diff --git a/compiler/delay_info.m b/compiler/delay_info.m index ff7257cb9..974ea7178 100644 --- a/compiler/delay_info.m +++ b/compiler/delay_info.m @@ -1,5 +1,5 @@ %-----------------------------------------------------------------------------% -% Copyright (C) 1994-1998, 2003 The University of Melbourne. +% Copyright (C) 1994-1998, 2003-2004 The University of Melbourne. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %-----------------------------------------------------------------------------% @@ -34,59 +34,54 @@ % Sanity-check the delay_info structure. % -:- pred delay_info__check_invariant(delay_info). -:- mode delay_info__check_invariant(in) is det. +:- pred delay_info__check_invariant(delay_info::in) is det. % Initialize the delay_info structure. % -:- pred delay_info__init(delay_info). -:- mode delay_info__init(out) is det. +:- pred delay_info__init(delay_info::out) is det. % Tell the delay_info structure that we've entered a new conjunction. % -:- pred delay_info__enter_conj(delay_info, delay_info). -:- mode delay_info__enter_conj(in, out) is det. +:- pred delay_info__enter_conj(delay_info::in, delay_info::out) is det. % Tell the delay_info structure that we've left a conjunction. % This predicate returns a list of the delayed goals from that % conjunction, i.e. goals which could not be scheduled. % -:- pred delay_info__leave_conj(delay_info, list(delayed_goal), delay_info). -:- mode delay_info__leave_conj(in, out, out) is det. +:- pred delay_info__leave_conj(delay_info::in, list(delayed_goal)::out, + delay_info::out) is det. % Insert a new delayed goal into the delay_info structure. % -:- pred delay_info__delay_goal(delay_info, mode_error_info, - hlds_goal, delay_info). -:- mode delay_info__delay_goal(in, in, in, out) is det. +:- pred delay_info__delay_goal(delay_info::in, mode_error_info::in, + hlds_goal::in, delay_info::out) is det. % Mark a list of variables as having been bound. % This may allow a previously delayed goal to change status % from "delayed" to "pending". % (This predicate just calls delay_info__bind_var in a loop.) % -:- pred delay_info__bind_var_list(list(prog_var), delay_info, delay_info). -:- mode delay_info__bind_var_list(in, in, out) is det. +:- pred delay_info__bind_var_list(list(prog_var)::in, + delay_info::in, delay_info::out) is det. % Mark a variable as having been bound. % This may allow a previously delayed goal to change status % from "delayed" to "pending". % -:- pred delay_info__bind_var(delay_info, prog_var, delay_info). -:- mode delay_info__bind_var(in, in, out) is det. +:- pred delay_info__bind_var(prog_var::in, delay_info::in, delay_info::out) + is det. % Mark all variables as having been bound. % This will allow all previously delayed goals to change status % from "delayed" to "pending". % -:- pred delay_info__bind_all_vars(delay_info, delay_info). -:- mode delay_info__bind_all_vars(in, out) is det. +:- pred delay_info__bind_all_vars(delay_info::in, delay_info::out) is det. % Check if there are any "pending" goals, and if so, % remove them from the delay_info and return them. % -:- pred delay_info__wakeup_goals(delay_info, list(hlds_goal), delay_info). -:- mode delay_info__wakeup_goals(in, out, out) is det. +:- pred delay_info__wakeup_goals(list(hlds_goal)::out, + delay_info::in, delay_info::out) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% @@ -96,7 +91,7 @@ :- import_module check_hlds__mode_errors. % for the mode_error_info % and delay_info types. -:- import_module int, stack, set, map, require, std_util. +:- import_module int, stack, set, map, svmap, require, std_util. % The delay_info structure is a tangled web of substructures % all of which are pointing at each other - debugging it @@ -106,28 +101,29 @@ :- type delay_info ---> delay_info( - depth_num, % CurrentDepth: + delay_depth :: depth_num, + % CurrentDepth: % the current conjunction depth, % i.e. the number of nested conjunctions % which are currently active - stack(map(seq_num, delayed_goal)), + delay_goals :: stack(map(seq_num, delayed_goal)), % DelayedGoalStack: % for each nested conjunction, % we store a collection of delayed goals % associated with that conjunction, % indexed by sequence number - waiting_goals_table, + delay_waiting :: waiting_goals_table, % WaitingGoalsTable: % for each variable, we keep track of % all the goals which are waiting on % that variable - pending_goals_table, + delay_pending :: pending_goals_table, % PendingGoalsTable: % when a variable gets bound, we % mark all the goals which are waiting % on that variable as ready to be % reawakened at the next opportunity - stack(seq_num) + delay_seqs :: stack(seq_num) % SeqNumsStack: % For each nested conjunction, the % next available sequence number. @@ -150,18 +146,15 @@ % hold, and if not, call error/1. delay_info__check_invariant(_). -/*** % for debugging purposes -delay_info__check_invariant(DelayInfo) :- - delay_info__check_invariant_x(DelayInfo). -***/ +%%% delay_info__check_invariant(DelayInfo) :- +%%% delay_info__check_invariant_x(DelayInfo). -:- pred delay_info__check_invariant_x(delay_info). -:- mode delay_info__check_invariant_x(in) is det. +:- pred delay_info__check_invariant_x(delay_info::in) is det. delay_info__check_invariant_x(DelayInfo) :- DelayInfo = delay_info(CurrentDepth, DelayedGoalStack, - WaitingGoalsTable, _PendingGoals, NextSeqNums), + WaitingGoalsTable, _PendingGoals, NextSeqNums), ( stack__depth(DelayedGoalStack, CurrentDepth), stack__depth(NextSeqNums, CurrentDepth), @@ -173,26 +166,25 @@ delay_info__check_invariant_x(DelayInfo) :- error("delay_info: invariant violated") ). - % For every variable which goals are waiting on, check the % consistency of all the goals waiting on that var. -:- pred waiting_goals_check_invariant(list(prog_var), waiting_goals_table). -:- mode waiting_goals_check_invariant(in, in) is semidet. +:- pred waiting_goals_check_invariant(list(prog_var)::in, + waiting_goals_table::in) is semidet. waiting_goals_check_invariant([], _). -waiting_goals_check_invariant([V|Vs], WaitingGoalsTable) :- - map__lookup(WaitingGoalsTable, V, WaitingGoals), +waiting_goals_check_invariant([Var | Vars], WaitingGoalsTable) :- + map__lookup(WaitingGoalsTable, Var, WaitingGoals), map__keys(WaitingGoals, GoalNums), - waiting_goal_check_invariant(GoalNums, WaitingGoals, WaitingGoalsTable), - waiting_goals_check_invariant(Vs, WaitingGoalsTable). + waiting_goal_check_invariant(GoalNums, WaitingGoals, + WaitingGoalsTable), + waiting_goals_check_invariant(Vars, WaitingGoalsTable). % Check the consistency of a list of goal_nums in the % waiting_goals_table. -:- pred waiting_goal_check_invariant(list(goal_num), waiting_goals, - waiting_goals_table). -:- mode waiting_goal_check_invariant(in, in, in) is semidet. +:- pred waiting_goal_check_invariant(list(goal_num)::in, waiting_goals::in, + waiting_goals_table::in) is semidet. waiting_goal_check_invariant([], _, _). waiting_goal_check_invariant([GoalNum | GoalNums], WaitingGoals, @@ -201,24 +193,26 @@ waiting_goal_check_invariant([GoalNum | GoalNums], WaitingGoals, set__list_to_set(Vars, VarsSet), waiting_goal_vars_check_invariant(Vars, GoalNum, VarsSet, WaitingGoalsTable), - waiting_goal_check_invariant(GoalNums, WaitingGoals, WaitingGoalsTable). + waiting_goal_check_invariant(GoalNums, WaitingGoals, + WaitingGoalsTable). % For every variable which a goal is waiting on, there should % be an entry in the waiting_goals_table for that goal, % and the set of vars which it is waiting on in that entry % should be the same as in all its other entries. -:- pred waiting_goal_vars_check_invariant(list(prog_var), goal_num, - set(prog_var), waiting_goals_table). -:- mode waiting_goal_vars_check_invariant(in, in, in, in) is semidet. +:- pred waiting_goal_vars_check_invariant(list(prog_var)::in, goal_num::in, + set(prog_var)::in, waiting_goals_table::in) is semidet. waiting_goal_vars_check_invariant([], _, _, _). -waiting_goal_vars_check_invariant([V|Vs], GoalNum, Vars, WaitingGoalsTable) :- - map__search(WaitingGoalsTable, V, WaitingGoals), +waiting_goal_vars_check_invariant([Var | Vars], GoalNum, GivenVars, + WaitingGoalsTable) :- + map__search(WaitingGoalsTable, Var, WaitingGoals), map__search(WaitingGoals, GoalNum, VarsList), set__list_to_set(VarsList, VarsSet), - set__equal(Vars, VarsSet), - waiting_goal_vars_check_invariant(Vs, GoalNum, Vars, WaitingGoalsTable). + set__equal(GivenVars, VarsSet), + waiting_goal_vars_check_invariant(Vars, GoalNum, GivenVars, + WaitingGoalsTable). %-----------------------------------------------------------------------------% @@ -232,7 +226,7 @@ delay_info__init(DelayInfo) :- map__init(PendingGoals), stack__init(NextSeqNums), DelayInfo = delay_info(CurrentDepth, DelayedGoalStack, - WaitingGoalsTable, PendingGoals, NextSeqNums), + WaitingGoalsTable, PendingGoals, NextSeqNums), delay_info__check_invariant(DelayInfo). %-----------------------------------------------------------------------------% @@ -240,13 +234,13 @@ delay_info__init(DelayInfo) :- delay_info__enter_conj(DelayInfo0, DelayInfo) :- delay_info__check_invariant(DelayInfo0), DelayInfo0 = delay_info(CurrentDepth0, DelayedGoalStack0, - WaitingGoalsTable, PendingGoals, NextSeqNums0), + WaitingGoalsTable, PendingGoals, NextSeqNums0), map__init(DelayedGoals), stack__push(DelayedGoalStack0, DelayedGoals, DelayedGoalStack), stack__push(NextSeqNums0, 0, NextSeqNums), CurrentDepth = CurrentDepth0 + 1, DelayInfo = delay_info(CurrentDepth, DelayedGoalStack, - WaitingGoalsTable, PendingGoals, NextSeqNums), + WaitingGoalsTable, PendingGoals, NextSeqNums), delay_info__check_invariant(DelayInfo). %-----------------------------------------------------------------------------% @@ -254,16 +248,16 @@ delay_info__enter_conj(DelayInfo0, DelayInfo) :- delay_info__leave_conj(DelayInfo0, DelayedGoalsList, DelayInfo) :- delay_info__check_invariant(DelayInfo0), DelayInfo0 = delay_info(CurrentDepth0, DelayedGoalStack0, - WaitingGoalsTable0, PendingGoals, NextSeqNums0), + WaitingGoalsTable0, PendingGoals, NextSeqNums0), stack__pop_det(DelayedGoalStack0, DelayedGoals, DelayedGoalStack), map__keys(DelayedGoals, SeqNums), remove_delayed_goals(SeqNums, DelayedGoals, CurrentDepth0, - WaitingGoalsTable0, WaitingGoalsTable), + WaitingGoalsTable0, WaitingGoalsTable), stack__pop_det(NextSeqNums0, _, NextSeqNums), CurrentDepth = CurrentDepth0 - 1, map__values(DelayedGoals, DelayedGoalsList), DelayInfo = delay_info(CurrentDepth, DelayedGoalStack, - WaitingGoalsTable, PendingGoals, NextSeqNums), + WaitingGoalsTable, PendingGoals, NextSeqNums), delay_info__check_invariant(DelayInfo). %-----------------------------------------------------------------------------% @@ -272,21 +266,20 @@ delay_info__leave_conj(DelayInfo0, DelayedGoalsList, DelayInfo) :- % from the waiting goals table before we delay the conjunction as a % whole. -:- pred remove_delayed_goals(list(seq_num), map(seq_num, delayed_goal), - depth_num, waiting_goals_table, waiting_goals_table). -:- mode remove_delayed_goals(in, in, in, in, out) is det. +:- pred remove_delayed_goals(list(seq_num)::in, map(seq_num, delayed_goal)::in, + depth_num::in, waiting_goals_table::in, waiting_goals_table::out) + is det. -remove_delayed_goals([], _, _, WaitingGoalsTable, WaitingGoalsTable). +remove_delayed_goals([], _, _, !WaitingGoalsTable). remove_delayed_goals([SeqNum | SeqNums], DelayedGoalsTable, Depth, - WaitingGoalsTable0, WaitingGoalsTable) :- + !WaitingGoalsTable) :- map__lookup(DelayedGoalsTable, SeqNum, DelayedGoal), DelayedGoal = delayed_goal(Vars, _Error, _Goal), GoalNum = Depth - SeqNum, set__to_sorted_list(Vars, VarList), - delete_waiting_vars(VarList, GoalNum, - WaitingGoalsTable0, WaitingGoalsTable1), + delete_waiting_vars(VarList, GoalNum, !WaitingGoalsTable), remove_delayed_goals(SeqNums, DelayedGoalsTable, Depth, - WaitingGoalsTable1, WaitingGoalsTable). + !WaitingGoalsTable). %-----------------------------------------------------------------------------% @@ -297,7 +290,7 @@ delay_info__delay_goal(DelayInfo0, Error, Goal, DelayInfo) :- delay_info__check_invariant(DelayInfo0), Error = mode_error_info(Vars, _, _, _), DelayInfo0 = delay_info(CurrentDepth, DelayedGoalStack0, - WaitingGoalsTable0, PendingGoals, NextSeqNums0), + WaitingGoalsTable0, PendingGoals, NextSeqNums0), % Get the next sequence number stack__pop_det(NextSeqNums0, SeqNum, NextSeqNums1), @@ -306,45 +299,39 @@ delay_info__delay_goal(DelayInfo0, Error, Goal, DelayInfo) :- % Store the goal in the delayed goal stack stack__pop_det(DelayedGoalStack0, DelayedGoals0, DelayedGoalStack1), - map__set(DelayedGoals0, SeqNum, delayed_goal(Vars, Error, Goal), - DelayedGoals), + svmap__set(SeqNum, delayed_goal(Vars, Error, Goal), + DelayedGoals0, DelayedGoals), stack__push(DelayedGoalStack1, DelayedGoals, DelayedGoalStack), % Store indexes to the goal in the waiting goals table GoalNum = CurrentDepth - SeqNum, set__to_sorted_list(Vars, VarList), - add_waiting_vars(VarList, GoalNum, VarList, WaitingGoalsTable0, - WaitingGoalsTable), + add_waiting_vars(VarList, GoalNum, VarList, + WaitingGoalsTable0, WaitingGoalsTable), DelayInfo = delay_info(CurrentDepth, DelayedGoalStack, - WaitingGoalsTable, PendingGoals, NextSeqNums), + WaitingGoalsTable, PendingGoals, NextSeqNums), delay_info__check_invariant(DelayInfo). - % add_waiting_vars(Vars, Goal, AllVars, WGT0, WGT): % update the waiting goals table by adding indexes % from each of the variables in Vars to Goal. % AllVars must be the list of all the variables which the goal is % waiting on. -:- pred add_waiting_vars(list(prog_var), goal_num, list(prog_var), - waiting_goals_table, waiting_goals_table). -:- mode add_waiting_vars(in, in, in, in, out) is det. +:- pred add_waiting_vars(list(prog_var)::in, goal_num::in, list(prog_var)::in, + waiting_goals_table::in, waiting_goals_table::out) is det. -add_waiting_vars([], _, _, WaitingGoalsTable, WaitingGoalsTable). -add_waiting_vars([Var | Vars], Goal, AllVars, WaitingGoalsTable0, - WaitingGoalsTable) :- - ( - map__search(WaitingGoalsTable0, Var, WaitingGoals0) - -> +add_waiting_vars([], _, _, !WaitingGoalsTable). +add_waiting_vars([Var | Vars], Goal, AllVars, !WaitingGoalsTable) :- + ( map__search(!.WaitingGoalsTable, Var, WaitingGoals0) -> WaitingGoals1 = WaitingGoals0 ; map__init(WaitingGoals1) ), map__set(WaitingGoals1, Goal, AllVars, WaitingGoals), - map__set(WaitingGoalsTable0, Var, WaitingGoals, WaitingGoalsTable1), - add_waiting_vars(Vars, Goal, AllVars, WaitingGoalsTable1, - WaitingGoalsTable). + svmap__set(Var, WaitingGoals, !WaitingGoalsTable), + add_waiting_vars(Vars, Goal, AllVars, !WaitingGoalsTable). %-----------------------------------------------------------------------------% @@ -354,15 +341,14 @@ add_waiting_vars([Var | Vars], Goal, AllVars, WaitingGoalsTable0, % goals table and add them to the pending goals table. They % will be woken up next time we get back to their conjunction. -delay_info__bind_all_vars(DelayInfo0, DelayInfo) :- - DelayInfo0 = delay_info(_, _, WaitingGoalsTable0, _, _), - map__keys(WaitingGoalsTable0, WaitingVars), - delay_info__bind_var_list(WaitingVars, DelayInfo0, DelayInfo). +delay_info__bind_all_vars(!DelayInfo) :- + map__keys(!.DelayInfo ^ delay_waiting, WaitingVars), + delay_info__bind_var_list(WaitingVars, !DelayInfo). -delay_info__bind_var_list([], DelayInfo, DelayInfo). -delay_info__bind_var_list([Var|Vars], DelayInfo0, DelayInfo) :- - delay_info__bind_var(DelayInfo0, Var, DelayInfo1), - delay_info__bind_var_list(Vars, DelayInfo1, DelayInfo). +delay_info__bind_var_list([], !DelayInfo). +delay_info__bind_var_list([Var|Vars], !DelayInfo) :- + delay_info__bind_var(Var, !DelayInfo), + delay_info__bind_var_list(Vars, !DelayInfo). % Whenever we bind a variable, we also check to see whether % we need to wake up some goals. If so, we remove those @@ -370,97 +356,86 @@ delay_info__bind_var_list([Var|Vars], DelayInfo0, DelayInfo) :- % goals table. They will be woken up next time we get back % to their conjunction. -delay_info__bind_var(DelayInfo0, Var, DelayInfo) :- - delay_info__check_invariant(DelayInfo0), - DelayInfo0 = delay_info(CurrentDepth, DelayedGoalStack, - WaitingGoalsTable0, PendingGoals0, NextSeqNums), - ( - map__search(WaitingGoalsTable0, Var, GoalsWaitingOnVar) - -> +delay_info__bind_var(Var, !DelayInfo) :- + delay_info__check_invariant(!.DelayInfo), + !.DelayInfo = delay_info(CurrentDepth, DelayedGoalStack, + WaitingGoalsTable0, PendingGoals0, NextSeqNums), + ( map__search(WaitingGoalsTable0, Var, GoalsWaitingOnVar) -> map__keys(GoalsWaitingOnVar, NewlyPendingGoals), add_pending_goals(NewlyPendingGoals, GoalsWaitingOnVar, - PendingGoals0, PendingGoals, - WaitingGoalsTable0, WaitingGoalsTable), - DelayInfo = delay_info(CurrentDepth, DelayedGoalStack, - WaitingGoalsTable, PendingGoals, NextSeqNums), - delay_info__check_invariant(DelayInfo) + PendingGoals0, PendingGoals, + WaitingGoalsTable0, WaitingGoalsTable), + !:DelayInfo = delay_info(CurrentDepth, DelayedGoalStack, + WaitingGoalsTable, PendingGoals, NextSeqNums), + delay_info__check_invariant(!.DelayInfo) ; - DelayInfo = DelayInfo0 + true ). % Add a collection of goals, identified by depth_num and seq_num % (depth of nested conjunction and sequence number within conjunction), % to the collection of pending goals. -:- pred add_pending_goals(list(goal_num), map(goal_num, list(prog_var)), - pending_goals_table, pending_goals_table, - waiting_goals_table, waiting_goals_table). -:- mode add_pending_goals(in, in, in, out, in, out) is det. +:- pred add_pending_goals(list(goal_num)::in, + map(goal_num, list(prog_var))::in, + pending_goals_table::in, pending_goals_table::out, + waiting_goals_table::in, waiting_goals_table::out) is det. -add_pending_goals([], _WaitingVarsTable, - PendingGoals, PendingGoals, - WaitingGoals, WaitingGoals). +add_pending_goals([], _WaitingVarsTable, !PendingGoals, !WaitingGoals). add_pending_goals([Depth - SeqNum | Rest], WaitingVarsTable, - PendingGoals0, PendingGoals, - WaitingGoals0, WaitingGoals) :- + !PendingGoals, !WaitingGoals) :- % remove any other indexes to the goal from the waiting % goals table GoalNum = Depth - SeqNum, map__lookup(WaitingVarsTable, GoalNum, WaitingVars), - delete_waiting_vars(WaitingVars, GoalNum, WaitingGoals0, WaitingGoals1), + delete_waiting_vars(WaitingVars, GoalNum, !WaitingGoals), % add the goal to the pending goals table - ( map__search(PendingGoals0, Depth, PendingSeqNums0) -> + ( map__search(!.PendingGoals, Depth, PendingSeqNums0) -> % XXX should use a queue list__append(PendingSeqNums0, [SeqNum], PendingSeqNums) ; PendingSeqNums = [SeqNum] ), - map__set(PendingGoals0, Depth, PendingSeqNums, PendingGoals1), + svmap__set(Depth, PendingSeqNums, !PendingGoals), % do the same for the rest of the pending goals add_pending_goals(Rest, WaitingVarsTable, - PendingGoals1, PendingGoals, - WaitingGoals1, WaitingGoals). + !PendingGoals, !WaitingGoals). %-----------------------------------------------------------------------------% % Remove all references to a goal from the waiting goals table. -:- pred delete_waiting_vars(list(prog_var), goal_num, - waiting_goals_table, waiting_goals_table). -:- mode delete_waiting_vars(in, in, in, out) is det. +:- pred delete_waiting_vars(list(prog_var)::in, goal_num::in, + waiting_goals_table::in, waiting_goals_table::out) is det. -delete_waiting_vars([], _, WaitingGoalTables, WaitingGoalTables). -delete_waiting_vars([Var | Vars], GoalNum, WaitingGoalsTable0, - WaitingGoalsTable) :- - map__lookup(WaitingGoalsTable0, Var, WaitingGoals0), +delete_waiting_vars([], _, !WaitingGoalTables). +delete_waiting_vars([Var | Vars], GoalNum, !WaitingGoalsTable) :- + map__lookup(!.WaitingGoalsTable, Var, WaitingGoals0), map__delete(WaitingGoals0, GoalNum, WaitingGoals), ( map__is_empty(WaitingGoals) -> - map__delete(WaitingGoalsTable0, Var, WaitingGoalsTable1) + svmap__delete(Var, !WaitingGoalsTable) ; - map__set(WaitingGoalsTable0, Var, WaitingGoals, - WaitingGoalsTable1) + svmap__set(Var, WaitingGoals, !WaitingGoalsTable) ), - delete_waiting_vars(Vars, GoalNum, WaitingGoalsTable1, - WaitingGoalsTable). + delete_waiting_vars(Vars, GoalNum, !WaitingGoalsTable). %-----------------------------------------------------------------------------% - % delay_info__wakeup_goals(DelayInfo0, Goals, DelayInfo): + % delay_info__wakeup_goals(Goals, !DelayInfo): % Goals is the list of pending goal in the order that they should % be woken up, and DelayInfo is the new delay_info, updated to % reflect the fact that the Goals have been woken up and is % hence are longer pending. -delay_info__wakeup_goals(DelayInfo0, Goals, DelayInfo) :- - ( delay_info__wakeup_goal(DelayInfo0, Goal, DelayInfo1) -> +delay_info__wakeup_goals(Goals, !DelayInfo) :- + ( delay_info__wakeup_goal(Goal, !DelayInfo) -> Goals = [Goal | Goals1], - delay_info__wakeup_goals(DelayInfo1, Goals1, DelayInfo) + delay_info__wakeup_goals(Goals1, !DelayInfo) ; - Goals = [], - DelayInfo = DelayInfo0 + Goals = [] ). % Check if there are any "pending" goals, and if so, @@ -468,8 +443,8 @@ delay_info__wakeup_goals(DelayInfo0, Goals, DelayInfo) :- % and return it. If there are no pending goals, this % predicate will fail. % -:- pred delay_info__wakeup_goal(delay_info, hlds_goal, delay_info). -:- mode delay_info__wakeup_goal(in, out, out) is semidet. +:- pred delay_info__wakeup_goal(hlds_goal::out, + delay_info::in, delay_info::out) is semidet. % delay_info__wakeup_goal(DelayInfo0, Goal, DelayInfo) is true iff % DelayInfo0 specifies that there is at least one goal which is @@ -477,10 +452,10 @@ delay_info__wakeup_goals(DelayInfo0, Goals, DelayInfo) :- % and DelayInfo is the new delay_info, updated to reflect the fact % that Goal has been woken up and is hence no longer pending. -delay_info__wakeup_goal(DelayInfo0, Goal, DelayInfo) :- - delay_info__check_invariant(DelayInfo0), - DelayInfo0 = delay_info(CurrentDepth, DelayedGoalStack0, WaitingGoals, - PendingGoalsTable0, NextSeqNums), +delay_info__wakeup_goal(Goal, !DelayInfo) :- + delay_info__check_invariant(!.DelayInfo), + !.DelayInfo = delay_info(CurrentDepth, DelayedGoalStack0, WaitingGoals, + PendingGoalsTable0, NextSeqNums), % is there a goal in the current conjunction which is pending? map__search(PendingGoalsTable0, CurrentDepth, PendingGoals0), @@ -489,15 +464,15 @@ delay_info__wakeup_goal(DelayInfo0, Goal, DelayInfo) :- % remove it from the delayed goals stack, and return it PendingGoals0 = [SeqNum | PendingGoals], map__set(PendingGoalsTable0, CurrentDepth, PendingGoals, - PendingGoalsTable), + PendingGoalsTable), stack__pop_det(DelayedGoalStack0, DelayedGoals0, DelayedGoalStack1), map__lookup(DelayedGoals0, SeqNum, DelayedGoal), DelayedGoal = delayed_goal(_Vars, _ErrorReason, Goal), map__delete(DelayedGoals0, SeqNum, DelayedGoals), stack__push(DelayedGoalStack1, DelayedGoals, DelayedGoalStack), - DelayInfo = delay_info(CurrentDepth, DelayedGoalStack, WaitingGoals, - PendingGoalsTable, NextSeqNums), - delay_info__check_invariant(DelayInfo). + !:DelayInfo = delay_info(CurrentDepth, DelayedGoalStack, WaitingGoals, + PendingGoalsTable, NextSeqNums), + delay_info__check_invariant(!.DelayInfo). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% diff --git a/compiler/inst_graph.m b/compiler/inst_graph.m index d45471aa1..90b6e241b 100644 --- a/compiler/inst_graph.m +++ b/compiler/inst_graph.m @@ -126,8 +126,7 @@ % Print the given inst_graph over the given varset in a format % suitable for debugging output. -:- pred dump(inst_graph::in, prog_varset::in, io__state::di, io__state::uo) - is det. +:- pred dump(inst_graph::in, prog_varset::in, io::di, io::uo) is det. % XXX this should probably go in list.m. :- pred corresponding_members(list(T)::in, list(U)::in, T::out, U::out) @@ -372,7 +371,7 @@ dump(InstGraph, VarSet, !IO) :- map__foldl(dump_node(VarSet), InstGraph, !IO). :- pred dump_node(prog_varset::in, prog_var::in, node::in, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. dump_node(VarSet, Var, Node, !IO) :- Node = node(Functors, MaybeParent), @@ -389,7 +388,7 @@ dump_node(VarSet, Var, Node, !IO) :- map__foldl(dump_functor(VarSet), Functors, !IO). :- pred dump_functor(prog_varset::in, cons_id::in, list(prog_var)::in, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. dump_functor(VarSet, ConsId, Args, !IO) :- io__write_string("%%\t", !IO), @@ -404,8 +403,7 @@ dump_functor(VarSet, ConsId, Args, !IO) :- ), io__nl(!IO). -:- pred dump_var(prog_varset::in, prog_var::in, - io__state::di, io__state::uo) is det. +:- pred dump_var(prog_varset::in, prog_var::in, io::di, io::uo) is det. dump_var(VarSet, Var, !IO) :- term_io__write_variable(Var, VarSet, !IO). diff --git a/compiler/inst_match.m b/compiler/inst_match.m index b41dc01de..b3e98a2f7 100644 --- a/compiler/inst_match.m +++ b/compiler/inst_match.m @@ -21,10 +21,10 @@ % modes.m would have to be changed to handle the implicit % conversions from `free'/`bound'/`ground' to `any' at % -% (1) procedure calls (this is just an extension of implied modes) -% currently we support only the easy cases of this -% (2) the end of branched goals -% (3) the end of predicates. +% (1) procedure calls (this is just an extension of implied modes) +% currently we support only the easy cases of this +% (2) the end of branched goals +% (3) the end of predicates. % % Since that is not yet done, we currently require the user to % insert explicit calls to initialize constraint variables. @@ -47,15 +47,14 @@ %-----------------------------------------------------------------------------% -:- pred inst_expand(module_info, inst, inst). -:- mode inst_expand(in, in, out) is det. +:- pred inst_expand(module_info::in, (inst)::in, (inst)::out) is det. % inst_expand(ModuleInfo, Inst0, Inst) checks if the top-level % part of the inst is a defined inst, and if so replaces it % with the definition. -:- pred inst_expand_and_remove_constrained_inst_vars(module_info, inst, inst). -:- mode inst_expand_and_remove_constrained_inst_vars(in, in, out) is det. +:- pred inst_expand_and_remove_constrained_inst_vars(module_info::in, + (inst)::in, (inst)::out) is det. % inst_expand_and_remove_constrained_inst_vars is the same as % inst_expand except that it also removes constrained_inst_vars from the @@ -74,30 +73,29 @@ % inst_matches_initial(bound(a), bound(a;b), _) should % succeed, but not vice versa. -:- pred inst_matches_initial(inst, inst, type, module_info). -:- mode inst_matches_initial(in, in, in, in) is semidet. +:- pred inst_matches_initial((inst)::in, (inst)::in, (type)::in, + module_info::in) is semidet. % This version of inst_matches_initial builds up a substitution map % (inst_var_sub). For each inst_var which occurs in InstA there will be % a substitution to the corresponding inst in InstB. -:- pred inst_matches_initial(inst, inst, type, module_info, module_info, - inst_var_sub, inst_var_sub). -:- mode inst_matches_initial(in, in, in, in, out, in, out) is semidet. +:- pred inst_matches_initial((inst)::in, (inst)::in, (type)::in, + module_info::in, module_info::out, inst_var_sub::in, inst_var_sub::out) + is semidet. % This version of inst_matches_initial does not allow implied modes. % This makes it almost the same as inst_matches_final. The only % different is in the way it handles constrained_inst_vars. -:- pred inst_matches_initial_no_implied_modes(inst, inst, type, module_info). -:- mode inst_matches_initial_no_implied_modes(in, in, in, in) is semidet. +:- pred inst_matches_initial_no_implied_modes((inst)::in, (inst)::in, + (type)::in, module_info::in) is semidet. % A version of the above that also computes the inst_var_sub. -:- pred inst_matches_initial_no_implied_modes(inst, inst, type, module_info, - module_info, inst_var_sub, inst_var_sub). -:- mode inst_matches_initial_no_implied_modes(in, in, in, in, out, in, out) - is semidet. +:- pred inst_matches_initial_no_implied_modes((inst)::in, (inst)::in, + (type)::in, module_info::in, module_info::out, + inst_var_sub::in, inst_var_sub::out) is semidet. % inst_matches_final(InstA, InstB, ModuleInfo): % Succeed iff InstA is compatible with InstB, @@ -108,17 +106,16 @@ % is the same and both insts specify a binding, the binding % must be identical. -:- pred inst_matches_final(inst, inst, module_info). -:- mode inst_matches_final(in, in, in) is semidet. +:- pred inst_matches_final((inst)::in, (inst)::in, module_info::in) is semidet. % This version of inst_matches_final allows you to pass in the type of - % the variables being compared. This allows it to be more precise (i.e. - % less conservative) for cases such as + % the variables being compared. This allows it to be more precise + % (i.e. less conservative) for cases such as % inst_matches_final(ground(...), bound(...), ...). % This version is to be preferred when the type is available. -:- pred inst_matches_final(inst, inst, type, module_info). -:- mode inst_matches_final(in, in, in, in) is semidet. +:- pred inst_matches_final((inst)::in, (inst)::in, (type)::in, module_info::in) + is semidet. % The difference between inst_matches_initial and % inst_matches_final is that inst_matches_initial requires @@ -138,39 +135,37 @@ % where When is either `initial' or `final'. % inst_is_at_least_as_instantiated(InstA, InstB, Type, ModuleInfo) - % succeeds iff InstA is at least as instantiated as InstB. This - % defines a partial order which is the same as - % inst_matches_initial except that uniqueness comparisons are - % reversed and we don't allow - % inst_is_at_least_as_instantiated(any, any). + % succeeds iff InstA is at least as instantiated as InstB. This + % defines a partial order which is the same as + % inst_matches_initial except that uniqueness comparisons are + % reversed and we don't allow + % inst_is_at_least_as_instantiated(any, any). -:- pred inst_is_at_least_as_instantiated(inst, inst, type, module_info). -:- mode inst_is_at_least_as_instantiated(in, in, in, in) is semidet. +:- pred inst_is_at_least_as_instantiated((inst)::in, (inst)::in, (type)::in, + module_info::in) is semidet. -:- pred unique_matches_initial(uniqueness, uniqueness). -:- mode unique_matches_initial(in, in) is semidet. +:- pred unique_matches_initial(uniqueness::in, uniqueness::in) is semidet. % unique_matches_initial(A, B) succeeds if A >= B in the ordering % clobbered < mostly_clobbered < shared < mostly_unique < unique -:- pred unique_matches_final(uniqueness, uniqueness). -:- mode unique_matches_final(in, in) is semidet. +:- pred unique_matches_final(uniqueness::in, uniqueness::in) is semidet. % unique_matches_final(A, B) succeeds if A >= B in the ordering % clobbered < mostly_clobbered < shared < mostly_unique < unique -:- pred inst_matches_binding(inst, inst, type, module_info). -:- mode inst_matches_binding(in, in, in, in) is semidet. +:- pred inst_matches_binding((inst)::in, (inst)::in, (type)::in, + module_info::in) is semidet. % inst_matches_binding(InstA, InstB, ModuleInfo): - % Succeed iff the binding of InstA is definitely exactly the - % same as that of InstB. This is the same as - % inst_matches_final except that it ignores uniqueness, and - % that `any' does not match itself. It is used to check - % whether variables get bound in negated contexts. + % Succeed iff the binding of InstA is definitely exactly the + % same as that of InstB. This is the same as + % inst_matches_final except that it ignores uniqueness, and + % that `any' does not match itself. It is used to check + % whether variables get bound in negated contexts. -:- pred inst_matches_binding_allow_any_any(inst, inst, type, module_info). -:- mode inst_matches_binding_allow_any_any(in, in, in, in) is semidet. +:- pred inst_matches_binding_allow_any_any((inst)::in, (inst)::in, (type)::in, + module_info::in) is semidet. % inst_matches_binding_allow_any_any is the same as % inst_matches_binding except that it also allows `any' to @@ -179,144 +174,128 @@ %-----------------------------------------------------------------------------% % pred_inst_matches(PredInstA, PredInstB, ModuleInfo) - % Succeeds if PredInstA specifies a pred that can + % Succeeds if PredInstA specifies a pred that can % be used wherever and whenever PredInstB could be used. % This is true if they both have the same PredOrFunc indicator % and the same determinism, and if the arguments match % using pred_inst_argmodes_match. % -:- pred pred_inst_matches(pred_inst_info, pred_inst_info, module_info). -:- mode pred_inst_matches(in, in, in) is semidet. +:- pred pred_inst_matches(pred_inst_info::in, pred_inst_info::in, + module_info::in) is semidet. %-----------------------------------------------------------------------------% -/* -** Predicates to test various properties of insts. -** Note that `not_reached' insts are considered to satisfy -** all of these predicates except inst_is_clobbered. -*/ +% +% Predicates to test various properties of insts. +% Note that `not_reached' insts are considered to satisfy +% all of these predicates except inst_is_clobbered. +% - % succeed if the inst is fully ground (i.e. contains only - % `ground', `bound', and `not_reached' insts, with no `free' - % or `any' insts). + % succeed if the inst is fully ground (i.e. contains only + % `ground', `bound', and `not_reached' insts, with no `free' + % or `any' insts). % This predicate succeeds for non-standard function insts so some care % needs to be taken since these insts may not be replaced by a less % precise inst that uses the higher-order mode information. -:- pred inst_is_ground(module_info, inst). -:- mode inst_is_ground(in, in) is semidet. +:- pred inst_is_ground(module_info::in, (inst)::in) is semidet. - % succeed if the inst is not partly free (i.e. contains only - % `any', `ground', `bound', and `not_reached' insts, with no - % `free' insts). + % succeed if the inst is not partly free (i.e. contains only + % `any', `ground', `bound', and `not_reached' insts, with no + % `free' insts). % This predicate succeeds for non-standard function insts so some care % needs to be taken since these insts may not be replaced by a less % precise inst that uses the higher-order mode information. -:- pred inst_is_ground_or_any(module_info, inst). -:- mode inst_is_ground_or_any(in, in) is semidet. +:- pred inst_is_ground_or_any(module_info::in, (inst)::in) is semidet. - % succeed if the inst is `mostly_unique' or `unique' -:- pred inst_is_mostly_unique(module_info, inst). -:- mode inst_is_mostly_unique(in, in) is semidet. + % succeed if the inst is `mostly_unique' or `unique' +:- pred inst_is_mostly_unique(module_info::in, (inst)::in) is semidet. - % succeed if the inst is `unique' -:- pred inst_is_unique(module_info, inst). -:- mode inst_is_unique(in, in) is semidet. + % succeed if the inst is `unique' +:- pred inst_is_unique(module_info::in, (inst)::in) is semidet. - % succeed if the inst is not `mostly_unique' or `unique' -:- pred inst_is_not_partly_unique(module_info, inst). -:- mode inst_is_not_partly_unique(in, in) is semidet. + % succeed if the inst is not `mostly_unique' or `unique' +:- pred inst_is_not_partly_unique(module_info::in, (inst)::in) is semidet. - % succeed if the inst is not `unique' -:- pred inst_is_not_fully_unique(module_info, inst). -:- mode inst_is_not_fully_unique(in, in) is semidet. + % succeed if the inst is not `unique' +:- pred inst_is_not_fully_unique(module_info::in, (inst)::in) is semidet. -:- pred inst_is_clobbered(module_info, inst). -:- mode inst_is_clobbered(in, in) is semidet. +:- pred inst_is_clobbered(module_info::in, (inst)::in) is semidet. -:- pred inst_list_is_ground(list(inst), module_info). -:- mode inst_list_is_ground(in, in) is semidet. +:- pred inst_list_is_ground(list(inst)::in, module_info::in) is semidet. -:- pred inst_list_is_ground_or_any(list(inst), module_info). -:- mode inst_list_is_ground_or_any(in, in) is semidet. +:- pred inst_list_is_ground_or_any(list(inst)::in, module_info::in) is semidet. -:- pred inst_list_is_unique(list(inst), module_info). -:- mode inst_list_is_unique(in, in) is semidet. +:- pred inst_list_is_unique(list(inst)::in, module_info::in) is semidet. -:- pred inst_list_is_mostly_unique(list(inst), module_info). -:- mode inst_list_is_mostly_unique(in, in) is semidet. +:- pred inst_list_is_mostly_unique(list(inst)::in, module_info::in) is semidet. -:- pred inst_list_is_not_partly_unique(list(inst), module_info). -:- mode inst_list_is_not_partly_unique(in, in) is semidet. +:- pred inst_list_is_not_partly_unique(list(inst)::in, module_info::in) + is semidet. -:- pred inst_list_is_not_fully_unique(list(inst), module_info). -:- mode inst_list_is_not_fully_unique(in, in) is semidet. +:- pred inst_list_is_not_fully_unique(list(inst)::in, module_info::in) + is semidet. -:- pred bound_inst_list_is_ground(list(bound_inst), module_info). -:- mode bound_inst_list_is_ground(in, in) is semidet. +:- pred bound_inst_list_is_ground(list(bound_inst)::in, module_info::in) + is semidet. -:- pred bound_inst_list_is_ground_or_any(list(bound_inst), module_info). -:- mode bound_inst_list_is_ground_or_any(in, in) is semidet. +:- pred bound_inst_list_is_ground_or_any(list(bound_inst)::in, + module_info::in) is semidet. -:- pred bound_inst_list_is_unique(list(bound_inst), module_info). -:- mode bound_inst_list_is_unique(in, in) is semidet. +:- pred bound_inst_list_is_unique(list(bound_inst)::in, module_info::in) + is semidet. -:- pred bound_inst_list_is_mostly_unique(list(bound_inst), module_info). -:- mode bound_inst_list_is_mostly_unique(in, in) is semidet. +:- pred bound_inst_list_is_mostly_unique(list(bound_inst)::in, module_info::in) + is semidet. -:- pred bound_inst_list_is_not_partly_unique(list(bound_inst), module_info). -:- mode bound_inst_list_is_not_partly_unique(in, in) is semidet. +:- pred bound_inst_list_is_not_partly_unique(list(bound_inst)::in, + module_info::in) is semidet. -:- pred bound_inst_list_is_not_fully_unique(list(bound_inst), module_info). -:- mode bound_inst_list_is_not_fully_unique(in, in) is semidet. +:- pred bound_inst_list_is_not_fully_unique(list(bound_inst)::in, + module_info::in) is semidet. -:- pred inst_is_free(module_info, inst). -:- mode inst_is_free(in, in) is semidet. +:- pred inst_is_free(module_info::in, (inst)::in) is semidet. -:- pred inst_is_any(module_info, inst). -:- mode inst_is_any(in, in) is semidet. +:- pred inst_is_any(module_info::in, (inst)::in) is semidet. -:- pred inst_list_is_free(list(inst), module_info). -:- mode inst_list_is_free(in, in) is semidet. +:- pred inst_list_is_free(list(inst)::in, module_info::in) is semidet. -:- pred bound_inst_list_is_free(list(bound_inst), module_info). -:- mode bound_inst_list_is_free(in, in) is semidet. +:- pred bound_inst_list_is_free(list(bound_inst)::in, module_info::in) + is semidet. -:- pred inst_is_bound(module_info, inst). -:- mode inst_is_bound(in, in) is semidet. +:- pred inst_is_bound(module_info::in, (inst)::in) is semidet. -:- pred inst_is_bound_to_functors(module_info, inst, list(bound_inst)). -:- mode inst_is_bound_to_functors(in, in, out) is semidet. +:- pred inst_is_bound_to_functors(module_info::in, (inst)::in, + list(bound_inst)::out) is semidet. %-----------------------------------------------------------------------------% % Succeed iff the specified inst contains (directly or indirectly) % the specified inst_name. -:- pred inst_contains_instname(inst, module_info, inst_name). -:- mode inst_contains_instname(in, in, in) is semidet. +:- pred inst_contains_instname((inst)::in, module_info::in, inst_name::in) + is semidet. % Nondeterministically produce all the inst_vars contained % in the specified list of modes. -:- pred mode_list_contains_inst_var(list(mode), module_info, inst_var). -:- mode mode_list_contains_inst_var(in, in, out) is nondet. +:- pred mode_list_contains_inst_var(list(mode)::in, module_info::in, + inst_var::out) is nondet. % Given a list of insts, and a corresponding list of livenesses, % return true iff for every element in the list of insts, either % the elemement is ground or the corresponding element in the liveness % list is dead. -:- pred inst_list_is_ground_or_dead(list(inst), list(is_live), module_info). -:- mode inst_list_is_ground_or_dead(in, in, in) is semidet. +:- pred inst_list_is_ground_or_dead(list(inst)::in, list(is_live)::in, + module_info::in) is semidet. % Given a list of insts, and a corresponding list of livenesses, % return true iff for every element in the list of insts, either % the elemement is ground or any, or the corresponding element % in the liveness list is dead. -:- pred inst_list_is_ground_or_any_or_dead(list(inst), list(is_live), - module_info). -:- mode inst_list_is_ground_or_any_or_dead(in, in, in) is semidet. +:- pred inst_list_is_ground_or_any_or_dead(list(inst)::in, list(is_live)::in, + module_info::in) is semidet. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% @@ -329,16 +308,16 @@ :- import_module hlds__hlds_data. :- import_module parse_tree__prog_data. -:- import_module list, set, map, term, std_util, require, bool. +:- import_module list, set, svset, map, term, std_util, require, bool. inst_matches_initial(InstA, InstB, Type, ModuleInfo) :- inst_matches_initial_1(InstA, InstB, Type, ModuleInfo, _, no, _). -inst_matches_initial(InstA, InstB, Type, ModuleInfo0, ModuleInfo, Sub0, Sub) :- - inst_matches_initial_1(InstA, InstB, Type, ModuleInfo0, ModuleInfo, - yes(Sub0), MaybeSub), +inst_matches_initial(InstA, InstB, Type, !ModuleInfo, !Sub) :- + inst_matches_initial_1(InstA, InstB, Type, !ModuleInfo, + yes(!.Sub), MaybeSub), ( - MaybeSub = yes(Sub) + MaybeSub = yes(!:Sub) ; MaybeSub = no, error("inst_matches_initial: missing inst_var_sub") @@ -348,27 +327,25 @@ inst_matches_initial_no_implied_modes(InstA, InstB, Type, ModuleInfo) :- Info0 = init_inst_match_info(ModuleInfo) ^ calculate_sub := forward, inst_matches_final_2(InstA, InstB, yes(Type), Info0, _). -inst_matches_initial_no_implied_modes(InstA, InstB, Type, ModuleInfo0, - ModuleInfo, Sub0, Sub) :- - Info0 = (init_inst_match_info(ModuleInfo0) - ^ calculate_sub := forward) - ^ maybe_sub := yes(Sub0), +inst_matches_initial_no_implied_modes(InstA, InstB, Type, !ModuleInfo, !Sub) :- + Info0 = (init_inst_match_info(!.ModuleInfo) + ^ calculate_sub := forward) + ^ maybe_sub := yes(!.Sub), inst_matches_final_2(InstA, InstB, yes(Type), Info0, Info), - ModuleInfo = Info ^ module_info, - yes(Sub) = Info ^ maybe_sub. + !:ModuleInfo = Info ^ module_info, + yes(!:Sub) = Info ^ maybe_sub. -:- pred inst_matches_initial_1(inst, inst, type, module_info, module_info, - maybe(inst_var_sub), maybe(inst_var_sub)). -:- mode inst_matches_initial_1(in, in, in, in, out, in, out) is semidet. +:- pred inst_matches_initial_1((inst)::in, (inst)::in, (type)::in, + module_info::in, module_info::out, + maybe(inst_var_sub)::in, maybe(inst_var_sub)::out) is semidet. -inst_matches_initial_1(InstA, InstB, Type, ModuleInfo0, ModuleInfo, - MaybeSub0, MaybeSub) :- - Info0 = (init_inst_match_info(ModuleInfo0) - ^ maybe_sub := MaybeSub0) - ^ calculate_sub := forward, +inst_matches_initial_1(InstA, InstB, Type, !ModuleInfo, !MaybeSub) :- + Info0 = (init_inst_match_info(!.ModuleInfo) + ^ maybe_sub := !.MaybeSub) + ^ calculate_sub := forward, inst_matches_initial_2(InstA, InstB, yes(Type), Info0, Info), - ModuleInfo = Info^module_info, - MaybeSub = Info ^ maybe_sub. + !:ModuleInfo = Info ^ module_info, + !:MaybeSub = Info ^ maybe_sub. :- type inst_match_inputs ---> inst_match_inputs(inst, inst, maybe(type)). :- type expansions == set(inst_match_inputs). @@ -423,18 +400,17 @@ sub(Info) = Sub :- :- func init_inst_match_info(module_info) = inst_match_info. init_inst_match_info(ModuleInfo) = - inst_match_info(ModuleInfo, Exp, no, none, match, yes) :- - set__init(Exp). + inst_match_info(ModuleInfo, set__init, no, none, match, yes). -:- pred swap_sub(pred(inst_match_info, inst_match_info), - inst_match_info, inst_match_info). -:- mode swap_sub(pred(in, out) is semidet, in, out) is semidet. +:- pred swap_sub( + pred(inst_match_info, inst_match_info)::in(pred(in, out) is semidet), + inst_match_info::in, inst_match_info::out) is semidet. -swap_sub(P, Info0, Info) :- - CalculateSub = Info0 ^ calculate_sub, - Info1 = Info0 ^ calculate_sub := swap_calculate_sub(CalculateSub), - P(Info1, Info2), - Info = Info2 ^ calculate_sub := CalculateSub. +swap_sub(P, !Info) :- + CalculateSub = !.Info ^ calculate_sub, + !:Info = !.Info ^ calculate_sub := swap_calculate_sub(CalculateSub), + P(!Info), + !:Info = !.Info ^ calculate_sub := CalculateSub. :- func swap_calculate_sub(calculate_sub) = calculate_sub. @@ -443,61 +419,60 @@ swap_calculate_sub(reverse) = forward. swap_calculate_sub(none) = none. :- type inst_matches_pred == - pred(inst, inst, maybe(type), inst_match_info, inst_match_info). + pred(inst, inst, maybe(type), inst_match_info, inst_match_info). :- inst inst_matches_pred == - (pred(in, in, in, in, out) is semidet). + (pred(in, in, in, in, out) is semidet). :- pred inst_matches_initial_2 `with_type` inst_matches_pred. :- mode inst_matches_initial_2 `with_inst` inst_matches_pred. -inst_matches_initial_2(InstA, InstB, MaybeType, Info0, Info) :- +inst_matches_initial_2(InstA, InstB, MaybeType, !Info) :- ThisExpansion = inst_match_inputs(InstA, InstB, MaybeType), - ( set__member(ThisExpansion, Info0^expansions) -> - Info = Info0 - + ( set__member(ThisExpansion, !.Info ^ expansions) -> + true ; - inst_expand(Info0^module_info, InstA, InstA2), - inst_expand(Info0^module_info, InstB, InstB2), - set__insert(Info0^expansions, ThisExpansion, Expansions1), + inst_expand(!.Info ^ module_info, InstA, InstA2), + inst_expand(!.Info ^ module_info, InstB, InstB2), + set__insert(!.Info ^ expansions, ThisExpansion, Expansions1), handle_inst_var_subs(inst_matches_initial_2, inst_matches_initial_4, InstA2, InstB2, MaybeType, - Info0^expansions := Expansions1, Info) + !.Info ^ expansions := Expansions1, !:Info) ). :- pred handle_inst_var_subs(inst_matches_pred, inst_matches_pred) `with_type` - inst_matches_pred. + inst_matches_pred. :- mode handle_inst_var_subs(in(inst_matches_pred), in(inst_matches_pred)) - `with_inst` inst_matches_pred. + `with_inst` inst_matches_pred. -handle_inst_var_subs(Recurse, Continue, InstA, InstB, Type, Info0, Info) :- - CalculateSub = Info0 ^ calculate_sub, +handle_inst_var_subs(Recurse, Continue, InstA, InstB, Type, !Info) :- + CalculateSub = !.Info ^ calculate_sub, ( CalculateSub = forward, handle_inst_var_subs_2(Recurse, Continue, InstA, InstB, - Type, Info0, Info) + Type, !Info) ; CalculateSub = reverse, handle_inst_var_subs_2(swap_args(Recurse), swap_args(Continue), - InstB, InstA, Type, Info0, Info) + InstB, InstA, Type, !Info) ; CalculateSub = none, - Continue(InstA, InstB, Type, Info0, Info) + Continue(InstA, InstB, Type, !Info) ). -:- pred handle_inst_var_subs_2(inst_matches_pred, inst_matches_pred) `with_type` - inst_matches_pred. +:- pred handle_inst_var_subs_2(inst_matches_pred, inst_matches_pred) + `with_type` inst_matches_pred. :- mode handle_inst_var_subs_2(in(inst_matches_pred), in(inst_matches_pred)) - `with_inst` inst_matches_pred. + `with_inst` inst_matches_pred. -handle_inst_var_subs_2(Recurse, Continue, InstA, InstB, Type, Info0, Info) :- +handle_inst_var_subs_2(Recurse, Continue, InstA, InstB, Type, !Info) :- ( InstB = constrained_inst_vars(InstVarsB, InstB1) -> % InstB is a constrained_inst_var with upper bound InstB1. % We need to check that InstA matches_initial InstB1 and add the % appropriate inst_var substitution. - Recurse(InstA, InstB1, Type, Info0, Info1), + Recurse(InstA, InstB1, Type, !Info), - ModuleInfo0 = Info1^module_info, + ModuleInfo0 = !.Info ^ module_info, % Call abstractly_unify_inst to calculate the uniqueness of the % inst represented by the constrained_inst_var. @@ -505,20 +480,20 @@ handle_inst_var_subs_2(Recurse, Continue, InstA, InstB, Type, Info0, Info) :- % abstractly_unify(unique, unique) = unique, not shared. Live = dead, abstractly_unify_inst(Live, InstA, InstB1, fake_unify, - ModuleInfo0, Inst, _Det, ModuleInfo1), - Info2 = Info1 ^ module_info := ModuleInfo1, - update_inst_var_sub(InstVarsB, Inst, Type, Info2, Info) + Inst, _Det, ModuleInfo0, ModuleInfo), + !:Info = !.Info ^ module_info := ModuleInfo, + update_inst_var_sub(InstVarsB, Inst, Type, !Info) ; InstA = constrained_inst_vars(_InstVarsA, InstA1) -> - Recurse(InstA1, InstB, Type, Info0, Info) + Recurse(InstA1, InstB, Type, !Info) ; - Continue(InstA, InstB, Type, Info0, Info) + Continue(InstA, InstB, Type, !Info) ). :- pred swap_args(inst_matches_pred) `with_type` inst_matches_pred. :- mode swap_args(in(inst_matches_pred)) `with_inst` inst_matches_pred. -swap_args(P, InstA, InstB, Type, Info0, Info) :- - P(InstB, InstA, Type, Info0, Info). +swap_args(P, InstA, InstB, Type, !Info) :- + P(InstB, InstA, Type, !Info). :- pred inst_matches_initial_4 `with_type` inst_matches_pred. :- mode inst_matches_initial_4 `with_inst` inst_matches_pred. @@ -527,111 +502,109 @@ swap_args(P, InstA, InstB, Type, Info0, Info) :- % inst_matches_initial is true for any pairs of insts which % occur in `Expansions'. -inst_matches_initial_4(any(UniqA), any(UniqB), _, I, I) :- - I ^ any_matches_any = yes, - compare_uniqueness(I ^ uniqueness_comparison, UniqA, UniqB). -inst_matches_initial_4(any(_), free, _, I, I). -inst_matches_initial_4(any(UniqA), ground(_, _)@InstB, Type, Info0, Info) :- - maybe_any_to_bound(Type, Info0 ^ module_info, UniqA, InstA), - inst_matches_initial_2(InstA, InstB, Type, Info0, Info). -inst_matches_initial_4(any(UniqA), bound(_, _)@InstB, Type, Info0, Info) :- - maybe_any_to_bound(Type, Info0 ^ module_info, UniqA, InstA), - inst_matches_initial_2(InstA, InstB, Type, Info0, Info). -inst_matches_initial_4(free, any(_), _, I, I). -inst_matches_initial_4(free, free, _, I, I). -inst_matches_initial_4(bound(UniqA, ListA), any(UniqB), _, Info, Info) :- - compare_uniqueness(Info ^ uniqueness_comparison, UniqA, UniqB), - compare_bound_inst_list_uniq(Info ^ uniqueness_comparison, - ListA, UniqB, Info^module_info). -inst_matches_initial_4(bound(_Uniq, _List), free, _, I, I). +inst_matches_initial_4(any(UniqA), any(UniqB), _, !Info) :- + !.Info ^ any_matches_any = yes, + compare_uniqueness(!.Info ^ uniqueness_comparison, UniqA, UniqB). +inst_matches_initial_4(any(_), free, _, !Info). +inst_matches_initial_4(any(UniqA), ground(_, _)@InstB, Type, !Info) :- + maybe_any_to_bound(Type, !.Info ^ module_info, UniqA, InstA), + inst_matches_initial_2(InstA, InstB, Type, !Info). +inst_matches_initial_4(any(UniqA), bound(_, _)@InstB, Type, !Info) :- + maybe_any_to_bound(Type, !.Info ^ module_info, UniqA, InstA), + inst_matches_initial_2(InstA, InstB, Type, !Info). +inst_matches_initial_4(free, any(_), _, !Info). +inst_matches_initial_4(free, free, _, !Info). +inst_matches_initial_4(bound(UniqA, ListA), any(UniqB), _, !Info) :- + compare_uniqueness(!.Info ^ uniqueness_comparison, UniqA, UniqB), + compare_bound_inst_list_uniq(!.Info ^ uniqueness_comparison, + ListA, UniqB, !.Info ^ module_info). +inst_matches_initial_4(bound(_Uniq, _List), free, _, !Info). inst_matches_initial_4(bound(UniqA, ListA), bound(UniqB, ListB), Type, - Info0, Info) :- - compare_uniqueness(Info0 ^ uniqueness_comparison, UniqA, UniqB), - bound_inst_list_matches_initial(ListA, ListB, Type, Info0, Info). + !Info) :- + compare_uniqueness(!.Info ^ uniqueness_comparison, UniqA, UniqB), + bound_inst_list_matches_initial(ListA, ListB, Type, !Info). inst_matches_initial_4(bound(UniqA, ListA), ground(UniqB, none), Type, - Info, Info) :- - compare_uniqueness(Info ^ uniqueness_comparison, UniqA, UniqB), - bound_inst_list_is_ground(ListA, Type, Info^module_info), - compare_bound_inst_list_uniq(Info ^ uniqueness_comparison, - ListA, UniqB, Info^module_info). -inst_matches_initial_4(bound(Uniq, List), abstract_inst(_,_), _, Info, Info) :- + !Info) :- + compare_uniqueness(!.Info ^ uniqueness_comparison, UniqA, UniqB), + bound_inst_list_is_ground(ListA, Type, !.Info ^ module_info), + compare_bound_inst_list_uniq(!.Info ^ uniqueness_comparison, + ListA, UniqB, !.Info ^ module_info). +inst_matches_initial_4(bound(Uniq, List), abstract_inst(_,_), _, !Info) :- Uniq = unique, - bound_inst_list_is_ground(List, Info^module_info), - bound_inst_list_is_unique(List, Info^module_info). -inst_matches_initial_4(bound(Uniq, List), abstract_inst(_,_), _, Info, Info) :- + bound_inst_list_is_ground(List, !.Info ^ module_info), + bound_inst_list_is_unique(List, !.Info ^ module_info). +inst_matches_initial_4(bound(Uniq, List), abstract_inst(_,_), _, !Info) :- Uniq = mostly_unique, - bound_inst_list_is_ground(List, Info^module_info), - bound_inst_list_is_mostly_unique(List, Info^module_info). -inst_matches_initial_4(ground(UniqA, GroundInstInfoA), any(UniqB), _, - Info, Info) :- + bound_inst_list_is_ground(List, !.Info ^ module_info), + bound_inst_list_is_mostly_unique(List, !.Info ^ module_info). +inst_matches_initial_4(ground(UniqA, GroundInstInfoA), any(UniqB), _, !Info) :- \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoA, - Info^module_info), - compare_uniqueness(Info ^ uniqueness_comparison, UniqA, UniqB). -inst_matches_initial_4(ground(_Uniq, _PredInst), free, _, I, I). + !.Info ^ module_info), + compare_uniqueness(!.Info ^ uniqueness_comparison, UniqA, UniqB). +inst_matches_initial_4(ground(_Uniq, _PredInst), free, _, !Info). inst_matches_initial_4(ground(UniqA, _GII_A), bound(UniqB, ListB), MaybeType, - Info0, Info) :- + !Info) :- MaybeType = yes(Type), % We can only check this case properly if the type is known. - compare_uniqueness(Info0 ^ uniqueness_comparison, UniqA, UniqB), - bound_inst_list_is_complete_for_type(set__init, Info0^module_info, + compare_uniqueness(!.Info ^ uniqueness_comparison, UniqA, UniqB), + bound_inst_list_is_complete_for_type(set__init, !.Info ^ module_info, ListB, Type), ground_matches_initial_bound_inst_list(UniqA, ListB, yes(Type), - Info0, Info). + !Info). inst_matches_initial_4(ground(UniqA, GroundInstInfoA), - ground(UniqB, GroundInstInfoB), Type, Info0, Info) :- - compare_uniqueness(Info0 ^ uniqueness_comparison, UniqA, UniqB), + ground(UniqB, GroundInstInfoB), Type, !Info) :- + compare_uniqueness(!.Info ^ uniqueness_comparison, UniqA, UniqB), ground_inst_info_matches_initial(GroundInstInfoA, GroundInstInfoB, - UniqB, Type, Info0, Info). -inst_matches_initial_4(ground(_UniqA, none), abstract_inst(_,_),_,_,_) :- + UniqB, Type, !Info). +inst_matches_initial_4(ground(_UniqA, none), abstract_inst(_,_), _, !Info) :- % I don't know what this should do. % Abstract insts aren't really supported. error("inst_matches_initial(ground, abstract_inst) == ??"). -inst_matches_initial_4(abstract_inst(_,_), any(shared), _, I, I). -inst_matches_initial_4(abstract_inst(_,_), free, _, I, I). +inst_matches_initial_4(abstract_inst(_,_), any(shared), _, !Info). +inst_matches_initial_4(abstract_inst(_,_), free, _, !Info). inst_matches_initial_4(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB), - _Type, Info0, Info) :- + _Type, !Info) :- list__duplicate(length(ArgsA), no, MaybeTypes), % XXX how do we get the argument types for an abstract inst? - inst_list_matches_initial(ArgsA, ArgsB, MaybeTypes, Info0, Info). -inst_matches_initial_4(not_reached, _, _, I, I). + inst_list_matches_initial(ArgsA, ArgsB, MaybeTypes, !Info). +inst_matches_initial_4(not_reached, _, _, !Info). %-----------------------------------------------------------------------------% % This predicate assumes that the check of % `bound_inst_list_is_complete_for_type' is done by the caller. -:- pred ground_matches_initial_bound_inst_list(uniqueness, list(bound_inst), - maybe(type), inst_match_info, inst_match_info). -:- mode ground_matches_initial_bound_inst_list(in, in, in, in, out) is semidet. +:- pred ground_matches_initial_bound_inst_list(uniqueness::in, + list(bound_inst)::in, maybe(type)::in, + inst_match_info::in, inst_match_info::out) is semidet. -ground_matches_initial_bound_inst_list(_, [], _) --> []. +ground_matches_initial_bound_inst_list(_, [], _, !Info). ground_matches_initial_bound_inst_list(Uniq, [functor(ConsId, Args) | List], - MaybeType) --> - ModuleInfo0 =^ module_info, - { maybe_get_cons_id_arg_types(ModuleInfo0, MaybeType, ConsId, - list__length(Args), MaybeTypes) }, - ground_matches_initial_inst_list(Uniq, Args, MaybeTypes), - ground_matches_initial_bound_inst_list(Uniq, List, MaybeType). + MaybeType, !Info) :- + maybe_get_cons_id_arg_types(!.Info ^ module_info, MaybeType, ConsId, + list__length(Args), MaybeTypes), + ground_matches_initial_inst_list(Uniq, Args, MaybeTypes, !Info), + ground_matches_initial_bound_inst_list(Uniq, List, MaybeType, !Info). -:- pred ground_matches_initial_inst_list(uniqueness, list(inst), - list(maybe(type)), inst_match_info, inst_match_info). -:- mode ground_matches_initial_inst_list(in, in, in, in, out) is semidet. +:- pred ground_matches_initial_inst_list(uniqueness::in, list(inst)::in, + list(maybe(type))::in, inst_match_info::in, inst_match_info::out) + is semidet. -ground_matches_initial_inst_list(_, [], []) --> []. -ground_matches_initial_inst_list(Uniq, [Inst | Insts], [Type | Types]) --> - inst_matches_initial_2(ground(Uniq, none), Inst, Type), - ground_matches_initial_inst_list(Uniq, Insts, Types). +ground_matches_initial_inst_list(_, [], [], !Info). +ground_matches_initial_inst_list(Uniq, [Inst | Insts], [Type | Types], + !Info) :- + inst_matches_initial_2(ground(Uniq, none), Inst, Type, !Info), + ground_matches_initial_inst_list(Uniq, Insts, Types, !Info). %-----------------------------------------------------------------------------% % A list(bound_inst) is ``complete'' for a given type iff it % includes each functor of the type and each argument of each % functor is also ``complete'' for the type. -:- pred bound_inst_list_is_complete_for_type(set(inst_name), module_info, - list(bound_inst), type). -:- mode bound_inst_list_is_complete_for_type(in, in, in, in) is semidet. +:- pred bound_inst_list_is_complete_for_type(set(inst_name)::in, + module_info::in, list(bound_inst)::in, (type)::in) is semidet. -bound_inst_list_is_complete_for_type(Expansions, ModuleInfo, BoundInsts, Type) - :- +bound_inst_list_is_complete_for_type(Expansions, ModuleInfo, BoundInsts, + Type) :- % Is this a type for which cons_ids are recorded in the type_table? type_util__cons_id_arg_types(ModuleInfo, Type, _, _), @@ -651,8 +624,8 @@ bound_inst_list_is_complete_for_type(Expansions, ModuleInfo, BoundInsts, Type) ) ). -:- pred inst_is_complete_for_type(set(inst_name), module_info, inst, type). -:- mode inst_is_complete_for_type(in, in, in, in) is semidet. +:- pred inst_is_complete_for_type(set(inst_name)::in, module_info::in, + (inst)::in, (type)::in) is semidet. inst_is_complete_for_type(Expansions, ModuleInfo, Inst, Type) :- ( Inst = defined_inst(Name) -> @@ -672,8 +645,7 @@ inst_is_complete_for_type(Expansions, ModuleInfo, Inst, Type) :- % Check that two cons_ids are the same, except that one may be less % module qualified than the other. -:- pred equivalent_cons_ids(cons_id, cons_id). -:- mode equivalent_cons_ids(in, in) is semidet. +:- pred equivalent_cons_ids(cons_id::in, cons_id::in) is semidet. equivalent_cons_ids(ConsIdA, ConsIdB) :- ( @@ -686,8 +658,7 @@ equivalent_cons_ids(ConsIdA, ConsIdB) :- ConsIdA = ConsIdB ). -:- pred equivalent_sym_names(sym_name, sym_name). -:- mode equivalent_sym_names(in, in) is semidet. +:- pred equivalent_sym_names(sym_name::in, sym_name::in) is semidet. equivalent_sym_names(unqualified(S), unqualified(S)). equivalent_sym_names(qualified(_, S), unqualified(S)). @@ -700,56 +671,61 @@ equivalent_sym_names(qualified(QualA, S), qualified(QualB, S)) :- % Update the inst_var_sub that is computed by inst_matches_initial. % The inst_var_sub records what inst should be substituted for each % inst_var that occurs in the called procedure's argument modes. -:- pred update_inst_var_sub(set(inst_var), inst, maybe(type), inst_match_info, - inst_match_info). -:- mode update_inst_var_sub(in, in, in, in, out) is semidet. +:- pred update_inst_var_sub(set(inst_var)::in, (inst)::in, maybe(type)::in, + inst_match_info::in, inst_match_info::out) is semidet. -update_inst_var_sub(InstVars, InstA, MaybeType) --> - ( yes(_) =^ maybe_sub -> - set__fold((pred(InstVar::in, in, out) is semidet --> - ( InstB =^ sub ^ elem(InstVar) -> - % If InstVar already has an inst associated with - % it, merge the old inst and the new inst. Fail - % if this merge is not possible. - M0 =^ module_info, - { inst_merge(InstA, InstB, MaybeType, M0, - Inst, M) }, - ^ module_info := M, - ^ sub ^ elem(InstVar) := Inst - ; - ^ sub ^ elem(InstVar) := InstA - )), InstVars) +update_inst_var_sub(InstVars, InstA, MaybeType, !Info) :- + ( + !.Info ^ maybe_sub = yes(_), + set__fold(update_inst_var_sub_2(InstA, MaybeType), + InstVars, !Info) ; - [] + !.Info ^ maybe_sub = no + ). + +:- pred update_inst_var_sub_2((inst)::in, maybe(type)::in, inst_var::in, + inst_match_info::in, inst_match_info::out) is semidet. + +update_inst_var_sub_2(InstA, MaybeType, InstVar, !Info) :- + ( InstB = !.Info ^ sub ^ elem(InstVar) -> + % If InstVar already has an inst associated with + % it, merge the old inst and the new inst. Fail + % if this merge is not possible. + ModuleInfo0 = !.Info ^ module_info, + inst_merge(InstA, InstB, MaybeType, Inst, + ModuleInfo0, ModuleInfo), + !:Info = !.Info ^ module_info := ModuleInfo, + !:Info = !.Info ^ sub ^ elem(InstVar) := Inst + ; + !:Info = !.Info ^ sub ^ elem(InstVar) := InstA ). %-----------------------------------------------------------------------------% % This predicate checks if two ground_inst_infos match_initial. % It does not check uniqueness. -:- pred ground_inst_info_matches_initial(ground_inst_info, ground_inst_info, - uniqueness, maybe(type), inst_match_info, inst_match_info). -:- mode ground_inst_info_matches_initial(in, in, in, in, in, out) is semidet. +:- pred ground_inst_info_matches_initial(ground_inst_info::in, + ground_inst_info::in, uniqueness::in, maybe(type)::in, + inst_match_info::in, inst_match_info::out) is semidet. -ground_inst_info_matches_initial(GroundInstInfoA, none, _, _) --> - ModuleInfo =^ module_info, - { \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoA, - ModuleInfo) }. -ground_inst_info_matches_initial(none, higher_order(PredInstB), _, Type) --> - { PredInstB = pred_inst_info(function, ArgModes, _Det) }, - { Arity = list__length(ArgModes) }, - { PredInstA = pred_inst_info_standard_func_mode(Arity) }, - pred_inst_matches_2(PredInstA, PredInstB, Type). +ground_inst_info_matches_initial(GroundInstInfoA, none, _, _, !Info) :- + \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoA, + !.Info ^ module_info). +ground_inst_info_matches_initial(none, higher_order(PredInstB), _, Type, + !Info) :- + PredInstB = pred_inst_info(function, ArgModes, _Det), + Arity = list__length(ArgModes), + PredInstA = pred_inst_info_standard_func_mode(Arity), + pred_inst_matches_2(PredInstA, PredInstB, Type, !Info). ground_inst_info_matches_initial(higher_order(PredInstA), - higher_order(PredInstB), _, MaybeType) --> - pred_inst_matches_2(PredInstA, PredInstB, MaybeType). + higher_order(PredInstB), _, MaybeType, !Info) :- + pred_inst_matches_2(PredInstA, PredInstB, MaybeType, !Info). pred_inst_matches(PredInstA, PredInstB, ModuleInfo) :- pred_inst_matches_1(PredInstA, PredInstB, no, ModuleInfo). -:- pred pred_inst_matches_1(pred_inst_info, pred_inst_info, maybe(type), - module_info). -:- mode pred_inst_matches_1(in, in, in, in) is semidet. +:- pred pred_inst_matches_1(pred_inst_info::in, pred_inst_info::in, + maybe(type)::in, module_info::in) is semidet. pred_inst_matches_1(PredInstA, PredInstB, MaybeType, ModuleInfo) :- Info0 = init_inst_match_info(ModuleInfo), @@ -759,48 +735,46 @@ pred_inst_matches_1(PredInstA, PredInstB, MaybeType, ModuleInfo) :- % % Same as pred_inst_matches/3, except that it updates % the inst_var_sub in the inst_match_info, and that any - % inst pairs in Info0^expansions are assumed to + % inst pairs in Info0 ^ expansions are assumed to % match_final each other. % (This avoids infinite loops when calling inst_matches_final % on higher-order recursive insts.) % -:- pred pred_inst_matches_2(pred_inst_info, pred_inst_info, maybe(type), - inst_match_info, inst_match_info). -:- mode pred_inst_matches_2(in, in, in, in, out) is semidet. +:- pred pred_inst_matches_2(pred_inst_info::in, pred_inst_info::in, + maybe(type)::in, inst_match_info::in, inst_match_info::out) is semidet. pred_inst_matches_2(pred_inst_info(PredOrFunc, ModesA, Det), - pred_inst_info(PredOrFunc, ModesB, Det), - MaybeType) --> - { maybe_get_higher_order_arg_types(MaybeType, length(ModesA), - MaybeTypes) }, - pred_inst_argmodes_matches(ModesA, ModesB, MaybeTypes). + pred_inst_info(PredOrFunc, ModesB, Det), MaybeType, !Info) :- + maybe_get_higher_order_arg_types(MaybeType, length(ModesA), + MaybeTypes), + pred_inst_argmodes_matches(ModesA, ModesB, MaybeTypes, !Info). - % pred_inst_argmodes_matches(ModesA, ModesB, Info0, Info): + % pred_inst_argmodes_matches(ModesA, ModesB, !Info): % % succeeds if the initial insts of ModesB specify at least as % much information as, and the same binding as, the initial % insts of ModesA; and the final insts of ModesA specify at % least as much information as, and the same binding as, the - % final insts of ModesB. Any inst pairs in Inst0^expansions + % final insts of ModesB. Any inst pairs in Inst0 ^ expansions % are assumed to match_final each other. % % (In other words, as far as subtyping goes it is contravariant in % the initial insts, and covariant in the final insts; % as far as binding goes, it is invariant for both.) % -:- pred pred_inst_argmodes_matches(list(mode), list(mode), list(maybe(type)), - inst_match_info, inst_match_info). -:- mode pred_inst_argmodes_matches(in, in, in, in, out) is semidet. +:- pred pred_inst_argmodes_matches(list(mode)::in, list(mode)::in, + list(maybe(type))::in, inst_match_info::in, inst_match_info::out) + is semidet. -pred_inst_argmodes_matches([], [], []) --> []. -pred_inst_argmodes_matches([ModeA|ModeAs], [ModeB|ModeBs], - [MaybeType | MaybeTypes]) --> - ModuleInfo =^ module_info, - { mode_get_insts(ModuleInfo, ModeA, InitialA, FinalA) }, - { mode_get_insts(ModuleInfo, ModeB, InitialB, FinalB) }, - swap_sub(inst_matches_final_2(InitialB, InitialA, MaybeType)), - inst_matches_final_2(FinalA, FinalB, MaybeType), - pred_inst_argmodes_matches(ModeAs, ModeBs, MaybeTypes). +pred_inst_argmodes_matches([], [], [], !Info). +pred_inst_argmodes_matches([ModeA | ModeAs], [ModeB | ModeBs], + [MaybeType | MaybeTypes], !Info) :- + ModuleInfo = !.Info ^ module_info, + mode_get_insts(ModuleInfo, ModeA, InitialA, FinalA), + mode_get_insts(ModuleInfo, ModeB, InitialB, FinalB), + swap_sub(inst_matches_final_2(InitialB, InitialA, MaybeType), !Info), + inst_matches_final_2(FinalA, FinalB, MaybeType, !Info), + pred_inst_argmodes_matches(ModeAs, ModeBs, MaybeTypes, !Info). %-----------------------------------------------------------------------------% @@ -812,8 +786,8 @@ pred_inst_argmodes_matches([ModeA|ModeAs], [ModeB|ModeBs], % is the reverse of when we are doing a match so call % unique_matches_initial with the arguments reversed. -:- pred compare_uniqueness(uniqueness_comparison, uniqueness, uniqueness). -:- mode compare_uniqueness(in, in, in) is semidet. +:- pred compare_uniqueness(uniqueness_comparison::in, + uniqueness::in, uniqueness::in) is semidet. compare_uniqueness(match, InstA, InstB) :- unique_matches_initial(InstA, InstB). @@ -837,18 +811,16 @@ unique_matches_final(A, B) :- %-----------------------------------------------------------------------------% -:- pred compare_bound_inst_list_uniq(uniqueness_comparison, list(bound_inst), - uniqueness, module_info). -:- mode compare_bound_inst_list_uniq(in, in, in, in) is semidet. +:- pred compare_bound_inst_list_uniq(uniqueness_comparison::in, + list(bound_inst)::in, uniqueness::in, module_info::in) is semidet. compare_bound_inst_list_uniq(match, List, Uniq, ModuleInfo) :- bound_inst_list_matches_uniq(List, Uniq, ModuleInfo). compare_bound_inst_list_uniq(instantiated, List, Uniq, ModuleInfo) :- uniq_matches_bound_inst_list(Uniq, List, ModuleInfo). -:- pred bound_inst_list_matches_uniq(list(bound_inst), uniqueness, - module_info). -:- mode bound_inst_list_matches_uniq(in, in, in) is semidet. +:- pred bound_inst_list_matches_uniq(list(bound_inst)::in, uniqueness::in, + module_info::in) is semidet. bound_inst_list_matches_uniq(List, Uniq, ModuleInfo) :- ( Uniq = unique -> @@ -859,9 +831,8 @@ bound_inst_list_matches_uniq(List, Uniq, ModuleInfo) :- true ). -:- pred uniq_matches_bound_inst_list(uniqueness, list(bound_inst), - module_info). -:- mode uniq_matches_bound_inst_list(in, in, in) is semidet. +:- pred uniq_matches_bound_inst_list(uniqueness::in, list(bound_inst)::in, + module_info::in) is semidet. uniq_matches_bound_inst_list(Uniq, List, ModuleInfo) :- ( Uniq = shared -> @@ -883,57 +854,56 @@ uniq_matches_bound_inst_list(Uniq, List, ModuleInfo) :- % The code here makes use of the fact that the bound_inst lists % are sorted. -:- pred bound_inst_list_matches_initial(list(bound_inst), list(bound_inst), - maybe(type), inst_match_info, inst_match_info). -:- mode bound_inst_list_matches_initial(in, in, in, in, out) is semidet. +:- pred bound_inst_list_matches_initial(list(bound_inst)::in, + list(bound_inst)::in, maybe(type)::in, + inst_match_info::in, inst_match_info::out) is semidet. -bound_inst_list_matches_initial([], _, _) --> []. -bound_inst_list_matches_initial([X|Xs], [Y|Ys], MaybeType) --> - { X = functor(ConsIdX, ArgsX) }, - { Y = functor(ConsIdY, ArgsY) }, - ( { ConsIdX = ConsIdY } -> - ModuleInfo =^ module_info, - { maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsIdX, - list__length(ArgsX), MaybeTypes) }, - inst_list_matches_initial(ArgsX, ArgsY, MaybeTypes), - bound_inst_list_matches_initial(Xs, Ys, MaybeType) +bound_inst_list_matches_initial([], _, _, !Info). +bound_inst_list_matches_initial([X | Xs], [Y | Ys], MaybeType, !Info) :- + X = functor(ConsIdX, ArgsX), + Y = functor(ConsIdY, ArgsY), + ( ConsIdX = ConsIdY -> + maybe_get_cons_id_arg_types(!.Info ^ module_info, MaybeType, + ConsIdX, list__length(ArgsX), MaybeTypes), + inst_list_matches_initial(ArgsX, ArgsY, MaybeTypes, !Info), + bound_inst_list_matches_initial(Xs, Ys, MaybeType, !Info) ; - { compare(>, ConsIdX, ConsIdY) }, - % ConsIdY does not occur in [X|Xs]. - % Hence [X|Xs] implicitly specifies `not_reached' + compare(>, ConsIdX, ConsIdY), + % ConsIdY does not occur in [X | Xs]. + % Hence [X | Xs] implicitly specifies `not_reached' % for the args of ConsIdY, and hence % automatically matches_initial Y. We just need to - % check that [X|Xs] matches_initial Ys. - bound_inst_list_matches_initial([X|Xs], Ys, MaybeType) + % check that [X | Xs] matches_initial Ys. + bound_inst_list_matches_initial([X | Xs], Ys, MaybeType, !Info) ). -:- pred inst_list_matches_initial(list(inst), list(inst), list(maybe(type)), - inst_match_info, inst_match_info). -:- mode inst_list_matches_initial(in, in, in, in, out) is semidet. +:- pred inst_list_matches_initial(list(inst)::in, list(inst)::in, + list(maybe(type))::in, inst_match_info::in, inst_match_info::out) + is semidet. -inst_list_matches_initial([], [], []) --> []. -inst_list_matches_initial([X|Xs], [Y|Ys], [Type | Types]) --> - inst_matches_initial_2(X, Y, Type), - inst_list_matches_initial(Xs, Ys, Types). +inst_list_matches_initial([], [], [], !Info). +inst_list_matches_initial([X | Xs], [Y | Ys], [Type | Types], !Info) :- + inst_matches_initial_2(X, Y, Type, !Info), + inst_list_matches_initial(Xs, Ys, Types, !Info). %-----------------------------------------------------------------------------% -inst_expand(ModuleInfo, Inst0, Inst) :- - ( Inst0 = defined_inst(InstName) -> - inst_lookup(ModuleInfo, InstName, Inst1), - inst_expand(ModuleInfo, Inst1, Inst) +inst_expand(ModuleInfo, !Inst) :- + ( !.Inst = defined_inst(InstName) -> + inst_lookup(ModuleInfo, InstName, !:Inst), + inst_expand(ModuleInfo, !Inst) ; - Inst = Inst0 + true ). -inst_expand_and_remove_constrained_inst_vars(ModuleInfo, Inst0, Inst) :- - ( Inst0 = defined_inst(InstName) -> - inst_lookup(ModuleInfo, InstName, Inst1), - inst_expand(ModuleInfo, Inst1, Inst) - ; Inst0 = constrained_inst_vars(_, Inst1) -> - inst_expand(ModuleInfo, Inst1, Inst) +inst_expand_and_remove_constrained_inst_vars(ModuleInfo, !Inst) :- + ( !.Inst = defined_inst(InstName) -> + inst_lookup(ModuleInfo, InstName, !:Inst), + inst_expand(ModuleInfo, !Inst) + ; !.Inst = constrained_inst_vars(_, !:Inst) -> + inst_expand(ModuleInfo, !Inst) ; - Inst = Inst0 + true ). %-----------------------------------------------------------------------------% @@ -949,72 +919,72 @@ inst_matches_final(InstA, InstB, Type, ModuleInfo) :- :- pred inst_matches_final_2 `with_type` inst_matches_pred. :- mode inst_matches_final_2 `with_inst` inst_matches_pred. -inst_matches_final_2(InstA, InstB, MaybeType, Info0, Info) :- +inst_matches_final_2(InstA, InstB, MaybeType, !Info) :- ThisExpansion = inst_match_inputs(InstA, InstB, MaybeType), - ( set__member(ThisExpansion, Info0^expansions) -> - Info = Info0 + ( set__member(ThisExpansion, !.Info ^ expansions) -> + true ; InstA = InstB -> - Info = Info0 + true ; - inst_expand(Info0^module_info, InstA, InstA2), - inst_expand(Info0^module_info, InstB, InstB2), - set__insert(Info0^expansions, ThisExpansion, Expansions1), - handle_inst_var_subs(inst_matches_final_2, inst_matches_final_3, - InstA2, InstB2, MaybeType, - Info0^expansions := Expansions1, Info) + inst_expand(!.Info ^ module_info, InstA, InstA2), + inst_expand(!.Info ^ module_info, InstB, InstB2), + set__insert(!.Info ^ expansions, ThisExpansion, Expansions1), + handle_inst_var_subs(inst_matches_final_2, + inst_matches_final_3, InstA2, InstB2, MaybeType, + !.Info ^ expansions := Expansions1, !:Info) ). :- pred inst_matches_final_3 `with_type` inst_matches_pred. :- mode inst_matches_final_3 `with_inst` inst_matches_pred. -inst_matches_final_3(any(UniqA), any(UniqB), _, I, I) :- +inst_matches_final_3(any(UniqA), any(UniqB), _, !Info) :- unique_matches_final(UniqA, UniqB). -inst_matches_final_3(any(UniqA), ground(_, _)@InstB, Type, Info0, Info) :- - maybe_any_to_bound(Type, Info0 ^ module_info, UniqA, InstA), - inst_matches_final_2(InstA, InstB, Type, Info0, Info). -inst_matches_final_3(any(UniqA), bound(_, _)@InstB, Type, Info0, Info) :- - maybe_any_to_bound(Type, Info0 ^ module_info, UniqA, InstA), - inst_matches_final_2(InstA, InstB, Type, Info0, Info). -inst_matches_final_3(free, any(Uniq), _, I, I) :- +inst_matches_final_3(any(UniqA), ground(_, _)@InstB, Type, !Info) :- + maybe_any_to_bound(Type, !.Info ^ module_info, UniqA, InstA), + inst_matches_final_2(InstA, InstB, Type, !Info). +inst_matches_final_3(any(UniqA), bound(_, _)@InstB, Type, !Info) :- + maybe_any_to_bound(Type, !.Info ^ module_info, UniqA, InstA), + inst_matches_final_2(InstA, InstB, Type, !Info). +inst_matches_final_3(free, any(Uniq), _, !Info) :- % We do not yet allow `free' to match `any', % unless the `any' is `clobbered_any' or `mostly_clobbered_any'. % Among other things, changing this would break compare_inst % in modecheck_call.m. ( Uniq = clobbered ; Uniq = mostly_clobbered ). -inst_matches_final_3(free, free, _, I, I). -inst_matches_final_3(bound(UniqA, ListA), any(UniqB), _, Info, Info) :- +inst_matches_final_3(free, free, _, !Info). +inst_matches_final_3(bound(UniqA, ListA), any(UniqB), _, !Info) :- unique_matches_final(UniqA, UniqB), - bound_inst_list_matches_uniq(ListA, UniqB, Info^module_info), + bound_inst_list_matches_uniq(ListA, UniqB, !.Info ^ module_info), % We do not yet allow `free' to match `any'. % Among other things, changing this would break compare_inst % in modecheck_call.m. - bound_inst_list_is_ground_or_any(ListA, Info^module_info). + bound_inst_list_is_ground_or_any(ListA, !.Info ^ module_info). inst_matches_final_3(bound(UniqA, ListA), bound(UniqB, ListB), MaybeType, - Info0, Info) :- + !Info) :- unique_matches_final(UniqA, UniqB), - bound_inst_list_matches_final(ListA, ListB, MaybeType, Info0, Info). + bound_inst_list_matches_final(ListA, ListB, MaybeType, !Info). inst_matches_final_3(bound(UniqA, ListA), ground(UniqB, none), Type, - Info, Info) :- + !Info) :- unique_matches_final(UniqA, UniqB), - bound_inst_list_is_ground(ListA, Type, Info^module_info), - bound_inst_list_matches_uniq(ListA, UniqB, Info^module_info). + bound_inst_list_is_ground(ListA, Type, !.Info ^ module_info), + bound_inst_list_matches_uniq(ListA, UniqB, !.Info ^ module_info). inst_matches_final_3(ground(UniqA, GroundInstInfoA), any(UniqB), _, - Info, Info) :- + !Info) :- \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoA, - Info^module_info), + !.Info ^ module_info), unique_matches_final(UniqA, UniqB). inst_matches_final_3(ground(UniqA, GroundInstInfoA), bound(UniqB, ListB), - MaybeType, Info, Info) :- + MaybeType, !Info) :- \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoA, - Info^module_info), + !.Info ^ module_info), unique_matches_final(UniqA, UniqB), - bound_inst_list_is_ground(ListB, MaybeType, Info^module_info), - uniq_matches_bound_inst_list(UniqA, ListB, Info^module_info), + bound_inst_list_is_ground(ListB, MaybeType, !.Info ^ module_info), + uniq_matches_bound_inst_list(UniqA, ListB, !.Info ^ module_info), ( MaybeType = yes(Type), % We can only do this check if the type is known. bound_inst_list_is_complete_for_type(set__init, - Info^module_info, ListB, Type) + !.Info ^ module_info, ListB, Type) ; true % XXX enabling the check for bound_inst_list_is_complete @@ -1023,53 +993,53 @@ inst_matches_final_3(ground(UniqA, GroundInstInfoA), bound(UniqB, ListB), % succeed, even if this check fails. ). inst_matches_final_3(ground(UniqA, GroundInstInfoA), - ground(UniqB, GroundInstInfoB), MaybeType, Info0, Info) :- + ground(UniqB, GroundInstInfoB), MaybeType, !Info) :- ground_inst_info_matches_final(GroundInstInfoA, GroundInstInfoB, - MaybeType, Info0, Info), + MaybeType, !Info), unique_matches_final(UniqA, UniqB). -inst_matches_final_3(abstract_inst(_, _), any(shared), _, I, I). +inst_matches_final_3(abstract_inst(_, _), any(shared), _, !Info). inst_matches_final_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB), - _MaybeType, Info0, Info) :- + _MaybeType, !Info) :- list__duplicate(length(ArgsA), no, MaybeTypes), % XXX how do we get the argument types for an abstract inst? - inst_list_matches_final(ArgsA, ArgsB, MaybeTypes, Info0, Info). -inst_matches_final_3(not_reached, _, _, I, I). + inst_list_matches_final(ArgsA, ArgsB, MaybeTypes, !Info). +inst_matches_final_3(not_reached, _, _, !Info). inst_matches_final_3(constrained_inst_vars(InstVarsA, InstA), InstB, MaybeType, - Info0, Info) :- + !Info) :- ( InstB = constrained_inst_vars(InstVarsB, InstB1) -> % Constrained_inst_vars match_final only if InstVarsA contains % all the variables in InstVarsB InstVarsB `set__subset` InstVarsA, - inst_matches_final_2(InstA, InstB1, MaybeType, Info0, Info) + inst_matches_final_2(InstA, InstB1, MaybeType, !Info) ; - inst_matches_final_2(InstA, InstB, MaybeType, Info0, Info) + inst_matches_final_2(InstA, InstB, MaybeType, !Info) ). -:- pred ground_inst_info_matches_final(ground_inst_info, ground_inst_info, - maybe(type), inst_match_info, inst_match_info). -:- mode ground_inst_info_matches_final(in, in, in, in, out) is semidet. +:- pred ground_inst_info_matches_final(ground_inst_info::in, + ground_inst_info::in, maybe(type)::in, + inst_match_info::in, inst_match_info::out) is semidet. -ground_inst_info_matches_final(GroundInstInfoA, none, _) --> - ModuleInfo =^ module_info, - { \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoA, - ModuleInfo) }. -ground_inst_info_matches_final(none, higher_order(PredInstB), Type) --> - { PredInstB = pred_inst_info(function, ArgModes, _Det) }, - { Arity = list__length(ArgModes) }, - { PredInstA = pred_inst_info_standard_func_mode(Arity) }, - pred_inst_matches_2(PredInstA, PredInstB, Type). +ground_inst_info_matches_final(GroundInstInfoA, none, _, !Info) :- + \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoA, + !.Info ^ module_info). +ground_inst_info_matches_final(none, higher_order(PredInstB), Type, !Info) :- + PredInstB = pred_inst_info(function, ArgModes, _Det), + Arity = list__length(ArgModes), + PredInstA = pred_inst_info_standard_func_mode(Arity), + pred_inst_matches_2(PredInstA, PredInstB, Type, !Info). ground_inst_info_matches_final(higher_order(PredInstA), - higher_order(PredInstB), MaybeType) --> - pred_inst_matches_2(PredInstA, PredInstB, MaybeType). + higher_order(PredInstB), MaybeType, !Info) :- + pred_inst_matches_2(PredInstA, PredInstB, MaybeType, !Info). -:- pred inst_list_matches_final(list(inst), list(inst), list(maybe(type)), - inst_match_info, inst_match_info). -:- mode inst_list_matches_final(in, in, in, in, out) is semidet. +:- pred inst_list_matches_final(list(inst)::in, list(inst)::in, + list(maybe(type))::in, inst_match_info::in, inst_match_info::out) + is semidet. -inst_list_matches_final([], [], []) --> []. -inst_list_matches_final([ArgA | ArgsA], [ArgB | ArgsB], [Type | Types]) --> - inst_matches_final_2(ArgA, ArgB, Type), - inst_list_matches_final(ArgsA, ArgsB, Types). +inst_list_matches_final([], [], [], !Info). +inst_list_matches_final([ArgA | ArgsA], [ArgB | ArgsB], [Type | Types], + !Info) :- + inst_matches_final_2(ArgA, ArgB, Type, !Info), + inst_list_matches_final(ArgsA, ArgsB, Types, !Info). % Here we check that the functors in the first list are a % subset of the functors in the second list. @@ -1080,39 +1050,37 @@ inst_list_matches_final([ArgA | ArgsA], [ArgB | ArgsB], [Type | Types]) --> % The code here makes use of the fact that the bound_inst lists % are sorted. -:- pred bound_inst_list_matches_final(list(bound_inst), list(bound_inst), - maybe(type), inst_match_info, inst_match_info). -:- mode bound_inst_list_matches_final(in, in, in, in, out) is semidet. +:- pred bound_inst_list_matches_final(list(bound_inst)::in, + list(bound_inst)::in, maybe(type)::in, + inst_match_info::in, inst_match_info::out) is semidet. -bound_inst_list_matches_final([], _, _) --> []. -bound_inst_list_matches_final([X|Xs], [Y|Ys], MaybeType) --> - { X = functor(ConsIdX, ArgsX) }, - { Y = functor(ConsIdY, ArgsY) }, - ( { ConsIdX = ConsIdY } -> - ModuleInfo =^ module_info, - { maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsIdX, - list__length(ArgsX), MaybeTypes) }, - inst_list_matches_final(ArgsX, ArgsY, MaybeTypes), - bound_inst_list_matches_final(Xs, Ys, MaybeType) +bound_inst_list_matches_final([], _, _, !Info). +bound_inst_list_matches_final([X | Xs], [Y | Ys], MaybeType, !Info) :- + X = functor(ConsIdX, ArgsX), + Y = functor(ConsIdY, ArgsY), + ( ConsIdX = ConsIdY -> + maybe_get_cons_id_arg_types(!.Info ^ module_info, MaybeType, + ConsIdX, list__length(ArgsX), MaybeTypes), + inst_list_matches_final(ArgsX, ArgsY, MaybeTypes, !Info), + bound_inst_list_matches_final(Xs, Ys, MaybeType, !Info) ; - { compare(>, ConsIdX, ConsIdY) }, - % ConsIdY does not occur in [X|Xs]. - % Hence [X|Xs] implicitly specifies `not_reached' + compare(>, ConsIdX, ConsIdY), + % ConsIdY does not occur in [X | Xs]. + % Hence [X | Xs] implicitly specifies `not_reached' % for the args of ConsIdY, and hence % automatically matches_final Y. We just need to - % check that [X|Xs] matches_final Ys. - bound_inst_list_matches_final([X|Xs], Ys, MaybeType) + % check that [X | Xs] matches_final Ys. + bound_inst_list_matches_final([X | Xs], Ys, MaybeType, !Info) ). inst_is_at_least_as_instantiated(InstA, InstB, Type, ModuleInfo) :- Info = (init_inst_match_info(ModuleInfo) - ^ uniqueness_comparison := instantiated) - ^ any_matches_any := no, + ^ uniqueness_comparison := instantiated) + ^ any_matches_any := no, inst_matches_initial_2(InstA, InstB, yes(Type), Info, _). inst_matches_binding(InstA, InstB, Type, ModuleInfo) :- - Info0 = init_inst_match_info(ModuleInfo) - ^ any_matches_any := no, + Info0 = init_inst_match_info(ModuleInfo) ^ any_matches_any := no, inst_matches_binding_2(InstA, InstB, yes(Type), Info0, _). inst_matches_binding_allow_any_any(InstA, InstB, Type, ModuleInfo) :- @@ -1122,18 +1090,18 @@ inst_matches_binding_allow_any_any(InstA, InstB, Type, ModuleInfo) :- :- pred inst_matches_binding_2 `with_type` inst_matches_pred. :- mode inst_matches_binding_2 `with_inst` inst_matches_pred. -inst_matches_binding_2(InstA, InstB, MaybeType, Info0, Info) :- +inst_matches_binding_2(InstA, InstB, MaybeType, !Info) :- ThisExpansion = inst_match_inputs(InstA, InstB, MaybeType), - ( set__member(ThisExpansion, Info0^expansions) -> - Info = Info0 + ( set__member(ThisExpansion, !.Info ^ expansions) -> + true ; - inst_expand_and_remove_constrained_inst_vars(Info0^module_info, - InstA, InstA2), - inst_expand_and_remove_constrained_inst_vars(Info0^module_info, - InstB, InstB2), - set__insert(Info0^expansions, ThisExpansion, Expansions1), + inst_expand_and_remove_constrained_inst_vars( + !.Info ^ module_info, InstA, InstA2), + inst_expand_and_remove_constrained_inst_vars( + !.Info ^ module_info, InstB, InstB2), + set__insert(!.Info ^ expansions, ThisExpansion, Expansions1), inst_matches_binding_3(InstA2, InstB2, MaybeType, - Info0^expansions := Expansions1, Info) + !.Info ^ expansions := Expansions1, !:Info) ). :- pred inst_matches_binding_3 `with_type` inst_matches_pred. @@ -1142,41 +1110,41 @@ inst_matches_binding_2(InstA, InstB, MaybeType, Info0, Info) :- % Note that `any' is *not* considered to match `any' unless % Info ^ any_matches_any = yes or the type is not a solver type (and does not % contain any solver types). -inst_matches_binding_3(free, free, _, I, I). -inst_matches_binding_3(any(UniqA), any(UniqB), Type, Info0, Info) :- - ( Info0 ^ any_matches_any = yes -> - Info = Info0 +inst_matches_binding_3(free, free, _, !Info). +inst_matches_binding_3(any(UniqA), any(UniqB), Type, !Info) :- + ( !.Info ^ any_matches_any = yes -> + true ; - maybe_any_to_bound(Type, Info0 ^ module_info, UniqA, InstA), - maybe_any_to_bound(Type, Info0 ^ module_info, UniqB, InstB), - inst_matches_binding_2(InstA, InstB, Type, Info0, Info) + maybe_any_to_bound(Type, !.Info ^ module_info, UniqA, InstA), + maybe_any_to_bound(Type, !.Info ^ module_info, UniqB, InstB), + inst_matches_binding_2(InstA, InstB, Type, !Info) ). -inst_matches_binding_3(any(UniqA), ground(_, _)@InstB, Type, Info0, Info) :- - maybe_any_to_bound(Type, Info0 ^ module_info, UniqA, InstA), - inst_matches_binding_2(InstA, InstB, Type, Info0, Info). -inst_matches_binding_3(any(UniqA), bound(_, _)@InstB, Type, Info0, Info) :- - maybe_any_to_bound(Type, Info0 ^ module_info, UniqA, InstA), - inst_matches_binding_2(InstA, InstB, Type, Info0, Info). -inst_matches_binding_3(ground(_, _)@InstA, any(UniqB), Type, Info0, Info) :- - maybe_any_to_bound(Type, Info0 ^ module_info, UniqB, InstB), - inst_matches_binding_2(InstA, InstB, Type, Info0, Info). -inst_matches_binding_3(bound(_, _)@InstA, any(UniqB), Type, Info0, Info) :- - maybe_any_to_bound(Type, Info0 ^ module_info, UniqB, InstB), - inst_matches_binding_2(InstA, InstB, Type, Info0, Info). +inst_matches_binding_3(any(UniqA), ground(_, _)@InstB, Type, !Info) :- + maybe_any_to_bound(Type, !.Info ^ module_info, UniqA, InstA), + inst_matches_binding_2(InstA, InstB, Type, !Info). +inst_matches_binding_3(any(UniqA), bound(_, _)@InstB, Type, !Info) :- + maybe_any_to_bound(Type, !.Info ^ module_info, UniqA, InstA), + inst_matches_binding_2(InstA, InstB, Type, !Info). +inst_matches_binding_3(ground(_, _)@InstA, any(UniqB), Type, !Info) :- + maybe_any_to_bound(Type, !.Info ^ module_info, UniqB, InstB), + inst_matches_binding_2(InstA, InstB, Type, !Info). +inst_matches_binding_3(bound(_, _)@InstA, any(UniqB), Type, !Info) :- + maybe_any_to_bound(Type, !.Info ^ module_info, UniqB, InstB), + inst_matches_binding_2(InstA, InstB, Type, !Info). inst_matches_binding_3(bound(_UniqA, ListA), bound(_UniqB, ListB), MaybeType, - Info0, Info) :- - bound_inst_list_matches_binding(ListA, ListB, MaybeType, Info0, Info). + !Info) :- + bound_inst_list_matches_binding(ListA, ListB, MaybeType, !Info). inst_matches_binding_3(bound(_UniqA, ListA), ground(_UniqB, none), Type, - Info, Info) :- - bound_inst_list_is_ground(ListA, Type, Info^module_info). + !Info) :- + bound_inst_list_is_ground(ListA, Type, !.Info ^ module_info). inst_matches_binding_3(ground(_UniqA, _), bound(_UniqB, ListB), MaybeType, - Info, Info) :- - bound_inst_list_is_ground(ListB, MaybeType, Info^module_info), + !Info) :- + bound_inst_list_is_ground(ListB, MaybeType, !.Info ^ module_info), ( MaybeType = yes(Type), % We can only do this check if the type is known. bound_inst_list_is_complete_for_type(set__init, - Info^module_info, ListB, Type) + !.Info ^ module_info, ListB, Type) ; true % XXX enabling the check for bound_inst_list_is_complete @@ -1185,19 +1153,18 @@ inst_matches_binding_3(ground(_UniqA, _), bound(_UniqB, ListB), MaybeType, % succeed, even if this check fails. ). inst_matches_binding_3(ground(_UniqA, GroundInstInfoA), - ground(_UniqB, GroundInstInfoB), MaybeType, Info, Info) :- + ground(_UniqB, GroundInstInfoB), MaybeType, !Info) :- ground_inst_info_matches_binding(GroundInstInfoA, GroundInstInfoB, - MaybeType, Info^module_info). + MaybeType, !.Info ^ module_info). inst_matches_binding_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB), - _MaybeType, Info0, Info) :- + _MaybeType, !Info) :- list__duplicate(length(ArgsA), no, MaybeTypes), % XXX how do we get the argument types for an abstract inst? - inst_list_matches_binding(ArgsA, ArgsB, MaybeTypes, Info0, Info). -inst_matches_binding_3(not_reached, _, _, I, I). + inst_list_matches_binding(ArgsA, ArgsB, MaybeTypes, !Info). +inst_matches_binding_3(not_reached, _, _, !Info). -:- pred ground_inst_info_matches_binding(ground_inst_info, ground_inst_info, - maybe(type), module_info). -:- mode ground_inst_info_matches_binding(in, in, in, in) is semidet. +:- pred ground_inst_info_matches_binding(ground_inst_info::in, + ground_inst_info::in, maybe(type)::in, module_info::in) is semidet. ground_inst_info_matches_binding(_, none, _, _). ground_inst_info_matches_binding(none, higher_order(PredInstB), MaybeType, @@ -1210,15 +1177,15 @@ ground_inst_info_matches_binding(higher_order(PredInstA), higher_order(PredInstB), MaybeType, ModuleInfo) :- pred_inst_matches_1(PredInstA, PredInstB, MaybeType, ModuleInfo). -:- pred inst_list_matches_binding(list(inst), list(inst), list(maybe(type)), - inst_match_info, inst_match_info). -:- mode inst_list_matches_binding(in, in, in, in, out) is semidet. +:- pred inst_list_matches_binding(list(inst)::in, list(inst)::in, + list(maybe(type))::in, inst_match_info::in, inst_match_info::out) + is semidet. -inst_list_matches_binding([], [], []) --> []. +inst_list_matches_binding([], [], [], !Info). inst_list_matches_binding([ArgA | ArgsA], [ArgB | ArgsB], - [MaybeType | MaybeTypes]) --> - inst_matches_binding_2(ArgA, ArgB, MaybeType), - inst_list_matches_binding(ArgsA, ArgsB, MaybeTypes). + [MaybeType | MaybeTypes], !Info) :- + inst_matches_binding_2(ArgA, ArgB, MaybeType, !Info), + inst_list_matches_binding(ArgsA, ArgsB, MaybeTypes, !Info). % Here we check that the functors in the first list are a % subset of the functors in the second list. @@ -1229,35 +1196,34 @@ inst_list_matches_binding([ArgA | ArgsA], [ArgB | ArgsB], % The code here makes use of the fact that the bound_inst lists % are sorted. -:- pred bound_inst_list_matches_binding(list(bound_inst), list(bound_inst), - maybe(type), inst_match_info, inst_match_info). -:- mode bound_inst_list_matches_binding(in, in, in, in, out) is semidet. +:- pred bound_inst_list_matches_binding(list(bound_inst)::in, + list(bound_inst)::in, maybe(type)::in, + inst_match_info::in, inst_match_info::out) is semidet. -bound_inst_list_matches_binding([], _, _) --> []. -bound_inst_list_matches_binding([X|Xs], [Y|Ys], MaybeType) --> - { X = functor(ConsIdX, ArgsX) }, - { Y = functor(ConsIdY, ArgsY) }, - ( { ConsIdX = ConsIdY } -> - ModuleInfo =^ module_info, - { maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsIdX, - list__length(ArgsX), MaybeTypes) }, - inst_list_matches_binding(ArgsX, ArgsY, MaybeTypes), - bound_inst_list_matches_binding(Xs, Ys, MaybeType) +bound_inst_list_matches_binding([], _, _, !Info). +bound_inst_list_matches_binding([X | Xs], [Y | Ys], MaybeType, !Info) :- + X = functor(ConsIdX, ArgsX), + Y = functor(ConsIdY, ArgsY), + ( ConsIdX = ConsIdY -> + maybe_get_cons_id_arg_types(!.Info ^ module_info, MaybeType, + ConsIdX, list__length(ArgsX), MaybeTypes), + inst_list_matches_binding(ArgsX, ArgsY, MaybeTypes, !Info), + bound_inst_list_matches_binding(Xs, Ys, MaybeType, !Info) ; - { compare(>, ConsIdX, ConsIdY) }, - % ConsIdX does not occur in [X|Xs]. - % Hence [X|Xs] implicitly specifies `not_reached' + compare(>, ConsIdX, ConsIdY), + % ConsIdX does not occur in [X | Xs]. + % Hence [X | Xs] implicitly specifies `not_reached' % for the args of ConsIdY, and hence % automatically matches_binding Y. We just need to - % check that [X|Xs] matches_binding Ys. - bound_inst_list_matches_binding([X|Xs], Ys, MaybeType) + % check that [X | Xs] matches_binding Ys. + bound_inst_list_matches_binding([X | Xs], Ys, MaybeType, !Info) ). %-----------------------------------------------------------------------------% - % inst_is_clobbered succeeds iff the inst passed is `clobbered' - % or `mostly_clobbered' or if it is a user-defined inst which - % is defined as one of those. + % inst_is_clobbered succeeds iff the inst passed is `clobbered' + % or `mostly_clobbered' or if it is a user-defined inst which + % is defined as one of those. inst_is_clobbered(_, not_reached) :- fail. inst_is_clobbered(_, any(mostly_clobbered)). @@ -1267,441 +1233,417 @@ inst_is_clobbered(_, ground(mostly_clobbered, _)). inst_is_clobbered(_, bound(clobbered, _)). inst_is_clobbered(_, bound(mostly_clobbered, _)). inst_is_clobbered(_, inst_var(_)) :- - error("internal error: uninstantiated inst parameter"). + error("internal error: uninstantiated inst parameter"). inst_is_clobbered(ModuleInfo, constrained_inst_vars(_, Inst)) :- inst_is_clobbered(ModuleInfo, Inst). inst_is_clobbered(ModuleInfo, defined_inst(InstName)) :- - inst_lookup(ModuleInfo, InstName, Inst), - inst_is_clobbered(ModuleInfo, Inst). + inst_lookup(ModuleInfo, InstName, Inst), + inst_is_clobbered(ModuleInfo, Inst). - % inst_is_free succeeds iff the inst passed is `free' - % or is a user-defined inst which is defined as `free'. - % Abstract insts must not be free. + % inst_is_free succeeds iff the inst passed is `free' + % or is a user-defined inst which is defined as `free'. + % Abstract insts must not be free. inst_is_free(_, free). inst_is_free(_, free(_Type)). inst_is_free(_, inst_var(_)) :- - error("internal error: uninstantiated inst parameter"). + error("internal error: uninstantiated inst parameter"). inst_is_free(ModuleInfo, constrained_inst_vars(_, Inst)) :- inst_is_free(ModuleInfo, Inst). inst_is_free(ModuleInfo, defined_inst(InstName)) :- - inst_lookup(ModuleInfo, InstName, Inst), - inst_is_free(ModuleInfo, Inst). + inst_lookup(ModuleInfo, InstName, Inst), + inst_is_free(ModuleInfo, Inst). inst_is_any(_, any(_)). inst_is_any(_, inst_var(_)) :- - error("internal error: uninstantiated inst parameter"). + error("internal error: uninstantiated inst parameter"). inst_is_any(ModuleInfo, constrained_inst_vars(_, Inst)) :- inst_is_any(ModuleInfo, Inst). inst_is_any(ModuleInfo, defined_inst(InstName)) :- - inst_lookup(ModuleInfo, InstName, Inst), - inst_is_any(ModuleInfo, Inst). + inst_lookup(ModuleInfo, InstName, Inst), + inst_is_any(ModuleInfo, Inst). - % inst_is_bound succeeds iff the inst passed is not `free' - % or is a user-defined inst which is not defined as `free'. - % Abstract insts must be bound. + % inst_is_bound succeeds iff the inst passed is not `free' + % or is a user-defined inst which is not defined as `free'. + % Abstract insts must be bound. inst_is_bound(_, not_reached). inst_is_bound(_, any(_)). inst_is_bound(_, ground(_, _)). inst_is_bound(_, bound(_, _)). inst_is_bound(_, inst_var(_)) :- - error("internal error: uninstantiated inst parameter"). + error("internal error: uninstantiated inst parameter"). inst_is_bound(ModuleInfo, constrained_inst_vars(_, Inst)) :- inst_is_bound(ModuleInfo, Inst). inst_is_bound(ModuleInfo, defined_inst(InstName)) :- - inst_lookup(ModuleInfo, InstName, Inst), - inst_is_bound(ModuleInfo, Inst). + inst_lookup(ModuleInfo, InstName, Inst), + inst_is_bound(ModuleInfo, Inst). inst_is_bound(_, abstract_inst(_, _)). - % inst_is_bound_to_functors succeeds iff the inst passed is - % `bound(_Uniq, Functors)' or is a user-defined inst which expands to - % `bound(_Uniq, Functors)'. + % inst_is_bound_to_functors succeeds iff the inst passed is + % `bound(_Uniq, Functors)' or is a user-defined inst which expands to + % `bound(_Uniq, Functors)'. inst_is_bound_to_functors(_, bound(_Uniq, Functors), Functors). inst_is_bound_to_functors(_, inst_var(_), _) :- - error("internal error: uninstantiated inst parameter"). + error("internal error: uninstantiated inst parameter"). inst_is_bound_to_functors(ModuleInfo, constrained_inst_vars(_, Inst), Functors) :- inst_is_bound_to_functors(ModuleInfo, Inst, Functors). inst_is_bound_to_functors(ModuleInfo, defined_inst(InstName), Functors) :- - inst_lookup(ModuleInfo, InstName, Inst), - inst_is_bound_to_functors(ModuleInfo, Inst, Functors). + inst_lookup(ModuleInfo, InstName, Inst), + inst_is_bound_to_functors(ModuleInfo, Inst, Functors). %-----------------------------------------------------------------------------% - % inst_is_ground succeeds iff the inst passed is `ground' - % or the equivalent. Abstract insts are not considered ground. + % inst_is_ground succeeds iff the inst passed is `ground' + % or the equivalent. Abstract insts are not considered ground. inst_is_ground(ModuleInfo, Inst) :- inst_is_ground(ModuleInfo, no, Inst). -:- pred inst_is_ground(module_info, maybe(type), inst). -:- mode inst_is_ground(in, in, in) is semidet. +:- pred inst_is_ground(module_info::in, maybe(type)::in, (inst)::in) + is semidet. inst_is_ground(ModuleInfo, MaybeType, Inst) :- - set__init(Expansions0), - inst_is_ground_1(ModuleInfo, MaybeType, Inst, Expansions0, _Expansions). - - % The third arg is the set of insts which have already - % been expanded - we use this to avoid going into an - % infinite loop. - -:- pred inst_is_ground_1(module_info, maybe(type), inst, set(inst), set(inst)). -:- mode inst_is_ground_1(in, in, in, in, out) is semidet. - -inst_is_ground_1(ModuleInfo, MaybeType, Inst, Expansions0, Expansions) :- - ( set__member(Inst, Expansions0) -> - Expansions = Expansions0 - ; - set__insert(Expansions0, Inst, Expansions1), - inst_is_ground_2(ModuleInfo, MaybeType, Inst, - Expansions1, Expansions) - ). - -:- pred inst_is_ground_2(module_info, maybe(type), inst, set(inst), set(inst)). -:- mode inst_is_ground_2(in, in, in, in, out) is semidet. - -inst_is_ground_2(_, _, not_reached, Expansions, Expansions). -inst_is_ground_2(ModuleInfo, MaybeType, bound(_, List), - Expansions0, Expansions) :- - bound_inst_list_is_ground_2(List, MaybeType, - ModuleInfo, Expansions0, Expansions). -inst_is_ground_2(_, _, ground(_, _), Expansions, Expansions). -inst_is_ground_2(_, _, inst_var(_), Expansions, Expansions) :- - error("internal error: uninstantiated inst parameter"). -inst_is_ground_2(ModuleInfo, MaybeType, Inst, Expansions0, Expansions) :- - Inst = constrained_inst_vars(_, Inst2), - inst_is_ground_1(ModuleInfo, MaybeType, Inst2, Expansions0, Expansions). -inst_is_ground_2(ModuleInfo, MaybeType, Inst, Expansions0, Expansions) :- - Inst = defined_inst(InstName), - inst_lookup(ModuleInfo, InstName, Inst2), - inst_is_ground_1(ModuleInfo, MaybeType, Inst2, Expansions0, Expansions). -inst_is_ground_2(ModuleInfo, MaybeType, any(Uniq), Expansions0, Expansions) :- - maybe_any_to_bound(MaybeType, ModuleInfo, Uniq, Inst), - inst_is_ground_1(ModuleInfo, MaybeType, Inst, Expansions0, Expansions). - - - % inst_is_ground_or_any succeeds iff the inst passed is `ground', - % `any', or the equivalent. Fails for abstract insts. - -inst_is_ground_or_any(ModuleInfo, Inst) :- - set__init(Expansions0), - inst_is_ground_or_any_2(ModuleInfo, Inst, Expansions0, _Expansions). - - % The third arg is the set of insts which have already - % been expanded - we use this to avoid going into an - % infinite loop. - -:- pred inst_is_ground_or_any_2(module_info, inst, set(inst), set(inst)). -:- mode inst_is_ground_or_any_2(in, in, in, out) is semidet. - -inst_is_ground_or_any_2(_, not_reached, Expansions, Expansions). -inst_is_ground_or_any_2(ModuleInfo, bound(_, List), Expansions0, Expansions) :- - bound_inst_list_is_ground_or_any_2(List, ModuleInfo, - Expansions0, Expansions). -inst_is_ground_or_any_2(_, ground(_, _), Expansions, Expansions). -inst_is_ground_or_any_2(_, any(_), Expansions, Expansions). -inst_is_ground_or_any_2(_, inst_var(_), _, _) :- - error("internal error: uninstantiated inst parameter"). -inst_is_ground_or_any_2(ModuleInfo, Inst, Expansions0, Expansions) :- - Inst = constrained_inst_vars(_, Inst2), - inst_is_ground_or_any_2(ModuleInfo, Inst2, Expansions0, Expansions). -inst_is_ground_or_any_2(ModuleInfo, Inst, Expansions0, Expansions) :- - Inst = defined_inst(InstName), - ( set__member(Inst, Expansions0) -> - Expansions = Expansions0 - ; - set__insert(Expansions0, Inst, Expansions1), - inst_lookup(ModuleInfo, InstName, Inst2), - inst_is_ground_or_any_2(ModuleInfo, Inst2, - Expansions1, Expansions) - ). - - % inst_is_unique succeeds iff the inst passed is unique - % or free. Abstract insts are not considered unique. - -inst_is_unique(ModuleInfo, Inst) :- - set__init(Expansions0), - inst_is_unique_2(ModuleInfo, Inst, Expansions0, _Expansions). - - % The third arg is the set of insts which have already - % been expanded - we use this to avoid going into an - % infinite loop. - -:- pred inst_is_unique_2(module_info, inst, set(inst), set(inst)). -:- mode inst_is_unique_2(in, in, in, out) is semidet. - -inst_is_unique_2(_, not_reached, Expansions, Expansions). -inst_is_unique_2(ModuleInfo, bound(unique, List), Expansions0, Expansions) :- - bound_inst_list_is_unique_2(List, ModuleInfo, Expansions0, Expansions). -inst_is_unique_2(_, any(unique), Expansions, Expansions). -inst_is_unique_2(_, free, Expansions, Expansions). -inst_is_unique_2(_, ground(unique, _), Expansions, Expansions). -inst_is_unique_2(_, inst_var(_), _, _) :- - error("internal error: uninstantiated inst parameter"). -inst_is_unique_2(ModuleInfo, Inst, Expansions0, Expansions) :- - Inst = constrained_inst_vars(_, Inst2), - inst_is_unique_2(ModuleInfo, Inst2, Expansions0, Expansions). -inst_is_unique_2(ModuleInfo, Inst, Expansions0, Expansions) :- - Inst = defined_inst(InstName), - ( set__member(Inst, Expansions0) -> - Expansions = Expansions0 - ; - set__insert(Expansions0, Inst, Expansions1), - inst_lookup(ModuleInfo, InstName, Inst2), - inst_is_unique_2(ModuleInfo, Inst2, Expansions1, Expansions) - ). - - % inst_is_mostly_unique succeeds iff the inst passed is unique, - % mostly_unique, or free. Abstract insts are not considered unique. - -inst_is_mostly_unique(ModuleInfo, Inst) :- - set__init(Expansions0), - inst_is_mostly_unique_2(ModuleInfo, Inst, Expansions0, _Expansions). - - % The third arg is the set of insts which have already - % been expanded - we use this to avoid going into an - % infinite loop. - -:- pred inst_is_mostly_unique_2(module_info, inst, set(inst), set(inst)). -:- mode inst_is_mostly_unique_2(in, in, in, out) is semidet. - -inst_is_mostly_unique_2(_, not_reached, Expansions, Expansions). -inst_is_mostly_unique_2(ModuleInfo, bound(unique, List), - Expansions0, Expansions) :- - bound_inst_list_is_mostly_unique_2(List, ModuleInfo, - Expansions0, Expansions). -inst_is_mostly_unique_2(ModuleInfo, bound(mostly_unique, List), - Expansions0, Expansions) :- - bound_inst_list_is_mostly_unique_2(List, ModuleInfo, - Expansions0, Expansions). -inst_is_mostly_unique_2(_, any(unique), Expansions, Expansions). -inst_is_mostly_unique_2(_, any(mostly_unique), Expansions, Expansions). -inst_is_mostly_unique_2(_, free, Expansions, Expansions). -inst_is_mostly_unique_2(_, ground(unique, _), Expansions, Expansions). -inst_is_mostly_unique_2(_, ground(mostly_unique, _), Expansions, Expansions). -inst_is_mostly_unique_2(_, inst_var(_), _, _) :- - error("internal error: uninstantiated inst parameter"). -inst_is_mostly_unique_2(ModuleInfo, Inst, Expansions0, Expansions) :- - Inst = constrained_inst_vars(_, Inst2), - inst_is_mostly_unique_2(ModuleInfo, Inst2, Expansions0, Expansions). -inst_is_mostly_unique_2(ModuleInfo, Inst, Expansions0, Expansions) :- - Inst = defined_inst(InstName), - ( set__member(Inst, Expansions0) -> - Expansions = Expansions0 - ; - set__insert(Expansions0, Inst, Expansions1), - inst_lookup(ModuleInfo, InstName, Inst2), - inst_is_mostly_unique_2(ModuleInfo, Inst2, - Expansions1, Expansions) - ). - - % inst_is_not_partly_unique succeeds iff the inst passed is - % not unique or mostly_unique, i.e. if it is shared - % or free. It fails for abstract insts. - -inst_is_not_partly_unique(ModuleInfo, Inst) :- - set__init(Expansions0), - inst_is_not_partly_unique_2(ModuleInfo, Inst, Expansions0, _Expansions). - - % The third arg is the set of insts which have already - % been expanded - we use this to avoid going into an - % infinite loop. - -:- pred inst_is_not_partly_unique_2(module_info, inst, set(inst), set(inst)). -:- mode inst_is_not_partly_unique_2(in, in, in, out) is semidet. - -inst_is_not_partly_unique_2(_, not_reached, Expansions, Expansions). -inst_is_not_partly_unique_2(ModuleInfo, bound(shared, List), - Expansions0, Expansions) :- - bound_inst_list_is_not_partly_unique_2(List, ModuleInfo, - Expansions0, Expansions). -inst_is_not_partly_unique_2(_, free, Expansions, Expansions). -inst_is_not_partly_unique_2(_, any(shared), Expansions, Expansions). -inst_is_not_partly_unique_2(_, ground(shared, _), Expansions, Expansions). -inst_is_not_partly_unique_2(_, inst_var(_), _, _) :- - error("internal error: uninstantiated inst parameter"). -inst_is_not_partly_unique_2(ModuleInfo, Inst, Expansions0, Expansions) :- - Inst = constrained_inst_vars(_, Inst2), - inst_is_not_partly_unique_2(ModuleInfo, Inst2, Expansions0, Expansions). -inst_is_not_partly_unique_2(ModuleInfo, Inst, Expansions0, Expansions) :- - Inst = defined_inst(InstName), - ( set__member(Inst, Expansions0) -> - Expansions = Expansions0 - ; - set__insert(Expansions0, Inst, Expansions1), - inst_lookup(ModuleInfo, InstName, Inst2), - inst_is_not_partly_unique_2(ModuleInfo, Inst2, - Expansions1, Expansions) - ). - - % inst_is_not_fully_unique succeeds iff the inst passed is - % not unique, i.e. if it is mostly_unique, shared, - % or free. It fails for abstract insts. - -inst_is_not_fully_unique(ModuleInfo, Inst) :- - set__init(Expansions0), - inst_is_not_fully_unique_2(ModuleInfo, Inst, + set__init(Expansions0), + inst_is_ground_1(ModuleInfo, MaybeType, Inst, Expansions0, _Expansions). - % The third arg is the set of insts which have already - % been expanded - we use this to avoid going into an - % infinite loop. + % The third arg is the set of insts which have already + % been expanded - we use this to avoid going into an + % infinite loop. -:- pred inst_is_not_fully_unique_2(module_info, inst, set(inst), set(inst)). -:- mode inst_is_not_fully_unique_2(in, in, in, out) is semidet. +:- pred inst_is_ground_1(module_info::in, maybe(type)::in, (inst)::in, + set(inst)::in, set(inst)::out) is semidet. -inst_is_not_fully_unique_2(_, not_reached, Expansions, Expansions). -inst_is_not_fully_unique_2(ModuleInfo, bound(shared, List), - Expansions0, Expansions) :- - bound_inst_list_is_not_fully_unique_2(List, ModuleInfo, - Expansions0, Expansions). -inst_is_not_fully_unique_2(ModuleInfo, bound(mostly_unique, List), - Expansions0, Expansions) :- - bound_inst_list_is_not_fully_unique_2(List, ModuleInfo, - Expansions0, Expansions). -inst_is_not_fully_unique_2(_, any(shared), Expansions, Expansions). -inst_is_not_fully_unique_2(_, any(mostly_unique), Expansions, Expansions). -inst_is_not_fully_unique_2(_, free, Expansions, Expansions). -inst_is_not_fully_unique_2(_, ground(shared, _), Expansions, Expansions). -inst_is_not_fully_unique_2(_, ground(mostly_unique, _), Expansions, Expansions). -inst_is_not_fully_unique_2(_, inst_var(_), _, _) :- - error("internal error: uninstantiated inst parameter"). -inst_is_not_fully_unique_2(ModuleInfo, Inst, Expansions0, Expansions) :- +inst_is_ground_1(ModuleInfo, MaybeType, Inst, !Expansions) :- + ( set__member(Inst, !.Expansions) -> + true + ; + svset__insert(Inst, !Expansions), + inst_is_ground_2(ModuleInfo, MaybeType, Inst, + !Expansions) + ). + +:- pred inst_is_ground_2(module_info::in, maybe(type)::in, (inst)::in, + set(inst)::in, set(inst)::out) is semidet. + +inst_is_ground_2(_, _, not_reached, !Expansions). +inst_is_ground_2(ModuleInfo, MaybeType, bound(_, List), !Expansions) :- + bound_inst_list_is_ground_2(List, MaybeType, ModuleInfo, !Expansions). +inst_is_ground_2(_, _, ground(_, _), !Expansions). +inst_is_ground_2(_, _, inst_var(_), !Expansions) :- + error("internal error: uninstantiated inst parameter"). +inst_is_ground_2(ModuleInfo, MaybeType, Inst, !Expansions) :- Inst = constrained_inst_vars(_, Inst2), - inst_is_not_fully_unique_2(ModuleInfo, Inst2, Expansions0, Expansions). -inst_is_not_fully_unique_2(ModuleInfo, Inst, Expansions0, Expansions) :- + inst_is_ground_1(ModuleInfo, MaybeType, Inst2, !Expansions). +inst_is_ground_2(ModuleInfo, MaybeType, Inst, !Expansions) :- Inst = defined_inst(InstName), - ( set__member(Inst, Expansions0) -> - Expansions = Expansions0 - ; - set__insert(Expansions0, Inst, Expansions1), - inst_lookup(ModuleInfo, InstName, Inst2), - inst_is_not_fully_unique_2(ModuleInfo, Inst2, - Expansions1, Expansions) - ). + inst_lookup(ModuleInfo, InstName, Inst2), + inst_is_ground_1(ModuleInfo, MaybeType, Inst2, !Expansions). +inst_is_ground_2(ModuleInfo, MaybeType, any(Uniq), !Expansions) :- + maybe_any_to_bound(MaybeType, ModuleInfo, Uniq, Inst), + inst_is_ground_1(ModuleInfo, MaybeType, Inst, !Expansions). + + % inst_is_ground_or_any succeeds iff the inst passed is `ground', + % `any', or the equivalent. Fails for abstract insts. + +inst_is_ground_or_any(ModuleInfo, Inst) :- + set__init(Expansions0), + inst_is_ground_or_any_2(ModuleInfo, Inst, Expansions0, _Expansions). + + % The third arg is the set of insts which have already + % been expanded - we use this to avoid going into an + % infinite loop. + +:- pred inst_is_ground_or_any_2(module_info::in, (inst)::in, + set(inst)::in, set(inst)::out) is semidet. + +inst_is_ground_or_any_2(_, not_reached, !Expansions). +inst_is_ground_or_any_2(ModuleInfo, bound(_, List), !Expansions) :- + bound_inst_list_is_ground_or_any_2(List, ModuleInfo, + !Expansions). +inst_is_ground_or_any_2(_, ground(_, _), !Expansions). +inst_is_ground_or_any_2(_, any(_), !Expansions). +inst_is_ground_or_any_2(_, inst_var(_), !Expansions) :- + error("internal error: uninstantiated inst parameter"). +inst_is_ground_or_any_2(ModuleInfo, Inst, !Expansions) :- + Inst = constrained_inst_vars(_, Inst2), + inst_is_ground_or_any_2(ModuleInfo, Inst2, !Expansions). +inst_is_ground_or_any_2(ModuleInfo, Inst, !Expansions) :- + Inst = defined_inst(InstName), + ( set__member(Inst, !.Expansions) -> + true + ; + svset__insert(Inst, !Expansions), + inst_lookup(ModuleInfo, InstName, Inst2), + inst_is_ground_or_any_2(ModuleInfo, Inst2, !Expansions) + ). + + % inst_is_unique succeeds iff the inst passed is unique + % or free. Abstract insts are not considered unique. + +inst_is_unique(ModuleInfo, Inst) :- + set__init(Expansions0), + inst_is_unique_2(ModuleInfo, Inst, Expansions0, _Expansions). + + % The third arg is the set of insts which have already + % been expanded - we use this to avoid going into an + % infinite loop. + +:- pred inst_is_unique_2(module_info::in, (inst)::in, + set(inst)::in, set(inst)::out) is semidet. + +inst_is_unique_2(_, not_reached, !Expansions). +inst_is_unique_2(ModuleInfo, bound(unique, List), !Expansions) :- + bound_inst_list_is_unique_2(List, ModuleInfo, !Expansions). +inst_is_unique_2(_, any(unique), !Expansions). +inst_is_unique_2(_, free, !Expansions). +inst_is_unique_2(_, ground(unique, _), !Expansions). +inst_is_unique_2(_, inst_var(_), !Expansions) :- + error("internal error: uninstantiated inst parameter"). +inst_is_unique_2(ModuleInfo, Inst, !Expansions) :- + Inst = constrained_inst_vars(_, Inst2), + inst_is_unique_2(ModuleInfo, Inst2, !Expansions). +inst_is_unique_2(ModuleInfo, Inst, !Expansions) :- + Inst = defined_inst(InstName), + ( set__member(Inst, !.Expansions) -> + true + ; + svset__insert(Inst, !Expansions), + inst_lookup(ModuleInfo, InstName, Inst2), + inst_is_unique_2(ModuleInfo, Inst2, !Expansions) + ). + + % inst_is_mostly_unique succeeds iff the inst passed is unique, + % mostly_unique, or free. Abstract insts are not considered unique. + +inst_is_mostly_unique(ModuleInfo, Inst) :- + set__init(Expansions0), + inst_is_mostly_unique_2(ModuleInfo, Inst, Expansions0, _Expansions). + + % The third arg is the set of insts which have already + % been expanded - we use this to avoid going into an + % infinite loop. + +:- pred inst_is_mostly_unique_2(module_info::in, (inst)::in, + set(inst)::in, set(inst)::out) is semidet. + +inst_is_mostly_unique_2(_, not_reached, !Expansions). +inst_is_mostly_unique_2(ModuleInfo, bound(unique, List), !Expansions) :- + bound_inst_list_is_mostly_unique_2(List, ModuleInfo, !Expansions). +inst_is_mostly_unique_2(ModuleInfo, bound(mostly_unique, List), !Expansions) :- + bound_inst_list_is_mostly_unique_2(List, ModuleInfo, !Expansions). +inst_is_mostly_unique_2(_, any(unique), !Expansions). +inst_is_mostly_unique_2(_, any(mostly_unique), !Expansions). +inst_is_mostly_unique_2(_, free, !Expansions). +inst_is_mostly_unique_2(_, ground(unique, _), !Expansions). +inst_is_mostly_unique_2(_, ground(mostly_unique, _), !Expansions). +inst_is_mostly_unique_2(_, inst_var(_), !Expansions) :- + error("internal error: uninstantiated inst parameter"). +inst_is_mostly_unique_2(ModuleInfo, Inst, !Expansions) :- + Inst = constrained_inst_vars(_, Inst2), + inst_is_mostly_unique_2(ModuleInfo, Inst2, !Expansions). +inst_is_mostly_unique_2(ModuleInfo, Inst, !Expansions) :- + Inst = defined_inst(InstName), + ( set__member(Inst, !.Expansions) -> + true + ; + svset__insert(Inst, !Expansions), + inst_lookup(ModuleInfo, InstName, Inst2), + inst_is_mostly_unique_2(ModuleInfo, Inst2, !Expansions) + ). + + % inst_is_not_partly_unique succeeds iff the inst passed is + % not unique or mostly_unique, i.e. if it is shared + % or free. It fails for abstract insts. + +inst_is_not_partly_unique(ModuleInfo, Inst) :- + set__init(Expansions0), + inst_is_not_partly_unique_2(ModuleInfo, Inst, + Expansions0, _Expansions). + + % The third arg is the set of insts which have already + % been expanded - we use this to avoid going into an + % infinite loop. + +:- pred inst_is_not_partly_unique_2(module_info::in, (inst)::in, + set(inst)::in, set(inst)::out) is semidet. + +inst_is_not_partly_unique_2(_, not_reached, !Expansions). +inst_is_not_partly_unique_2(ModuleInfo, bound(shared, List), !Expansions) :- + bound_inst_list_is_not_partly_unique_2(List, ModuleInfo, !Expansions). +inst_is_not_partly_unique_2(_, free, !Expansions). +inst_is_not_partly_unique_2(_, any(shared), !Expansions). +inst_is_not_partly_unique_2(_, ground(shared, _), !Expansions). +inst_is_not_partly_unique_2(_, inst_var(_), !Expansions) :- + error("internal error: uninstantiated inst parameter"). +inst_is_not_partly_unique_2(ModuleInfo, Inst, !Expansions) :- + Inst = constrained_inst_vars(_, Inst2), + inst_is_not_partly_unique_2(ModuleInfo, Inst2, !Expansions). +inst_is_not_partly_unique_2(ModuleInfo, Inst, !Expansions) :- + Inst = defined_inst(InstName), + ( set__member(Inst, !.Expansions) -> + true + ; + svset__insert(Inst, !Expansions), + inst_lookup(ModuleInfo, InstName, Inst2), + inst_is_not_partly_unique_2(ModuleInfo, Inst2, !Expansions) + ). + + % inst_is_not_fully_unique succeeds iff the inst passed is + % not unique, i.e. if it is mostly_unique, shared, + % or free. It fails for abstract insts. + +inst_is_not_fully_unique(ModuleInfo, Inst) :- + set__init(Expansions0), + inst_is_not_fully_unique_2(ModuleInfo, Inst, + Expansions0, _Expansions). + + % The third arg is the set of insts which have already + % been expanded - we use this to avoid going into an + % infinite loop. + +:- pred inst_is_not_fully_unique_2(module_info::in, (inst)::in, + set(inst)::in, set(inst)::out) is semidet. + +inst_is_not_fully_unique_2(_, not_reached, !Expansions). +inst_is_not_fully_unique_2(ModuleInfo, bound(shared, List), + !Expansions) :- + bound_inst_list_is_not_fully_unique_2(List, ModuleInfo, + !Expansions). +inst_is_not_fully_unique_2(ModuleInfo, bound(mostly_unique, List), + !Expansions) :- + bound_inst_list_is_not_fully_unique_2(List, ModuleInfo, + !Expansions). +inst_is_not_fully_unique_2(_, any(shared), !Expansions). +inst_is_not_fully_unique_2(_, any(mostly_unique), !Expansions). +inst_is_not_fully_unique_2(_, free, !Expansions). +inst_is_not_fully_unique_2(_, ground(shared, _), !Expansions). +inst_is_not_fully_unique_2(_, ground(mostly_unique, _), !Expansions). +inst_is_not_fully_unique_2(_, inst_var(_), _, _) :- + error("internal error: uninstantiated inst parameter"). +inst_is_not_fully_unique_2(ModuleInfo, Inst, !Expansions) :- + Inst = constrained_inst_vars(_, Inst2), + inst_is_not_fully_unique_2(ModuleInfo, Inst2, !Expansions). +inst_is_not_fully_unique_2(ModuleInfo, Inst, !Expansions) :- + Inst = defined_inst(InstName), + ( set__member(Inst, !.Expansions) -> + true + ; + svset__insert(Inst, !Expansions), + inst_lookup(ModuleInfo, InstName, Inst2), + inst_is_not_fully_unique_2(ModuleInfo, Inst2, !Expansions) + ). %-----------------------------------------------------------------------------% bound_inst_list_is_ground(BoundInsts, ModuleInfo) :- bound_inst_list_is_ground(BoundInsts, no, ModuleInfo). -:- pred bound_inst_list_is_ground(list(bound_inst), maybe(type), module_info). -:- mode bound_inst_list_is_ground(in, in, in) is semidet. +:- pred bound_inst_list_is_ground(list(bound_inst)::in, maybe(type)::in, + module_info::in) is semidet. bound_inst_list_is_ground([], _, _). -bound_inst_list_is_ground([functor(Name, Args)|BoundInsts], MaybeType, +bound_inst_list_is_ground([functor(Name, Args) | BoundInsts], MaybeType, ModuleInfo) :- maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, Name, list__length(Args), MaybeTypes), - inst_list_is_ground(Args, MaybeTypes, ModuleInfo), - bound_inst_list_is_ground(BoundInsts, MaybeType, ModuleInfo). - + inst_list_is_ground(Args, MaybeTypes, ModuleInfo), + bound_inst_list_is_ground(BoundInsts, MaybeType, ModuleInfo). bound_inst_list_is_ground_or_any([], _). -bound_inst_list_is_ground_or_any([functor(_Name, Args)|BoundInsts], - ModuleInfo) :- - inst_list_is_ground_or_any(Args, ModuleInfo), - bound_inst_list_is_ground_or_any(BoundInsts, ModuleInfo). +bound_inst_list_is_ground_or_any([functor(_Name, Args) | BoundInsts], + ModuleInfo) :- + inst_list_is_ground_or_any(Args, ModuleInfo), + bound_inst_list_is_ground_or_any(BoundInsts, ModuleInfo). bound_inst_list_is_unique([], _). -bound_inst_list_is_unique([functor(_Name, Args)|BoundInsts], ModuleInfo) :- - inst_list_is_unique(Args, ModuleInfo), - bound_inst_list_is_unique(BoundInsts, ModuleInfo). +bound_inst_list_is_unique([functor(_Name, Args) | BoundInsts], ModuleInfo) :- + inst_list_is_unique(Args, ModuleInfo), + bound_inst_list_is_unique(BoundInsts, ModuleInfo). bound_inst_list_is_mostly_unique([], _). -bound_inst_list_is_mostly_unique([functor(_Name, Args)|BoundInsts], - ModuleInfo) :- - inst_list_is_mostly_unique(Args, ModuleInfo), - bound_inst_list_is_mostly_unique(BoundInsts, ModuleInfo). +bound_inst_list_is_mostly_unique([functor(_Name, Args) | BoundInsts], + ModuleInfo) :- + inst_list_is_mostly_unique(Args, ModuleInfo), + bound_inst_list_is_mostly_unique(BoundInsts, ModuleInfo). bound_inst_list_is_not_partly_unique([], _). -bound_inst_list_is_not_partly_unique([functor(_Name, Args)|BoundInsts], - ModuleInfo) :- - inst_list_is_not_partly_unique(Args, ModuleInfo), - bound_inst_list_is_not_partly_unique(BoundInsts, ModuleInfo). +bound_inst_list_is_not_partly_unique([functor(_Name, Args) | BoundInsts], + ModuleInfo) :- + inst_list_is_not_partly_unique(Args, ModuleInfo), + bound_inst_list_is_not_partly_unique(BoundInsts, ModuleInfo). bound_inst_list_is_not_fully_unique([], _). -bound_inst_list_is_not_fully_unique([functor(_Name, Args)|BoundInsts], - ModuleInfo) :- - inst_list_is_not_fully_unique(Args, ModuleInfo), - bound_inst_list_is_not_fully_unique(BoundInsts, ModuleInfo). +bound_inst_list_is_not_fully_unique([functor(_Name, Args) | BoundInsts], + ModuleInfo) :- + inst_list_is_not_fully_unique(Args, ModuleInfo), + bound_inst_list_is_not_fully_unique(BoundInsts, ModuleInfo). %-----------------------------------------------------------------------------% -:- pred bound_inst_list_is_ground_2(list(bound_inst), maybe(type), module_info, - set(inst), set(inst)). -:- mode bound_inst_list_is_ground_2(in, in, in, in, out) is semidet. +:- pred bound_inst_list_is_ground_2(list(bound_inst)::in, maybe(type)::in, + module_info::in, set(inst)::in, set(inst)::out) is semidet. -bound_inst_list_is_ground_2([], _, _, Expansions, Expansions). -bound_inst_list_is_ground_2([functor(Name, Args)|BoundInsts], MaybeType, - ModuleInfo, Expansions0, Expansions) :- +bound_inst_list_is_ground_2([], _, _, !Expansions). +bound_inst_list_is_ground_2([functor(Name, Args) | BoundInsts], MaybeType, + ModuleInfo, !Expansions) :- maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, Name, list__length(Args), MaybeTypes), - inst_list_is_ground_2(Args, MaybeTypes, ModuleInfo, - Expansions0, Expansions1), - bound_inst_list_is_ground_2(BoundInsts, MaybeType, ModuleInfo, - Expansions1, Expansions). + inst_list_is_ground_2(Args, MaybeTypes, ModuleInfo, !Expansions), + bound_inst_list_is_ground_2(BoundInsts, MaybeType, ModuleInfo, + !Expansions). -:- pred bound_inst_list_is_ground_or_any_2(list(bound_inst), module_info, - set(inst), set(inst)). -:- mode bound_inst_list_is_ground_or_any_2(in, in, in, out) is semidet. +:- pred bound_inst_list_is_ground_or_any_2(list(bound_inst)::in, + module_info::in, set(inst)::in, set(inst)::out) is semidet. -bound_inst_list_is_ground_or_any_2([], _, Expansions, Expansions). -bound_inst_list_is_ground_or_any_2([functor(_Name, Args)|BoundInsts], - ModuleInfo, Expansions0, Expansions) :- - inst_list_is_ground_or_any_2(Args, ModuleInfo, - Expansions0, Expansions1), - bound_inst_list_is_ground_or_any_2(BoundInsts, ModuleInfo, - Expansions1, Expansions). +bound_inst_list_is_ground_or_any_2([], _, !Expansions). +bound_inst_list_is_ground_or_any_2([functor(_Name, Args) | BoundInsts], + ModuleInfo, !Expansions) :- + inst_list_is_ground_or_any_2(Args, ModuleInfo, !Expansions), + bound_inst_list_is_ground_or_any_2(BoundInsts, ModuleInfo, + !Expansions). -:- pred bound_inst_list_is_unique_2(list(bound_inst), module_info, - set(inst), set(inst)). -:- mode bound_inst_list_is_unique_2(in, in, in, out) is semidet. +:- pred bound_inst_list_is_unique_2(list(bound_inst)::in, module_info::in, + set(inst)::in, set(inst)::out) is semidet. -bound_inst_list_is_unique_2([], _, Expansions, Expansions). -bound_inst_list_is_unique_2([functor(_Name, Args)|BoundInsts], ModuleInfo, - Expansions0, Expansions) :- - inst_list_is_unique_2(Args, ModuleInfo, Expansions0, Expansions1), - bound_inst_list_is_unique_2(BoundInsts, ModuleInfo, - Expansions1, Expansions). +bound_inst_list_is_unique_2([], _, !Expansions). +bound_inst_list_is_unique_2([functor(_Name, Args) | BoundInsts], ModuleInfo, + !Expansions) :- + inst_list_is_unique_2(Args, ModuleInfo, !Expansions), + bound_inst_list_is_unique_2(BoundInsts, ModuleInfo, !Expansions). -:- pred bound_inst_list_is_mostly_unique_2(list(bound_inst), module_info, - set(inst), set(inst)). -:- mode bound_inst_list_is_mostly_unique_2(in, in, in, out) is semidet. +:- pred bound_inst_list_is_mostly_unique_2(list(bound_inst)::in, + module_info::in, set(inst)::in, set(inst)::out) is semidet. -bound_inst_list_is_mostly_unique_2([], _, Expansions, Expansions). -bound_inst_list_is_mostly_unique_2([functor(_Name, Args)|BoundInsts], - ModuleInfo, Expansions0, Expansions) :- - inst_list_is_mostly_unique_2(Args, ModuleInfo, - Expansions0, Expansions1), - bound_inst_list_is_mostly_unique_2(BoundInsts, ModuleInfo, - Expansions1, Expansions). +bound_inst_list_is_mostly_unique_2([], _, !Expansions). +bound_inst_list_is_mostly_unique_2([functor(_Name, Args) | BoundInsts], + ModuleInfo, !Expansions) :- + inst_list_is_mostly_unique_2(Args, ModuleInfo, !Expansions), + bound_inst_list_is_mostly_unique_2(BoundInsts, ModuleInfo, + !Expansions). -:- pred bound_inst_list_is_not_partly_unique_2(list(bound_inst), module_info, - set(inst), set(inst)). -:- mode bound_inst_list_is_not_partly_unique_2(in, in, in, out) is semidet. +:- pred bound_inst_list_is_not_partly_unique_2(list(bound_inst)::in, + module_info::in, set(inst)::in, set(inst)::out) is semidet. -bound_inst_list_is_not_partly_unique_2([], _, Expansions, Expansions). -bound_inst_list_is_not_partly_unique_2([functor(_Name, Args)|BoundInsts], - ModuleInfo, Expansions0, Expansions) :- - inst_list_is_not_partly_unique_2(Args, ModuleInfo, - Expansions0, Expansions1), - bound_inst_list_is_not_partly_unique_2(BoundInsts, ModuleInfo, - Expansions1, Expansions). +bound_inst_list_is_not_partly_unique_2([], _, !Expansions). +bound_inst_list_is_not_partly_unique_2([functor(_Name, Args) | BoundInsts], + ModuleInfo, !Expansions) :- + inst_list_is_not_partly_unique_2(Args, ModuleInfo, !Expansions), + bound_inst_list_is_not_partly_unique_2(BoundInsts, ModuleInfo, + !Expansions). -:- pred bound_inst_list_is_not_fully_unique_2(list(bound_inst), module_info, - set(inst), set(inst)). -:- mode bound_inst_list_is_not_fully_unique_2(in, in, in, out) is semidet. +:- pred bound_inst_list_is_not_fully_unique_2(list(bound_inst)::in, + module_info::in, set(inst)::in, set(inst)::out) is semidet. -bound_inst_list_is_not_fully_unique_2([], _, Expansions, Expansions). -bound_inst_list_is_not_fully_unique_2([functor(_Name, Args)|BoundInsts], - ModuleInfo, Expansions0, Expansions) :- - inst_list_is_not_fully_unique_2(Args, ModuleInfo, - Expansions0, Expansions1), - bound_inst_list_is_not_fully_unique_2(BoundInsts, ModuleInfo, - Expansions1, Expansions). +bound_inst_list_is_not_fully_unique_2([], _, !Expansions). +bound_inst_list_is_not_fully_unique_2([functor(_Name, Args) | BoundInsts], + ModuleInfo, !Expansions) :- + inst_list_is_not_fully_unique_2(Args, ModuleInfo, !Expansions), + bound_inst_list_is_not_fully_unique_2(BoundInsts, ModuleInfo, + !Expansions). %-----------------------------------------------------------------------------% @@ -1709,115 +1651,104 @@ inst_list_is_ground(Insts, ModuleInfo) :- MaybeTypes = list__duplicate(list__length(Insts), no), inst_list_is_ground(Insts, MaybeTypes, ModuleInfo). -:- pred inst_list_is_ground(list(inst), list(maybe(type)), module_info). -:- mode inst_list_is_ground(in, in, in) is semidet. +:- pred inst_list_is_ground(list(inst)::in, list(maybe(type))::in, + module_info::in) is semidet. inst_list_is_ground([], [], _). inst_list_is_ground([Inst | Insts], [MaybeType | MaybeTypes], ModuleInfo) :- - inst_is_ground(ModuleInfo, MaybeType, Inst), - inst_list_is_ground(Insts, MaybeTypes, ModuleInfo). + inst_is_ground(ModuleInfo, MaybeType, Inst), + inst_list_is_ground(Insts, MaybeTypes, ModuleInfo). inst_list_is_ground_or_any([], _). inst_list_is_ground_or_any([Inst | Insts], ModuleInfo) :- - inst_is_ground_or_any(ModuleInfo, Inst), - inst_list_is_ground_or_any(Insts, ModuleInfo). + inst_is_ground_or_any(ModuleInfo, Inst), + inst_list_is_ground_or_any(Insts, ModuleInfo). inst_list_is_unique([], _). inst_list_is_unique([Inst | Insts], ModuleInfo) :- - inst_is_unique(ModuleInfo, Inst), - inst_list_is_unique(Insts, ModuleInfo). + inst_is_unique(ModuleInfo, Inst), + inst_list_is_unique(Insts, ModuleInfo). inst_list_is_mostly_unique([], _). inst_list_is_mostly_unique([Inst | Insts], ModuleInfo) :- - inst_is_mostly_unique(ModuleInfo, Inst), - inst_list_is_mostly_unique(Insts, ModuleInfo). + inst_is_mostly_unique(ModuleInfo, Inst), + inst_list_is_mostly_unique(Insts, ModuleInfo). inst_list_is_not_partly_unique([], _). inst_list_is_not_partly_unique([Inst | Insts], ModuleInfo) :- - inst_is_not_partly_unique(ModuleInfo, Inst), - inst_list_is_not_partly_unique(Insts, ModuleInfo). + inst_is_not_partly_unique(ModuleInfo, Inst), + inst_list_is_not_partly_unique(Insts, ModuleInfo). inst_list_is_not_fully_unique([], _). inst_list_is_not_fully_unique([Inst | Insts], ModuleInfo) :- - inst_is_not_fully_unique(ModuleInfo, Inst), - inst_list_is_not_fully_unique(Insts, ModuleInfo). + inst_is_not_fully_unique(ModuleInfo, Inst), + inst_list_is_not_fully_unique(Insts, ModuleInfo). %-----------------------------------------------------------------------------% -:- pred inst_list_is_ground_2(list(inst), list(maybe(type)), - module_info, set(inst), set(inst)). -:- mode inst_list_is_ground_2(in, in, in, in, out) is semidet. +:- pred inst_list_is_ground_2(list(inst)::in, list(maybe(type))::in, + module_info::in, set(inst)::in, set(inst)::out) is semidet. -inst_list_is_ground_2([], _, _, Expansions, Expansions). -inst_list_is_ground_2([Inst | Insts], [MaybeType | MaybeTypes], - ModuleInfo, Expansions0, Expansions) :- - inst_is_ground_1(ModuleInfo, MaybeType, Inst, Expansions0, Expansions1), - inst_list_is_ground_2(Insts, MaybeTypes, ModuleInfo, - Expansions1, Expansions). +inst_list_is_ground_2([], _, _, !Expansions). +inst_list_is_ground_2([Inst | Insts], [MaybeType | MaybeTypes], ModuleInfo, + !Expansions) :- + inst_is_ground_1(ModuleInfo, MaybeType, Inst, !Expansions), + inst_list_is_ground_2(Insts, MaybeTypes, ModuleInfo, !Expansions). -:- pred inst_list_is_ground_or_any_2(list(inst), module_info, - set(inst), set(inst)). -:- mode inst_list_is_ground_or_any_2(in, in, in, out) is semidet. +:- pred inst_list_is_ground_or_any_2(list(inst)::in, module_info::in, + set(inst)::in, set(inst)::out) is semidet. -inst_list_is_ground_or_any_2([], _, Expansions, Expansions). -inst_list_is_ground_or_any_2([Inst | Insts], ModuleInfo, - Expansions0, Expansions) :- - inst_is_ground_or_any_2(ModuleInfo, Inst, Expansions0, Expansions1), - inst_list_is_ground_or_any_2(Insts, ModuleInfo, - Expansions1, Expansions). +inst_list_is_ground_or_any_2([], _, !Expansions). +inst_list_is_ground_or_any_2([Inst | Insts], ModuleInfo, !Expansions) :- + inst_is_ground_or_any_2(ModuleInfo, Inst, !Expansions), + inst_list_is_ground_or_any_2(Insts, ModuleInfo, !Expansions). -:- pred inst_list_is_unique_2(list(inst), module_info, set(inst), set(inst)). -:- mode inst_list_is_unique_2(in, in, in, out) is semidet. +:- pred inst_list_is_unique_2(list(inst)::in, module_info::in, + set(inst)::in, set(inst)::out) is semidet. -inst_list_is_unique_2([], _, Expansions, Expansions). -inst_list_is_unique_2([Inst | Insts], ModuleInfo, Expansions0, Expansions) :- - inst_is_unique_2(ModuleInfo, Inst, Expansions0, Expansions1), - inst_list_is_unique_2(Insts, ModuleInfo, Expansions1, Expansions). +inst_list_is_unique_2([], _, !Expansions). +inst_list_is_unique_2([Inst | Insts], ModuleInfo, !Expansions) :- + inst_is_unique_2(ModuleInfo, Inst, !Expansions), + inst_list_is_unique_2(Insts, ModuleInfo, !Expansions). -:- pred inst_list_is_mostly_unique_2(list(inst), module_info, - set(inst), set(inst)). -:- mode inst_list_is_mostly_unique_2(in, in, in, out) is semidet. +:- pred inst_list_is_mostly_unique_2(list(inst)::in, module_info::in, + set(inst)::in, set(inst)::out) is semidet. -inst_list_is_mostly_unique_2([], _, Expansions, Expansions). +inst_list_is_mostly_unique_2([], _, !Expansions). inst_list_is_mostly_unique_2([Inst | Insts], ModuleInfo, - Expansions0, Expansions) :- - inst_is_mostly_unique_2(ModuleInfo, Inst, Expansions0, Expansions1), - inst_list_is_mostly_unique_2(Insts, ModuleInfo, - Expansions1, Expansions). + !Expansions) :- + inst_is_mostly_unique_2(ModuleInfo, Inst, !Expansions), + inst_list_is_mostly_unique_2(Insts, ModuleInfo, !Expansions). -:- pred inst_list_is_not_partly_unique_2(list(inst), module_info, - set(inst), set(inst)). -:- mode inst_list_is_not_partly_unique_2(in, in, in, out) is semidet. +:- pred inst_list_is_not_partly_unique_2(list(inst)::in, module_info::in, + set(inst)::in, set(inst)::out) is semidet. -inst_list_is_not_partly_unique_2([], _, Expansions, Expansions). +inst_list_is_not_partly_unique_2([], _, !Expansions). inst_list_is_not_partly_unique_2([Inst | Insts], ModuleInfo, - Expansions0, Expansions) :- - inst_is_not_partly_unique_2(ModuleInfo, Inst, Expansions0, Expansions1), - inst_list_is_not_partly_unique_2(Insts, ModuleInfo, - Expansions1, Expansions). + !Expansions) :- + inst_is_not_partly_unique_2(ModuleInfo, Inst, !Expansions), + inst_list_is_not_partly_unique_2(Insts, ModuleInfo, !Expansions). -:- pred inst_list_is_not_fully_unique_2(list(inst), module_info, - set(inst), set(inst)). -:- mode inst_list_is_not_fully_unique_2(in, in, in, out) is semidet. +:- pred inst_list_is_not_fully_unique_2(list(inst)::in, module_info::in, + set(inst)::in, set(inst)::out) is semidet. -inst_list_is_not_fully_unique_2([], _, Expansions, Expansions). +inst_list_is_not_fully_unique_2([], _, !Expansions). inst_list_is_not_fully_unique_2([Inst | Insts], ModuleInfo, - Expansions0, Expansions) :- - inst_is_not_fully_unique_2(ModuleInfo, Inst, Expansions0, Expansions1), - inst_list_is_not_fully_unique_2(Insts, ModuleInfo, - Expansions1, Expansions). + !Expansions) :- + inst_is_not_fully_unique_2(ModuleInfo, Inst, !Expansions), + inst_list_is_not_fully_unique_2(Insts, ModuleInfo, !Expansions). %-----------------------------------------------------------------------------% bound_inst_list_is_free([], _). -bound_inst_list_is_free([functor(_Name, Args)|BoundInsts], ModuleInfo) :- - inst_list_is_free(Args, ModuleInfo), - bound_inst_list_is_free(BoundInsts, ModuleInfo). +bound_inst_list_is_free([functor(_Name, Args) | BoundInsts], ModuleInfo) :- + inst_list_is_free(Args, ModuleInfo), + bound_inst_list_is_free(BoundInsts, ModuleInfo). inst_list_is_free([], _). inst_list_is_free([Inst | Insts], ModuleInfo) :- - inst_is_free(ModuleInfo, Inst), - inst_list_is_free(Insts, ModuleInfo). + inst_is_free(ModuleInfo, Inst), + inst_list_is_free(Insts, ModuleInfo). %-----------------------------------------------------------------------------% @@ -1845,88 +1776,85 @@ inst_list_is_ground_or_any_or_dead([Inst | Insts], [Live | Lives], inst_contains_instname(Inst, ModuleInfo, InstName) :- set__init(Expansions0), - inst_contains_instname_2(Inst, ModuleInfo, InstName, - yes, Expansions0, _Expansions). + inst_contains_instname_2(Inst, ModuleInfo, InstName, yes, + Expansions0, _Expansions). :- type inst_names == set(inst_name). -:- pred inst_contains_instname_2(inst, module_info, inst_name, bool, - inst_names, inst_names). -:- mode inst_contains_instname_2(in, in, in, out, in, out) is det. +:- pred inst_contains_instname_2((inst)::in, module_info::in, inst_name::in, + bool::out, inst_names::in, inst_names::out) is det. -inst_contains_instname_2(abstract_inst(_, _), _, _, no, Expns, Expns). -inst_contains_instname_2(any(_), _, _, no, Expns, Expns). -inst_contains_instname_2(free, _, _, no, Expns, Expns). -inst_contains_instname_2(free(_T), _, _, no, Expns, Expns). -inst_contains_instname_2(ground(_Uniq, _), _, _, no, Expns, Expns). -inst_contains_instname_2(inst_var(_), _, _, no, Expns, Expns). -inst_contains_instname_2(not_reached, _, _, no, Expns, Expns). +inst_contains_instname_2(abstract_inst(_, _), _, _, no, !Expansions). +inst_contains_instname_2(any(_), _, _, no, !Expansions). +inst_contains_instname_2(free, _, _, no, !Expansions). +inst_contains_instname_2(free(_T), _, _, no, !Expansions). +inst_contains_instname_2(ground(_Uniq, _), _, _, no, !Expansions). +inst_contains_instname_2(inst_var(_), _, _, no, !Expansions). +inst_contains_instname_2(not_reached, _, _, no, !Expansions). inst_contains_instname_2(constrained_inst_vars(_, Inst), ModuleInfo, InstName, - Result, Expansions0, Expansions) :- + Result, !Expansions) :- inst_contains_instname_2(Inst, ModuleInfo, InstName, Result, - Expansions0, Expansions). + !Expansions). inst_contains_instname_2(defined_inst(InstName1), ModuleInfo, InstName, - Result, Expansions0, Expansions) :- + Result, !Expansions) :- ( InstName = InstName1 -> - Result = yes, - Expansions = Expansions0 + Result = yes ; - ( set__member(InstName1, Expansions0) -> - Result = no, - Expansions = Expansions0 + ( set__member(InstName1, !.Expansions) -> + Result = no ; inst_lookup(ModuleInfo, InstName1, Inst1), - set__insert(Expansions0, InstName1, Expansions1), + svset__insert(InstName1, !Expansions), inst_contains_instname_2(Inst1, ModuleInfo, - InstName, Result, Expansions1, Expansions) + InstName, Result, !Expansions) ) ). inst_contains_instname_2(bound(_Uniq, ArgInsts), ModuleInfo, - InstName, Result, Expansions0, Expansions) :- + InstName, Result, !Expansions) :- bound_inst_list_contains_instname(ArgInsts, ModuleInfo, - InstName, Result, Expansions0, Expansions). + InstName, Result, !Expansions). -:- pred bound_inst_list_contains_instname(list(bound_inst), module_info, - inst_name, bool, inst_names, inst_names). -:- mode bound_inst_list_contains_instname(in, in, in, out, in, out) is det. +:- pred bound_inst_list_contains_instname(list(bound_inst)::in, + module_info::in, inst_name::in, bool::out, + inst_names::in, inst_names::out) is det. bound_inst_list_contains_instname([], _ModuleInfo, - _InstName, no, Expansions, Expansions). -bound_inst_list_contains_instname([BoundInst|BoundInsts], ModuleInfo, - InstName, Result, Expansions0, Expansions) :- + _InstName, no, !Expansions). +bound_inst_list_contains_instname([BoundInst | BoundInsts], ModuleInfo, + InstName, Result, !Expansions) :- BoundInst = functor(_Functor, ArgInsts), inst_list_contains_instname(ArgInsts, ModuleInfo, InstName, Result1, - Expansions0, Expansions1), - ( Result1 = yes -> - Result = yes, - Expansions = Expansions1 + !Expansions), + ( + Result1 = yes, + Result = yes ; + Result1 = no, bound_inst_list_contains_instname(BoundInsts, ModuleInfo, - InstName, Result, Expansions1, Expansions) + InstName, Result, !Expansions) ). -:- pred inst_list_contains_instname(list(inst), module_info, inst_name, bool, - inst_names, inst_names). -:- mode inst_list_contains_instname(in, in, in, out, in, out) is det. +:- pred inst_list_contains_instname(list(inst)::in, module_info::in, + inst_name::in, bool::out, inst_names::in, inst_names::out) is det. inst_list_contains_instname([], _ModuleInfo, _InstName, no, - Expansions, Expansions). -inst_list_contains_instname([Inst|Insts], ModuleInfo, InstName, Result, - Expansions0, Expansions) :- + !Expansions). +inst_list_contains_instname([Inst | Insts], ModuleInfo, InstName, Result, + !Expansions) :- inst_contains_instname_2(Inst, ModuleInfo, InstName, Result1, - Expansions0, Expansions1), - ( Result1 = yes -> - Result = yes, - Expansions = Expansions1 + !Expansions), + ( + Result1 = yes, + Result = yes ; + Result1 = no, inst_list_contains_instname(Insts, ModuleInfo, InstName, - Result, Expansions1, Expansions) + Result, !Expansions) ). %-----------------------------------------------------------------------------% -:- pred inst_name_contains_inst_var(inst_name, inst_var). -:- mode inst_name_contains_inst_var(in, out) is nondet. +:- pred inst_name_contains_inst_var(inst_name::in, inst_var::out) is nondet. inst_name_contains_inst_var(user_inst(_Name, ArgInsts), InstVar) :- inst_list_contains_inst_var(ArgInsts, InstVar). @@ -1938,10 +1866,11 @@ inst_name_contains_inst_var(unify_inst(_Live, InstA, InstB, _Real), InstVar) :- ( inst_contains_inst_var(InstA, InstVar) ; inst_contains_inst_var(InstB, InstVar) ). -inst_name_contains_inst_var(ground_inst(InstName, _Live, _Uniq, _Real), InstVar) - :- +inst_name_contains_inst_var(ground_inst(InstName, _Live, _Uniq, _Real), + InstVar) :- inst_name_contains_inst_var(InstName, InstVar). -inst_name_contains_inst_var(any_inst(InstName, _Live, _Uniq, _Real), InstVar) :- +inst_name_contains_inst_var(any_inst(InstName, _Live, _Uniq, _Real), + InstVar) :- inst_name_contains_inst_var(InstName, InstVar). inst_name_contains_inst_var(shared_inst(InstName), InstVar) :- inst_name_contains_inst_var(InstName, InstVar). @@ -1951,8 +1880,7 @@ inst_name_contains_inst_var(typed_ground(_Uniq, _Type), _InstVar) :- fail. inst_name_contains_inst_var(typed_inst(_Type, InstName), InstVar) :- inst_name_contains_inst_var(InstName, InstVar). -:- pred inst_contains_inst_var(inst, inst_var). -:- mode inst_contains_inst_var(in, out) is nondet. +:- pred inst_contains_inst_var((inst)::in, inst_var::out) is nondet. inst_contains_inst_var(inst_var(InstVar), InstVar). inst_contains_inst_var(defined_inst(InstName), InstVar) :- @@ -1965,10 +1893,10 @@ inst_contains_inst_var(ground(_Uniq, GroundInstInfo), InstVar) :- inst_contains_inst_var(abstract_inst(_Name, ArgInsts), InstVar) :- inst_list_contains_inst_var(ArgInsts, InstVar). -:- pred bound_inst_list_contains_inst_var(list(bound_inst), inst_var). -:- mode bound_inst_list_contains_inst_var(in, out) is nondet. +:- pred bound_inst_list_contains_inst_var(list(bound_inst)::in, inst_var::out) + is nondet. -bound_inst_list_contains_inst_var([BoundInst|BoundInsts], InstVar) :- +bound_inst_list_contains_inst_var([BoundInst | BoundInsts], InstVar) :- BoundInst = functor(_Functor, ArgInsts), ( inst_list_contains_inst_var(ArgInsts, InstVar) @@ -1976,10 +1904,9 @@ bound_inst_list_contains_inst_var([BoundInst|BoundInsts], InstVar) :- bound_inst_list_contains_inst_var(BoundInsts, InstVar) ). -:- pred inst_list_contains_inst_var(list(inst), inst_var). -:- mode inst_list_contains_inst_var(in, out) is nondet. +:- pred inst_list_contains_inst_var(list(inst)::in, inst_var::out) is nondet. -inst_list_contains_inst_var([Inst|Insts], InstVar) :- +inst_list_contains_inst_var([Inst | Insts], InstVar) :- ( inst_contains_inst_var(Inst, InstVar) ; @@ -1989,21 +1916,19 @@ inst_list_contains_inst_var([Inst|Insts], InstVar) :- mode_list_contains_inst_var(Modes, _ModuleInfo, InstVar) :- mode_list_contains_inst_var(Modes, InstVar). -:- pred mode_list_contains_inst_var(list(mode), inst_var). -:- mode mode_list_contains_inst_var(in, out) is nondet. +:- pred mode_list_contains_inst_var(list(mode)::in, inst_var::out) is nondet. -mode_list_contains_inst_var([Mode|_Modes], InstVar) :- +mode_list_contains_inst_var([Mode | _Modes], InstVar) :- mode_contains_inst_var(Mode, InstVar). -mode_list_contains_inst_var([_|Modes], InstVar) :- +mode_list_contains_inst_var([_ | Modes], InstVar) :- mode_list_contains_inst_var(Modes, InstVar). -:- pred mode_contains_inst_var(mode, inst_var). -:- mode mode_contains_inst_var(in, out) is nondet. +:- pred mode_contains_inst_var((mode)::in, inst_var::out) is nondet. mode_contains_inst_var(Mode, InstVar) :- ( Mode = (Initial -> Final), - ( Inst = Initial ; Inst = Final ) + ( Inst = Initial ; Inst = Final ) ; Mode = user_defined_mode(_Name, Insts), list__member(Inst, Insts) @@ -2016,8 +1941,8 @@ mode_contains_inst_var(Mode, InstVar) :- % the `solver' keyword), the inst `any' should be considered % to be equivalent to a bound inst i where i contains all % the functors of the type t and each argument has inst `any'. -:- pred maybe_any_to_bound(maybe(type), module_info, uniqueness, inst). -:- mode maybe_any_to_bound(in, in, in, out) is semidet. +:- pred maybe_any_to_bound(maybe(type)::in, module_info::in, uniqueness::in, + (inst)::out) is semidet. maybe_any_to_bound(yes(Type), ModuleInfo, Uniq, Inst) :- \+ type_util__is_solver_type(ModuleInfo, Type), @@ -2039,8 +1964,7 @@ maybe_any_to_bound(yes(Type), ModuleInfo, Uniq, Inst) :- Inst = ground(Uniq, none) ). -:- pred type_may_contain_solver_type((type), module_info). -:- mode type_may_contain_solver_type(in, in) is semidet. +:- pred type_may_contain_solver_type((type)::in, module_info::in) is semidet. type_may_contain_solver_type(Type, ModuleInfo) :- type_may_contain_solver_type_2(classify_type(ModuleInfo, Type)) = yes. diff --git a/compiler/inst_util.m b/compiler/inst_util.m index b33bef67d..99e6a6da2 100644 --- a/compiler/inst_util.m +++ b/compiler/inst_util.m @@ -43,51 +43,47 @@ :- import_module list, std_util. -:- pred abstractly_unify_inst(is_live, inst, inst, unify_is_real, module_info, - inst, determinism, module_info). -:- mode abstractly_unify_inst(in, in, in, in, in, out, out, out) is semidet. - - % Compute the inst that results from abstractly unifying two variables. - -:- pred abstractly_unify_inst_functor(is_live, inst, cons_id, list(inst), - list(is_live), unify_is_real, (type), module_info, - inst, determinism, module_info). -:- mode abstractly_unify_inst_functor(in, in, in, in, in, in, in, in, - out, out, out) is semidet. - - % Compute the inst that results from abstractly unifying - % a variable with a functor. - % Mode checking is like abstract interpretation. - % The above predicates define the abstract unification operation + % The predicates below define the abstract unification operation % which unifies two instantiatednesses. If the unification % would be illegal, then abstract unification fails. % If the unification would fail, then the abstract unification % will succeed, and the resulting instantiatedness will be % `not_reached'. -%-----------------------------------------------------------------------------% + % Compute the inst that results from abstractly unifying two variables. + % +:- pred abstractly_unify_inst(is_live::in, (inst)::in, (inst)::in, + unify_is_real::in, (inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. -:- pred make_mostly_uniq_inst(inst, module_info, inst, module_info). -:- mode make_mostly_uniq_inst(in, in, out, out) is det. + % Compute the inst that results from abstractly unifying + % a variable with a functor. + % +:- pred abstractly_unify_inst_functor(is_live::in, (inst)::in, cons_id::in, + list(inst)::in, list(is_live)::in, unify_is_real::in, (type)::in, + (inst)::out, determinism::out, module_info::in, module_info::out) + is semidet. + +%-----------------------------------------------------------------------------% % Given an inst, return a new inst which is the same as the % original inst but with all occurrences of `unique' replaced % with `mostly_unique'. - -:- pred make_shared_inst_list(list(inst), module_info, list(inst), module_info). -:- mode make_shared_inst_list(in, in, out, out) is det. + % +:- pred make_mostly_uniq_inst((inst)::in, (inst)::out, + module_info::in, module_info::out) is det. % Given a list of insts, return a new list of insts which is the % same as the original list of insts, but with all occurrences % of `unique' replaced with `shared'. It is an error if any part % of the inst list is free. + % +:- pred make_shared_inst_list(list(inst)::in, list(inst)::out, + module_info::in, module_info::out) is det. %-----------------------------------------------------------------------------% -:- pred inst_merge(inst, inst, maybe(type), module_info, inst, module_info). -:- mode inst_merge(in, in, in, in, out, out) is semidet. - % inst_merge(InstA, InstB, InstC): % Combine the insts found in different arms of a % disjunction (or if-then-else). @@ -95,35 +91,37 @@ % information in InstA and InstB. Where InstA and % InstB specify a binding (free or bound), it must be % the same in both. + % +:- pred inst_merge((inst)::in, (inst)::in, maybe(type)::in, (inst)::out, + module_info::in, module_info::out) is semidet. %-----------------------------------------------------------------------------% -:- pred inst_contains_nonstandard_func_mode(inst, module_info). -:- mode inst_contains_nonstandard_func_mode(in, in) is semidet. - % inst_contains_nonstandard_func_mode(Inst, ModuleInfo) succeeds iff the % inst contains a higher-order function inst that does not match the % standard function mode `(in, ..., in) = out is det'. % E.g. this predicate fails for "func(in) = uo" because that matches the % standard func mode "func(in) = out", even though it isn't the same as % the standard func mode. - -:- pred pred_inst_info_is_nonstandard_func_mode(pred_inst_info, module_info). -:- mode pred_inst_info_is_nonstandard_func_mode(in, in) is semidet. + % +:- pred inst_contains_nonstandard_func_mode((inst)::in, module_info::in) + is semidet. % Succeed iff the first argument is a function pred_inst_info % whose mode does not match the standard func mode. - -:- pred ground_inst_info_is_nonstandard_func_mode(ground_inst_info, - module_info). -:- mode ground_inst_info_is_nonstandard_func_mode(in, in) is semidet. + % +:- pred pred_inst_info_is_nonstandard_func_mode(pred_inst_info::in, + module_info::in) is semidet. % Succeed iff the first argument is a function ground_inst_info % whose mode does not match the standard func mode. - -:- func pred_inst_info_standard_func_mode(arity) = pred_inst_info. + % +:- pred ground_inst_info_is_nonstandard_func_mode(ground_inst_info::in, + module_info::in) is semidet. % Return the standard mode for a function of the given arity. + % +:- func pred_inst_info_standard_func_mode(arity) = pred_inst_info. %-----------------------------------------------------------------------------% @@ -143,16 +141,16 @@ :- import_module hlds__hlds_data. :- import_module parse_tree__prog_mode. -:- import_module bool, std_util, require, map, list, set, int. +:- import_module bool, int, std_util, require, list, set, svset, map, svmap. % Abstractly unify two insts. -abstractly_unify_inst(Live, InstA, InstB, UnifyIsReal, ModuleInfo0, - Inst, Det, ModuleInfo) :- +abstractly_unify_inst(Live, InstA, InstB, UnifyIsReal, Inst, Det, + !ModuleInfo) :- % check whether this pair of insts is already in % the unify_insts table ThisInstPair = unify_inst(Live, InstA, InstB, UnifyIsReal), - module_info_insts(ModuleInfo0, InstTable0), + module_info_insts(!.ModuleInfo, InstTable0), inst_table_get_unify_insts(InstTable0, UnifyInsts0), ( map__search(UnifyInsts0, ThisInstPair, Result) -> ( Result = known(UnifyInst, UnifyDet) -> @@ -168,20 +166,26 @@ abstractly_unify_inst(Live, InstA, InstB, UnifyIsReal, ModuleInfo0, % it must be semidet somewhere else too. Det = det ), - ModuleInfo = ModuleInfo0, Inst1 = Inst0 ; + % XXX should these expansions be done wrt the + % ModuleInfo after the module_info__set_insts below? + % The original code I cleaned up had these calls to + % inst_expand in that position, but referred to the + % version of ModuleInfo that is current here. + inst_expand(!.ModuleInfo, InstA, InstA2), + inst_expand(!.ModuleInfo, InstB, InstB2), + % insert ThisInstPair into the table with value % `unknown' - map__det_insert(UnifyInsts0, ThisInstPair, unknown, - UnifyInsts1), - inst_table_set_unify_insts(UnifyInsts1, InstTable0, InstTable1), - module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1), + svmap__det_insert(ThisInstPair, unknown, + UnifyInsts0, UnifyInsts1), + inst_table_set_unify_insts(UnifyInsts1, + InstTable0, InstTable1), + module_info_set_insts(InstTable1, !ModuleInfo), % unify the insts - inst_expand(ModuleInfo0, InstA, InstA2), - inst_expand(ModuleInfo0, InstB, InstB2), abstractly_unify_inst_2(Live, InstA2, InstB2, UnifyIsReal, - ModuleInfo1, Inst0, Det, ModuleInfo2), + Inst0, Det, !ModuleInfo), % If this unification cannot possible succeed, % the correct inst is not_reached. @@ -192,41 +196,38 @@ abstractly_unify_inst(Live, InstA, InstB, UnifyIsReal, ModuleInfo0, ), % now update the value associated with ThisInstPair - module_info_insts(ModuleInfo2, InstTable2), + module_info_insts(!.ModuleInfo, InstTable2), inst_table_get_unify_insts(InstTable2, UnifyInsts2), map__det_update(UnifyInsts2, ThisInstPair, known(Inst1, Det), UnifyInsts), inst_table_set_unify_insts(UnifyInsts, InstTable2, InstTable), - module_info_set_insts(InstTable, ModuleInfo2, ModuleInfo) + module_info_set_insts(InstTable, !ModuleInfo) ), % avoid expanding recursive insts - ( inst_contains_instname(Inst1, ModuleInfo, ThisInstPair) -> + ( inst_contains_instname(Inst1, !.ModuleInfo, ThisInstPair) -> Inst = defined_inst(ThisInstPair) ; Inst = Inst1 ). -:- pred abstractly_unify_inst_2(is_live, inst, inst, unify_is_real, module_info, - inst, determinism, module_info). -:- mode abstractly_unify_inst_2(in, in, in, in, in, out, out, out) is semidet. +:- pred abstractly_unify_inst_2(is_live::in, (inst)::in, (inst)::in, + unify_is_real::in, (inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. -abstractly_unify_inst_2(IsLive, InstA, InstB, UnifyIsReal, ModuleInfo0, - Inst, Det, ModuleInfo) :- +abstractly_unify_inst_2(IsLive, InstA, InstB, UnifyIsReal, Inst, Det, + !ModuleInfo) :- ( InstB = not_reached -> Inst = not_reached, - Det = det, - ModuleInfo = ModuleInfo0 + Det = det ; InstA = constrained_inst_vars(InstVars, InstA1) -> abstractly_unify_constrained_inst_vars(IsLive, InstVars, InstA1, - InstB, UnifyIsReal, ModuleInfo0, Inst, Det, - ModuleInfo) + InstB, UnifyIsReal, Inst, Det, !ModuleInfo) ; InstB = constrained_inst_vars(InstVars, InstB1) -> abstractly_unify_constrained_inst_vars(IsLive, InstVars, InstB1, - InstA, UnifyIsReal, ModuleInfo0, Inst, Det, - ModuleInfo) + InstA, UnifyIsReal, Inst, Det, !ModuleInfo) ; abstractly_unify_inst_3(IsLive, InstA, InstB, UnifyIsReal, - ModuleInfo0, Inst, Det, ModuleInfo) + Inst, Det, !ModuleInfo) ). % Abstractly unify two expanded insts. @@ -234,98 +235,101 @@ abstractly_unify_inst_2(IsLive, InstA, InstB, UnifyIsReal, ModuleInfo0, % Given the two insts to be unified, this produces % a resulting inst and a determinism for the unification. -:- pred abstractly_unify_inst_3(is_live, inst, inst, unify_is_real, module_info, - inst, determinism, module_info). -:- mode abstractly_unify_inst_3(in, in, in, in, in, out, out, out) is semidet. +:- pred abstractly_unify_inst_3(is_live::in, (inst)::in, (inst)::in, + unify_is_real::in, (inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. % XXX could be extended to handle `any' insts better -abstractly_unify_inst_3(live, not_reached, _, _, M, not_reached, det, M). +abstractly_unify_inst_3(live, not_reached, _, _, not_reached, det, + !ModuleInfo). -abstractly_unify_inst_3(live, any(Uniq), Inst0, Real, M0, Inst, Det, M) :- - make_any_inst(Inst0, live, Uniq, Real, M0, Inst, Det, M). +abstractly_unify_inst_3(live, any(Uniq), Inst0, Real, Inst, Det, + !ModuleInfo) :- + make_any_inst(Inst0, live, Uniq, Real, Inst, Det, !ModuleInfo). -abstractly_unify_inst_3(live, free, any(UniqY), Real, M, - any(Uniq), det, M) :- +abstractly_unify_inst_3(live, free, any(UniqY), Real, any(Uniq), det, + !ModuleInfo) :- unify_uniq(live, Real, det, unique, UniqY, Uniq). -% abstractly_unify_inst_3(live, free, free, _, _, _, _, _) :- fail. +% abstractly_unify_inst_3(live, free, free, _, _, _, _, _) :- fail. -abstractly_unify_inst_3(live, free, bound(UniqY, List0), Real, M0, - bound(Uniq, List), det, M) :- +abstractly_unify_inst_3(live, free, bound(UniqY, List0), Real, + bound(Uniq, List), det, !ModuleInfo) :- unify_uniq(live, Real, det, unique, UniqY, Uniq), % since both are live, we must disallow free-free unifications - bound_inst_list_is_ground_or_any(List0, M0), + bound_inst_list_is_ground_or_any(List0, !.ModuleInfo), % since both are live, we must make the result shared % (unless it was already shared) ( ( UniqY = unique ; UniqY = mostly_unique ) -> - make_shared_bound_inst_list(List0, M0, List, M) + make_shared_bound_inst_list(List0, List, !ModuleInfo) ; - List = List0, M = M0 + List = List0 ). -abstractly_unify_inst_3(live, free, ground(UniqY, PredInst), Real, M, - ground(Uniq, PredInst), det, M) :- +abstractly_unify_inst_3(live, free, ground(UniqY, PredInst), Real, + ground(Uniq, PredInst), det, !ModuleInfo) :- unify_uniq(live, Real, det, unique, UniqY, Uniq). -% abstractly_unify_inst_3(live, free, abstract_inst(_,_), _, _, _, _) :- fail. +% abstractly_unify_inst_3(live, free, abstract_inst(_,_), _, _, _, _) :- fail. -abstractly_unify_inst_3(live, bound(UniqX, List0), any(UniqY), Real, M0, - bound(Uniq, List), Det, M) :- +abstractly_unify_inst_3(live, bound(UniqX, List0), any(UniqY), Real, + bound(Uniq, List), Det, !ModuleInfo) :- allow_unify_bound_any(Real), unify_uniq(live, Real, semidet, UniqX, UniqY, Uniq), - make_any_bound_inst_list(List0, live, UniqY, Real, M0, - List, Det1, M), + make_any_bound_inst_list(List0, live, UniqY, Real, List, Det1, + !ModuleInfo), det_par_conjunction_detism(Det1, semidet, Det). -abstractly_unify_inst_3(live, bound(UniqY, List0), free, Real, M0, - bound(Uniq, List), det, M) :- +abstractly_unify_inst_3(live, bound(UniqY, List0), free, Real, + bound(Uniq, List), det, !ModuleInfo) :- unify_uniq(live, Real, det, unique, UniqY, Uniq), % since both are live, we must disallow free-free unifications - bound_inst_list_is_ground_or_any(List0, M0), - make_shared_bound_inst_list(List0, M0, List, M). + bound_inst_list_is_ground_or_any(List0, !.ModuleInfo), + make_shared_bound_inst_list(List0, List, !ModuleInfo). abstractly_unify_inst_3(live, bound(UniqX, ListX), bound(UniqY, ListY), Real, - M0, bound(Uniq, List), Det, M) :- - abstractly_unify_bound_inst_list(live, ListX, ListY, Real, M0, - List, Det, M), + bound(Uniq, List), Det, !ModuleInfo) :- + abstractly_unify_bound_inst_list(live, ListX, ListY, Real, List, Det, + !ModuleInfo), unify_uniq(live, Real, Det, UniqX, UniqY, Uniq). abstractly_unify_inst_3(live, bound(UniqX, BoundInsts0), ground(UniqY, _), - Real, M0, bound(Uniq, BoundInsts), Det, M) :- + Real, bound(Uniq, BoundInsts), Det, !ModuleInfo) :- unify_uniq(live, Real, semidet, UniqX, UniqY, Uniq), - make_ground_bound_inst_list(BoundInsts0, live, UniqY, Real, M0, - BoundInsts, Det1, M), + make_ground_bound_inst_list(BoundInsts0, live, UniqY, Real, BoundInsts, + Det1, !ModuleInfo), det_par_conjunction_detism(Det1, semidet, Det). % abstract insts not supported -% abstractly_unify_inst_3(live, bound(Uniq, List), abstract_inst(_,_), Real, M, -% ground(shared), semidet, M) :- +% abstractly_unify_inst_3(live, bound(Uniq, List), abstract_inst(_,_), Real, +% ground(shared), semidet, !ModuleInfo) :- % unify_uniq(live, Real, semidet, unique, UniqY, Uniq), -% bound_inst_list_is_ground(List, M). +% bound_inst_list_is_ground(List, !.ModuleInfo). abstractly_unify_inst_3(live, ground(UniqX, higher_order(PredInst)), - any(UniqY), Real, M, ground(Uniq, higher_order(PredInst)), - semidet, M) :- + any(UniqY), Real, ground(Uniq, higher_order(PredInst)), + semidet, !ModuleInfo) :- Real = fake_unify, unify_uniq(live, Real, det, UniqX, UniqY, Uniq). abstractly_unify_inst_3(live, ground(Uniq0, higher_order(PredInst)), free, - Real, M, ground(Uniq, higher_order(PredInst)), det, M) :- + Real, ground(Uniq, higher_order(PredInst)), det, + !ModuleInfo) :- unify_uniq(live, Real, det, unique, Uniq0, Uniq). abstractly_unify_inst_3(live, ground(UniqX, higher_order(_)), - bound(UniqY, BoundInsts0), Real, M0, bound(Uniq, BoundInsts), - Det, M) :- + bound(UniqY, BoundInsts0), Real, bound(Uniq, BoundInsts), + Det, !ModuleInfo) :- % check `Real = fake_unify' ? unify_uniq(live, Real, semidet, UniqX, UniqY, Uniq), - make_ground_bound_inst_list(BoundInsts0, live, UniqX, Real, M0, - BoundInsts, Det1, M), + make_ground_bound_inst_list(BoundInsts0, live, UniqX, Real, BoundInsts, + Det1, !ModuleInfo), det_par_conjunction_detism(Det1, semidet, Det). abstractly_unify_inst_3(live, ground(UniqA, higher_order(PredInstA)), - ground(UniqB, _GroundInstInfoB), Real, M, - ground(Uniq, GroundInstInfo), semidet, M) :- + ground(UniqB, _GroundInstInfoB), Real, + ground(Uniq, GroundInstInfo), semidet, !ModuleInfo) :- % It is an error to unify higher-order preds, % so if Real \= fake_unify, then we must fail. Real = fake_unify, @@ -338,68 +342,70 @@ abstractly_unify_inst_3(live, ground(UniqA, higher_order(PredInstA)), GroundInstInfo = higher_order(PredInstA), unify_uniq(live, Real, semidet, UniqA, UniqB, Uniq). -abstractly_unify_inst_3(live, ground(Uniq, none), Inst0, Real, M0, - Inst, Det, M) :- - make_ground_inst(Inst0, live, Uniq, Real, M0, Inst, Det, M). +abstractly_unify_inst_3(live, ground(Uniq, none), Inst0, Real, Inst, Det, + !ModuleInfo) :- + make_ground_inst(Inst0, live, Uniq, Real, Inst, Det, !ModuleInfo). -% abstractly_unify_inst_3(live, abstract_inst(_,_), free, _, _, _, _, _) +% abstractly_unify_inst_3(live, abstract_inst(_,_), free, _, _, _, _, _) % :- fail. % abstract insts not supported % abstractly_unify_inst_3(live, abstract_inst(_,_), bound(Uniq, List), Real, -% ModuleInfo, ground(shared, no), semidet, ModuleInfo) :- +% ground(shared, no), semidet, !ModuleInfo) :- % check_not_clobbered(Real, Uniq), -% bound_inst_list_is_ground(List, ModuleInfo). +% bound_inst_list_is_ground(List, !.ModuleInfo). % -% abstractly_unify_inst_3(live, abstract_inst(_,_), ground(Uniq, no), Real, M, -% ground(shared, no), semidet, M) :- +% abstractly_unify_inst_3(live, abstract_inst(_,_), ground(Uniq, no), Real, +% ground(shared, no), semidet, !ModuleInfo) :- % check_not_clobbered(Real, Uniq). % % abstractly_unify_inst_3(live, abstract_inst(Name, ArgsA), -% abstract_inst(Name, ArgsB), Real, ModuleInfo0, -% abstract_inst(Name, Args), Det, ModuleInfo) :- -% abstractly_unify_inst_list(ArgsA, ArgsB, live, Real, ModuleInfo0, -% Args, Det, ModuleInfo). +% abstract_inst(Name, ArgsB), Real, +% abstract_inst(Name, Args), Det, !ModuleInfo) :- +% abstractly_unify_inst_list(ArgsA, ArgsB, live, Real, +% Args, Det, !ModuleInfo). -abstractly_unify_inst_3(dead, not_reached, _, _, M, not_reached, det, M). +abstractly_unify_inst_3(dead, not_reached, _, _, not_reached, det, + !ModuleInfo). -abstractly_unify_inst_3(dead, any(Uniq), Inst0, Real, M0, Inst, Det, M) :- - make_any_inst(Inst0, dead, Uniq, Real, M0, Inst, Det, M). +abstractly_unify_inst_3(dead, any(Uniq), Inst0, Real, Inst, Det, + !ModuleInfo) :- + make_any_inst(Inst0, dead, Uniq, Real, Inst, Det, !ModuleInfo). -abstractly_unify_inst_3(dead, free, Inst, _, M, Inst, det, M). +abstractly_unify_inst_3(dead, free, Inst, _, Inst, det, !ModuleInfo). -abstractly_unify_inst_3(dead, bound(UniqX, List0), any(UniqY), Real, M0, - bound(Uniq, List), Det, M) :- +abstractly_unify_inst_3(dead, bound(UniqX, List0), any(UniqY), Real, + bound(Uniq, List), Det, !ModuleInfo) :- allow_unify_bound_any(Real), unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq), - make_any_bound_inst_list(List0, live, UniqY, Real, M0, - List, Det1, M), + make_any_bound_inst_list(List0, live, UniqY, Real, List, Det1, + !ModuleInfo), det_par_conjunction_detism(Det1, semidet, Det). -abstractly_unify_inst_3(dead, bound(UniqX, List), free, Real, ModuleInfo, - bound(Uniq, List), det, ModuleInfo) :- +abstractly_unify_inst_3(dead, bound(UniqX, List), free, Real, + bound(Uniq, List), det, !ModuleInfo) :- unify_uniq(dead, Real, det, UniqX, unique, Uniq). abstractly_unify_inst_3(dead, bound(UniqX, ListX), bound(UniqY, ListY), - Real, M0, bound(Uniq, List), Det, M) :- - abstractly_unify_bound_inst_list(dead, ListX, ListY, Real, M0, - List, Det, M), + Real, bound(Uniq, List), Det, !ModuleInfo) :- + abstractly_unify_bound_inst_list(dead, ListX, ListY, Real, + List, Det, !ModuleInfo), unify_uniq(dead, Real, Det, UniqX, UniqY, Uniq). abstractly_unify_inst_3(dead, bound(UniqX, BoundInsts0), ground(UniqY, _), - Real, M0, bound(Uniq, BoundInsts), Det, M) :- + Real, bound(Uniq, BoundInsts), Det, !ModuleInfo) :- unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq), - make_ground_bound_inst_list(BoundInsts0, dead, UniqY, Real, M0, - BoundInsts, Det1, M), + make_ground_bound_inst_list(BoundInsts0, dead, UniqY, Real, BoundInsts, + Det1, !ModuleInfo), det_par_conjunction_detism(Det1, semidet, Det). % abstract insts aren't really supported % abstractly_unify_inst_3(dead, bound(Uniq, List), abstract_inst(N,As), -% ModuleInfo, Result, Det, ModuleInfo) :- -% ( bound_inst_list_is_ground(List, ModuleInfo) -> +% Result, Det, !ModuleInfo) :- +% ( bound_inst_list_is_ground(List, !.ModuleInfo) -> % Result = bound(Uniq, List), % Det = semidet -% ; bound_inst_list_is_free(List, ModuleInfo) -> +% ; bound_inst_list_is_free(List, !.ModuleInfo) -> % Result = abstract_inst(N,As), % Det = det % ; @@ -407,32 +413,32 @@ abstractly_unify_inst_3(dead, bound(UniqX, BoundInsts0), ground(UniqY, _), % ). abstractly_unify_inst_3(dead, ground(UniqX, higher_order(PredInst)), - any(UniqY), Real, M, ground(Uniq, higher_order(PredInst)), - semidet, M) :- + any(UniqY), Real, ground(Uniq, higher_order(PredInst)), + semidet, !ModuleInfo) :- allow_unify_bound_any(Real), unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq). abstractly_unify_inst_3(dead, ground(Uniq, higher_order(PredInst)), free, - _Real, M, ground(Uniq, higher_order(PredInst)), det, M). + _Real, ground(Uniq, higher_order(PredInst)), det, !ModuleInfo). abstractly_unify_inst_3(dead, ground(UniqA, higher_order(_)), - bound(UniqB, BoundInsts0), Real, M0, bound(Uniq, BoundInsts), - Det, M) :- + bound(UniqB, BoundInsts0), Real, bound(Uniq, BoundInsts), + Det, !ModuleInfo) :- unify_uniq(dead, Real, semidet, UniqA, UniqB, Uniq), - make_ground_bound_inst_list(BoundInsts0, dead, UniqA, Real, M0, - BoundInsts, Det1, M), + make_ground_bound_inst_list(BoundInsts0, dead, UniqA, Real, BoundInsts, + Det1, !ModuleInfo), det_par_conjunction_detism(Det1, semidet, Det). abstractly_unify_inst_3(dead, ground(UniqA, higher_order(PredInstA)), - ground(UniqB, _GroundInstInfoB), Real, M, - ground(Uniq, GroundInstInfo), det, M) :- + ground(UniqB, _GroundInstInfoB), Real, + ground(Uniq, GroundInstInfo), det, !ModuleInfo) :- Real = fake_unify, GroundInstInfo = higher_order(PredInstA), unify_uniq(dead, Real, det, UniqA, UniqB, Uniq). -abstractly_unify_inst_3(dead, ground(Uniq, none), Inst0, Real, M0, - Inst, Det, M) :- - make_ground_inst(Inst0, dead, Uniq, Real, M0, Inst, Det, M). +abstractly_unify_inst_3(dead, ground(Uniq, none), Inst0, Real, Inst, Det, + !ModuleInfo) :- + make_ground_inst(Inst0, dead, Uniq, Real, Inst, Det, !ModuleInfo). % abstract insts aren't really supported % abstractly_unify_inst_3(dead, abstract_inst(N,As), bound(List), Real, @@ -447,32 +453,28 @@ abstractly_unify_inst_3(dead, ground(Uniq, none), Inst0, Real, M0, % fail % ). % -% abstractly_unify_inst_3(dead, abstract_inst(_,_), ground, _Real, ModuleInfo, -% ground, semidet, ModuleInfo). +% abstractly_unify_inst_3(dead, abstract_inst(_,_), ground, _Real, +% ground, semidet, !ModuleInfo). % % abstractly_unify_inst_3(dead, abstract_inst(Name, ArgsA), -% abstract_inst(Name, ArgsB), Real, ModuleInfo0, -% abstract_inst(Name, Args), Det, ModuleInfo) :- -% abstractly_unify_inst_list(ArgsA, ArgsB, dead, Real, ModuleInfo0, -% Args, Det, ModuleInfo). +% abstract_inst(Name, ArgsB), Real, +% abstract_inst(Name, Args), Det, !ModuleInfo) :- +% abstractly_unify_inst_list(ArgsA, ArgsB, dead, Real, +% Args, Det, !ModuleInfo). %-----------------------------------------------------------------------------% % Abstractly unify two inst lists. -:- pred abstractly_unify_inst_list(list(inst), list(inst), is_live, - unify_is_real, module_info, - list(inst), determinism, module_info). -:- mode abstractly_unify_inst_list(in, in, in, in, in, out, out, out) - is semidet. +:- pred abstractly_unify_inst_list(list(inst)::in, list(inst)::in, is_live::in, + unify_is_real::in, list(inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. -abstractly_unify_inst_list([], [], _, _, M, [], det, M). -abstractly_unify_inst_list([X|Xs], [Y|Ys], Live, Real, ModuleInfo0, - [Z|Zs], Det, ModuleInfo) :- - abstractly_unify_inst(Live, X, Y, Real, ModuleInfo0, - Z, Det1, ModuleInfo1), - abstractly_unify_inst_list(Xs, Ys, Live, Real, ModuleInfo1, - Zs, Det2, ModuleInfo), +abstractly_unify_inst_list([], [], _, _, [], det, !ModuleInfo). +abstractly_unify_inst_list([X|Xs], [Y|Ys], Live, Real, [Z|Zs], Det, + !ModuleInfo) :- + abstractly_unify_inst(Live, X, Y, Real, Z, Det1, !ModuleInfo), + abstractly_unify_inst_list(Xs, Ys, Live, Real, Zs, Det2, !ModuleInfo), det_par_conjunction_detism(Det1, Det2, Det). %-----------------------------------------------------------------------------% @@ -482,14 +484,13 @@ abstractly_unify_inst_list([X|Xs], [Y|Ys], Live, Real, ModuleInfo0, % with a functor. abstractly_unify_inst_functor(Live, InstA, ConsId, ArgInsts, ArgLives, - Real, Type, ModuleInfo0, Inst, Det, ModuleInfo) :- - inst_expand(ModuleInfo0, InstA, InstA2), + Real, Type, Inst, Det, !ModuleInfo) :- + inst_expand(!.ModuleInfo, InstA, InstA2), ( InstA2 = constrained_inst_vars(InstVars, InstA3) -> abstractly_unify_inst_functor(Live, InstA3, ConsId, ArgInsts, - ArgLives, Real, Type, ModuleInfo0, Inst0, Det, - ModuleInfo), + ArgLives, Real, Type, Inst0, Det, !ModuleInfo), ( - inst_matches_final(Inst0, InstA3, ModuleInfo) + inst_matches_final(Inst0, InstA3, !.ModuleInfo) -> % We can keep the constrained_inst_vars. Inst = constrained_inst_vars(InstVars, Inst0) @@ -513,74 +514,71 @@ abstractly_unify_inst_functor(Live, InstA, ConsId, ArgInsts, ArgLives, ) ; abstractly_unify_inst_functor_2(Live, InstA2, ConsId, ArgInsts, - ArgLives, Real, Type, ModuleInfo0, Inst, Det, - ModuleInfo) + ArgLives, Real, Type, Inst, Det, !ModuleInfo) ). -:- pred abstractly_unify_inst_functor_2(is_live, inst, cons_id, list(inst), - list(is_live), unify_is_real, (type), module_info, - inst, determinism, module_info). -:- mode abstractly_unify_inst_functor_2(in, in, in, in, in, in, in, in, - out, out, out) is semidet. +:- pred abstractly_unify_inst_functor_2(is_live::in, (inst)::in, cons_id::in, + list(inst)::in, list(is_live)::in, unify_is_real::in, (type)::in, + (inst)::out, determinism::out, module_info::in, module_info::out) + is semidet. -abstractly_unify_inst_functor_2(live, not_reached, _, _, _, _, _, M, - not_reached, erroneous, M). +abstractly_unify_inst_functor_2(live, not_reached, _, _, _, _, _, + not_reached, erroneous, !ModuleInfo). abstractly_unify_inst_functor_2(live, free, ConsId, Args0, ArgLives, _Real, - _, ModuleInfo0, - bound(unique, [functor(ConsId, Args)]), det, - ModuleInfo) :- - inst_list_is_ground_or_any_or_dead(Args0, ArgLives, ModuleInfo0), - maybe_make_shared_inst_list(Args0, ArgLives, ModuleInfo0, - Args, ModuleInfo). + _, bound(unique, [functor(ConsId, Args)]), det, + !ModuleInfo) :- + inst_list_is_ground_or_any_or_dead(Args0, ArgLives, !.ModuleInfo), + maybe_make_shared_inst_list(Args0, ArgLives, Args, !ModuleInfo). abstractly_unify_inst_functor_2(live, any(Uniq), ConsId, ArgInsts, - ArgLives, Real, Type, ModuleInfo0, Inst, Det, ModuleInfo) :- + ArgLives, Real, Type, Inst, Det, !ModuleInfo) :- % We only allow `any' to unify with a functor if we know that % the type is not a solver type. - \+ type_util__is_solver_type(ModuleInfo0, Type), + \+ type_util__is_solver_type(!.ModuleInfo, Type), make_any_inst_list_lives(ArgInsts, live, ArgLives, Uniq, Real, - ModuleInfo0, AnyArgInsts, Det, ModuleInfo), + AnyArgInsts, Det, !ModuleInfo), Inst = bound(Uniq, [functor(ConsId, AnyArgInsts)]). abstractly_unify_inst_functor_2(live, bound(Uniq, ListX), ConsId, Args, - ArgLives, Real, _, M0, bound(Uniq, List), Det, M) :- + ArgLives, Real, _, bound(Uniq, List), Det, + !ModuleInfo) :- abstractly_unify_bound_inst_list_lives(ListX, ConsId, Args, ArgLives, - Real, M0, List, Det, M). + Real, List, Det, !ModuleInfo). abstractly_unify_inst_functor_2(live, ground(Uniq, _), ConsId, ArgInsts, - ArgLives, Real, _, M0, Inst, Det, M) :- - make_ground_inst_list_lives(ArgInsts, live, ArgLives, Uniq, Real, M0, - GroundArgInsts, Det, M), + ArgLives, Real, _, Inst, Det, !ModuleInfo) :- + make_ground_inst_list_lives(ArgInsts, live, ArgLives, Uniq, Real, + GroundArgInsts, Det, !ModuleInfo), Inst = bound(Uniq, [functor(ConsId, GroundArgInsts)]). % abstractly_unify_inst_functor_2(live, abstract_inst(_,_), _, _, _, _, _, % _, _) :- % fail. -abstractly_unify_inst_functor_2(dead, not_reached, _, _, _, _, _, M, - not_reached, erroneous, M). +abstractly_unify_inst_functor_2(dead, not_reached, _, _, _, _, _, + not_reached, erroneous, !ModuleInfo). abstractly_unify_inst_functor_2(dead, free, ConsId, Args, _ArgLives, _Real, _, - M, bound(unique, [functor(ConsId, Args)]), det, M). + bound(unique, [functor(ConsId, Args)]), det, !ModuleInfo). abstractly_unify_inst_functor_2(dead, any(Uniq), ConsId, ArgInsts, - _ArgLives, Real, Type, ModuleInfo0, Inst, Det, ModuleInfo) :- - \+ type_util__is_solver_type(ModuleInfo0, Type), - make_any_inst_list(ArgInsts, dead, Uniq, Real, ModuleInfo0, - AnyArgInsts, Det, ModuleInfo), + _ArgLives, Real, Type, Inst, Det, !ModuleInfo) :- + \+ type_util__is_solver_type(!.ModuleInfo, Type), + make_any_inst_list(ArgInsts, dead, Uniq, Real, AnyArgInsts, Det, + !ModuleInfo), Inst = bound(Uniq, [functor(ConsId, AnyArgInsts)]). abstractly_unify_inst_functor_2(dead, bound(Uniq, ListX), ConsId, Args, - _ArgLives, Real, _, M0, bound(Uniq, List), Det, M) :- + _ArgLives, Real, _, bound(Uniq, List), Det, !ModuleInfo) :- ListY = [functor(ConsId, Args)], - abstractly_unify_bound_inst_list(dead, ListX, ListY, Real, M0, - List, Det, M). + abstractly_unify_bound_inst_list(dead, ListX, ListY, Real, List, Det, + !ModuleInfo). abstractly_unify_inst_functor_2(dead, ground(Uniq, _), ConsId, ArgInsts, - _ArgLives, Real, _, M0, Inst, Det, M) :- - make_ground_inst_list(ArgInsts, dead, Uniq, Real, M0, - GroundArgInsts, Det, M), + _ArgLives, Real, _, Inst, Det, !ModuleInfo) :- + make_ground_inst_list(ArgInsts, dead, Uniq, Real, GroundArgInsts, Det, + !ModuleInfo), Inst = bound(Uniq, [functor(ConsId, GroundArgInsts)]). % abstractly_unify_inst_functor_2(dead, abstract_inst(_,_), _, _, _, _, @@ -603,14 +601,12 @@ abstractly_unify_inst_functor_2(dead, ground(Uniq, _), ConsId, ArgInsts, % and determinism checking of the goal for the unification % predicate for the type. -:- pred abstractly_unify_bound_inst_list(is_live, list(bound_inst), - list(bound_inst), unify_is_real, module_info, - list(bound_inst), determinism, module_info). -:- mode abstractly_unify_bound_inst_list(in, in, in, in, in, - out, out, out) is semidet. +:- pred abstractly_unify_bound_inst_list(is_live::in, list(bound_inst)::in, + list(bound_inst)::in, unify_is_real::in, + list(bound_inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. -abstractly_unify_bound_inst_list(Live, Xs, Ys, Real, ModuleInfo0, L, Det, - ModuleInfo) :- +abstractly_unify_bound_inst_list(Live, Xs, Ys, Real, L, Det, !ModuleInfo) :- ( ( Xs = [] ; Ys = [] ) -> % % This probably shouldn't happen. If we get here, @@ -619,11 +615,10 @@ abstractly_unify_bound_inst_list(Live, Xs, Ys, Real, ModuleInfo0, L, Det, % away the rest of the conjunction after that goal. % L = [], - Det = erroneous, - ModuleInfo = ModuleInfo0 + Det = erroneous ; abstractly_unify_bound_inst_list_2(Live, Xs, Ys, Real, - ModuleInfo0, L, Det0, ModuleInfo), + L, Det0, !ModuleInfo), % % If there are multiple alternatives for either of @@ -639,24 +634,23 @@ abstractly_unify_bound_inst_list(Live, Xs, Ys, Real, ModuleInfo0, L, Det, ) ). -:- pred abstractly_unify_bound_inst_list_2(is_live, list(bound_inst), - list(bound_inst), unify_is_real, module_info, - list(bound_inst), determinism, module_info). -:- mode abstractly_unify_bound_inst_list_2(in, in, in, in, in, - out, out, out) is semidet. +:- pred abstractly_unify_bound_inst_list_2(is_live::in, list(bound_inst)::in, + list(bound_inst)::in, unify_is_real::in, + list(bound_inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. -abstractly_unify_bound_inst_list_2(_, [], [], _, M, [], erroneous, M). -abstractly_unify_bound_inst_list_2(_, [], [_|_], _, M, [], failure, M). -abstractly_unify_bound_inst_list_2(_, [_|_], [], _, M, [], failure, M). -abstractly_unify_bound_inst_list_2(Live, [X|Xs], [Y|Ys], Real, ModuleInfo0, - L, Det, ModuleInfo) :- +abstractly_unify_bound_inst_list_2(_, [], [], _, [], erroneous, !ModuleInfo). +abstractly_unify_bound_inst_list_2(_, [], [_|_], _, [], failure, !ModuleInfo). +abstractly_unify_bound_inst_list_2(_, [_|_], [], _, [], failure, !ModuleInfo). +abstractly_unify_bound_inst_list_2(Live, [X|Xs], [Y|Ys], Real, L, Det, + !ModuleInfo) :- X = functor(ConsIdX, ArgsX), Y = functor(ConsIdY, ArgsY), ( ConsIdX = ConsIdY -> abstractly_unify_inst_list(ArgsX, ArgsY, Live, Real, - ModuleInfo0, Args, Det1, ModuleInfo1), + Args, Det1, !ModuleInfo), abstractly_unify_bound_inst_list_2(Live, Xs, Ys, Real, - ModuleInfo1, L1, Det2, ModuleInfo), + L1, Det2, !ModuleInfo), % If the unification of the two cons_ids is guaranteed % not to succeed, don't include it in the list. @@ -669,64 +663,61 @@ abstractly_unify_bound_inst_list_2(Live, [X|Xs], [Y|Ys], Real, ModuleInfo0, ; ( compare(<, ConsIdX, ConsIdY) -> abstractly_unify_bound_inst_list_2(Live, Xs, [Y|Ys], - Real, ModuleInfo0, L, Det1, ModuleInfo) + Real, L, Det1, !ModuleInfo) ; abstractly_unify_bound_inst_list_2(Live, [X|Xs], Ys, - Real, ModuleInfo0, L, Det1, ModuleInfo) + Real, L, Det1, !ModuleInfo) ), det_switch_detism(Det1, failure, Det) ). -:- pred abstractly_unify_bound_inst_list_lives(list(bound_inst), cons_id, - list(inst), list(is_live), unify_is_real, module_info, - list(bound_inst), determinism, module_info). -:- mode abstractly_unify_bound_inst_list_lives(in, in, in, in, in, in, - out, out, out) is semidet. +:- pred abstractly_unify_bound_inst_list_lives(list(bound_inst)::in, + cons_id::in, list(inst)::in, list(is_live)::in, + unify_is_real::in, list(bound_inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. -abstractly_unify_bound_inst_list_lives([], _, _, _, _, ModuleInfo, - [], failure, ModuleInfo). +abstractly_unify_bound_inst_list_lives([], _, _, _, _, [], failure, + !ModuleInfo). abstractly_unify_bound_inst_list_lives([X|Xs], ConsIdY, ArgsY, LivesY, Real, - ModuleInfo0, L, Det, ModuleInfo) :- + L, Det, !ModuleInfo) :- X = functor(ConsIdX, ArgsX), ( ConsIdX = ConsIdY -> abstractly_unify_inst_list_lives(ArgsX, ArgsY, LivesY, Real, - ModuleInfo0, Args, Det, ModuleInfo), + Args, Det, !ModuleInfo), L = [functor(ConsIdX, Args)] ; abstractly_unify_bound_inst_list_lives(Xs, ConsIdY, ArgsY, - LivesY, Real, ModuleInfo0, L, Det, ModuleInfo) + LivesY, Real, L, Det, !ModuleInfo) ). -:- pred abstractly_unify_inst_list_lives(list(inst), list(inst), list(is_live), - unify_is_real, module_info, list(inst), determinism, module_info). -:- mode abstractly_unify_inst_list_lives(in, in, in, in, in, out, out, out) - is semidet. +:- pred abstractly_unify_inst_list_lives(list(inst)::in, list(inst)::in, + list(is_live)::in, unify_is_real::in, + list(inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. -abstractly_unify_inst_list_lives([], [], [], _, ModuleInfo, - [], det, ModuleInfo). +abstractly_unify_inst_list_lives([], [], [], _, [], det, !ModuleInfo). abstractly_unify_inst_list_lives([X|Xs], [Y|Ys], [Live|Lives], Real, - ModuleInfo0, [Z|Zs], Det, ModuleInfo) :- - abstractly_unify_inst(Live, X, Y, Real, ModuleInfo0, - Z, Det1, ModuleInfo1), - abstractly_unify_inst_list_lives(Xs, Ys, Lives, Real, ModuleInfo1, - Zs, Det2, ModuleInfo), + [Z|Zs], Det, !ModuleInfo) :- + abstractly_unify_inst(Live, X, Y, Real, Z, Det1, !ModuleInfo), + abstractly_unify_inst_list_lives(Xs, Ys, Lives, Real, Zs, Det2, + !ModuleInfo), det_par_conjunction_detism(Det1, Det2, Det). %-----------------------------------------------------------------------------% -:- pred abstractly_unify_constrained_inst_vars(is_live, set(inst_var), inst, - inst, unify_is_real, module_info, inst, determinism, module_info). -:- mode abstractly_unify_constrained_inst_vars(in, in, in, in, in, in, out, - out, out) is semidet. +:- pred abstractly_unify_constrained_inst_vars(is_live::in, set(inst_var)::in, + (inst)::in, (inst)::in, unify_is_real::in, + (inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. abstractly_unify_constrained_inst_vars(IsLive, InstVars, InstConstraint, InstB, - UnifyIsReal, ModuleInfo0, Inst, Det, ModuleInfo) :- + UnifyIsReal, Inst, Det, !ModuleInfo) :- abstractly_unify_inst(IsLive, InstConstraint, InstB, UnifyIsReal, - ModuleInfo0, Inst0, Det, ModuleInfo), + Inst0, Det, !ModuleInfo), ( - \+ inst_matches_final(Inst0, InstConstraint, ModuleInfo) + \+ inst_matches_final(Inst0, InstConstraint, !.ModuleInfo) -> % The inst has become too instantiated so the % constrained_inst_vars must be removed. @@ -736,7 +727,7 @@ abstractly_unify_constrained_inst_vars(IsLive, InstVars, InstConstraint, InstB, -> % Avoid nested constrained_inst_vars. Inst = constrained_inst_vars(set__union(InstVars0, InstVars), - Inst1) + Inst1) ; % We can keep the constrained_inst_vars. Inst = constrained_inst_vars(InstVars, Inst0) @@ -745,9 +736,8 @@ abstractly_unify_constrained_inst_vars(IsLive, InstVars, InstConstraint, InstB, %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% -:- pred unify_uniq(is_live, unify_is_real, determinism, uniqueness, uniqueness, - uniqueness). -:- mode unify_uniq(in, in, in, in, in, out) is semidet. +:- pred unify_uniq(is_live::in, unify_is_real::in, determinism::in, + uniqueness::in, uniqueness::in, uniqueness::out) is semidet. % Unifying shared with either shared or unique gives shared. % Unifying unique with unique gives shared if live, unique if @@ -776,48 +766,48 @@ abstractly_unify_constrained_inst_vars(IsLive, InstVars, InstConstraint, InstB, % of a clobbered variable, so those are the only ones we need to % disallow. -unify_uniq(_, _, _, shared, shared, shared). -unify_uniq(_, _, _, shared, unique, shared). -unify_uniq(_, _, _, shared, mostly_unique, shared). -unify_uniq(Live, Real, Det, shared, clobbered, clobbered) :- +unify_uniq(_, _, _, shared, shared, shared). +unify_uniq(_, _, _, shared, unique, shared). +unify_uniq(_, _, _, shared, mostly_unique, shared). +unify_uniq(Live, Real, Det, shared, clobbered, clobbered) :- allow_unify_with_clobbered(Live, Real, Det). -unify_uniq(Live, Real, Det, shared, mostly_clobbered, mostly_clobbered) :- +unify_uniq(Live, Real, Det, shared, mostly_clobbered, mostly_clobbered) :- allow_unify_with_clobbered(Live, Real, Det). -unify_uniq(_, _, _, unique, shared, shared). -unify_uniq(live, _, _, unique, unique, shared). -unify_uniq(live, _, _, unique, mostly_unique, shared). -unify_uniq(dead, _, _, unique, unique, unique). -unify_uniq(dead, _, _, unique, mostly_unique, mostly_unique). +unify_uniq(_, _, _, unique, shared, shared). +unify_uniq(live, _, _, unique, unique, shared). +unify_uniq(live, _, _, unique, mostly_unique, shared). +unify_uniq(dead, _, _, unique, unique, unique). +unify_uniq(dead, _, _, unique, mostly_unique, mostly_unique). % XXX the above line is a conservative approximation % sometimes it should return unique not mostly_unique -unify_uniq(Live, Real, Det, unique, clobbered, clobbered) :- +unify_uniq(Live, Real, Det, unique, clobbered, clobbered) :- allow_unify_with_clobbered(Live, Real, Det). -unify_uniq(Live, Real, Det, unique, mostly_clobbered, mostly_clobbered) :- +unify_uniq(Live, Real, Det, unique, mostly_clobbered, mostly_clobbered) :- allow_unify_with_clobbered(Live, Real, Det). -unify_uniq(_, _, _, mostly_unique, shared, shared). -unify_uniq(live, _, _, mostly_unique, unique, shared). -unify_uniq(live, _, _, mostly_unique, mostly_unique, shared). -unify_uniq(dead, _, _, mostly_unique, unique, mostly_unique). +unify_uniq(_, _, _, mostly_unique, shared, shared). +unify_uniq(live, _, _, mostly_unique, unique, shared). +unify_uniq(live, _, _, mostly_unique, mostly_unique, shared). +unify_uniq(dead, _, _, mostly_unique, unique, mostly_unique). % XXX the above line is a conservative approximation % sometimes it should return unique not mostly_unique -unify_uniq(dead, _, _, mostly_unique, mostly_unique, mostly_unique). -unify_uniq(Live, Real, Det, mostly_unique, clobbered, clobbered) :- +unify_uniq(dead, _, _, mostly_unique, mostly_unique, mostly_unique). +unify_uniq(Live, Real, Det, mostly_unique, clobbered, clobbered) :- allow_unify_with_clobbered(Live, Real, Det). -unify_uniq(Live, Real, Det, mostly_unique, mostly_clobbered, - mostly_clobbered) :- +unify_uniq(Live, Real, Det, mostly_unique, mostly_clobbered, + mostly_clobbered) :- allow_unify_with_clobbered(Live, Real, Det). -unify_uniq(Live, Real, Det, clobbered, _, clobbered) :- +unify_uniq(Live, Real, Det, clobbered, _, clobbered) :- allow_unify_with_clobbered(Live, Real, Det). -unify_uniq(Live, Real, Det, mostly_clobbered, Uniq0, Uniq) :- +unify_uniq(Live, Real, Det, mostly_clobbered, Uniq0, Uniq) :- ( Uniq0 = clobbered -> Uniq = clobbered ; Uniq = mostly_clobbered ), allow_unify_with_clobbered(Live, Real, Det). -:- pred allow_unify_with_clobbered(is_live, unify_is_real, determinism). -:- mode allow_unify_with_clobbered(in, in, in) is semidet. +:- pred allow_unify_with_clobbered(is_live::in, unify_is_real::in, + determinism::in) is semidet. allow_unify_with_clobbered(live, _, _) :- error("allow_unify_with_clobbered: clobbered value is live?"). @@ -826,8 +816,7 @@ allow_unify_with_clobbered(dead, _, det). %-----------------------------------------------------------------------------% -:- pred check_not_clobbered(uniqueness, unify_is_real). -:- mode check_not_clobbered(in, in) is det. +:- pred check_not_clobbered(uniqueness::in, unify_is_real::in) is det. % sanity check check_not_clobbered(Uniq, Real) :- @@ -841,77 +830,77 @@ check_not_clobbered(Uniq, Real) :- %-----------------------------------------------------------------------------% -:- pred make_ground_inst_list_lives(list(inst), is_live, list(is_live), - uniqueness, unify_is_real, - module_info, list(inst), determinism, module_info). -:- mode make_ground_inst_list_lives(in, in, in, in, in, in, out, out, out) - is semidet. +:- pred make_ground_inst_list_lives(list(inst)::in, is_live::in, + list(is_live)::in, uniqueness::in, unify_is_real::in, + list(inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. -make_ground_inst_list_lives([], _, _, _, _, ModuleInfo, [], det, ModuleInfo). +make_ground_inst_list_lives([], _, _, _, _, [], det, !ModuleInfo). make_ground_inst_list_lives([Inst0 | Insts0], Live, [ArgLive | ArgLives], - Uniq, Real, ModuleInfo0, [Inst | Insts], Det, ModuleInfo) :- + Uniq, Real, [Inst | Insts], Det, !ModuleInfo) :- ( Live = live, ArgLive = live -> BothLive = live ; BothLive = dead ), - make_ground_inst(Inst0, BothLive, Uniq, Real, ModuleInfo0, - Inst, Det1, ModuleInfo1), + make_ground_inst(Inst0, BothLive, Uniq, Real, Inst, Det1, + !ModuleInfo), make_ground_inst_list_lives(Insts0, Live, ArgLives, Uniq, Real, - ModuleInfo1, Insts, Det2, ModuleInfo), + Insts, Det2, !ModuleInfo), det_par_conjunction_detism(Det1, Det2, Det). -:- pred make_ground_inst_list(list(inst), is_live, uniqueness, unify_is_real, - module_info, list(inst), determinism, module_info). -:- mode make_ground_inst_list(in, in, in, in, in, out, out, out) is semidet. +:- pred make_ground_inst_list(list(inst)::in, is_live::in, uniqueness::in, + unify_is_real::in, list(inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. -make_ground_inst_list([], _, _, _, ModuleInfo, [], det, ModuleInfo). -make_ground_inst_list([Inst0 | Insts0], Live, Uniq, Real, ModuleInfo0, - [Inst | Insts], Det, ModuleInfo) :- - make_ground_inst(Inst0, Live, Uniq, Real, ModuleInfo0, - Inst, Det1, ModuleInfo1), - make_ground_inst_list(Insts0, Live, Uniq, Real, ModuleInfo1, - Insts, Det2, ModuleInfo), +make_ground_inst_list([], _, _, _, [], det, !ModuleInfo). +make_ground_inst_list([Inst0 | Insts0], Live, Uniq, Real, [Inst | Insts], Det, + !ModuleInfo) :- + make_ground_inst(Inst0, Live, Uniq, Real, Inst, Det1, !ModuleInfo), + make_ground_inst_list(Insts0, Live, Uniq, Real, Insts, Det2, + !ModuleInfo), det_par_conjunction_detism(Det1, Det2, Det). % abstractly unify an inst with `ground' and calculate the new inst % and the determinism of the unification. -:- pred make_ground_inst(inst, is_live, uniqueness, unify_is_real, module_info, - inst, determinism, module_info). -:- mode make_ground_inst(in, in, in, in, in, out, out, out) is semidet. +:- pred make_ground_inst((inst)::in, is_live::in, uniqueness::in, + unify_is_real::in, (inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. -make_ground_inst(not_reached, _, _, _, M, not_reached, erroneous, M). -make_ground_inst(any(Uniq0), IsLive, Uniq1, Real, M, ground(Uniq, none), - semidet, M) :- +make_ground_inst(not_reached, _, _, _, not_reached, erroneous, !ModuleInfo). +make_ground_inst(any(Uniq0), IsLive, Uniq1, Real, ground(Uniq, none), + semidet, !ModuleInfo) :- unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq). -make_ground_inst(free, IsLive, Uniq0, Real, M, ground(Uniq, none), det, M) :- +make_ground_inst(free, IsLive, Uniq0, Real, ground(Uniq, none), det, + !ModuleInfo) :- unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq). -make_ground_inst(free(T), IsLive, Uniq0, Real, M, - defined_inst(typed_ground(Uniq, T)), det, M) :- +make_ground_inst(free(T), IsLive, Uniq0, Real, + defined_inst(typed_ground(Uniq, T)), det, !ModuleInfo) :- unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq). -make_ground_inst(bound(Uniq0, BoundInsts0), IsLive, Uniq1, Real, M0, - bound(Uniq, BoundInsts), Det, M) :- +make_ground_inst(bound(Uniq0, BoundInsts0), IsLive, Uniq1, Real, + bound(Uniq, BoundInsts), Det, !ModuleInfo) :- unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq), - make_ground_bound_inst_list(BoundInsts0, IsLive, Uniq1, Real, M0, - BoundInsts, Det1, M), + make_ground_bound_inst_list(BoundInsts0, IsLive, Uniq1, Real, + BoundInsts, Det1, !ModuleInfo), det_par_conjunction_detism(Det1, semidet, Det). -make_ground_inst(ground(Uniq0, GroundInstInfo), IsLive, Uniq1, Real, M, - ground(Uniq, GroundInstInfo), semidet, M) :- +make_ground_inst(ground(Uniq0, GroundInstInfo), IsLive, Uniq1, Real, + ground(Uniq, GroundInstInfo), semidet, !ModuleInfo) :- unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq). make_ground_inst(inst_var(_), _, _, _, _, _, _, _) :- error("free inst var"). make_ground_inst(constrained_inst_vars(InstVars, InstConstraint), IsLive, - Uniq, Real, M0, Inst, Det, M) :- + Uniq, Real, Inst, Det, !ModuleInfo) :- abstractly_unify_constrained_inst_vars(IsLive, InstVars, - InstConstraint, ground(Uniq, none), Real, M0, Inst, Det, M). -make_ground_inst(abstract_inst(_,_), _, _, _, M, ground(shared, none), - semidet, M). -make_ground_inst(defined_inst(InstName), IsLive, Uniq, Real, ModuleInfo0, - Inst, Det, ModuleInfo) :- + InstConstraint, ground(Uniq, none), Real, Inst, Det, + !ModuleInfo). +make_ground_inst(abstract_inst(_,_), _, _, _, ground(shared, none), + semidet, !ModuleInfo). +make_ground_inst(defined_inst(InstName), IsLive, Uniq, Real, Inst, Det, + !ModuleInfo) :- % check whether the inst name is already in the % ground_inst table - module_info_insts(ModuleInfo0, InstTable0), + module_info_insts(!.ModuleInfo, InstTable0), inst_table_get_ground_insts(InstTable0, GroundInsts0), GroundInstKey = ground_inst(InstName, IsLive, Uniq, Real), ( @@ -927,56 +916,55 @@ make_ground_inst(defined_inst(InstName), IsLive, Uniq, Real, ModuleInfo0, % if it were semidet, we would have noticed % this in the process of unfolding the % definition. - ), - ModuleInfo = ModuleInfo0 + ) ; % insert the inst name in the ground_inst table, with % value `unknown' for the moment - map__det_insert(GroundInsts0, GroundInstKey, unknown, - GroundInsts1), + svmap__det_insert(GroundInstKey, unknown, + GroundInsts0, GroundInsts1), inst_table_set_ground_insts(GroundInsts1, InstTable0, InstTable1), - module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1), + module_info_set_insts(InstTable1, !ModuleInfo), % expand the inst name, and invoke ourself recursively on % it's expansion - inst_lookup(ModuleInfo1, InstName, Inst0), - inst_expand(ModuleInfo1, Inst0, Inst1), - make_ground_inst(Inst1, IsLive, Uniq, Real, ModuleInfo1, - GroundInst, Det, ModuleInfo2), + inst_lookup(!.ModuleInfo, InstName, Inst0), + inst_expand(!.ModuleInfo, Inst0, Inst1), + make_ground_inst(Inst1, IsLive, Uniq, Real, GroundInst, Det, + !ModuleInfo), % now that we have determined the resulting Inst, store % the appropriate value `known(GroundInst, Det)' in the % ground_inst table - module_info_insts(ModuleInfo2, InstTable2), + module_info_insts(!.ModuleInfo, InstTable2), inst_table_get_ground_insts(InstTable2, GroundInsts2), - map__det_update(GroundInsts2, GroundInstKey, - known(GroundInst, Det), GroundInsts), + svmap__det_update(GroundInstKey, known(GroundInst, Det), + GroundInsts2, GroundInsts), inst_table_set_ground_insts(GroundInsts, InstTable2, InstTable), - module_info_set_insts(InstTable, ModuleInfo2, ModuleInfo) + module_info_set_insts(InstTable, !ModuleInfo) ), % avoid expanding recursive insts - ( inst_contains_instname(GroundInst, ModuleInfo, GroundInstKey) -> + ( inst_contains_instname(GroundInst, !.ModuleInfo, GroundInstKey) -> Inst = defined_inst(GroundInstKey) ; Inst = GroundInst ). -:- pred make_ground_bound_inst_list(list(bound_inst), is_live, uniqueness, - unify_is_real, module_info, list(bound_inst), determinism, module_info). -:- mode make_ground_bound_inst_list(in, in, in, in, in, - out, out, out) is semidet. +:- pred make_ground_bound_inst_list(list(bound_inst)::in, is_live::in, + uniqueness::in, unify_is_real::in, + list(bound_inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. -make_ground_bound_inst_list([], _, _, _, ModuleInfo, [], det, ModuleInfo). -make_ground_bound_inst_list([Bound0 | Bounds0], IsLive, Uniq, Real, ModuleInfo0, - [Bound | Bounds], Det, ModuleInfo) :- +make_ground_bound_inst_list([], _, _, _, [], det, !ModuleInfo). +make_ground_bound_inst_list([Bound0 | Bounds0], IsLive, Uniq, Real, + [Bound | Bounds], Det, !ModuleInfo) :- Bound0 = functor(ConsId, ArgInsts0), - make_ground_inst_list(ArgInsts0, IsLive, Uniq, Real, ModuleInfo0, - ArgInsts, Det1, ModuleInfo1), + make_ground_inst_list(ArgInsts0, IsLive, Uniq, Real, ArgInsts, Det1, + !ModuleInfo), Bound = functor(ConsId, ArgInsts), - make_ground_bound_inst_list(Bounds0, IsLive, Uniq, Real, ModuleInfo1, - Bounds, Det2, ModuleInfo), + make_ground_bound_inst_list(Bounds0, IsLive, Uniq, Real, Bounds, Det2, + !ModuleInfo), det_par_conjunction_detism(Det1, Det2, Det). %-----------------------------------------------------------------------------% @@ -984,48 +972,47 @@ make_ground_bound_inst_list([Bound0 | Bounds0], IsLive, Uniq, Real, ModuleInfo0, % abstractly unify an inst with `any' and calculate the new inst % and the determinism of the unification. -:- pred make_any_inst(inst, is_live, uniqueness, unify_is_real, module_info, - inst, determinism, module_info). -:- mode make_any_inst(in, in, in, in, in, out, out, out) is semidet. +:- pred make_any_inst((inst)::in, is_live::in, uniqueness::in, + unify_is_real::in, (inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. -make_any_inst(not_reached, _, _, _, M, not_reached, erroneous, M). -make_any_inst(any(Uniq0), IsLive, Uniq1, Real, M, any(Uniq), - semidet, M) :- +make_any_inst(not_reached, _, _, _, not_reached, erroneous, !ModuleInfo). +make_any_inst(any(Uniq0), IsLive, Uniq1, Real, any(Uniq), semidet, + !ModuleInfo) :- allow_unify_bound_any(Real), unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq). -make_any_inst(free, IsLive, Uniq0, Real, M, any(Uniq), det, M) :- +make_any_inst(free, IsLive, Uniq0, Real, any(Uniq), det, !ModuleInfo) :- unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq). -make_any_inst(free(T), IsLive, Uniq, Real, M, - defined_inst(Any), det, M) :- +make_any_inst(free(T), IsLive, Uniq, Real, defined_inst(Any), det, + !ModuleInfo) :- % The following is a round-about way of doing this % unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq), % Any = typed_any(Uniq, T). % without the need for a `typed_any' inst. Any = typed_inst(T, unify_inst(IsLive, free, any(Uniq), Real)). -make_any_inst(bound(Uniq0, BoundInsts0), IsLive, Uniq1, Real, M0, - bound(Uniq, BoundInsts), Det, M) :- +make_any_inst(bound(Uniq0, BoundInsts0), IsLive, Uniq1, Real, + bound(Uniq, BoundInsts), Det, !ModuleInfo) :- allow_unify_bound_any(Real), unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq), - make_any_bound_inst_list(BoundInsts0, IsLive, Uniq1, Real, M0, - BoundInsts, Det1, M), + make_any_bound_inst_list(BoundInsts0, IsLive, Uniq1, Real, + BoundInsts, Det1, !ModuleInfo), det_par_conjunction_detism(Det1, semidet, Det). -make_any_inst(ground(Uniq0, PredInst), IsLive, Uniq1, Real, M, - ground(Uniq, PredInst), semidet, M) :- +make_any_inst(ground(Uniq0, PredInst), IsLive, Uniq1, Real, + ground(Uniq, PredInst), semidet, !ModuleInfo) :- allow_unify_bound_any(Real), unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq). make_any_inst(inst_var(_), _, _, _, _, _, _, _) :- error("free inst var"). make_any_inst(constrained_inst_vars(InstVars, InstConstraint), IsLive, - Uniq, Real, M0, Inst, Det, M) :- + Uniq, Real, Inst, Det, !ModuleInfo) :- abstractly_unify_constrained_inst_vars(IsLive, InstVars, - InstConstraint, any(Uniq), Real, M0, Inst, Det, M). -make_any_inst(abstract_inst(_,_), _, _, _, M, any(shared), - semidet, M). -make_any_inst(defined_inst(InstName), IsLive, Uniq, Real, ModuleInfo0, - Inst, Det, ModuleInfo) :- + InstConstraint, any(Uniq), Real, Inst, Det, !ModuleInfo). +make_any_inst(abstract_inst(_,_), _, _, _, any(shared), semidet, !ModuleInfo). +make_any_inst(defined_inst(InstName), IsLive, Uniq, Real, Inst, Det, + !ModuleInfo) :- % check whether the inst name is already in the % any_inst table - module_info_insts(ModuleInfo0, InstTable0), + module_info_insts(!.ModuleInfo, InstTable0), inst_table_get_any_insts(InstTable0, AnyInsts0), AnyInstKey = any_inst(InstName, IsLive, Uniq, Real), ( @@ -1041,156 +1028,146 @@ make_any_inst(defined_inst(InstName), IsLive, Uniq, Real, ModuleInfo0, % if it were semidet, we would have noticed % this in the process of unfolding the % definition. - ), - ModuleInfo = ModuleInfo0 + ) ; % insert the inst name in the any_inst table, with % value `unknown' for the moment - map__det_insert(AnyInsts0, AnyInstKey, unknown, - AnyInsts1), + svmap__det_insert(AnyInstKey, unknown, AnyInsts0, AnyInsts1), inst_table_set_any_insts(AnyInsts1, InstTable0, InstTable1), - module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1), + module_info_set_insts(InstTable1, !ModuleInfo), % expand the inst name, and invoke ourself recursively on % it's expansion - inst_lookup(ModuleInfo1, InstName, Inst0), - inst_expand(ModuleInfo1, Inst0, Inst1), - make_any_inst(Inst1, IsLive, Uniq, Real, ModuleInfo1, - AnyInst, Det, ModuleInfo2), + inst_lookup(!.ModuleInfo, InstName, Inst0), + inst_expand(!.ModuleInfo, Inst0, Inst1), + make_any_inst(Inst1, IsLive, Uniq, Real, AnyInst, Det, + !ModuleInfo), % now that we have determined the resulting Inst, store % the appropriate value `known(AnyInst, Det)' in the % any_inst table - module_info_insts(ModuleInfo2, InstTable2), + module_info_insts(!.ModuleInfo, InstTable2), inst_table_get_any_insts(InstTable2, AnyInsts2), - map__det_update(AnyInsts2, AnyInstKey, - known(AnyInst, Det), AnyInsts), + svmap__det_update(AnyInstKey, known(AnyInst, Det), + AnyInsts2, AnyInsts), inst_table_set_any_insts(AnyInsts, InstTable2, InstTable), - module_info_set_insts(InstTable, ModuleInfo2, ModuleInfo) + module_info_set_insts(InstTable, !ModuleInfo) ), % avoid expanding recursive insts - ( inst_contains_instname(AnyInst, ModuleInfo, AnyInstKey) -> + ( inst_contains_instname(AnyInst, !.ModuleInfo, AnyInstKey) -> Inst = defined_inst(AnyInstKey) ; Inst = AnyInst ). -:- pred make_any_bound_inst_list(list(bound_inst), is_live, uniqueness, - unify_is_real, module_info, list(bound_inst), determinism, module_info). -:- mode make_any_bound_inst_list(in, in, in, in, in, - out, out, out) is semidet. +:- pred make_any_bound_inst_list(list(bound_inst)::in, is_live::in, + uniqueness::in, unify_is_real::in, + list(bound_inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. -make_any_bound_inst_list([], _, _, _, ModuleInfo, [], det, ModuleInfo). -make_any_bound_inst_list([Bound0 | Bounds0], IsLive, Uniq, Real, ModuleInfo0, - [Bound | Bounds], Det, ModuleInfo) :- +make_any_bound_inst_list([], _, _, _, [], det, !ModuleInfo). +make_any_bound_inst_list([Bound0 | Bounds0], IsLive, Uniq, Real, + [Bound | Bounds], Det, !ModuleInfo) :- Bound0 = functor(ConsId, ArgInsts0), - make_any_inst_list(ArgInsts0, IsLive, Uniq, Real, ModuleInfo0, - ArgInsts, Det1, ModuleInfo1), + make_any_inst_list(ArgInsts0, IsLive, Uniq, Real, + ArgInsts, Det1, !ModuleInfo), Bound = functor(ConsId, ArgInsts), - make_any_bound_inst_list(Bounds0, IsLive, Uniq, Real, ModuleInfo1, - Bounds, Det2, ModuleInfo), + make_any_bound_inst_list(Bounds0, IsLive, Uniq, Real, Bounds, Det2, + !ModuleInfo), det_par_conjunction_detism(Det1, Det2, Det). -:- pred make_any_inst_list(list(inst), is_live, uniqueness, unify_is_real, - module_info, list(inst), determinism, module_info). -:- mode make_any_inst_list(in, in, in, in, in, out, out, out) is semidet. +:- pred make_any_inst_list(list(inst)::in, is_live::in, uniqueness::in, + unify_is_real::in, list(inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. -make_any_inst_list([], _, _, _, ModuleInfo, [], det, ModuleInfo). -make_any_inst_list([Inst0 | Insts0], Live, Uniq, Real, ModuleInfo0, - [Inst | Insts], Det, ModuleInfo) :- - make_any_inst(Inst0, Live, Uniq, Real, ModuleInfo0, - Inst, Det1, ModuleInfo1), - make_any_inst_list(Insts0, Live, Uniq, Real, ModuleInfo1, - Insts, Det2, ModuleInfo), +make_any_inst_list([], _, _, _, [], det, !ModuleInfo). +make_any_inst_list([Inst0 | Insts0], Live, Uniq, Real, [Inst | Insts], Det, + !ModuleInfo) :- + make_any_inst(Inst0, Live, Uniq, Real, Inst, Det1, !ModuleInfo), + make_any_inst_list(Insts0, Live, Uniq, Real, Insts, Det2, !ModuleInfo), det_par_conjunction_detism(Det1, Det2, Det). -:- pred make_any_inst_list_lives(list(inst), is_live, list(is_live), - uniqueness, unify_is_real, - module_info, list(inst), determinism, module_info). -:- mode make_any_inst_list_lives(in, in, in, in, in, in, out, out, out) - is semidet. +:- pred make_any_inst_list_lives(list(inst)::in, is_live::in, list(is_live)::in, + uniqueness::in, unify_is_real::in, + list(inst)::out, determinism::out, + module_info::in, module_info::out) is semidet. -make_any_inst_list_lives([], _, _, _, _, ModuleInfo, [], det, ModuleInfo). +make_any_inst_list_lives([], _, _, _, _, [], det, !ModuleInfo). make_any_inst_list_lives([Inst0 | Insts0], Live, [ArgLive | ArgLives], - Uniq, Real, ModuleInfo0, [Inst | Insts], Det, ModuleInfo) :- + Uniq, Real, [Inst | Insts], Det, !ModuleInfo) :- ( Live = live, ArgLive = live -> BothLive = live ; BothLive = dead ), - make_any_inst(Inst0, BothLive, Uniq, Real, ModuleInfo0, - Inst, Det1, ModuleInfo1), + make_any_inst(Inst0, BothLive, Uniq, Real, Inst, Det1, !ModuleInfo), make_any_inst_list_lives(Insts0, Live, ArgLives, Uniq, Real, - ModuleInfo1, Insts, Det2, ModuleInfo), + Insts, Det2, !ModuleInfo), det_par_conjunction_detism(Det1, Det2, Det). %-----------------------------------------------------------------------------% -:- pred maybe_make_shared_inst_list(list(inst), list(is_live), module_info, - list(inst), module_info). -:- mode maybe_make_shared_inst_list(in, in, in, out, out) is det. +:- pred maybe_make_shared_inst_list(list(inst)::in, list(is_live)::in, + list(inst)::out, module_info::in, module_info::out) is det. -maybe_make_shared_inst_list([], [], ModuleInfo, [], ModuleInfo). -maybe_make_shared_inst_list([Inst0 | Insts0], [IsLive | IsLives], ModuleInfo0, - [Inst | Insts], ModuleInfo) :- +maybe_make_shared_inst_list([], [], [], !ModuleInfo). +maybe_make_shared_inst_list([Inst0 | Insts0], [IsLive | IsLives], + [Inst | Insts], !ModuleInfo) :- ( IsLive = live -> - make_shared_inst(Inst0, ModuleInfo0, Inst, ModuleInfo1) + make_shared_inst(Inst0, Inst, !ModuleInfo) ; - Inst = Inst0, - ModuleInfo1 = ModuleInfo0 + Inst = Inst0 ), - maybe_make_shared_inst_list(Insts0, IsLives, ModuleInfo1, - Insts, ModuleInfo). + maybe_make_shared_inst_list(Insts0, IsLives, Insts, !ModuleInfo). maybe_make_shared_inst_list([], [_|_], _, _, _) :- error("maybe_make_shared_inst_list: length mismatch"). maybe_make_shared_inst_list([_|_], [], _, _, _) :- error("maybe_make_shared_inst_list: length mismatch"). - -make_shared_inst_list([], ModuleInfo, [], ModuleInfo). -make_shared_inst_list([Inst0 | Insts0], ModuleInfo0, - [Inst | Insts], ModuleInfo) :- - make_shared_inst(Inst0, ModuleInfo0, Inst, ModuleInfo1), - make_shared_inst_list(Insts0, ModuleInfo1, Insts, ModuleInfo). +make_shared_inst_list([], [], !ModuleInfo). +make_shared_inst_list([Inst0 | Insts0], [Inst | Insts], !ModuleInfo) :- + make_shared_inst(Inst0, Inst, !ModuleInfo), + make_shared_inst_list(Insts0, Insts, !ModuleInfo). % make an inst shared; replace all occurrences of `unique' or `mostly_unique' % in the inst with `shared'. -:- pred make_shared_inst(inst, module_info, inst, module_info). -:- mode make_shared_inst(in, in, out, out) is det. +:- pred make_shared_inst((inst)::in, (inst)::out, + module_info::in, module_info::out) is det. -make_shared_inst(not_reached, M, not_reached, M). -make_shared_inst(any(Uniq0), M, any(Uniq), M) :- +make_shared_inst(not_reached, not_reached, !ModuleInfo). +make_shared_inst(any(Uniq0), any(Uniq), !ModuleInfo) :- make_shared(Uniq0, Uniq). -make_shared_inst(free, M, free, M) :- +make_shared_inst(free, free, !ModuleInfo) :- % the caller should ensure that this never happens error("make_shared_inst: cannot make shared version of `free'"). -make_shared_inst(free(T), M, free(T), M) :- +make_shared_inst(free(T), free(T), !ModuleInfo) :- % the caller should ensure that this never happens error("make_shared_inst: cannot make shared version of `free(T)'"). -make_shared_inst(bound(Uniq0, BoundInsts0), M0, bound(Uniq, BoundInsts), M) :- +make_shared_inst(bound(Uniq0, BoundInsts0), bound(Uniq, BoundInsts), + !ModuleInfo) :- make_shared(Uniq0, Uniq), - make_shared_bound_inst_list(BoundInsts0, M0, BoundInsts, M). -make_shared_inst(ground(Uniq0, PredInst), M, ground(Uniq, PredInst), M) :- + make_shared_bound_inst_list(BoundInsts0, BoundInsts, !ModuleInfo). +make_shared_inst(ground(Uniq0, PredInst), ground(Uniq, PredInst), + !ModuleInfo) :- make_shared(Uniq0, Uniq). make_shared_inst(inst_var(_), _, _, _) :- error("free inst var"). -make_shared_inst(constrained_inst_vars(InstVars, Inst0), ModuleInfo0, Inst, - ModuleInfo) :- - make_shared_inst(Inst0, ModuleInfo0, Inst1, ModuleInfo), +make_shared_inst(constrained_inst_vars(InstVars, Inst0), Inst, !ModuleInfo) :- + make_shared_inst(Inst0, Inst1, !ModuleInfo), ( - \+ inst_matches_final(Inst1, Inst0, ModuleInfo) + \+ inst_matches_final(Inst1, Inst0, !.ModuleInfo) -> Inst = Inst1 ; Inst = constrained_inst_vars(InstVars, Inst1) ). -make_shared_inst(abstract_inst(_,_), M, _, M) :- +make_shared_inst(abstract_inst(_,_), _, !ModuleInfo) :- error("make_shared_inst(abstract_inst)"). -make_shared_inst(defined_inst(InstName), ModuleInfo0, Inst, ModuleInfo) :- +make_shared_inst(defined_inst(InstName), Inst, !ModuleInfo) :- % check whether the inst name is already in the % shared_inst table - module_info_insts(ModuleInfo0, InstTable0), + module_info_insts(!.ModuleInfo, InstTable0), inst_table_get_shared_insts(InstTable0, SharedInsts0), ( map__search(SharedInsts0, InstName, Result) @@ -1199,42 +1176,41 @@ make_shared_inst(defined_inst(InstName), ModuleInfo0, Inst, ModuleInfo) :- SharedInst = SharedInst0 ; SharedInst = defined_inst(InstName) - ), - ModuleInfo = ModuleInfo0 + ) ; % insert the inst name in the shared_inst table, with % value `unknown' for the moment - map__det_insert(SharedInsts0, InstName, unknown, SharedInsts1), + svmap__det_insert(InstName, unknown, + SharedInsts0, SharedInsts1), inst_table_set_shared_insts(SharedInsts1, InstTable0, InstTable1), - module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1), + module_info_set_insts(InstTable1, !ModuleInfo), % expand the inst name, and invoke ourself recursively on % it's expansion - inst_lookup(ModuleInfo1, InstName, Inst0), - inst_expand(ModuleInfo1, Inst0, Inst1), - make_shared_inst(Inst1, ModuleInfo1, SharedInst, ModuleInfo2), + inst_lookup(!.ModuleInfo, InstName, Inst0), + inst_expand(!.ModuleInfo, Inst0, Inst1), + make_shared_inst(Inst1, SharedInst, !ModuleInfo), % now that we have determined the resulting Inst, store % the appropriate value `known(SharedInst)' in the shared_inst % table - module_info_insts(ModuleInfo2, InstTable2), + module_info_insts(!.ModuleInfo, InstTable2), inst_table_get_shared_insts(InstTable2, SharedInsts2), - map__det_update(SharedInsts2, InstName, known(SharedInst), - SharedInsts), + svmap__det_update(InstName, known(SharedInst), + SharedInsts2, SharedInsts), inst_table_set_shared_insts(SharedInsts, InstTable2, InstTable), - module_info_set_insts(InstTable, ModuleInfo2, ModuleInfo) + module_info_set_insts(InstTable, !ModuleInfo) ), % avoid expanding recursive insts - ( inst_contains_instname(SharedInst, ModuleInfo, InstName) -> + ( inst_contains_instname(SharedInst, !.ModuleInfo, InstName) -> Inst = defined_inst(InstName) ; Inst = SharedInst ). -:- pred make_shared(uniqueness, uniqueness). -:- mode make_shared(in, out) is det. +:- pred make_shared(uniqueness::in, uniqueness::out) is det. make_shared(unique, shared). make_shared(mostly_unique, shared). @@ -1242,19 +1218,16 @@ make_shared(shared, shared). make_shared(mostly_clobbered, mostly_clobbered). make_shared(clobbered, clobbered). -:- pred make_shared_bound_inst_list(list(bound_inst), module_info, - list(bound_inst), module_info). -:- mode make_shared_bound_inst_list(in, in, out, out) is det. +:- pred make_shared_bound_inst_list(list(bound_inst)::in, + list(bound_inst)::out, module_info::in, module_info::out) is det. -make_shared_bound_inst_list([], ModuleInfo, [], ModuleInfo). -make_shared_bound_inst_list([Bound0 | Bounds0], ModuleInfo0, - [Bound | Bounds], ModuleInfo) :- +make_shared_bound_inst_list([], [], !ModuleInfo). +make_shared_bound_inst_list([Bound0 | Bounds0], [Bound | Bounds], + !ModuleInfo) :- Bound0 = functor(ConsId, ArgInsts0), - make_shared_inst_list(ArgInsts0, ModuleInfo0, - ArgInsts, ModuleInfo1), + make_shared_inst_list(ArgInsts0, ArgInsts, !ModuleInfo), Bound = functor(ConsId, ArgInsts), - make_shared_bound_inst_list(Bounds0, ModuleInfo1, - Bounds, ModuleInfo). + make_shared_bound_inst_list(Bounds0, Bounds, !ModuleInfo). %-----------------------------------------------------------------------------% @@ -1262,36 +1235,37 @@ make_shared_bound_inst_list([Bound0 | Bounds0], ModuleInfo0, % in the inst with `mostly_unique'. (Used by unique_modes.m to % change the insts of semidet-live or nondet-live insts.) -make_mostly_uniq_inst(not_reached, M, not_reached, M). -make_mostly_uniq_inst(any(Uniq0), M, any(Uniq), M) :- +make_mostly_uniq_inst(not_reached, not_reached, !ModuleInfo). +make_mostly_uniq_inst(any(Uniq0), any(Uniq), !ModuleInfo) :- make_mostly_uniq(Uniq0, Uniq). -make_mostly_uniq_inst(free, M, free, M). -make_mostly_uniq_inst(free(T), M, free(T), M). -make_mostly_uniq_inst(bound(Uniq0, BoundInsts0), M0, bound(Uniq, BoundInsts), - M) :- +make_mostly_uniq_inst(free, free, !ModuleInfo). +make_mostly_uniq_inst(free(T), free(T), !ModuleInfo). +make_mostly_uniq_inst(bound(Uniq0, BoundInsts0), bound(Uniq, BoundInsts), + !ModuleInfo) :- % XXX could improve efficiency by avoiding recursion here make_mostly_uniq(Uniq0, Uniq), - make_mostly_uniq_bound_inst_list(BoundInsts0, M0, BoundInsts, M). -make_mostly_uniq_inst(ground(Uniq0, PredInst), M, ground(Uniq, PredInst), M) :- + make_mostly_uniq_bound_inst_list(BoundInsts0, BoundInsts, !ModuleInfo). +make_mostly_uniq_inst(ground(Uniq0, PredInst), ground(Uniq, PredInst), + !ModuleInfo) :- make_mostly_uniq(Uniq0, Uniq). make_mostly_uniq_inst(inst_var(_), _, _, _) :- error("free inst var"). -make_mostly_uniq_inst(constrained_inst_vars(InstVars, Inst0), ModuleInfo0, Inst, - ModuleInfo) :- - make_mostly_uniq_inst(Inst0, ModuleInfo0, Inst1, ModuleInfo), +make_mostly_uniq_inst(constrained_inst_vars(InstVars, Inst0), Inst, + !ModuleInfo) :- + make_mostly_uniq_inst(Inst0, Inst1, !ModuleInfo), ( - \+ inst_matches_final(Inst1, Inst0, ModuleInfo) + \+ inst_matches_final(Inst1, Inst0, !.ModuleInfo) -> Inst = Inst1 ; Inst = constrained_inst_vars(InstVars, Inst1) ). -make_mostly_uniq_inst(abstract_inst(_,_), M, _, M) :- +make_mostly_uniq_inst(abstract_inst(_,_), _, !ModuleInfo) :- error("make_mostly_uniq_inst(abstract_inst)"). -make_mostly_uniq_inst(defined_inst(InstName), ModuleInfo0, Inst, ModuleInfo) :- +make_mostly_uniq_inst(defined_inst(InstName), Inst, !ModuleInfo) :- % check whether the inst name is already in the % mostly_uniq_inst table - module_info_insts(ModuleInfo0, InstTable0), + module_info_insts(!.ModuleInfo, InstTable0), inst_table_get_mostly_uniq_insts(InstTable0, NondetLiveInsts0), ( map__search(NondetLiveInsts0, InstName, Result) @@ -1300,8 +1274,7 @@ make_mostly_uniq_inst(defined_inst(InstName), ModuleInfo0, Inst, ModuleInfo) :- NondetLiveInst = NondetLiveInst0 ; NondetLiveInst = defined_inst(InstName) - ), - ModuleInfo = ModuleInfo0 + ) ; % insert the inst name in the mostly_uniq_inst table, with % value `unknown' for the moment @@ -1309,35 +1282,33 @@ make_mostly_uniq_inst(defined_inst(InstName), ModuleInfo0, Inst, ModuleInfo) :- NondetLiveInsts1), inst_table_set_mostly_uniq_insts(NondetLiveInsts1, InstTable0, InstTable1), - module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1), + module_info_set_insts(InstTable1, !ModuleInfo), % expand the inst name, and invoke ourself recursively on % it's expansion - inst_lookup(ModuleInfo1, InstName, Inst0), - inst_expand(ModuleInfo1, Inst0, Inst1), - make_mostly_uniq_inst(Inst1, ModuleInfo1, NondetLiveInst, - ModuleInfo2), + inst_lookup(!.ModuleInfo, InstName, Inst0), + inst_expand(!.ModuleInfo, Inst0, Inst1), + make_mostly_uniq_inst(Inst1, NondetLiveInst, !ModuleInfo), % now that we have determined the resulting Inst, store % the appropriate value `known(NondetLiveInst)' in the % mostly_uniq_inst table - module_info_insts(ModuleInfo2, InstTable2), + module_info_insts(!.ModuleInfo, InstTable2), inst_table_get_mostly_uniq_insts(InstTable2, NondetLiveInsts2), - map__det_update(NondetLiveInsts2, InstName, - known(NondetLiveInst), NondetLiveInsts), + svmap__det_update(InstName, known(NondetLiveInst), + NondetLiveInsts2, NondetLiveInsts), inst_table_set_mostly_uniq_insts(NondetLiveInsts, InstTable2, InstTable), - module_info_set_insts(InstTable, ModuleInfo2, ModuleInfo) + module_info_set_insts(InstTable, !ModuleInfo) ), % avoid expanding recursive insts - ( inst_contains_instname(NondetLiveInst, ModuleInfo, InstName) -> + ( inst_contains_instname(NondetLiveInst, !.ModuleInfo, InstName) -> Inst = defined_inst(InstName) ; Inst = NondetLiveInst ). -:- pred make_mostly_uniq(uniqueness, uniqueness). -:- mode make_mostly_uniq(in, out) is det. +:- pred make_mostly_uniq(uniqueness::in, uniqueness::out) is det. make_mostly_uniq(unique, mostly_unique). make_mostly_uniq(mostly_unique, mostly_unique). @@ -1345,29 +1316,24 @@ make_mostly_uniq(shared, shared). make_mostly_uniq(mostly_clobbered, mostly_clobbered). make_mostly_uniq(clobbered, clobbered). -:- pred make_mostly_uniq_bound_inst_list(list(bound_inst), module_info, - list(bound_inst), module_info). -:- mode make_mostly_uniq_bound_inst_list(in, in, out, out) is det. +:- pred make_mostly_uniq_bound_inst_list(list(bound_inst)::in, + list(bound_inst)::out, module_info::in, module_info::out) is det. -make_mostly_uniq_bound_inst_list([], ModuleInfo, [], ModuleInfo). -make_mostly_uniq_bound_inst_list([Bound0 | Bounds0], ModuleInfo0, - [Bound | Bounds], ModuleInfo) :- +make_mostly_uniq_bound_inst_list([], [], !ModuleInfo). +make_mostly_uniq_bound_inst_list([Bound0 | Bounds0], [Bound | Bounds], + !ModuleInfo) :- Bound0 = functor(ConsId, ArgInsts0), - make_mostly_uniq_inst_list(ArgInsts0, ModuleInfo0, - ArgInsts, ModuleInfo1), + make_mostly_uniq_inst_list(ArgInsts0, ArgInsts, !ModuleInfo), Bound = functor(ConsId, ArgInsts), - make_mostly_uniq_bound_inst_list(Bounds0, ModuleInfo1, - Bounds, ModuleInfo). + make_mostly_uniq_bound_inst_list(Bounds0, Bounds, !ModuleInfo). -:- pred make_mostly_uniq_inst_list(list(inst), module_info, - list(inst), module_info). -:- mode make_mostly_uniq_inst_list(in, in, out, out) is det. +:- pred make_mostly_uniq_inst_list(list(inst)::in, list(inst)::out, + module_info::in, module_info::out) is det. -make_mostly_uniq_inst_list([], ModuleInfo, [], ModuleInfo). -make_mostly_uniq_inst_list([Inst0 | Insts0], ModuleInfo0, - [Inst | Insts], ModuleInfo) :- - make_mostly_uniq_inst(Inst0, ModuleInfo0, Inst, ModuleInfo1), - make_mostly_uniq_inst_list(Insts0, ModuleInfo1, Insts, ModuleInfo). +make_mostly_uniq_inst_list([], [], !ModuleInfo). +make_mostly_uniq_inst_list([Inst0 | Insts0], [Inst | Insts], !ModuleInfo) :- + make_mostly_uniq_inst(Inst0, Inst, !ModuleInfo), + make_mostly_uniq_inst_list(Insts0, Insts, !ModuleInfo). %-----------------------------------------------------------------------------% @@ -1377,6 +1343,7 @@ make_mostly_uniq_inst_list([Inst0 | Insts0], ModuleInfo0, % but now we allow it for real_unifies too. :- pred allow_unify_bound_any(unify_is_real::in) is det. + allow_unify_bound_any(_) :- true. %-----------------------------------------------------------------------------% @@ -1389,14 +1356,13 @@ allow_unify_bound_any(_) :- true. % InstB specify a binding (free or bound), it must be % the same in both. -inst_merge(InstA, InstB, MaybeType, ModuleInfo0, Inst, ModuleInfo) :- +inst_merge(InstA, InstB, MaybeType, Inst, !ModuleInfo) :- % check whether this pair of insts is already in % the merge_insts table - module_info_insts(ModuleInfo0, InstTable0), + module_info_insts(!.ModuleInfo, InstTable0), inst_table_get_merge_insts(InstTable0, MergeInstTable0), ThisInstPair = InstA - InstB, ( map__search(MergeInstTable0, ThisInstPair, Result) -> - ModuleInfo = ModuleInfo0, ( Result = known(MergedInst) -> Inst0 = MergedInst ; @@ -1409,58 +1375,57 @@ inst_merge(InstA, InstB, MaybeType, ModuleInfo0, Inst, ModuleInfo) :- MergeInstTable1), inst_table_set_merge_insts(MergeInstTable1, InstTable0, InstTable1), - module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1), + module_info_set_insts(InstTable1, !ModuleInfo), % merge the insts - inst_merge_2(InstA, InstB, MaybeType, ModuleInfo1, Inst0, - ModuleInfo2), - + inst_merge_2(InstA, InstB, MaybeType, Inst0, + !ModuleInfo), % now update the value associated with ThisInstPair - module_info_insts(ModuleInfo2, InstTable2), + module_info_insts(!.ModuleInfo, InstTable2), inst_table_get_merge_insts(InstTable2, MergeInstTable2), map__det_update(MergeInstTable2, ThisInstPair, known(Inst0), MergeInstTable3), inst_table_set_merge_insts(MergeInstTable3, InstTable2, InstTable3), - module_info_set_insts(InstTable3, ModuleInfo2, ModuleInfo) + module_info_set_insts(InstTable3, !ModuleInfo) ), % avoid expanding recursive insts - ( inst_contains_instname(Inst0, ModuleInfo, merge_inst(InstA, InstB)) -> + ( + inst_contains_instname(Inst0, !.ModuleInfo, + merge_inst(InstA, InstB)) + -> Inst = defined_inst(merge_inst(InstA, InstB)) ; Inst = Inst0 ). -:- pred inst_merge_2(inst, inst, maybe(type), module_info, inst, module_info). -:- mode inst_merge_2(in, in, in, in, out, out) is semidet. +:- pred inst_merge_2((inst)::in, (inst)::in, maybe(type)::in, (inst)::out, + module_info::in, module_info::out) is semidet. -inst_merge_2(InstA, InstB, MaybeType, ModuleInfo0, Inst, ModuleInfo) :- +inst_merge_2(InstA, InstB, MaybeType, Inst, !ModuleInfo) :- /********* % would this test improve efficiency?? ( InstA = InstB -> Inst = InstA, - ModuleInfo = ModuleInfo0 ; *********/ - inst_expand(ModuleInfo0, InstA, InstA2), - inst_expand(ModuleInfo0, InstB, InstB2), + inst_expand(!.ModuleInfo, InstA, InstA2), + inst_expand(!.ModuleInfo, InstB, InstB2), ( InstB2 = not_reached -> - Inst = InstA2, - ModuleInfo = ModuleInfo0 + Inst = InstA2 ; - inst_merge_3(InstA2, InstB2, MaybeType, ModuleInfo0, Inst, - ModuleInfo) + inst_merge_3(InstA2, InstB2, MaybeType, Inst, !ModuleInfo) ). -:- pred inst_merge_3(inst, inst, maybe(type), module_info, inst, module_info). -:- mode inst_merge_3(in, in, in, in, out, out) is semidet. +:- pred inst_merge_3((inst)::in, (inst)::in, maybe(type)::in, (inst)::out, + module_info::in, module_info::out) is semidet. -inst_merge_3(InstA, InstB, MaybeType, ModuleInfo0, Inst, ModuleInfo) :- +inst_merge_3(InstA, InstB, MaybeType, Inst, !ModuleInfo) :- ( InstA = constrained_inst_vars(InstVarsA, InstA1) -> ( InstB = constrained_inst_vars(InstVarsB, InstB1) -> - inst_merge(InstA1, InstB1, MaybeType, - ModuleInfo0, Inst0, ModuleInfo), + inst_merge(InstA1, InstB1, MaybeType, Inst0, + !ModuleInfo), InstVars = InstVarsA `set__intersect` InstVarsB, ( set__non_empty(InstVars) -> Inst = constrained_inst_vars(InstVars, Inst0) @@ -1473,16 +1438,14 @@ inst_merge_3(InstA, InstB, MaybeType, ModuleInfo0, Inst, ModuleInfo) :- Inst = Inst0 ) ; - inst_merge(InstA1, InstB, MaybeType, ModuleInfo0, - Inst, ModuleInfo) + inst_merge(InstA1, InstB, MaybeType, Inst, !ModuleInfo) ) ; - inst_merge_4(InstA, InstB, MaybeType, ModuleInfo0, Inst, - ModuleInfo) + inst_merge_4(InstA, InstB, MaybeType, Inst, !ModuleInfo) ). -:- pred inst_merge_4(inst, inst, maybe(type), module_info, inst, module_info). -:- mode inst_merge_4(in, in, in, in, out, out) is semidet. +:- pred inst_merge_4((inst)::in, (inst)::in, maybe(type)::in, (inst)::out, + module_info::in, module_info::out) is semidet. % We do not yet allow merging of `free' and `any', % except in the case where the any is `mostly_clobbered_any' @@ -1496,58 +1459,57 @@ inst_merge_3(InstA, InstB, MaybeType, ModuleInfo0, Inst, ModuleInfo) :- % too weak -- it might not be able to detect bugs as well % as it can currently. -inst_merge_4(any(UniqA), any(UniqB), _, M, any(Uniq), M) :- +inst_merge_4(any(UniqA), any(UniqB), _, any(Uniq), !ModuleInfo) :- merge_uniq(UniqA, UniqB, Uniq). -inst_merge_4(any(Uniq), free, _, M, any(Uniq), M) :- +inst_merge_4(any(Uniq), free, _, any(Uniq), !ModuleInfo) :- % we do not yet allow merge of any with free, except for clobbered anys ( Uniq = clobbered ; Uniq = mostly_clobbered ). -inst_merge_4(any(UniqA), bound(UniqB, ListB), _, ModInfo, any(Uniq), ModInfo) :- - merge_uniq_bound(UniqA, UniqB, ListB, ModInfo, Uniq), +inst_merge_4(any(UniqA), bound(UniqB, ListB), _, any(Uniq), !ModuleInfo) :- + merge_uniq_bound(UniqA, UniqB, ListB, !.ModuleInfo, Uniq), % we do not yet allow merge of any with free, except for clobbered anys ( ( Uniq = clobbered ; Uniq = mostly_clobbered ) -> true ; - bound_inst_list_is_ground_or_any(ListB, ModInfo) + bound_inst_list_is_ground_or_any(ListB, !.ModuleInfo) ). -inst_merge_4(any(UniqA), ground(UniqB, _), _, M, any(Uniq), M) :- +inst_merge_4(any(UniqA), ground(UniqB, _), _, any(Uniq), !ModuleInfo) :- merge_uniq(UniqA, UniqB, Uniq). -inst_merge_4(any(UniqA), abstract_inst(_, _), _, M, any(Uniq), M) :- +inst_merge_4(any(UniqA), abstract_inst(_, _), _, any(Uniq), !ModuleInfo) :- merge_uniq(UniqA, shared, Uniq), % we do not yet allow merge of any with free, except for clobbered anys ( Uniq = clobbered ; Uniq = mostly_clobbered ). -inst_merge_4(free, any(Uniq), _, M, any(Uniq), M) :- +inst_merge_4(free, any(Uniq), _, any(Uniq), !ModuleInfo) :- % we do not yet allow merge of any with free, except for clobbered anys ( Uniq = clobbered ; Uniq = mostly_clobbered ). -inst_merge_4(bound(UniqA, ListA), any(UniqB), _, ModInfo, any(Uniq), ModInfo) :- - merge_uniq_bound(UniqB, UniqA, ListA, ModInfo, Uniq), +inst_merge_4(bound(UniqA, ListA), any(UniqB), _, any(Uniq), !ModuleInfo) :- + merge_uniq_bound(UniqB, UniqA, ListA, !.ModuleInfo, Uniq), % we do not yet allow merge of any with free, except for clobbered anys ( ( Uniq = clobbered ; Uniq = mostly_clobbered ) -> true ; - bound_inst_list_is_ground_or_any(ListA, ModInfo) + bound_inst_list_is_ground_or_any(ListA, !.ModuleInfo) ). -inst_merge_4(ground(UniqA, _), any(UniqB), _, M, any(Uniq), M) :- +inst_merge_4(ground(UniqA, _), any(UniqB), _, any(Uniq), !ModuleInfo) :- merge_uniq(UniqA, UniqB, Uniq). -inst_merge_4(abstract_inst(_, _), any(UniqB), _, M, any(Uniq), M) :- +inst_merge_4(abstract_inst(_, _), any(UniqB), _, any(Uniq), !ModuleInfo) :- merge_uniq(shared, UniqB, Uniq), % we do not yet allow merge of any with free, except for clobbered anys ( Uniq = clobbered ; Uniq = mostly_clobbered ). -inst_merge_4(free, free, _, M, free, M). -inst_merge_4(bound(UniqA, ListA), bound(UniqB, ListB), MaybeType, ModuleInfo0, - bound(Uniq, List), ModuleInfo) :- +inst_merge_4(free, free, _, free, !ModuleInfo). +inst_merge_4(bound(UniqA, ListA), bound(UniqB, ListB), MaybeType, + bound(Uniq, List), !ModuleInfo) :- merge_uniq(UniqA, UniqB, Uniq), - bound_inst_list_merge(ListA, ListB, MaybeType, ModuleInfo0, List, - ModuleInfo). -inst_merge_4(bound(UniqA, ListA), ground(UniqB, _), MaybeType, ModuleInfo0, - Result, ModuleInfo) :- - inst_merge_bound_ground(UniqA, ListA, UniqB, MaybeType, - ModuleInfo0, Result, ModuleInfo). -inst_merge_4(ground(UniqA, _), bound(UniqB, ListB), MaybeType, ModuleInfo0, - Result, ModuleInfo) :- - inst_merge_bound_ground(UniqB, ListB, UniqA, MaybeType, - ModuleInfo0, Result, ModuleInfo). + bound_inst_list_merge(ListA, ListB, MaybeType, List, !ModuleInfo). +inst_merge_4(bound(UniqA, ListA), ground(UniqB, _), MaybeType, Result, + !ModuleInfo) :- + inst_merge_bound_ground(UniqA, ListA, UniqB, MaybeType, Result, + !ModuleInfo). +inst_merge_4(ground(UniqA, _), bound(UniqB, ListB), MaybeType, Result, + !ModuleInfo) :- + inst_merge_bound_ground(UniqB, ListB, UniqA, MaybeType, Result, + !ModuleInfo). inst_merge_4(ground(UniqA, GroundInstInfoA), ground(UniqB, GroundInstInfoB), - _, ModuleInfo, ground(Uniq, GroundInstInfo), ModuleInfo) :- + _, ground(Uniq, GroundInstInfo), !ModuleInfo) :- ( GroundInstInfoA = higher_order(PredA), GroundInstInfoB = higher_order(PredB) @@ -1555,38 +1517,36 @@ inst_merge_4(ground(UniqA, GroundInstInfoA), ground(UniqB, GroundInstInfoB), % if they specify matching pred insts, but one is more % precise (specifies more info) than the other, % then we want to choose the least precise one - ( pred_inst_matches(PredA, PredB, ModuleInfo) -> + ( pred_inst_matches(PredA, PredB, !.ModuleInfo) -> GroundInstInfo = higher_order(PredB) - ; pred_inst_matches(PredB, PredA, ModuleInfo) -> + ; pred_inst_matches(PredB, PredA, !.ModuleInfo) -> GroundInstInfo = higher_order(PredA) ; % If either is a function inst with non-standard % modes, don't allow the higher-order % information to be lost. \+ pred_inst_info_is_nonstandard_func_mode(PredA, - ModuleInfo), + !.ModuleInfo), \+ pred_inst_info_is_nonstandard_func_mode(PredB, - ModuleInfo), + !.ModuleInfo), GroundInstInfo = none ) ; \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoA, - ModuleInfo), + !.ModuleInfo), \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoB, - ModuleInfo), + !.ModuleInfo), GroundInstInfo = none ), merge_uniq(UniqA, UniqB, Uniq). inst_merge_4(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB), - _, ModuleInfo0, abstract_inst(Name, Args), ModuleInfo) :- + _, abstract_inst(Name, Args), !ModuleInfo) :- % We don't know the arguments types of an abstract inst. MaybeTypes = list__duplicate(list__length(ArgsA), no), - inst_list_merge(ArgsA, ArgsB, MaybeTypes, ModuleInfo0, Args, - ModuleInfo). -inst_merge_4(not_reached, Inst, _, M, Inst, M). + inst_list_merge(ArgsA, ArgsB, MaybeTypes, Args, !ModuleInfo). +inst_merge_4(not_reached, Inst, _, Inst, !ModuleInfo). -:- pred merge_uniq(uniqueness, uniqueness, uniqueness). -:- mode merge_uniq(in, in, out) is det. +:- pred merge_uniq(uniqueness::in, uniqueness::in, uniqueness::out) is det. % merge_uniq(A, B, C) succeeds if C is minimum of A and B in % the ordering @@ -1602,9 +1562,8 @@ merge_uniq(UniqA, UniqB, Merged) :- % merge_uniq_bound(UniqA, UniqB, ListB, ModuleInfo, Uniq) succeeds iff % Uniq is the result of merging -:- pred merge_uniq_bound(uniqueness, uniqueness, list(bound_inst), module_info, - uniqueness). -:- mode merge_uniq_bound(in, in, in, in, out) is det. +:- pred merge_uniq_bound(uniqueness::in, uniqueness::in, list(bound_inst)::in, + module_info::in, uniqueness::out) is det. merge_uniq_bound(UniqA, UniqB, ListB, ModuleInfo, Uniq) :- merge_uniq(UniqA, UniqB, Uniq0), @@ -1612,153 +1571,135 @@ merge_uniq_bound(UniqA, UniqB, ListB, ModuleInfo, Uniq) :- merge_bound_inst_list_uniq(ListB, Uniq0, ModuleInfo, Expansions0, _Expansions, Uniq). -:- pred merge_bound_inst_list_uniq(list(bound_inst), uniqueness, module_info, - set(inst_name), set(inst_name), uniqueness). -:- mode merge_bound_inst_list_uniq(in, in, in, in, out, out) is det. +:- pred merge_bound_inst_list_uniq(list(bound_inst)::in, uniqueness::in, + module_info::in, set(inst_name)::in, + set(inst_name)::out, uniqueness::out) is det. -merge_bound_inst_list_uniq([], Uniq, _, Expansions, Expansions, Uniq). -merge_bound_inst_list_uniq([BoundInst | BoundInsts], Uniq0, - ModuleInfo, Expansions0, Expansions, Uniq) :- +merge_bound_inst_list_uniq([], Uniq, _, !Expansions, Uniq). +merge_bound_inst_list_uniq([BoundInst | BoundInsts], Uniq0, ModuleInfo, + !Expansions, Uniq) :- BoundInst = functor(_ConsId, ArgInsts), - merge_inst_list_uniq(ArgInsts, Uniq0, ModuleInfo, - Expansions0, Expansions1, Uniq1), - merge_bound_inst_list_uniq(BoundInsts, Uniq1, ModuleInfo, - Expansions1, Expansions, Uniq). - -:- pred merge_inst_list_uniq(list(inst), uniqueness, module_info, - set(inst_name), set(inst_name), uniqueness). -:- mode merge_inst_list_uniq(in, in, in, in, out, out) is det. - -merge_inst_list_uniq([], Uniq, _, Expansions, Expansions, Uniq). -merge_inst_list_uniq([Inst | Insts], Uniq0, ModuleInfo, - Expansions0, Expansions, Uniq) :- - merge_inst_uniq(Inst, Uniq0, ModuleInfo, Expansions0, Expansions1, - Uniq1), - merge_inst_list_uniq(Insts, Uniq1, ModuleInfo, Expansions1, Expansions, + merge_inst_list_uniq(ArgInsts, Uniq0, ModuleInfo, !Expansions, Uniq1), + merge_bound_inst_list_uniq(BoundInsts, Uniq1, ModuleInfo, !Expansions, Uniq). -:- pred merge_inst_uniq(inst, uniqueness, module_info, - set(inst_name), set(inst_name), uniqueness). -:- mode merge_inst_uniq(in, in, in, in, out, out) is det. +:- pred merge_inst_list_uniq(list(inst)::in, uniqueness::in, module_info::in, + set(inst_name)::in, set(inst_name)::out, uniqueness::out) is det. -merge_inst_uniq(any(UniqA), UniqB, _, Expansions, Expansions, Uniq) :- +merge_inst_list_uniq([], Uniq, _, !Expansions, Uniq). +merge_inst_list_uniq([Inst | Insts], Uniq0, ModuleInfo, !Expansions, Uniq) :- + merge_inst_uniq(Inst, Uniq0, ModuleInfo, !Expansions, Uniq1), + merge_inst_list_uniq(Insts, Uniq1, ModuleInfo, !Expansions, Uniq). + +:- pred merge_inst_uniq((inst)::in, uniqueness::in, module_info::in, + set(inst_name)::in, set(inst_name)::out, uniqueness::out) is det. + +merge_inst_uniq(any(UniqA), UniqB, _, !Expansions, Uniq) :- merge_uniq(UniqA, UniqB, Uniq). -merge_inst_uniq(free, Uniq, _, Expansions, Expansions, Uniq). -merge_inst_uniq(free(_), Uniq, _, Expansions, Expansions, Uniq). -merge_inst_uniq(bound(UniqA, ListA), UniqB, ModuleInfo, - Expansions0, Expansions, Uniq) :- +merge_inst_uniq(free, Uniq, _, !Expansions, Uniq). +merge_inst_uniq(free(_), Uniq, _, !Expansions, Uniq). +merge_inst_uniq(bound(UniqA, ListA), UniqB, ModuleInfo, !Expansions, Uniq) :- merge_uniq(UniqA, UniqB, Uniq0), merge_bound_inst_list_uniq(ListA, Uniq0, ModuleInfo, - Expansions0, Expansions, Uniq). -merge_inst_uniq(ground(UniqA, _), UniqB, _, Expansions, Expansions, Uniq) :- + !Expansions, Uniq). +merge_inst_uniq(ground(UniqA, _), UniqB, _, !Expansions, Uniq) :- merge_uniq(UniqA, UniqB, Uniq). -merge_inst_uniq(abstract_inst(_,_), UniqB, _, Expansions, Expansions, Uniq) :- +merge_inst_uniq(abstract_inst(_,_), UniqB, _, !Expansions, Uniq) :- merge_uniq(shared, UniqB, Uniq). merge_inst_uniq(defined_inst(InstName), UniqB, ModuleInfo, - Expansions0, Expansions, Uniq) :- - ( set__member(InstName, Expansions0) -> - Uniq = UniqB, - Expansions = Expansions0 + !Expansions, Uniq) :- + ( set__member(InstName, !.Expansions) -> + Uniq = UniqB ; - set__insert(Expansions0, InstName, Expansions1), + svset__insert(InstName, !Expansions), inst_lookup(ModuleInfo, InstName, Inst), - merge_inst_uniq(Inst, UniqB, ModuleInfo, - Expansions1, Expansions, Uniq) + merge_inst_uniq(Inst, UniqB, ModuleInfo, !Expansions, Uniq) ). -merge_inst_uniq(not_reached, Uniq, _, Expansions, Expansions, Uniq). -merge_inst_uniq(inst_var(_), _, _, Expansions, Expansions, _) :- +merge_inst_uniq(not_reached, Uniq, _, !Expansions, Uniq). +merge_inst_uniq(inst_var(_), _, _, !Expansions, _) :- error("merge_inst_uniq: unexpected inst_var"). merge_inst_uniq(constrained_inst_vars(_InstVars, Inst0), UniqB, ModuleInfo, - Expansions0, Expansions, Uniq) :- - merge_inst_uniq(Inst0, UniqB, ModuleInfo, Expansions0, Expansions, - Uniq). + !Expansions, Uniq) :- + merge_inst_uniq(Inst0, UniqB, ModuleInfo, !Expansions, Uniq). %-----------------------------------------------------------------------------% -:- pred inst_merge_bound_ground(uniqueness, list(bound_inst), - uniqueness, maybe(type), module_info, inst, module_info). -:- mode inst_merge_bound_ground(in, in, in, in, in, out, out) is semidet. +:- pred inst_merge_bound_ground(uniqueness::in, list(bound_inst)::in, + uniqueness::in, maybe(type)::in, (inst)::out, + module_info::in, module_info::out) is semidet. -inst_merge_bound_ground(UniqA, ListA, UniqB, MaybeType, ModuleInfo0, - Result, ModuleInfo) :- - ( bound_inst_list_is_ground(ListA, ModuleInfo0) -> - merge_uniq_bound(UniqB, UniqA, ListA, ModuleInfo0, Uniq), - Result = ground(Uniq, none), - ModuleInfo = ModuleInfo0 +inst_merge_bound_ground(UniqA, ListA, UniqB, MaybeType, Result, !ModuleInfo) :- + ( bound_inst_list_is_ground(ListA, !.ModuleInfo) -> + merge_uniq_bound(UniqB, UniqA, ListA, !.ModuleInfo, Uniq), + Result = ground(Uniq, none) ; - bound_inst_list_is_ground_or_any(ListA, ModuleInfo0), + bound_inst_list_is_ground_or_any(ListA, !.ModuleInfo), % If we know the type, we can give a more accurate result than % just "any". ( MaybeType = yes(Type), - type_constructors(Type, ModuleInfo0, Constructors), + type_constructors(Type, !.ModuleInfo, Constructors), constructors_to_bound_insts(Constructors, UniqB, - ModuleInfo0, ListB0), + !.ModuleInfo, ListB0), list__sort_and_remove_dups(ListB0, ListB), - inst_merge_4(bound(UniqA, ListA), - bound(UniqB, ListB), MaybeType, - ModuleInfo0, Result, ModuleInfo) + inst_merge_4(bound(UniqA, ListA), bound(UniqB, ListB), + MaybeType, Result, !ModuleInfo) ; MaybeType = no, - merge_uniq_bound(UniqB, UniqA, ListA, ModuleInfo0, + merge_uniq_bound(UniqB, UniqA, ListA, !.ModuleInfo, Uniq), - Result = any(Uniq), - ModuleInfo = ModuleInfo0 + Result = any(Uniq) ) ). %-----------------------------------------------------------------------------% -:- pred inst_list_merge(list(inst), list(inst), list(maybe(type)), module_info, - list(inst), module_info). -:- mode inst_list_merge(in, in, in, in, out, out) is semidet. +:- pred inst_list_merge(list(inst)::in, list(inst)::in, list(maybe(type))::in, + list(inst)::out, module_info::in, module_info::out) is semidet. -inst_list_merge([], [], _, ModuleInfo, [], ModuleInfo). +inst_list_merge([], [], _, [], !ModuleInfo). inst_list_merge([ArgA | ArgsA], [ArgB | ArgsB], [MaybeType | MaybeTypes], - ModuleInfo0, [Arg | Args], ModuleInfo) :- - inst_merge(ArgA, ArgB, MaybeType, ModuleInfo0, Arg, ModuleInfo1), - inst_list_merge(ArgsA, ArgsB, MaybeTypes, ModuleInfo1, Args, - ModuleInfo). + [Arg | Args], !ModuleInfo) :- + inst_merge(ArgA, ArgB, MaybeType, Arg, !ModuleInfo), + inst_list_merge(ArgsA, ArgsB, MaybeTypes, Args, !ModuleInfo). - % bound_inst_list_merge(Xs, Ys, ModuleInfo0, Zs, ModuleInfo): + % bound_inst_list_merge(Xs, Ys, Zs, !ModuleInfo): % The two input lists Xs and Ys must already be sorted. % Here we perform a sorted merge operation, % so that the functors of the output list Zs are the union % of the functors of the input lists Xs and Ys. -:- pred bound_inst_list_merge(list(bound_inst), list(bound_inst), - maybe(type), module_info, list(bound_inst), module_info). -:- mode bound_inst_list_merge(in, in, in, in, out, out) is semidet. +:- pred bound_inst_list_merge(list(bound_inst)::in, list(bound_inst)::in, + maybe(type)::in, list(bound_inst)::out, + module_info::in, module_info::out) is semidet. -bound_inst_list_merge(Xs, Ys, MaybeType, ModuleInfo0, Zs, ModuleInfo) :- +bound_inst_list_merge(Xs, Ys, MaybeType, Zs, !ModuleInfo) :- ( Xs = [] -> - Zs = Ys, - ModuleInfo = ModuleInfo0 + Zs = Ys ; Ys = [] -> - Zs = Xs, - ModuleInfo = ModuleInfo0 + Zs = Xs ; Xs = [X | Xs1], Ys = [Y | Ys1], X = functor(ConsIdX, ArgsX), Y = functor(ConsIdY, ArgsY), ( ConsIdX = ConsIdY -> - maybe_get_cons_id_arg_types(ModuleInfo0, MaybeType, + maybe_get_cons_id_arg_types(!.ModuleInfo, MaybeType, ConsIdX, list__length(ArgsX), MaybeTypes), - inst_list_merge(ArgsX, ArgsY, MaybeTypes, ModuleInfo0, - Args, ModuleInfo1), + inst_list_merge(ArgsX, ArgsY, MaybeTypes, Args, + !ModuleInfo), Z = functor(ConsIdX, Args), Zs = [Z | Zs1], - bound_inst_list_merge(Xs1, Ys1, MaybeType, ModuleInfo1, - Zs1, ModuleInfo) + bound_inst_list_merge(Xs1, Ys1, MaybeType, Zs1, + !ModuleInfo) ; compare(<, ConsIdX, ConsIdY) -> Zs = [X | Zs1], - bound_inst_list_merge(Xs1, Ys, MaybeType, ModuleInfo0, - Zs1, ModuleInfo) + bound_inst_list_merge(Xs1, Ys, MaybeType, Zs1, + !ModuleInfo) ; Zs = [Y | Zs1], - bound_inst_list_merge(Xs, Ys1, MaybeType, ModuleInfo0, - Zs1, ModuleInfo) + bound_inst_list_merge(Xs, Ys1, MaybeType, Zs1, + !ModuleInfo) ) ). @@ -1769,8 +1710,8 @@ inst_contains_nonstandard_func_mode(Inst, ModuleInfo) :- set__init(Expansions0), inst_contains_nonstandard_func_mode_2(Inst, ModuleInfo, Expansions0). -:- pred inst_contains_nonstandard_func_mode_2(inst, module_info, set(inst)). -:- mode inst_contains_nonstandard_func_mode_2(in, in, in) is semidet. +:- pred inst_contains_nonstandard_func_mode_2((inst)::in, module_info::in, + set(inst)::in) is semidet. inst_contains_nonstandard_func_mode_2(ground(_, GroundInstInfo), ModuleInfo, _Expansions) :- @@ -1814,7 +1755,6 @@ inst_contains_unconstrained_var(bound(_Uniqueness, BoundInsts)) :- BoundInst = functor(_ConsId, ArgInsts), list.member(ArgInst, ArgInsts), inst_contains_unconstrained_var(ArgInst). - inst_contains_unconstrained_var(ground(_Uniqueness, GroundInstInfo)) :- GroundInstInfo = higher_order(PredInstInfo), PredInstInfo = pred_inst_info(_PredOrFunc, Modes, _Detism), @@ -1828,9 +1768,7 @@ inst_contains_unconstrained_var(ground(_Uniqueness, GroundInstInfo)) :- list.member(Inst, Insts) ), inst_contains_unconstrained_var(Inst). - inst_contains_unconstrained_var(inst_var(_InstVar)). - inst_contains_unconstrained_var(defined_inst(InstName)) :- ( InstName = user_inst(_, Insts), @@ -1864,7 +1802,6 @@ inst_contains_unconstrained_var(defined_inst(InstName)) :- InstName = typed_inst(_, InstName1), inst_contains_unconstrained_var(defined_inst(InstName1)) ). - inst_contains_unconstrained_var(abstract_inst(_SymName, Insts)) :- list.member(Inst, Insts), inst_contains_unconstrained_var(Inst). diff --git a/compiler/instmap.m b/compiler/instmap.m index 31413594a..5bf6b1c7d 100644 --- a/compiler/instmap.m +++ b/compiler/instmap.m @@ -32,23 +32,19 @@ % Initialize an empty instmap. % -:- pred instmap__init_reachable(instmap). -:- mode instmap__init_reachable(out) is det. +:- pred instmap__init_reachable(instmap::out) is det. % Initialize an empty unreachable instmap. % -:- pred instmap__init_unreachable(instmap). -:- mode instmap__init_unreachable(out) is det. +:- pred instmap__init_unreachable(instmap::out) is det. % Initialize an empty reachable instmap_delta. % -:- pred instmap_delta_init_reachable(instmap_delta). -:- mode instmap_delta_init_reachable(out) is det. +:- pred instmap_delta_init_reachable(instmap_delta::out) is det. % Initialize an empty unreachable instmap_delta. % -:- pred instmap_delta_init_unreachable(instmap_delta). -:- mode instmap_delta_init_unreachable(out) is det. +:- pred instmap_delta_init_unreachable(instmap_delta::out) is det. % For any instmap InstMap, exactly one of % instmap__is_reachable(InstMap) and @@ -56,13 +52,11 @@ % Is the instmap reachable? % -:- pred instmap__is_reachable(instmap). -:- mode instmap__is_reachable(in) is semidet. +:- pred instmap__is_reachable(instmap::in) is semidet. % Is the instmap unreachable? % -:- pred instmap__is_unreachable(instmap). -:- mode instmap__is_unreachable(in) is semidet. +:- pred instmap__is_unreachable(instmap::in) is semidet. % For any instmap InstMapDelta, exactly one of % instmap_delta_is_reachable(InstMapDelta) and @@ -70,36 +64,30 @@ % Is the instmap_delta reachable? % -:- pred instmap_delta_is_reachable(instmap_delta). -:- mode instmap_delta_is_reachable(in) is semidet. +:- pred instmap_delta_is_reachable(instmap_delta::in) is semidet. % Is the instmap_delta unreachable? % -:- pred instmap_delta_is_unreachable(instmap_delta). -:- mode instmap_delta_is_unreachable(in) is semidet. +:- pred instmap_delta_is_unreachable(instmap_delta::in) is semidet. -:- pred instmap__from_assoc_list(assoc_list(prog_var, inst), instmap). -:- mode instmap__from_assoc_list(in, out) is det. +:- pred instmap__from_assoc_list(assoc_list(prog_var, inst)::in, instmap::out) + is det. -:- pred instmap_delta_from_assoc_list(assoc_list(prog_var, inst), - instmap_delta). -:- mode instmap_delta_from_assoc_list(in, out) is det. +:- pred instmap_delta_from_assoc_list(assoc_list(prog_var, inst)::in, + instmap_delta::out) is det. -:- pred instmap_delta_from_mode_list(list(prog_var), list(mode), - module_info, instmap_delta). -:- mode instmap_delta_from_mode_list(in, in, in, out) is det. +:- pred instmap_delta_from_mode_list(list(prog_var)::in, list(mode)::in, + module_info::in, instmap_delta::out) is det. %-----------------------------------------------------------------------------% % Return the set of variables in an instmap. % -:- pred instmap__vars(instmap, set(prog_var)). -:- mode instmap__vars(in, out) is det. +:- pred instmap__vars(instmap::in, set(prog_var)::out) is det. % Return the list of variables in an instmap. % -:- pred instmap__vars_list(instmap, list(prog_var)). -:- mode instmap__vars_list(in, out) is det. +:- pred instmap__vars_list(instmap::in, list(prog_var)::out) is det. % Return the set of variables whose instantiations have % changed (or our knowledge about them has changed) across @@ -108,8 +96,8 @@ % This predicate shouldn't be used if you want your code to % compile on the alias branch, use instmap_changed_vars instead. % -:- pred instmap_delta_changed_vars(instmap_delta, set(prog_var)). -:- mode instmap_delta_changed_vars(in, out) is det. +:- pred instmap_delta_changed_vars(instmap_delta::in, set(prog_var)::out) + is det. % % instmap_changed_vars(IMA, IMB, MI, CV) @@ -124,64 +112,60 @@ % transform more easily to the alias branch. % :- pred instmap_changed_vars(instmap::in, instmap::in, vartypes::in, - module_info::in, set(prog_var)::out) is det. + module_info::in, set(prog_var)::out) is det. %-----------------------------------------------------------------------------% % Given an instmap and a variable, determine the inst of % that variable. % -:- pred instmap__lookup_var(instmap, prog_var, inst). -:- mode instmap__lookup_var(in, in, out) is det. +:- pred instmap__lookup_var(instmap::in, prog_var::in, (inst)::out) is det. % Given an instmap_delta and a variable, determine the new inst % of that variable (if any). % -:- pred instmap_delta_search_var(instmap_delta, prog_var, inst). -:- mode instmap_delta_search_var(in, in, out) is semidet. +:- pred instmap_delta_search_var(instmap_delta::in, prog_var::in, (inst)::out) + is semidet. % Given an instmap and a list of variables, return a list % containing the insts of those variable. % -:- pred instmap__lookup_vars(list(prog_var), instmap, list(inst)). -:- mode instmap__lookup_vars(in, in, out) is det. +:- pred instmap__lookup_vars(list(prog_var)::in, instmap::in, list(inst)::out) + is det. % Insert an entry into an instmap_delta. Note that you % cannot call instmap_delta_insert for a variable already % present. % -:- pred instmap_delta_insert(instmap_delta, prog_var, inst, instmap_delta). -:- mode instmap_delta_insert(in, in, in, out) is det. +:- pred instmap_delta_insert(instmap_delta::in, prog_var::in, (inst)::in, + instmap_delta::out) is det. % Set an entry in an instmap. % -:- pred instmap__set(instmap, prog_var, inst, instmap). -:- mode instmap__set(in, in, in, out) is det. +:- pred instmap__set(instmap::in, prog_var::in, (inst)::in, instmap::out) + is det. % Set multiple entries in an instmap. % -:- pred instmap__set_vars(instmap, list(prog_var), list(inst), instmap). -:- mode instmap__set_vars(in, in, in, out) is det. +:- pred instmap__set_vars(instmap::in, list(prog_var)::in, list(inst)::in, + instmap::out) is det. -:- pred instmap_delta_set(instmap_delta, prog_var, inst, instmap_delta). -:- mode instmap_delta_set(in, in, in, out) is det. +:- pred instmap_delta_set(instmap_delta::in, prog_var::in, (inst)::in, + instmap_delta::out) is det. % Bind a variable in an instmap to a functor at the beginning % of a case in a switch. Aborts on compiler generated cons_ids. -:- pred instmap_delta_bind_var_to_functor(prog_var, type, cons_id, instmap, - instmap_delta, instmap_delta, module_info, module_info). -:- mode instmap_delta_bind_var_to_functor(in, in, in, in, in, out, in, out) - is det. +:- pred instmap_delta_bind_var_to_functor(prog_var::in, (type)::in, + cons_id::in, instmap::in, instmap_delta::in, instmap_delta::out, + module_info::in, module_info::out) is det. -:- pred instmap__bind_var_to_functor(prog_var, type, cons_id, - instmap, instmap, module_info, module_info). -:- mode instmap__bind_var_to_functor(in, in, in, in, out, in, out) is det. +:- pred instmap__bind_var_to_functor(prog_var::in, (type)::in, cons_id::in, + instmap::in, instmap::out, module_info::in, module_info::out) is det. % Update the given instmap to include the initial insts of the % lambda variables. -:- pred instmap__pre_lambda_update(module_info, list(prog_var), list(mode), - instmap, instmap). -:- mode instmap__pre_lambda_update(in, in, in, in, out) is det. +:- pred instmap__pre_lambda_update(module_info::in, list(prog_var)::in, + list(mode)::in, instmap::in, instmap::out) is det. %-----------------------------------------------------------------------------% @@ -189,22 +173,21 @@ % which records the change in the instantiation state of those % variables. % -:- pred compute_instmap_delta(instmap, instmap, set(prog_var), instmap_delta). -:- mode compute_instmap_delta(in, in, in, out) is det. +:- pred compute_instmap_delta(instmap::in, instmap::in, set(prog_var)::in, + instmap_delta::out) is det. % Given an instmap and an instmap_delta, apply the instmap_delta % to the instmap to produce a new instmap. % -:- pred instmap__apply_instmap_delta(instmap, instmap_delta, instmap). -:- mode instmap__apply_instmap_delta(in, in, out) is det. +:- pred instmap__apply_instmap_delta(instmap::in, instmap_delta::in, + instmap::out) is det. % Given an instmap_delta and an instmap_delta, apply the % second instmap_delta to the first to produce a new % instmap_delta. % -:- pred instmap_delta_apply_instmap_delta(instmap_delta, instmap_delta, - instmap_delta). -:- mode instmap_delta_apply_instmap_delta(in, in, out) is det. +:- pred instmap_delta_apply_instmap_delta(instmap_delta::in, instmap_delta::in, + instmap_delta::out) is det. % instmap_merge(NonLocalVars, InstMaps, MergeContext): % Merge the `InstMaps' resulting from different branches @@ -212,9 +195,8 @@ % instantiatedness of all the nonlocal variables, % checking that it is the same for every branch. % -:- pred instmap__merge(set(prog_var), list(instmap), merge_context, - mode_info, mode_info). -:- mode instmap__merge(in, in, in, in, out) is det. +:- pred instmap__merge(set(prog_var)::in, list(instmap)::in, merge_context::in, + mode_info::in, mode_info::out) is det. % instmap__unify(NonLocalVars, InstMapNonlocalvarPairss): % Unify the `InstMaps' in the list of pairs resulting @@ -224,62 +206,60 @@ % the individual conjuncts ensures that variables have % at most one producer. % -:- pred instmap__unify(set(prog_var), list(pair(instmap, set(prog_var))), - mode_info, mode_info). -:- mode instmap__unify(in, in, in, out) is det. +:- pred instmap__unify(set(prog_var)::in, list(pair(instmap, + set(prog_var)))::in, mode_info::in, mode_info::out) is det. % instmap__restrict takes an instmap and a set of vars and % returns an instmap with its domain restricted to those % vars. % -:- pred instmap__restrict(instmap, set(prog_var), instmap). -:- mode instmap__restrict(in, in, out) is det. +:- pred instmap__restrict(instmap::in, set(prog_var)::in, instmap::out) + is det. % instmap_delta_restrict takes an instmap and a set of vars % and returns an instmap_delta with its domain restricted to % those vars. % -:- pred instmap_delta_restrict(instmap_delta, set(prog_var), instmap_delta). -:- mode instmap_delta_restrict(in, in, out) is det. +:- pred instmap_delta_restrict(instmap_delta::in, set(prog_var)::in, + instmap_delta::out) is det. % instmap_delta_delete_vars takes an instmap_delta and a list of % vars and returns an instmap_delta with those vars removed from % its domain. % -:- pred instmap_delta_delete_vars(instmap_delta, list(prog_var), instmap_delta). -:- mode instmap_delta_delete_vars(in, in, out) is det. +:- pred instmap_delta_delete_vars(instmap_delta::in, list(prog_var)::in, + instmap_delta::out) is det. % `instmap__no_output_vars(Instmap, InstmapDelta, Vars, ModuleInfo)' % is true if none of the vars in the set Vars could have become more % instantiated when InstmapDelta is applied to Instmap. -:- pred instmap__no_output_vars(instmap, instmap_delta, set(prog_var), - vartypes, module_info). -:- mode instmap__no_output_vars(in, in, in, in, in) is semidet. +:- pred instmap__no_output_vars(instmap::in, instmap_delta::in, + set(prog_var)::in, vartypes::in, module_info::in) is semidet. % merge_instmap_delta(InitialInstMap, NonLocals, % InstMapDeltaA, InstMapDeltaB, ModuleInfo0, ModuleInfo) % Merge the instmap_deltas of different branches of an if-then-else, % disj or switch. -:- pred merge_instmap_delta(instmap, set(prog_var), vartypes, instmap_delta, - instmap_delta, instmap_delta, module_info, module_info). -:- mode merge_instmap_delta(in, in, in, in, in, out, in, out) is det. +:- pred merge_instmap_delta(instmap::in, set(prog_var)::in, vartypes::in, + instmap_delta::in, instmap_delta::in, instmap_delta::out, + module_info::in, module_info::out) is det. % merge_instmap_deltas(Vars, InstMapDeltas, % MergedInstMapDelta, ModuleInfo0, ModuleInfo) % takes a list of instmap deltas from the branches of an if-then-else, % switch, or disj and merges them. This is used in situations % where the bindings are known to be compatible. -:- pred merge_instmap_deltas(instmap, set(prog_var), vartypes, - list(instmap_delta), instmap_delta, module_info, module_info). -:- mode merge_instmap_deltas(in, in, in, in, out, in, out) is det. +:- pred merge_instmap_deltas(instmap::in, set(prog_var)::in, vartypes::in, + list(instmap_delta)::in, instmap_delta::out, + module_info::in, module_info::out) is det. % unify_instmap_delta(InitialInstMap, NonLocals, - % InstMapDeltaA, InstMapDeltaB, ModuleInfo0, ModuleInfo) + % InstMapDeltaA, InstMapDeltaB, !ModuleInfo) % Unify the instmap_deltas of different branches of a parallel % conjunction. -:- pred unify_instmap_delta(instmap, set(prog_var), instmap_delta, - instmap_delta, instmap_delta, module_info, module_info). -:- mode unify_instmap_delta(in, in, in, in, out, in, out) is det. +:- pred unify_instmap_delta(instmap::in, set(prog_var)::in, instmap_delta::in, + instmap_delta::in, instmap_delta::out, + module_info::in, module_info::out) is det. %-----------------------------------------------------------------------------% @@ -289,26 +269,24 @@ % InstmapDelta0 which does not appear in Sub, it is ignored if % Must is set to no, otherwise it is an error. % -:- pred instmap_delta_apply_sub(instmap_delta, bool, map(prog_var, prog_var), - instmap_delta). -:- mode instmap_delta_apply_sub(in, in, in, out) is det. +:- pred instmap_delta_apply_sub(instmap_delta::in, bool::in, + map(prog_var, prog_var)::in, instmap_delta::out) is det. -:- pred instmap__apply_sub(instmap, bool, map(prog_var, prog_var), instmap). -:- mode instmap__apply_sub(in, in, in, out) is det. +:- pred instmap__apply_sub(instmap::in, bool::in, map(prog_var, prog_var)::in, + instmap::out) is det. %-----------------------------------------------------------------------------% -:- pred instmap__to_assoc_list(instmap, assoc_list(prog_var, inst)). -:- mode instmap__to_assoc_list(in, out) is det. +:- pred instmap__to_assoc_list(instmap::in, assoc_list(prog_var, inst)::out) + is det. -:- pred instmap_delta_to_assoc_list(instmap_delta, assoc_list(prog_var, inst)). -:- mode instmap_delta_to_assoc_list(in, out) is det. +:- pred instmap_delta_to_assoc_list(instmap_delta::in, + assoc_list(prog_var, inst)::out) is det. % Apply the specified procedure to all insts in an instmap_delta. -:- pred instmap_delta_map_foldl(pred(prog_var, inst, inst, T, T), - instmap_delta, instmap_delta, T, T). -:- mode instmap_delta_map_foldl((pred(in, in, out, in, out) is det), - in, out, in, out) is det. +:- pred instmap_delta_map_foldl( + pred(prog_var, inst, inst, T, T)::in(pred(in, in, out, in, out) is det), + instmap_delta::in, instmap_delta::out, T::in, T::out) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% @@ -323,12 +301,13 @@ :- import_module hlds__hlds_data. :- import_module parse_tree__prog_data. -:- import_module std_util, require, string, term. +:- import_module std_util, require, string, term, svmap. :- type instmap_delta == instmap. -:- type instmap ---> reachable(instmapping) - ; unreachable. +:- type instmap + ---> reachable(instmapping) + ; unreachable. :- type instmapping == map(prog_var, inst). @@ -376,25 +355,24 @@ instmap_delta_from_mode_list(Var, Modes, ModuleInfo, InstMapDelta) :- instmap_delta_from_mode_list_2(Var, Modes, ModuleInfo, InstMapDelta0, InstMapDelta). -:- pred instmap_delta_from_mode_list_2(list(prog_var), list(mode), - module_info, instmap_delta, instmap_delta). -:- mode instmap_delta_from_mode_list_2(in, in, in, in, out) is det. +:- pred instmap_delta_from_mode_list_2(list(prog_var)::in, list(mode)::in, + module_info::in, instmap_delta::in, instmap_delta::out) is det. -instmap_delta_from_mode_list_2([], [], _, InstMapDelta, InstMapDelta). -instmap_delta_from_mode_list_2([], [_|_], _, _, _) :- +instmap_delta_from_mode_list_2([], [], _, !InstMapDelta). +instmap_delta_from_mode_list_2([], [_|_], _, !InstMapDelta) :- error("instmap_delta_from_mode_list_2"). -instmap_delta_from_mode_list_2([_|_], [], _, _, _) :- +instmap_delta_from_mode_list_2([_|_], [], _, !InstMapDelta) :- error("instmap_delta_from_mode_list_2"). instmap_delta_from_mode_list_2([Var | Vars], [Mode | Modes], ModuleInfo, - InstMapDelta0, InstMapDelta) :- + !InstMapDelta) :- mode_get_insts(ModuleInfo, Mode, Inst1, Inst2), ( Inst1 = Inst2 -> instmap_delta_from_mode_list_2(Vars, Modes, ModuleInfo, - InstMapDelta0, InstMapDelta) + !InstMapDelta) ; - instmap_delta_set(InstMapDelta0, Var, Inst2, InstMapDelta1), + instmap_delta_set(!.InstMapDelta, Var, Inst2, !:InstMapDelta), instmap_delta_from_mode_list_2(Vars, Modes, ModuleInfo, - InstMapDelta1, InstMapDelta) + !InstMapDelta) ). %-----------------------------------------------------------------------------% @@ -421,7 +399,7 @@ instmap_changed_vars(InstMapA, InstMapB, VarTypes, ModuleInfo, ChangedVars) :- ChangedVars). :- pred changed_vars_2(prog_vars::in, instmap::in, instmap::in, vartypes::in, - module_info::in, set(prog_var)::out) is det. + module_info::in, set(prog_var)::out) is det. changed_vars_2([], _InstMapA, _InstMapB, _Types, _ModuleInfo, ChangedVars) :- set__init(ChangedVars). @@ -451,8 +429,8 @@ instmap__lookup_var(unreachable, _Var, not_reached). instmap__lookup_var(reachable(InstMap), Var, Inst) :- instmapping_lookup_var(InstMap, Var, Inst). -:- pred instmapping_lookup_var(instmapping, prog_var, inst). -:- mode instmapping_lookup_var(in, in, out) is det. +:- pred instmapping_lookup_var(instmapping::in, prog_var::in, (inst)::out) + is det. instmapping_lookup_var(InstMap, Var, Inst) :- ( map__search(InstMap, Var, VarInst) -> @@ -505,11 +483,10 @@ instmap_delta_insert(reachable(InstMapping0), Var, Inst, Instmap) :- %-----------------------------------------------------------------------------% instmap_delta_bind_var_to_functor(Var, Type, ConsId, InstMap, - InstmapDelta0, InstmapDelta, ModuleInfo0, ModuleInfo) :- + InstmapDelta0, InstmapDelta, !ModuleInfo) :- ( InstmapDelta0 = unreachable, - InstmapDelta = unreachable, - ModuleInfo = ModuleInfo0 + InstmapDelta = unreachable ; InstmapDelta0 = reachable(InstmappingDelta0), @@ -529,7 +506,7 @@ instmap_delta_bind_var_to_functor(Var, Type, ConsId, InstMap, NewInst1 = OldInst ), bind_inst_to_functor(Type, ConsId, NewInst1, NewInst, - ModuleInfo0, ModuleInfo), + !ModuleInfo), % % add `Var :: OldInst -> NewInst' to the instmap delta @@ -543,27 +520,23 @@ instmap_delta_bind_var_to_functor(Var, Type, ConsId, InstMap, ). instmap__bind_var_to_functor(Var, Type, ConsId, InstMap0, InstMap, - ModuleInfo0, ModuleInfo) :- + !ModuleInfo) :- instmap__lookup_var(InstMap0, Var, Inst0), - bind_inst_to_functor(Type, ConsId, Inst0, Inst, - ModuleInfo0, ModuleInfo), + bind_inst_to_functor(Type, ConsId, Inst0, Inst, !ModuleInfo), instmap__set(InstMap0, Var, Inst, InstMap). -:- pred bind_inst_to_functor(type, cons_id, (inst), (inst), - module_info, module_info). -:- mode bind_inst_to_functor(in, in, in, out, in, out) is det. +:- pred bind_inst_to_functor((type)::in, cons_id::in, (inst)::in, (inst)::out, + module_info::in, module_info::out) is det. -bind_inst_to_functor(Type, ConsId, Inst0, Inst, ModuleInfo0, ModuleInfo) :- - Arity = cons_id_adjusted_arity(ModuleInfo0, Type, ConsId), +bind_inst_to_functor(Type, ConsId, !Inst, !ModuleInfo) :- + Arity = cons_id_adjusted_arity(!.ModuleInfo, Type, ConsId), list__duplicate(Arity, dead, ArgLives), list__duplicate(Arity, free, ArgInsts), ( - abstractly_unify_inst_functor(dead, Inst0, ConsId, ArgInsts, - ArgLives, real_unify, Type, ModuleInfo0, Inst1, _Det, - ModuleInfo1) + abstractly_unify_inst_functor(dead, !.Inst, ConsId, ArgInsts, + ArgLives, real_unify, Type, !:Inst, _Det, !ModuleInfo) -> - ModuleInfo = ModuleInfo1, - Inst = Inst1 + true ; error("bind_inst_to_functor: mode error") ). @@ -633,7 +606,7 @@ instmap__merge(NonLocals, InstMapList, MergeContext, ModeInfo0, ModeInfo) :- set__to_sorted_list(NonLocals, NonLocalsList), mode_info_get_var_types(ModeInfo0, VarTypes), instmap__merge_2(NonLocalsList, InstMapList, VarTypes, - ModuleInfo0, InstMapping0, ModuleInfo, InstMapping, + InstMapping0, InstMapping, ModuleInfo0, ModuleInfo, ErrorList), mode_info_set_module_info(ModuleInfo, ModeInfo0, ModeInfo1), ( ErrorList = [FirstError | _] -> @@ -653,8 +626,8 @@ instmap__merge(NonLocals, InstMapList, MergeContext, ModeInfo0, ModeInfo) :- ), mode_info_set_instmap(InstMap, ModeInfo2, ModeInfo). -:- pred get_reachable_instmaps(list(instmap), list(map(prog_var, inst))). -:- mode get_reachable_instmaps(in, out) is det. +:- pred get_reachable_instmaps(list(instmap)::in, + list(map(prog_var, inst))::out) is det. get_reachable_instmaps([], []). get_reachable_instmaps([InstMap | InstMaps], Reachables) :- @@ -672,24 +645,24 @@ get_reachable_instmaps([InstMap | InstMaps], Reachables) :- % there are two instmaps in `InstMaps' for which the inst % the variable is incompatible. -:- pred instmap__merge_2(list(prog_var), list(instmap), vartypes, module_info, - map(prog_var, inst), module_info, map(prog_var, inst), - merge_errors). -:- mode instmap__merge_2(in, in, in, in, in, out, out, out) is det. +:- pred instmap__merge_2(list(prog_var)::in, list(instmap)::in, vartypes::in, + instmapping::in, instmapping::out, module_info::in, module_info::out, + merge_errors::out) is det. -instmap__merge_2([], _, _, ModuleInfo, InstMap, ModuleInfo, InstMap, []). -instmap__merge_2([Var|Vars], InstMapList, VarTypes, ModuleInfo0, InstMap0, - ModuleInfo, InstMap, ErrorList) :- - instmap__merge_2(Vars, InstMapList, VarTypes, ModuleInfo0, InstMap0, - ModuleInfo1, InstMap1, ErrorList1), +instmap__merge_2([], _, _, !InstMap, !ModuleInfo, []). +instmap__merge_2([Var|Vars], InstMapList, VarTypes, !InstMap, !ModuleInfo, + !:ErrorList) :- + instmap__merge_2(Vars, InstMapList, VarTypes, !InstMap, !ModuleInfo, + !:ErrorList), instmap__merge_var(InstMapList, Var, VarTypes ^ det_elem(Var), - ModuleInfo1, Insts, Inst, ModuleInfo, Error), - ( Error = yes -> - ErrorList = [Var - Insts | ErrorList1], - map__set(InstMap1, Var, not_reached, InstMap) + Insts, Inst, !ModuleInfo, Error), + ( + Error = yes, + !:ErrorList = [Var - Insts | !.ErrorList], + svmap__set(Var, not_reached, !InstMap) ; - ErrorList = ErrorList1, - map__set(InstMap1, Var, Inst, InstMap) + Error = no, + svmap__set(Var, Inst, !InstMap) ). % instmap_merge_var(InstMaps, Var, ModuleInfo, Insts, Error): @@ -698,71 +671,66 @@ instmap__merge_2([Var|Vars], InstMapList, VarTypes, ModuleInfo0, InstMap0, % there are two instmaps for which the inst of `Var' % is incompatible. -:- pred instmap__merge_var(list(instmap), prog_var, (type), module_info, - list(inst), inst, module_info, bool). -:- mode instmap__merge_var(in, in, in, in, out, out, out, out) is det. +:- pred instmap__merge_var(list(instmap)::in, prog_var::in, (type)::in, + list(inst)::out, (inst)::out, module_info::in, module_info::out, + bool::out) is det. -instmap__merge_var([], _, _, ModuleInfo, [], not_reached, ModuleInfo, no). -instmap__merge_var([InstMap | InstMaps], Var, Type, ModuleInfo0, - InstList, Inst, ModuleInfo, Error) :- - instmap__merge_var(InstMaps, Var, Type, ModuleInfo0, - InstList0, Inst0, ModuleInfo1, Error0), +instmap__merge_var([], _, _, [], not_reached, !ModuleInfo, no). +instmap__merge_var([InstMap | InstMaps], Var, Type, InstList, Inst, + !ModuleInfo, Error) :- + instmap__merge_var(InstMaps, Var, Type, InstList0, Inst0, !ModuleInfo, + Error0), instmap__lookup_var(InstMap, Var, VarInst), InstList = [VarInst | InstList0], - ( - inst_merge(Inst0, VarInst, yes(Type), ModuleInfo1, Inst1, - ModuleInfo2) - -> + ( inst_merge(Inst0, VarInst, yes(Type), Inst1, !ModuleInfo) -> Inst = Inst1, - ModuleInfo = ModuleInfo2, Error = Error0 ; Error = yes, - ModuleInfo = ModuleInfo1, Inst = not_reached ). %-----------------------------------------------------------------------------% merge_instmap_deltas(InstMap, NonLocals, VarTypes, InstMapDeltaList, - MergedDelta, ModuleInfo0, ModuleInfo) :- + MergedDelta, !ModuleInfo) :- ( InstMapDeltaList = [], error("merge_instmap_deltas: empty instmap_delta list.") ; InstMapDeltaList = [Delta | Deltas], merge_instmap_deltas(InstMap, NonLocals, VarTypes, Delta, - Deltas, MergedDelta, ModuleInfo0, ModuleInfo) + Deltas, MergedDelta, !ModuleInfo) ). -:- pred merge_instmap_deltas(instmap, set(prog_var), vartypes, instmap_delta, - list(instmap_delta), instmap_delta, module_info, module_info). -:- mode merge_instmap_deltas(in, in, in, in, in, out, in, out) is det. +:- pred merge_instmap_deltas(instmap::in, set(prog_var)::in, vartypes::in, + instmap_delta::in, list(instmap_delta)::in, instmap_delta::out, + module_info::in, module_info::out) is det. merge_instmap_deltas(_InstMap, _NonLocals, _VarTypes, MergedDelta, [], - MergedDelta, ModuleInfo, ModuleInfo). + MergedDelta, !ModuleInfo). merge_instmap_deltas(InstMap, NonLocals, VarTypes, MergedDelta0, [Delta|Deltas], - MergedDelta, ModuleInfo0, ModuleInfo) :- + MergedDelta, !ModuleInfo) :- merge_instmap_delta(InstMap, NonLocals, VarTypes, MergedDelta0, Delta, - MergedDelta1, ModuleInfo0, ModuleInfo1), + MergedDelta1, !ModuleInfo), merge_instmap_deltas(InstMap, NonLocals, VarTypes, MergedDelta1, Deltas, - MergedDelta, ModuleInfo1, ModuleInfo). + MergedDelta, !ModuleInfo). %-----------------------------------------------------------------------------% -instmap__unify(NonLocals, InstMapList, ModeInfo0, ModeInfo) :- +instmap__unify(NonLocals, InstMapList, !ModeInfo) :- ( % If any of the instmaps is unreachable, then % the final instmap is unreachable. list__member(unreachable - _, InstMapList) -> - mode_info_set_instmap(unreachable, ModeInfo0, ModeInfo) + mode_info_set_instmap(unreachable, !ModeInfo) ; % If there is only one instmap, then we just % stick it in the mode_info. InstMapList = [InstMap - _] -> - mode_info_set_instmap(InstMap, ModeInfo0, ModeInfo) + mode_info_set_instmap(InstMap, !ModeInfo) ; InstMapList = [InstMap0 - _|InstMapList1], InstMap0 = reachable(InstMapping0) @@ -771,12 +739,12 @@ instmap__unify(NonLocals, InstMapList, ModeInfo0, ModeInfo) :- % an accumulator, all instmap__unify_2 which % unifies each of the nonlocals from each instmap % with the corresponding inst in the accumulator. - mode_info_get_module_info(ModeInfo0, ModuleInfo0), + mode_info_get_module_info(!.ModeInfo, ModuleInfo0), set__to_sorted_list(NonLocals, NonLocalsList), instmap__unify_2(NonLocalsList, InstMap0, InstMapList1, ModuleInfo0, InstMapping0, ModuleInfo, InstMapping, ErrorList), - mode_info_set_module_info(ModuleInfo, ModeInfo0, ModeInfo1), + mode_info_set_module_info(ModuleInfo, !ModeInfo), % If there were any errors, then add the error % to the list of possible errors in the mode_info. @@ -784,15 +752,13 @@ instmap__unify(NonLocals, InstMapList, ModeInfo0, ModeInfo) :- FirstError = Var - _, set__singleton_set(WaitingVars, Var), mode_info_error(WaitingVars, - mode_error_par_conj(ErrorList), - ModeInfo1, ModeInfo2) + mode_error_par_conj(ErrorList), !ModeInfo) ; - ModeInfo2 = ModeInfo1 + true ), - mode_info_set_instmap(reachable(InstMapping), - ModeInfo2, ModeInfo) + mode_info_set_instmap(reachable(InstMapping), !ModeInfo) ; - ModeInfo = ModeInfo0 + true ). %-----------------------------------------------------------------------------% @@ -802,10 +768,10 @@ instmap__unify(NonLocals, InstMapList, ModeInfo0, ModeInfo) :- % Let `ErrorList' be the list of variables in `Vars' for % which there are two instmaps in `InstMaps' for which the insts % of the variable is incompatible. -:- pred instmap__unify_2(list(prog_var), instmap, list(pair(instmap, - set(prog_var))), module_info, map(prog_var, inst), module_info, - map(prog_var, inst), merge_errors). -:- mode instmap__unify_2(in, in, in, in, in, out, out, out) is det. +:- pred instmap__unify_2(list(prog_var)::in, instmap::in, + list(pair(instmap, set(prog_var)))::in, module_info::in, + map(prog_var, inst)::in, module_info::out, + map(prog_var, inst)::out, merge_errors::out) is det. instmap__unify_2([], _, _, ModuleInfo, InstMap, ModuleInfo, InstMap, []). instmap__unify_2([Var|Vars], InitialInstMap, InstMapList, ModuleInfo0, InstMap0, @@ -829,18 +795,14 @@ instmap__unify_2([Var|Vars], InitialInstMap, InstMapList, ModuleInfo0, InstMap0, % iff there are two instmaps for which the inst of `Var' % is incompatible. -:- pred instmap__unify_var(list(pair(instmap, set(prog_var))), prog_var, - list(inst), list(inst), inst, inst, module_info, module_info, - bool, bool). -:- mode instmap__unify_var(in, in, in, out, in, out, in, out, in, out) is det. +:- pred instmap__unify_var(list(pair(instmap, set(prog_var)))::in, + prog_var::in, list(inst)::in, list(inst)::out, (inst)::in, (inst)::out, + module_info::in, module_info::out, bool::in, bool::out) is det. -instmap__unify_var([], _, Insts, Insts, Inst, Inst, ModuleInfo, ModuleInfo, - Error, Error). -instmap__unify_var([InstMap - Nonlocals| Rest], Var, InstList0, InstList, - Inst0, Inst, ModuleInfo0, ModuleInfo, Error0, Error) :- - ( - set__member(Var, Nonlocals) - -> +instmap__unify_var([], _, !Insts, !Inst, !ModuleInfo, !Error). +instmap__unify_var([InstMap - Nonlocals| Rest], Var, !InstList, !Inst, + !ModuleInfo, !Error) :- + ( set__member(Var, Nonlocals) -> instmap__lookup_var(InstMap, Var, VarInst), ( % We can ignore the determinism of the unification: @@ -848,25 +810,19 @@ instmap__unify_var([InstMap - Nonlocals| Rest], Var, InstList0, InstList, % or a determinism error in one of the parallel % conjuncts. - abstractly_unify_inst(live, Inst0, VarInst, fake_unify, - ModuleInfo0, Inst1, _Det, ModuleInfo1) + abstractly_unify_inst(live, !.Inst, VarInst, + fake_unify, !:Inst, _Det, !ModuleInfo) -> - Inst2 = Inst1, - ModuleInfo2 = ModuleInfo1, - Error1 = Error0 + true ; - Error1 = yes, - ModuleInfo2 = ModuleInfo0, - Inst2 = not_reached + !:Error = yes, + !:Inst = not_reached ) ; - VarInst = free, - Inst2 = Inst0, - Error1 = Error0, - ModuleInfo2 = ModuleInfo0 + VarInst = free ), - instmap__unify_var(Rest, Var, [VarInst | InstList0], InstList, - Inst2, Inst, ModuleInfo2, ModuleInfo, Error1, Error). + !:InstList = [VarInst | !.InstList], + instmap__unify_var(Rest, Var, !InstList, !Inst, !ModuleInfo, !Error). %-----------------------------------------------------------------------------% @@ -882,9 +838,8 @@ compute_instmap_delta(reachable(InstMapA), reachable(InstMapB), NonLocals, compute_instmap_delta_2(NonLocalsList, InstMapA, InstMapB, AssocList), map__from_sorted_assoc_list(AssocList, DeltaInstMap). -:- pred compute_instmap_delta_2(list(prog_var), instmapping, instmapping, - assoc_list(prog_var, inst)). -:- mode compute_instmap_delta_2(in, in, in, out) is det. +:- pred compute_instmap_delta_2(list(prog_var)::in, instmapping::in, + instmapping::in, assoc_list(prog_var, inst)::out) is det. compute_instmap_delta_2([], _, _, []). compute_instmap_delta_2([Var | Vars], InstMapA, InstMapB, AssocList) :- @@ -905,9 +860,8 @@ instmap__no_output_vars(InstMap0, reachable(InstMapDelta), Vars, VT, M) :- set__to_sorted_list(Vars, VarList), instmap__no_output_vars_2(VarList, InstMap0, InstMapDelta, VT, M). -:- pred instmap__no_output_vars_2(list(prog_var), instmap, instmapping, - vartypes, module_info). -:- mode instmap__no_output_vars_2(in, in, in, in, in) is semidet. +:- pred instmap__no_output_vars_2(list(prog_var)::in, instmap::in, + instmapping::in, vartypes::in, module_info::in) is semidet. instmap__no_output_vars_2([], _, _, _, _). instmap__no_output_vars_2([Var | Vars], InstMap0, InstMapDelta, VarTypes, @@ -936,40 +890,40 @@ instmap__no_output_vars_2([Var | Vars], InstMap0, InstMapDelta, VarTypes, % Given two instmap deltas, merge them to produce a new instmap_delta. -merge_instmap_delta(_, _, _, unreachable, InstMapDelta, InstMapDelta) --> []. +merge_instmap_delta(_, _, _, unreachable, InstMapDelta, InstMapDelta, + !ModuleInfo). merge_instmap_delta(_, _, _, reachable(InstMapping), unreachable, - reachable(InstMapping)) --> []. + reachable(InstMapping), !ModuleInfo). merge_instmap_delta(InstMap, NonLocals, VarTypes, reachable(InstMappingA), - reachable(InstMappingB), reachable(InstMapping)) --> - merge_instmapping_delta(InstMap, NonLocals, VarTypes, InstMappingA, - InstMappingB, InstMapping). + reachable(InstMappingB), reachable(InstMapping), + !ModuleInfo) :- + merge_instmapping_delta(InstMap, NonLocals, VarTypes, + InstMappingA, InstMappingB, InstMapping, !ModuleInfo). -:- pred merge_instmapping_delta(instmap, set(prog_var), vartypes, instmapping, - instmapping, instmapping, module_info, module_info). -:- mode merge_instmapping_delta(in, in, in, in, in, out, in, out) is det. +:- pred merge_instmapping_delta(instmap::in, set(prog_var)::in, vartypes::in, + instmapping::in, instmapping::in, instmapping::out, + module_info::in, module_info::out) is det. -merge_instmapping_delta(InstMap, NonLocals, VarTypes, InstMappingA, - InstMappingB, InstMapping) --> - { map__keys(InstMappingA, VarsInA) }, - { map__keys(InstMappingB, VarsInB) }, - { set__sorted_list_to_set(VarsInA, SetofVarsInA) }, - { set__insert_list(SetofVarsInA, VarsInB, SetofVars0) }, - { set__intersect(SetofVars0, NonLocals, SetofVars) }, - { map__init(InstMapping0) }, - { set__to_sorted_list(SetofVars, ListofVars) }, - merge_instmapping_delta_2(ListofVars, InstMap, VarTypes, InstMappingA, - InstMappingB, InstMapping0, InstMapping). +merge_instmapping_delta(InstMap, NonLocals, VarTypes, + InstMappingA, InstMappingB, InstMapping, !ModuleInfo) :- + map__keys(InstMappingA, VarsInA), + map__keys(InstMappingB, VarsInB), + set__sorted_list_to_set(VarsInA, SetofVarsInA), + set__insert_list(SetofVarsInA, VarsInB, SetofVars0), + set__intersect(SetofVars0, NonLocals, SetofVars), + set__to_sorted_list(SetofVars, ListofVars), + merge_instmapping_delta_2(ListofVars, InstMap, VarTypes, + InstMappingA, InstMappingB, map__init, InstMapping, + !ModuleInfo). -:- pred merge_instmapping_delta_2(list(prog_var), instmap, vartypes, - instmapping, instmapping, instmapping, instmapping, - module_info, module_info). -:- mode merge_instmapping_delta_2(in, in, in, in, in, in, out, in, out) is det. +:- pred merge_instmapping_delta_2(list(prog_var)::in, instmap::in, + vartypes::in, instmapping::in, instmapping::in, + instmapping::in, instmapping::out, + module_info::in, module_info::out) is det. -merge_instmapping_delta_2([], _, _, _, _, InstMapping, InstMapping, - ModInfo, ModInfo). -merge_instmapping_delta_2([Var | Vars], InstMap, VarTypes, InstMappingA, - InstMappingB, InstMapping0, InstMapping, - ModuleInfo0, ModuleInfo) :- +merge_instmapping_delta_2([], _, _, _, _, !InstMapping, !ModuleInfo). +merge_instmapping_delta_2([Var | Vars], InstMap, VarTypes, + InstMappingA, InstMappingB, !InstMapping, !ModuleInfo) :- ( map__search(InstMappingA, Var, InstInA) -> InstA = InstInA ; @@ -981,8 +935,8 @@ merge_instmapping_delta_2([Var | Vars], InstMap, VarTypes, InstMappingA, instmap__lookup_var(InstMap, Var, InstB) ), ( - inst_merge(InstA, InstB, yes(VarTypes ^ det_elem(Var)), - ModuleInfo0, Inst1, ModuleInfoPrime) + inst_merge(InstA, InstB, yes(VarTypes ^ det_elem(Var)), Inst1, + !ModuleInfo) -> % XXX Given instmap__lookup_var(InstMap, Var, OldInst), % we should probably set Inst not directly from Inst1, but @@ -1000,9 +954,8 @@ merge_instmapping_delta_2([Var | Vars], InstMap, VarTypes, InstMappingA, % arise only after inlining, as in puzzle_detism_bug.m in % tests/hard_coded. -zs - ModuleInfo1 = ModuleInfoPrime, Inst = Inst1, - map__det_insert(InstMapping0, Var, Inst, InstMapping1) + svmap__det_insert(Var, Inst, !InstMapping) ; term__var_to_int(Var, VarInt), string__format( @@ -1010,48 +963,46 @@ merge_instmapping_delta_2([Var | Vars], InstMap, VarTypes, InstMappingA, [i(VarInt)], Msg), error(Msg) ), - merge_instmapping_delta_2(Vars, InstMap, VarTypes, InstMappingA, - InstMappingB, InstMapping1, InstMapping, - ModuleInfo1, ModuleInfo). + merge_instmapping_delta_2(Vars, InstMap, VarTypes, + InstMappingA, InstMappingB, !InstMapping, !ModuleInfo). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % Given two instmap deltas, unify them to produce a new instmap_delta. -unify_instmap_delta(_, _, unreachable, InstMapDelta, InstMapDelta) --> []. +unify_instmap_delta(_, _, unreachable, InstMapDelta, InstMapDelta, !ModuleInfo). unify_instmap_delta(_, _, reachable(InstMapping), unreachable, - reachable(InstMapping)) --> []. + reachable(InstMapping), !ModuleInfo). unify_instmap_delta(InstMap, NonLocals, reachable(InstMappingA), - reachable(InstMappingB), reachable(InstMapping)) --> - unify_instmapping_delta(InstMap, NonLocals, InstMappingA, - InstMappingB, InstMapping). + reachable(InstMappingB), reachable(InstMapping), + !ModuleInfo) :- + unify_instmapping_delta(InstMap, NonLocals, InstMappingA, InstMappingB, + InstMapping, !ModuleInfo). -:- pred unify_instmapping_delta(instmap, set(prog_var), instmapping, - instmapping, instmapping, module_info, module_info). -:- mode unify_instmapping_delta(in, in, in, in, out, in, out) is det. +:- pred unify_instmapping_delta(instmap::in, set(prog_var)::in, + instmapping::in, instmapping::in, instmapping::out, + module_info::in, module_info::out) is det. -unify_instmapping_delta(InstMap, NonLocals, InstMappingA, - InstMappingB, InstMapping) --> - { map__keys(InstMappingA, VarsInA) }, - { map__keys(InstMappingB, VarsInB) }, - { set__sorted_list_to_set(VarsInA, SetofVarsInA) }, - { set__insert_list(SetofVarsInA, VarsInB, SetofVars0) }, - { set__intersect(SetofVars0, NonLocals, SetofVars) }, - { map__init(InstMapping0) }, - { set__to_sorted_list(SetofVars, ListofVars) }, - unify_instmapping_delta_2(ListofVars, InstMap, InstMappingA, - InstMappingB, InstMapping0, InstMapping). +unify_instmapping_delta(InstMap, NonLocals, InstMappingA, InstMappingB, + InstMapping, !ModuleInfo) :- + map__keys(InstMappingA, VarsInA), + map__keys(InstMappingB, VarsInB), + set__sorted_list_to_set(VarsInA, SetofVarsInA), + set__insert_list(SetofVarsInA, VarsInB, SetofVars0), + set__intersect(SetofVars0, NonLocals, SetofVars), + set__to_sorted_list(SetofVars, ListofVars), + unify_instmapping_delta_2(ListofVars, InstMap, + InstMappingA, InstMappingB, map__init, InstMapping, + !ModuleInfo). -:- pred unify_instmapping_delta_2(list(prog_var), instmap, instmapping, - instmapping, instmapping, instmapping, - module_info, module_info). -:- mode unify_instmapping_delta_2(in, in, in, in, in, out, in, out) is det. +:- pred unify_instmapping_delta_2(list(prog_var)::in, instmap::in, + instmapping::in, instmapping::in, instmapping::in, instmapping::out, + module_info::in, module_info::out) is det. -unify_instmapping_delta_2([], _, _, _, InstMapping, InstMapping, - ModInfo, ModInfo). +unify_instmapping_delta_2([], _, _, _, !InstMapping, !ModuleInfo). unify_instmapping_delta_2([Var | Vars], InstMap, InstMappingA, InstMappingB, - InstMapping0, InstMapping, ModuleInfo0, ModuleInfo) :- + !InstMapping, !ModuleInfo) :- ( map__search(InstMappingA, Var, InstA) -> ( map__search(InstMappingB, Var, InstB) -> ( @@ -1061,31 +1012,25 @@ unify_instmapping_delta_2([Var | Vars], InstMap, InstMappingA, InstMappingB, % in one of the parallel conjuncts. abstractly_unify_inst(live, InstA, InstB, - fake_unify, ModuleInfo0, Inst, _Det, - ModuleInfoPrime) + fake_unify, Inst, _Det, !ModuleInfo) -> - ModuleInfo1 = ModuleInfoPrime, - map__det_insert(InstMapping0, Var, Inst, - InstMapping1) + svmap__det_insert(Var, Inst, !InstMapping) ; - error( - "unify_instmapping_delta_2: unexpected error") + error("unify_instmapping_delta_2: " ++ + "unexpected error") ) ; - ModuleInfo1 = ModuleInfo0, - map__det_insert(InstMapping0, Var, InstA, InstMapping1) + svmap__det_insert(Var, InstA, !InstMapping) ) ; ( map__search(InstMappingB, Var, InstB) -> - ModuleInfo1 = ModuleInfo0, - map__det_insert(InstMapping0, Var, InstB, InstMapping1) + svmap__det_insert(Var, InstB, !InstMapping) ; - ModuleInfo1 = ModuleInfo0, - InstMapping1 = InstMapping0 + true ) ), unify_instmapping_delta_2(Vars, InstMap, InstMappingA, InstMappingB, - InstMapping1, InstMapping, ModuleInfo1, ModuleInfo). + !InstMapping, !ModuleInfo). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% @@ -1094,27 +1039,25 @@ instmap_delta_apply_sub(unreachable, _Must, _Sub, unreachable). instmap_delta_apply_sub(reachable(OldInstMapping), Must, Sub, reachable(InstMapping)) :- map__to_assoc_list(OldInstMapping, InstMappingAL), - map__init(InstMapping0), instmap_delta_apply_sub_2(InstMappingAL, Must, Sub, - InstMapping0, InstMapping). + map__init, InstMapping). instmap__apply_sub(InstMap0, Must, Sub, InstMap) :- instmap_delta_apply_sub(InstMap0, Must, Sub, InstMap). -:- pred instmap_delta_apply_sub_2(assoc_list(prog_var, inst), bool, - map(prog_var, prog_var), instmapping, instmapping). -:- mode instmap_delta_apply_sub_2(in, in, in, in, out) is det. +:- pred instmap_delta_apply_sub_2(assoc_list(prog_var, inst)::in, bool::in, + map(prog_var, prog_var)::in, instmapping::in, instmapping::out) is det. instmap_delta_apply_sub_2([], _Must, _Sub, IM, IM). instmap_delta_apply_sub_2([V - I | AL], Must, Sub, IM0, IM) :- - ( - map__search(Sub, V, N0) - -> + ( map__search(Sub, V, N0) -> N = N0 ; - ( Must = no, + ( + Must = no, N = V - ; Must = yes, + ; + Must = yes, error("instmap_delta_apply_sub_2: no substitute") ) ), diff --git a/compiler/make.module_target.m b/compiler/make.module_target.m index e548f4d5e..9960901ab 100644 --- a/compiler/make.module_target.m +++ b/compiler/make.module_target.m @@ -18,7 +18,7 @@ % % Make a target corresponding to a single module. :- pred make_module_target(dependency_file::in, bool::out, - make_info::in, make_info::out, io__state::di, io__state::uo) is det. + make_info::in, make_info::out, io::di, io::uo) is det. % record_made_target(Target, Task, MakeSucceeded) % @@ -28,25 +28,25 @@ % Exported for use by make__module_dep_file__write_module_dep_file. :- pred record_made_target(target_file::in, compilation_task_type::in, bool::in, make_info::in, make_info::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. :- type foreign_code_file ---> foreign_code_file( - foreign_language :: foreign_language, + foreign_language :: foreign_language, % Name of the file produced by the Mercury % compiler, e.g. module_c_code.c. - target_file :: file_name, + target_file :: file_name, % Name of the file produced by the foreign % language compiler, e.g. module_c_code.o. - object_file :: file_name + object_file :: file_name ). % Find the foreign code files generated when a module is processed. % The `pic' field is only used for C foreign code. :- pred external_foreign_code_files(pic::in, module_imports::in, - list(foreign_code_file)::out, io__state::di, io__state::uo) is det. + list(foreign_code_file)::out, io::di, io::uo) is det. %-----------------------------------------------------------------------------% :- implementation. @@ -54,7 +54,7 @@ :- import_module hlds__passes_aux. :- pred make_module_target(dependency_file::in, bool::in, bool::out, - make_info::in, make_info::out, io__state::di, io__state::uo) is det. + make_info::in, make_info::out, io::di, io::uo) is det. make_module_target(TargetFile, Succeeded1, Succeeded1 `and` Succeeded2, Info0, Info) --> @@ -196,7 +196,7 @@ make_module_target(target(TargetFile) @ Dep, Succeeded, Info0, Info) --> :- pred make_dependency_files(target_file::in, list(dependency_file)::in, list(target_file)::in, list(file_name)::in, dependencies_result::out, - make_info::in, make_info::out, io__state::di, io__state::uo) is det. + make_info::in, make_info::out, io::di, io::uo) is det. make_dependency_files(TargetFile, DepFilesToMake, TouchedTargetFiles, TouchedFiles, DepsResult, Info0, Info) --> @@ -250,7 +250,7 @@ make_dependency_files(TargetFile, DepFilesToMake, TouchedTargetFiles, :- pred build_target(compilation_task_result::in, target_file::in, module_imports::in, list(target_file)::in, list(file_name)::in, bool::out, make_info::in, make_info::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. build_target(CompilationTask, TargetFile, Imports, TouchedTargetFiles, TouchedFiles, Succeeded, Info0, Info) --> @@ -296,7 +296,7 @@ build_target(CompilationTask, TargetFile, Imports, TouchedTargetFiles, :- pred build_target_2(module_name::in, compilation_task_type::in, maybe(file_name)::in, module_imports::in, list(string)::in, io__output_stream::in, bool::out, make_info::in, make_info::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. build_target_2(ModuleName, process_module(ModuleTask), ArgFileName, _Imports, AllOptionArgs, ErrorStream, @@ -385,7 +385,7 @@ build_target_2(ModuleName, fact_table_code_to_object_code(PIC, FactTableFile), :- pred build_object_code(module_name::in, compilation_target::in, pic::in, io__output_stream::in, module_imports::in, bool::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. build_object_code(ModuleName, c, PIC, ErrorStream, _Imports, Succeeded) --> compile_target_code__compile_c_file(ErrorStream, PIC, ModuleName, @@ -402,8 +402,8 @@ build_object_code(ModuleName, il, _, ErrorStream, Imports, Succeeded) --> Imports ^ has_main, Succeeded). :- pred compile_foreign_code_file(io__output_stream::in, pic::in, - module_imports::in, foreign_code_file::in, bool::out, - io__state::di, io__state::uo) is det. + module_imports::in, foreign_code_file::in, bool::out, + io::di, io::uo) is det. compile_foreign_code_file(ErrorStream, PIC, _Imports, foreign_code_file(c, CFile, ObjFile), Succeeded) --> @@ -478,7 +478,7 @@ get_object_extension(Globals, PIC) = Ext :- %-----------------------------------------------------------------------------% :- pred call_mercury_compile_main(list(string)::in, bool::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. call_mercury_compile_main(Args, Succeeded) --> io__get_exit_status(Status0), @@ -489,7 +489,7 @@ call_mercury_compile_main(Args, Succeeded) --> io__set_exit_status(Status0). :- pred invoke_mmc(io__output_stream::in, maybe(file_name)::in, - list(string)::in, bool::out, io__state::di, io__state::uo) is det. + list(string)::in, bool::out, io::di, io::uo) is det. invoke_mmc(ErrorStream, MaybeArgFileName, Args, Succeeded) --> io__progname("", ProgName), @@ -559,8 +559,8 @@ record_made_target(TargetFile, CompilationTask, Succeeded, Info0, Info) --> TouchedFiles, Info1, Info). :- pred record_made_target_2(bool::in, target_file::in, list(target_file)::in, - list(file_name)::in, make_info::in, make_info::out, - io__state::di, io__state::uo) is det. + list(file_name)::in, make_info::in, make_info::out, io::di, io::uo) + is det. record_made_target_2(Succeeded, TargetFile, TouchedTargetFiles, OtherTouchedFiles, Info0, Info) --> @@ -597,7 +597,7 @@ update_target_status(TargetStatus, TargetFile, Info, :- type compilation_task_result == pair(compilation_task_type, list(string)). :- func compilation_task(globals, module_target_type) = - compilation_task_result. + compilation_task_result. compilation_task(_, source) = _ :- error("compilation_task"). compilation_task(_, errors) = @@ -649,7 +649,7 @@ get_pic_flags(non_pic) = []. % Find the files which could be touched by a compilation task. :- pred touched_files(target_file::in, compilation_task_type::in, list(target_file)::out, list(file_name)::out, - make_info::in, make_info::out, io__state::di, io__state::uo) is det. + make_info::in, make_info::out, io::di, io::uo) is det. touched_files(TargetFile, process_module(Task), TouchedTargetFiles, TouchedFileNames, Info0, Info) --> @@ -859,36 +859,35 @@ external_foreign_code_files(PIC, Imports, ForeignFiles) --> :- pred external_foreign_code_files_for_il(module_name::in, foreign_language::in, list(foreign_code_file)::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. -external_foreign_code_files_for_il(ModuleName, Language, - ForeignFiles) --> +external_foreign_code_files_for_il(ModuleName, Language, ForeignFiles, !IO) :- ( - { ForeignModuleName = foreign_language_module_name(ModuleName, - Language) }, - { ForeignExt = foreign_language_file_extension(Language) } + ForeignModuleName = foreign_language_module_name(ModuleName, + Language), + ForeignExt = foreign_language_file_extension(Language) -> module_name_to_file_name(ForeignModuleName, ForeignExt, yes, - ForeignFileName), + ForeignFileName, !IO), module_name_to_file_name(ForeignModuleName, ".dll", yes, - ForeignDLLFileName), - { ForeignFiles = [foreign_code_file(Language, ForeignFileName, - ForeignDLLFileName)] } + ForeignDLLFileName, !IO), + ForeignFiles = [foreign_code_file(Language, ForeignFileName, + ForeignDLLFileName)] ; % No external file is generated for this foreign language. - { ForeignFiles = [] } + ForeignFiles = [] ). :- func target_type_to_pic(module_target_type) = pic. -target_type_to_pic(TargetType) = - ( TargetType = asm_code(PIC) -> - PIC - ; TargetType = object_code(PIC) -> - PIC - ; - non_pic - ). +target_type_to_pic(TargetType) = Result :- + ( TargetType = asm_code(PIC) -> + Result = PIC + ; TargetType = object_code(PIC) -> + Result = PIC + ; + Result = non_pic + ). %-----------------------------------------------------------------------------% diff --git a/compiler/mercury_compile.m b/compiler/mercury_compile.m index 337cf3a7b..94f65e5b0 100644 --- a/compiler/mercury_compile.m +++ b/compiler/mercury_compile.m @@ -302,7 +302,7 @@ main(Args, !IO) :- %-----------------------------------------------------------------------------% -:- pred gc_init(io__state::di, io__state::uo) is det. +:- pred gc_init(io::di, io::uo) is det. % This version is only used if there is no matching foreign_proc version. gc_init(!IO). @@ -1241,12 +1241,12 @@ halt_at_module_error(HaltSyntax, some_module_errors) :- HaltSyntax = yes. module_to_link(ModuleName - _Items, ModuleToLink) :- module_name_to_file_name(ModuleName, ModuleToLink). -:- type compile == pred(bool, io__state, io__state). +:- type compile == pred(bool, io, io). :- inst compile == (pred(out, di, uo) is det). :- pred compile_with_module_options(module_name::in, options_variables::in, - list(string)::in, compile::in(compile), - bool::out, io__state::di, io__state::uo) is det. + list(string)::in, compile::in(compile), bool::out, io::di, io::uo) + is det. compile_with_module_options(ModuleName, OptionVariables, OptionArgs, Compile, Succeeded, !IO) :- @@ -2087,8 +2087,8 @@ mercury_compile__frontend_pass_no_type_error(QualInfo0, ) ). -:- pred mercury_compile__maybe_write_optfile(bool::in, module_info::in, - module_info::out, io__state::di, io__state::uo) is det. +:- pred mercury_compile__maybe_write_optfile(bool::in, + module_info::in, module_info::out, io::di, io::uo) is det. mercury_compile__maybe_write_optfile(MakeOptInt, !HLDS, !IO) :- globals__io_get_globals(Globals, !IO), @@ -2393,8 +2393,8 @@ mercury_compile__middle_pass(ModuleName, !HLDS, !IO) :- %-----------------------------------------------------------------------------% :- pred mercury_compile__maybe_generate_rl_bytecode(bool::in, - maybe(rl_file)::out, module_info::in, module_info::out, - io__state::di, io__state::uo) is det. + maybe(rl_file)::out, module_info::in, module_info::out, + io::di, io::uo) is det. mercury_compile__maybe_generate_rl_bytecode(Verbose, MaybeRLFile, !ModuleInfo, !IO) :- @@ -2450,9 +2450,8 @@ mercury_compile__maybe_generate_rl_bytecode(Verbose, MaybeRLFile, MaybeRLFile = no ). -:- pred mercury_compile__generate_aditi_proc_info(module_info, - list(rtti_data)). -:- mode mercury_compile__generate_aditi_proc_info(in, out) is det. +:- pred mercury_compile__generate_aditi_proc_info(module_info::in, + list(rtti_data)::out) is det. mercury_compile__generate_aditi_proc_info(HLDS, AditiProcInfoRttiData) :- module_info_aditi_top_down_procs(HLDS, Procs), @@ -2464,8 +2463,7 @@ mercury_compile__generate_aditi_proc_info(HLDS, AditiProcInfoRttiData) :- %-----------------------------------------------------------------------------% :- pred mercury_compile__backend_pass(module_info::in, module_info::out, - global_data::out, list(c_procedure)::out, - io::di, io::uo) is det. + global_data::out, list(c_procedure)::out, io::di, io::uo) is det. mercury_compile__backend_pass(!HLDS, GlobalData, LLDS, !IO) :- module_info_name(!.HLDS, ModuleName), diff --git a/compiler/mode_debug.m b/compiler/mode_debug.m index f859573a7..eea898d75 100644 --- a/compiler/mode_debug.m +++ b/compiler/mode_debug.m @@ -64,7 +64,7 @@ mode_checkpoint(Port, Msg, !ModeInfo, !IO) :- ). :- pred mode_checkpoint_2(port::in, string::in, mode_info::in, mode_info::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. mode_checkpoint_2(Port, Msg, !ModeInfo, !IO) :- mode_info_get_last_checkpoint_insts(!.ModeInfo, OldInsts), @@ -108,7 +108,7 @@ mode_checkpoint_2(Port, Msg, !ModeInfo, !IO) :- :- pred write_var_insts(assoc_list(prog_var, inst)::in, assoc_list(prog_var, inst)::in, prog_varset::in, inst_varset::in, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. write_var_insts([], _, _, _, !IO). write_var_insts([Var - Inst | VarInsts], OldInsts, VarSet, InstVarSet, !IO) :- diff --git a/compiler/mode_errors.m b/compiler/mode_errors.m index b54f34209..e436eac40 100644 --- a/compiler/mode_errors.m +++ b/compiler/mode_errors.m @@ -168,17 +168,15 @@ % determinism analysis). :- pred write_mode_inference_messages(list(pred_id)::in, bool::in, - module_info::in, io__state::di, io__state::uo) is det. + module_info::in, io::di, io::uo) is det. % report an error for the case when two mode declarations % declare indistinguishable modes :- pred report_indistinguishable_modes_error(proc_id::in, proc_id::in, - pred_id::in, pred_info::in, module_info::in, - io__state::di, io__state::uo) is det. + pred_id::in, pred_info::in, module_info::in, io::di, io::uo) is det. -:- pred output_mode_decl(proc_id::in, pred_info::in, - io__state::di, io__state::uo) is det. +:- pred output_mode_decl(proc_id::in, pred_info::in, io::di, io::uo) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% @@ -251,9 +249,8 @@ report_mode_error(mode_error_final_inst(ArgNum, Var, VarInst, Inst, Reason), %-----------------------------------------------------------------------------% -:- pred report_mode_error_conj(mode_info, list(delayed_goal), schedule_culprit, - io__state, io__state). -:- mode report_mode_error_conj(in, in, in, di, uo) is det. +:- pred report_mode_error_conj(mode_info::in, list(delayed_goal)::in, + schedule_culprit::in, io::di, io::uo) is det. report_mode_error_conj(ModeInfo, Errors, Culprit) --> { mode_info_get_context(ModeInfo, Context) }, @@ -313,9 +310,8 @@ report_mode_error_conj(ModeInfo, Errors, Culprit) --> " This is the location of the impure goal.\n") ). -:- pred find_important_errors(list(delayed_goal), list(delayed_goal), - list(delayed_goal)). -:- mode find_important_errors(in, out, out) is det. +:- pred find_important_errors(list(delayed_goal)::in, + list(delayed_goal)::out, list(delayed_goal)::out) is det. find_important_errors([], [], []). find_important_errors([Error | Errors], ImportantErrors, OtherErrors) :- @@ -339,9 +335,8 @@ find_important_errors([Error | Errors], ImportantErrors, OtherErrors) :- ), find_important_errors(Errors, ImportantErrors1, OtherErrors1). -:- pred report_mode_error_conj_2(list(delayed_goal), prog_varset, prog_context, - mode_info, io__state, io__state). -:- mode report_mode_error_conj_2(in, in, in, in, di, uo) is det. +:- pred report_mode_error_conj_2(list(delayed_goal)::in, prog_varset::in, + prog_context::in, mode_info::in, io::di, io::uo) is det. report_mode_error_conj_2([], _, _, _) --> []. report_mode_error_conj_2([delayed_goal(Vars, Error, Goal) | Rest], @@ -372,9 +367,8 @@ report_mode_error_conj_2([delayed_goal(Vars, Error, Goal) | Rest], %-----------------------------------------------------------------------------% -:- pred report_mode_error_disj(mode_info, merge_context, merge_errors, - io__state, io__state). -:- mode report_mode_error_disj(in, in, in, di, uo) is det. +:- pred report_mode_error_disj(mode_info::in, merge_context::in, + merge_errors::in, io::di, io::uo) is det. report_mode_error_disj(ModeInfo, MergeContext, ErrorList) --> { mode_info_get_context(ModeInfo, Context) }, @@ -385,9 +379,8 @@ report_mode_error_disj(ModeInfo, MergeContext, ErrorList) --> io__write_string(".\n"), write_merge_error_list(ErrorList, ModeInfo). -:- pred report_mode_error_par_conj(mode_info, merge_errors, - io__state, io__state). -:- mode report_mode_error_par_conj(in, in, di, uo) is det. +:- pred report_mode_error_par_conj(mode_info::in, merge_errors::in, + io::di, io::uo) is det. report_mode_error_par_conj(ModeInfo, ErrorList) --> { mode_info_get_context(ModeInfo, Context) }, @@ -402,8 +395,8 @@ report_mode_error_par_conj(ModeInfo, ErrorList) --> io__write_string(" parallel conjunctions to fail.)\n"), write_merge_error_list(ErrorList, ModeInfo). -:- pred write_merge_error_list(merge_errors, mode_info, io__state, io__state). -:- mode write_merge_error_list(in, in, di, uo) is det. +:- pred write_merge_error_list(merge_errors::in, mode_info::in, + io::di, io::uo) is det. write_merge_error_list([], _) --> []. write_merge_error_list([Var - Insts | Errors], ModeInfo) --> @@ -417,8 +410,7 @@ write_merge_error_list([Var - Insts | Errors], ModeInfo) --> io__write_string(".\n"), write_merge_error_list(Errors, ModeInfo). -:- pred write_merge_context(merge_context, io__state, io__state). -:- mode write_merge_context(in, di, uo) is det. +:- pred write_merge_context(merge_context::in, io::di, io::uo) is det. write_merge_context(disj) --> io__write_string("disjunction"). @@ -427,9 +419,8 @@ write_merge_context(if_then_else) --> %-----------------------------------------------------------------------------% -:- pred report_mode_error_bind_var(mode_info, var_lock_reason, prog_var, - inst, inst, io__state, io__state). -:- mode report_mode_error_bind_var(in, in, in, in, in, di, uo) is det. +:- pred report_mode_error_bind_var(mode_info::in, var_lock_reason::in, + prog_var::in, (inst)::in, (inst)::in, io::di, io::uo) is det. report_mode_error_bind_var(ModeInfo, Reason, Var, VarInst, Inst) --> { mode_info_get_context(ModeInfo, Context) }, @@ -486,10 +477,8 @@ report_mode_error_bind_var(ModeInfo, Reason, Var, VarInst, Inst) --> %-----------------------------------------------------------------------------% -:- pred report_mode_error_non_local_lambda_var(mode_info, prog_var, inst, - io__state, io__state). -:- mode report_mode_error_non_local_lambda_var(in, in, in, - di, uo) is det. +:- pred report_mode_error_non_local_lambda_var(mode_info::in, prog_var::in, + (inst)::in, io::di, io::uo) is det. report_mode_error_non_local_lambda_var(ModeInfo, Var, VarInst) --> { mode_info_get_context(ModeInfo, Context) }, @@ -508,11 +497,9 @@ report_mode_error_non_local_lambda_var(ModeInfo, Var, VarInst) --> %-----------------------------------------------------------------------------% -:- pred report_mode_error_in_callee(mode_info, list(prog_var), - list(inst), pred_id, proc_id, list(mode_error_info), - io__state, io__state). -:- mode report_mode_error_in_callee(in, in, in, in, in, in, - di, uo) is det. +:- pred report_mode_error_in_callee(mode_info::in, list(prog_var)::in, + list(inst)::in, pred_id::in, proc_id::in, list(mode_error_info)::in, + io::di, io::uo) is det. report_mode_error_in_callee(ModeInfo0, Vars, Insts, CalleePredId, CalleeProcId, CalleeModeErrors) --> @@ -555,9 +542,8 @@ report_mode_error_in_callee(ModeInfo0, Vars, Insts, { error("report_mode_error_in_callee: no error") } ). -:- pred report_mode_error_no_matching_mode(mode_info, list(prog_var), - list(inst), io__state, io__state). -:- mode report_mode_error_no_matching_mode(in, in, in, di, uo) is det. +:- pred report_mode_error_no_matching_mode(mode_info::in, list(prog_var)::in, + list(inst)::in, io::di, io::uo) is det. report_mode_error_no_matching_mode(ModeInfo, Vars, Insts) --> { mode_info_get_context(ModeInfo, Context) }, @@ -581,10 +567,8 @@ report_mode_error_no_matching_mode(ModeInfo, Vars, Insts) --> ), io__write_string(".\n"). -:- pred report_mode_error_higher_order_pred_var(mode_info, pred_or_func, - prog_var, inst, arity, io__state, io__state). -:- mode report_mode_error_higher_order_pred_var(in, in, in, in, in, - di, uo) is det. +:- pred report_mode_error_higher_order_pred_var(mode_info::in, pred_or_func::in, + prog_var::in, (inst)::in, arity::in, io::di, io::uo) is det. report_mode_error_higher_order_pred_var(ModeInfo, PredOrFunc, Var, VarInst, Arity) --> @@ -610,9 +594,8 @@ report_mode_error_higher_order_pred_var(ModeInfo, PredOrFunc, Var, VarInst, ), io__write_string(").\n"). -:- pred report_mode_error_poly_unify(mode_info, prog_var, inst, - io__state, io__state). -:- mode report_mode_error_poly_unify(in, in, in, di, uo) is det. +:- pred report_mode_error_poly_unify(mode_info::in, prog_var::in, (inst)::in, + io::di, io::uo) is det. report_mode_error_poly_unify(ModeInfo, Var, VarInst) --> { mode_info_get_context(ModeInfo, Context) }, @@ -640,9 +623,8 @@ report_mode_error_poly_unify(ModeInfo, Var, VarInst) --> [] ). -:- pred report_mode_error_var_is_live(mode_info, prog_var, - io__state, io__state). -:- mode report_mode_error_var_is_live(in, in, di, uo) is det. +:- pred report_mode_error_var_is_live(mode_info::in, prog_var::in, + io::di, io::uo) is det. report_mode_error_var_is_live(ModeInfo, Var) --> { mode_info_get_context(ModeInfo, Context) }, @@ -655,9 +637,8 @@ report_mode_error_var_is_live(ModeInfo, Var) --> mercury_output_var(Var, VarSet, no), io__write_string("' is still live.\n"). -:- pred report_mode_error_var_has_inst(mode_info, prog_var, inst, inst, - io__state, io__state). -:- mode report_mode_error_var_has_inst(in, in, in, in, di, uo) is det. +:- pred report_mode_error_var_has_inst(mode_info::in, prog_var::in, + (inst)::in, (inst)::in, io::di, io::uo) is det. report_mode_error_var_has_inst(ModeInfo, Var, VarInst, Inst) --> { mode_info_get_context(ModeInfo, Context) }, @@ -674,9 +655,8 @@ report_mode_error_var_has_inst(ModeInfo, Var, VarInst, Inst) --> output_inst(Inst, ModeInfo), io__write_string("'.\n"). -:- pred report_mode_error_implied_mode(mode_info, prog_var, inst, inst, - io__state, io__state). -:- mode report_mode_error_implied_mode(in, in, in, in, di, uo) is det. +:- pred report_mode_error_implied_mode(mode_info::in, prog_var::in, + (inst)::in, (inst)::in, io::di, io::uo) is det. report_mode_error_implied_mode(ModeInfo, Var, VarInst, Inst) --> % This "error" message is really a "sorry, not implemented" @@ -703,8 +683,7 @@ report_mode_error_implied_mode(ModeInfo, Var, VarInst, Inst) --> [] ). -:- pred report_mode_error_no_mode_decl(mode_info, io__state, io__state). -:- mode report_mode_error_no_mode_decl(in, di, uo) is det. +:- pred report_mode_error_no_mode_decl(mode_info::in, io::di, io::uo) is det. report_mode_error_no_mode_decl(ModeInfo) --> { mode_info_get_context(ModeInfo, Context) }, @@ -712,11 +691,9 @@ report_mode_error_no_mode_decl(ModeInfo) --> prog_out__write_context(Context), io__write_string(" no mode declaration for called predicate.\n"). -:- pred report_mode_error_unify_pred(mode_info, prog_var, mode_error_unify_rhs, - type, pred_or_func, - io__state, io__state). -:- mode report_mode_error_unify_pred(in, in, in, in, in, - di, uo) is det. +:- pred report_mode_error_unify_pred(mode_info::in, prog_var::in, + mode_error_unify_rhs::in, (type)::in, pred_or_func::in, + io::di, io::uo) is det. report_mode_error_unify_pred(ModeInfo, X, RHS, Type, PredOrFunc) --> { mode_info_get_context(ModeInfo, Context) }, @@ -771,10 +748,8 @@ report_mode_error_unify_pred(ModeInfo, X, RHS, Type, PredOrFunc) --> %-----------------------------------------------------------------------------% -:- pred report_mode_error_unify_var_var(mode_info, prog_var, prog_var, - inst, inst, io__state, io__state). -:- mode report_mode_error_unify_var_var(in, in, in, in, in, di, uo) - is det. +:- pred report_mode_error_unify_var_var(mode_info::in, prog_var::in, + prog_var::in, (inst)::in, (inst)::in, io::di, io::uo) is det. report_mode_error_unify_var_var(ModeInfo, X, Y, InstX, InstY) --> { mode_info_get_context(ModeInfo, Context) }, @@ -801,10 +776,8 @@ report_mode_error_unify_var_var(ModeInfo, X, Y, InstX, InstY) --> %-----------------------------------------------------------------------------% -:- pred report_mode_error_unify_var_lambda(mode_info, prog_var, inst, inst, - io__state, io__state). -:- mode report_mode_error_unify_var_lambda(in, in, in, in, di, uo) - is det. +:- pred report_mode_error_unify_var_lambda(mode_info::in, prog_var::in, + (inst)::in, (inst)::in, io::di, io::uo) is det. report_mode_error_unify_var_lambda(ModeInfo, X, InstX, InstY) --> { mode_info_get_context(ModeInfo, Context) }, @@ -827,10 +800,9 @@ report_mode_error_unify_var_lambda(ModeInfo, X, InstX, InstY) --> %-----------------------------------------------------------------------------% -:- pred report_mode_error_unify_var_functor(mode_info, prog_var, cons_id, - list(prog_var), inst, list(inst), io__state, io__state). -:- mode report_mode_error_unify_var_functor(in, in, in, in, in, in, - di, uo) is det. +:- pred report_mode_error_unify_var_functor(mode_info::in, prog_var::in, + cons_id::in, list(prog_var)::in, (inst)::in, list(inst)::in, + io::di, io::uo) is det. report_mode_error_unify_var_functor(ModeInfo, X, ConsId, Args, InstX, ArgInsts) --> @@ -869,8 +841,7 @@ report_mode_error_unify_var_functor(ModeInfo, X, ConsId, Args, InstX, ArgInsts) %-----------------------------------------------------------------------------% -:- pred mode_info_write_context(mode_info, io__state, io__state). -:- mode mode_info_write_context(in, di, uo) is det. +:- pred mode_info_write_context(mode_info::in, io::di, io::uo) is det. mode_info_write_context(ModeInfo) --> { mode_info_get_module_info(ModeInfo, ModuleInfo) }, @@ -898,10 +869,8 @@ mode_info_write_context(ModeInfo) --> %-----------------------------------------------------------------------------% -:- pred report_mode_error_final_inst(mode_info, int, prog_var, inst, inst, - final_inst_error, io__state, io__state). -:- mode report_mode_error_final_inst(in, in, in, in, in, in, - di, uo) is det. +:- pred report_mode_error_final_inst(mode_info::in, int::in, prog_var::in, + (inst)::in, (inst)::in, final_inst_error::in, io::di, io::uo) is det. report_mode_error_final_inst(ModeInfo, ArgNum, Var, VarInst, Inst, Reason) --> { mode_info_get_context(ModeInfo, Context) }, @@ -940,19 +909,15 @@ mode_context_init(uninitialized). % XXX some parts of the mode context never get set up -:- pred write_mode_context(mode_context, prog_context, pred_markers, - module_info, io__state, io__state). -:- mode write_mode_context(in, in, in, in, di, uo) is det. - +:- pred write_mode_context(mode_context::in, prog_context::in, pred_markers::in, + module_info::in, io::di, io::uo) is det. write_mode_context(uninitialized, _Context, _Markers, _ModuleInfo) --> []. - write_mode_context(call(CallId, ArgNum), Context, Markers, _ModuleInfo) --> prog_out__write_context(Context), io__write_string(" in "), hlds_out__write_call_arg_id(CallId, ArgNum, Markers), io__write_string(":\n"). - write_mode_context(unify(UnifyContext, _Side), Context, _Markers, _ModuleInfo) --> hlds_out__write_unify_context(UnifyContext, Context). @@ -1014,9 +979,8 @@ write_mode_inference_messages([PredId | PredIds], OutputDetism, ModuleInfo) --> % write out the inferred `mode' declarations for a list of % proc_ids -:- pred write_mode_inference_messages_2(list(proc_id), proc_table, pred_info, - bool, module_info, io__state, io__state). -:- mode write_mode_inference_messages_2(in, in, in, in, in, di, uo) is det. +:- pred write_mode_inference_messages_2(list(proc_id)::in, proc_table::in, + pred_info::in, bool::in, module_info::in, io::di, io::uo) is det. write_mode_inference_messages_2([], _, _, _, _) --> []. write_mode_inference_messages_2([ProcId | ProcIds], Procs, PredInfo, @@ -1044,9 +1008,8 @@ write_mode_inference_messages_2([ProcId | ProcIds], Procs, PredInfo, % write out the inferred `mode' declaration % for a single function or predicate. -:- pred write_mode_inference_message(pred_info, proc_info, bool, - module_info, io__state, io__state). -:- mode write_mode_inference_message(in, in, in, in, di, uo) is det. +:- pred write_mode_inference_message(pred_info::in, proc_info::in, bool::in, + module_info::in, io::di, io::uo) is det. write_mode_inference_message(PredInfo, ProcInfo, OutputDetism, ModuleInfo) --> { PredName = pred_info_name(PredInfo) }, @@ -1125,8 +1088,7 @@ report_mode_errors(!ModeInfo, !IO) :- %-----------------------------------------------------------------------------% -:- pred output_inst((inst), mode_info, io__state, io__state). -:- mode output_inst(in, in, di, uo) is det. +:- pred output_inst((inst)::in, mode_info::in, io::di, io::uo) is det. output_inst(Inst0, ModeInfo) --> { strip_builtin_qualifiers_from_inst(Inst0, Inst) }, @@ -1134,8 +1096,7 @@ output_inst(Inst0, ModeInfo) --> { mode_info_get_module_info(ModeInfo, ModuleInfo) }, mercury_output_expanded_inst(Inst, InstVarSet, ModuleInfo). -:- pred output_inst_list(list(inst), mode_info, io__state, io__state). -:- mode output_inst_list(in, in, di, uo) is det. +:- pred output_inst_list(list(inst)::in, mode_info::in, io::di, io::uo) is det. output_inst_list([], _) --> []. output_inst_list([Inst | Insts], ModeInfo) --> diff --git a/compiler/mode_ordering.m b/compiler/mode_ordering.m index 1393816f3..03c500057 100644 --- a/compiler/mode_ordering.m +++ b/compiler/mode_ordering.m @@ -31,8 +31,7 @@ % of each predicate, and determine which modes are needed for each predicate. :- pred mode_ordering(pred_constraint_map::in, list(list(pred_id))::in, - module_info::in, module_info::out, io__state::di, io__state::uo) - is det. + module_info::in, module_info::out, io::di, io::uo) is det. :- pred mode_ordering__proc(inst_graph::in, mode_constraint::in, mode_constraint_info::in, module_info::in, pred_constraint_map::in, @@ -468,8 +467,8 @@ pred_info_create_proc_info_for_mode_decl_constraint(PredInfo0, ). :- pred find_matching_proc(pred_id::in, list(prog_var)::in, set(prog_var)::in, - proc_id::out, set(prog_var)::out, mode_ordering__info::in, - mode_ordering__info::out) is det. + proc_id::out, set(prog_var)::out, + mode_ordering__info::in, mode_ordering__info::out) is det. find_matching_proc(PredId, Args, ProdVars, ProcId, ConsumingVars) --> ModuleInfo =^ module_info, @@ -538,16 +537,15 @@ find_matching_proc_2([ProcId0 - ProcInfo | ProcList], ProdVars, Args, CalleeInstGraph, MCInfo, ProcId, ConsumingVars) ). -:- pred report_mode_errors(module_info::in, io__state::di, io__state::uo) - is det. +:- pred report_mode_errors(module_info::in, io::di, io::uo) is det. -report_mode_errors(_) --> []. +report_mode_errors(_, !IO). % XXX - %io__stderr_stream(StdErr), - %io__write_string(StdErr, "Mode error reporting NYI"). + %io__stderr_stream(StdErr, !IO), + %io__write_string(StdErr, "Mode error reporting NYI", !IO). :- pred lookup_pred_constraint(pred_constraint_map::in, pred_id::in, - mode_constraint::out, mode_constraint_info::out) is det. + mode_constraint::out, mode_constraint_info::out) is det. lookup_pred_constraint(PCM, PredId, MC, MCInfo) :- map__lookup(PCM, PredId, pci(MC, MCInfo)). diff --git a/compiler/mode_robdd.check.m b/compiler/mode_robdd.check.m index c0f23543d..58ea0fc8e 100644 --- a/compiler/mode_robdd.check.m +++ b/compiler/mode_robdd.check.m @@ -191,8 +191,7 @@ check_robdd(X1, X2) = mode_robdd(X1, X2) :- % impure unsafe_perform_io(report_robdd_error(R1, R2)) ). -% :- pred report_robdd_error(robdd(T)::in, robdd(T)::in, io__state::di, -% io__state::uo) is det. +% :- pred report_robdd_error(robdd(T)::in, robdd(T)::in, io::di, io::uo) is det. % % report_robdd_error(R1, R2) --> % % { R12 = R1 * (~ R2) }, diff --git a/compiler/mode_util.m b/compiler/mode_util.m index f8572bbbc..888777b8d 100644 --- a/compiler/mode_util.m +++ b/compiler/mode_util.m @@ -500,19 +500,19 @@ propagate_type_into_mode(Type, ModuleInfo, Mode0, Mode) :- :- pred propagate_type_into_inst_lazily((type)::in, tsubst::in, module_info::in, (inst)::in, (inst)::out) is det. -% % XXX We ought to expand things eagerly here, using the commented -% % out code below. However, that causes efficiency problems, -% % so for the moment it is disabled. +% % XXX We ought to expand things eagerly here, using the commented +% % out code below. However, that causes efficiency problems, +% % so for the moment it is disabled. % propagate_type_into_inst(Type, Subst, ModuleInfo, Inst0, Inst) :- -% apply_type_subst(Type0, Subst, Type), -% ( -% type_constructors(Type, ModuleInfo, Constructors) -% -> -% propagate_ctor_info(Inst0, Type, Constructors, ModuleInfo, -% Inst) -% ; -% Inst = Inst0 -% ). +% apply_type_subst(Type0, Subst, Type), +% ( +% type_constructors(Type, ModuleInfo, Constructors) +% -> +% propagate_ctor_info(Inst0, Type, Constructors, ModuleInfo, +% Inst) +% ; +% Inst = Inst0 +% ). propagate_type_into_inst(Type, Subst, ModuleInfo, Inst0, Inst) :- propagate_ctor_info_lazily(Inst0, Type, Subst, ModuleInfo, Inst). @@ -718,27 +718,8 @@ propagate_ctor_info_2(BoundInsts0, Type, ModuleInfo, BoundInsts) :- ( type_is_tuple(Type, TupleArgTypes) -> - list__map( - (pred(BoundInst0::in, BoundInst::out) is det :- - BoundInst0 = functor(Functor, ArgInsts0), - ( - Functor = cons(unqualified("{}"), _), - list__length(ArgInsts0, - list__length(TupleArgTypes)) - -> - map__init(Subst), - propagate_types_into_inst_list(TupleArgTypes, - Subst, ModuleInfo, ArgInsts0, ArgInsts) - ; - % The bound_inst's arity does not match the - % tuple's arity, so leave it alone. This can - % only happen in a user defined bound_inst. - % A mode error should be reported if anything - % tries to match with the inst. - ArgInsts = ArgInsts0 - ), - BoundInst = functor(Functor, ArgInsts) - ), BoundInsts0, BoundInsts) + list__map(propagate_ctor_info_tuple(ModuleInfo, TupleArgTypes), + BoundInsts0, BoundInsts) ; type_to_ctor_and_args(Type, TypeCtor, TypeArgs), TypeCtor = qualified(TypeModule, _) - _, @@ -758,6 +739,30 @@ propagate_ctor_info_2(BoundInsts0, Type, ModuleInfo, BoundInsts) :- BoundInsts = BoundInsts0 ). +:- pred propagate_ctor_info_tuple(module_info::in, list(type)::in, + bound_inst::in, bound_inst::out) is det. + +propagate_ctor_info_tuple(ModuleInfo, TupleArgTypes, BoundInst0, BoundInst) :- + BoundInst0 = functor(Functor, ArgInsts0), + ( + Functor = cons(unqualified("{}"), _), + list__length(ArgInsts0, ArgInstsLen), + list__length(TupleArgTypes, TupleArgTypesLen), + ArgInstsLen = TupleArgTypesLen + -> + map__init(Subst), + propagate_types_into_inst_list(TupleArgTypes, + Subst, ModuleInfo, ArgInsts0, ArgInsts) + ; + % The bound_inst's arity does not match the + % tuple's arity, so leave it alone. This can + % only happen in a user defined bound_inst. + % A mode error should be reported if anything + % tries to match with the inst. + ArgInsts = ArgInsts0 + ), + BoundInst = functor(Functor, ArgInsts). + :- pred propagate_ctor_info_3(list(bound_inst)::in, module_name::in, list(constructor)::in, tsubst::in, module_info::in, list(bound_inst)::out) is det. @@ -876,7 +881,7 @@ recompute_instmap_delta(RecomputeAtomic, Goal0, Goal, VarTypes, InstVarSet, recompute_info::in, recompute_info::out) is det. recompute_instmap_delta_1(RecomputeAtomic, Goal0 - GoalInfo0, Goal - GoalInfo, - VarTypes, InstMap0, InstMapDelta, RI0, RI) :- + VarTypes, InstMap0, InstMapDelta, !RI) :- ( RecomputeAtomic = no, goal_is_atomic(Goal0), @@ -884,14 +889,13 @@ recompute_instmap_delta_1(RecomputeAtomic, Goal0 - GoalInfo0, Goal - GoalInfo, % Lambda expressions always need to be processed. -> Goal = Goal0, - GoalInfo1 = GoalInfo0, - RI0 = RI + GoalInfo1 = GoalInfo0 ; recompute_instmap_delta_2(RecomputeAtomic, Goal0, GoalInfo0, - Goal, VarTypes, InstMap0, InstMapDelta0, RI0, RI), + Goal, VarTypes, InstMap0, InstMapDelta0, !RI), goal_info_get_nonlocals(GoalInfo0, NonLocals), - instmap_delta_restrict(InstMapDelta0, - NonLocals, InstMapDelta1), + instmap_delta_restrict(InstMapDelta0, NonLocals, + InstMapDelta1), goal_info_set_instmap_delta(GoalInfo0, InstMapDelta1, GoalInfo1) ), @@ -1226,8 +1230,7 @@ recompute_instmap_delta_call_2([Arg | Args], InstMap, [Mode0 | Modes0], mode_get_insts(!.ModuleInfo, Mode0, _, FinalInst), ( abstractly_unify_inst(dead, ArgInst0, FinalInst, - fake_unify, !.ModuleInfo, UnifyInst, _, - !:ModuleInfo) + fake_unify, UnifyInst, _, !ModuleInfo) -> Mode = (ArgInst0 -> UnifyInst) ; @@ -1373,7 +1376,7 @@ fixup_switch_var(Var, InstMap0, InstMap, Goal0, Goal) :- %-----------------------------------------------------------------------------% partition_args(_, [], [_|_], _, _) :- - error("partition_args"). + error("partition_args"). partition_args(_, [_|_], [], _, _) :- error("partition_args"). partition_args(_, [], [], [], []). diff --git a/compiler/modecheck_unify.m b/compiler/modecheck_unify.m index 6b332e0f0..3126d5b4e 100644 --- a/compiler/modecheck_unify.m +++ b/compiler/modecheck_unify.m @@ -110,7 +110,7 @@ modecheck_unification(X, var(Y), Unification0, UnifyContext, BothLive = dead ), abstractly_unify_inst(BothLive, InstOfX, InstOfY, - real_unify, ModuleInfo0, UnifyInst, Det1, ModuleInfo1), + real_unify, UnifyInst, Det1, ModuleInfo0, ModuleInfo1), % Don't allow free-free unifications if both variables are % locked. (Normally the checks for binding locked variables % are done in modecheck_set_var_inst, which is called below, @@ -274,7 +274,7 @@ modecheck_unification(X, lambda_goal(Purity, PredOrFunc, EvalMethod, _, mode_info_get_types_of_vars(!.ModeInfo, Vars, VarTypes), propagate_types_into_mode_list(VarTypes, ModuleInfo0, Modes0, Modes) - ; + ; Modes = Modes0 ), @@ -331,8 +331,8 @@ modecheck_unification(X, lambda_goal(Purity, PredOrFunc, EvalMethod, _, inst_list_is_ground_or_any(NonLocalInsts, ModuleInfo2) -> - make_shared_inst_list(NonLocalInsts, ModuleInfo2, - SharedNonLocalInsts, ModuleInfo3), + make_shared_inst_list(NonLocalInsts, SharedNonLocalInsts, + ModuleInfo2, ModuleInfo3), instmap__set_vars(InstMap1, NonLocalsList, SharedNonLocalInsts, InstMap2), mode_info_set_module_info(ModuleInfo3, !ModeInfo), @@ -412,7 +412,7 @@ modecheck_unify_lambda(X, PredOrFunc, ArgVars, LambdaModes, LambdaDet, LambdaPredInfo = pred_inst_info(PredOrFunc, LambdaModes, LambdaDet), ( abstractly_unify_inst(dead, InstOfX, InstOfY, real_unify, - ModuleInfo0, UnifyInst, _Det, ModuleInfo1) + UnifyInst, _Det, ModuleInfo0, ModuleInfo1) -> Inst = UnifyInst, mode_info_set_module_info(ModuleInfo1, !ModeInfo), @@ -531,8 +531,8 @@ modecheck_unify_functor(X0, TypeOfX, ConsId0, IsExistConstruction, ArgVars0, ExtraGoals1 = no_extra_goals ; abstractly_unify_inst_functor(LiveX, InstOfX, InstConsId, - InstArgs, LiveArgs, real_unify, TypeOfX, ModuleInfo0, - UnifyInst, Det1, ModuleInfo1) + InstArgs, LiveArgs, real_unify, TypeOfX, + UnifyInst, Det1, ModuleInfo0, ModuleInfo1) -> Inst = UnifyInst, Det = Det1, @@ -612,8 +612,8 @@ modecheck_unify_functor(X0, TypeOfX, ConsId0, IsExistConstruction, ArgVars0, Unification = construct(_, _, _, _, _, _, _), LiveX = dead -> - Goal = conj([]), - !:ModeInfo = !.ModeInfo % XXX deleting this exposes + Goal = conj([]) + % !:ModeInfo = !.ModeInfo % XXX deleting this exposes % a bug in the state variable % transformation ; @@ -625,8 +625,8 @@ modecheck_unify_functor(X0, TypeOfX, ConsId0, IsExistConstruction, ArgVars0, %, % Unifying two preds is not erroneous as far as the % mode checker is concerned, but a mode _error_. - Goal = disj([]), - !:ModeInfo = !.ModeInfo % XXX deleting this exposes + Goal = disj([]) + % !:ModeInfo = !.ModeInfo % XXX deleting this exposes % a bug in the state variable % transformation ; diff --git a/compiler/modes.m b/compiler/modes.m index 2e7d546ad..a8bf65aba 100644 --- a/compiler/modes.m +++ b/compiler/modes.m @@ -43,63 +43,63 @@ % iterating mode inference passes until we reach a fixpoint. % % To mode-analyse a procedure: -% 1. Initialize the insts of the head variables. -% 2. Mode-analyse the goal. -% 3. a. If we're doing mode-checking: -% Check that the final insts of the head variables -% matches that specified in the mode declaration -% b. If we're doing mode-inference: -% Normalise the final insts of the head variables, -% record the newly inferred normalised final insts -% in the proc_info, and check whether they changed -% (so that we know when we've reached the fixpoint). +% 1. Initialize the insts of the head variables. +% 2. Mode-analyse the goal. +% 3. a. If we're doing mode-checking: +% Check that the final insts of the head variables +% matches that specified in the mode declaration +% b. If we're doing mode-inference: +% Normalise the final insts of the head variables, +% record the newly inferred normalised final insts +% in the proc_info, and check whether they changed +% (so that we know when we've reached the fixpoint). % % To mode-analyse a goal: % If goal is -% (a) a disjunction -% Mode-analyse the sub-goals; -% check that the final insts of all the non-local -% variables are the same for all the sub-goals. -% (b) a conjunction -% Attempt to schedule each sub-goal. If a sub-goal can -% be scheduled, then schedule it, otherwise delay it. -% Continue with the remaining sub-goals until there are -% no goals left. Every time a variable gets bound, -% see whether we should wake up a delayed goal, -% and if so, wake it up next time we get back to -% the conjunction. If there are still delayed goals -% hanging around at the end of the conjunction, -% report a mode error. -% (c) a negation -% Mode-check the sub-goal. -% Check that the sub-goal does not further instantiate -% any non-local variables. (Actually, rather than -% doing this check after we mode-analyse the subgoal, -% we instead "lock" the non-local variables, and -% disallow binding of locked variables.) -% (d) a unification -% Check that the unification doesn't attempt to unify -% two free variables (or in general two free sub-terms) -% unless one of them is dead. Split unifications -% up if necessary to avoid complicated sub-unifications. -% We also figure out at this point whether or not each -% unification can fail. -% (e) a predicate call -% Check that there is a mode declaration for the -% predicate which matches the current instantiation of -% the arguments. (Also handle calls to implied modes.) -% If the called predicate is one for which we must infer -% the modes, then create a new mode for the called predicate -% whose initial insts are the result of normalising -% the current inst of the arguments. -% (f) an if-then-else -% Attempt to schedule the condition. If successful, -% then check that it doesn't further instantiate any -% non-local variables, mode-check the `then' part -% and the `else' part, and then check that the final -% insts match. (Perhaps also think about expanding -% if-then-elses so that they can be run backwards, -% if the condition can't be scheduled?) +% (a) a disjunction +% Mode-analyse the sub-goals; +% check that the final insts of all the non-local +% variables are the same for all the sub-goals. +% (b) a conjunction +% Attempt to schedule each sub-goal. If a sub-goal can +% be scheduled, then schedule it, otherwise delay it. +% Continue with the remaining sub-goals until there are +% no goals left. Every time a variable gets bound, +% see whether we should wake up a delayed goal, +% and if so, wake it up next time we get back to +% the conjunction. If there are still delayed goals +% hanging around at the end of the conjunction, +% report a mode error. +% (c) a negation +% Mode-check the sub-goal. +% Check that the sub-goal does not further instantiate +% any non-local variables. (Actually, rather than +% doing this check after we mode-analyse the subgoal, +% we instead "lock" the non-local variables, and +% disallow binding of locked variables.) +% (d) a unification +% Check that the unification doesn't attempt to unify +% two free variables (or in general two free sub-terms) +% unless one of them is dead. Split unifications +% up if necessary to avoid complicated sub-unifications. +% We also figure out at this point whether or not each +% unification can fail. +% (e) a predicate call +% Check that there is a mode declaration for the +% predicate which matches the current instantiation of +% the arguments. (Also handle calls to implied modes.) +% If the called predicate is one for which we must infer +% the modes, then create a new mode for the called predicate +% whose initial insts are the result of normalising +% the current inst of the arguments. +% (f) an if-then-else +% Attempt to schedule the condition. If successful, +% then check that it doesn't further instantiate any +% non-local variables, mode-check the `then' part +% and the `else' part, and then check that the final +% insts match. (Perhaps also think about expanding +% if-then-elses so that they can be run backwards, +% if the condition can't be scheduled?) % % To attempt to schedule a goal, first mode-check the goal. If mode-checking % succeeds, then scheduling succeeds. If mode-checking would report @@ -224,15 +224,15 @@ mode_info::in, mode_info::out) is det. % modecheck_set_var_inst(Var, Inst, MaybeUInst, ModeInfo0, ModeInfo). - % Assign the given Inst to the given Var, after checking that - % it is okay to do so. If the inst to be assigned is the - % result of an abstract unification then the MaybeUInst - % argument should be the initial inst of the _other_ side of - % the unification. This allows more precise (i.e. less - % conservative) checking in the case that Inst contains `any' - % components and Var is locked (i.e. is a nonlocal variable in - % a negated context). Where the inst is not the result of an - % abstract unification then MaybeUInst should be `no'. + % Assign the given Inst to the given Var, after checking that + % it is okay to do so. If the inst to be assigned is the + % result of an abstract unification then the MaybeUInst + % argument should be the initial inst of the _other_ side of + % the unification. This allows more precise (i.e. less + % conservative) checking in the case that Inst contains `any' + % components and Var is locked (i.e. is a nonlocal variable in + % a negated context). Where the inst is not the result of an + % abstract unification then MaybeUInst should be `no'. :- pred modecheck_set_var_inst(prog_var::in, (inst)::in, maybe(inst)::in, mode_info::in, mode_info::out) is det. @@ -326,8 +326,8 @@ % Construct a call to initialise a free solver type variable. % :- pred construct_initialisation_call(prog_var::in, (type)::in, (inst)::in, - prog_context::in, maybe(call_unify_context)::in, - hlds_goal::out, mode_info::in, mode_info::out) is det. + prog_context::in, maybe(call_unify_context)::in, + hlds_goal::out, mode_info::in, mode_info::out) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% @@ -409,7 +409,7 @@ check_pred_modes(WhatToCheck, MayChangeCalledProc, :- pred modecheck_to_fixpoint(list(pred_id)::in, int::in, how_to_check_goal::in, may_change_called_proc::in, module_info::in, module_info::out, bool::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. modecheck_to_fixpoint(PredIds, MaxIterations, WhatToCheck, MayChangeCalledProc, !ModuleInfo, UnsafeToContinue, !IO) :- @@ -497,8 +497,8 @@ report_max_iterations_exceeded(!IO) :- % copy_pred_bodies(OldPredTable, ProcId, ModuleInfo0, ModuleInfo): % copy the procedure bodies for all procedures of the specified % PredIds from OldPredTable into ModuleInfo0, giving ModuleInfo. -:- pred copy_pred_bodies(pred_table, list(pred_id), module_info, module_info). -:- mode copy_pred_bodies(in, in, in, out) is det. +:- pred copy_pred_bodies(pred_table::in, list(pred_id)::in, + module_info::in, module_info::out) is det. copy_pred_bodies(OldPredTable, PredIds, !ModuleInfo) :- module_info_preds(!.ModuleInfo, PredTable0), @@ -509,8 +509,8 @@ copy_pred_bodies(OldPredTable, PredIds, !ModuleInfo) :- % copy_pred_body(OldPredTable, ProcId, PredTable0, PredTable): % copy the procedure bodies for all procedures of the specified % PredId from OldPredTable into PredTable0, giving PredTable. -:- pred copy_pred_body(pred_table, pred_id, pred_table, pred_table). -:- mode copy_pred_body(in, in, in, out) is det. +:- pred copy_pred_body(pred_table::in, pred_id::in, + pred_table::in, pred_table::out) is det. copy_pred_body(OldPredTable, PredId, PredTable0, PredTable) :- map__lookup(PredTable0, PredId, PredInfo0), @@ -638,7 +638,7 @@ modecheck_pred_mode(PredId, PredInfo0, WhatToCheck, MayChangeCalledProc, :- pred modecheck_pred_mode_2(pred_id::in, pred_info::in, how_to_check_goal::in, may_change_called_proc::in, module_info::in, module_info::out, bool::in, bool::out, int::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. modecheck_pred_mode_2(PredId, PredInfo0, WhatToCheck, MayChangeCalledProc, !ModuleInfo, !Changed, NumErrors, !IO) :- @@ -675,11 +675,11 @@ modecheck_pred_mode_2(PredId, PredInfo0, WhatToCheck, MayChangeCalledProc, :- pred modecheck_procs(list(proc_id)::in, pred_id::in, how_to_check_goal::in, may_change_called_proc::in, module_info::in, module_info::out, - bool::in, bool::out, int::in, int::out, io__state::di, io__state::uo) + bool::in, bool::out, int::in, int::out, io::di, io::uo) is det. modecheck_procs([], _PredId, _, _, !ModuleInfo, !Changed, !Errs, !IO). -modecheck_procs([ProcId|ProcIds], PredId, WhatToCheck, MayChangeCalledProc, +modecheck_procs([ProcId | ProcIds], PredId, WhatToCheck, MayChangeCalledProc, !ModuleInfo, !Changed, !Errs, !IO) :- % mode-check that mode of the predicate modecheck_proc_2(ProcId, PredId, WhatToCheck, MayChangeCalledProc, @@ -704,7 +704,7 @@ modecheck_proc(ProcId, PredId, WhatToCheck, MayChangeCalledProc, !ModuleInfo, :- pred modecheck_proc_2(proc_id::in, pred_id::in, how_to_check_goal::in, may_change_called_proc::in, module_info::in, module_info::out, - bool::in, bool::out, int::out, io__state::di, io__state::uo) is det. + bool::in, bool::out, int::out, io::di, io::uo) is det. modecheck_proc_2(ProcId, PredId, WhatToCheck, MayChangeCalledProc, !ModuleInfo, !Changed, NumErrors, !IO) :- @@ -737,7 +737,7 @@ modecheck_proc_info(ProcId, PredId, !ModuleInfo, !ProcInfo, NumErrors, !IO) :- :- pred modecheck_proc_3(proc_id::in, pred_id::in, how_to_check_goal::in, may_change_called_proc::in, module_info::in, module_info::out, proc_info::in, proc_info::out, bool::in, bool::out, int::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. modecheck_proc_3(ProcId, PredId, WhatToCheck, MayChangeCalledProc, !ModuleInfo, !ProcInfo, !Changed, NumErrors, !IO) :- @@ -899,9 +899,9 @@ modecheck_final_insts_2(HeadVars, FinalInsts0, InferModes, FinalInsts, :- pred maybe_clobber_insts(list(inst)::in, list(is_live)::in, list(inst)::out) is det. -maybe_clobber_insts([], [_|_], _) :- +maybe_clobber_insts([], [_ | _], _) :- error("maybe_clobber_insts: length mismatch"). -maybe_clobber_insts([_|_], [], _) :- +maybe_clobber_insts([_ | _], [], _) :- error("maybe_clobber_insts: length mismatch"). maybe_clobber_insts([], [], []). maybe_clobber_insts([Inst0 | Insts0], [IsLive | IsLives], [Inst | Insts]) :- @@ -993,8 +993,7 @@ check_final_insts(Vars, Insts, VarInsts, InferModes, ArgNum, ModuleInfo, %-----------------------------------------------------------------------------% :- pred prepend_initialisation_call(prog_var::in, (type)::in, (inst)::in, - hlds_goal::in, hlds_goal::out, mode_info::in, mode_info::out) - is det. + hlds_goal::in, hlds_goal::out, mode_info::in, mode_info::out) is det. prepend_initialisation_call(Var, VarType, InitialInst, Goal0, Goal, !ModeInfo) :- @@ -1632,7 +1631,7 @@ modecheck_conj_list_2([Goal0 | Goals0], Goals, !ImpurityErrors, !ModeInfo, % Next, we attempt to wake up any pending goals, % and then continue scheduling the rest of the goal. - delay_info__wakeup_goals(DelayInfo1, WokenGoals, DelayInfo), + delay_info__wakeup_goals(WokenGoals, DelayInfo1, DelayInfo), list__append(WokenGoals, Goals0, Goals1), ( WokenGoals = [] -> true @@ -1763,7 +1762,7 @@ modecheck_conj_list_3(DelayedGoals0, DelayedGoals, Goals, delay_info__enter_conj(DelayInfo0, DelayInfo1), mode_info_set_delay_info(DelayInfo1, !ModeInfo), - mode_info_add_goals_live_vars(InitGoals, !ModeInfo), + mode_info_add_goals_live_vars(InitGoals, !ModeInfo), modecheck_conj_list_2(Goals1, Goals, !ImpurityErrors, !ModeInfo, !IO), @@ -1780,12 +1779,10 @@ modecheck_conj_list_3(DelayedGoals0, DelayedGoals, Goals, ) ). - :- pred construct_initialisation_calls(list(prog_var)::in, - list(hlds_goal)::out, mode_info::in, mode_info::out) is det. + list(hlds_goal)::out, mode_info::in, mode_info::out) is det. construct_initialisation_calls([], [], !ModeInfo). - construct_initialisation_calls([Var | Vars], [Goal | Goals], !ModeInfo) :- mode_info_get_var_types(!.ModeInfo, VarTypes), map__lookup(VarTypes, Var, VarType), @@ -1796,22 +1793,21 @@ construct_initialisation_calls([Var | Vars], [Goal | Goals], !ModeInfo) :- MaybeCallUnifyContext, Goal, !ModeInfo), construct_initialisation_calls(Vars, Goals, !ModeInfo). - % XXX will this catch synonyms for `free'? % N.B. This is perhaps the only time when `for' and `free' % can be juxtaposed grammatically :-) % :- func non_free_vars_in_assoc_list(assoc_list(prog_var, inst)) = - list(prog_var). + list(prog_var). -non_free_vars_in_assoc_list([] ) = []. +non_free_vars_in_assoc_list([]) = []. non_free_vars_in_assoc_list([Var - Inst | AssocList]) = - ( if ( Inst = free ; Inst = free(_) ) - then non_free_vars_in_assoc_list(AssocList) - else [Var | non_free_vars_in_assoc_list(AssocList)] + ( ( Inst = free ; Inst = free(_) ) -> + non_free_vars_in_assoc_list(AssocList) + ; + [Var | non_free_vars_in_assoc_list(AssocList)] ). - % Find a set of vars that, if they were instantiated, might % lead to a deterministic scheduling of the given goals. % @@ -1822,7 +1818,7 @@ non_free_vars_in_assoc_list([Var - Inst | AssocList]) = % goals, foreign_code, or var/lambda unifications. % :- pred candidate_init_vars(mode_info::in, list(hlds_goal)::in, - set(prog_var)::in, set(prog_var)::out) is cc_nondet. + set(prog_var)::in, set(prog_var)::out) is cc_nondet. candidate_init_vars(ModeInfo, Goals, NonFreeVars0, CandidateVars) :- CandidateVars0 = set__init, @@ -1830,19 +1826,17 @@ candidate_init_vars(ModeInfo, Goals, NonFreeVars0, CandidateVars) :- CandidateVars0, CandidateVars1), CandidateVars = set__difference(CandidateVars1, NonFreeVars1). - :- pred candidate_init_vars_2(mode_info::in, list(hlds_goal)::in, - set(prog_var)::in, set(prog_var)::out, - set(prog_var)::in, set(prog_var)::out) is nondet. + set(prog_var)::in, set(prog_var)::out, + set(prog_var)::in, set(prog_var)::out) is nondet. candidate_init_vars_2(ModeInfo, Goals, !NonFree, !CandidateVars) :- list__foldl2(candidate_init_vars_3(ModeInfo), Goals, !NonFree, !CandidateVars). - :- pred candidate_init_vars_3(mode_info::in, hlds_goal::in, - set(prog_var)::in, set(prog_var)::out, - set(prog_var)::in, set(prog_var)::out) is nondet. + set(prog_var)::in, set(prog_var)::out, + set(prog_var)::in, set(prog_var)::out) is nondet. candidate_init_vars_3(_ModeInfo, Goal, !NonFree, !CandidateVars) :- % A var/var unification. @@ -1961,14 +1955,13 @@ candidate_init_vars_3(ModeInfo, Goal, !NonFree, !CandidateVars) :- candidate_init_vars_call(ModeInfo, Args, ArgModes, !NonFree, !CandidateVars). - % Update !NonFree and !CandidateVars given the args and modes for % a call. % :- pred candidate_init_vars_call(mode_info::in, - list(prog_var)::in, list(mode)::in, - set(prog_var)::in, set(prog_var)::out, - set(prog_var)::in, set(prog_var)::out) is semidet. + list(prog_var)::in, list(mode)::in, + set(prog_var)::in, set(prog_var)::out, + set(prog_var)::in, set(prog_var)::out) is semidet. candidate_init_vars_call(_ModeInfo, [], [], !NonFree, !CandidateVars). @@ -2004,7 +1997,6 @@ candidate_init_vars_call(ModeInfo, [Arg | Args], [Mode | Modes], candidate_init_vars_call(ModeInfo, Args, Modes, !NonFree, !CandidateVars). - % We may still have some unscheduled goals. This may be because some % initialisation calls are needed to turn some solver type vars % from inst free to inst any. This pass tries to unblock the @@ -2062,13 +2054,11 @@ modecheck_conj_list_4(DelayedGoals0, DelayedGoals, Goals, ) ). - :- func hlds_goal_from_delayed_goal(delayed_goal) = hlds_goal. hlds_goal_from_delayed_goal(delayed_goal(_WaitingVars, _ModeError, Goal)) = Goal. - % check whether there are any delayed goals (other than headvar unifications) % at the point where we are about to schedule an impure goal. If so, that is % an error. Headvar unifications are allowed to be delayed because in the @@ -2109,10 +2099,12 @@ check_for_impurity_error(Goal, !ImpurityErrors, !ModeInfo) :- no_non_headvar_unification_goals([], _). no_non_headvar_unification_goals([delayed_goal(_, _, Goal - _) | Goals], HeadVars) :- - Goal = unify(Var,Rhs,_,_,_), - ( list__member(Var, HeadVars) - ; Rhs = var(OtherVar), - list__member(OtherVar, HeadVars) + Goal = unify(Var, RHS, _, _, _), + ( + list__member(Var, HeadVars) + ; + RHS = var(OtherVar), + list__member(OtherVar, HeadVars) ), no_non_headvar_unification_goals(Goals, HeadVars). @@ -2215,7 +2207,7 @@ modecheck_functor_test(Var, ConsId, !ModeInfo) :- mode_info::in, mode_info::out, io::di, io::uo) is det. modecheck_par_conj_list([], [], _NonLocals, [], !ModeInfo, !IO). -modecheck_par_conj_list([Goal0 | Goals0], [Goal|Goals], NonLocals, +modecheck_par_conj_list([Goal0 | Goals0], [Goal | Goals], NonLocals, [InstMap - GoalNonLocals | InstMaps], !ModeInfo, !IO) :- mode_info_get_instmap(!.ModeInfo, InstMap0), Goal0 = _ - GoalInfo, @@ -2229,10 +2221,10 @@ modecheck_par_conj_list([Goal0 | Goals0], [Goal|Goals], NonLocals, ( PVars1 = [_ - Bound1 | PVars2], ( - PVars2 = [OuterNonLocals - OuterBound0|PVars3], + PVars2 = [OuterNonLocals - OuterBound0 | PVars3], set__intersect(OuterNonLocals, Bound1, Bound), set__union(OuterBound0, Bound, OuterBound), - PVars = [OuterNonLocals - OuterBound|PVars3], + PVars = [OuterNonLocals - OuterBound | PVars3], mode_info_set_parallel_vars(PVars, !ModeInfo) ; PVars2 = [], @@ -2270,9 +2262,9 @@ compute_arg_offset(PredInfo, ArgOffset) :- % ensure the liveness of each variable satisfies the corresponding % expected liveness. -modecheck_var_list_is_live([_|_], [], _, _, !ModeInfo) :- +modecheck_var_list_is_live([_ | _], [], _, _, !ModeInfo) :- error("modecheck_var_list_is_live: length mismatch"). -modecheck_var_list_is_live([], [_|_], _, _, !ModeInfo) :- +modecheck_var_list_is_live([], [_ | _], _, _, !ModeInfo) :- error("modecheck_var_list_is_live: length mismatch"). modecheck_var_list_is_live([], [], _NeedExactMatch, _ArgNum, !ModeInfo). modecheck_var_list_is_live([Var | Vars], [IsLive | IsLives], NeedExactMatch, @@ -2323,9 +2315,9 @@ modecheck_var_has_inst_list(Vars, Insts, NeedEaxctMatch, ArgNum, Subst, bool::in, int::in, inst_var_sub::in, inst_var_sub::out, mode_info::in, mode_info::out) is det. -modecheck_var_has_inst_list_2([_|_], [], _, _, !Subst, !ModeInfo) :- +modecheck_var_has_inst_list_2([_ | _], [], _, _, !Subst, !ModeInfo) :- error("modecheck_var_has_inst_list: length mismatch"). -modecheck_var_has_inst_list_2([], [_|_], _, _, !Subst, !ModeInfo) :- +modecheck_var_has_inst_list_2([], [_ | _], _, _, !Subst, !ModeInfo) :- error("modecheck_var_has_inst_list: length mismatch"). modecheck_var_has_inst_list_2([], [], _Exact, _ArgNum, !Subst, !ModeInfo). modecheck_var_has_inst_list_2([Var | Vars], [Inst | Insts], NeedExactMatch, @@ -2433,8 +2425,8 @@ modecheck_set_var_inst(Var0, FinalInst, MaybeUInst, !ModeInfo) :- mode_info_get_module_info(!.ModeInfo, ModuleInfo0), ( abstractly_unify_inst(dead, Inst0, FinalInst, - fake_unify, ModuleInfo0, - UnifyInst, _Det, ModuleInfo1) + fake_unify, UnifyInst, _Det, + ModuleInfo0, ModuleInfo1) -> ModuleInfo = ModuleInfo1, Inst = UnifyInst @@ -2495,7 +2487,7 @@ modecheck_set_var_inst(Var0, FinalInst, MaybeUInst, !ModeInfo) :- instmap__set(InstMap0, Var0, Inst, InstMap), mode_info_set_instmap(InstMap, !ModeInfo), mode_info_get_delay_info(!.ModeInfo, DelayInfo0), - delay_info__bind_var(DelayInfo0, Var0, DelayInfo), + delay_info__bind_var(Var0, DelayInfo0, DelayInfo), mode_info_set_delay_info(DelayInfo, !ModeInfo) ) ; @@ -2504,10 +2496,10 @@ modecheck_set_var_inst(Var0, FinalInst, MaybeUInst, !ModeInfo) :- ( PVars0 = [] ; - PVars0 = [NonLocals - Bound0|PVars1], + PVars0 = [NonLocals - Bound0 | PVars1], ( set__member(Var0, NonLocals) -> set__insert(Bound0, Var0, Bound), - PVars = [NonLocals - Bound|PVars1] + PVars = [NonLocals - Bound | PVars1] ; PVars = PVars0 ), @@ -2569,7 +2561,7 @@ handle_implied_mode(Var0, VarInst0, InitialInst0, Var, !ExtraGoals, mode_context_to_unify_context(!.ModeInfo, ModeContext, UnifyContext), CallUnifyContext = yes(call_unify_context(Var, var(Var), - UnifyContext)), + UnifyContext)), ( mode_info_get_errors(!.ModeInfo, ModeErrors), ModeErrors = [], @@ -2590,7 +2582,7 @@ handle_implied_mode(Var0, VarInst0, InitialInst0, Var, !ExtraGoals, mode_error_implied_mode(Var0, VarInst0, InitialInst), !ModeInfo) - ) + ) ; inst_is_bound(ModuleInfo0, InitialInst) -> @@ -2622,11 +2614,10 @@ handle_implied_mode(Var0, VarInst0, InitialInst0, Var, !ExtraGoals, !:ExtraGoals) ). - :- pred insert_extra_initialisation_call(prog_var::in, (type)::in, (inst)::in, - prog_context::in, maybe(call_unify_context)::in, - extra_goals::in, extra_goals::out, - mode_info::in, mode_info::out) is det. + prog_context::in, maybe(call_unify_context)::in, + extra_goals::in, extra_goals::out, mode_info::in, mode_info::out) + is det. insert_extra_initialisation_call(Var, VarType, Inst, Context, CallUnifyContext, !ExtraGoals, !ModeInfo) :- @@ -2636,13 +2627,12 @@ insert_extra_initialisation_call(Var, VarType, Inst, Context, CallUnifyContext, NewExtraGoal = extra_goals([InitVarGoal], []), append_extra_goals(!.ExtraGoals, NewExtraGoal, !:ExtraGoals). - construct_initialisation_call(Var, VarType, Inst, Context, MaybeCallUnifyContext, InitVarGoal, !ModeInfo) :- ( type_to_ctor_and_args(VarType, TypeCtor, _TypeArgs), PredName = special_pred__special_pred_name(initialise, - TypeCtor), + TypeCtor), ( TypeCtor = qualified(ModuleName, _TypeName) - _Arity ; @@ -2662,7 +2652,6 @@ construct_initialisation_call(Var, VarType, Inst, Context, error("modes.construct_initialisation_call") ). - :- pred build_call(module_name::in, string::in, list(prog_var)::in, set(prog_var)::in, instmap_delta::in, prog_context::in, maybe(call_unify_context)::in, hlds_goal::out, @@ -2713,18 +2702,17 @@ mode_context_to_unify_context(_, uninitialized, _) :- % we also check the mode of main/2 here. :- pred check_eval_methods(module_info::in, module_info::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. check_eval_methods(!ModuleInfo, !IO) :- module_info_predids(!.ModuleInfo, PredIds), pred_check_eval_methods(PredIds, !ModuleInfo, !IO). :- pred pred_check_eval_methods(list(pred_id)::in, - module_info::in, module_info::out, - io__state::di, io__state::uo) is det. + module_info::in, module_info::out, io::di, io::uo) is det. pred_check_eval_methods([], !ModuleInfo, !IO). -pred_check_eval_methods([PredId|Rest], !ModuleInfo, !IO) :- +pred_check_eval_methods([PredId | Rest], !ModuleInfo, !IO) :- module_info_preds(!.ModuleInfo, Preds), map__lookup(Preds, PredId, PredInfo), ProcIds = pred_info_procids(PredInfo), @@ -2732,11 +2720,10 @@ pred_check_eval_methods([PredId|Rest], !ModuleInfo, !IO) :- pred_check_eval_methods(Rest, !ModuleInfo, !IO). :- pred proc_check_eval_methods(list(proc_id)::in, pred_id::in, - module_info::in, module_info::out, - io__state::di, io__state::uo) is det. + module_info::in, module_info::out, io::di, io::uo) is det. proc_check_eval_methods([], _, !ModuleInfo, !IO). -proc_check_eval_methods([ProcId|Rest], PredId, !ModuleInfo, !IO) :- +proc_check_eval_methods([ProcId | Rest], PredId, !ModuleInfo, !IO) :- module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId, PredInfo, ProcInfo), proc_info_eval_method(ProcInfo, EvalMethod), @@ -2774,7 +2761,7 @@ proc_check_eval_methods([ProcId|Rest], PredId, !ModuleInfo, !IO) :- :- pred only_fully_in_out_modes(list(mode)::in, module_info::in) is semidet. only_fully_in_out_modes([], _). -only_fully_in_out_modes([Mode|Rest], ModuleInfo) :- +only_fully_in_out_modes([Mode | Rest], ModuleInfo) :- mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst), ( inst_is_ground(ModuleInfo, InitialInst) @@ -2791,7 +2778,7 @@ only_fully_in_out_modes([Mode|Rest], ModuleInfo) :- :- pred only_nonunique_modes(list(mode)::in, module_info::in) is semidet. only_nonunique_modes([], _). -only_nonunique_modes([Mode|Rest], ModuleInfo) :- +only_nonunique_modes([Mode | Rest], ModuleInfo) :- mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst), inst_is_not_partly_unique(ModuleInfo, InitialInst), inst_is_not_partly_unique(ModuleInfo, FinalInst), @@ -2817,8 +2804,7 @@ check_mode_of_main([Di, Uo], ModuleInfo) :- inst_expand(ModuleInfo, UoFinalInst, ground(unique, none)). :- pred report_eval_method_requires_ground_args(proc_info::in, - module_info::in, module_info::out, - io__state::di, io__state::uo) is det. + module_info::in, module_info::out, io::di, io::uo) is det. report_eval_method_requires_ground_args(ProcInfo, !ModuleInfo, !IO) :- proc_info_eval_method(ProcInfo, EvalMethod), @@ -2845,8 +2831,7 @@ report_eval_method_requires_ground_args(ProcInfo, !ModuleInfo, !IO) :- module_info_incr_errors(!ModuleInfo). :- pred report_eval_method_destroys_uniqueness(proc_info::in, - module_info::in, module_info::out, - io__state::di, io__state::uo) is det. + module_info::in, module_info::out, io::di, io::uo) is det. report_eval_method_destroys_uniqueness(ProcInfo, !ModuleInfo, !IO) :- proc_info_eval_method(ProcInfo, EvalMethod), @@ -2858,8 +2843,8 @@ report_eval_method_destroys_uniqueness(ProcInfo, !ModuleInfo, !IO) :- io__write_string(EvalMethodS, !IO), io__write_string("'\n", !IO), prog_out__write_context(Context, !IO), - io__write_string( - " declaration not allowed for procedure with\n", !IO), + io__write_string(" declaration not allowed for procedure with\n", + !IO), prog_out__write_context(Context, !IO), io__write_string(" unique modes.\n", !IO), ( @@ -2874,8 +2859,7 @@ report_eval_method_destroys_uniqueness(ProcInfo, !ModuleInfo, !IO) :- module_info_incr_errors(!ModuleInfo). :- pred report_wrong_mode_for_main(proc_info::in, - module_info::in, module_info::out, - io__state::di, io__state::uo) is det. + module_info::in, module_info::out, io::di, io::uo) is det. report_wrong_mode_for_main(ProcInfo, !ModuleInfo, !IO) :- proc_info_context(ProcInfo, Context), @@ -2889,10 +2873,10 @@ report_wrong_mode_for_main(ProcInfo, !ModuleInfo, !IO) :- % Given a list of variables, and a list of livenesses, % select the live variables. -get_live_vars([_|_], [], _) :- error("get_live_vars: length mismatch"). -get_live_vars([], [_|_], _) :- error("get_live_vars: length mismatch"). +get_live_vars([_ | _], [], _) :- error("get_live_vars: length mismatch"). +get_live_vars([], [_ | _], _) :- error("get_live_vars: length mismatch"). get_live_vars([], [], []). -get_live_vars([Var|Vars], [IsLive|IsLives], LiveVars) :- +get_live_vars([Var | Vars], [IsLive | IsLives], LiveVars) :- ( IsLive = live -> LiveVars = [Var | LiveVars0] ; @@ -2909,7 +2893,7 @@ get_live_vars([Var|Vars], [IsLive|IsLives], LiveVars) :- % an infinite loop). :- pred check_circular_modes(module_info::in, module_info::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. check_circular_modes(!Module, !IO). diff --git a/compiler/passes_aux.m b/compiler/passes_aux.m index b48b91c83..5315b37f7 100644 --- a/compiler/passes_aux.m +++ b/compiler/passes_aux.m @@ -30,11 +30,10 @@ proc_info, proc_info)) ; update_proc_io(pred( pred_id, proc_id, module_info, - proc_info, proc_info, io__state, io__state)) + proc_info, proc_info, io, io)) ; update_proc_error(pred( pred_id, proc_id, module_info, module_info, - proc_info, proc_info, int, int, - io__state, io__state)) + proc_info, proc_info, int, int, io, io)) ; update_pred_error(pred_error_task) ; update_module(pred( pred_id, proc_id, pred_info, @@ -42,8 +41,7 @@ module_info, module_info)) ; update_module_io(pred( pred_id, proc_id, proc_info, proc_info, - module_info, module_info, - io__state, io__state)) + module_info, module_info, io, io)) % It would be better to use an existentially-quantified type % rather than `univ' here, but the current version of Mercury % doesn't support existentially-quantified types. @@ -55,7 +53,7 @@ :- type pred_error_task == pred(pred_id, module_info, module_info, pred_info, pred_info, - int, int, io__state, io__state). + int, int, io, io). % Note that update_module_cookie causes some difficulties. % Ideally, it should be implemented using existential types: @@ -186,8 +184,7 @@ % a Unix shell to be present, so it won't work properly % with native Windows. :- pred invoke_shell_command(io__output_stream::in, - command_verbosity::in, string::in, bool::out, - io__state::di, io__state::uo) is det. + command_verbosity::in, string::in, bool::out, io::di, io::uo) is det. % invoke_shell_command(ErrorStream, Verbosity, Command, % ProcessOutput, Succeeded) @@ -201,7 +198,7 @@ % with native Windows. :- pred invoke_shell_command(io__output_stream::in, command_verbosity::in, string::in, maybe(string)::in, bool::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. % invoke_system_command(ErrorStream, Verbosity, Command, Succeeded) % @@ -209,8 +206,7 @@ % Both standard and error output will go to the % specified output stream. :- pred invoke_system_command(io__output_stream::in, - command_verbosity::in, string::in, bool::out, - io__state::di, io__state::uo) is det. + command_verbosity::in, string::in, bool::out, io::di, io::uo) is det. % invoke_system_command(ErrorStream, Verbosity, Command, % ProcessOutput, Succeeded) @@ -221,14 +217,14 @@ % `ProcessOutput'. :- pred invoke_system_command(io__output_stream::in, command_verbosity::in, string::in, maybe(string)::in, bool::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. % Make a command string, which needs to be invoked in a shell % environment. :- pred make_command_string(string::in, quote_char::in, string::out) is det. % If the bool is `no' set the exit status to 1. -:- pred maybe_set_exit_status(bool::in, io__state::di, io__state::uo) is det. +:- pred maybe_set_exit_status(bool::in, io::di, io::uo) is det. %-----------------------------------------------------------------------------% diff --git a/compiler/polymorphism.m b/compiler/polymorphism.m index fa7fb97a6..2710e3fab 100644 --- a/compiler/polymorphism.m +++ b/compiler/polymorphism.m @@ -172,7 +172,7 @@ % Run the polymorphism pass over the whole HLDS. :- pred polymorphism__process_module(module_info::in, module_info::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. % Run the polymorphism pass over a single pred. % This is used to transform clauses introduced by unify_proc.m @@ -402,8 +402,7 @@ polymorphism__process_module(!ModuleInfo, !IO) :- polymorphism__expand_class_method_bodies(!ModuleInfo). :- pred polymorphism__maybe_process_pred(pred_id::in, - module_info::in, module_info::out, io__state::di, io__state::uo) - is det. + module_info::in, module_info::out, io::di, io::uo) is det. polymorphism__maybe_process_pred(PredId, !ModuleInfo, !IO) :- module_info_pred_info(!.ModuleInfo, PredId, PredInfo), @@ -519,8 +518,7 @@ polymorphism__fixup_pred(PredId, !ModuleInfo) :- %---------------------------------------------------------------------------% :- pred polymorphism__process_pred(pred_id::in, - module_info::in, module_info::out, io__state::di, io__state::uo) - is det. + module_info::in, module_info::out, io::di, io::uo) is det. polymorphism__process_pred(PredId, !ModuleInfo, !IO) :- write_pred_progress_message("% Transforming polymorphism for ", diff --git a/compiler/post_typecheck.m b/compiler/post_typecheck.m index 918724291..d7cbfddb8 100644 --- a/compiler/post_typecheck.m +++ b/compiler/post_typecheck.m @@ -58,7 +58,7 @@ % :- pred post_typecheck__finish_preds(list(pred_id)::in, bool::in, int::out, bool::out, module_info::in, module_info::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. % As above, but don't check for `aditi__state's and return % the list of procedures containing unbound inst variables @@ -71,13 +71,13 @@ list(proc_id)::out, pred_info::in, pred_info::out) is det. :- pred post_typecheck__finish_ill_typed_pred(module_info::in, pred_id::in, - pred_info::in, pred_info::out, io__state::di, io__state::uo) is det. + pred_info::in, pred_info::out, io::di, io::uo) is det. % Now that the assertion has finished being typechecked, % remove it from further processing and store it in the % assertion_table. :- pred post_typecheck__finish_promise(promise_type::in, pred_id::in, - module_info::in, module_info::out, io__state::di, io__state::uo) is det. + module_info::in, module_info::out, io::di, io::uo) is det. % Handle any unresolved overloading for a predicate call. % @@ -147,7 +147,7 @@ post_typecheck__finish_preds(PredIds, ReportTypeErrors, NumErrors, :- pred post_typecheck__finish_preds(list(pred_id)::in, bool::in, module_info::in, module_info::out, int::in, int::out, - bool::in, bool::out, io__state::di, io__state::uo) is det. + bool::in, bool::out, io::di, io::uo) is det. post_typecheck__finish_preds([], _, !ModuleInfo, !NumErrors, !PostTypecheckError, !IO). @@ -227,8 +227,8 @@ post_typecheck__finish_preds([PredId | PredIds], ReportTypeErrors, % variables, and that there are no unsatisfied type class constraints. :- pred post_typecheck__check_type_bindings(module_info::in, pred_id::in, - pred_info::in, pred_info::out, bool::in, int::out, - io__state::di, io__state::uo) is det. + pred_info::in, pred_info::out, bool::in, int::out, io::di, io::uo) + is det. post_typecheck__check_type_bindings(ModuleInfo, PredId, PredInfo0, PredInfo, ReportErrs, NumErrors, !IO) :- @@ -336,8 +336,7 @@ bind_type_vars_to_void(UnboundTypeVarsSet, !VarTypesMap, !Proofs) :- % report an error: unsatisfied type class constraints % :- pred report_unsatisfied_constraints(list(class_constraint)::in, - pred_id::in, pred_info::in, module_info::in, - io__state::di, io__state::uo) is det. + pred_id::in, pred_info::in, module_info::in, io::di, io::uo) is det. report_unsatisfied_constraints(Constraints, PredId, PredInfo, ModuleInfo) --> io__set_exit_status(1), @@ -894,7 +893,7 @@ report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo, !IO) :- :- pred report_unbound_inst_var_error(module_info::in, pred_id::in, proc_id::in, proc_table::in, proc_table::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. report_unbound_inst_var_error(ModuleInfo, PredId, ProcId, Procs0, Procs, !IO) :- diff --git a/compiler/process_util.m b/compiler/process_util.m index 706502e5d..c8b6c2f2b 100644 --- a/compiler/process_util.m +++ b/compiler/process_util.m @@ -8,6 +8,7 @@ % % Process and signal handling, mainly for use by make.m and its sub-modules. %-----------------------------------------------------------------------------% + :- module libs__process_util. :- interface. @@ -16,10 +17,10 @@ %-----------------------------------------------------------------------------% -:- type build0(Info) == pred(bool, Info, Info, io__state, io__state). +:- type build0(Info) == pred(bool, Info, Info, io, io). :- inst build0 == (pred(out, in, out, di, uo) is det). -:- type post_signal_cleanup(Info) == pred(Info, Info, io__state, io__state). +:- type post_signal_cleanup(Info) == pred(Info, Info, io, io). :- inst post_signal_cleanup == (pred(in, out, di, uo) is det). % build_with_check_for_interrupt(Build, Cleanup, @@ -38,15 +39,15 @@ % immediately afterwards. :- pred build_with_check_for_interrupt(build0(Info)::in(build0), post_signal_cleanup(Info)::in(post_signal_cleanup), bool::out, - Info::in, Info::out, io__state::di, io__state::uo) is det. + Info::in, Info::out, io::di, io::uo) is det. % raise_signal(Signal). % Send `Signal' to the current process. -:- pred raise_signal(int::in, io__state::di, io__state::uo) is det. +:- pred raise_signal(int::in, io::di, io::uo) is det. %-----------------------------------------------------------------------------% -:- type io_pred == pred(bool, io__state, io__state). +:- type io_pred == pred(bool, io, io). :- inst io_pred == (pred(out, di, uo) is det). % Does fork() work on the current platform. @@ -64,12 +65,12 @@ % If fork() is not supported on the current architecture, % `AltP' will be called instead in the current process. :- pred call_in_forked_process(io_pred::in(io_pred), io_pred::in(io_pred), - bool::out, io__state::di, io__state::uo) is det. + bool::out, io::di, io::uo) is det. % As above, but if fork() is not available, just call the % predicate in the current process. -:- pred call_in_forked_process(io_pred::in(io_pred), - bool::out, io__state::di, io__state::uo) is det. +:- pred call_in_forked_process(io_pred::in(io_pred), bool::out, + io::di, io::uo) is det. %-----------------------------------------------------------------------------% @@ -80,29 +81,28 @@ :- import_module std_util, require. -build_with_check_for_interrupt(Build, Cleanup, Succeeded, Info0, Info) --> - setup_signal_handlers(MaybeSigIntHandler), - Build(Succeeded0, Info0, Info1), - restore_signal_handlers(MaybeSigIntHandler), - check_for_signal(Signalled, Signal), - ( { Signalled = 1 } -> - { Succeeded = no }, - globals__io_lookup_bool_option(verbose_make, Verbose), - ( { Verbose = yes } -> - io__write_string("** Received signal "), - io__write_int(Signal), - io__write_string(", cleaning up.\n") +build_with_check_for_interrupt(Build, Cleanup, Succeeded, !Info, !IO) :- + setup_signal_handlers(MaybeSigIntHandler, !IO), + Build(Succeeded0, !Info, !IO), + restore_signal_handlers(MaybeSigIntHandler, !IO), + check_for_signal(Signalled, Signal, !IO), + ( Signalled = 1 -> + Succeeded = no, + globals__io_lookup_bool_option(verbose_make, Verbose, !IO), + ( Verbose = yes -> + io__write_string("** Received signal ", !IO), + io__write_int(Signal, !IO), + io__write_string(", cleaning up.\n", !IO) ; - [] + true ), - Cleanup(Info1, Info), + Cleanup(!Info, !IO), % The signal handler has been restored to the default, % so this should kill us. - raise_signal(Signal) + raise_signal(Signal, !IO) ; - { Succeeded = Succeeded0 }, - { Info = Info1 } + Succeeded = Succeeded0 ). :- type signal_action ---> signal_action. @@ -162,8 +162,7 @@ MC_mercury_compile_signal_handler(int sig) } "). -:- pred setup_signal_handlers(signal_action::out, - io__state::di, io__state::uo) is det. +:- pred setup_signal_handlers(signal_action::out, io::di, io::uo) is det. setup_signal_handlers(signal_action::out, IO::di, IO::uo). @@ -190,8 +189,7 @@ setup_signal_handlers(signal_action::out, IO::di, IO::uo). #endif }"). -:- pred restore_signal_handlers(signal_action::in, - io__state::di, io__state::uo) is det. +:- pred restore_signal_handlers(signal_action::in, io::di, io::uo) is det. restore_signal_handlers(_::in, IO::di, IO::uo). @@ -214,21 +212,23 @@ restore_signal_handlers(_::in, IO::di, IO::uo). % Restore all signal handlers to default values in the child % so that the child will be killed by the signals the parent % is catching. -:- pred setup_child_signal_handlers(io__state::di, io__state::uo) is det. +:- pred setup_child_signal_handlers(io::di, io::uo) is det. -setup_child_signal_handlers --> - restore_signal_handlers(sig_dfl). +setup_child_signal_handlers(!IO) :- + restore_signal_handlers(sig_dfl, !IO). :- func sig_dfl = signal_action. sig_dfl = (signal_action::out). -:- pragma foreign_proc("C", sig_dfl = (Result::out), - [will_not_call_mercury, promise_pure], - "MR_init_signal_action(&Result, SIG_DFL, MR_FALSE, MR_TRUE);"). +:- pragma foreign_proc("C", + sig_dfl = (Result::out), + [will_not_call_mercury, promise_pure], +" + MR_init_signal_action(&Result, SIG_DFL, MR_FALSE, MR_TRUE); +"). -:- pred check_for_signal(int::out, int::out, - io__state::di, io__state::uo) is det. +:- pred check_for_signal(int::out, int::out, io::di, io::uo) is det. check_for_signal(0::out, 0::out, IO::di, IO::uo). @@ -259,27 +259,28 @@ raise_signal(_::in, IO::di, IO::uo). %-----------------------------------------------------------------------------% -call_in_forked_process(P, Success) --> - call_in_forked_process(P, P, Success). +call_in_forked_process(P, Success, !IO) :- + call_in_forked_process(P, P, Success, !IO). -call_in_forked_process(P, AltP, Success) --> - ( { can_fork } -> - call_in_forked_process_2(P, ForkStatus, CallStatus), - { ForkStatus = 1 -> +call_in_forked_process(P, AltP, Success, !IO) :- + ( can_fork -> + call_in_forked_process_2(P, ForkStatus, CallStatus, !IO), + ( ForkStatus = 1 -> Success = no ; Status = io__handle_system_command_exit_status( - CallStatus), + CallStatus), Success = (Status = ok(exited(0)) -> yes ; no) - } + ) ; - AltP(Success) + AltP(Success, !IO) ). can_fork :- semidet_fail. -:- pragma foreign_proc("C", can_fork, - [will_not_call_mercury, thread_safe, promise_pure], +:- pragma foreign_proc("C", + can_fork, + [will_not_call_mercury, thread_safe, promise_pure], " #ifdef MC_CAN_FORK SUCCESS_INDICATOR = MR_TRUE; @@ -289,7 +290,7 @@ can_fork :- semidet_fail. "). :- pred call_in_forked_process_2(io_pred::in(io_pred), int::out, int::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. call_in_forked_process_2(_::in(io_pred), _::out, _::out, _::di, _::uo) :- error("call_in_forked_process_2"). @@ -385,13 +386,13 @@ call_in_forked_process_2(_::in(io_pred), _::out, _::out, _::di, _::uo) :- % call_child_process_io_pred(P, ExitStatus). :- pred call_child_process_io_pred(io_pred::in(io_pred), int::out, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. :- pragma export(call_child_process_io_pred(in(io_pred), out, di, uo), - "MC_call_child_process_io_pred"). + "MC_call_child_process_io_pred"). -call_child_process_io_pred(P, Status) --> - setup_child_signal_handlers, - P(Success), - { Status = ( Success = yes -> 0 ; 1 ) }. +call_child_process_io_pred(P, Status, !IO) :- + setup_child_signal_handlers(!IO), + P(Success, !IO), + Status = ( Success = yes -> 0 ; 1 ). %-----------------------------------------------------------------------------% diff --git a/compiler/prog_io.m b/compiler/prog_io.m index daacde4ba..b828093e1 100644 --- a/compiler/prog_io.m +++ b/compiler/prog_io.m @@ -94,7 +94,7 @@ % Program is the parse tree. :- type module_error - ---> no_module_errors % no errors + ---> no_module_errors % no errors ; some_module_errors % some syntax errors ; fatal_module_errors. % couldn't open the file @@ -177,7 +177,7 @@ maybe_functor::out) is det. % parse_type_decl_where_part_if_present(TypeSymName, Arity, - % IsSolverType, Inst, ModuleName, Term0, Term, Result): + % IsSolverType, Inst, ModuleName, Term0, Term, Result): % Checks if Term0 is a term of the form % ` where ' % If so, returns the `' in Term and the parsed @@ -186,9 +186,8 @@ % Result = no. % :- pred parse_type_decl_where_part_if_present(is_solver_type::in, - module_name::in, term::in, term::out, - maybe2(maybe(solver_type_details), maybe(unify_compare))::out) - is det. + module_name::in, term::in, term::out, + maybe2(maybe(solver_type_details), maybe(unify_compare))::out) is det. %-----------------------------------------------------------------------------% @@ -284,42 +283,43 @@ prog_io__read_module(OpenFile, DefaultModuleName, ReturnTimestamp, Error, FileData, ModuleName, - Messages, Items, MaybeModuleTimestamp) --> + Messages, Items, MaybeModuleTimestamp, !IO) :- prog_io__read_module_2(OpenFile, DefaultModuleName, no, ReturnTimestamp, Error, FileData, ModuleName, - Messages, Items, MaybeModuleTimestamp). + Messages, Items, MaybeModuleTimestamp, !IO). prog_io__read_module_if_changed(OpenFile, DefaultModuleName, OldTimestamp, Error, FileData, ModuleName, Messages, - Items, MaybeModuleTimestamp) --> + Items, MaybeModuleTimestamp, !IO) :- prog_io__read_module_2(OpenFile, DefaultModuleName, yes(OldTimestamp), yes, Error, FileData, - ModuleName, Messages, Items, MaybeModuleTimestamp). + ModuleName, Messages, Items, MaybeModuleTimestamp, !IO). -prog_io__read_opt_file(FileName, DefaultModuleName, Error, Messages, Items) --> - globals__io_lookup_accumulating_option(intermod_directories, Dirs), +prog_io__read_opt_file(FileName, DefaultModuleName, Error, Messages, Items, + !IO) :- + globals__io_lookup_accumulating_option(intermod_directories, Dirs, + !IO), prog_io__read_module_2(search_for_file(Dirs, FileName), - DefaultModuleName, no, no, Error, _, ModuleName, - Messages, Items, _), - check_module_has_expected_name(FileName, - DefaultModuleName, ModuleName). + DefaultModuleName, no, no, Error, _, ModuleName, Messages, + Items, _, !IO), + check_module_has_expected_name(FileName, DefaultModuleName, ModuleName, + !IO). -check_module_has_expected_name(FileName, ExpectedName, ActualName) --> - ( { ActualName \= ExpectedName } -> - { prog_out__sym_name_to_string(ActualName, ActualString) }, - { prog_out__sym_name_to_string(ExpectedName, ExpectedString) }, +check_module_has_expected_name(FileName, ExpectedName, ActualName, !IO) :- + ( ActualName \= ExpectedName -> + prog_out__sym_name_to_string(ActualName, ActualString), + prog_out__sym_name_to_string(ExpectedName, ExpectedString), io__write_strings([ "Error: file `", FileName, "' contains the wrong module.\n", "Expected module `", ExpectedString, "', found module `", ActualString, "'.\n" - ]), - io__set_exit_status(1) + ], !IO), + io__set_exit_status(1, !IO) ; - [] + true ). - % This implementation uses io__read_term to read in the program % term at a time, and then converts those terms into clauses and % declarations, checking for errors as it goes. @@ -328,40 +328,38 @@ check_module_has_expected_name(FileName, ExpectedName, ActualName) --> % and then reverse them afterwards. (Using difference lists would require % late-input modes.) -:- pred prog_io__read_module_2(open_file(T), module_name, - maybe(timestamp), bool, module_error, maybe(T), module_name, - message_list, item_list, maybe(io__res(timestamp)), - io__state, io__state). -:- mode prog_io__read_module_2(in(open_file), in, in, in, - out, out, out, out, out, out, di, uo) is det. +:- pred prog_io__read_module_2(open_file(T)::in(open_file), module_name::in, + maybe(timestamp)::in, bool::in, module_error::out, maybe(T)::out, + module_name::out, message_list::out, item_list::out, + maybe(io__res(timestamp))::out, io::di, io::uo) is det. prog_io__read_module_2(OpenFile, DefaultModuleName, MaybeOldTimestamp, ReturnTimestamp, Error, MaybeFileData, ModuleName, Messages, Items, - MaybeModuleTimestamp) --> - io__input_stream(OldInputStream), - OpenFile(OpenResult), + MaybeModuleTimestamp, !IO) :- + io__input_stream(OldInputStream, !IO), + OpenFile(OpenResult, !IO), ( - { OpenResult = ok(FileData) }, - { MaybeFileData = yes(FileData) }, - ( { ReturnTimestamp = yes } -> - io__input_stream_name(InputStreamName), + OpenResult = ok(FileData), + MaybeFileData = yes(FileData), + ( ReturnTimestamp = yes -> + io__input_stream_name(InputStreamName, !IO), io__file_modification_time(InputStreamName, - TimestampResult), + TimestampResult, !IO), ( - { TimestampResult = ok(Timestamp) }, - { MaybeModuleTimestamp = yes( - ok(time_t_to_timestamp(Timestamp))) } + TimestampResult = ok(Timestamp), + MaybeModuleTimestamp = yes( + ok(time_t_to_timestamp(Timestamp))) ; - { TimestampResult = error(IOError) }, - { MaybeModuleTimestamp = yes(error(IOError)) } + TimestampResult = error(IOError), + MaybeModuleTimestamp = yes(error(IOError)) ) ; - { MaybeModuleTimestamp = no } + MaybeModuleTimestamp = no ), ( - { MaybeOldTimestamp = yes(OldTimestamp) }, - { MaybeModuleTimestamp = yes(ok(OldTimestamp)) } + MaybeOldTimestamp = yes(OldTimestamp), + MaybeModuleTimestamp = yes(ok(OldTimestamp)) -> % % XXX Currently smart recompilation won't work @@ -370,34 +368,32 @@ prog_io__read_module_2(OpenFile, DefaultModuleName, % be disabled and prog_io__read_module should % never be passed an old timestamp. % - { ModuleName = DefaultModuleName }, - { Items = [] }, - { Error = no_module_errors }, - { Messages = [] } + ModuleName = DefaultModuleName, + Items = [], + Error = no_module_errors, + Messages = [] ; read_all_items(DefaultModuleName, ModuleName, - Messages, Items, Error) + Messages, Items, Error, !IO) ), - io__set_input_stream(OldInputStream, ModuleInputStream), - io__close_input(ModuleInputStream) + io__set_input_stream(OldInputStream, ModuleInputStream, !IO), + io__close_input(ModuleInputStream, !IO) ; - { OpenResult = error(Message0) }, - io__progname_base("mercury_compile", Progname), - { - Message = Progname ++ ": " ++ Message0, - dummy_term(Term), - Messages = [Message - Term], - Error = fatal_module_errors, - Items = [], - ModuleName = DefaultModuleName, - MaybeFileData = no, - MaybeModuleTimestamp = no - } + OpenResult = error(Message0), + io__progname_base("mercury_compile", Progname, !IO), + Message = Progname ++ ": " ++ Message0, + dummy_term(Term), + Messages = [Message - Term], + Error = fatal_module_errors, + Items = [], + ModuleName = DefaultModuleName, + MaybeFileData = no, + MaybeModuleTimestamp = no ). -search_for_file(Dirs, FileName, Result) --> - search_for_file_returning_dir(Dirs, FileName, Result0), - { +search_for_file(Dirs, FileName, Result, !IO) :- + search_for_file_returning_dir(Dirs, FileName, Result0, !IO), + ( Result0 = ok(Dir), ( dir__this_directory(Dir) -> PathName = FileName @@ -408,55 +404,56 @@ search_for_file(Dirs, FileName, Result) --> ; Result0 = error(Message), Result = error(Message) - }. + ). -search_for_file_returning_dir(Dirs, FileName, R) --> - search_for_file_returning_dir(Dirs, Dirs, FileName, R). +search_for_file_returning_dir(Dirs, FileName, R, !IO) :- + search_for_file_returning_dir(Dirs, Dirs, FileName, R, !IO). :- pred search_for_file_returning_dir(list(dir_name)::in, list(dir_name)::in, file_name::in, maybe_error(dir_name)::out, io::di, io::uo) is det. -search_for_file_returning_dir([], AllDirs, FileName, error(Msg)) --> - { Msg = append_list(["cannot find `", FileName, "' in directories ", - string__join_list(", ", AllDirs)]) }. -search_for_file_returning_dir([Dir | Dirs], AllDirs, FileName, R) --> - { dir__this_directory(Dir) -> +search_for_file_returning_dir([], AllDirs, FileName, error(Msg), !IO) :- + Msg = append_list(["cannot find `", FileName, "' in directories ", + string__join_list(", ", AllDirs)]). +search_for_file_returning_dir([Dir | Dirs], AllDirs, FileName, R, !IO) :- + ( dir__this_directory(Dir) -> ThisFileName = FileName ; ThisFileName = dir__make_path_name(Dir, FileName) - }, - io__see(ThisFileName, R0), - ( { R0 = ok } -> - { R = ok(Dir) } + ), + io__see(ThisFileName, R0, !IO), + ( R0 = ok -> + R = ok(Dir) ; - search_for_file_returning_dir(Dirs, AllDirs, FileName, R) + search_for_file_returning_dir(Dirs, AllDirs, FileName, R, !IO) ). -search_for_module_source(Dirs, ModuleName, MaybeFileName) --> - search_for_module_source(Dirs, ModuleName, ModuleName, MaybeFileName). +search_for_module_source(Dirs, ModuleName, MaybeFileName, !IO) :- + search_for_module_source(Dirs, ModuleName, ModuleName, MaybeFileName, + !IO). :- pred search_for_module_source(list(dir_name)::in, module_name::in, module_name::in, maybe_error(file_name)::out, io::di, io::uo) is det. -search_for_module_source(Dirs, ModuleName, PartialModuleName, Result) --> - module_name_to_file_name(PartialModuleName, ".m", no, FileName), - search_for_file(Dirs, FileName, Result0), +search_for_module_source(Dirs, ModuleName, PartialModuleName, Result, !IO) :- + module_name_to_file_name(PartialModuleName, ".m", no, FileName, !IO), + search_for_file(Dirs, FileName, Result0, !IO), ( - { Result0 = ok(_) }, - { Result = Result0 } + Result0 = ok(_), + Result = Result0 ; - { Result0 = error(_) }, + Result0 = error(_), ( - { PartialModuleName1 = - drop_one_qualifier(PartialModuleName) } + PartialModuleName1 = + drop_one_qualifier(PartialModuleName) -> search_for_module_source(Dirs, ModuleName, - PartialModuleName1, Result) + PartialModuleName1, Result, !IO) ; - { sym_name_to_string(ModuleName, ModuleNameStr) }, - { Result = error("can't find source for module `" ++ - ModuleNameStr ++ "'") } + sym_name_to_string(ModuleName, ModuleNameStr), + Result = error("can't find source for module `" ++ + ModuleNameStr ++ "'") ) ). @@ -571,47 +568,47 @@ dummy_term_with_context(Context, Term) :- %-----------------------------------------------------------------------------% -find_module_name(FileName, MaybeModuleName) --> - io__open_input(FileName, OpenRes), +find_module_name(FileName, MaybeModuleName, !IO) :- + io__open_input(FileName, OpenRes, !IO), ( - { OpenRes = ok(InputStream) }, - io__set_input_stream(InputStream, OldInputStream), - { string__remove_suffix(FileName, ".m", PartialFileName0) -> + OpenRes = ok(InputStream), + io__set_input_stream(InputStream, OldInputStream, !IO), + ( string__remove_suffix(FileName, ".m", PartialFileName0) -> PartialFileName = PartialFileName0 ; PartialFileName = FileName - }, - { dir__basename(PartialFileName, BaseName0) -> + ), + ( dir__basename(PartialFileName, BaseName0) -> BaseName = BaseName0 ; BaseName = "" - }, - { file_name_to_module_name(BaseName, DefaultModuleName) }, + ), + file_name_to_module_name(BaseName, DefaultModuleName), read_first_item(DefaultModuleName, FileName, - ModuleName, RevMessages, _, _, _), - { MaybeModuleName = yes(ModuleName) }, - prog_out__write_messages(list__reverse(RevMessages)), - io__set_input_stream(OldInputStream, _), - io__close_input(InputStream) + ModuleName, RevMessages, _, _, _, !IO), + MaybeModuleName = yes(ModuleName), + prog_out__write_messages(list__reverse(RevMessages), !IO), + io__set_input_stream(OldInputStream, _, !IO), + io__close_input(InputStream, !IO) ; - { OpenRes = error(Error) }, - io__progname_base("mercury_compile", Progname), - io__write_string(Progname), - io__write_string(": error opening `"), - io__write_string(FileName), - io__write_string("': "), - io__write_string(io__error_message(Error)), - io__write_string(".\n"), - { MaybeModuleName = no } + OpenRes = error(Error), + io__progname_base("mercury_compile", Progname, !IO), + io__write_string(Progname, !IO), + io__write_string(": error opening `", !IO), + io__write_string(FileName, !IO), + io__write_string("': ", !IO), + io__write_string(io__error_message(Error), !IO), + io__write_string(".\n", !IO), + MaybeModuleName = no ). - % Read a source file from standard in, first reading in + % Read a source file from standard in, first reading in % the input term by term and then parsing those terms and producing % a high-level representation. % Parsing is actually a 3-stage process instead of the % normal two-stage process: % lexical analysis (chars -> tokens), - % parsing stage 1 (tokens -> terms), + % parsing stage 1 (tokens -> terms), % parsing stage 2 (terms -> items). % The final stage produces a list of program items, each of % which may be a declaration or a clause. @@ -774,28 +771,28 @@ read_first_item(DefaultModuleName, SourceFileName, ModuleName, Error = no_module_errors ). -:- pred make_module_decl(module_name, term__context, item_and_context). -:- mode make_module_decl(in, in, out) is det. +:- pred make_module_decl(module_name::in, term__context::in, + item_and_context::out) is det. make_module_decl(ModuleName, Context, Item - Context) :- varset__init(EmptyVarSet), ModuleDefn = module(ModuleName), Item = module_defn(EmptyVarSet, ModuleDefn). -:- pred maybe_add_warning(bool, read_term, term__context, string, - message_list, message_list). -:- mode maybe_add_warning(in, in, in, in, in, out) is det. +:- pred maybe_add_warning(bool::in, read_term::in, term__context::in, + string::in, message_list::in, message_list::out) is det. -maybe_add_warning(DoWarn, MaybeTerm, Context, Warning, Messages0, Messages) :- - ( DoWarn = yes -> +maybe_add_warning(DoWarn, MaybeTerm, Context, Warning, !Messages) :- + ( + DoWarn = yes, ( MaybeTerm = term(_VarSet, Term) -> WarningTerm = Term ; dummy_term_with_context(Context, WarningTerm) ), - add_warning(Warning, WarningTerm, Messages0, Messages) + add_warning(Warning, WarningTerm, !Messages) ; - Messages = Messages0 + DoWarn = no ). %-----------------------------------------------------------------------------% @@ -813,7 +810,7 @@ maybe_add_warning(DoWarn, MaybeTerm, Context, Warning, Messages0, Messages) :- read_items_loop(ModuleName, SourceFileName, !Msgs, !Items, !Error, !IO) :- read_item(ModuleName, SourceFileName, MaybeItem, !IO), - read_items_loop_2(MaybeItem, ModuleName, SourceFileName, + read_items_loop_2(MaybeItem, ModuleName, SourceFileName, !Msgs, !Items, !Error, !IO). %-----------------------------------------------------------------------------% @@ -846,7 +843,7 @@ read_items_loop_2(error(M, T), ModuleName, SourceFileName, !Msgs, !Items, % the list of messages and continue looping add_error(M, T, !Msgs), Error1 = some_module_errors, - read_items_loop(ModuleName, SourceFileName, !Msgs, !Items, + read_items_loop(ModuleName, SourceFileName, !Msgs, !Items, Error1, Error, !IO). read_items_loop_2(ok(Item0, Context), ModuleName0, SourceFileName0, @@ -902,7 +899,7 @@ read_items_loop_2(ok(Item0, Context), ModuleName0, SourceFileName0, ModuleName = ModuleName0, !:Items = [Item - Context | !.Items] ), - read_items_loop(ModuleName, SourceFileName, !Msgs, !Items, !Error, + read_items_loop(ModuleName, SourceFileName, !Msgs, !Items, !Error, !IO). %-----------------------------------------------------------------------------% @@ -910,38 +907,37 @@ read_items_loop_2(ok(Item0, Context), ModuleName0, SourceFileName0, % read_item/1 reads a single item, and if it is a valid term % parses it. -:- type maybe_item_or_eof ---> eof - ; syntax_error(file_name, int) - ; error(string, term) - ; ok(item, term__context). +:- type maybe_item_or_eof + ---> eof + ; syntax_error(file_name, int) + ; error(string, term) + ; ok(item, term__context). -:- pred read_item(module_name, file_name, maybe_item_or_eof, - io__state, io__state). -:- mode read_item(in, in, out, di, uo) is det. +:- pred read_item(module_name::in, file_name::in, maybe_item_or_eof::out, + io::di, io::uo) is det. -read_item(ModuleName, SourceFileName, MaybeItem) --> - parser__read_term(SourceFileName, MaybeTerm), - { process_read_term(ModuleName, MaybeTerm, MaybeItem) }. +read_item(ModuleName, SourceFileName, MaybeItem, !IO) :- + parser__read_term(SourceFileName, MaybeTerm, !IO), + process_read_term(ModuleName, MaybeTerm, MaybeItem). -:- pred process_read_term(module_name, read_term, maybe_item_or_eof). -:- mode process_read_term(in, in, out) is det. +:- pred process_read_term(module_name::in, read_term::in, + maybe_item_or_eof::out) is det. process_read_term(_ModuleName, eof, eof). process_read_term(_ModuleName, error(ErrorMsg, LineNumber), - syntax_error(ErrorMsg, LineNumber)). -process_read_term(ModuleName, term(VarSet, Term), - MaybeItemOrEof) :- + syntax_error(ErrorMsg, LineNumber)). +process_read_term(ModuleName, term(VarSet, Term), MaybeItemOrEof) :- parse_item(ModuleName, VarSet, Term, MaybeItem), convert_item(MaybeItem, MaybeItemOrEof). -:- pred convert_item(maybe_item_and_context, maybe_item_or_eof). -:- mode convert_item(in, out) is det. +:- pred convert_item(maybe_item_and_context::in, maybe_item_or_eof::out) + is det. convert_item(ok(Item, Context), ok(Item, Context)). convert_item(error(M, T), error(M, T)). parse_item(ModuleName, VarSet, Term, Result) :- - ( %%% some [Decl, DeclContext] + ( %%% some [Decl, DeclContext] Term = term__functor(term__atom(":-"), [Decl], _DeclContext) -> % It's a declaration @@ -982,7 +978,7 @@ parse_item(ModuleName, VarSet, Term, Result) :- parse_goal(Body, Body2, ProgVarSet, ProgVarSet2), ( Head = term__functor(term__atom("="), - [FuncHead0, FuncResult], _), + [FuncHead0, FuncResult], _), FuncHead = desugar_field_access(FuncHead0) -> parse_implicitly_qualified_term(ModuleName, @@ -997,8 +993,8 @@ parse_item(ModuleName, VarSet, Term, Result) :- add_context(R3, TheContext, Result) ). -:- pred process_pred_clause(maybe_functor, prog_varset, goal, maybe1(item)). -:- mode process_pred_clause(in, in, in, out) is det. +:- pred process_pred_clause(maybe_functor::in, prog_varset::in, goal::in, + maybe1(item)::out) is det. process_pred_clause(ok(Name, Args0), VarSet, Body, ok(clause(VarSet, predicate, Name, Args, Body))) :- @@ -1006,9 +1002,8 @@ process_pred_clause(ok(Name, Args0), VarSet, Body, process_pred_clause(error(ErrMessage, Term0), _, _, error(ErrMessage, Term)) :- term__coerce(Term0, Term). -:- pred process_func_clause(maybe_functor, term, prog_varset, goal, - maybe1(item)). -:- mode process_func_clause(in, in, in, in, out) is det. +:- pred process_func_clause(maybe_functor::in, term::in, prog_varset::in, + goal::in, maybe1(item)::out) is det. process_func_clause(ok(Name, Args0), Result0, VarSet, Body, ok(clause(VarSet, function, Name, Args, Body))) :- @@ -1047,9 +1042,8 @@ parse_decl(ModuleName, VarSet, F, Result) :- % representation of that declaration. Attributes is a list % of enclosing declaration attributes, in the order innermost to % outermost. -:- pred parse_decl_2(module_name, varset, term, decl_attrs, - maybe_item_and_context). -:- mode parse_decl_2(in, in, in, in, out) is det. +:- pred parse_decl_2(module_name::in, varset::in, term::in, decl_attrs::in, + maybe_item_and_context::out) is det. parse_decl_2(ModuleName, VarSet, F, Attributes, Result) :- ( @@ -1078,9 +1072,8 @@ parse_decl_2(ModuleName, VarSet, F, Attributes, Result) :- % representation of that declaration. Attributes is a list % of enclosing declaration attributes, in the order outermost to % innermost. -:- pred process_decl(module_name, varset, string, list(term), decl_attrs, - maybe1(item)). -:- mode process_decl(in, in, in, in, in, out) is semidet. +:- pred process_decl(module_name::in, varset::in, string::in, list(term)::in, + decl_attrs::in, maybe1(item)::out) is semidet. process_decl(ModuleName, VarSet, "type", [TypeDecl], Attributes, Result) :- parse_type_decl(ModuleName, VarSet, TypeDecl, Attributes, Result). @@ -1251,7 +1244,7 @@ process_decl(DefaultModuleName, VarSet0, "include_module", [ModuleNames], Result0 = ok(ModuleNameSyms), varset__coerce(VarSet0, VarSet), Result1 = ok(module_defn(VarSet, - include_module(ModuleNameSyms))) + include_module(ModuleNameSyms))) ; Result0 = error(A, B), Result1 = error(A, B) @@ -1290,12 +1283,12 @@ process_decl(ModuleName, VarSet, "promise", Assertion, Attributes, Result):- process_decl(ModuleName, VarSet, "promise_exclusive", PromiseGoal, Attributes, Result):- parse_promise(ModuleName, exclusive, VarSet, PromiseGoal, Attributes, - Result). + Result). process_decl(ModuleName, VarSet, "promise_exhaustive", PromiseGoal, Attributes, Result):- parse_promise(ModuleName, exhaustive, VarSet, PromiseGoal, Attributes, - Result). + Result). process_decl(ModuleName, VarSet, "promise_exclusive_exhaustive", PromiseGoal, Attributes, Result):- @@ -1344,11 +1337,11 @@ process_decl(ModuleName, VarSet0, "version_numbers", ; ( VersionNumberTerm = term__functor(_, _, Context) -> - Msg = -"interface file needs to be recreated, the version numbers are out of date", + Msg = "interface file needs to be recreated, " ++ + "the version numbers are out of date", dummy_term_with_context(Context, DummyTerm), Warning = item_warning(yes(warn_smart_recompilation), - Msg, DummyTerm), + Msg, DummyTerm), Result = ok(nothing(yes(Warning))) ; Result = error( @@ -1357,8 +1350,8 @@ process_decl(ModuleName, VarSet0, "version_numbers", ) ). -:- pred parse_decl_attribute(string, list(term), decl_attribute, term). -:- mode parse_decl_attribute(in, in, out, out) is semidet. +:- pred parse_decl_attribute(string::in, list(term)::in, decl_attribute::out, + term::out) is semidet. parse_decl_attribute("impure", [Decl], purity(impure), Decl). parse_decl_attribute("semipure", [Decl], purity(semipure), Decl). @@ -1374,8 +1367,8 @@ parse_decl_attribute("all", [TVars, Decl], parse_list_of_vars(TVars, TVarsList). parse_decl_attribute("solver", [Decl], solver_type, Decl). -:- pred check_no_attributes(maybe1(T), decl_attrs, maybe1(T)). -:- mode check_no_attributes(in, in, out) is det. +:- pred check_no_attributes(maybe1(T)::in, decl_attrs::in, maybe1(T)::out) + is det. check_no_attributes(Result0, Attributes, Result) :- ( @@ -1389,8 +1382,7 @@ check_no_attributes(Result0, Attributes, Result) :- Result = Result0 ). -:- pred attribute_description(decl_attribute, string). -:- mode attribute_description(in, out) is det. +:- pred attribute_description(decl_attribute::in, string::out) is det. attribute_description(purity(_), "purity specifier"). attribute_description(quantifier(univ, _), "universal quantifier (`all')"). @@ -1402,9 +1394,8 @@ attribute_description(solver_type, "solver type specifier"). %-----------------------------------------------------------------------------% -:- pred parse_promise(module_name, promise_type, varset, list(term), decl_attrs, - maybe1(item)). -:- mode parse_promise(in, in, in, in, in, out) is semidet. +:- pred parse_promise(module_name::in, promise_type::in, varset::in, + list(term)::in, decl_attrs::in, maybe1(item)::out) is semidet. parse_promise(ModuleName, PromiseType, VarSet, [Term], Attributes, Result) :- varset__coerce(VarSet, ProgVarSet0), @@ -1420,7 +1411,7 @@ parse_promise(ModuleName, PromiseType, VarSet, [Term], Attributes, Result) :- Goal = Goal0 ) ; - get_quant_vars(univ, ModuleName, Attributes, [], _, UnivVars0), + get_quant_vars(univ, ModuleName, Attributes, _, [], UnivVars0), list__map(term__coerce_var, UnivVars0, UnivVars), Goal0 = Goal ), @@ -1429,8 +1420,8 @@ parse_promise(ModuleName, PromiseType, VarSet, [Term], Attributes, Result) :- %-----------------------------------------------------------------------------% -:- pred parse_type_decl(module_name, varset, term, decl_attrs, maybe1(item)). -:- mode parse_type_decl(in, in, in, in, out) is det. +:- pred parse_type_decl(module_name::in, varset::in, term::in, decl_attrs::in, + maybe1(item)::out) is det. parse_type_decl(ModuleName, VarSet, TypeDecl, Attributes, Result) :- ( @@ -1444,50 +1435,47 @@ parse_type_decl(ModuleName, VarSet, TypeDecl, Attributes, Result) :- process_abstract_type(ModuleName, TypeDecl, Attributes, R1), Cond1 = true ), - process_maybe1(make_type_defn(VarSet, Cond1), R1, Result). - % we should check the condition for errs + % We should check the condition for errors % (don't bother at the moment, since we ignore - % conditions anyhow :-) + % conditions anyhow :-). + process_maybe1(make_type_defn(VarSet, Cond1), R1, Result). -:- pred make_type_defn(varset, condition, processed_type_body, item). -:- mode make_type_defn(in, in, in, out) is det. +:- pred make_type_defn(varset::in, condition::in, processed_type_body::in, + item::out) is det. make_type_defn(VarSet0, Cond, processed_type_body(Name, Args, TypeDefn), type_defn(VarSet, Name, Args, TypeDefn, Cond)) :- varset__coerce(VarSet0, VarSet). -:- pred make_external(varset, sym_name_specifier, item). -:- mode make_external(in, in, out) is det. +:- pred make_external(varset::in, sym_name_specifier::in, item::out) is det. make_external(VarSet0, SymSpec, module_defn(VarSet, external(SymSpec))) :- varset__coerce(VarSet0, VarSet). -:- pred get_is_solver_type(decl_attrs, is_solver_type, decl_attrs). -:- mode get_is_solver_type(in, out, out) is det. +:- pred get_is_solver_type(is_solver_type::out, + decl_attrs::in, decl_attrs::out) is det. -get_is_solver_type(Attributes0, IsSolverType, Attributes) :- - ( Attributes0 = [solver_type - _ | Attributes1] -> - IsSolverType = solver_type, - Attributes = Attributes1 +get_is_solver_type(IsSolverType, !Attributes) :- + ( !.Attributes = [solver_type - _ | !:Attributes] -> + IsSolverType = solver_type ; - IsSolverType = non_solver_type, - Attributes = Attributes0 + IsSolverType = non_solver_type ). %-----------------------------------------------------------------------------% % add a warning message to the list of messages -:- pred add_warning(string, term, message_list, message_list). -:- mode add_warning(in, in, in, out) is det. +:- pred add_warning(string::in, term::in, message_list::in, message_list::out) + is det. add_warning(Warning, Term, Msgs, [Msg - Term | Msgs]) :- string__append("Warning: ", Warning, Msg). % add an error message to the list of messages -:- pred add_error(string, term, message_list, message_list). -:- mode add_error(in, in, in, out) is det. +:- pred add_error(string::in, term::in, message_list::in, message_list::out) + is det. add_error(Error, Term, Msgs, [Msg - Term | Msgs]) :- string__append("Error: ", Error, Msg). @@ -1498,18 +1486,18 @@ add_error(Error, Term, Msgs, [Msg - Term | Msgs]) :- % to the condition for that declaration (if any), and Result to % a representation of the declaration. -:- pred parse_type_decl_type(module_name, string, list(term), decl_attrs, - condition, maybe1(processed_type_body)). -:- mode parse_type_decl_type(in, in, in, in, out, out) is semidet. +:- pred parse_type_decl_type(module_name::in, string::in, list(term)::in, + decl_attrs::in, condition::out, maybe1(processed_type_body)::out) + is semidet. parse_type_decl_type(ModuleName, "--->", [H, B], Attributes0, Condition, Result) :- get_condition(B, Body, Condition), - get_is_solver_type(Attributes0, IsSolverType, Attributes), + get_is_solver_type(IsSolverType, Attributes0, Attributes), ( IsSolverType = solver_type, Result = error("a solver type cannot have data constructors", - H) + H) ; IsSolverType = non_solver_type, du_type_rhs_ctors_and_where_terms(Body, CtorsTerm, @@ -1521,8 +1509,7 @@ parse_type_decl_type(ModuleName, "--->", [H, B], Attributes0, Condition, ; CtorsResult = ok(Ctors), WhereResult = parse_type_decl_where_term( - non_solver_type, ModuleName, - MaybeWhereTerm), + non_solver_type, ModuleName, MaybeWhereTerm), ( WhereResult = error(String, Term), Result = error(String, Term) @@ -1530,13 +1517,13 @@ parse_type_decl_type(ModuleName, "--->", [H, B], Attributes0, Condition, % The code to process `where' % attributes will return an error % result if solver attributes are - % given for a non-solver type. + % given for a non-solver type. % Because this is a du type, if the % unification with WhereResult % succeeds then _NoSolverTypeDetails % is guaranteed to be `no'. WhereResult = ok(_NoSolverTypeDetails, - MaybeUserEqComp), + MaybeUserEqComp), process_du_type(ModuleName, H, Body, Ctors, MaybeUserEqComp, Result0), check_no_attributes(Result0, Attributes, @@ -1553,11 +1540,11 @@ parse_type_decl_type(ModuleName, "==", [H, B], Attributes, Condition, R) :- parse_type_decl_type(ModuleName, "where", [H, B], Attributes0, Condition, R) :- get_condition(B, Body, Condition), - get_is_solver_type(Attributes0, IsSolverType, Attributes), + get_is_solver_type(IsSolverType, Attributes0, Attributes), ( IsSolverType = non_solver_type, R = error("only solver types can be defined " ++ - "by a `where' block alone", H) + "by a `where' block alone", H) ; IsSolverType = solver_type, R0 = parse_type_decl_where_term(solver_type, ModuleName, @@ -1573,18 +1560,18 @@ parse_type_decl_type(ModuleName, "where", [H, B], Attributes0, Condition, ) ). - :- pred du_type_rhs_ctors_and_where_terms(term::in, - term::out, maybe(term)::out) is det. + term::out, maybe(term)::out) is det. du_type_rhs_ctors_and_where_terms(Term, CtorsTerm, MaybeWhereTerm) :- - ( if Term = term__functor(term__atom("where"), + ( + Term = term__functor(term__atom("where"), [CtorsTerm0, WhereTerm], _Context) - then - CtorsTerm = CtorsTerm0, + -> + CtorsTerm = CtorsTerm0, MaybeWhereTerm = yes(WhereTerm) - else - CtorsTerm = Term, + ; + CtorsTerm = Term, MaybeWhereTerm = no ). @@ -1593,9 +1580,8 @@ du_type_rhs_ctors_and_where_terms(Term, CtorsTerm, MaybeWhereTerm) :- % parse_type_decl_pred(ModuleName, VarSet, Pred, Attributes, Result) % succeeds if Pred is a predicate type declaration, and binds Result % to a representation of the declaration. -:- pred parse_type_decl_pred(module_name, varset, term, decl_attrs, - maybe1(item)). -:- mode parse_type_decl_pred(in, in, in, in, out) is det. +:- pred parse_type_decl_pred(module_name::in, varset::in, term::in, + decl_attrs::in, maybe1(item)::out) is det. parse_type_decl_pred(ModuleName, VarSet, Pred, Attributes, R) :- get_condition(Pred, Body, Condition), @@ -1612,8 +1598,7 @@ parse_type_decl_pred(ModuleName, VarSet, Pred, Attributes, R) :- decl_attrs::in, maybe1(item)::out) is det. process_type_decl_pred_or_func(PredOrFunc, ModuleName, WithType, WithInst0, - MaybeDeterminism0, VarSet, Body, - Condition, Attributes, R) :- + MaybeDeterminism0, VarSet, Body, Condition, Attributes, R) :- ( MaybeDeterminism0 = ok(MaybeDeterminism), ( @@ -1657,9 +1642,8 @@ process_type_decl_pred_or_func(PredOrFunc, ModuleName, WithType, WithInst0, % parse_type_decl_func(ModuleName, Varset, Func, Attributes, Result) % succeeds if Func is a function type declaration, and binds Result to % a representation of the declaration. -:- pred parse_type_decl_func(module_name, varset, term, decl_attrs, - maybe1(item)). -:- mode parse_type_decl_func(in, in, in, in, out) is det. +:- pred parse_type_decl_func(module_name::in, varset::in, term::in, + decl_attrs::in, maybe1(item)::out) is det. parse_type_decl_func(ModuleName, VarSet, Func, Attributes, R) :- get_condition(Func, Body, Condition), @@ -1699,8 +1683,8 @@ parse_mode_decl_pred(ModuleName, VarSet, Pred, Attributes, Result) :- MaybeDeterminism, Result) ) ; - WithInst0 = error(E, T), - Result = error(E, T) + WithInst0 = error(E, T), + Result = error(E, T) ) ; MaybeDeterminism0 = error(E, T), @@ -1709,7 +1693,7 @@ parse_mode_decl_pred(ModuleName, VarSet, Pred, Attributes, Result) :- %-----------------------------------------------------------------------------% - % The optional `where ...' part of the type definition syntax + % The optional `where ...' part of the type definition syntax % is a comma separated list of special type `attributes'. % % The possible attributes (in this order) are either @@ -1729,23 +1713,22 @@ parse_type_decl_where_part_if_present(IsSolverType, ModuleName, Term0, Term, Result) :- ( Term0 = term__functor(term__atom("where"), [Term1, WhereTerm], - _Context) + _Context) -> Term = Term1, Result = parse_type_decl_where_term(IsSolverType, ModuleName, - yes(WhereTerm)) + yes(WhereTerm)) ; Term = Term0, Result = ok(no, no) ). - % The maybe2 wrapper allows us to return an error code or a pair % of results. Either result half may be empty, hence the maybe % wrapper around each of those. % :- func parse_type_decl_where_term(is_solver_type, module_name, maybe(term)) = - maybe2(maybe(solver_type_details), maybe(unify_compare)). + maybe2(maybe(solver_type_details), maybe(unify_compare)). parse_type_decl_where_term(_IsSolverType, _ModuleName, no) = ok(no, no). @@ -1796,7 +1779,6 @@ parse_type_decl_where_term(IsSolverType, ModuleName, MaybeTerm0 @ yes(Term)) = Term ). - % parse_where_attribute(Parser, Result, MaybeTerm0, MaybeTerm) % handles % - where MaybeTerm0 may contain nothing @@ -1807,8 +1789,7 @@ parse_type_decl_where_term(IsSolverType, ModuleName, MaybeTerm0 @ yes(Term)) = % was a comma-separated pair. % :- pred parse_where_attribute((func(term) = maybe1(maybe(T)))::in, - maybe1(maybe(T))::out, maybe(term)::in, maybe(term)::out) - is det. + maybe1(maybe(T))::out, maybe(term)::in, maybe(term)::out) is det. parse_where_attribute(_Parser, ok(no), no, no ). @@ -1833,12 +1814,11 @@ parse_where_attribute( Parser, Result, yes(Term0), MaybeRest) :- MaybeRest = MaybeRestIfYes ). - % Parser for `where ...' attributes of the form % `attributename is attributevalue'. % :- func parse_where_is(string, func(term) = maybe1(T), term) = - maybe1(maybe(T)). + maybe1(maybe(T)). parse_where_is(Name, Parser, Term) = Result :- ( @@ -1862,46 +1842,42 @@ parse_where_is(Name, Parser, Term) = Result :- Result = error("expected is/2", Term) ). - :- func parse_where_type_is_abstract_noncanonical(term) = maybe1(maybe(unit)). parse_where_type_is_abstract_noncanonical(Term) = ( Term = term__functor(term__atom( - "type_is_abstract_noncanonical"), [], _Context) + "type_is_abstract_noncanonical"), [], _Context) -> ok(yes(unit)) ; ok(no) ). - :- func parse_where_initialisation_is(module_name, term) = - maybe1(maybe(sym_name)). + maybe1(maybe(sym_name)). parse_where_initialisation_is(ModuleName, Term) = Result :- Result0 = parse_where_is("initialisation", - parse_where_pred_is(ModuleName), Term), + parse_where_pred_is(ModuleName), Term), ( Result0 = ok(no) -> Result = parse_where_is("initialization", - parse_where_pred_is(ModuleName), Term) + parse_where_pred_is(ModuleName), Term) ; Result = Result0 ). - :- func parse_where_pred_is(module_name, term) = maybe1(sym_name). parse_where_pred_is(ModuleName, Term) = Result :- parse_implicitly_qualified_symbol_name(ModuleName, Term, Result). - :- func parse_where_inst_is(module_name, term) = maybe1(inst). parse_where_inst_is(_ModuleName, Term) = - ( + ( prog_io_util__convert_inst(no_allow_constrained_inst_var, Term, Inst), not inst_util__inst_contains_unconstrained_var(Inst) @@ -1911,20 +1887,16 @@ parse_where_inst_is(_ModuleName, Term) = error("expected a ground, unconstrained inst", Term) ). - :- func parse_where_type_is(module_name, term) = maybe1(type). parse_where_type_is(_ModuleName, Term) = ok(Type) :- prog_io_util__convert_type(Term, Type). - :- pred parse_where_end(maybe(term)::in, maybe1(maybe(unit))::out) is det. parse_where_end(no, ok(yes(unit))). - parse_where_end(yes(Term), error("attributes are either badly ordered or " ++ - "contain an unrecognised attribute", Term)). - + "contain an unrecognised attribute", Term)). :- func make_maybe_where_details( is_solver_type, @@ -1996,10 +1968,11 @@ make_maybe_where_details( EqualityIsResult = ok(no), ComparisonIsResult = ok(no) -> - Result = ok(no, yes(abstract_noncanonical_type(IsSolverType))) + Result = ok(no, + yes(abstract_noncanonical_type(IsSolverType))) ; - Result = error("`where type_is_abstract_noncanonical' " ++ - " excludes other `where ...' attributes", + Result = error("`where type_is_abstract_noncanonical' " + ++ " excludes other `where ...' attributes", WhereTerm) ) ; @@ -2040,8 +2013,8 @@ make_maybe_where_details( ; AnyIsResult = ok(yes(_)) ) -> - Result = error("solver type attribute given for non-solver type", - WhereTerm) + Result = error("solver type attribute given for " ++ + "non-solver type", WhereTerm) ; EqualityIsResult = ok(MaybeEqPred), ComparisonIsResult = ok(MaybeCmpPred) @@ -2052,14 +2025,13 @@ make_maybe_where_details( "shouldn't have reached this point!") ). - % get_determinism(Term0, Term, Determinism) binds Determinism % to a representation of the determinism condition of Term0, if any, % and binds Term to the other part of Term0. If Term0 does not % contain a determinism, then Determinism is bound to `unspecified'. -:- pred get_determinism(term, term, maybe1(maybe(determinism))). -:- mode get_determinism(in, out, out) is det. +:- pred get_determinism(term::in, term::out, maybe1(maybe(determinism))::out) + is det. get_determinism(B, Body, Determinism) :- ( @@ -2083,19 +2055,18 @@ get_determinism(B, Body, Determinism) :- % Process the `with_inst` part of a declaration of the form: % :- mode p(int) `with_inst` (pred(in, out) is det). -:- pred get_with_inst(term, term, maybe1(maybe(inst))). -:- mode get_with_inst(in, out, out) is det. +:- pred get_with_inst(term::in, term::out, maybe1(maybe(inst))::out) is det. get_with_inst(Body0, Body, WithInst) :- ( Body0 = term__functor(term__atom("with_inst"), - [Body1, Inst1], _) + [Body1, Inst1], _) -> ( convert_inst(allow_constrained_inst_var, Inst1, Inst) -> WithInst = ok(yes(Inst)) ; WithInst = error("invalid inst in `with_inst`", - Body0) + Body0) ), Body = Body1 ; @@ -2103,8 +2074,7 @@ get_with_inst(Body0, Body, WithInst) :- WithInst = ok(no) ). -:- pred get_with_type(term, term, maybe(type)). -:- mode get_with_type(in, out, out) is det. +:- pred get_with_type(term::in, term::out, maybe(type)::out) is det. get_with_type(Body0, Body, WithType) :- ( @@ -2126,8 +2096,7 @@ get_with_type(Body0, Body, WithType) :- % and binds Term to the other part of Term0. If Term0 does not % contain a condition, then Condition is bound to true. -:- pred get_condition(term, term, condition). -:- mode get_condition(in, out, out) is det. +:- pred get_condition(term::in, term::out, condition::out) is det. get_condition(Body, Body, true). @@ -2140,12 +2109,12 @@ get_condition(Body, Body, true). % There is some code here to support that sort of thing, but % probably we would now need to use a different syntax, since % Mercury now uses `where' for different purposes (e.g. specifying -% user-defined equality predicates; also for type classes, eventually...) +% user-defined equality predicates, and also for type classes ...) % get_condition(B, Body, Condition) :- ( B = term__functor(term__atom("where"), [Body1, Condition1], - _Context) + _Context) -> Body = Body1, Condition = where(Condition1) @@ -2158,17 +2127,17 @@ get_condition(B, Body, Condition) :- %-----------------------------------------------------------------------------% :- type processed_type_body - ---> processed_type_body( - sym_name, - list(type_param), - type_defn - ). + ---> processed_type_body( + sym_name, + list(type_param), + type_defn + ). %-----------------------------------------------------------------------------% :- pred process_solver_type(module_name::in, term::in, - maybe(solver_type_details)::in, maybe(unify_compare)::in, - maybe1(processed_type_body)::out) is det. + maybe(solver_type_details)::in, maybe(unify_compare)::in, + maybe1(processed_type_body)::out) is det. process_solver_type(ModuleName, Head, MaybeSolverTypeDetails, MaybeUserEqComp, Result) :- @@ -2183,37 +2152,38 @@ process_solver_type(ModuleName, Head, MaybeSolverTypeDetails, MaybeUserEqComp, Result0 = ok(Name, Args0), ( RepnType = SolverTypeDetails ^ - representation_type, + representation_type, term__contains_var(RepnType, Var), not term__contains_var_list(Args0, term__coerce_var(Var)) -> Result = error("free type variable in " ++ - "representation type", Head) + "representation type", Head) ; list__map(term__coerce, Args0, Args), Result = ok(processed_type_body(Name, Args, - solver_type(SolverTypeDetails, - MaybeUserEqComp))) + solver_type(SolverTypeDetails, + MaybeUserEqComp))) ) ) ; MaybeSolverTypeDetails = no, - Result = error("solver type with no solver_type_details", - Head) + Result = error("solver type with no solver_type_details", Head) ). %-----------------------------------------------------------------------------% % This is for "Head == Body" (equivalence) definitions. -:- pred process_eqv_type(module_name, term, term, maybe1(processed_type_body)). -:- mode process_eqv_type(in, in, in, out) is det. +:- pred process_eqv_type(module_name::in, term::in, term::in, + maybe1(processed_type_body)::out) is det. + process_eqv_type(ModuleName, Head, Body, Result) :- parse_type_defn_head(ModuleName, Head, Body, Result0), process_eqv_type_2(Result0, Body, Result). :- pred process_eqv_type_2(maybe_functor::in, term::in, - maybe1(processed_type_body)::out) is det. + maybe1(processed_type_body)::out) is det. + process_eqv_type_2(error(Error, Term), _, error(Error, Term)). process_eqv_type_2(ok(Name, Args0), Body0, Result) :- % check that all the variables in the body occur in the head @@ -2224,7 +2194,7 @@ process_eqv_type_2(ok(Name, Args0), Body0, Result) :- ) -> Result = error("free type parameter in RHS of " ++ - "type definition", Body0) + "type definition", Body0) ; list__map(term__coerce, Args0, Args), convert_type(Body0, Body), @@ -2234,15 +2204,15 @@ process_eqv_type_2(ok(Name, Args0), Body0, Result) :- %-----------------------------------------------------------------------------% % process_du_type(ModuleName, TypeHead, TypeBody, - % MaybeUserEqComp, Result) + % MaybeUserEqComp, Result) % checks that its arguments are well formed, and if they are, % binds Result to a representation of the type information about the % TypeHead. % This is for "Head ---> Body [where ...]" (constructor) definitions. :- pred process_du_type(module_name::in, term::in, term::in, - list(constructor)::in, maybe(unify_compare)::in, - maybe1(processed_type_body)::out) is det. + list(constructor)::in, maybe(unify_compare)::in, + maybe1(processed_type_body)::out) is det. process_du_type(ModuleName, Head, Body, Ctors, MaybeUserEqComp, Result) :- parse_type_defn_head(ModuleName, Head, Body, Result0), @@ -2255,10 +2225,9 @@ process_du_type(ModuleName, Head, Body, Ctors, MaybeUserEqComp, Result) :- MaybeUserEqComp, Result) ). - :- pred process_du_type_2(sym_name::in, list(term)::in, term::in, - list(constructor)::in, maybe(unify_compare)::in, - maybe1(processed_type_body)::out) is det. + list(constructor)::in, maybe(unify_compare)::in, + maybe1(processed_type_body)::out) is det. process_du_type_2(Functor, Args0, Body, Ctors, MaybeUserEqComp, Result) :- @@ -2270,15 +2239,14 @@ process_du_type_2(Functor, Args0, Body, Ctors, MaybeUserEqComp, Result) :- % or occur in the head. ( list__member(Ctor, Ctors), - Ctor = ctor(ExistQVars, _Constraints, _CtorName, - CtorArgs), + Ctor = ctor(ExistQVars, _Constraints, _CtorName, CtorArgs), assoc_list__values(CtorArgs, CtorArgTypes), term__contains_var_list(CtorArgTypes, Var), \+ list__member(Var, ExistQVars), \+ term__contains_var_list(Args, Var) -> Result = error("free type parameter in RHS of " ++ - "type definition", Body) + "type definition", Body) % check that all type variables in existential quantifiers % do not occur in the head @@ -2286,29 +2254,27 @@ process_du_type_2(Functor, Args0, Body, Ctors, MaybeUserEqComp, Result) :- % If we were to allow it, we would need to rename them apart.) ; list__member(Ctor, Ctors), - Ctor = ctor(ExistQVars, _Constraints, _CtorName, - _CtorArgs), + Ctor = ctor(ExistQVars, _Constraints, _CtorName, _CtorArgs), list__member(Var, ExistQVars), term__contains_var_list(Args, Var) -> - Result = error( "type variable has overlapping " ++ - "scopes (explicit type quantifier " ++ - "shadows argument type)", Body) + Result = error("type variable has overlapping " ++ + "scopes (explicit type quantifier " ++ + "shadows argument type)", Body) % check that all type variables in existential quantifiers % occur somewhere in the constructor argument types % (not just the constraints) ; list__member(Ctor, Ctors), - Ctor = ctor(ExistQVars, _Constraints, _CtorName, - CtorArgs), + Ctor = ctor(ExistQVars, _Constraints, _CtorName, CtorArgs), list__member(Var, ExistQVars), assoc_list__values(CtorArgs, CtorArgTypes), \+ term__contains_var_list(CtorArgTypes, Var) -> Result = error("type variable in existential " ++ - "quantifier does not occur in " ++ - "arguments of constructor", Body) + "quantifier does not occur in " ++ + "arguments of constructor", Body) % check that all type variables in existential constraints % occur in the existential quantifiers % (XXX is this check overly conservative? Perhaps we should @@ -2318,21 +2284,20 @@ process_du_type_2(Functor, Args0, Body, Ctors, MaybeUserEqComp, Result) :- % existentially quantified.) ; list__member(Ctor, Ctors), - Ctor = ctor(ExistQVars, Constraints, _CtorName, - _CtorArgs), + Ctor = ctor(ExistQVars, Constraints, _CtorName, _CtorArgs), list__member(Constraint, Constraints), Constraint = constraint(_Name, ConstraintArgs), term__contains_var_list(ConstraintArgs, Var), \+ list__member(Var, ExistQVars) -> Result = error("type variables in class " ++ - "constraints introduced " ++ - "with `=>' must be explicitly " ++ - "existentially quantified " ++ - "using `some'", Body) + "constraints introduced " ++ + "with `=>' must be explicitly " ++ + "existentially quantified " ++ + "using `some'", Body) ; Result = ok(processed_type_body(Functor, Args, - du_type(Ctors, MaybeUserEqComp))) + du_type(Ctors, MaybeUserEqComp))) ). %-----------------------------------------------------------------------------% @@ -2342,19 +2307,19 @@ process_du_type_2(Functor, Args0, Body, Ctors, MaybeUserEqComp, Result) :- % binds Result to a representation of the type information about the % TypeHead. -:- pred process_abstract_type(module_name, term, decl_attrs, - maybe1(processed_type_body)). -:- mode process_abstract_type(in, in, in, out) is det. +:- pred process_abstract_type(module_name::in, term::in, decl_attrs::in, + maybe1(processed_type_body)::out) is det. + process_abstract_type(ModuleName, Head, Attributes0, Result) :- dummy_term(Body), parse_type_defn_head(ModuleName, Head, Body, Result0), - get_is_solver_type(Attributes0, IsSolverType, Attributes), + get_is_solver_type(IsSolverType, Attributes0, Attributes), process_abstract_type_2(Result0, IsSolverType, Result1), check_no_attributes(Result1, Attributes, Result). -:- pred process_abstract_type_2(maybe_functor, is_solver_type, - maybe1(processed_type_body)). -:- mode process_abstract_type_2(in, in, out) is det. +:- pred process_abstract_type_2(maybe_functor::in, is_solver_type::in, + maybe1(processed_type_body)::out) is det. + process_abstract_type_2(error(Error, Term), _, error(Error, Term)). process_abstract_type_2(ok(Functor, Args0), IsSolverType, ok(processed_type_body(Functor, Args, @@ -2381,14 +2346,16 @@ parse_type_defn_head(ModuleName, Head, Body, Result) :- parse_type_defn_head_2(R, Head, Result) ). -:- pred parse_type_defn_head_2(maybe_functor, term, maybe_functor). -:- mode parse_type_defn_head_2(in, in, out) is det. +:- pred parse_type_defn_head_2(maybe_functor::in, term::in, maybe_functor::out) + is det. + parse_type_defn_head_2(error(Msg, Term), _, error(Msg, Term)). parse_type_defn_head_2(ok(Name, Args), Head, Result) :- parse_type_defn_head_3(Name, Args, Head, Result). -:- pred parse_type_defn_head_3(sym_name, list(term), term, maybe_functor). -:- mode parse_type_defn_head_3(in, in, in, out) is det. +:- pred parse_type_defn_head_3(sym_name::in, list(term)::in, term::in, + maybe_functor::out) is det. + parse_type_defn_head_3(Name, Args, Head, Result) :- % check that all the head args are variables ( %%% some [Arg] @@ -2400,7 +2367,7 @@ parse_type_defn_head_3(Name, Args, Head, Result) :- Result = error("type parameters must be variables", Head) ; % check that all the head arg variables are distinct - %%% some [Arg2, OtherArgs] + %%% some [Arg2, OtherArgs] ( list__member(Arg2, Args, [Arg2|OtherArgs]), list__member(Arg2, OtherArgs) @@ -2433,9 +2400,8 @@ convert_constructors(ModuleName, Body) = Result :- % true if input argument is a valid list of constructors - :- func convert_constructors_2(module_name, list(term)) = - maybe1(list(constructor)). + maybe1(list(constructor)). convert_constructors_2(_ModuleName, []) = ok([]). @@ -2456,31 +2422,28 @@ convert_constructors_2( ModuleName, [Term | Terms]) = Result :- ) ). - -:- func convert_constructor(module_name, term) = - maybe1(constructor). +:- func convert_constructor(module_name, term) = maybe1(constructor). convert_constructor(ModuleName, Term0) = Result :- ( - Term0 = term__functor(term__atom("some"), [Vars, Term1], - _Context) + Term0 = term__functor(term__atom("some"), [Vars, Term1], + _Context) -> ( parse_list_of_vars(Vars, ExistQVars0) -> list__map(term__coerce_var, ExistQVars0, ExistQVars), Result = convert_constructor_2(ModuleName, ExistQVars, - Term0, Term1) + Term0, Term1) ; Result = error("syntax error in variable list", Term0) ) ; ExistQVars = [], Result = convert_constructor_2(ModuleName, ExistQVars, - Term0, Term0) + Term0, Term0) ). - :- func convert_constructor_2(module_name, list(tvar), term, term) = maybe1(constructor). @@ -2498,19 +2461,18 @@ convert_constructor_2(ModuleName, ExistQVars, Term0, Term1) = Result :- % This is to allow you to define ';'/2 and 'some'/2 % constructors. Term2 = term__functor(term__atom("{}"), [Term3], - _Context) + _Context) -> Term4 = Term3 ; Term4 = Term2 ), Result = convert_constructor_3(ModuleName, ExistQVars, - Constraints, Term0, Term4) + Constraints, Term0, Term4) ). - :- func convert_constructor_3(module_name, list(tvar), - list(class_constraint), term, term) = maybe1(constructor). + list(class_constraint), term, term) = maybe1(constructor). convert_constructor_3(ModuleName, ExistQVars, Constraints, Term0, Term1) = Result :- @@ -2536,10 +2498,9 @@ convert_constructor_3(ModuleName, ExistQVars, Constraints, Term0, Term1) = % parse a `:- pred p(...)' declaration or a % `:- func f(...) `with_type` t' declaration -:- pred process_pred_or_func(pred_or_func, module_name, varset, term, - condition, maybe(type), maybe(inst), maybe(determinism), - decl_attrs, maybe1(item)). -:- mode process_pred_or_func(in, in, in, in, in, in, in, in, in, out) is det. +:- pred process_pred_or_func(pred_or_func::in, module_name::in, varset::in, + term::in, condition::in, maybe(type)::in, maybe(inst)::in, + maybe(determinism)::in, decl_attrs::in, maybe1(item)::out) is det. process_pred_or_func(PredOrFunc, ModuleName, VarSet, PredType, Cond, WithType, WithInst, MaybeDet, Attributes0, Result) :- @@ -2589,7 +2550,7 @@ process_pred_or_func_2(PredOrFunc, ok(F, As0), PredType, VarSet0, pred_or_func_decl_string(PredOrFunc), PredType) ; - get_purity(Attributes0, Purity, Attributes), + get_purity(Purity, Attributes0, Attributes), varset__coerce(VarSet0, TVarSet), varset__coerce(VarSet0, IVarSet), Result0 = ok(pred_or_func(TVarSet, IVarSet, @@ -2611,16 +2572,13 @@ process_pred_or_func_2(PredOrFunc, ok(F, As0), PredType, VarSet0, process_pred_or_func_2(_, error(M, T), _, _, _, _, _, _, _, _, _, _, error(M, T)). -:- pred get_purity(decl_attrs, purity, decl_attrs). -:- mode get_purity(in, out, out) is det. +:- pred get_purity(purity::out, decl_attrs::in, decl_attrs::out) is det. -get_purity(Attributes0, Purity, Attributes) :- - ( Attributes0 = [purity(Purity0) - _ | Attributes1] -> - Purity = Purity0, - Attributes = Attributes1 +get_purity(Purity, !Attributes) :- + ( !.Attributes = [purity(Purity0) - _ | !:Attributes] -> + Purity = Purity0 ; - Purity = (pure), - Attributes = Attributes0 + Purity = (pure) ). :- func pred_or_func_decl_string(pred_or_func) = string. @@ -2644,9 +2602,9 @@ pred_or_func_decl_string(predicate) = "`:- pred' declaration". % error). % Attributes is bound to the remaining attributes. -:- pred get_class_context_and_inst_constraints(module_name, decl_attrs, - decl_attrs, maybe3(existq_tvars, class_constraints, inst_var_sub)). -:- mode get_class_context_and_inst_constraints(in, in, out, out) is det. +:- pred get_class_context_and_inst_constraints(module_name::in, + decl_attrs::in, decl_attrs::out, + maybe3(existq_tvars, class_constraints, inst_var_sub)::out) is det. get_class_context_and_inst_constraints(ModuleName, RevAttributes0, RevAttributes, MaybeContext) :- @@ -2660,7 +2618,7 @@ get_class_context_and_inst_constraints(ModuleName, RevAttributes0, % 2. existential quantifiers some 950 % 3. universal constraints <= 920 % 4. existential constraints => 920 [*] - % 5. the decl itself pred or func 800 + % 5. the decl itself pred or func 800 % % When we reach here, Attributes0 contains declaration attributes % in the opposite order -- innermost to outermost -- so we reverse @@ -2685,24 +2643,23 @@ get_class_context_and_inst_constraints(ModuleName, RevAttributes0, % error message.) list__reverse(RevAttributes0, Attributes0), - get_quant_vars(univ, ModuleName, Attributes0, [], - Attributes1, _UnivQVars), - get_quant_vars(exist, ModuleName, Attributes1, [], - Attributes2, ExistQVars0), + get_quant_vars(univ, ModuleName, Attributes0, Attributes1, + [], _UnivQVars), + get_quant_vars(exist, ModuleName, Attributes1, Attributes2, + [], ExistQVars0), list__map(term__coerce_var, ExistQVars0, ExistQVars), get_constraints(univ, ModuleName, Attributes2, - Attributes3, MaybeUnivConstraints), + Attributes3, MaybeUnivConstraints), get_constraints(exist, ModuleName, Attributes3, - Attributes, MaybeExistConstraints), + Attributes, MaybeExistConstraints), list__reverse(Attributes, RevAttributes), combine_quantifier_results(MaybeUnivConstraints, MaybeExistConstraints, - ExistQVars, MaybeContext). + ExistQVars, MaybeContext). -:- pred combine_quantifier_results(maybe_class_and_inst_constraints, - maybe_class_and_inst_constraints, existq_tvars, - maybe3(existq_tvars, class_constraints, inst_var_sub)). -:- mode combine_quantifier_results(in, in, in, out) is det. +:- pred combine_quantifier_results(maybe_class_and_inst_constraints::in, + maybe_class_and_inst_constraints::in, existq_tvars::in, + maybe3(existq_tvars, class_constraints, inst_var_sub)::out) is det. combine_quantifier_results(error(Msg, Term), _, _, error(Msg, Term)). combine_quantifier_results(ok(_, _), error(Msg, Term), _, error(Msg, Term)). @@ -2711,70 +2668,61 @@ combine_quantifier_results(ok(UnivConstraints, InstConstraints0), ok(ExistQVars, constraints(UnivConstraints, ExistConstraints), InstConstraints0 `map__merge` InstConstraints1)). -:- pred get_quant_vars(quantifier_type, module_name, decl_attrs, list(var), - decl_attrs, list(var)). -:- mode get_quant_vars(in, in, in, in, out, out) is det. +:- pred get_quant_vars(quantifier_type::in, module_name::in, + decl_attrs::in, decl_attrs::out, list(var)::in, list(var)::out) is det. -get_quant_vars(QuantType, ModuleName, Attributes0, Vars0, - Attributes, Vars) :- +get_quant_vars(QuantType, ModuleName, !Attributes, !Vars) :- ( - Attributes0 = [quantifier(QuantType, Vars1) - _ | Attributes1] + !.Attributes = [quantifier(QuantType, QuantVars) - _ + | !:Attributes] -> - list__append(Vars0, Vars1, Vars2), - get_quant_vars(QuantType, ModuleName, Attributes1, Vars2, - Attributes, Vars) + list__append(!.Vars, QuantVars, !:Vars), + get_quant_vars(QuantType, ModuleName, !Attributes, !Vars) ; - Attributes = Attributes0, - Vars = Vars0 + true ). -:- pred get_constraints(quantifier_type, module_name, decl_attrs, decl_attrs, - maybe_class_and_inst_constraints). -:- mode get_constraints(in, in, in, out, out) is det. +:- pred get_constraints(quantifier_type::in, module_name::in, decl_attrs::in, + decl_attrs::out, maybe_class_and_inst_constraints::out) is det. -get_constraints(QuantType, ModuleName, Attributes0, Attributes, - MaybeConstraints) :- +get_constraints(QuantType, ModuleName, !Attributes, MaybeConstraints) :- ( - Attributes0 = [constraints(QuantType, ConstraintsTerm) - _Term - | Attributes1] + !.Attributes = [constraints(QuantType, ConstraintsTerm) - _Term + | !:Attributes] -> parse_class_and_inst_constraints(ModuleName, ConstraintsTerm, MaybeConstraints0), % there may be more constraints of the same type -- % collect them all and combine them - get_constraints(QuantType, ModuleName, Attributes1, - Attributes, MaybeConstraints1), + get_constraints(QuantType, ModuleName, !Attributes, + MaybeConstraints1), combine_constraint_list_results(MaybeConstraints1, MaybeConstraints0, MaybeConstraints) ; - Attributes = Attributes0, MaybeConstraints = ok([], map__init) ). -:- pred combine_constraint_list_results(maybe_class_and_inst_constraints, - maybe_class_and_inst_constraints, maybe_class_and_inst_constraints). -:- mode combine_constraint_list_results(in, in, out) is det. +:- pred combine_constraint_list_results(maybe_class_and_inst_constraints::in, + maybe_class_and_inst_constraints::in, + maybe_class_and_inst_constraints::out) is det. combine_constraint_list_results(error(Msg, Term), _, error(Msg, Term)). combine_constraint_list_results(ok(_, _), error(Msg, Term), error(Msg, Term)). combine_constraint_list_results(ok(CC0, IC0), ok(CC1, IC1), ok(CC0 ++ CC1, IC0 `map__merge` IC1)). -:- pred get_existential_constraints_from_term(module_name, term, term, - maybe1(list(class_constraint))). -:- mode get_existential_constraints_from_term(in, in, out, out) is det. +:- pred get_existential_constraints_from_term(module_name::in, + term::in, term::out, maybe1(list(class_constraint))::out) is det. -get_existential_constraints_from_term(ModuleName, PredType0, PredType, +get_existential_constraints_from_term(ModuleName, !PredType, MaybeExistentialConstraints) :- ( - PredType0 = term__functor(term__atom("=>"), - [PredType1, ExistentialConstraints], _) + !.PredType = term__functor(term__atom("=>"), + [!:PredType, ExistentialConstraints], _) -> - PredType = PredType1, parse_class_constraints(ModuleName, ExistentialConstraints, MaybeExistentialConstraints) ; - PredType = PredType0, MaybeExistentialConstraints = ok([]) ). @@ -2783,15 +2731,14 @@ get_existential_constraints_from_term(ModuleName, PredType0, PredType, % Verify that among the arguments of a :- pred declaration, % either all arguments specify a mode or none of them do. -:- pred verify_type_and_mode_list(list(type_and_mode)). -:- mode verify_type_and_mode_list(in) is semidet. +:- pred verify_type_and_mode_list(list(type_and_mode)::in) is semidet. verify_type_and_mode_list([]). verify_type_and_mode_list([First | Rest]) :- verify_type_and_mode_list_2(Rest, First). -:- pred verify_type_and_mode_list_2(list(type_and_mode), type_and_mode). -:- mode verify_type_and_mode_list_2(in, in) is semidet. +:- pred verify_type_and_mode_list_2(list(type_and_mode)::in, type_and_mode::in) + is semidet. verify_type_and_mode_list_2([], _). verify_type_and_mode_list_2([Head | Tail], First) :- @@ -2808,9 +2755,8 @@ verify_type_and_mode_list_2([Head | Tail], First) :- % parse a `:- func p(...)' declaration -:- pred process_func(module_name, varset, term, condition, - maybe(determinism), decl_attrs, maybe1(item)). -:- mode process_func(in, in, in, in, in, in, out) is det. +:- pred process_func(module_name::in, varset::in, term::in, condition::in, + maybe(determinism)::in, decl_attrs::in, maybe1(item)::out) is det. process_func(ModuleName, VarSet, Term, Cond, MaybeDet, Attributes0, Result) :- get_class_context_and_inst_constraints(ModuleName, Attributes0, @@ -2825,16 +2771,16 @@ process_func(ModuleName, VarSet, Term, Cond, MaybeDet, Attributes0, Result) :- Result = error(String, ErrorTerm) ). -:- pred process_func_2(module_name, varset, term, condition, - maybe(determinism), existq_tvars, class_constraints, inst_var_sub, - decl_attrs, maybe1(item)). -:- mode process_func_2(in, in, in, in, in, in, in, in, in, out) is det. +:- pred process_func_2(module_name::in, varset::in, term::in, condition::in, + maybe(determinism)::in, existq_tvars::in, class_constraints::in, + inst_var_sub::in, decl_attrs::in, maybe1(item)::out) is det. process_func_2(ModuleName, VarSet, Term, Cond, MaybeDet, - ExistQVars, Constraints, InstConstraints, Attributes, Result) :- + ExistQVars, Constraints, InstConstraints, Attributes, + Result) :- ( Term = term__functor(term__atom("="), - [FuncTerm0, ReturnTypeTerm], _Context), + [FuncTerm0, ReturnTypeTerm], _Context), FuncTerm = desugar_field_access(FuncTerm0) -> parse_implicitly_qualified_term(ModuleName, FuncTerm, Term, @@ -2879,7 +2825,7 @@ process_func_3(ok(F, As0), FuncTerm, ReturnTypeTerm, FullTerm, VarSet0, "but function arguments don't", FuncTerm) ; - get_purity(Attributes0, Purity, Attributes), + get_purity(Purity, Attributes0, Attributes), varset__coerce(VarSet0, TVarSet), varset__coerce(VarSet0, IVarSet), list__append(As, [ReturnType], Args), @@ -2915,25 +2861,25 @@ process_func_3(error(M, T), _, _, _, _, _, _, _, _, _, _, error(M, T)). % Perform one of the following field-access syntax rewrites if % possible: % - % A ^ f(B, ...) ---> f(B, ..., A) - % (A ^ f(B, ...) := X) ---> 'f :='(B, ..., A, X) + % A ^ f(B, ...) ---> f(B, ..., A) + % (A ^ f(B, ...) := X) ---> 'f :='(B, ..., A, X) % :- func desugar_field_access(term) = term. desugar_field_access(Term) = - ( if + ( Term = functor(atom("^"), [A, RHS], _), RHS = functor(atom(FieldName), Bs, Context) - then - functor(atom(FieldName), Bs ++ [A], Context) - else if + -> + functor(atom(FieldName), Bs ++ [A], Context) + ; Term = functor(atom(":="), [LHS, X], _), LHS = functor(atom("^"), [A, RHS], Context), RHS = functor(atom(FieldName), Bs, Context) - then - functor(atom(FieldName ++ " :="), Bs ++ [A, X], Context) - else - Term + -> + functor(atom(FieldName ++ " :="), Bs ++ [A, X], Context) + ; + Term ). %-----------------------------------------------------------------------------% @@ -2944,8 +2890,8 @@ desugar_field_access(Term) = decl_attrs::in, maybe(inst)::in, maybe(determinism)::in, maybe1(item)::out) is det. -process_mode(ModuleName, VarSet, Term, Cond, Attributes, - WithInst, MaybeDet, Result) :- +process_mode(ModuleName, VarSet, Term, Cond, Attributes, WithInst, MaybeDet, + Result) :- ( WithInst = no, Term = term__functor(term__atom("="), @@ -2953,7 +2899,7 @@ process_mode(ModuleName, VarSet, Term, Cond, Attributes, FuncTerm = desugar_field_access(FuncTerm0) -> parse_implicitly_qualified_term(ModuleName, FuncTerm, Term, - "function `:- mode' declaration", R), + "function `:- mode' declaration", R), process_func_mode(R, ModuleName, FuncTerm, ReturnTypeTerm, Term, VarSet, MaybeDet, Cond, Attributes, Result) ; @@ -2973,7 +2919,7 @@ process_pred_or_func_mode(ok(F, As0), ModuleName, PredMode, VarSet0, WithInst, convert_mode_list(allow_constrained_inst_var, As0, As1) -> get_class_context_and_inst_constraints(ModuleName, Attributes0, - Attributes, MaybeConstraints), + Attributes, MaybeConstraints), ( MaybeConstraints = ok(_, _, InstConstraints), list__map(constrain_inst_vars_in_mode(InstConstraints), @@ -3069,8 +3015,8 @@ constrain_inst_vars_in_mode(InstConstraints, user_defined_mode(Name, Args0), user_defined_mode(Name, Args)) :- list__map(constrain_inst_vars_in_inst(InstConstraints), Args0, Args). -:- pred constrain_inst_vars_in_inst(inst_var_sub, inst, inst). -:- mode constrain_inst_vars_in_inst(in, in, out) is det. +:- pred constrain_inst_vars_in_inst(inst_var_sub::in, (inst)::in, (inst)::out) + is det. constrain_inst_vars_in_inst(_, any(U), any(U)). constrain_inst_vars_in_inst(_, free, free). @@ -3112,17 +3058,16 @@ constrain_inst_vars_in_inst(InstConstraints, abstract_inst(N, Is0), abstract_inst(N, Is)) :- list__map(constrain_inst_vars_in_inst(InstConstraints), Is0, Is). -:- pred constrain_inst_vars_in_pred_inst_info(inst_var_sub, pred_inst_info, - pred_inst_info). -:- mode constrain_inst_vars_in_pred_inst_info(in, in, out) is det. +:- pred constrain_inst_vars_in_pred_inst_info(inst_var_sub::in, + pred_inst_info::in, pred_inst_info::out) is det. constrain_inst_vars_in_pred_inst_info(InstConstraints, PII0, PII) :- PII0 = pred_inst_info(PredOrFunc, Modes0, Det), list__map(constrain_inst_vars_in_mode(InstConstraints), Modes0, Modes), PII = pred_inst_info(PredOrFunc, Modes, Det). -:- pred constrain_inst_vars_in_inst_name(inst_var_sub, inst_name, inst_name). -:- mode constrain_inst_vars_in_inst_name(in, in, out) is det. +:- pred constrain_inst_vars_in_inst_name(inst_var_sub::in, + inst_name::in, inst_name::out) is det. constrain_inst_vars_in_inst_name(InstConstraints, Name0, Name) :- ( Name0 = user_inst(SymName, Args0) -> @@ -3138,16 +3083,14 @@ constrain_inst_vars_in_inst_name(InstConstraints, Name0, Name) :- inst_var_constraints_are_consistent_in_modes(Modes) :- inst_var_constraints_are_consistent_in_modes(Modes, map__init, _). -:- pred inst_var_constraints_are_consistent_in_modes(list(mode), - inst_var_sub, inst_var_sub). -:- mode inst_var_constraints_are_consistent_in_modes(in, in, out) is semidet. +:- pred inst_var_constraints_are_consistent_in_modes(list(mode)::in, + inst_var_sub::in, inst_var_sub::out) is semidet. -inst_var_constraints_are_consistent_in_modes(Modes) --> - list__foldl(inst_var_constraints_are_consistent_in_mode, Modes). +inst_var_constraints_are_consistent_in_modes(Modes, !Sub) :- + list__foldl(inst_var_constraints_are_consistent_in_mode, Modes, !Sub). :- pred inst_var_constraints_are_consistent_in_type_and_modes( - list(type_and_mode)). -:- mode inst_var_constraints_are_consistent_in_type_and_modes(in) is semidet. + list(type_and_mode)::in) is semidet. inst_var_constraints_are_consistent_in_type_and_modes(TypeAndModes) :- list__foldl((pred(TypeAndMode::in, in, out) is semidet --> @@ -3156,52 +3099,53 @@ inst_var_constraints_are_consistent_in_type_and_modes(TypeAndModes) :- inst_var_constraints_are_consistent_in_mode(Mode) )), TypeAndModes, map__init, _). -:- pred inst_var_constraints_are_consistent_in_mode(mode, inst_var_sub, - inst_var_sub). -:- mode inst_var_constraints_are_consistent_in_mode(in, in, out) is semidet. +:- pred inst_var_constraints_are_consistent_in_mode((mode)::in, + inst_var_sub::in, inst_var_sub::out) is semidet. -inst_var_constraints_are_consistent_in_mode(InitialInst -> FinalInst) --> - inst_var_constraints_are_consistent_in_inst(InitialInst), - inst_var_constraints_are_consistent_in_inst(FinalInst). -inst_var_constraints_are_consistent_in_mode(user_defined_mode(_, ArgInsts)) --> - inst_var_constraints_are_consistent_in_insts(ArgInsts). +inst_var_constraints_are_consistent_in_mode(InitialInst -> FinalInst, !Sub) :- + inst_var_constraints_are_consistent_in_inst(InitialInst, !Sub), + inst_var_constraints_are_consistent_in_inst(FinalInst, !Sub). +inst_var_constraints_are_consistent_in_mode(user_defined_mode(_, ArgInsts), + !Sub) :- + inst_var_constraints_are_consistent_in_insts(ArgInsts, !Sub). -:- pred inst_var_constraints_are_consistent_in_insts(list(inst), inst_var_sub, - inst_var_sub). -:- mode inst_var_constraints_are_consistent_in_insts(in, in, out) is semidet. +:- pred inst_var_constraints_are_consistent_in_insts(list(inst)::in, + inst_var_sub::in, inst_var_sub::out) is semidet. -inst_var_constraints_are_consistent_in_insts(Insts) --> - list__foldl(inst_var_constraints_are_consistent_in_inst, Insts). +inst_var_constraints_are_consistent_in_insts(Insts, !Sub) :- + list__foldl(inst_var_constraints_are_consistent_in_inst, Insts, !Sub). -:- pred inst_var_constraints_are_consistent_in_inst(inst, inst_var_sub, - inst_var_sub). -:- mode inst_var_constraints_are_consistent_in_inst(in, in, out) is semidet. +:- pred inst_var_constraints_are_consistent_in_inst((inst)::in, + inst_var_sub::in, inst_var_sub::out) is semidet. -inst_var_constraints_are_consistent_in_inst(any(_)) --> []. -inst_var_constraints_are_consistent_in_inst(free) --> []. -inst_var_constraints_are_consistent_in_inst(free(_)) --> []. -inst_var_constraints_are_consistent_in_inst(bound(_, BoundInsts)) --> +inst_var_constraints_are_consistent_in_inst(any(_), !Sub). +inst_var_constraints_are_consistent_in_inst(free, !Sub). +inst_var_constraints_are_consistent_in_inst(free(_), !Sub). +inst_var_constraints_are_consistent_in_inst(bound(_, BoundInsts), !Sub) :- list__foldl((pred(functor(_, Insts)::in, in, out) is semidet --> inst_var_constraints_are_consistent_in_insts(Insts)), - BoundInsts). -inst_var_constraints_are_consistent_in_inst(ground(_, GroundInstInfo)) --> - ( { GroundInstInfo = none } - ; { GroundInstInfo = higher_order(pred_inst_info(_, Modes, _)) }, - inst_var_constraints_are_consistent_in_modes(Modes) - ). -inst_var_constraints_are_consistent_in_inst(not_reached) --> []. -inst_var_constraints_are_consistent_in_inst(inst_var(_)) --> - { error("inst_var_constraints_are_consistent_in_inst: unconstrained inst_var") }. -inst_var_constraints_are_consistent_in_inst(defined_inst(InstName)) --> - ( { InstName = user_inst(_, Insts) } -> - inst_var_constraints_are_consistent_in_insts(Insts) + BoundInsts, !Sub). +inst_var_constraints_are_consistent_in_inst(ground(_, GroundInstInfo), !Sub) :- + ( + GroundInstInfo = none ; - [] + GroundInstInfo = higher_order(pred_inst_info(_, Modes, _)), + inst_var_constraints_are_consistent_in_modes(Modes, !Sub) ). -inst_var_constraints_are_consistent_in_inst(abstract_inst(_, Insts)) --> - inst_var_constraints_are_consistent_in_insts(Insts). +inst_var_constraints_are_consistent_in_inst(not_reached, !Sub). +inst_var_constraints_are_consistent_in_inst(inst_var(_), !Sub) :- + error("inst_var_constraints_are_consistent_in_inst: " ++ + "unconstrained inst_var"). +inst_var_constraints_are_consistent_in_inst(defined_inst(InstName), !Sub) :- + ( InstName = user_inst(_, Insts) -> + inst_var_constraints_are_consistent_in_insts(Insts, !Sub) + ; + true + ). +inst_var_constraints_are_consistent_in_inst(abstract_inst(_, Insts), !Sub) :- + inst_var_constraints_are_consistent_in_insts(Insts, !Sub). inst_var_constraints_are_consistent_in_inst( - constrained_inst_vars(InstVars, Inst)) --> + constrained_inst_vars(InstVars, Inst), !Sub) :- set__fold((pred(InstVar::in, in, out) is semidet --> ( Inst0 =^ map__elem(InstVar) -> % Check that the inst_var constraint is consistent with @@ -3209,8 +3153,8 @@ inst_var_constraints_are_consistent_in_inst( { Inst = Inst0 } ; ^ map__elem(InstVar) := Inst - )), InstVars), - inst_var_constraints_are_consistent_in_inst(Inst). + )), InstVars, !Sub), + inst_var_constraints_are_consistent_in_inst(Inst, !Sub). %-----------------------------------------------------------------------------% @@ -3220,8 +3164,9 @@ inst_var_constraints_are_consistent_in_inst( % `=' as well. Since `=' was once the standard operator, make % sure warnings are given before it is phased out. % -:- pred parse_inst_decl(module_name, varset, term, maybe1(item)). -:- mode parse_inst_decl(in, in, in, out) is det. +:- pred parse_inst_decl(module_name::in, varset::in, term::in, + maybe1(item)::out) is det. + parse_inst_decl(ModuleName, VarSet, InstDefn, Result) :- ( InstDefn = term__functor(term__atom(Op), [H, B], _Context), @@ -3233,10 +3178,8 @@ parse_inst_decl(ModuleName, VarSet, InstDefn, Result) :- ; % XXX this is for `abstract inst' declarations, % which are not really supported - InstDefn = term__functor(term__atom("is"), [ - Head, - term__functor(term__atom("private"), [], _) - ], _) + InstDefn = term__functor(term__atom("is"), + [Head, term__functor(term__atom("private"), [], _)], _) -> Condition = true, convert_abstract_inst_defn(ModuleName, Head, R), @@ -3249,7 +3192,8 @@ parse_inst_decl(ModuleName, VarSet, InstDefn, Result) :- convert_inst_defn(ModuleName, H, Body1, R), process_maybe1(make_inst_defn(VarSet, Condition), R, Result) ; - Result = error("`==' expected in `:- inst' definition", InstDefn) + Result = error("`==' expected in `:- inst' definition", + InstDefn) ). % we should check the condition for errs % (don't bother at the moment, since we ignore @@ -3257,16 +3201,16 @@ parse_inst_decl(ModuleName, VarSet, InstDefn, Result) :- % Parse a `:- inst ---> .' definition. % -:- pred convert_inst_defn(module_name, term, term, maybe1(processed_inst_body)). -:- mode convert_inst_defn(in, in, in, out) is det. +:- pred convert_inst_defn(module_name::in, term::in, term::in, + maybe1(processed_inst_body)::out) is det. + convert_inst_defn(ModuleName, Head, Body, Result) :- parse_implicitly_qualified_term(ModuleName, Head, Body, "inst definition", R), convert_inst_defn_2(R, Head, Body, Result). -:- pred convert_inst_defn_2(maybe_functor, term, term, - maybe1(processed_inst_body)). -:- mode convert_inst_defn_2(in, in, in, out) is det. +:- pred convert_inst_defn_2(maybe_functor::in, term::in, term::in, + maybe1(processed_inst_body)::out) is det. convert_inst_defn_2(error(M, T), _, _, error(M, T)). convert_inst_defn_2(ok(Name, ArgTerms), Head, Body, Result) :- @@ -3322,23 +3266,23 @@ convert_inst_defn_2(ok(Name, ArgTerms), Head, Body, Result) :- ). :- type processed_inst_body - ---> processed_inst_body( - sym_name, - list(inst_var), - inst_defn - ). + ---> processed_inst_body( + sym_name, + list(inst_var), + inst_defn + ). + +:- pred convert_abstract_inst_defn(module_name::in, term::in, + maybe1(processed_inst_body)::out) is det. -:- pred convert_abstract_inst_defn(module_name, term, - maybe1(processed_inst_body)). -:- mode convert_abstract_inst_defn(in, in, out) is det. convert_abstract_inst_defn(ModuleName, Head, Result) :- parse_implicitly_qualified_term(ModuleName, Head, Head, "inst definition", R), convert_abstract_inst_defn_2(R, Head, Result). -:- pred convert_abstract_inst_defn_2(maybe_functor, term, - maybe1(processed_inst_body)). -:- mode convert_abstract_inst_defn_2(in, in, out) is det. +:- pred convert_abstract_inst_defn_2(maybe_functor::in, term::in, + maybe1(processed_inst_body)::out) is det. + convert_abstract_inst_defn_2(error(M, T), _, error(M, T)). convert_abstract_inst_defn_2(ok(Name, ArgTerms), Head, Result) :- ( @@ -3356,14 +3300,14 @@ convert_abstract_inst_defn_2(ok(Name, ArgTerms), Head, Result) :- ; list__map(term__coerce_var, Args, InstArgs), Result = ok(processed_inst_body(Name, InstArgs, - abstract_inst)) + abstract_inst)) ) ; Result = error("inst parameters must be variables", Head) ). -:- pred make_inst_defn(varset, condition, processed_inst_body, item). -:- mode make_inst_defn(in, in, in, out) is det. +:- pred make_inst_defn(varset::in, condition::in, processed_inst_body::in, + item::out) is det. make_inst_defn(VarSet0, Cond, processed_inst_body(Name, Params, InstDefn), inst_defn(VarSet, Name, Params, InstDefn, Cond)) :- @@ -3373,8 +3317,8 @@ make_inst_defn(VarSet0, Cond, processed_inst_body(Name, Params, InstDefn), % parse a `:- mode foo :: ...' or `:- mode foo = ...' definition. -:- pred parse_mode_decl(module_name, varset, term, decl_attrs, maybe1(item)). -:- mode parse_mode_decl(in, in, in, in, out) is det. +:- pred parse_mode_decl(module_name::in, varset::in, term::in, decl_attrs::in, + maybe1(item)::out) is det. parse_mode_decl(ModuleName, VarSet, ModeDefn, Attributes, Result) :- ( %%% some [H, B] @@ -3409,29 +3353,29 @@ parse_mode_decl(ModuleName, VarSet, ModeDefn, Attributes, Result) :- % Before phasing it out, a deprecated syntax warning should be % given for a version or two. % -:- pred mode_op(term, term, term). -:- mode mode_op(in, out, out) is semidet. +:- pred mode_op(term::in, term::out, term::out) is semidet. + mode_op(term__functor(term__atom(Op), [H, B], _), H, B) :- ( Op = "==" ; Op = "::" ). :- type processed_mode_body - ---> processed_mode_body( - sym_name, - list(inst_var), - mode_defn - ). + ---> processed_mode_body( + sym_name, + list(inst_var), + mode_defn + ). + +:- pred convert_mode_defn(module_name::in, term::in, term::in, + maybe1(processed_mode_body)::out) is det. -:- pred convert_mode_defn(module_name, term, term, - maybe1(processed_mode_body)). -:- mode convert_mode_defn(in, in, in, out) is det. convert_mode_defn(ModuleName, Head, Body, Result) :- parse_implicitly_qualified_term(ModuleName, Head, Head, "mode definition", R), convert_mode_defn_2(R, Head, Body, Result). -:- pred convert_mode_defn_2(maybe_functor, term, term, - maybe1(processed_mode_body)). -:- mode convert_mode_defn_2(in, in, in, out) is det. +:- pred convert_mode_defn_2(maybe_functor::in, term::in, term::in, + maybe1(processed_mode_body)::out) is det. + convert_mode_defn_2(error(M, T), _, _, error(M, T)). convert_mode_defn_2(ok(Name, ArgTerms), Head, Body, Result) :- ( @@ -3476,16 +3420,17 @@ convert_mode_defn_2(ok(Name, ArgTerms), Head, Body, Result) :- Result = error("mode parameters must be variables", Head) ). -:- pred convert_type_and_mode_list(inst_var_sub, list(term), - list(type_and_mode)). -:- mode convert_type_and_mode_list(in, in, out) is semidet. +:- pred convert_type_and_mode_list(inst_var_sub::in, list(term)::in, + list(type_and_mode)::out) is semidet. + convert_type_and_mode_list(_, [], []). convert_type_and_mode_list(InstConstraints, [H0|T0], [H|T]) :- convert_type_and_mode(InstConstraints, H0, H), convert_type_and_mode_list(InstConstraints, T0, T). -:- pred convert_type_and_mode(inst_var_sub, term, type_and_mode). -:- mode convert_type_and_mode(in, in, out) is semidet. +:- pred convert_type_and_mode(inst_var_sub::in, term::in, type_and_mode::out) + is semidet. + convert_type_and_mode(InstConstraints, Term, Result) :- ( Term = term__functor(term__atom("::"), [TypeTerm, ModeTerm], @@ -3500,8 +3445,9 @@ convert_type_and_mode(InstConstraints, Term, Result) :- Result = type_only(Type) ). -:- pred make_mode_defn(varset, condition, processed_mode_body, item). -:- mode make_mode_defn(in, in, in, out) is det. +:- pred make_mode_defn(varset::in, condition::in, processed_mode_body::in, + item::out) is det. + make_mode_defn(VarSet0, Cond, processed_mode_body(Name, Params, ModeDefn), mode_defn(VarSet, Name, Params, ModeDefn, Cond)) :- varset__coerce(VarSet0, VarSet). @@ -3511,21 +3457,21 @@ make_mode_defn(VarSet0, Cond, processed_mode_body(Name, Params, ModeDefn), :- type maker(T1, T2) == pred(T1, T2). :- mode maker :: pred(in, out) is det. -:- pred parse_symlist_decl(parser(T), maker(list(T), sym_list), - maker(sym_list, module_defn), - term, decl_attrs, varset, maybe1(item)). -:- mode parse_symlist_decl(parser, maker, maker, in, in, in, out) is det. +:- pred parse_symlist_decl(parser(T)::parser, maker(list(T), sym_list)::maker, + maker(sym_list, module_defn)::maker, + term::in, decl_attrs::in, varset::in, maybe1(item)::out) is det. parse_symlist_decl(ParserPred, MakeSymListPred, MakeModuleDefnPred, - Term, Attributes, VarSet, Result) :- + Term, Attributes, VarSet, Result) :- parse_list(ParserPred, Term, Result0), process_maybe1(make_module_defn(MakeSymListPred, MakeModuleDefnPred, - VarSet), Result0, Result1), + VarSet), Result0, Result1), check_no_attributes(Result1, Attributes, Result). -:- pred make_module_defn(maker(T, sym_list), maker(sym_list, module_defn), - varset, T, item). -:- mode make_module_defn(maker, maker, in, in, out) is det. +:- pred make_module_defn(maker(T, sym_list)::maker, + maker(sym_list, module_defn)::maker, varset::in, T::in, item::out) + is det. + make_module_defn(MakeSymListPred, MakeModuleDefnPred, VarSet0, T, module_defn(VarSet, ModuleDefn)) :- varset__coerce(VarSet0, VarSet), @@ -3595,8 +3541,7 @@ make_op(X, op(X)). % module(ModuleSpecifier) % Matches all symbols in the specified module. -:- pred parse_symbol_specifier(term, maybe1(sym_specifier)). -:- mode parse_symbol_specifier(in, out) is det. +:- pred parse_symbol_specifier(term::in, maybe1(sym_specifier)::out) is det. parse_symbol_specifier(MainTerm, Result) :- ( MainTerm = term__functor(term__atom(Functor), [Term], _Context) -> @@ -3638,37 +3583,44 @@ parse_symbol_specifier(MainTerm, Result) :- process_maybe1(make_cons_symbol_specifier, Result0, Result) ). -% Once we've parsed the appropriate type of symbol specifier, we +% Once we've parsed the appropriate type of symbol specifier, we % need to convert it to a sym_specifier. :- pred make_pred_symbol_specifier(pred_specifier::in, sym_specifier::out) is det. + make_pred_symbol_specifier(PredSpec, pred(PredSpec)). :- pred make_func_symbol_specifier(func_specifier::in, sym_specifier::out) is det. + make_func_symbol_specifier(FuncSpec, func(FuncSpec)). :- pred make_cons_symbol_specifier(cons_specifier::in, sym_specifier::out) is det. + make_cons_symbol_specifier(ConsSpec, cons(ConsSpec)). :- pred make_type_symbol_specifier(type_specifier::in, sym_specifier::out) is det. + make_type_symbol_specifier(TypeSpec, type(TypeSpec)). :- pred make_adt_symbol_specifier(adt_specifier::in, sym_specifier::out) is det. + make_adt_symbol_specifier(ADT_Spec, adt(ADT_Spec)). :- pred make_op_symbol_specifier(op_specifier::in, sym_specifier::out) is det. + make_op_symbol_specifier(OpSpec, op(OpSpec)). :- pred make_module_symbol_specifier(module_specifier::in, sym_specifier::out) is det. + make_module_symbol_specifier(ModuleSpec, module(ModuleSpec)). -:- pred cons_specifier_to_sym_specifier(cons_specifier, sym_specifier). -:- mode cons_specifier_to_sym_specifier(in, out) is det. +:- pred cons_specifier_to_sym_specifier(cons_specifier::in, + sym_specifier::out) is det. cons_specifier_to_sym_specifier(sym(SymSpec), sym(SymSpec)). cons_specifier_to_sym_specifier(typed(SymSpec), typed_sym(SymSpec)). @@ -3677,8 +3629,8 @@ cons_specifier_to_sym_specifier(typed(SymSpec), typed_sym(SymSpec)). % A ModuleSpecifier is just an sym_name. -:- pred parse_module_specifier(term, maybe1(module_specifier)). -:- mode parse_module_specifier(in, out) is det. +:- pred parse_module_specifier(term::in, maybe1(module_specifier)::out) is det. + parse_module_specifier(Term, Result) :- parse_symbol_name(Term, Result). @@ -3688,17 +3640,21 @@ parse_module_specifier(Term, Result) :- % as a special case, so that we can report a better error % message for that case. -:- pred parse_module_name(module_name, term, maybe1(module_name)). -:- mode parse_module_name(in, in, out) is det. +:- pred parse_module_name(module_name::in, term::in, + maybe1(module_name)::out) is det. + parse_module_name(DefaultModuleName, Term, Result) :- ( Term = term__variable(_) -> dummy_term(ErrorContext), - Result = error("module names starting with capital letters must be quoted using single quotes (e.g. "":- module 'Foo'."")", ErrorContext) + Result = error("module names starting with " ++ + "capital letters must be quoted using " ++ + "single quotes (e.g. "":- module 'Foo'."")", + ErrorContext) ; parse_implicitly_qualified_symbol_name(DefaultModuleName, - Term, Result) + Term, Result) ). %-----------------------------------------------------------------------------% @@ -3771,18 +3727,18 @@ process_typed_predicate_specifier(ok(Name, Args0), ok(Result)) :- ). process_typed_predicate_specifier(error(Msg, Term), error(Msg, Term)). -:- pred make_arity_predicate_specifier(sym_name_specifier, pred_specifier). -:- mode make_arity_predicate_specifier(in, out) is det. +:- pred make_arity_predicate_specifier(sym_name_specifier::in, + pred_specifier::out) is det. make_arity_predicate_specifier(Result, sym(Result)). %-----------------------------------------------------------------------------% -% Parsing the name & argument types of a constructor specifier is -% exactly the same as parsing a predicate specifier... +% Parsing the name & argument types of a constructor specifier is +% exactly the same as parsing a predicate specifier... -:- pred parse_arg_types_specifier(term, maybe1(pred_specifier)). -:- mode parse_arg_types_specifier(in, out) is det. +:- pred parse_arg_types_specifier(term::in, maybe1(pred_specifier)::out) + is det. parse_arg_types_specifier(Term, Result) :- ( @@ -3797,24 +3753,26 @@ parse_arg_types_specifier(Term, Result) :- process_typed_predicate_specifier(TermResult, Result) ). -% ... but we have to convert the result back into the appropriate -% format. +% ... but we have to convert the result back into the appropriate +% format. + +:- pred process_typed_constructor_specifier(maybe1(pred_specifier)::in, + maybe1(type)::in, maybe1(cons_specifier)::out) is det. -:- pred process_typed_constructor_specifier(maybe1(pred_specifier), - maybe1(type), maybe1(cons_specifier)). -:- mode process_typed_constructor_specifier(in, in, out) is det. process_typed_constructor_specifier(error(Msg, Term), _, error(Msg, Term)). process_typed_constructor_specifier(ok(_), error(Msg, Term), error(Msg, Term)). process_typed_constructor_specifier(ok(NameArgs), ok(ResType), ok(Result)) :- process_typed_cons_spec_2(NameArgs, ResType, Result). -:- pred process_typed_cons_spec_2(pred_specifier, type, cons_specifier). -:- mode process_typed_cons_spec_2(in, in, out) is det. +:- pred process_typed_cons_spec_2(pred_specifier::in, (type)::in, + cons_specifier::out) is det. + process_typed_cons_spec_2(sym(Name), Res, typed(name_res(Name, Res))). process_typed_cons_spec_2(name_args(Name, Args), Res, - typed(name_args_res(Name, Args, Res))). + typed(name_args_res(Name, Args, Res))). :- pred make_untyped_cons_spec(pred_specifier::in, cons_specifier::out) is det. + make_untyped_cons_spec(sym(Name), sym(Name)). make_untyped_cons_spec(name_args(Name, Args), typed(name_args(Name, Args))). @@ -3826,8 +3784,8 @@ make_untyped_cons_spec(name_args(Name, Args), typed(name_args(Name, Args))). % Matches only symbols of the specified arity. % -:- pred parse_symbol_name_specifier(term, maybe1(sym_name_specifier)). -:- mode parse_symbol_name_specifier(in, out) is det. +:- pred parse_symbol_name_specifier(term::in, maybe1(sym_name_specifier)::out) + is det. parse_symbol_name_specifier(Term, Result) :- root_module_name(DefaultModule), @@ -3839,7 +3797,7 @@ parse_symbol_name_specifier(Term, Result) :- parse_implicitly_qualified_symbol_name_specifier(DefaultModule, Term, Result) :- ( %%% some [NameTerm, ArityTerm, Context] - Term = term__functor(term__atom("/"), [NameTerm, ArityTerm], + Term = term__functor(term__atom("/"), [NameTerm, ArityTerm], _Context) -> ( %%% some [Arity, Context2] @@ -3894,7 +3852,7 @@ make_name_specifier(Name, name(Name)). parse_symbol_name(Term, Result) :- ( - Term = term__functor(term__atom(FunctorName), + Term = term__functor(term__atom(FunctorName), [ModuleTerm, NameTerm], _Context), ( FunctorName = ":" ; FunctorName = "." @@ -3932,9 +3890,8 @@ parse_symbol_name(Term, Result) :- ) ). -:- pred parse_implicitly_qualified_symbol_name(module_name, term, - maybe1(sym_name)). -:- mode parse_implicitly_qualified_symbol_name(in, in, out) is det. +:- pred parse_implicitly_qualified_symbol_name(module_name::in, term::in, + maybe1(sym_name)::out) is det. parse_implicitly_qualified_symbol_name(DefaultModName, Term, Result) :- parse_symbol_name(Term, Result0), @@ -3995,7 +3952,7 @@ parse_implicitly_qualified_term(DefaultModName, Term, ContainingTerm, Msg, parse_qualified_term(Term, ContainingTerm, Msg, Result) :- ( - Term = term__functor(term__atom(FunctorName), + Term = term__functor(term__atom(FunctorName), [ModuleTerm, NameArgsTerm], _), ( FunctorName = "." ; FunctorName = ":" @@ -4048,102 +4005,102 @@ parse_qualified_term(Term, ContainingTerm, Msg, Result) :- % predicates used to convert a sym_list to a program item :- pred make_use(sym_list::in, module_defn::out) is det. + make_use(Syms, use(Syms)). :- pred make_import(sym_list::in, module_defn::out) is det. + make_import(Syms, import(Syms)). :- pred make_export(sym_list::in, module_defn::out) is det. + make_export(Syms, export(Syms)). %-----------------------------------------------------------------------------% % A FuncSpecifier is just a constructur name specifier. -:- pred parse_function_specifier(term, maybe1(func_specifier)). -:- mode parse_function_specifier(in, out) is det. +:- pred parse_function_specifier(term::in, maybe1(func_specifier)::out) is det. + parse_function_specifier(Term, Result) :- parse_constructor_specifier(Term, Result). % A TypeSpecifier is just a symbol name specifier. -:- pred parse_type_specifier(term, maybe1(sym_name_specifier)). -:- mode parse_type_specifier(in, out) is det. +:- pred parse_type_specifier(term::in, maybe1(sym_name_specifier)::out) is det. + parse_type_specifier(Term, Result) :- parse_symbol_name_specifier(Term, Result). % An ADT_Specifier is just a symbol name specifier. -:- pred parse_adt_specifier(term, maybe1(sym_name_specifier)). -:- mode parse_adt_specifier(in, out) is det. +:- pred parse_adt_specifier(term::in, maybe1(sym_name_specifier)::out) is det. + parse_adt_specifier(Term, Result) :- parse_symbol_name_specifier(Term, Result). %-----------------------------------------------------------------------------% % For the moment, an OpSpecifier is just a symbol name specifier. -% XXX We should allow specifying the fixity of an operator +% XXX We should allow specifying the fixity of an operator + +:- pred parse_op_specifier(term::in, maybe1(op_specifier)::out) is det. -:- pred parse_op_specifier(term, maybe1(op_specifier)). -:- mode parse_op_specifier(in, out) is det. parse_op_specifier(Term, Result) :- parse_symbol_name_specifier(Term, R), process_maybe1(make_op_specifier, R, Result). :- pred make_op_specifier(sym_name_specifier::in, op_specifier::out) is det. + make_op_specifier(X, sym(X)). %-----------------------------------------------------------------------------% % types are represented just as ordinary terms -:- pred parse_type(term, maybe1(type)). -:- mode parse_type(in, out) is det. +:- pred parse_type(term::in, maybe1(type)::out) is det. + parse_type(T0, ok(T)) :- convert_type(T0, T). :- func convert_constructor_arg_list(module_name, list(term)) = - maybe1(list(constructor_arg)). + maybe1(list(constructor_arg)). convert_constructor_arg_list(_ModuleName, []) = ok([]). - convert_constructor_arg_list( ModuleName, [Term | Terms]) = Result :- ( Term = term__functor(term__atom("::"), [NameTerm, TypeTerm], - _) + _) -> parse_implicitly_qualified_term(ModuleName, NameTerm, Term, "field name", NameResult), ( NameResult = error(String1, Term1), - Result = error(String1, Term1) + Result = error(String1, Term1) ; NameResult = ok(_SymName, [_ | _]), - Result = error("syntax error in " ++ - "constructor name", Term) + Result = error("syntax error in constructor name", + Term) ; NameResult = ok(SymName, []), MaybeFieldName = yes(SymName), - Result = convert_constructor_arg_list_2( - ModuleName, MaybeFieldName, - TypeTerm, Terms) + Result = convert_constructor_arg_list_2(ModuleName, + MaybeFieldName, TypeTerm, Terms) ) ; MaybeFieldName = no, - TypeTerm = Term, - Result = convert_constructor_arg_list_2( - ModuleName, MaybeFieldName, - TypeTerm, Terms) + TypeTerm = Term, + Result = convert_constructor_arg_list_2(ModuleName, + MaybeFieldName, TypeTerm, Terms) ). - :- func convert_constructor_arg_list_2(module_name, maybe(sym_name), term, - list(term)) = maybe1(list(constructor_arg)). + list(term)) = maybe1(list(constructor_arg)). convert_constructor_arg_list_2(ModuleName, MaybeFieldName, TypeTerm, Terms) = Result :- convert_type(TypeTerm, Type), - Arg = MaybeFieldName - Type, + Arg = MaybeFieldName - Type, Result0 = convert_constructor_arg_list(ModuleName, Terms), ( Result0 = error(String, Term), @@ -4160,6 +4117,7 @@ convert_constructor_arg_list_2(ModuleName, MaybeFieldName, TypeTerm, Terms) = % if the default module is the root module then we don't add any qualifier. :- pred root_module_name(module_name::out) is det. + root_module_name(unqualified("")). %-----------------------------------------------------------------------------% diff --git a/compiler/prog_io_dcg.m b/compiler/prog_io_dcg.m index c0819091a..92ce74566 100644 --- a/compiler/prog_io_dcg.m +++ b/compiler/prog_io_dcg.m @@ -23,9 +23,8 @@ :- import_module parse_tree__prog_io_util. :- import_module varset, term. -:- pred parse_dcg_clause(module_name, varset, term, term, - prog_context, maybe_item_and_context). -:- mode parse_dcg_clause(in, in, in, in, in, out) is det. +:- pred parse_dcg_clause(module_name::in, varset::in, term::in, term::in, + prog_context::in, maybe_item_and_context::out) is det. % parse_dcg_pred_goal(GoalTerm, Goal, % DCGVarInitial, DCGVarFinal, VarSet0, Varset) @@ -156,7 +155,7 @@ parse_dcg_goal_2("{}", [G0 | Gs], Context, Goal, !VarSet, !Counter, !Var) :- % The parser treats '{}/N' terms as tuples, so we need % to undo the parsing of the argument conjunction here. list_to_conjunction(Context, G0, Gs, G), - parse_goal(G, Goal, !VarSet). + parse_goal(G, Goal, !VarSet). parse_dcg_goal_2("impure", [G], _, Goal, !VarSet, !Counter, !Var) :- parse_dcg_goal_with_purity(G, (impure), Goal, !VarSet, !Counter, !Var). parse_dcg_goal_2("semipure", [G], _, Goal, !VarSet, !Counter, !Var) :- @@ -209,9 +208,8 @@ parse_dcg_goal_2(":=", [A0], Context, Goal, !VarSet, !Counter, _Var0, Var) :- % ******/ % If-then (NU-Prolog syntax). -parse_dcg_goal_2("if", [ - term__functor(term__atom("then"), [Cond0, Then0], _) - ], Context, Goal, !VarSet, !Counter, Var0, Var) :- +parse_dcg_goal_2("if", [term__functor(term__atom("then"), [Cond0, Then0], _)], + Context, Goal, !VarSet, !Counter, Var0, Var) :- parse_dcg_if_then(Cond0, Then0, Context, SomeVars, StateVars, Cond, Then, !VarSet, !Counter, Var0, Var), ( Var = Var0 -> @@ -266,12 +264,10 @@ parse_dcg_goal_2(";", [A0, B0], Context, Goal, !VarSet, !Counter, Var0, Var) :- ). % If-then-else (NU-Prolog syntax). -parse_dcg_goal_2("else", [ - term__functor(term__atom("if"), [ - term__functor(term__atom("then"), [Cond0, Then0], _) - ], Context), - Else0 - ], _, Goal, !VarSet, !Counter, !Var) :- +parse_dcg_goal_2("else", [IF, Else0], _, Goal, !VarSet, !Counter, !Var) :- + IF = term__functor(term__atom("if"), + [term__functor(term__atom("then"), [Cond0, Then0], _)], + Context), parse_dcg_if_then_else(Cond0, Then0, Else0, Context, Goal, !VarSet, !Counter, !Var). @@ -489,9 +485,9 @@ term_list_append_term(List0, Term, List) :- List = Term ; List0 = term__functor(term__atom("[|]"), - [Head, Tail0], Context2), + [Head, Tail0], Context2), List = term__functor(term__atom("[|]"), - [Head, Tail], Context2), + [Head, Tail], Context2), term_list_append_term(Tail0, Term, Tail) ). diff --git a/compiler/prog_io_goal.m b/compiler/prog_io_goal.m index 9d2acc045..7d457ba0c 100644 --- a/compiler/prog_io_goal.m +++ b/compiler/prog_io_goal.m @@ -40,9 +40,8 @@ % `[Var1::Mode1, ..., VarN::ModeN] is Det' % part. % -:- pred parse_lambda_expression(term, list(prog_term), - list(mode), determinism). -:- mode parse_lambda_expression(in, out, out, out) is semidet. +:- pred parse_lambda_expression(term::in, list(prog_term)::out, + list(mode)::out, determinism::out) is semidet. % parse_pred_expression/3 converts the first argument to a :-/2 % higher-order pred expression into a list of variables, a list @@ -50,9 +49,8 @@ % a variant on parse_lambda_expression with a different syntax: % `(pred(Var1::Mode1, ..., VarN::ModeN) is Det :- Goal)'. % -:- pred parse_pred_expression(term, lambda_eval_method, list(prog_term), - list(mode), determinism). -:- mode parse_pred_expression(in, out, out, out, out) is semidet. +:- pred parse_pred_expression(term::in, lambda_eval_method::out, + list(prog_term)::out, list(mode)::out, determinism::out) is semidet. % parse_dcg_pred_expression/3 converts the first argument to a -->/2 % higher-order dcg pred expression into a list of arguments, a list @@ -62,9 +60,8 @@ % `(pred(Var1::Mode1, ..., VarN::ModeN, DCG0Mode, DCGMode) % is Det --> Goal)'. % -:- pred parse_dcg_pred_expression(term, lambda_eval_method, list(prog_term), - list(mode), determinism). -:- mode parse_dcg_pred_expression(in, out, out, out, out) is semidet. +:- pred parse_dcg_pred_expression(term::in, lambda_eval_method::out, + list(prog_term)::out, list(mode)::out, determinism::out) is semidet. % parse_func_expression/3 converts the first argument to a :-/2 % higher-order func expression into a list of arguments, a list @@ -83,15 +80,14 @@ % or % `(func(Var1, ..., VarN) = (VarN1). ' % -:- pred parse_func_expression(term, lambda_eval_method, list(prog_term), - list(mode), determinism). -:- mode parse_func_expression(in, out, out, out, out) is semidet. +:- pred parse_func_expression(term::in, lambda_eval_method::out, + list(prog_term)::out, list(mode)::out, determinism::out) is semidet. % parse_lambda_eval_method/3 extracts the `aditi_bottom_up' % annotation (if any) from a pred expression and returns the % rest of the term. -:- pred parse_lambda_eval_method(term(T), lambda_eval_method, term(T)). -:- mode parse_lambda_eval_method(in, out, out) is det. +:- pred parse_lambda_eval_method(term(T)::in, lambda_eval_method::out, + term(T)::out) is det. %-----------------------------------------------------------------------------% @@ -178,13 +174,9 @@ parse_goal_2(";", [A0, B0], R, !V) :- parse_goal(B0, B, !V), R = (A;B) ). -parse_goal_2("else", [ - term__functor(term__atom("if"), [ - term__functor(term__atom("then"), [A0, B0], _) - ], _), - C0 - ], - if_then_else(Vars, StateVars, A, B, C), !V) :- +parse_goal_2("else", [IF, C0], if_then_else(Vars, StateVars, A, B, C), !V) :- + IF = term__functor(term__atom("if"), + [term__functor(term__atom("then"), [A0, B0], _)], _), parse_some_vars_goal(A0, Vars, StateVars, A, !V), parse_goal(B0, B, !V), parse_goal(C0, C, !V). @@ -307,14 +299,14 @@ parse_some_vars_goal(A0, Vars, StateVars, A, !VarSet) :- parse_lambda_expression(LambdaExpressionTerm, Args, Modes, Det) :- LambdaExpressionTerm = term__functor(term__atom("is"), - [LambdaArgsTerm, DetTerm], _), + [LambdaArgsTerm, DetTerm], _), DetTerm = term__functor(term__atom(DetString), [], _), standard_det(DetString, Det), parse_lambda_args(LambdaArgsTerm, Args, Modes), inst_var_constraints_are_consistent_in_modes(Modes). -:- pred parse_lambda_args(term, list(prog_term), list(mode)). -:- mode parse_lambda_args(in, out, out) is semidet. +:- pred parse_lambda_args(term::in, list(prog_term)::out, list(mode)::out) + is semidet. parse_lambda_args(Term, Args, Modes) :- ( Term = term__functor(term__atom("[|]"), [Head, Tail], _Context) -> @@ -331,8 +323,7 @@ parse_lambda_args(Term, Args, Modes) :- parse_lambda_arg(Term, Arg, Mode) ). -:- pred parse_lambda_arg(term, prog_term, mode). -:- mode parse_lambda_arg(in, out, out) is semidet. +:- pred parse_lambda_arg(term::in, prog_term::out, (mode)::out) is semidet. parse_lambda_arg(Term, ArgTerm, Mode) :- Term = term__functor(term__atom("::"), [ArgTerm0, ModeTerm], _), @@ -394,7 +385,6 @@ parse_func_expression(FuncTerm, EvalMethod, Args, Modes, Det) :- list__map(term__coerce, Args1, Args) ). - parse_func_expression(FuncTerm, EvalMethod, Args, Modes, Det) :- % % parse a func expression with unspecified modes and determinism @@ -433,8 +423,8 @@ parse_lambda_eval_method(Term0, EvalMethod, Term) :- Term = Term0 ). -:- pred parse_pred_expr_args(list(term), list(prog_term), list(mode)). -:- mode parse_pred_expr_args(in, out, out) is semidet. +:- pred parse_pred_expr_args(list(term)::in, list(prog_term)::out, + list(mode)::out) is semidet. parse_pred_expr_args([], [], []). parse_pred_expr_args([Term|Terms], [Arg|Args], [Mode|Modes]) :- @@ -444,9 +434,8 @@ parse_pred_expr_args([Term|Terms], [Arg|Args], [Mode|Modes]) :- % parse_dcg_pred_expr_args is like parse_pred_expr_args except % that the last two elements of the list are the modes of the % two dcg arguments. -:- pred parse_dcg_pred_expr_args(list(term), list(prog_term), - list(mode)). -:- mode parse_dcg_pred_expr_args(in, out, out) is semidet. +:- pred parse_dcg_pred_expr_args(list(term)::in, list(prog_term)::out, + list(mode)::out) is semidet. parse_dcg_pred_expr_args([DCGModeTermA, DCGModeTermB], [], [DCGModeA, DCGModeB]) :- diff --git a/compiler/prog_io_pragma.m b/compiler/prog_io_pragma.m index 1d617c892..3f4f3e02f 100644 --- a/compiler/prog_io_pragma.m +++ b/compiler/prog_io_pragma.m @@ -1,4 +1,6 @@ %-----------------------------------------------------------------------------% +% vim:ts=4 sw=4 expandtab +%-----------------------------------------------------------------------------% % Copyright (C) 1996-2004 The University of Melbourne. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. @@ -20,10 +22,10 @@ %-----------------------------------------------------------------------------% - % Parse the pragma declaration. - % + % Parse the pragma declaration. + % :- pred parse_pragma(module_name::in, varset::in, list(term)::in, - maybe1(item)::out) is semidet. + maybe1(item)::out) is semidet. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% @@ -40,1548 +42,1428 @@ %-----------------------------------------------------------------------------% parse_pragma(ModuleName, VarSet, PragmaTerms, Result) :- - ( - % new syntax: `:- pragma foo(...).' - PragmaTerms = [SinglePragmaTerm0], - parse_type_decl_where_part_if_present( - non_solver_type, ModuleName, SinglePragmaTerm0, - SinglePragmaTerm, WherePartResult), - SinglePragmaTerm = term__functor(term__atom(PragmaType), - PragmaArgs, _), - parse_pragma_type(ModuleName, PragmaType, PragmaArgs, - SinglePragmaTerm, VarSet, Result0) - -> - ( - % The code to process `where' attributes will - % return an error result if solver attributes - % are given for a non-solver type. Because - % this is a non-solver type, if the - % unification with WhereResult succeeds then - % _NoSolverTypeDetails is guaranteed to be - % `no'. - WherePartResult = - ok(_NoSolverTypeDetails, MaybeUserEqComp), - ( - MaybeUserEqComp = yes(_), - Result0 = ok(Item0) - -> - ( - Item0 = type_defn(_, _, _, _, _), - foreign_type(Type, _, Assertions) = - Item0 ^ td_ctor_defn - -> - Result = ok(Item0 ^ td_ctor_defn := - foreign_type(Type, - MaybeUserEqComp, - Assertions)) - ; - Result = error( - "unexpected `where equality/comparison is'", - SinglePragmaTerm0) - ) - ; - Result = Result0 - ) - ; - WherePartResult = error(String, Term), - Result = error(String, Term) - ) - ; - % old syntax: `:- pragma(foo, ...).' - % XXX we should issue a warning; this syntax is deprecated. - PragmaTerms = [PragmaTypeTerm | PragmaArgs2], - PragmaTypeTerm = term__functor(term__atom(PragmaType), [], _), - parse_pragma_type(ModuleName, PragmaType, PragmaArgs2, - PragmaTypeTerm, VarSet, Result1) - -> - Result = Result1 - ; - fail - ). + ( + % new syntax: `:- pragma foo(...).' + PragmaTerms = [SinglePragmaTerm0], + parse_type_decl_where_part_if_present(non_solver_type, ModuleName, + SinglePragmaTerm0, SinglePragmaTerm, WherePartResult), + SinglePragmaTerm = term__functor(term__atom(PragmaType), + PragmaArgs, _), + parse_pragma_type(ModuleName, PragmaType, PragmaArgs, SinglePragmaTerm, + VarSet, Result0) + -> + ( + % The code to process `where' attributes will + % return an error result if solver attributes + % are given for a non-solver type. Because + % this is a non-solver type, if the + % unification with WhereResult succeeds then + % _NoSolverTypeDetails is guaranteed to be + % `no'. + WherePartResult = ok(_NoSolverTypeDetails, MaybeUserEqComp), + ( + MaybeUserEqComp = yes(_), + Result0 = ok(Item0) + -> + ( + Item0 = type_defn(_, _, _, _, _), + foreign_type(Type, _, Assertions) = Item0 ^ td_ctor_defn + -> + Result = ok(Item0 ^ td_ctor_defn := + foreign_type(Type, MaybeUserEqComp, Assertions)) + ; + Result = error("unexpected `where equality/comparison is'", + SinglePragmaTerm0) + ) + ; + Result = Result0 + ) + ; + WherePartResult = error(String, Term), + Result = error(String, Term) + ) + ; + % old syntax: `:- pragma(foo, ...).' + % XXX we should issue a warning; this syntax is deprecated. + PragmaTerms = [PragmaTypeTerm | PragmaArgs2], + PragmaTypeTerm = term__functor(term__atom(PragmaType), [], _), + parse_pragma_type(ModuleName, PragmaType, PragmaArgs2, + PragmaTypeTerm, VarSet, Result1) + -> + Result = Result1 + ; + fail + ). :- pred parse_pragma_type(module_name::in, string::in, list(term)::in, - term::in, varset::in, maybe1(item)::out) is semidet. + term::in, varset::in, maybe1(item)::out) is semidet. parse_pragma_type(_, "source_file", PragmaTerms, ErrorTerm, _VarSet, Result) :- - ( PragmaTerms = [SourceFileTerm] -> - ( - SourceFileTerm = term__functor( - term__string(SourceFile), [], _) - -> - Result = ok(pragma(source_file(SourceFile))) - ; - Result = error("string expected in `:- pragma " ++ - "source_file' declaration", SourceFileTerm) - ) - ; - Result = error("wrong number of arguments in " ++ - "`:- pragma source_file' declaration", ErrorTerm) - ). + ( PragmaTerms = [SourceFileTerm] -> + ( + SourceFileTerm = term__functor(term__string(SourceFile), [], _) + -> + Result = ok(pragma(source_file(SourceFile))) + ; + Result = error("string expected in `:- pragma " ++ + "source_file' declaration", SourceFileTerm) + ) + ; + Result = error("wrong number of arguments in " ++ + "`:- pragma source_file' declaration", ErrorTerm) + ). parse_pragma_type(ModuleName, "foreign_type", PragmaTerms, ErrorTerm, VarSet, - Result) :- - ( - ( - PragmaTerms = [LangTerm, MercuryTypeTerm, - ForeignTypeTerm], - MaybeAssertionTerm = no - ; - PragmaTerms = [LangTerm, MercuryTypeTerm, - ForeignTypeTerm, AssertionTerm], - MaybeAssertionTerm = yes(AssertionTerm) - ) - -> - ( - parse_foreign_language(LangTerm, Language) - -> - parse_foreign_language_type(ForeignTypeTerm, Language, - MaybeForeignType), - ( - MaybeForeignType = ok(ForeignType), - parse_type_defn_head(ModuleName, - MercuryTypeTerm, ErrorTerm, - MaybeTypeDefnHead), - ( - MaybeTypeDefnHead = - ok(MercuryTypeSymName, - MercuryArgs0), - varset__coerce(VarSet, TVarSet), - MercuryArgs = list__map(term__coerce, - MercuryArgs0), - ( parse_maybe_foreign_type_assertions( - MaybeAssertionTerm, Assertions) - -> - % rafe: XXX I'm not - % sure that - % `no' - % here is right - we - % might need some more - % parsing... - Result = ok(type_defn(TVarSet, - MercuryTypeSymName, - MercuryArgs, - foreign_type( - ForeignType, - no, - Assertions), - true)) - ; MaybeAssertionTerm = - yes(ErrorAssertionTerm) - -> - Result = error( - "invalid assertion in `:- pragma foreign_type' declaration", - ErrorAssertionTerm) - ; - error( - "parse_pragma_type: unexpected failure of " ++ - "parse_maybe_foreign_type_assertion") - ) + Result) :- + ( + ( + PragmaTerms = [LangTerm, MercuryTypeTerm, ForeignTypeTerm], + MaybeAssertionTerm = no + ; + PragmaTerms = [LangTerm, MercuryTypeTerm, ForeignTypeTerm, + AssertionTerm], + MaybeAssertionTerm = yes(AssertionTerm) + ) + -> + ( + parse_foreign_language(LangTerm, Language) + -> + parse_foreign_language_type(ForeignTypeTerm, Language, + MaybeForeignType), + ( + MaybeForeignType = ok(ForeignType), + parse_type_defn_head(ModuleName, MercuryTypeTerm, ErrorTerm, + MaybeTypeDefnHead), + ( + MaybeTypeDefnHead = ok(MercuryTypeSymName, MercuryArgs0), + varset__coerce(VarSet, TVarSet), + MercuryArgs = list__map(term__coerce, MercuryArgs0), + ( + parse_maybe_foreign_type_assertions(MaybeAssertionTerm, + Assertions) + -> + % rafe: XXX I'm not + % sure that + % `no' + % here is right - we + % might need some more + % parsing... + Result = ok(type_defn(TVarSet, MercuryTypeSymName, + MercuryArgs, + foreign_type( ForeignType, no, Assertions), + true)) + ; + MaybeAssertionTerm = yes(ErrorAssertionTerm) + -> + Result = error("invalid assertion in " ++ + "`:- pragma foreign_type' declaration", + ErrorAssertionTerm) + ; + error("parse_pragma_type: unexpected failure of " ++ + "parse_maybe_foreign_type_assertion") + ) ; - MaybeTypeDefnHead = - error(String, Term), - Result = error(String, Term) - ) - ; - MaybeForeignType = error(String, Term), - Result = error(String, Term) - ) - ; - Result = error( - "invalid foreign language in `:- pragma foreign_type' declaration", - LangTerm) - ) - ; - Result = error( - "wrong number of arguments in `:- pragma foreign_type' declaration", - ErrorTerm) - ). + MaybeTypeDefnHead = error(String, Term), + Result = error(String, Term) + ) + ; + MaybeForeignType = error(String, Term), + Result = error(String, Term) + ) + ; + Result = error("invalid foreign language in " ++ + "`:- pragma foreign_type' declaration", LangTerm) + ) + ; + Result = error("wrong number of arguments in " ++ + "`:- pragma foreign_type' declaration", ErrorTerm) + ). parse_pragma_type(ModuleName, "foreign_decl", PragmaTerms, ErrorTerm, - VarSet, Result) :- - parse_pragma_foreign_decl_pragma(ModuleName, "foreign_decl", - PragmaTerms, ErrorTerm, VarSet, Result). + VarSet, Result) :- + parse_pragma_foreign_decl_pragma(ModuleName, "foreign_decl", + PragmaTerms, ErrorTerm, VarSet, Result). parse_pragma_type(ModuleName, "c_header_code", PragmaTerms, ErrorTerm, - VarSet, Result) :- - ( - PragmaTerms = [term__functor(_, _, Context) | _] - -> - LangC = term__functor(term__string("C"), [], Context), - parse_pragma_foreign_decl_pragma(ModuleName, "c_header_code", - [LangC | PragmaTerms], ErrorTerm, VarSet, Result) - ; - Result = error("wrong number of arguments or unexpected " ++ - "variable in `:- pragma c_header_code' declaration", - ErrorTerm) - ). + VarSet, Result) :- + ( + PragmaTerms = [term__functor(_, _, Context) | _] + -> + LangC = term__functor(term__string("C"), [], Context), + parse_pragma_foreign_decl_pragma(ModuleName, "c_header_code", + [LangC | PragmaTerms], ErrorTerm, VarSet, Result) + ; + Result = error("wrong number of arguments or unexpected " ++ + "variable in `:- pragma c_header_code' declaration", + ErrorTerm) + ). parse_pragma_type(ModuleName, "foreign_code", PragmaTerms, ErrorTerm, - VarSet, Result) :- - parse_pragma_foreign_code_pragma(ModuleName, "foreign_code", - PragmaTerms, ErrorTerm, VarSet, Result). + VarSet, Result) :- + parse_pragma_foreign_code_pragma(ModuleName, "foreign_code", + PragmaTerms, ErrorTerm, VarSet, Result). parse_pragma_type(ModuleName, "foreign_proc", PragmaTerms, ErrorTerm, - VarSet, Result) :- - parse_pragma_foreign_proc_pragma(ModuleName, "foreign_proc", - PragmaTerms, ErrorTerm, VarSet, Result). + VarSet, Result) :- + parse_pragma_foreign_proc_pragma(ModuleName, "foreign_proc", + PragmaTerms, ErrorTerm, VarSet, Result). - % pragma c_code is almost as if we have written foreign_code - % or foreign_proc with the language set to "C". - % There are a few differences (error messages, some deprecated - % syntax is still supported for c_code) so we pass the original - % pragma name to parse_pragma_foreign_code_pragma. + % pragma c_code is almost as if we have written foreign_code + % or foreign_proc with the language set to "C". + % There are a few differences (error messages, some deprecated + % syntax is still supported for c_code) so we pass the original + % pragma name to parse_pragma_foreign_code_pragma. parse_pragma_type(ModuleName, "c_code", PragmaTerms, ErrorTerm, - VarSet, Result) :- - ( - % arity = 1 (same as foreign_code) - PragmaTerms = [term__functor(_, _, Context)] - -> - LangC = term__functor(term__string("C"), [], Context), - parse_pragma_foreign_code_pragma(ModuleName, "c_code", - [LangC | PragmaTerms], ErrorTerm, VarSet, Result) - ; - % arity > 1 (same as foreign_proc) - PragmaTerms = [term__functor(_, _, Context) | _] - -> - LangC = term__functor(term__string("C"), [], Context), - parse_pragma_foreign_proc_pragma(ModuleName, "c_code", - [LangC | PragmaTerms], ErrorTerm, VarSet, Result) - ; - Result = error("wrong number of arguments or unexpected " ++ - "variable in `:- pragma c_code' declaration", - ErrorTerm) - ). + VarSet, Result) :- + ( + % arity = 1 (same as foreign_code) + PragmaTerms = [term__functor(_, _, Context)] + -> + LangC = term__functor(term__string("C"), [], Context), + parse_pragma_foreign_code_pragma(ModuleName, "c_code", + [LangC | PragmaTerms], ErrorTerm, VarSet, Result) + ; + % arity > 1 (same as foreign_proc) + PragmaTerms = [term__functor(_, _, Context) | _] + -> + LangC = term__functor(term__string("C"), [], Context), + parse_pragma_foreign_proc_pragma(ModuleName, "c_code", + [LangC | PragmaTerms], ErrorTerm, VarSet, Result) + ; + Result = error("wrong number of arguments or unexpected " ++ + "variable in `:- pragma c_code' declaration", ErrorTerm) + ). parse_pragma_type(_ModuleName, "c_import_module", PragmaTerms, ErrorTerm, - _VarSet, Result) :- - ( - PragmaTerms = [ImportTerm], - sym_name_and_args(ImportTerm, Import, []) - -> - Result = ok(pragma(foreign_import_module(c, Import))) - ; - Result = error("wrong number of arguments or invalid " ++ - "module name in `:- pragma c_import_module' " ++ - "declaration", ErrorTerm) - ). + _VarSet, Result) :- + ( + PragmaTerms = [ImportTerm], + sym_name_and_args(ImportTerm, Import, []) + -> + Result = ok(pragma(foreign_import_module(c, Import))) + ; + Result = error("wrong number of arguments or invalid " ++ + "module name in `:- pragma c_import_module' " ++ + "declaration", ErrorTerm) + ). parse_pragma_type(_ModuleName, "foreign_import_module", PragmaTerms, ErrorTerm, - _VarSet, Result) :- - ( - PragmaTerms = [LangTerm, ImportTerm], - sym_name_and_args(ImportTerm, Import, []) - -> - ( parse_foreign_language(LangTerm, Language) -> - Result = ok(pragma( - foreign_import_module(Language, Import))) - ; - Result = error("invalid foreign language in " ++ - "`:- pragma foreign_import_module' " ++ - "declaration", LangTerm) - ) - ; - Result = error("wrong number of arguments or invalid " ++ - "module name in `:- pragma foreign_import_module' " ++ - "declaration", ErrorTerm) - ). + _VarSet, Result) :- + ( + PragmaTerms = [LangTerm, ImportTerm], + sym_name_and_args(ImportTerm, Import, []) + -> + ( parse_foreign_language(LangTerm, Language) -> + Result = ok(pragma( + foreign_import_module(Language, Import))) + ; + Result = error("invalid foreign language in " ++ + "`:- pragma foreign_import_module' " ++ + "declaration", LangTerm) + ) + ; + Result = error("wrong number of arguments or invalid " ++ + "module name in `:- pragma foreign_import_module' " ++ + "declaration", ErrorTerm) + ). :- pred parse_foreign_decl_is_local(term::in, foreign_decl_is_local::out) - is semidet. + is semidet. parse_foreign_decl_is_local(term__functor(Functor, [], _), IsLocal) :- - ( - Functor = term__string(String) - ; - Functor = term__atom(String) - ), - ( - String = "local", - IsLocal = foreign_decl_is_local - ; - String = "exported", - IsLocal = foreign_decl_is_exported - ). + ( + Functor = term__string(String) + ; + Functor = term__atom(String) + ), + ( + String = "local", + IsLocal = foreign_decl_is_local + ; + String = "exported", + IsLocal = foreign_decl_is_exported + ). :- pred parse_foreign_language(term::in, foreign_language::out) is semidet. parse_foreign_language(term__functor(term__string(String), _, _), Lang) :- - globals__convert_foreign_language(String, Lang). + globals__convert_foreign_language(String, Lang). parse_foreign_language(term__functor(term__atom(String), _, _), Lang) :- - globals__convert_foreign_language(String, Lang). + globals__convert_foreign_language(String, Lang). :- pred parse_foreign_language_type(term::in, foreign_language::in, - maybe1(foreign_language_type)::out) is det. + maybe1(foreign_language_type)::out) is det. parse_foreign_language_type(InputTerm, Language, Result) :- - ( - Language = il - -> - ( - InputTerm = term__functor(term__string(ILTypeName), - [], _) - -> - parse_il_type_name(ILTypeName, InputTerm, Result) - ; - Result = error("invalid backend specification term", - InputTerm) - ) - ; - Language = c - -> - ( - InputTerm = term__functor(term__string(CTypeName), - [], _) - -> - Result = ok(c(c(CTypeName))) - ; - Result = error("invalid backend specification term", - InputTerm) - ) - ; - Language = java - -> - ( - InputTerm = term__functor(term__string(JavaTypeName), - [], _) - -> - Result = ok(java(java(JavaTypeName))) - ; - Result = error("invalid backend specification term", - InputTerm) - ) - ; + ( Language = il -> + ( InputTerm = term__functor(term__string(ILTypeName), [], _) -> + parse_il_type_name(ILTypeName, InputTerm, Result) + ; + Result = error("invalid backend specification term", InputTerm) + ) + ; Language = c -> + ( InputTerm = term__functor(term__string(CTypeName), [], _) -> + Result = ok(c(c(CTypeName))) + ; + Result = error("invalid backend specification term", InputTerm) + ) + ; Language = java -> + ( InputTerm = term__functor(term__string(JavaTypeName), [], _) -> + Result = ok(java(java(JavaTypeName))) + ; + Result = error("invalid backend specification term", InputTerm) + ) + ; - Result = error("unsupported language specified, " ++ - "unable to parse backend type", InputTerm) - ). + Result = error("unsupported language specified, " ++ + "unable to parse backend type", InputTerm) + ). :- pred parse_il_type_name(string::in, term::in, - maybe1(foreign_language_type)::out) is det. + maybe1(foreign_language_type)::out) is det. parse_il_type_name(String0, ErrorTerm, ForeignType) :- - ( - parse_special_il_type_name(String0, ForeignTypeResult) - -> - ForeignType = ok(il(ForeignTypeResult)) - ; - string__append("class [", String1, String0), - string__sub_string_search(String1, "]", Index) - -> - string__left(String1, Index, AssemblyName), - string__split(String1, Index + 1, _, TypeNameStr), - string_to_sym_name(TypeNameStr, ".", TypeSymName), - ForeignType = ok(il(il(reference, AssemblyName, TypeSymName))) - ; - string__append("valuetype [", String1, String0), - string__sub_string_search(String1, "]", Index) - -> - string__left(String1, Index, AssemblyName), - string__split(String1, Index + 1, _, TypeNameStr), - string_to_sym_name(TypeNameStr, ".", TypeSymName), - ForeignType = ok(il(il(value, AssemblyName, TypeSymName))) - ; - ForeignType = error( - "invalid foreign language type description", ErrorTerm) - ). + ( + parse_special_il_type_name(String0, ForeignTypeResult) + -> + ForeignType = ok(il(ForeignTypeResult)) + ; + string__append("class [", String1, String0), + string__sub_string_search(String1, "]", Index) + -> + string__left(String1, Index, AssemblyName), + string__split(String1, Index + 1, _, TypeNameStr), + string_to_sym_name(TypeNameStr, ".", TypeSymName), + ForeignType = ok(il(il(reference, AssemblyName, TypeSymName))) + ; + string__append("valuetype [", String1, String0), + string__sub_string_search(String1, "]", Index) + -> + string__left(String1, Index, AssemblyName), + string__split(String1, Index + 1, _, TypeNameStr), + string_to_sym_name(TypeNameStr, ".", TypeSymName), + ForeignType = ok(il(il(value, AssemblyName, TypeSymName))) + ; + ForeignType = error("invalid foreign language type description", + ErrorTerm) + ). - % Parse all the special assembler names for all the builtin types. - % See Parition I 'Built-In Types' (Section 8.2.2) for the list - % of all builtin types. + % Parse all the special assembler names for all the builtin types. + % See Parition I 'Built-In Types' (Section 8.2.2) for the list + % of all builtin types. :- pred parse_special_il_type_name(string::in, il_foreign_type::out) is semidet. parse_special_il_type_name("bool", il(value, "mscorlib", - qualified(unqualified("System"), "Boolean"))). + qualified(unqualified("System"), "Boolean"))). parse_special_il_type_name("char", il(value, "mscorlib", - qualified(unqualified("System"), "Char"))). + qualified(unqualified("System"), "Char"))). parse_special_il_type_name("object", il(reference, "mscorlib", - qualified(unqualified("System"), "Object"))). + qualified(unqualified("System"), "Object"))). parse_special_il_type_name("string", il(reference, "mscorlib", - qualified(unqualified("System"), "String"))). + qualified(unqualified("System"), "String"))). parse_special_il_type_name("float32", il(value, "mscorlib", - qualified(unqualified("System"), "Single"))). + qualified(unqualified("System"), "Single"))). parse_special_il_type_name("float64", il(value, "mscorlib", - qualified(unqualified("System"), "Double"))). + qualified(unqualified("System"), "Double"))). parse_special_il_type_name("int8", il(value, "mscorlib", - qualified(unqualified("System"), "SByte"))). + qualified(unqualified("System"), "SByte"))). parse_special_il_type_name("int16", il(value, "mscorlib", - qualified(unqualified("System"), "Int16"))). + qualified(unqualified("System"), "Int16"))). parse_special_il_type_name("int32", il(value, "mscorlib", - qualified(unqualified("System"), "Int32"))). + qualified(unqualified("System"), "Int32"))). parse_special_il_type_name("int64", il(value, "mscorlib", - qualified(unqualified("System"), "Int64"))). + qualified(unqualified("System"), "Int64"))). parse_special_il_type_name("natural int", il(value, "mscorlib", - qualified(unqualified("System"), "IntPtr"))). + qualified(unqualified("System"), "IntPtr"))). parse_special_il_type_name("native int", il(value, "mscorlib", - qualified(unqualified("System"), "IntPtr"))). + qualified(unqualified("System"), "IntPtr"))). parse_special_il_type_name("natural unsigned int", il(value, "mscorlib", - qualified(unqualified("System"), "UIntPtr"))). + qualified(unqualified("System"), "UIntPtr"))). parse_special_il_type_name("native unsigned int", il(value, "mscorlib", - qualified(unqualified("System"), "UIntPtr"))). + qualified(unqualified("System"), "UIntPtr"))). parse_special_il_type_name("refany", il(value, "mscorlib", - qualified(unqualified("System"), "TypedReference"))). + qualified(unqualified("System"), "TypedReference"))). parse_special_il_type_name("typedref", il(value, "mscorlib", - qualified(unqualified("System"), "TypedReference"))). + qualified(unqualified("System"), "TypedReference"))). parse_special_il_type_name("unsigned int8", il(value, "mscorlib", - qualified(unqualified("System"), "Byte"))). + qualified(unqualified("System"), "Byte"))). parse_special_il_type_name("unsigned int16", il(value, "mscorlib", - qualified(unqualified("System"), "UInt16"))). + qualified(unqualified("System"), "UInt16"))). parse_special_il_type_name("unsigned int32", il(value, "mscorlib", - qualified(unqualified("System"), "UInt32"))). + qualified(unqualified("System"), "UInt32"))). parse_special_il_type_name("unsigned int64", il(value, "mscorlib", - qualified(unqualified("System"), "UInt64"))). + qualified(unqualified("System"), "UInt64"))). :- pred parse_maybe_foreign_type_assertions(maybe(term)::in, list(foreign_type_assertion)::out) is semidet. parse_maybe_foreign_type_assertions(no, []). parse_maybe_foreign_type_assertions(yes(Term), Assertions) :- - parse_foreign_type_assertions(Term, Assertions). + parse_foreign_type_assertions(Term, Assertions). :- pred parse_foreign_type_assertions(term::in, list(foreign_type_assertion)::out) is semidet. parse_foreign_type_assertions(Term, Assertions) :- - ( Term = term__functor(term__atom("[]"), [], _) -> - Assertions = [] - ; - Term = term__functor(term__atom("[|]"), [Head, Tail], _), - parse_foreign_type_assertion(Head, HeadAssertion), - parse_foreign_type_assertions(Tail, TailAssertions), - Assertions = [HeadAssertion | TailAssertions] - ). + ( Term = term__functor(term__atom("[]"), [], _) -> + Assertions = [] + ; + Term = term__functor(term__atom("[|]"), [Head, Tail], _), + parse_foreign_type_assertion(Head, HeadAssertion), + parse_foreign_type_assertions(Tail, TailAssertions), + Assertions = [HeadAssertion | TailAssertions] + ). :- pred parse_foreign_type_assertion(term::in, - foreign_type_assertion::out) is semidet. + foreign_type_assertion::out) is semidet. parse_foreign_type_assertion(Term, Assertion) :- - Term = term__functor(term__atom(Constant), [], _), + Term = term__functor(term__atom(Constant), [], _), Constant = "can_pass_as_mercury_type", Assertion = can_pass_as_mercury_type. parse_foreign_type_assertion(Term, Assertion) :- - Term = term__functor(term__atom(Constant), [], _), - Constant = "stable", - Assertion = stable. + Term = term__functor(term__atom(Constant), [], _), + Constant = "stable", + Assertion = stable. - % This predicate parses both c_header_code and foreign_decl pragmas. + % This predicate parses both c_header_code and foreign_decl pragmas. :- pred parse_pragma_foreign_decl_pragma(module_name::in, string::in, - list(term)::in, term::in, varset::in, maybe1(item)::out) is det. + list(term)::in, term::in, varset::in, maybe1(item)::out) is det. parse_pragma_foreign_decl_pragma(_ModuleName, Pragma, PragmaTerms, - ErrorTerm, _VarSet, Result) :- - string__format("invalid `:- pragma %s' declaration ", [s(Pragma)], - InvalidDeclStr), - ( - ( - PragmaTerms = [LangTerm, HeaderTerm], - IsLocal = foreign_decl_is_exported - ; - PragmaTerms = [LangTerm, IsLocalTerm, HeaderTerm], - parse_foreign_decl_is_local(IsLocalTerm, IsLocal) - ) - -> - ( - parse_foreign_language(LangTerm, ForeignLanguage) - -> - ( - HeaderTerm = term__functor(term__string( - HeaderCode), [], _) - -> - DeclCode = foreign_decl(ForeignLanguage, - IsLocal, HeaderCode), - Result = ok(pragma(DeclCode)) - ; - ErrMsg = "-- expected string for foreign " - ++ "declaration code", - Result = error(string__append(InvalidDeclStr, - ErrMsg), HeaderTerm) - ) - ; - ErrMsg = "-- invalid language parameter", - Result = error(InvalidDeclStr ++ ErrMsg, LangTerm) - ) - ; - string__format("invalid `:- pragma %s' declaration ", - [s(Pragma)], ErrorStr), - Result = error(ErrorStr, ErrorTerm) - ). - - % This predicate parses both c_code and foreign_code pragmas. - % Processing of foreign_proc (or c_code that defines a procedure) - % is handled in parse_pragma_foreign_proc_pragma below. - % -:- pred parse_pragma_foreign_code_pragma(module_name::in, string::in, - list(term)::in, term::in, varset::in, maybe1(item)::out) is det. - -parse_pragma_foreign_code_pragma(_ModuleName, Pragma, PragmaTerms, - ErrorTerm, _VarSet, Result) :- - string__format("invalid `:- pragma %s' declaration ", [s(Pragma)], - InvalidDeclStr), - - Check1 = (func(PTerms1, ForeignLanguage) = Res is semidet :- - PTerms1 = [Just_Code_Term], - ( - Just_Code_Term = term__functor(term__string( - Just_Code), [], _) - -> - Res = ok(pragma(foreign_code(ForeignLanguage, - Just_Code))) - ; - ErrMsg = "-- expected string for foreign code", - Res = error(string__append(InvalidDeclStr, ErrMsg), - ErrorTerm) - ) - ), - - CheckLength = (func(PTermsLen, ForeignLanguage) = Res :- - ( - Res0 = Check1(PTermsLen, ForeignLanguage) - -> - Res = Res0 - ; - ErrMsg = "-- wrong number of arguments", - Res = error(string__append(InvalidDeclStr, ErrMsg), - ErrorTerm) - ) - ), - - CheckLanguage = (func(PTermsLang) = Res is semidet :- - PTermsLang = [Lang | Rest], - ( - parse_foreign_language(Lang, ForeignLanguage) - -> - Res = CheckLength(Rest, ForeignLanguage) - ; - ErrMsg = "-- invalid language parameter", - Res = error(string__append(InvalidDeclStr, ErrMsg), - Lang) - ) - ), - - ( - Result0 = CheckLanguage(PragmaTerms) - -> - Result = Result0 - ; - ErrMsg0 = "-- wrong number of arguments", - Result = error(string__append(InvalidDeclStr, ErrMsg0), - ErrorTerm) - ). - - % This predicate parses both c_code and foreign_proc pragmas. - % -:- pred parse_pragma_foreign_proc_pragma(module_name::in, string::in, - list(term)::in, term::in, varset::in, maybe1(item)::out) is det. - -parse_pragma_foreign_proc_pragma(ModuleName, Pragma, PragmaTerms, - ErrorTerm, VarSet, Result) :- - string__format("invalid `:- pragma %s' declaration ", [s(Pragma)], - InvalidDeclStr), - - Check6 = (func(PTerms6, ForeignLanguage) = Res is semidet :- - PTerms6 = [PredAndVarsTerm, FlagsTerm, - FieldsTerm, FirstTerm, LaterTerm, SharedTerm], - parse_pragma_foreign_proc_attributes_term( - ForeignLanguage, Pragma, FlagsTerm, MaybeFlags), - ( MaybeFlags = ok(Flags) -> - ( parse_pragma_keyword("local_vars", FieldsTerm, Fields, - FieldsContext) -> - ( parse_pragma_keyword("first_code", FirstTerm, First, - FirstContext) -> - ( parse_pragma_keyword("retry_code", LaterTerm, Later, - LaterContext) -> - ( parse_pragma_keyword("shared_code", SharedTerm, - Shared, SharedContext) -> - parse_pragma_foreign_code(ModuleName, - Flags, PredAndVarsTerm, - nondet(Fields, yes(FieldsContext), - First, yes(FirstContext), - Later, yes(LaterContext), - share, Shared, yes(SharedContext)), - VarSet, Res) - ; parse_pragma_keyword("duplicated_code", - SharedTerm, Shared, SharedContext) -> - parse_pragma_foreign_code(ModuleName, - Flags, PredAndVarsTerm, - nondet(Fields, yes(FieldsContext), - First, yes(FirstContext), - Later, yes(LaterContext), - duplicate, Shared, yes(SharedContext)), - VarSet, Res) - ; parse_pragma_keyword("common_code", SharedTerm, - Shared, SharedContext) -> - parse_pragma_foreign_code(ModuleName, - Flags, PredAndVarsTerm, - nondet(Fields, yes(FieldsContext), - First, yes(FirstContext), - Later, yes(LaterContext), - automatic, Shared, yes(SharedContext)), - VarSet, Res) - ; - ErrMsg = "-- invalid seventh argument, " - ++ "expecting `common_code()'", - Res = error(string__append(InvalidDeclStr, - ErrMsg), SharedTerm) - ) - ; - ErrMsg = "-- invalid sixth argument, " - ++ "expecting `retry_code()'", - Res = error(string__append(InvalidDeclStr, ErrMsg), - LaterTerm) - ) - ; - ErrMsg = "-- invalid fifth argument, " - ++ "expecting `first_code()'", - Res = error(string__append(InvalidDeclStr, ErrMsg), - FirstTerm) - ) - ; - ErrMsg = "-- invalid fourth argument, " - ++ "expecting `local_vars()'", - Res = error(string__append(InvalidDeclStr, ErrMsg), - FieldsTerm) - ) - ; - MaybeFlags = error(FlagsErrorStr, ErrorTerm), - ErrMsg = "-- invalid third argument: " ++ FlagsErrorStr, - Res = error(string__append(InvalidDeclStr, ErrMsg), ErrorTerm) - ) - ), - - Check5 = (func(PTerms5, ForeignLanguage) = Res is semidet :- - PTerms5 = [PredAndVarsTerm, FlagsTerm, - FieldsTerm, FirstTerm, LaterTerm], - term__context_init(DummyContext), - SharedTerm = term__functor(term__atom("common_code"), - [term__functor(term__string(""), [], DummyContext)], - DummyContext), - Res = Check6([PredAndVarsTerm, FlagsTerm, FieldsTerm, FirstTerm, - LaterTerm, SharedTerm], ForeignLanguage) - ), - - Check3 = (func(PTerms3, ForeignLanguage) = Res is semidet :- - PTerms3 = [PredAndVarsTerm, FlagsTerm, CodeTerm], - ( - CodeTerm = term__functor(term__string(Code), [], Context) - -> - parse_pragma_foreign_proc_attributes_term(ForeignLanguage, - Pragma, FlagsTerm, MaybeFlags), - ( - MaybeFlags = ok(Flags), - parse_pragma_foreign_code(ModuleName, Flags, - PredAndVarsTerm, ordinary(Code, yes(Context)), - VarSet, Res) - ; - MaybeFlags = error(FlagsErr, FlagsErrTerm), - parse_pragma_foreign_proc_attributes_term( - ForeignLanguage, Pragma, PredAndVarsTerm, - MaybeFlags2), - ( - MaybeFlags2 = ok(Flags), - % XXX we should issue a warning; this syntax is - % deprecated We will continue to accept this if - % c_code is used, but not with foreign_code - ( Pragma = "c_code" -> - parse_pragma_foreign_code(ModuleName, - Flags, FlagsTerm, - ordinary(Code, yes(Context)), - VarSet, Res) - ; - ErrMsg = "-- invalid second argument, " - ++ "expecting predicate " - ++ "or function mode", - Res = error(string__append( - InvalidDeclStr, ErrMsg), - PredAndVarsTerm) - ) - ; - MaybeFlags2 = error(_, _), - ErrMsg = "-- invalid third argument: ", - Res = error(InvalidDeclStr ++ ErrMsg ++ - FlagsErr, FlagsErrTerm) - ) - ) - ; - ErrMsg = "-- invalid fourth argument, " - ++ "expecting string containing foreign code", - Res = error(string__append(InvalidDeclStr, ErrMsg), - CodeTerm) - ) - ), - - Check2 = (func(PTerms2, ForeignLanguage) = Res is semidet :- - PTerms2 = [PredAndVarsTerm, CodeTerm], - % XXX we should issue a warning; this syntax is deprecated. - % We will continue to accept this if c_code is used, but - % not with foreign_code - ( - Pragma = "c_code" - -> - % may_call_mercury is a conservative default. - Attributes0 = default_attributes(ForeignLanguage), - set_legacy_purity_behaviour(yes, Attributes0, - Attributes), - ( - CodeTerm = term__functor(term__string(Code), [], - Context) - -> - parse_pragma_foreign_code(ModuleName, - Attributes, PredAndVarsTerm, ordinary(Code, - yes(Context)), VarSet, Res) - ; - ErrMsg = "-- expecting either " - ++ "`may_call_mercury' or " - ++ "`will_not_call_mercury', " - ++ "and a string for foreign code", - Res = error(string__append(InvalidDeclStr, ErrMsg), - CodeTerm) - ) - ; - ErrMsg = "-- doesn't say whether it can call mercury", - Res = error(string__append(InvalidDeclStr, ErrMsg), - ErrorTerm) - ) - ), - - CheckLength = (func(PTermsLen, ForeignLanguage) = Res :- - ( - Res0 = Check2(PTermsLen, ForeignLanguage) - -> - Res = Res0 - ; - Res0 = Check3(PTermsLen, ForeignLanguage) - -> - Res = Res0 - ; - Res0 = Check5(PTermsLen, ForeignLanguage) - -> - Res = Res0 - ; - Res0 = Check6(PTermsLen, ForeignLanguage) - -> - Res = Res0 - ; - ErrMsg = "-- wrong number of arguments", - Res = error(string__append(InvalidDeclStr, ErrMsg), - ErrorTerm) - ) - ), - - CheckLanguage = (func(PTermsLang) = Res is semidet :- - PTermsLang = [Lang | Rest], - ( - parse_foreign_language(Lang, ForeignLanguage) - -> - Res = CheckLength(Rest, ForeignLanguage) - ; - ErrMsg = "-- invalid language parameter", - Res = error(string__append(InvalidDeclStr, ErrMsg), - Lang) - ) - ), - - ( - Result0 = CheckLanguage(PragmaTerms) - -> - Result = Result0 - ; - ErrMsg0 = "-- wrong number of arguments", - Result = error(string__append(InvalidDeclStr, ErrMsg0), - ErrorTerm) - ). - -parse_pragma_type(ModuleName, "import", PragmaTerms, - ErrorTerm, _VarSet, Result) :- - % XXX we assume all imports are C - ForeignLanguage = c, - ( - ( - PragmaTerms = [PredAndModesTerm, FlagsTerm, FunctionTerm], - parse_pragma_foreign_proc_attributes_term(ForeignLanguage, - "import", FlagsTerm, MaybeFlags), - ( - MaybeFlags = error(FlagError, ErrorTerm), - FlagsResult = error("invalid second argument in " - ++ "`:- pragma import/3' declaration : " - ++ FlagError, ErrorTerm) - ; - MaybeFlags = ok(Flags), - FlagsResult = ok(Flags) - ) - ; - PragmaTerms = [PredAndModesTerm, FunctionTerm], - Flags0 = default_attributes(ForeignLanguage), - % pragma import uses legacy purity behaviour - set_legacy_purity_behaviour(yes, Flags0, Flags), - FlagsResult = ok(Flags) - ) - -> - ( - FunctionTerm = term__functor(term__string(Function), [], _) - -> - parse_pred_or_func_and_arg_modes(yes(ModuleName), - PredAndModesTerm, ErrorTerm, - "`:- pragma import' declaration", - PredAndArgModesResult), - ( - PredAndArgModesResult = ok(PredName - PredOrFunc, - ArgModes), - ( - FlagsResult = ok(Attributes), - Result = ok(pragma(import(PredName, PredOrFunc, - ArgModes, Attributes, Function))) - ; - FlagsResult = error(Msg, Term), - Result = error(Msg, Term) - ) - ; - PredAndArgModesResult = error(Msg, Term), - Result = error(Msg, Term) - ) - ; - Result = error("expected pragma import(PredName(ModeList), " - ++ "Function)", PredAndModesTerm) - ) - ; - Result = - error( - "wrong number of arguments in `:- pragma import' declaration", - ErrorTerm) - ). - -parse_pragma_type(_ModuleName, "export", PragmaTerms, - ErrorTerm, _VarSet, Result) :- - % XXX we implicitly assume exports are only for C - ( - PragmaTerms = [PredAndModesTerm, FunctionTerm] - -> - ( - FunctionTerm = term__functor(term__string(Function), [], _) - -> - parse_pred_or_func_and_arg_modes(no, PredAndModesTerm, - ErrorTerm, "`:- pragma export' declaration", - PredAndModesResult), - ( - PredAndModesResult = ok(PredName - PredOrFunc, Modes), - Result = ok(pragma(export(PredName, PredOrFunc, - Modes, Function))) - ; - PredAndModesResult = error(Msg, Term), - Result = error(Msg, Term) - ) - ; - Result = error( - "expected pragma export(PredName(ModeList), Function)", - PredAndModesTerm) - ) - ; - Result = - error( - "wrong number of arguments in `:- pragma export' declaration", - ErrorTerm) - ). - -parse_pragma_type(ModuleName, "inline", PragmaTerms, ErrorTerm, - _VarSet, Result) :- - parse_simple_pragma(ModuleName, "inline", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = inline(Name, Arity)), - PragmaTerms, ErrorTerm, Result). - -parse_pragma_type(ModuleName, "no_inline", PragmaTerms, ErrorTerm, - _VarSet, Result) :- - parse_simple_pragma(ModuleName, "no_inline", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = no_inline(Name, Arity)), - PragmaTerms, ErrorTerm, Result). - -parse_pragma_type(ModuleName, "memo", PragmaTerms, ErrorTerm, - _VarSet, Result) :- - parse_tabling_pragma(ModuleName, "memo", eval_memo, - PragmaTerms, ErrorTerm, Result). -parse_pragma_type(ModuleName, "loop_check", PragmaTerms, - ErrorTerm, _VarSet, Result) :- - parse_tabling_pragma(ModuleName, "loop_check", eval_loop_check, - PragmaTerms, ErrorTerm, Result). -parse_pragma_type(ModuleName, "minimal_model", PragmaTerms, ErrorTerm, - _VarSet, Result) :- - % We don't yet know whether we will use the stack_copy or the - % own_stacks technique for computing minimal models. The decision - % depends on the grade, and is made in make_hlds.m; the stack_copy here - % is just a placeholder. - parse_tabling_pragma(ModuleName, "minimal_model", - eval_minimal(stack_copy), PragmaTerms, ErrorTerm, Result). - -parse_pragma_type(ModuleName, "obsolete", PragmaTerms, ErrorTerm, - _VarSet, Result) :- - parse_simple_pragma(ModuleName, "obsolete", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = obsolete(Name, Arity)), - PragmaTerms, ErrorTerm, Result). - - % pragma unused_args should never appear in user programs, - % only in .opt files. -parse_pragma_type(ModuleName, "unused_args", PragmaTerms, - ErrorTerm, _VarSet, Result) :- - ( - PragmaTerms = [ - PredOrFuncTerm, - PredNameTerm, - term__functor(term__integer(Arity), [], _), - term__functor(term__integer(ModeNum), [], _), - UnusedArgsTerm - ], - ( - PredOrFuncTerm = term__functor( - term__atom("predicate"), [], _), - PredOrFunc = predicate - ; - PredOrFuncTerm = term__functor( - term__atom("function"), [], _), - PredOrFunc = function - ), - parse_implicitly_qualified_term(ModuleName, PredNameTerm, - ErrorTerm, "`:- pragma unused_args' declaration", - PredNameResult), - PredNameResult = ok(PredName, []), - convert_int_list(UnusedArgsTerm, UnusedArgsResult), - UnusedArgsResult = ok(UnusedArgs) - -> - Result = ok(pragma(unused_args(PredOrFunc, PredName, - Arity, ModeNum, UnusedArgs))) - ; - Result = error("error in `:- pragma unused_args'", ErrorTerm) - ). - -parse_pragma_type(ModuleName, "type_spec", PragmaTerms, ErrorTerm, - VarSet0, Result) :- - ( - ( - PragmaTerms = [PredAndModesTerm, TypeSubnTerm], - MaybeName = no - ; - PragmaTerms = [PredAndModesTerm, TypeSubnTerm, SpecNameTerm], - SpecNameTerm = term__functor(_, _, SpecContext), - - % This form of the pragma should not appear in source files. - term__context_file(SpecContext, FileName), - \+ string__remove_suffix(FileName, ".m", _), - - parse_implicitly_qualified_term(ModuleName, - SpecNameTerm, ErrorTerm, "", NameResult), - NameResult = ok(SpecName, []), - MaybeName = yes(SpecName) - ) - -> - parse_arity_or_modes(ModuleName, PredAndModesTerm, ErrorTerm, - "`:- pragma type_spec' declaration", - ArityOrModesResult), - ( - ArityOrModesResult = ok(arity_or_modes(PredName, - Arity, MaybePredOrFunc, MaybeModes)), - conjunction_to_list(TypeSubnTerm, TypeSubnList), - - % The varset is actually a tvarset. - varset__coerce(VarSet0, TVarSet), - ( list__map(convert_type_spec_pair, TypeSubnList, TypeSubn) -> - ( MaybeName = yes(SpecializedName0) -> - SpecializedName = SpecializedName0 - ; - unqualify_name(PredName, UnqualName), - make_pred_name(ModuleName, "TypeSpecOf", - MaybePredOrFunc, UnqualName, - type_subst(TVarSet, TypeSubn), - SpecializedName) - ), - Result = ok(pragma(type_spec(PredName, - SpecializedName, Arity, MaybePredOrFunc, - MaybeModes, TypeSubn, TVarSet, set__init))) - ; - Result = error( - "expected type substitution in `:- pragma type_spec' declaration", - TypeSubnTerm) - ) - ; - ArityOrModesResult = error(Msg, Term), - Result = error(Msg, Term) - ) - ; - Result = error( - "wrong number of arguments in `:- pragma type_spec' declaration", - ErrorTerm) - ). - -parse_pragma_type(ModuleName, "reserve_tag", PragmaTerms, ErrorTerm, - _VarSet, Result) :- - parse_simple_type_pragma(ModuleName, "reserve_tag", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = reserve_tag(Name, Arity)), - PragmaTerms, ErrorTerm, Result). - -parse_pragma_type(ModuleName, "fact_table", PragmaTerms, ErrorTerm, - _VarSet, Result) :- - ( - PragmaTerms = [PredAndArityTerm, FileNameTerm] - -> - parse_pred_name_and_arity(ModuleName, "fact_table", - PredAndArityTerm, ErrorTerm, NameArityResult), - ( - NameArityResult = ok(PredName, Arity), - ( - FileNameTerm = term__functor(term__string(FileName), [], _) - -> - Result = ok(pragma(fact_table(PredName, Arity, FileName))) - ; - Result = error("expected string for fact table filename", - FileNameTerm) - ) - ; - NameArityResult = error(ErrorMsg, _), - Result = error(ErrorMsg, PredAndArityTerm) - ) - ; - Result = - error( - "wrong number of arguments in `:- pragma fact_table' declaration", - ErrorTerm) - ). - -parse_pragma_type(ModuleName, "aditi", PragmaTerms, ErrorTerm, _, Result) :- - parse_simple_pragma(ModuleName, "aditi", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = aditi(Name, Arity)), - PragmaTerms, ErrorTerm, Result). - -parse_pragma_type(ModuleName, "base_relation", PragmaTerms, - ErrorTerm, _, Result) :- - parse_simple_pragma(ModuleName, "base_relation", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = base_relation(Name, Arity)), - PragmaTerms, ErrorTerm, Result). - -parse_pragma_type(ModuleName, "aditi_index", PragmaTerms, - ErrorTerm, _, Result) :- - ( PragmaTerms = [PredNameArityTerm, IndexTypeTerm, AttributesTerm] -> - parse_pred_name_and_arity(ModuleName, "aditi_index", - PredNameArityTerm, ErrorTerm, NameArityResult), - ( - NameArityResult = ok(PredName, PredArity), - ( - IndexTypeTerm = term__functor(term__atom(IndexTypeStr), - [], _), - ( - IndexTypeStr = "unique_B_tree", - IndexType = unique_B_tree - ; - IndexTypeStr = "non_unique_B_tree", - IndexType = non_unique_B_tree - ) - -> - convert_int_list(AttributesTerm, AttributeResult), - ( - AttributeResult = ok(Attributes), - Result = ok(pragma(aditi_index(PredName, PredArity, - index_spec(IndexType, Attributes)))) - ; - AttributeResult = error(_, AttrErrorTerm), - Result = error( - "expected attribute list for `:- pragma aditi_index' declaration", - AttrErrorTerm) - ) - ; - Result = error( - "expected index type for `:- pragma aditi_index' declaration", - IndexTypeTerm) - ) - ; - NameArityResult = error(NameErrorMsg, NameErrorTerm), - Result = error(NameErrorMsg, NameErrorTerm) - ) - ; - Result = error( - "wrong number of arguments in `:- pragma aditi_index' declaration", - ErrorTerm) - ). - -parse_pragma_type(ModuleName, "naive", PragmaTerms, ErrorTerm, _, Result) :- - parse_simple_pragma(ModuleName, "naive", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = naive(Name, Arity)), - PragmaTerms, ErrorTerm, Result). - -parse_pragma_type(ModuleName, "psn", PragmaTerms, ErrorTerm, _, Result) :- - parse_simple_pragma(ModuleName, "psn", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = psn(Name, Arity)), - PragmaTerms, ErrorTerm, Result). - -parse_pragma_type(ModuleName, "aditi_memo", - PragmaTerms, ErrorTerm, _, Result) :- - parse_simple_pragma(ModuleName, "aditi_memo", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = aditi_memo(Name, Arity)), - PragmaTerms, ErrorTerm, Result). - -parse_pragma_type(ModuleName, "aditi_no_memo", - PragmaTerms, ErrorTerm, _, Result) :- - parse_simple_pragma(ModuleName, "aditi_no_memo", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = aditi_no_memo(Name, Arity)), - PragmaTerms, ErrorTerm, Result). - -parse_pragma_type(ModuleName, "supp_magic", - PragmaTerms, ErrorTerm, _, Result) :- - parse_simple_pragma(ModuleName, "supp_magic", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = supp_magic(Name, Arity)), - PragmaTerms, ErrorTerm, Result). - -parse_pragma_type(ModuleName, "context", - PragmaTerms, ErrorTerm, _, Result) :- - parse_simple_pragma(ModuleName, "context", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = context(Name, Arity)), - PragmaTerms, ErrorTerm, Result). - -parse_pragma_type(ModuleName, "owner", - PragmaTerms, ErrorTerm, _, Result) :- - ( PragmaTerms = [SymNameAndArityTerm, OwnerTerm] -> - ( OwnerTerm = term__functor(term__atom(Owner), [], _) -> - parse_simple_pragma(ModuleName, "owner", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = owner(Name, Arity, Owner)), - [SymNameAndArityTerm], ErrorTerm, Result) - ; - ErrorMsg = "expected owner name for `:- pragma owner' declaration", - Result = error(ErrorMsg, OwnerTerm) - ) - ; - ErrorMsg = "wrong number of arguments in `:- pragma owner' declaration", - Result = error(ErrorMsg, ErrorTerm) - ). - -parse_pragma_type(ModuleName, "promise_pure", PragmaTerms, ErrorTerm, - _VarSet, Result) :- - parse_simple_pragma(ModuleName, "promise_pure", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = promise_pure(Name, Arity)), - PragmaTerms, ErrorTerm, Result). - -parse_pragma_type(ModuleName, "promise_semipure", PragmaTerms, ErrorTerm, - _VarSet, Result) :- - parse_simple_pragma(ModuleName, "promise_semipure", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = promise_semipure(Name, Arity)), - PragmaTerms, ErrorTerm, Result). - -parse_pragma_type(ModuleName, "termination_info", PragmaTerms, ErrorTerm, - _VarSet, Result) :- + ErrorTerm, _VarSet, Result) :- + string__format("invalid `:- pragma %s' declaration ", [s(Pragma)], + InvalidDeclStr), ( - PragmaTerms = [ - PredAndModesTerm0, - ArgSizeTerm, - TerminationTerm - ], - parse_pred_or_func_and_arg_modes(yes(ModuleName), PredAndModesTerm0, - ErrorTerm, "`:- pragma termination_info' declaration", - NameAndModesResult), - NameAndModesResult = ok(PredName - PredOrFunc, ModeList), - ( - ArgSizeTerm = term__functor(term__atom("not_set"), [], _), - MaybeArgSizeInfo = no - ; - ArgSizeTerm = term__functor(term__atom("infinite"), [], _), - MaybeArgSizeInfo = yes(infinite(unit)) - ; - ArgSizeTerm = term__functor(term__atom("finite"), - [IntTerm, UsedArgsTerm], _), - IntTerm = term__functor(term__integer(Int), [], _), - convert_bool_list(UsedArgsTerm, UsedArgs), - MaybeArgSizeInfo = yes(finite(Int, UsedArgs)) - ), - ( - TerminationTerm = term__functor(term__atom("not_set"), [], _), - MaybeTerminationInfo = no - ; - TerminationTerm = term__functor(term__atom("can_loop"), [], _), - MaybeTerminationInfo = yes(can_loop(unit)) - ; - TerminationTerm = term__functor(term__atom("cannot_loop"), - [], _), - MaybeTerminationInfo = yes(cannot_loop) - ), - Result0 = ok(pragma(termination_info(PredOrFunc, PredName, - ModeList, MaybeArgSizeInfo, MaybeTerminationInfo))) + ( + PragmaTerms = [LangTerm, HeaderTerm], + IsLocal = foreign_decl_is_exported + ; + PragmaTerms = [LangTerm, IsLocalTerm, HeaderTerm], + parse_foreign_decl_is_local(IsLocalTerm, IsLocal) + ) -> - Result = Result0 + ( parse_foreign_language(LangTerm, ForeignLanguage) -> + ( HeaderTerm = term__functor(term__string( HeaderCode), [], _) -> + DeclCode = foreign_decl(ForeignLanguage, IsLocal, HeaderCode), + Result = ok(pragma(DeclCode)) + ; + ErrMsg = "-- expected string for foreign declaration code", + Result = error(string__append(InvalidDeclStr, ErrMsg), + HeaderTerm) + ) + ; + ErrMsg = "-- invalid language parameter", + Result = error(InvalidDeclStr ++ ErrMsg, LangTerm) + ) ; - Result = error( - "syntax error in `:- pragma termination_info' declaration", - ErrorTerm) + string__format("invalid `:- pragma %s' declaration ", + [s(Pragma)], ErrorStr), + Result = error(ErrorStr, ErrorTerm) ). -parse_pragma_type(ModuleName, "terminates", PragmaTerms, - ErrorTerm, _VarSet, Result) :- - parse_simple_pragma(ModuleName, "terminates", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = terminates(Name, Arity)), - PragmaTerms, ErrorTerm, Result). + % This predicate parses both c_code and foreign_code pragmas. + % Processing of foreign_proc (or c_code that defines a procedure) + % is handled in parse_pragma_foreign_proc_pragma below. + % +:- pred parse_pragma_foreign_code_pragma(module_name::in, string::in, + list(term)::in, term::in, varset::in, maybe1(item)::out) is det. -parse_pragma_type(ModuleName, "does_not_terminate", PragmaTerms, - ErrorTerm, _VarSet, Result) :- - parse_simple_pragma(ModuleName, "does_not_terminate", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = does_not_terminate(Name, Arity)), - PragmaTerms, ErrorTerm, Result). +parse_pragma_foreign_code_pragma(_ModuleName, Pragma, PragmaTerms, + ErrorTerm, _VarSet, Result) :- + string__format("invalid `:- pragma %s' declaration ", [s(Pragma)], + InvalidDeclStr), -parse_pragma_type(ModuleName, "exceptions", PragmaTerms, - ErrorTerm, _VarSet, Result) :- - ( - PragmaTerms = [ - PredOrFuncTerm, - PredNameTerm, - term.functor(term.integer(Arity), [], _), - term.functor(term.integer(ModeNum), [], _), - ThrowStatusTerm - ], - ( - PredOrFuncTerm = term.functor( - term.atom("predicate"), [], _), - PredOrFunc = predicate - ; - PredOrFuncTerm = term.functor( - term.atom("function"), [], _), - PredOrFunc = function - ), - parse_implicitly_qualified_term(ModuleName, PredNameTerm, - ErrorTerm, "`:- pragma exceptions' declaration", - PredNameResult), - PredNameResult = ok(PredName, []), - ( - ThrowStatusTerm = term.functor( - term.atom("will_not_throw"), [], _), - ThrowStatus = will_not_throw - ; - ThrowStatusTerm = term.functor( - term.atom("may_throw"), - [ExceptionTypeTerm], _), - ( - ExceptionTypeTerm = term.functor( - term.atom("user_exception"), [], _), - ExceptionType = user_exception - ; - ExceptionTypeTerm = term.functor( - term.atom("type_exception"), [], _), - ExceptionType = type_exception - ), - ThrowStatus = may_throw(ExceptionType) - ; - ThrowStatusTerm = term.functor( - term.atom("conditional"), [], _), - ThrowStatus = conditional - ) - -> - Result = ok(pragma(exceptions(PredOrFunc, PredName, - Arity, ModeNum, ThrowStatus))) - ; - Result = error("error in `:- pragma exceptions'", ErrorTerm) - ). + Check1 = (func(PTerms1, ForeignLanguage) = Res is semidet :- + PTerms1 = [Just_Code_Term], + ( Just_Code_Term = term__functor(term__string(Just_Code), [], _) -> + Res = ok(pragma(foreign_code(ForeignLanguage, Just_Code))) + ; + ErrMsg = "-- expected string for foreign code", + Res = error(string__append(InvalidDeclStr, ErrMsg), ErrorTerm) + ) + ), -parse_pragma_type(ModuleName, "check_termination", PragmaTerms, - ErrorTerm, _VarSet, Result) :- - parse_simple_pragma(ModuleName, "check_termination", - (pred(Name::in, Arity::in, Pragma::out) is det :- - Pragma = check_termination(Name, Arity)), - PragmaTerms, ErrorTerm, Result). + CheckLength = (func(PTermsLen, ForeignLanguage) = Res :- + ( Res0 = Check1(PTermsLen, ForeignLanguage) -> + Res = Res0 + ; + ErrMsg = "-- wrong number of arguments", + Res = error(string__append(InvalidDeclStr, ErrMsg), ErrorTerm) + ) + ), - % This parses a pragma that refers to a predicate or function. - % -:- pred parse_simple_pragma(module_name::in, string::in, - pred(sym_name, int, pragma_type)::(pred(in, in, out) is det), - list(term)::in, term::in, maybe1(item)::out) is det. + CheckLanguage = (func(PTermsLang) = Res is semidet :- + PTermsLang = [Lang | Rest], + ( parse_foreign_language(Lang, ForeignLanguage) -> + Res = CheckLength(Rest, ForeignLanguage) + ; + ErrMsg = "-- invalid language parameter", + Res = error(string__append(InvalidDeclStr, ErrMsg), Lang) + ) + ), -parse_simple_pragma(ModuleName, PragmaType, MakePragma, - PragmaTerms, ErrorTerm, Result) :- - parse_simple_pragma_base(ModuleName, PragmaType, - "predicate or function", MakePragma, PragmaTerms, ErrorTerm, - Result). + ( Result0 = CheckLanguage(PragmaTerms) -> + Result = Result0 + ; + ErrMsg0 = "-- wrong number of arguments", + Result = error(string__append(InvalidDeclStr, ErrMsg0), ErrorTerm) + ). - % This parses a pragma that refers to type. - % -:- pred parse_simple_type_pragma(module_name::in, string::in, - pred(sym_name, int, pragma_type)::(pred(in, in, out) is det), - list(term)::in, term::in, maybe1(item)::out) is det. + % This predicate parses both c_code and foreign_proc pragmas. + % +:- pred parse_pragma_foreign_proc_pragma(module_name::in, string::in, + list(term)::in, term::in, varset::in, maybe1(item)::out) is det. -parse_simple_type_pragma(ModuleName, PragmaType, MakePragma, - PragmaTerms, ErrorTerm, Result) :- - parse_simple_pragma_base(ModuleName, PragmaType, "type", MakePragma, - PragmaTerms, ErrorTerm, Result). +parse_pragma_foreign_proc_pragma(ModuleName, Pragma, PragmaTerms, + ErrorTerm, VarSet, Result) :- + string__format("invalid `:- pragma %s' declaration ", [s(Pragma)], + InvalidDeclStr), - % This parses a pragma that refers to symbol name / arity. - % -:- pred parse_simple_pragma_base(module_name::in, string::in, string::in, - pred(sym_name, int, pragma_type)::(pred(in, in, out) is det), - list(term)::in, term::in, maybe1(item)::out) is det. + Check6 = (func(PTerms6, ForeignLanguage) = Res is semidet :- + PTerms6 = [PredAndVarsTerm, FlagsTerm, FieldsTerm, + FirstTerm, LaterTerm, SharedTerm], + parse_pragma_foreign_proc_attributes_term(ForeignLanguage, Pragma, + FlagsTerm, MaybeFlags), + ( MaybeFlags = ok(Flags) -> + ( + parse_pragma_keyword("local_vars", FieldsTerm, Fields, + FieldsContext) + -> + ( + parse_pragma_keyword("first_code", FirstTerm, First, + FirstContext) + -> + ( + parse_pragma_keyword("retry_code", LaterTerm, + Later, LaterContext) + -> + ( + parse_pragma_keyword("shared_code", SharedTerm, + Shared, SharedContext) + -> + parse_pragma_foreign_code(ModuleName, Flags, + PredAndVarsTerm, + nondet(Fields, yes(FieldsContext), + First, yes(FirstContext), + Later, yes(LaterContext), + share, Shared, yes(SharedContext)), + VarSet, Res) + ; + parse_pragma_keyword("duplicated_code", + SharedTerm, Shared, SharedContext) + -> + parse_pragma_foreign_code(ModuleName, Flags, + PredAndVarsTerm, + nondet(Fields, yes(FieldsContext), + First, yes(FirstContext), + Later, yes(LaterContext), + duplicate, Shared, yes(SharedContext)), + VarSet, Res) + ; + parse_pragma_keyword("common_code", SharedTerm, + Shared, SharedContext) + -> + parse_pragma_foreign_code(ModuleName, Flags, + PredAndVarsTerm, + nondet(Fields, yes(FieldsContext), + First, yes(FirstContext), + Later, yes(LaterContext), + automatic, Shared, yes(SharedContext)), + VarSet, Res) + ; + ErrMsg = "-- invalid seventh argument, " + ++ "expecting `common_code()'", + Res = error(string__append(InvalidDeclStr, + ErrMsg), SharedTerm) + ) + ; + ErrMsg = "-- invalid sixth argument, " + ++ "expecting `retry_code()'", + Res = error(string__append(InvalidDeclStr, ErrMsg), + LaterTerm) + ) + ; + ErrMsg = "-- invalid fifth argument, " + ++ "expecting `first_code()'", + Res = error(string__append(InvalidDeclStr, ErrMsg), + FirstTerm) + ) + ; + ErrMsg = "-- invalid fourth argument, " + ++ "expecting `local_vars()'", + Res = error(string__append(InvalidDeclStr, ErrMsg), + FieldsTerm) + ) + ; + MaybeFlags = error(FlagsErrorStr, ErrorTerm), + ErrMsg = "-- invalid third argument: " ++ FlagsErrorStr, + Res = error(string__append(InvalidDeclStr, ErrMsg), ErrorTerm) + ) + ), -parse_simple_pragma_base(ModuleName, PragmaType, NameKind, MakePragma, - PragmaTerms, ErrorTerm, Result) :- - ( PragmaTerms = [PredAndArityTerm] -> - parse_simple_name_and_arity(ModuleName, PragmaType, NameKind, - PredAndArityTerm, ErrorTerm, NameArityResult), - ( - NameArityResult = ok(PredName, Arity), - call(MakePragma, PredName, Arity, Pragma), - Result = ok(pragma(Pragma)) - ; - NameArityResult = error(ErrorMsg, _), - Result = error(ErrorMsg, PredAndArityTerm) - ) - ; - string__append_list(["wrong number of arguments in `:- pragma ", - PragmaType, "' declaration"], ErrorMsg), - Result = error(ErrorMsg, ErrorTerm) + Check5 = (func(PTerms5, ForeignLanguage) = Res is semidet :- + PTerms5 = [PredAndVarsTerm, FlagsTerm, FieldsTerm, + FirstTerm, LaterTerm], + term__context_init(DummyContext), + SharedTerm = term__functor(term__atom("common_code"), + [term__functor(term__string(""), [], DummyContext)], + DummyContext), + Res = Check6([PredAndVarsTerm, FlagsTerm, FieldsTerm, FirstTerm, + LaterTerm, SharedTerm], ForeignLanguage) + ), + + Check3 = (func(PTerms3, ForeignLanguage) = Res is semidet :- + PTerms3 = [PredAndVarsTerm, FlagsTerm, CodeTerm], + ( CodeTerm = term__functor(term__string(Code), [], Context) -> + parse_pragma_foreign_proc_attributes_term(ForeignLanguage, + Pragma, FlagsTerm, MaybeFlags), + ( + MaybeFlags = ok(Flags), + parse_pragma_foreign_code(ModuleName, Flags, + PredAndVarsTerm, ordinary(Code, yes(Context)), + VarSet, Res) + ; + MaybeFlags = error(FlagsErr, FlagsErrTerm), + parse_pragma_foreign_proc_attributes_term( + ForeignLanguage, Pragma, PredAndVarsTerm, + MaybeFlags2), + ( + MaybeFlags2 = ok(Flags), + % XXX we should issue a warning; this syntax is + % deprecated We will continue to accept this if + % c_code is used, but not with foreign_code + ( Pragma = "c_code" -> + parse_pragma_foreign_code(ModuleName, + Flags, FlagsTerm, ordinary(Code, yes(Context)), + VarSet, Res) + ; + ErrMsg = "-- invalid second argument, " + ++ "expecting predicate " + ++ "or function mode", + Res = error(string__append(InvalidDeclStr, ErrMsg), + PredAndVarsTerm) + ) + ; + MaybeFlags2 = error(_, _), + ErrMsg = "-- invalid third argument: ", + Res = error(InvalidDeclStr ++ ErrMsg ++ FlagsErr, + FlagsErrTerm) + ) + ) + ; + ErrMsg = "-- invalid fourth argument, " + ++ "expecting string containing foreign code", + Res = error(string__append(InvalidDeclStr, ErrMsg), CodeTerm) + ) + ), + + Check2 = (func(PTerms2, ForeignLanguage) = Res is semidet :- + PTerms2 = [PredAndVarsTerm, CodeTerm], + % XXX we should issue a warning; this syntax is deprecated. + % We will continue to accept this if c_code is used, but + % not with foreign_code + ( Pragma = "c_code" -> + % may_call_mercury is a conservative default. + Attributes0 = default_attributes(ForeignLanguage), + set_legacy_purity_behaviour(yes, Attributes0, Attributes), + ( CodeTerm = term__functor(term__string(Code), [], Context) -> + parse_pragma_foreign_code(ModuleName, Attributes, + PredAndVarsTerm, ordinary(Code, yes(Context)), VarSet, Res) + ; + ErrMsg = "-- expecting either " + ++ "`may_call_mercury' or " + ++ "`will_not_call_mercury', " + ++ "and a string for foreign code", + Res = error(string__append(InvalidDeclStr, ErrMsg), CodeTerm) + ) + ; + ErrMsg = "-- doesn't say whether it can call mercury", + Res = error(string__append(InvalidDeclStr, ErrMsg), ErrorTerm) + ) + ), + + CheckLength = (func(PTermsLen, ForeignLanguage) = Res :- + ( Res0 = Check2(PTermsLen, ForeignLanguage) -> + Res = Res0 + ; Res0 = Check3(PTermsLen, ForeignLanguage) -> + Res = Res0 + ; Res0 = Check5(PTermsLen, ForeignLanguage) -> + Res = Res0 + ; Res0 = Check6(PTermsLen, ForeignLanguage) -> + Res = Res0 + ; + ErrMsg = "-- wrong number of arguments", + Res = error(string__append(InvalidDeclStr, ErrMsg), ErrorTerm) + ) + ), + + CheckLanguage = (func(PTermsLang) = Res is semidet :- + PTermsLang = [Lang | Rest], + ( parse_foreign_language(Lang, ForeignLanguage) -> + Res = CheckLength(Rest, ForeignLanguage) + ; + ErrMsg = "-- invalid language parameter", + Res = error(string__append(InvalidDeclStr, ErrMsg), Lang) + ) + ), + + ( Result0 = CheckLanguage(PragmaTerms) -> + Result = Result0 + ; + ErrMsg0 = "-- wrong number of arguments", + Result = error(string__append(InvalidDeclStr, ErrMsg0), ErrorTerm) + ). + +parse_pragma_type(ModuleName, "import", PragmaTerms, ErrorTerm, _VarSet, + Result) :- + % XXX we assume all imports are C + ForeignLanguage = c, + ( + ( + PragmaTerms = [PredAndModesTerm, FlagsTerm, FunctionTerm], + parse_pragma_foreign_proc_attributes_term(ForeignLanguage, + "import", FlagsTerm, MaybeFlags), + ( + MaybeFlags = error(FlagError, ErrorTerm), + FlagsResult = error("invalid second argument in " + ++ "`:- pragma import/3' declaration : " + ++ FlagError, ErrorTerm) + ; + MaybeFlags = ok(Flags), + FlagsResult = ok(Flags) + ) + ; + PragmaTerms = [PredAndModesTerm, FunctionTerm], + Flags0 = default_attributes(ForeignLanguage), + % pragma import uses legacy purity behaviour + set_legacy_purity_behaviour(yes, Flags0, Flags), + FlagsResult = ok(Flags) + ) + -> + ( FunctionTerm = term__functor(term__string(Function), [], _) -> + parse_pred_or_func_and_arg_modes(yes(ModuleName), + PredAndModesTerm, ErrorTerm, "`:- pragma import' declaration", + PredAndArgModesResult), + ( + PredAndArgModesResult = ok(PredName - PredOrFunc, + ArgModes), + ( + FlagsResult = ok(Attributes), + Result = ok(pragma(import(PredName, PredOrFunc, + ArgModes, Attributes, Function))) + ; + FlagsResult = error(Msg, Term), + Result = error(Msg, Term) + ) + ; + PredAndArgModesResult = error(Msg, Term), + Result = error(Msg, Term) + ) + ; + Result = error("expected pragma import(PredName(ModeList), " + ++ "Function)", PredAndModesTerm) + ) + ; + Result = error("wrong number of arguments in " ++ + "`:- pragma import' declaration", ErrorTerm) + ). + +parse_pragma_type(_ModuleName, "export", PragmaTerms, ErrorTerm, _VarSet, + Result) :- + % XXX we implicitly assume exports are only for C + ( PragmaTerms = [PredAndModesTerm, FunctionTerm] -> + ( FunctionTerm = term__functor(term__string(Function), [], _) -> + parse_pred_or_func_and_arg_modes(no, PredAndModesTerm, + ErrorTerm, "`:- pragma export' declaration", + PredAndModesResult), + ( + PredAndModesResult = ok(PredName - PredOrFunc, Modes), + Result = ok(pragma(export(PredName, PredOrFunc, Modes, + Function))) + ; + PredAndModesResult = error(Msg, Term), + Result = error(Msg, Term) + ) + ; + Result = error( + "expected pragma export(PredName(ModeList), Function)", + PredAndModesTerm) + ) + ; + Result = error("wrong number of arguments in " ++ + "`:- pragma export' declaration", ErrorTerm) ). +parse_pragma_type(ModuleName, "inline", PragmaTerms, ErrorTerm, _VarSet, + Result) :- + parse_simple_pragma(ModuleName, "inline", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = inline(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "no_inline", PragmaTerms, ErrorTerm, _VarSet, + Result) :- + parse_simple_pragma(ModuleName, "no_inline", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = no_inline(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "memo", PragmaTerms, ErrorTerm, _VarSet, + Result) :- + parse_tabling_pragma(ModuleName, "memo", eval_memo, + PragmaTerms, ErrorTerm, Result). +parse_pragma_type(ModuleName, "loop_check", PragmaTerms, ErrorTerm, _VarSet, + Result) :- + parse_tabling_pragma(ModuleName, "loop_check", eval_loop_check, + PragmaTerms, ErrorTerm, Result). +parse_pragma_type(ModuleName, "minimal_model", PragmaTerms, ErrorTerm, _VarSet, + Result) :- + % We don't yet know whether we will use the stack_copy or the + % own_stacks technique for computing minimal models. The decision + % depends on the grade, and is made in make_hlds.m; the stack_copy here + % is just a placeholder. + parse_tabling_pragma(ModuleName, "minimal_model", + eval_minimal(stack_copy), PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "obsolete", PragmaTerms, ErrorTerm, _VarSet, + Result) :- + parse_simple_pragma(ModuleName, "obsolete", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = obsolete(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + + % pragma unused_args should never appear in user programs, + % only in .opt files. +parse_pragma_type(ModuleName, "unused_args", PragmaTerms, ErrorTerm, _VarSet, + Result) :- + ( + PragmaTerms = [ + PredOrFuncTerm, + PredNameTerm, + term__functor(term__integer(Arity), [], _), + term__functor(term__integer(ModeNum), [], _), + UnusedArgsTerm + ], + ( + PredOrFuncTerm = term__functor(term__atom("predicate"), [], _), + PredOrFunc = predicate + ; + PredOrFuncTerm = term__functor(term__atom("function"), [], _), + PredOrFunc = function + ), + parse_implicitly_qualified_term(ModuleName, PredNameTerm, ErrorTerm, + "`:- pragma unused_args' declaration", PredNameResult), + PredNameResult = ok(PredName, []), + convert_int_list(UnusedArgsTerm, UnusedArgsResult), + UnusedArgsResult = ok(UnusedArgs) + -> + Result = ok(pragma(unused_args(PredOrFunc, PredName, Arity, ModeNum, + UnusedArgs))) + ; + Result = error("error in `:- pragma unused_args'", ErrorTerm) + ). + +parse_pragma_type(ModuleName, "type_spec", PragmaTerms, ErrorTerm, VarSet0, + Result) :- + ( + ( + PragmaTerms = [PredAndModesTerm, TypeSubnTerm], + MaybeName = no + ; + PragmaTerms = [PredAndModesTerm, TypeSubnTerm, SpecNameTerm], + SpecNameTerm = term__functor(_, _, SpecContext), + + % This form of the pragma should not appear in source files. + term__context_file(SpecContext, FileName), + \+ string__remove_suffix(FileName, ".m", _), + + parse_implicitly_qualified_term(ModuleName, + SpecNameTerm, ErrorTerm, "", NameResult), + NameResult = ok(SpecName, []), + MaybeName = yes(SpecName) + ) + -> + parse_arity_or_modes(ModuleName, PredAndModesTerm, ErrorTerm, + "`:- pragma type_spec' declaration", + ArityOrModesResult), + ( + ArityOrModesResult = ok(arity_or_modes(PredName, Arity, + MaybePredOrFunc, MaybeModes)), + conjunction_to_list(TypeSubnTerm, TypeSubnList), + + % The varset is actually a tvarset. + varset__coerce(VarSet0, TVarSet), + ( list__map(convert_type_spec_pair, TypeSubnList, TypeSubn) -> + ( MaybeName = yes(SpecializedName0) -> + SpecializedName = SpecializedName0 + ; + unqualify_name(PredName, UnqualName), + make_pred_name(ModuleName, "TypeSpecOf", MaybePredOrFunc, + UnqualName, type_subst(TVarSet, TypeSubn), + SpecializedName) + ), + Result = ok(pragma(type_spec(PredName, SpecializedName, Arity, + MaybePredOrFunc, MaybeModes, TypeSubn, TVarSet, + set__init))) + ; + Result = error("expected type substitution in " ++ + "`:- pragma type_spec' declaration", TypeSubnTerm) + ) + ; + ArityOrModesResult = error(Msg, Term), + Result = error(Msg, Term) + ) + ; + Result = error("wrong number of arguments in " ++ + "`:- pragma type_spec' declaration", ErrorTerm) + ). + +parse_pragma_type(ModuleName, "reserve_tag", PragmaTerms, ErrorTerm, _VarSet, + Result) :- + parse_simple_type_pragma(ModuleName, "reserve_tag", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = reserve_tag(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "fact_table", PragmaTerms, ErrorTerm, _VarSet, + Result) :- + ( PragmaTerms = [PredAndArityTerm, FileNameTerm] -> + parse_pred_name_and_arity(ModuleName, "fact_table", + PredAndArityTerm, ErrorTerm, NameArityResult), + ( + NameArityResult = ok(PredName, Arity), + ( FileNameTerm = term__functor(term__string(FileName), [], _) -> + Result = ok(pragma(fact_table(PredName, Arity, FileName))) + ; + Result = error("expected string for fact table filename", + FileNameTerm) + ) + ; + NameArityResult = error(ErrorMsg, _), + Result = error(ErrorMsg, PredAndArityTerm) + ) + ; + Result = error("wrong number of arguments in " ++ + "`:- pragma fact_table' declaration", ErrorTerm) + ). + +parse_pragma_type(ModuleName, "aditi", PragmaTerms, ErrorTerm, _, Result) :- + parse_simple_pragma(ModuleName, "aditi", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = aditi(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "base_relation", PragmaTerms, ErrorTerm, _, + Result) :- + parse_simple_pragma(ModuleName, "base_relation", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = base_relation(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "aditi_index", PragmaTerms, ErrorTerm, _, + Result) :- + ( PragmaTerms = [PredNameArityTerm, IndexTypeTerm, AttributesTerm] -> + parse_pred_name_and_arity(ModuleName, "aditi_index", + PredNameArityTerm, ErrorTerm, NameArityResult), + ( + NameArityResult = ok(PredName, PredArity), + ( + IndexTypeTerm = term__functor(term__atom(IndexTypeStr), [], _), + ( + IndexTypeStr = "unique_B_tree", + IndexType = unique_B_tree + ; + IndexTypeStr = "non_unique_B_tree", + IndexType = non_unique_B_tree + ) + -> + convert_int_list(AttributesTerm, AttributeResult), + ( + AttributeResult = ok(Attributes), + Result = ok(pragma(aditi_index(PredName, PredArity, + index_spec(IndexType, Attributes)))) + ; + AttributeResult = error(_, AttrErrorTerm), + Result = error("expected attribute list for " ++ + "`:- pragma aditi_index' declaration", AttrErrorTerm) + ) + ; + Result = error("expected index type for " ++ + "`:- pragma aditi_index' declaration", IndexTypeTerm) + ) + ; + NameArityResult = error(NameErrorMsg, NameErrorTerm), + Result = error(NameErrorMsg, NameErrorTerm) + ) + ; + Result = error("wrong number of arguments in " ++ + "`:- pragma aditi_index' declaration", ErrorTerm) + ). + +parse_pragma_type(ModuleName, "naive", PragmaTerms, ErrorTerm, _, Result) :- + parse_simple_pragma(ModuleName, "naive", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = naive(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "psn", PragmaTerms, ErrorTerm, _, Result) :- + parse_simple_pragma(ModuleName, "psn", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = psn(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "aditi_memo", PragmaTerms, ErrorTerm, _, + Result) :- + parse_simple_pragma(ModuleName, "aditi_memo", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = aditi_memo(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "aditi_no_memo", PragmaTerms, ErrorTerm, _, + Result) :- + parse_simple_pragma(ModuleName, "aditi_no_memo", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = aditi_no_memo(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "supp_magic", PragmaTerms, ErrorTerm, _, + Result) :- + parse_simple_pragma(ModuleName, "supp_magic", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = supp_magic(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "context", PragmaTerms, ErrorTerm, _, Result) :- + parse_simple_pragma(ModuleName, "context", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = context(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "owner", PragmaTerms, ErrorTerm, _, Result) :- + ( PragmaTerms = [SymNameAndArityTerm, OwnerTerm] -> + ( OwnerTerm = term__functor(term__atom(Owner), [], _) -> + parse_simple_pragma(ModuleName, "owner", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = owner(Name, Arity, Owner)), + [SymNameAndArityTerm], ErrorTerm, Result) + ; + ErrorMsg = "expected owner name for `:- pragma owner' declaration", + Result = error(ErrorMsg, OwnerTerm) + ) + ; + ErrorMsg = "wrong number of arguments in " ++ + "`:- pragma owner' declaration", + Result = error(ErrorMsg, ErrorTerm) + ). + +parse_pragma_type(ModuleName, "promise_pure", PragmaTerms, ErrorTerm, _VarSet, + Result) :- + parse_simple_pragma(ModuleName, "promise_pure", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = promise_pure(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "promise_semipure", PragmaTerms, ErrorTerm, + _VarSet, Result) :- + parse_simple_pragma(ModuleName, "promise_semipure", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = promise_semipure(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "termination_info", PragmaTerms, ErrorTerm, + _VarSet, Result) :- + ( + PragmaTerms = [ + PredAndModesTerm0, + ArgSizeTerm, + TerminationTerm + ], + parse_pred_or_func_and_arg_modes(yes(ModuleName), PredAndModesTerm0, + ErrorTerm, "`:- pragma termination_info' declaration", + NameAndModesResult), + NameAndModesResult = ok(PredName - PredOrFunc, ModeList), + ( + ArgSizeTerm = term__functor(term__atom("not_set"), [], _), + MaybeArgSizeInfo = no + ; + ArgSizeTerm = term__functor(term__atom("infinite"), [], _), + MaybeArgSizeInfo = yes(infinite(unit)) + ; + ArgSizeTerm = term__functor(term__atom("finite"), + [IntTerm, UsedArgsTerm], _), + IntTerm = term__functor(term__integer(Int), [], _), + convert_bool_list(UsedArgsTerm, UsedArgs), + MaybeArgSizeInfo = yes(finite(Int, UsedArgs)) + ), + ( + TerminationTerm = term__functor(term__atom("not_set"), [], _), + MaybeTerminationInfo = no + ; + TerminationTerm = term__functor(term__atom("can_loop"), [], _), + MaybeTerminationInfo = yes(can_loop(unit)) + ; + TerminationTerm = term__functor(term__atom("cannot_loop"), [], _), + MaybeTerminationInfo = yes(cannot_loop) + ), + Result0 = ok(pragma(termination_info(PredOrFunc, PredName, + ModeList, MaybeArgSizeInfo, MaybeTerminationInfo))) + -> + Result = Result0 + ; + Result = error("syntax error in `:- pragma termination_info' " ++ + "declaration", ErrorTerm) + ). + +parse_pragma_type(ModuleName, "terminates", PragmaTerms, ErrorTerm, _VarSet, + Result) :- + parse_simple_pragma(ModuleName, "terminates", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = terminates(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "does_not_terminate", PragmaTerms, ErrorTerm, + _VarSet, Result) :- + parse_simple_pragma(ModuleName, "does_not_terminate", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = does_not_terminate(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + +parse_pragma_type(ModuleName, "exceptions", PragmaTerms, ErrorTerm, _VarSet, + Result) :- + ( + PragmaTerms = [ + PredOrFuncTerm, + PredNameTerm, + term.functor(term.integer(Arity), [], _), + term.functor(term.integer(ModeNum), [], _), + ThrowStatusTerm + ], + ( + PredOrFuncTerm = term.functor(term.atom("predicate"), [], _), + PredOrFunc = predicate + ; + PredOrFuncTerm = term.functor(term.atom("function"), [], _), + PredOrFunc = function + ), + parse_implicitly_qualified_term(ModuleName, PredNameTerm, + ErrorTerm, "`:- pragma exceptions' declaration", + PredNameResult), + PredNameResult = ok(PredName, []), + ( + ThrowStatusTerm = term.functor(term.atom("will_not_throw"), [], _), + ThrowStatus = will_not_throw + ; + ThrowStatusTerm = term.functor(term.atom("may_throw"), + [ExceptionTypeTerm], _), + ( + ExceptionTypeTerm = term.functor( + term.atom("user_exception"), [], _), + ExceptionType = user_exception + ; + ExceptionTypeTerm = term.functor( + term.atom("type_exception"), [], _), + ExceptionType = type_exception + ), + ThrowStatus = may_throw(ExceptionType) + ; + ThrowStatusTerm = term.functor( + term.atom("conditional"), [], _), + ThrowStatus = conditional + ) + -> + Result = ok(pragma(exceptions(PredOrFunc, PredName, + Arity, ModeNum, ThrowStatus))) + ; + Result = error("error in `:- pragma exceptions'", ErrorTerm) + ). + +parse_pragma_type(ModuleName, "check_termination", PragmaTerms, ErrorTerm, + _VarSet, Result) :- + parse_simple_pragma(ModuleName, "check_termination", + (pred(Name::in, Arity::in, Pragma::out) is det :- + Pragma = check_termination(Name, Arity)), + PragmaTerms, ErrorTerm, Result). + + % This parses a pragma that refers to a predicate or function. + % +:- pred parse_simple_pragma(module_name::in, string::in, + pred(sym_name, int, pragma_type)::(pred(in, in, out) is det), + list(term)::in, term::in, maybe1(item)::out) is det. + +parse_simple_pragma(ModuleName, PragmaType, MakePragma, PragmaTerms, ErrorTerm, + Result) :- + parse_simple_pragma_base(ModuleName, PragmaType, + "predicate or function", MakePragma, PragmaTerms, ErrorTerm, + Result). + + % This parses a pragma that refers to type. + % +:- pred parse_simple_type_pragma(module_name::in, string::in, + pred(sym_name, int, pragma_type)::(pred(in, in, out) is det), + list(term)::in, term::in, maybe1(item)::out) is det. + +parse_simple_type_pragma(ModuleName, PragmaType, MakePragma, + PragmaTerms, ErrorTerm, Result) :- + parse_simple_pragma_base(ModuleName, PragmaType, "type", MakePragma, + PragmaTerms, ErrorTerm, Result). + + % This parses a pragma that refers to symbol name / arity. + % +:- pred parse_simple_pragma_base(module_name::in, string::in, string::in, + pred(sym_name, int, pragma_type)::(pred(in, in, out) is det), + list(term)::in, term::in, maybe1(item)::out) is det. + +parse_simple_pragma_base(ModuleName, PragmaType, NameKind, MakePragma, + PragmaTerms, ErrorTerm, Result) :- + ( PragmaTerms = [PredAndArityTerm] -> + parse_simple_name_and_arity(ModuleName, PragmaType, NameKind, + PredAndArityTerm, ErrorTerm, NameArityResult), + ( + NameArityResult = ok(PredName, Arity), + call(MakePragma, PredName, Arity, Pragma), + Result = ok(pragma(Pragma)) + ; + NameArityResult = error(ErrorMsg, _), + Result = error(ErrorMsg, PredAndArityTerm) + ) + ; + string__append_list(["wrong number of arguments in `:- pragma ", + PragmaType, "' declaration"], ErrorMsg), + Result = error(ErrorMsg, ErrorTerm) + ). + :- pred parse_pred_name_and_arity(module_name::in, string::in, term::in, - term::in, maybe2(sym_name, arity)::out) is det. + term::in, maybe2(sym_name, arity)::out) is det. parse_pred_name_and_arity(ModuleName, PragmaType, NameAndArityTerm, ErrorTerm, - Result) :- - parse_simple_name_and_arity(ModuleName, PragmaType, - "predicate or function", NameAndArityTerm, ErrorTerm, Result). + Result) :- + parse_simple_name_and_arity(ModuleName, PragmaType, + "predicate or function", NameAndArityTerm, ErrorTerm, Result). :- pred parse_simple_name_and_arity(module_name::in, string::in, string::in, - term::in, term::in, maybe2(sym_name, arity)::out) is det. + term::in, term::in, maybe2(sym_name, arity)::out) is det. parse_simple_name_and_arity(ModuleName, PragmaType, NameKind, - NameAndArityTerm, ErrorTerm, Result) :- - ( - parse_name_and_arity(ModuleName, NameAndArityTerm, - Name, Arity) - -> - Result = ok(Name, Arity) - ; - string__append_list(["expected ", NameKind, - " name/arity for `pragma ", - PragmaType, "' declaration"], ErrorMsg), - Result = error(ErrorMsg, ErrorTerm) - ). + NameAndArityTerm, ErrorTerm, Result) :- + ( parse_name_and_arity(ModuleName, NameAndArityTerm, Name, Arity) -> + Result = ok(Name, Arity) + ; + string__append_list(["expected ", NameKind, " name/arity for `pragma ", + PragmaType, "' declaration"], ErrorMsg), + Result = error(ErrorMsg, ErrorTerm) + ). %-----------------------------------------------------------------------------% :- pred parse_pragma_keyword(string::in, term::in, string::out, - term__context::out) is semidet. + term__context::out) is semidet. parse_pragma_keyword(ExpectedKeyword, Term, StringArg, StartContext) :- - Term = term__functor(term__atom(ExpectedKeyword), [Arg], _), - Arg = term__functor(term__string(StringArg), [], StartContext). + Term = term__functor(term__atom(ExpectedKeyword), [Arg], _), + Arg = term__functor(term__string(StringArg), [], StartContext). %-----------------------------------------------------------------------------% :- type collected_pragma_foreign_proc_attribute - ---> may_call_mercury(may_call_mercury) - ; thread_safe(thread_safe) - ; tabled_for_io(tabled_for_io) - ; purity(purity) - ; aliasing - ; max_stack_size(int) - ; terminates(terminates) - ; will_not_throw_exception - ; ordinary_despite_detism. + ---> may_call_mercury(may_call_mercury) + ; thread_safe(thread_safe) + ; tabled_for_io(tabled_for_io) + ; purity(purity) + ; aliasing + ; max_stack_size(int) + ; terminates(terminates) + ; will_not_throw_exception + ; ordinary_despite_detism. :- pred parse_pragma_foreign_proc_attributes_term(foreign_language::in, - string::in, term::in, maybe1(pragma_foreign_proc_attributes)::out) - is det. + string::in, term::in, maybe1(pragma_foreign_proc_attributes)::out) + is det. parse_pragma_foreign_proc_attributes_term(ForeignLanguage, Pragma, Term, - MaybeAttributes) :- - Attributes0 = default_attributes(ForeignLanguage), - ( ( Pragma = "c_code" ; Pragma = "import" ) -> - set_legacy_purity_behaviour(yes, Attributes0, Attributes1), - set_purity(pure, Attributes1, Attributes2) - ; - Attributes2 = Attributes0 - ), - ConflictingAttributes = [ - may_call_mercury(will_not_call_mercury) - - may_call_mercury(may_call_mercury), - thread_safe(thread_safe) - - thread_safe(not_thread_safe), - tabled_for_io(tabled_for_io) - - tabled_for_io(tabled_for_io_unitize), - tabled_for_io(tabled_for_io) - - tabled_for_io(tabled_for_descendant_io), - tabled_for_io(tabled_for_io) - - tabled_for_io(not_tabled_for_io), - tabled_for_io(tabled_for_io_unitize) - - tabled_for_io(tabled_for_descendant_io), - tabled_for_io(tabled_for_io_unitize) - - tabled_for_io(not_tabled_for_io), - tabled_for_io(tabled_for_descendant_io) - - tabled_for_io(not_tabled_for_io), - purity(pure) - purity(impure), - purity(pure) - purity(semipure), - purity(semipure) - purity(impure), - terminates(terminates) - terminates(does_not_terminate), - terminates(depends_on_mercury_calls) - - terminates(terminates), - terminates(depends_on_mercury_calls) - - terminates(does_not_terminate) - ], - ( - parse_pragma_foreign_proc_attributes_term0(Term, AttrList) - -> - ( - list__member(Conflict1 - Conflict2, - ConflictingAttributes), - list__member(Conflict1, AttrList), - list__member(Conflict2, AttrList) - -> - MaybeAttributes = error("conflicting attributes " ++ - "in attribute list", Term) - ; - list__foldl( - process_attribute, - AttrList, Attributes2, Attributes), - MaybeAttributes = check_required_attributes( - ForeignLanguage, Attributes, Term) - ) - ; - ErrMsg = "expecting a foreign proc attribute " ++ - "or list of attributes", - MaybeAttributes = error(ErrMsg, Term) - ). + MaybeAttributes) :- + Attributes0 = default_attributes(ForeignLanguage), + ( ( Pragma = "c_code" ; Pragma = "import" ) -> + set_legacy_purity_behaviour(yes, Attributes0, Attributes1), + set_purity(pure, Attributes1, Attributes2) + ; + Attributes2 = Attributes0 + ), + ConflictingAttributes = [ + may_call_mercury(will_not_call_mercury) - + may_call_mercury(may_call_mercury), + thread_safe(thread_safe) - + thread_safe(not_thread_safe), + tabled_for_io(tabled_for_io) - + tabled_for_io(tabled_for_io_unitize), + tabled_for_io(tabled_for_io) - + tabled_for_io(tabled_for_descendant_io), + tabled_for_io(tabled_for_io) - + tabled_for_io(not_tabled_for_io), + tabled_for_io(tabled_for_io_unitize) - + tabled_for_io(tabled_for_descendant_io), + tabled_for_io(tabled_for_io_unitize) - + tabled_for_io(not_tabled_for_io), + tabled_for_io(tabled_for_descendant_io) - + tabled_for_io(not_tabled_for_io), + purity(pure) - purity(impure), + purity(pure) - purity(semipure), + purity(semipure) - purity(impure), + terminates(terminates) - terminates(does_not_terminate), + terminates(depends_on_mercury_calls) - + terminates(terminates), + terminates(depends_on_mercury_calls) - + terminates(does_not_terminate) + ], + ( + parse_pragma_foreign_proc_attributes_term0(Term, AttrList) + -> + ( + list__member(Conflict1 - Conflict2, ConflictingAttributes), + list__member(Conflict1, AttrList), + list__member(Conflict2, AttrList) + -> + MaybeAttributes = error("conflicting attributes " ++ + "in attribute list", Term) + ; + list__foldl(process_attribute, AttrList, Attributes2, Attributes), + MaybeAttributes = check_required_attributes(ForeignLanguage, + Attributes, Term) + ) + ; + ErrMsg = "expecting a foreign proc attribute or list of attributes", + MaybeAttributes = error(ErrMsg, Term) + ). - % Update the pragma_foreign_proc_attributes according to the given - % collected_pragma_foreign_proc_attribute. + % Update the pragma_foreign_proc_attributes according to the given + % collected_pragma_foreign_proc_attribute. :- pred process_attribute(collected_pragma_foreign_proc_attribute::in, - pragma_foreign_proc_attributes::in, - pragma_foreign_proc_attributes::out) is det. + pragma_foreign_proc_attributes::in, + pragma_foreign_proc_attributes::out) is det. process_attribute(may_call_mercury(MayCallMercury), !Attrs) :- - set_may_call_mercury(MayCallMercury, !Attrs). + set_may_call_mercury(MayCallMercury, !Attrs). process_attribute(thread_safe(ThreadSafe), !Attrs) :- - set_thread_safe(ThreadSafe, !Attrs). + set_thread_safe(ThreadSafe, !Attrs). process_attribute(tabled_for_io(TabledForIO), !Attrs) :- - set_tabled_for_io(TabledForIO, !Attrs). + set_tabled_for_io(TabledForIO, !Attrs). process_attribute(purity(Pure), !Attrs) :- - set_purity(Pure, !Attrs). + set_purity(Pure, !Attrs). process_attribute(terminates(Terminates), !Attrs) :- - set_terminates(Terminates, !Attrs). + set_terminates(Terminates, !Attrs). process_attribute(will_not_throw_exception, !Attrs) :- - set_may_throw_exception(will_not_throw_exception, !Attrs). + set_may_throw_exception(will_not_throw_exception, !Attrs). process_attribute(max_stack_size(Size), !Attrs) :- - add_extra_attribute(max_stack_size(Size), !Attrs). + add_extra_attribute(max_stack_size(Size), !Attrs). process_attribute(ordinary_despite_detism, !Attrs) :- - set_ordinary_despite_detism(yes, !Attrs). + set_ordinary_despite_detism(yes, !Attrs). - % Aliasing is currently ignored in the main branch compiler. + % Aliasing is currently ignored in the main branch compiler. process_attribute(aliasing, Attrs, Attrs). - % Check whether all the required attributes have been set for - % a particular language + % Check whether all the required attributes have been set for + % a particular language :- func check_required_attributes(foreign_language, - pragma_foreign_proc_attributes, term) - = maybe1(pragma_foreign_proc_attributes). + pragma_foreign_proc_attributes, term) + = maybe1(pragma_foreign_proc_attributes). check_required_attributes(c, Attrs, _Term) = ok(Attrs). check_required_attributes(managed_cplusplus, Attrs, _Term) = ok(Attrs). check_required_attributes(csharp, Attrs, _Term) = ok(Attrs). check_required_attributes(il, Attrs, Term) = Res :- - ( [] = list__filter_map( - (func(X) = X is semidet :- X = max_stack_size(_)), - Attrs ^ extra_attributes) - -> - Res = error( - "expecting max_stack_size attribute for IL code", Term) - ; - Res = ok(Attrs) - ). + ( [] = list__filter_map( + (func(X) = X is semidet :- X = max_stack_size(_)), + Attrs ^ extra_attributes) + -> + Res = error("expecting max_stack_size attribute for IL code", Term) + ; + Res = ok(Attrs) + ). check_required_attributes(java, Attrs, _Term) = ok(Attrs). :- pred parse_pragma_foreign_proc_attributes_term0(term::in, - list(collected_pragma_foreign_proc_attribute)::out) is semidet. + list(collected_pragma_foreign_proc_attribute)::out) is semidet. parse_pragma_foreign_proc_attributes_term0(Term, Flags) :- - ( parse_single_pragma_foreign_proc_attribute(Term, Flag) -> - Flags = [Flag] - ; - ( - Term = term__functor(term__atom("[]"), [], _), - Flags = [] - ; - Term = term__functor(term__atom("[|]"), [Hd, Tl], _), - Flags = [Flag|Flags0], - parse_single_pragma_foreign_proc_attribute(Hd, Flag), - parse_pragma_foreign_proc_attributes_term0(Tl, Flags0) - ) - ). + ( parse_single_pragma_foreign_proc_attribute(Term, Flag) -> + Flags = [Flag] + ; + ( + Term = term__functor(term__atom("[]"), [], _), + Flags = [] + ; + Term = term__functor(term__atom("[|]"), [Head, Tail], _), + parse_single_pragma_foreign_proc_attribute(Head, HeadFlag), + parse_pragma_foreign_proc_attributes_term0(Tail, TailFlags), + Flags = [HeadFlag | TailFlags] + ) + ). :- pred parse_single_pragma_foreign_proc_attribute(term::in, - collected_pragma_foreign_proc_attribute::out) is semidet. + collected_pragma_foreign_proc_attribute::out) is semidet. parse_single_pragma_foreign_proc_attribute(Term, Flag) :- - ( parse_may_call_mercury(Term, MayCallMercury) -> - Flag = may_call_mercury(MayCallMercury) - ; parse_threadsafe(Term, ThreadSafe) -> - Flag = thread_safe(ThreadSafe) - ; parse_tabled_for_io(Term, TabledForIo) -> - Flag = tabled_for_io(TabledForIo) - ; parse_aliasing(Term) -> - Flag = aliasing - ; parse_max_stack_size(Term, Size) -> - Flag = max_stack_size(Size) - ; parse_purity_promise(Term, Purity) -> - Flag = purity(Purity) - ; parse_terminates(Term, Terminates) -> - Flag = terminates(Terminates) - ; parse_no_exception_promise(Term) -> - Flag = will_not_throw_exception - ; parse_ordinary_despite_detism(Term) -> - Flag = ordinary_despite_detism - ; - fail - ). - + ( parse_may_call_mercury(Term, MayCallMercury) -> + Flag = may_call_mercury(MayCallMercury) + ; parse_threadsafe(Term, ThreadSafe) -> + Flag = thread_safe(ThreadSafe) + ; parse_tabled_for_io(Term, TabledForIo) -> + Flag = tabled_for_io(TabledForIo) + ; parse_aliasing(Term) -> + Flag = aliasing + ; parse_max_stack_size(Term, Size) -> + Flag = max_stack_size(Size) + ; parse_purity_promise(Term, Purity) -> + Flag = purity(Purity) + ; parse_terminates(Term, Terminates) -> + Flag = terminates(Terminates) + ; parse_no_exception_promise(Term) -> + Flag = will_not_throw_exception + ; parse_ordinary_despite_detism(Term) -> + Flag = ordinary_despite_detism + ; + fail + ). :- pred parse_may_call_mercury(term::in, may_call_mercury::out) is semidet. parse_may_call_mercury(term__functor(term__atom("recursive"), [], _), - may_call_mercury). + may_call_mercury). parse_may_call_mercury(term__functor(term__atom("non_recursive"), [], _), - will_not_call_mercury). + will_not_call_mercury). parse_may_call_mercury(term__functor(term__atom("may_call_mercury"), [], _), - may_call_mercury). + may_call_mercury). parse_may_call_mercury(term__functor(term__atom("will_not_call_mercury"), [], - _), will_not_call_mercury). + _), will_not_call_mercury). :- pred parse_threadsafe(term::in, thread_safe::out) is semidet. parse_threadsafe(term__functor(term__atom("thread_safe"), [], _), - thread_safe). + thread_safe). parse_threadsafe(term__functor(term__atom("not_thread_safe"), [], _), - not_thread_safe). + not_thread_safe). :- pred parse_tabled_for_io(term::in, tabled_for_io::out) is semidet. parse_tabled_for_io(term__functor(term__atom(Str), [], _), TabledForIo) :- - ( - Str = "tabled_for_io", - TabledForIo = tabled_for_io - ; - Str = "tabled_for_io_unitize", - TabledForIo = tabled_for_io_unitize - ; - Str = "tabled_for_descendant_io", - TabledForIo = tabled_for_descendant_io - ; - Str = "not_tabled_for_io", - TabledForIo = not_tabled_for_io - ). + ( + Str = "tabled_for_io", + TabledForIo = tabled_for_io + ; + Str = "tabled_for_io_unitize", + TabledForIo = tabled_for_io_unitize + ; + Str = "tabled_for_descendant_io", + TabledForIo = tabled_for_descendant_io + ; + Str = "not_tabled_for_io", + TabledForIo = not_tabled_for_io + ). - % XXX For the moment we just ignore the following attributes. - % These attributes are used for aliasing on the reuse branch, - % and ignoring them allows the main branch compiler to compile - % the reuse branch. + % XXX For the moment we just ignore the following attributes. + % These attributes are used for aliasing on the reuse branch, + % and ignoring them allows the main branch compiler to compile + % the reuse branch. :- pred parse_aliasing(term::in) is semidet. parse_aliasing(term__functor(term__atom("no_aliasing"), [], _)). @@ -1591,301 +1473,283 @@ parse_aliasing(term__functor(term__atom("alias"), [_Types, _Alias], _)). :- pred parse_max_stack_size(term::in, int::out) is semidet. parse_max_stack_size(term__functor( - term__atom("max_stack_size"), [SizeTerm], _), Size) :- - SizeTerm = term__functor(term__integer(Size), [], _). + term__atom("max_stack_size"), [SizeTerm], _), Size) :- + SizeTerm = term__functor(term__integer(Size), [], _). :- pred parse_purity_promise(term::in, purity::out) is semidet. parse_purity_promise(term__functor(term__atom("promise_pure"), [], _), - (pure)). + (pure)). parse_purity_promise(term__functor(term__atom("promise_semipure"), [], _), - (semipure)). + (semipure)). :- pred parse_terminates(term::in, terminates::out) is semidet. parse_terminates(term__functor(term__atom("terminates"), [], _), - terminates). + terminates). parse_terminates(term__functor(term__atom("does_not_terminate"), [], _), - does_not_terminate). + does_not_terminate). :- pred parse_no_exception_promise(term::in) is semidet. parse_no_exception_promise(term.functor( - term.atom("will_not_throw_exception"), [], _)). + term.atom("will_not_throw_exception"), [], _)). :- pred parse_ordinary_despite_detism(term::in) is semidet. parse_ordinary_despite_detism( - term__functor(term__atom("ordinary_despite_detism"), [], _)). + term__functor(term__atom("ordinary_despite_detism"), [], _)). % parse a pragma foreign_code declaration :- pred parse_pragma_foreign_code(module_name::in, - pragma_foreign_proc_attributes::in, term::in, - pragma_foreign_code_impl::in, varset::in, maybe1(item)::out) is det. + pragma_foreign_proc_attributes::in, term::in, + pragma_foreign_code_impl::in, varset::in, maybe1(item)::out) is det. parse_pragma_foreign_code(ModuleName, Flags, PredAndVarsTerm0, - PragmaImpl, VarSet0, Result) :- - parse_pred_or_func_and_args(yes(ModuleName), PredAndVarsTerm0, - PredAndVarsTerm0, "`:- pragma c_code' declaration", - PredAndArgsResult), - ( - PredAndArgsResult = ok(PredName, VarList0 - MaybeRetTerm), - ( - % is this a function or a predicate? - MaybeRetTerm = yes(FuncResultTerm0) - -> - % function - PredOrFunc = function, - list__append(VarList0, [FuncResultTerm0], VarList) - ; - % predicate - PredOrFunc = predicate, - VarList = VarList0 - ), - parse_pragma_c_code_varlist(VarSet0, VarList, PragmaVars, - Error), - ( - Error = no, - varset__coerce(VarSet0, VarSet), - Result = ok(pragma(foreign_proc(Flags, PredName, - PredOrFunc, PragmaVars, VarSet, PragmaImpl))) - ; - Error = yes(ErrorMessage), - Result = error(ErrorMessage, PredAndVarsTerm0) + PragmaImpl, VarSet0, Result) :- + parse_pred_or_func_and_args(yes(ModuleName), PredAndVarsTerm0, + PredAndVarsTerm0, "`:- pragma c_code' declaration", PredAndArgsResult), + ( + PredAndArgsResult = ok(PredName, VarList0 - MaybeRetTerm), + ( + % is this a function or a predicate? + MaybeRetTerm = yes(FuncResultTerm0) + -> + % function + PredOrFunc = function, + list__append(VarList0, [FuncResultTerm0], VarList) + ; + % predicate + PredOrFunc = predicate, + VarList = VarList0 + ), + parse_pragma_c_code_varlist(VarSet0, VarList, PragmaVars, Error), + ( + Error = no, + varset__coerce(VarSet0, VarSet), + Result = ok(pragma(foreign_proc(Flags, PredName, PredOrFunc, + PragmaVars, VarSet, PragmaImpl))) + ; + Error = yes(ErrorMessage), + Result = error(ErrorMessage, PredAndVarsTerm0) + ) + ; + PredAndArgsResult = error(Msg, Term), + Result = error(Msg, Term) + ). - ) - ; - PredAndArgsResult = error(Msg, Term), - Result = error(Msg, Term) - ). - - % parse the variable list in the pragma c code declaration. - % The final argument is 'no' for no error, or 'yes(ErrorMessage)'. + % parse the variable list in the pragma c code declaration. + % The final argument is 'no' for no error, or 'yes(ErrorMessage)'. :- pred parse_pragma_c_code_varlist(varset::in, list(term)::in, - list(pragma_var)::out, maybe(string)::out) is det. + list(pragma_var)::out, maybe(string)::out) is det. parse_pragma_c_code_varlist(_, [], [], no). parse_pragma_c_code_varlist(VarSet, [V|Vars], PragmaVars, Error):- - ( - V = term__functor(term__atom("::"), [VarTerm, ModeTerm], _), - VarTerm = term__variable(Var) - -> - ( - varset__search_name(VarSet, Var, VarName) - -> - ( - convert_mode(allow_constrained_inst_var, - ModeTerm, Mode0) - -> - constrain_inst_vars_in_mode(Mode0, Mode), - term__coerce_var(Var, ProgVar), - P = (pragma_var(ProgVar, VarName, Mode)), - parse_pragma_c_code_varlist(VarSet, - Vars, PragmaVars0, Error), - PragmaVars = [P|PragmaVars0] - ; - PragmaVars = [], - Error = yes("unknown mode in pragma c_code") - ) - ; - % if the variable wasn't in the varset it must be an - % underscore variable. - PragmaVars = [], % return any old junk for that. - Error = yes("sorry, not implemented: anonymous " ++ - "`_' variable in pragma c_code") - ) - ; - PragmaVars = [], % return any old junk in PragmaVars - Error = yes("arguments not in form 'Var :: mode'") - ). - -:- pred parse_tabling_pragma(module_name::in, string::in, eval_method::in, - list(term)::in, term::in, maybe1(item)::out) is det. - -parse_tabling_pragma(ModuleName, PragmaName, TablingType, PragmaTerms, - ErrorTerm, Result) :- - ( - PragmaTerms = [PredAndModesTerm0] - -> - string__append_list(["`:- pragma ", PragmaName, - "' declaration"], ParseMsg), - parse_arity_or_modes(ModuleName, PredAndModesTerm0, - ErrorTerm, ParseMsg, ArityModesResult), - ( - ArityModesResult = ok(arity_or_modes(PredName, - Arity, MaybePredOrFunc, MaybeModes)), - Result = ok(pragma(tabled(TablingType, PredName, Arity, - MaybePredOrFunc, MaybeModes))) - ; - ArityModesResult = error(Msg, Term), - Result = error(Msg, Term) - ) - ; - string__append_list( - ["wrong number of arguments in `:- pragma ", - PragmaName, "' declaration"], ErrorMessage), - Result = error(ErrorMessage, ErrorTerm) - ). - -:- type arity_or_modes - ---> arity_or_modes( - sym_name, - arity, - maybe(pred_or_func), - maybe(list(mode)) - ). - -:- pred parse_arity_or_modes(module_name::in, term::in, term::in, - string::in, maybe1(arity_or_modes)::out) is det. - -parse_arity_or_modes(ModuleName, PredAndModesTerm0, - ErrorTerm, ErrorMsg, Result) :- - ( - % Is this a simple pred/arity pragma - PredAndModesTerm0 = term__functor(term__atom("/"), - [PredNameTerm, ArityTerm], _) - -> - ( - parse_implicitly_qualified_term(ModuleName, - PredNameTerm, PredAndModesTerm0, "", ok(PredName, [])), - ArityTerm = term__functor(term__integer(Arity), [], _) - -> - Result = ok(arity_or_modes(PredName, Arity, no, no)) + ( + V = term__functor(term__atom("::"), [VarTerm, ModeTerm], _), + VarTerm = term__variable(Var) + -> + ( varset__search_name(VarSet, Var, VarName) -> + ( convert_mode(allow_constrained_inst_var, ModeTerm, Mode0) -> + constrain_inst_vars_in_mode(Mode0, Mode), + term__coerce_var(Var, ProgVar), + P = (pragma_var(ProgVar, VarName, Mode)), + parse_pragma_c_code_varlist(VarSet, Vars, PragmaVars0, Error), + PragmaVars = [P|PragmaVars0] ; - string__append("expected predname/arity for", ErrorMsg, Msg), - Result = error(Msg, ErrorTerm) + PragmaVars = [], + Error = yes("unknown mode in pragma c_code") ) ; - parse_pred_or_func_and_arg_modes(yes(ModuleName), - PredAndModesTerm0, PredAndModesTerm0, ErrorMsg, - PredAndModesResult), - ( - PredAndModesResult = ok(PredName - PredOrFunc, Modes), - list__length(Modes, Arity0), - ( PredOrFunc = function -> - Arity = Arity0 - 1 - ; - Arity = Arity0 - ), - Result = ok(arity_or_modes(PredName, Arity, - yes(PredOrFunc), yes(Modes))) + % if the variable wasn't in the varset it must be an + % underscore variable. + PragmaVars = [], % return any old junk for that. + Error = yes("sorry, not implemented: anonymous " ++ + "`_' variable in pragma c_code") + ) + ; + PragmaVars = [], % return any old junk in PragmaVars + Error = yes("arguments not in form 'Var :: mode'") + ). + +:- pred parse_tabling_pragma(module_name::in, string::in, eval_method::in, + list(term)::in, term::in, maybe1(item)::out) is det. + +parse_tabling_pragma(ModuleName, PragmaName, TablingType, PragmaTerms, + ErrorTerm, Result) :- + ( PragmaTerms = [PredAndModesTerm0] -> + string__append_list(["`:- pragma ", PragmaName, "' declaration"], + ParseMsg), + parse_arity_or_modes(ModuleName, PredAndModesTerm0, ErrorTerm, + ParseMsg, ArityModesResult), + ( + ArityModesResult = ok(arity_or_modes(PredName, Arity, + MaybePredOrFunc, MaybeModes)), + Result = ok(pragma(tabled(TablingType, PredName, Arity, + MaybePredOrFunc, MaybeModes))) + ; + ArityModesResult = error(Msg, Term), + Result = error(Msg, Term) + ) + ; + string__append_list(["wrong number of arguments in `:- pragma ", + PragmaName, "' declaration"], ErrorMessage), + Result = error(ErrorMessage, ErrorTerm) + ). + +:- type arity_or_modes + ---> arity_or_modes( + sym_name, + arity, + maybe(pred_or_func), + maybe(list(mode)) + ). + +:- pred parse_arity_or_modes(module_name::in, term::in, term::in, + string::in, maybe1(arity_or_modes)::out) is det. + +parse_arity_or_modes(ModuleName, PredAndModesTerm0, + ErrorTerm, ErrorMsg, Result) :- + ( + % Is this a simple pred/arity pragma + PredAndModesTerm0 = term__functor(term__atom("/"), + [PredNameTerm, ArityTerm], _) + -> + ( + parse_implicitly_qualified_term(ModuleName, PredNameTerm, + PredAndModesTerm0, "", ok(PredName, [])), + ArityTerm = term__functor(term__integer(Arity), [], _) + -> + Result = ok(arity_or_modes(PredName, Arity, no, no)) + ; + string__append("expected predname/arity for", ErrorMsg, Msg), + Result = error(Msg, ErrorTerm) + ) + ; + parse_pred_or_func_and_arg_modes(yes(ModuleName), PredAndModesTerm0, + PredAndModesTerm0, ErrorMsg, PredAndModesResult), + ( + PredAndModesResult = ok(PredName - PredOrFunc, Modes), + list__length(Modes, Arity0), + ( PredOrFunc = function -> + Arity = Arity0 - 1 ; - PredAndModesResult = error(Msg, Term), - Result = error(Msg, Term) - ) - ). + Arity = Arity0 + ), + Result = ok(arity_or_modes(PredName, Arity, yes(PredOrFunc), + yes(Modes))) + ; + PredAndModesResult = error(Msg, Term), + Result = error(Msg, Term) + ) + ). :- type maybe_pred_or_func_modes == - maybe2(pair(sym_name, pred_or_func), list(mode)). + maybe2(pair(sym_name, pred_or_func), list(mode)). :- pred parse_pred_or_func_and_arg_modes(maybe(module_name)::in, term::in, - term::in, string::in, maybe_pred_or_func_modes::out) is det. + term::in, string::in, maybe_pred_or_func_modes::out) is det. parse_pred_or_func_and_arg_modes(MaybeModuleName, PredAndModesTerm, - ErrorTerm, Msg, Result) :- - parse_pred_or_func_and_args(MaybeModuleName, PredAndModesTerm, - ErrorTerm, Msg, PredAndArgsResult), - ( - PredAndArgsResult = - ok(PredName, ArgModeTerms - MaybeRetModeTerm), - ( - convert_mode_list(allow_constrained_inst_var, ArgModeTerms, - ArgModes0) - -> - ( - MaybeRetModeTerm = yes(RetModeTerm), - ( - convert_mode(allow_constrained_inst_var, RetModeTerm, - RetMode) - -> - list__append(ArgModes0, [RetMode], ArgModes1), - list__map(constrain_inst_vars_in_mode, ArgModes1, - ArgModes), - Result = ok(PredName - function, ArgModes) - ; - string__append("error in return mode in ", - Msg, ErrorMsg), - Result = error(ErrorMsg, ErrorTerm) - ) - ; - MaybeRetModeTerm = no, - Result = ok(PredName - predicate, ArgModes0) - ) - ; - string__append("error in argument modes in ", Msg, - ErrorMsg), - Result = error(ErrorMsg, ErrorTerm) - ) - ; - PredAndArgsResult = error(ErrorMsg, Term), - Result = error(ErrorMsg, Term) - ). + ErrorTerm, Msg, Result) :- + parse_pred_or_func_and_args(MaybeModuleName, PredAndModesTerm, + ErrorTerm, Msg, PredAndArgsResult), + ( + PredAndArgsResult = + ok(PredName, ArgModeTerms - MaybeRetModeTerm), + ( + convert_mode_list(allow_constrained_inst_var, ArgModeTerms, + ArgModes0) + -> + ( + MaybeRetModeTerm = yes(RetModeTerm), + ( + convert_mode(allow_constrained_inst_var, RetModeTerm, + RetMode) + -> + list__append(ArgModes0, [RetMode], ArgModes1), + list__map(constrain_inst_vars_in_mode, ArgModes1, + ArgModes), + Result = ok(PredName - function, ArgModes) + ; + string__append("error in return mode in ", Msg, ErrorMsg), + Result = error(ErrorMsg, ErrorTerm) + ) + ; + MaybeRetModeTerm = no, + Result = ok(PredName - predicate, ArgModes0) + ) + ; + string__append("error in argument modes in ", Msg, + ErrorMsg), + Result = error(ErrorMsg, ErrorTerm) + ) + ; + PredAndArgsResult = error(ErrorMsg, Term), + Result = error(ErrorMsg, Term) + ). :- pred convert_bool_list(term::in, list(bool)::out) is semidet. convert_bool_list(ListTerm, Bools) :- - convert_list(ListTerm, - (pred(Term::in, Bool::out) is semidet :- - Term = term__functor(term__atom(Name), [], _), - ( Name = "yes", Bool = yes - ; Name = "no", Bool = no - ) - ), - ok(Bools)). + convert_list(ListTerm, + (pred(Term::in, Bool::out) is semidet :- + Term = term__functor(term__atom(Name), [], _), + ( Name = "yes", Bool = yes + ; Name = "no", Bool = no + ) + ), + ok(Bools)). :- pred convert_int_list(term::in, maybe1(list(int))::out) is det. convert_int_list(ListTerm, Result) :- - convert_list(ListTerm, - (pred(Term::in, Int::out) is semidet :- - Term = term__functor(term__integer(Int), [], _) - ), Result). + convert_list(ListTerm, + (pred(Term::in, Int::out) is semidet :- + Term = term__functor(term__integer(Int), [], _) + ), Result). - % - % convert_list(T, P, M) will convert a term T into a list of - % type X where P is a predicate that converts each element of - % the list into the correct type. M will hold the list if the - % conversion succeded for each element of M, otherwise it will - % hold the error. - % + % + % convert_list(T, P, M) will convert a term T into a list of + % type X where P is a predicate that converts each element of + % the list into the correct type. M will hold the list if the + % conversion succeded for each element of M, otherwise it will + % hold the error. + % :- pred convert_list(term::in, pred(term, T)::(pred(in, out) is semidet), - maybe1(list(T))::out) is det. + maybe1(list(T))::out) is det. -convert_list(term__variable(V),_, error("variable in list", term__variable(V))). +convert_list(term__variable(V),_, error("variable in list", + term__variable(V))). convert_list(term__functor(Functor, Args, Context), Pred, Result) :- - ( - Functor = term__atom("[|]"), - Args = [Term, RestTerm], - call(Pred, Term, Element) - -> - convert_list(RestTerm, Pred, RestResult), - ( - RestResult = ok(List0), - Result = ok([Element | List0]) - ; - RestResult = error(_, _), - Result = RestResult - ) - ; - Functor = term__atom("[]"), - Args = [] - -> - Result = ok([]) - ; - Result = error("error in list", - term__functor(Functor, Args, Context)) - ). + ( + Functor = term__atom("[|]"), + Args = [Term, RestTerm], + call(Pred, Term, Element) + -> + convert_list(RestTerm, Pred, RestResult), + ( + RestResult = ok(List0), + Result = ok([Element | List0]) + ; + RestResult = error(_, _), + Result = RestResult + ) + ; + Functor = term__atom("[]"), + Args = [] + -> + Result = ok([]) + ; + Result = error("error in list", term__functor(Functor, Args, Context)) + ). :- pred convert_type_spec_pair(term::in, pair(tvar, type)::out) is semidet. convert_type_spec_pair(Term, TypeSpec) :- - Term = term__functor(term__atom("="), [TypeVarTerm, SpecTypeTerm0], _), - TypeVarTerm = term__variable(TypeVar0), - term__coerce_var(TypeVar0, TypeVar), - convert_type(SpecTypeTerm0, SpecType), - TypeSpec = TypeVar - SpecType. - -%----------------------------------------------------------------------------% -:- end_module prog_io_pragma. -%----------------------------------------------------------------------------% + Term = term__functor(term__atom("="), [TypeVarTerm, SpecTypeTerm0], _), + TypeVarTerm = term__variable(TypeVar0), + term__coerce_var(TypeVar0, TypeVar), + convert_type(SpecTypeTerm0, SpecType), + TypeSpec = TypeVar - SpecType. diff --git a/compiler/prog_io_typeclass.m b/compiler/prog_io_typeclass.m index 5501a8619..f90c846d0 100644 --- a/compiler/prog_io_typeclass.m +++ b/compiler/prog_io_typeclass.m @@ -20,25 +20,23 @@ :- import_module list, varset, term. % parse a typeclass declaration. -:- pred parse_typeclass(module_name, varset, list(term), maybe1(item)). -:- mode parse_typeclass(in, in, in, out) is semidet. +:- pred parse_typeclass(module_name::in, varset::in, list(term)::in, + maybe1(item)::out) is semidet. % parse an instance declaration. -:- pred parse_instance(module_name, varset, list(term), maybe1(item)). -:- mode parse_instance(in, in, in, out) is semidet. +:- pred parse_instance(module_name::in, varset::in, list(term)::in, + maybe1(item)::out) is semidet. % parse a list of class constraints -:- pred parse_class_constraints(module_name, term, - maybe1(list(class_constraint))). -:- mode parse_class_constraints(in, in, out) is det. +:- pred parse_class_constraints(module_name::in, term::in, + maybe1(list(class_constraint))::out) is det. % parse a list of class and inst constraints -:- pred parse_class_and_inst_constraints(module_name, term, - maybe_class_and_inst_constraints). -:- mode parse_class_and_inst_constraints(in, in, out) is det. +:- pred parse_class_and_inst_constraints(module_name::in, term::in, + maybe_class_and_inst_constraints::out) is det. :- type maybe_class_and_inst_constraints == - maybe2(list(class_constraint), inst_var_sub). + maybe2(list(class_constraint), inst_var_sub). :- implementation. @@ -63,8 +61,8 @@ parse_typeclass(ModuleName, VarSet, TypeClassTerm, Result) :- parse_class_name(ModuleName, Arg, VarSet, Result) ). -:- pred parse_non_empty_class(module_name, term, term, varset, maybe1(item)). -:- mode parse_non_empty_class(in, in, in, in, out) is det. +:- pred parse_non_empty_class(module_name::in, term::in, term::in, varset::in, + maybe1(item)::out) is det. parse_non_empty_class(ModuleName, Name, Methods, VarSet, Result) :- varset__coerce(VarSet, TVarSet), @@ -92,8 +90,8 @@ parse_non_empty_class(ModuleName, Name, Methods, VarSet, Result) :- Result = error(String, Term) ). -:- pred parse_class_name(module_name, term, varset, maybe1(item)). -:- mode parse_class_name(in, in, in, out) is det. +:- pred parse_class_name(module_name::in, term::in, varset::in, + maybe1(item)::out) is det. parse_class_name(ModuleName, Arg, VarSet, Result) :- ( @@ -106,8 +104,8 @@ parse_class_name(ModuleName, Arg, VarSet, Result) :- parse_unconstrained_class(ModuleName, Arg, TVarSet, Result) ). -:- pred parse_constrained_class(module_name, term, term, varset, maybe1(item)). -:- mode parse_constrained_class(in, in, in, in, out) is det. +:- pred parse_constrained_class(module_name::in, term::in, term::in, + varset::in, maybe1(item)::out) is det. parse_constrained_class(ModuleName, Decl, Constraints, VarSet, Result) :- varset__coerce(VarSet, TVarSet), @@ -135,8 +133,9 @@ parse_constrained_class(ModuleName, Decl, Constraints, VarSet, Result) :- list__member(Var, ConstrainedVars), \+ list__member(Var, Vars) -> - Result = error( -"type variable in superclass constraint is not a parameter of this type class", + Result = error("type variable in " ++ + "superclass constraint is not " ++ + "a parameter of this type class", Constraints) ; Result = ok(typeclass(ConstraintList, Name, @@ -152,18 +151,16 @@ parse_constrained_class(ModuleName, Decl, Constraints, VarSet, Result) :- Result = error(String, Term) ). -:- pred parse_superclass_constraints(module_name, term, - maybe1(list(class_constraint))). -:- mode parse_superclass_constraints(in, in, out) is det. +:- pred parse_superclass_constraints(module_name::in, term::in, + maybe1(list(class_constraint))::out) is det. parse_superclass_constraints(ModuleName, Constraints, Result) :- parse_simple_class_constraints(ModuleName, Constraints, - "constraints on class declaration may only constrain type variables and ground types", - Result). - -:- pred parse_unconstrained_class(module_name, term, tvarset, maybe1(item)). -:- mode parse_unconstrained_class(in, in, in, out) is det. + "constraints on class declaration may only constrain " ++ + "type variables and ground types", Result). +:- pred parse_unconstrained_class(module_name::in, term::in, tvarset::in, + maybe1(item)::out) is det. parse_unconstrained_class(ModuleName, Name, TVarSet, Result) :- parse_implicitly_qualified_term(ModuleName, @@ -180,18 +177,16 @@ parse_unconstrained_class(ModuleName, Name, TVarSet, Result) :- Result = ok(typeclass([], ClassName, Vars, abstract, TVarSet)) ; - Result = error( - "expected distinct variables as class parameters", - Name) + Result = error("expected distinct variables " ++ + "as class parameters", Name) ) ; MaybeClassName = error(String, Term), Result = error(String, Term) ). -:- pred parse_class_methods(module_name, term, varset, - maybe1(list(class_method))). -:- mode parse_class_methods(in, in, in, out) is det. +:- pred parse_class_methods(module_name::in, term::in, varset::in, + maybe1(list(class_method))::out) is det. parse_class_methods(ModuleName, Methods, VarSet, Result) :- ( @@ -211,8 +206,7 @@ parse_class_methods(ModuleName, Methods, VarSet, Result) :- Result = error("expected list of class methods", Methods) ). -:- pred list_term_to_term_list(term, list(term)). -:- mode list_term_to_term_list(in, out) is semidet. +:- pred list_term_to_term_list(term::in, list(term)::out) is semidet. list_term_to_term_list(Methods, MethodList) :- ( @@ -225,9 +219,8 @@ list_term_to_term_list(Methods, MethodList) :- ). -:- pred item_to_class_method(maybe2(item, prog_context), term, - maybe1(class_method)). -:- mode item_to_class_method(in, in, out) is det. +:- pred item_to_class_method(maybe2(item, prog_context)::in, term::in, + maybe1(class_method)::out) is det. item_to_class_method(error(String, Term), _, error(String, Term)). item_to_class_method(ok(Item, Context), Term, Result) :- @@ -235,20 +228,20 @@ item_to_class_method(ok(Item, Context), Term, Result) :- Item = pred_or_func(A, B, C, D, E, F, G, H, I, J, K, L) -> Result = ok(pred_or_func(A, B, C, D, E, F, G, H, I, J, K, L, - Context)) + Context)) ; Item = pred_or_func_mode(A, B, C, D, E, F, G) -> Result = ok(pred_or_func_mode(A, B, C, D, E, F, G, Context)) ; - Result = error("Only pred, func and mode declarations allowed in class interface", Term) + Result = error("Only pred, func and mode declarations " ++ + "allowed in class interface", Term) ). % from a list of maybe1s, search through until you find an error. % If an error is found, return it. % If no error is found, return ok(the original elements). -:- pred find_errors(list(maybe1(T)), maybe1(list(T))). -:- mode find_errors(in, out) is det. +:- pred find_errors(list(maybe1(T))::in, maybe1(list(T))::out) is det. find_errors([], ok([])). find_errors([X|Xs], Result) :- @@ -283,9 +276,8 @@ parse_class_and_inst_constraints(ModuleName, ConstraintsTerm, Result) :- % Parse constraints which can only constrain type variables and ground types. -:- pred parse_simple_class_constraints(module_name, term, string, - maybe1(list(class_constraint))). -:- mode parse_simple_class_constraints(in, in, in, out) is det. +:- pred parse_simple_class_constraints(module_name::in, term::in, string::in, + maybe1(list(class_constraint))::out) is det. parse_simple_class_constraints(ModuleName, ConstraintsTerm, ErrorMessage, Result) :- @@ -293,9 +285,8 @@ parse_simple_class_constraints(ModuleName, ConstraintsTerm, ErrorMessage, ErrorMessage, Result0), extract_class_constraints(Result0, Result). -:- pred parse_simple_class_and_inst_constraints(module_name, term, string, - maybe_class_and_inst_constraints). -:- mode parse_simple_class_and_inst_constraints(in, in, in, out) is det. +:- pred parse_simple_class_and_inst_constraints(module_name::in, term::in, + string::in, maybe_class_and_inst_constraints::out) is det. parse_simple_class_and_inst_constraints(ModuleName, ConstraintsTerm, ErrorMessage, Result) :- @@ -321,9 +312,8 @@ parse_simple_class_and_inst_constraints(ModuleName, ConstraintsTerm, % Parse constraints which can constrain arbitrary types -:- pred parse_arbitrary_class_and_inst_constraints(module_name, term, - maybe_class_and_inst_constraints). -:- mode parse_arbitrary_class_and_inst_constraints(in, in, out) is det. +:- pred parse_arbitrary_class_and_inst_constraints(module_name::in, term::in, + maybe_class_and_inst_constraints::out) is det. parse_arbitrary_class_and_inst_constraints(ModuleName, ConstraintsTerm, Result) :- @@ -331,9 +321,8 @@ parse_arbitrary_class_and_inst_constraints(ModuleName, ConstraintsTerm, parse_class_and_inst_constraint_list(ModuleName, ConstraintList, Result). -:- pred parse_class_and_inst_constraint_list(module_name, list(term), - maybe_class_and_inst_constraints). -:- mode parse_class_and_inst_constraint_list(in, in, out) is det. +:- pred parse_class_and_inst_constraint_list(module_name::in, list(term)::in, + maybe_class_and_inst_constraints::out) is det. parse_class_and_inst_constraint_list(_, [], ok([], map__init)). parse_class_and_inst_constraint_list(ModuleName, [C0|C0s], Result) :- @@ -342,27 +331,25 @@ parse_class_and_inst_constraint_list(ModuleName, [C0|C0s], Result) :- Result = combine_class_and_inst_constraints(Result0, Result1). :- func combine_class_and_inst_constraints(maybe1(class_or_inst_constraint), - maybe_class_and_inst_constraints) = - maybe_class_and_inst_constraints. + maybe_class_and_inst_constraints) = maybe_class_and_inst_constraints. combine_class_and_inst_constraints(error(String, Term), _) = - error(String, Term). + error(String, Term). combine_class_and_inst_constraints(ok(_), error(String, Term)) = - error(String, Term). + error(String, Term). combine_class_and_inst_constraints(ok(class_constraint(ClassConstraint)), - ok(ClassConstraints, InstConstraints)) = - ok([ClassConstraint | ClassConstraints], InstConstraints). + ok(ClassConstraints, InstConstraints)) = + ok([ClassConstraint | ClassConstraints], InstConstraints). combine_class_and_inst_constraints(ok(inst_constraint(InstVar, Inst)), - ok(ClassConstraints, InstConstraints)) = - ok(ClassConstraints, InstConstraints ^ elem(InstVar) := Inst). + ok(ClassConstraints, InstConstraints)) = + ok(ClassConstraints, InstConstraints ^ elem(InstVar) := Inst). :- type class_or_inst_constraint ---> class_constraint(class_constraint) ; inst_constraint(inst_var, inst). -:- pred parse_class_or_inst_constraint(module_name, term, - maybe1(class_or_inst_constraint)). -:- mode parse_class_or_inst_constraint(in, in, out) is det. +:- pred parse_class_or_inst_constraint(module_name::in, term::in, + maybe1(class_or_inst_constraint)::out) is det. parse_class_or_inst_constraint(_ModuleName, ConstraintTerm, Result) :- ( @@ -383,8 +370,7 @@ parse_class_or_inst_constraint(_ModuleName, ConstraintTerm, Result) :- ConstraintTerm) ). -:- pred parse_inst_constraint(term, inst_var, inst). -:- mode parse_inst_constraint(in, out, out) is semidet. +:- pred parse_inst_constraint(term::in, inst_var::out, (inst)::out) is semidet. parse_inst_constraint(Term, InstVar, Inst) :- Term = term__functor(term__atom("=<"), [Arg1, Arg2], _), @@ -392,9 +378,8 @@ parse_inst_constraint(Term, InstVar, Inst) :- term__coerce_var(InstVar0, InstVar), convert_inst(no_allow_constrained_inst_var, Arg2, Inst). -:- pred extract_class_constraints(maybe_class_and_inst_constraints, - maybe1(list(class_constraint))). -:- mode extract_class_constraints(in, out) is det. +:- pred extract_class_constraints(maybe_class_and_inst_constraints::in, + maybe1(list(class_constraint))::out) is det. extract_class_constraints(ok(ClassConstraints, _), ok(ClassConstraints)). extract_class_constraints(error(String, Term), error(String, Term)). @@ -415,8 +400,8 @@ parse_instance(ModuleName, VarSet, TypeClassTerm, Result) :- parse_instance_name(ModuleName, Arg, TVarSet, Result) ). -:- pred parse_instance_name(module_name, term, tvarset, maybe1(item)). -:- mode parse_instance_name(in, in, in, out) is det. +:- pred parse_instance_name(module_name::in, term::in, tvarset::in, + maybe1(item)::out) is det. parse_instance_name(ModuleName, Arg, TVarSet, Result) :- ( @@ -428,8 +413,8 @@ parse_instance_name(ModuleName, Arg, TVarSet, Result) :- parse_underived_instance(ModuleName, Arg, TVarSet, Result) ). -:- pred parse_derived_instance(module_name, term, term, tvarset, maybe1(item)). -:- mode parse_derived_instance(in, in, in, in, out) is det. +:- pred parse_derived_instance(module_name::in, term::in, term::in, + tvarset::in, maybe1(item)::out) is det. parse_derived_instance(ModuleName, Decl, Constraints, TVarSet, Result) :- @@ -447,7 +432,7 @@ parse_derived_instance(ModuleName, Decl, Constraints, TVarSet, ModName)) -> Result = ok(instance(ConstraintList, Name, Types, Body, - VarSet, ModName)) + VarSet, ModName)) ; % if the item we get back isn't an instance, % something has gone wrong... @@ -460,17 +445,16 @@ parse_derived_instance(ModuleName, Decl, Constraints, TVarSet, Result = error(String, Term) ). -:- pred parse_instance_constraints(module_name, term, - maybe1(list(class_constraint))). -:- mode parse_instance_constraints(in, in, out) is det. +:- pred parse_instance_constraints(module_name::in, term::in, + maybe1(list(class_constraint))::out) is det. parse_instance_constraints(ModuleName, Constraints, Result) :- parse_simple_class_constraints(ModuleName, Constraints, "constraints on instance declaration may only constrain type variables and ground types", Result). -:- pred parse_underived_instance(module_name, term, tvarset, maybe1(item)). -:- mode parse_underived_instance(in, in, in, out) is det. +:- pred parse_underived_instance(module_name::in, term::in, tvarset::in, + maybe1(item)::out) is det. parse_underived_instance(ModuleName, Name, TVarSet, Result) :- % We don't give a default module name here since the instance @@ -520,16 +504,17 @@ parse_underived_instance(ModuleName, Name, TVarSet, Result) :- % XXX erroneous type ErroneousTypes = [E0|_Es], term__coerce(E0, E), - Result = error("expected type in instance declaration to be a functor with variables as args", E) + Result = error("expected type in " ++ + "instance declaration to be " ++ + "a functor with variables as args", E) ) ; MaybeClassName = error(String, Term), Result = error(String, Term) ). -:- pred parse_non_empty_instance(module_name, term, term, varset, tvarset, - maybe1(item)). -:- mode parse_non_empty_instance(in, in, in, in, in, out) is det. +:- pred parse_non_empty_instance(module_name::in, term::in, term::in, + varset::in, tvarset::in, maybe1(item)::out) is det. parse_non_empty_instance(ModuleName, Name, Methods, VarSet, TVarSet, Result) :- parse_instance_methods(ModuleName, Methods, VarSet, ParsedMethods), @@ -559,8 +544,8 @@ parse_non_empty_instance(ModuleName, Name, Methods, VarSet, TVarSet, Result) :- Result = error(String, Term) ). -:- pred check_tvars_in_instance_constraint(maybe1(item), term, maybe1(item)). -:- mode check_tvars_in_instance_constraint(in, in, out) is det. +:- pred check_tvars_in_instance_constraint(maybe1(item)::in, term::in, + maybe1(item)::out) is det. check_tvars_in_instance_constraint(error(M,E), _, error(M, E)). check_tvars_in_instance_constraint(ok(Item), InstanceTerm, Result) :- @@ -579,8 +564,8 @@ check_tvars_in_instance_constraint(ok(Item), InstanceTerm, Result) :- list__member(TVar, TVars), \+ term__contains_var_list(Types, TVar) -> - Result = error( - "unbound type variable(s) in constraints on instance declaration", + Result = error("unbound type variable(s) " ++ + "in constraints on instance declaration", InstanceTerm) ; Result = ok(Item) @@ -589,9 +574,8 @@ check_tvars_in_instance_constraint(ok(Item), InstanceTerm, Result) :- error("check_tvars_in_constraint: expecting instance item") ). -:- pred parse_instance_methods(module_name, term, varset, - maybe1(list(instance_method))). -:- mode parse_instance_methods(in, in, in, out) is det. +:- pred parse_instance_methods(module_name::in, term::in, varset::in, + maybe1(list(instance_method))::out) is det. parse_instance_methods(ModuleName, Methods, VarSet, Result) :- ( @@ -607,14 +591,13 @@ parse_instance_methods(ModuleName, Methods, VarSet, Result) :- ). % Turn the term into a method instance -:- pred term_to_instance_method(module_name, varset, term, - maybe1(instance_method)). -:- mode term_to_instance_method(in, in, in, out) is det. +:- pred term_to_instance_method(module_name::in, varset::in, term::in, + maybe1(instance_method)::out) is det. term_to_instance_method(_ModuleName, VarSet, MethodTerm, Result) :- ( MethodTerm = term__functor(term__atom("is"), [ClassMethodTerm, - InstanceMethod], TermContext) + InstanceMethod], TermContext) -> ( ClassMethodTerm = term__functor(term__atom("pred"), @@ -640,7 +623,8 @@ term_to_instance_method(_ModuleName, VarSet, MethodTerm, Result) :- ArityInt, TermContext)) ; Result = error( - "expected `pred( / ) is '", + "expected `pred( / ) " ++ + "is '", MethodTerm) ) ; @@ -667,12 +651,14 @@ term_to_instance_method(_ModuleName, VarSet, MethodTerm, Result) :- ArityInt, TermContext)) ; Result = error( - "expected `func( / ) is '", + "expected `func( / ) " ++ + "is '", MethodTerm) ) ; Result = error( - "expected `pred( / ) is '", + "expected `pred( / ) " ++ + "is '", MethodTerm) ) ; @@ -696,11 +682,10 @@ term_to_instance_method(_ModuleName, VarSet, MethodTerm, Result) :- _ClauseBody) -> adjust_func_arity(PredOrFunc, ArityInt, - list__length(HeadArgs)), + list__length(HeadArgs)), Result = ok(instance_method(PredOrFunc, - ClassMethodName, - clauses([Item]), - ArityInt, Context)) + ClassMethodName, clauses([Item]), ArityInt, + Context)) ; Result0 = error(ErrorMsg, ErrorTerm) -> @@ -708,8 +693,10 @@ term_to_instance_method(_ModuleName, VarSet, MethodTerm, Result) :- ; % catch-all error message for a syntactically valid item % which is not a clause - Result = error("expected clause or `pred( / ) is ' or `func( / ) is ')", + Result = error("expected clause or " ++ + "`pred( / ) is " ++ + "' or " ++ + "`func( / ) is ')", MethodTerm) ) ). - diff --git a/compiler/prog_io_util.m b/compiler/prog_io_util.m index ffbc0af0b..8610be9e9 100644 --- a/compiler/prog_io_util.m +++ b/compiler/prog_io_util.m @@ -300,7 +300,7 @@ convert_mode(AllowConstrainedInstVar, Term, Mode) :- Term = term__functor(term__atom("is"), [EqTerm, DetTerm], _), EqTerm = term__functor(term__atom("="), - [FuncTerm, RetModeTerm], _), + [FuncTerm, RetModeTerm], _), FuncTerm = term__functor(term__atom("func"), ArgModesTerms, _) -> DetTerm = term__functor(term__atom(DetString), [], _), @@ -360,7 +360,7 @@ convert_inst(AllowConstrainedInstVar, Term, Result) :- Name = "is", Args0 = [EqTerm, DetTerm], EqTerm = term__functor(term__atom("="), - [FuncTerm, RetModeTerm], _), + [FuncTerm, RetModeTerm], _), FuncTerm = term__functor(term__atom("func"), ArgModesTerm, _) -> DetTerm = term__functor(term__atom(DetString), [], _), @@ -393,7 +393,7 @@ convert_inst(AllowConstrainedInstVar, Term, Result) :- % Do not allow nested constrained_inst_vars. convert_inst(no_allow_constrained_inst_var, InstTerm, Inst), Result = constrained_inst_vars(set__make_singleton_set( - term__coerce_var(Var)), Inst) + term__coerce_var(Var)), Inst) % anything else must be a user-defined inst ; parse_qualified_term(Term, Term, "inst", diff --git a/compiler/recompilation.check.m b/compiler/recompilation.check.m index 8ec3e11d4..70c0b7e19 100644 --- a/compiler/recompilation.check.m +++ b/compiler/recompilation.check.m @@ -20,16 +20,15 @@ :- type modules_to_recompile ---> (all) - ; some(list(module_name)) - . + ; some(list(module_name)). :- type find_target_file_names == - pred(module_name, list(file_name), io__state, io__state). + pred(module_name, list(file_name), io, io). :- inst find_target_file_names == (pred(in, out, di, uo) is det). :- type find_timestamp_file_names == - pred(module_name, list(file_name), io__state, io__state). + pred(module_name, list(file_name), io, io). :- inst find_timestamp_file_names == (pred(in, out, di, uo) is det). @@ -49,8 +48,7 @@ :- pred recompilation__check__should_recompile(module_name::in, find_target_file_names::in(find_target_file_names), find_timestamp_file_names::in(find_timestamp_file_names), - modules_to_recompile::out, read_modules::out, - io__state::di, io__state::uo) is det. + modules_to_recompile::out, read_modules::out, io::di, io::uo) is det. %-----------------------------------------------------------------------------% @@ -70,112 +68,122 @@ :- import_module recompilation__version. :- import_module assoc_list, bool, exception, int, map, parser, require. -:- import_module set, std_util, string, term, term_io. +:- import_module svmap, set, std_util, string, term, term_io. recompilation__check__should_recompile(ModuleName, FindTargetFiles, FindTimestampFiles, Info ^ modules_to_recompile, - Info ^ read_modules) --> + Info ^ read_modules, !IO) :- globals__io_lookup_bool_option(find_all_recompilation_reasons, - FindAll), - { Info0 = recompilation_check_info(ModuleName, no, [], map__init, - init_item_id_set(map__init, map__init, map__init), - set__init, some([]), FindAll, []) }, + FindAll, !IO), + Info0 = recompilation_check_info(ModuleName, no, [], map__init, + init_item_id_set(map__init, map__init, map__init), + set__init, some([]), FindAll, []), recompilation__check__should_recompile_2(no, FindTargetFiles, - FindTimestampFiles, ModuleName, Info0, Info). + FindTimestampFiles, ModuleName, Info0, Info, !IO). :- pred recompilation__check__should_recompile_2(bool::in, find_target_file_names::in(find_target_file_names), find_timestamp_file_names::in(find_timestamp_file_names), module_name::in, recompilation_check_info::in, - recompilation_check_info::out, io__state::di, io__state::uo) is det. + recompilation_check_info::out, io::di, io::uo) is det. recompilation__check__should_recompile_2(IsSubModule, FindTargetFiles, - FindTimestampFiles, ModuleName, Info0, Info) --> - { Info1 = (Info0 ^ module_name := ModuleName) - ^ sub_modules := [] }, - module_name_to_file_name(ModuleName, ".used", no, UsageFileName), - io__open_input(UsageFileName, MaybeVersionStream), + FindTimestampFiles, ModuleName, !Info, !IO) :- + !:Info = (!.Info ^ module_name := ModuleName) ^ sub_modules := [], + module_name_to_file_name(ModuleName, ".used", no, UsageFileName, !IO), + io__open_input(UsageFileName, MaybeVersionStream, !IO), ( - { MaybeVersionStream = ok(VersionStream0) }, - io__set_input_stream(VersionStream0, OldInputStream), + MaybeVersionStream = ok(VersionStream0), + io__set_input_stream(VersionStream0, OldInputStream, !IO), promise_only_solution_io( - (pred(R::out, di, uo) is cc_multi --> - try_io( - (pred(Info2::out, di, uo) is det --> - recompilation__check__should_recompile_3( - IsSubModule, FindTargetFiles, - Info1, Info2) - ), R) - ), - Result), + should_recompile_3_try(IsSubModule, + FindTimestampFiles, !.Info), + Result, !IO), ( - { Result = succeeded(Info3) }, - { Reasons = Info3 ^ recompilation_reasons } + Result = succeeded(!:Info), + Reasons = !.Info ^ recompilation_reasons ; - { Result = failed }, - { error("recompilation__check__should_recompile_2") } + Result = failed, + error("recompilation__check__should_recompile_2") ; - { Result = exception(Exception) }, - { univ_to_type(Exception, RecompileException0) -> + Result = exception(Exception), + ( univ_to_type(Exception, RecompileException0) -> RecompileException = RecompileException0 ; rethrow(Result) - }, - { RecompileException = - recompile_exception(Reason, Info3) }, - { Reasons = [Reason] } + ), + RecompileException = + recompile_exception(Reason, !:Info), + Reasons = [Reason] ), - - ( { Reasons = [] } -> - FindTimestampFiles(ModuleName, TimestampFiles), + ( + Reasons = [], + FindTimestampFiles(ModuleName, TimestampFiles, !IO), write_recompilation_message( - (pred(di, uo) is det --> - io__write_string("Not recompiling module "), - prog_out__write_sym_name(ModuleName), - io__write_string(".\n") - )), - list__foldl(touch_datestamp, TimestampFiles), - { Info4 = Info3 } + (pred(IO0::di, IO::uo) is det :- + io__write_string( + "Not recompiling module ", + IO0, IO1), + prog_out__write_sym_name(ModuleName, + IO1, IO2), + io__write_string(".\n", IO2, IO) + ), !IO), + list__foldl(touch_datestamp, TimestampFiles, !IO) ; - { add_module_to_recompile(ModuleName, Info3, Info4) }, + Reasons = [_ | _], + add_module_to_recompile(ModuleName, !Info), write_recompilation_message( - (pred(di, uo) is det --> - list__foldl( - write_recompile_reason(ModuleName), - list__reverse(Reasons)) - )) + (pred(IO0::di, IO::uo) is det :- + list__foldl( + write_recompile_reason( + ModuleName), + list__reverse(Reasons), + IO0, IO) + ), !IO) ), - io__set_input_stream(OldInputStream, VersionStream), - io__close_input(VersionStream), + io__set_input_stream(OldInputStream, VersionStream, !IO), + io__close_input(VersionStream, !IO), - ( { (all) = Info4 ^ modules_to_recompile } -> - { Info = Info4 } + ( (all) = !.Info ^ modules_to_recompile -> + true ; - { Info5 = Info4 ^ is_inline_sub_module := yes }, + !:Info = !.Info ^ is_inline_sub_module := yes, list__foldl2( recompilation__check__should_recompile_2(yes, FindTargetFiles, FindTimestampFiles), - Info5 ^ sub_modules, Info5, Info) + !.Info ^ sub_modules, !Info, !IO) ) ; - { MaybeVersionStream = error(_) }, + MaybeVersionStream = error(_), write_recompilation_message( - (pred(di, uo) is det --> - { Reason = file_error(UsageFileName, - "file `" ++ UsageFileName ++ "' not found.") }, - write_recompile_reason(ModuleName, Reason) - )), - { Info = Info1 ^ modules_to_recompile := (all) } + (pred(IO0::di, IO::uo) is det :- + Reason = file_error(UsageFileName, + "file `" ++ UsageFileName ++ + "' not found."), + write_recompile_reason(ModuleName, Reason, + IO0, IO) + ), !IO), + !:Info = !.Info ^ modules_to_recompile := (all) ). +:- pred should_recompile_3_try(bool::in, + find_timestamp_file_names::in(find_timestamp_file_names), + recompilation_check_info::in, + exception_result(recompilation_check_info)::out, + io::di, io::uo) is cc_multi. + +should_recompile_3_try(IsSubModule, FindTargetFiles, Info, Result, !IO) :- + try_io(should_recompile_3(IsSubModule, FindTargetFiles, Info), + Result, !IO). + :- pred recompilation__check__should_recompile_3(bool::in, - find_target_file_names::in(find_target_file_names), - recompilation_check_info::in, recompilation_check_info::out, - io__state::di, io__state::uo) is det. + find_target_file_names::in(find_target_file_names), + recompilation_check_info::in, recompilation_check_info::out, + io::di, io::uo) is det. recompilation__check__should_recompile_3(IsSubModule, FindTargetFiles, - Info0, Info) --> + !Info, !IO) :- % % WARNING: any exceptions thrown before the sub_modules @@ -188,62 +196,63 @@ recompilation__check__should_recompile_3(IsSubModule, FindTargetFiles, % % Check that the format of the usage file is the current format. % - read_term_check_for_error_or_eof(Info0, "usage file version number", - VersionNumberTerm), + read_term_check_for_error_or_eof(!.Info, "usage file version number", + VersionNumberTerm, !IO), ( - { VersionNumberTerm = term__functor(term__atom(","), + VersionNumberTerm = term__functor(term__atom(","), [UsageFileVersionNumberTerm, - VersionNumbersVersionNumberTerm], _) }, - { UsageFileVersionNumberTerm = + VersionNumbersVersionNumberTerm], _), + UsageFileVersionNumberTerm = term__functor( term__integer(usage_file_version_number), - _, _) }, - { VersionNumbersVersionNumberTerm = + _, _), + VersionNumbersVersionNumberTerm = term__functor( term__integer(version_numbers_version_number), - _, _) } + _, _) -> - [] + true ; - io__input_stream_name(UsageFileName), - { throw_syntax_error( + io__input_stream_name(UsageFileName, !IO), + throw_syntax_error( file_error(UsageFileName, "invalid usage file version number in file `" ++ UsageFileName ++ "'."), - Info0) } + !.Info) ), % % Find the timestamp of the module the last time it was compiled. % - read_term_check_for_error_or_eof(Info0, "module timestamp", - TimestampTerm), - { parse_module_timestamp(Info0, TimestampTerm, _, ModuleTimestamp) }, - { ModuleTimestamp = module_timestamp(_, RecordedTimestamp, _) }, + read_term_check_for_error_or_eof(!.Info, "module timestamp", + TimestampTerm, !IO), + parse_module_timestamp(!.Info, TimestampTerm, _, ModuleTimestamp), + ModuleTimestamp = module_timestamp(_, RecordedTimestamp, _), - ( { IsSubModule = yes } -> + ( + IsSubModule = yes % For inline sub-modules we don't need to check % the module timestamp because we've already checked % the timestamp for the parent module. - { Info3 = Info0 } ; + IsSubModule = no, % % If the module has changed, recompile. % - { ModuleName = Info0 ^ module_name }, + ModuleName = !.Info ^ module_name, read_mod_if_changed(ModuleName, ".m", "Reading module", yes, RecordedTimestamp, Items, Error, - FileName, MaybeNewTimestamp), - { + FileName, MaybeNewTimestamp, !IO), + ( MaybeNewTimestamp = yes(NewTimestamp), NewTimestamp \= RecordedTimestamp -> record_read_file(ModuleName, ModuleTimestamp ^ timestamp := NewTimestamp, - Items, Error, FileName, Info0, Info1), - Info2 = Info1 ^ modules_to_recompile := (all), + Items, Error, FileName, !Info), + !:Info = !.Info ^ modules_to_recompile := (all), record_recompilation_reason(module_changed(FileName), - Info2, Info3) + !Info) ; ( Error \= no_module_errors ; MaybeNewTimestamp = no @@ -251,103 +260,106 @@ recompilation__check__should_recompile_3(IsSubModule, FindTargetFiles, -> throw_syntax_error( file_error(FileName, - "error reading file `" - ++ FileName ++ "'."), - Info0) + "error reading file `" + ++ FileName ++ "'."), + !.Info) ; - Info3 = Info0 - } + true + ) ), % % Find out whether this module has any inline sub-modules. % - read_term_check_for_error_or_eof(Info3, "inline sub-modules", - SubModulesTerm), - { + read_term_check_for_error_or_eof(!.Info, "inline sub-modules", + SubModulesTerm, !IO), + ( SubModulesTerm = term__functor(term__atom("sub_modules"), - SubModuleTerms, _), + SubModuleTerms, _), list__map( (pred(Term::in, SubModule::out) is semidet :- sym_name_and_args(Term, SubModule, []) ), SubModuleTerms, SubModules) -> - Info4 = Info3 ^ sub_modules := SubModules + !:Info = !.Info ^ sub_modules := SubModules ; Reason1 = syntax_error(get_term_context(SubModulesTerm), - "error in sub_modules term"), - throw_syntax_error(Reason1, Info3) - }, + "error in sub_modules term"), + throw_syntax_error(Reason1, !.Info) + ), % % Check whether the output files are present and up-to-date. % - FindTargetFiles(Info4 ^ module_name, TargetFiles), + FindTargetFiles(!.Info ^ module_name, TargetFiles, !IO), list__foldl2( - (pred(TargetFile::in, RInfo0::in, RInfo::out, di, uo) is det --> - io__file_modification_time(TargetFile, TargetModTimeResult), - { - TargetModTimeResult = ok(TargetModTime), - compare(TargetModTimeCompare, - time_t_to_timestamp(TargetModTime), - RecordedTimestamp), - TargetModTimeCompare = (>) - -> - RInfo = RInfo0 - ; - Reason2 = output_file_not_up_to_date(TargetFile), - record_recompilation_reason(Reason2, RInfo0, RInfo) - } - ), TargetFiles, Info4, Info5), + (pred(TargetFile::in, RInfo0::in, RInfo::out, IO0::di, IO::uo) + is det :- + io__file_modification_time(TargetFile, + TargetModTimeResult, IO0, IO), + ( + TargetModTimeResult = ok(TargetModTime), + compare(TargetModTimeCompare, + time_t_to_timestamp(TargetModTime), + RecordedTimestamp), + TargetModTimeCompare = (>) + -> + RInfo = RInfo0 + ; + Reason2 = + output_file_not_up_to_date(TargetFile), + record_recompilation_reason(Reason2, + RInfo0, RInfo) + ) + ), TargetFiles, !Info, !IO), % % Read in the used items, used for checking for % ambiguities with new items. % - read_term_check_for_error_or_eof(Info5, "used items", - UsedItemsTerm), - { parse_used_items(Info5, UsedItemsTerm, UsedItems) }, - { Info6 = Info5 ^ used_items := UsedItems }, + read_term_check_for_error_or_eof(!.Info, "used items", + UsedItemsTerm, !IO), + parse_used_items(!.Info, UsedItemsTerm, UsedItems), + !:Info = !.Info ^ used_items := UsedItems, - read_term_check_for_error_or_eof(Info6, "used classes", - UsedClassesTerm), - { + read_term_check_for_error_or_eof(!.Info, "used classes", + UsedClassesTerm, !IO), + ( UsedClassesTerm = term__functor(term__atom("used_classes"), - UsedClassTerms, _), + UsedClassTerms, _), list__map( (pred(Term::in, UsedClass::out) is semidet :- - parse_name_and_arity(Term, - ClassName, ClassArity), + parse_name_and_arity(Term, ClassName, + ClassArity), UsedClass = ClassName - ClassArity ), UsedClassTerms, UsedClasses) -> - Info7 = Info6 ^ used_typeclasses := - set__list_to_set(UsedClasses) + !:Info = !.Info ^ used_typeclasses := + set__list_to_set(UsedClasses) ; Reason3 = syntax_error(get_term_context(UsedClassesTerm), - "error in used_typeclasses term"), - throw_syntax_error(Reason3, Info6) - }, - check_imported_modules(Info7, Info). - + "error in used_typeclasses term"), + throw_syntax_error(Reason3, !.Info) + ), + check_imported_modules(!Info, !IO). %-----------------------------------------------------------------------------% :- pred parse_module_timestamp(recompilation_check_info::in, term::in, - module_name::out, module_timestamp::out) is det. + module_name::out, module_timestamp::out) is det. parse_module_timestamp(Info, Term, ModuleName, ModuleTimestamp) :- conjunction_to_list(Term, Args), ( - Args = [ModuleNameTerm, SuffixTerm, - TimestampTerm | MaybeOtherTerms], + Args = [ModuleNameTerm, SuffixTerm, TimestampTerm + | MaybeOtherTerms], sym_name_and_args(ModuleNameTerm, ModuleName0, []), SuffixTerm = term__functor(term__string(Suffix), [], _), Timestamp = term_to_timestamp(TimestampTerm), ( MaybeOtherTerms = [term__functor(term__atom("used"), - [], _)], + [], _)], NeedQualifier = must_be_qualified ; MaybeOtherTerms = [], @@ -355,27 +367,27 @@ parse_module_timestamp(Info, Term, ModuleName, ModuleTimestamp) :- ) -> ModuleName = ModuleName0, - ModuleTimestamp = module_timestamp(Suffix, - Timestamp, NeedQualifier) + ModuleTimestamp = module_timestamp(Suffix, Timestamp, + NeedQualifier) ; Reason = syntax_error(get_term_context(Term), - "error in module timestamp"), + "error in module timestamp"), throw_syntax_error(Reason, Info) ). %-----------------------------------------------------------------------------% :- pred parse_used_items(recompilation_check_info::in, - term::in, resolved_used_items::out) is det. + term::in, resolved_used_items::out) is det. parse_used_items(Info, Term, UsedItems) :- ( Term = term__functor(term__atom("used_items"), UsedItemTerms, _) -> - list__foldl(parse_used_item_set(Info), UsedItemTerms, + list__foldl(parse_used_item_set(Info), UsedItemTerms, init_item_id_set(map__init, map__init, map__init), UsedItems) ; Reason = syntax_error(get_term_context(Term), - "error in used items"), + "error in used items"), throw_syntax_error(Reason, Info) ). @@ -388,8 +400,8 @@ parse_used_item_set(Info, Term, UsedItems0, UsedItems) :- string_to_item_type(ItemTypeStr, ItemType) -> ( is_simple_item_type(ItemType) -> - list__foldl(parse_simple_item(Info), - ItemTerms, map__init, SimpleItems), + list__foldl(parse_simple_item(Info), ItemTerms, + map__init, SimpleItems), UsedItems = update_simple_item_set(UsedItems0, ItemType, SimpleItems) ; is_pred_or_func_item_type(ItemType) -> @@ -403,24 +415,23 @@ parse_used_item_set(Info, Term, UsedItems0, UsedItems) :- UsedItems = UsedItems0 ^ functors := CtorItems ; Reason = syntax_error(get_term_context(Term), - string__append( - "error in used items: unknown item type :", - ItemTypeStr)), + "error in used items: unknown item type :" ++ + ItemTypeStr), throw_syntax_error(Reason, Info) ) ; Reason = syntax_error(get_term_context(Term), - "error in used items"), + "error in used items"), throw_syntax_error(Reason, Info) ). :- pred parse_simple_item(recompilation_check_info::in, term::in, - simple_item_set::in, simple_item_set::out) is det. + simple_item_set::in, simple_item_set::out) is det. parse_simple_item(Info, Term, Set0, Set) :- ( Term = term__functor(term__atom("-"), - [NameArityTerm, MatchesTerm], _), + [NameArityTerm, MatchesTerm], _), parse_name_and_arity(NameArityTerm, SymName, Arity) -> unqualify_name(SymName, Name), @@ -430,13 +441,13 @@ parse_simple_item(Info, Term, Set0, Set) :- map__det_insert(Set0, Name - Arity, Matches, Set) ; Reason = syntax_error(get_term_context(Term), - "error in simple items"), + "error in simple items"), throw_syntax_error(Reason, Info) ). :- pred parse_simple_item_match(recompilation_check_info::in, term::in, - map(module_qualifier, module_name)::in, - map(module_qualifier, module_name)::out) is det. + map(module_qualifier, module_name)::in, + map(module_qualifier, module_name)::out) is det. parse_simple_item_match(Info, Term, Items0, Items) :- ( @@ -454,22 +465,21 @@ parse_simple_item_match(Info, Term, Items0, Items) :- map__det_insert(Items0, Qualifier, ModuleName, Items) ; Reason = syntax_error(get_term_context(Term), - "error in simple item match"), + "error in simple item match"), throw_syntax_error(Reason, Info) ). -:- pred parse_pred_or_func_item(recompilation_check_info::in, - term::in, resolved_pred_or_func_set::in, - resolved_pred_or_func_set::out) is det. +:- pred parse_pred_or_func_item(recompilation_check_info::in, term::in, + resolved_pred_or_func_set::in, resolved_pred_or_func_set::out) is det. -parse_pred_or_func_item(Info, Term, Set0, Set) :- - parse_resolved_item_set(Info, parse_pred_or_func_item_match, - Term, Set0, Set). +parse_pred_or_func_item(Info, Term, !Set) :- + parse_resolved_item_set(Info, parse_pred_or_func_item_match, Term, + !Set). :- pred parse_pred_or_func_item_match(recompilation_check_info::in, term::in, resolved_pred_or_func_map::in, resolved_pred_or_func_map::out) is det. -parse_pred_or_func_item_match(Info, Term, Items0, Items) :- +parse_pred_or_func_item_match(Info, Term, !Items) :- PredId = invalid_pred_id, ( ( @@ -479,57 +489,56 @@ parse_pred_or_func_item_match(Info, Term, Items0, Items) :- sym_name_and_args(QualifierTerm, Qualifier, []), conjunction_to_list(MatchesTerm, MatchesList), list__map( - (pred(MatchTerm::in, Match::out) is semidet :- - sym_name_and_args(MatchTerm, MatchName, []), - Match = PredId - MatchName - ), - MatchesList, Matches) + (pred(MatchTerm::in, Match::out) is semidet :- + sym_name_and_args(MatchTerm, MatchName, + []), + Match = PredId - MatchName + ), + MatchesList, Matches) ; sym_name_and_args(Term, Qualifier, []), Matches = [PredId - Qualifier] ) -> - map__det_insert(Items0, Qualifier, set__list_to_set(Matches), - Items) + svmap__det_insert(Qualifier, set__list_to_set(Matches), + !Items) ; Reason = syntax_error(get_term_context(Term), - "error in pred or func match"), + "error in pred or func match"), throw_syntax_error(Reason, Info) ). :- pred parse_functor_item(recompilation_check_info::in, term::in, resolved_functor_set::in, resolved_functor_set::out) is det. -parse_functor_item(Info, Term, Set0, Set) :- - parse_resolved_item_set(Info, parse_functor_matches, Term, Set0, Set). +parse_functor_item(Info, Term, !Set) :- + parse_resolved_item_set(Info, parse_functor_matches, Term, !Set). :- pred parse_functor_matches(recompilation_check_info::in, term::in, resolved_functor_map::in, resolved_functor_map::out) is det. -parse_functor_matches(Info, Term, Map0, Map) :- +parse_functor_matches(Info, Term, !Map) :- ( Term = term__functor(term__atom("=>"), [QualifierTerm, MatchesTerm], _), sym_name_and_args(QualifierTerm, Qualifier, []) -> conjunction_to_list(MatchesTerm, MatchesList), - list__map(parse_resolved_functor(Info), - MatchesList, Matches), - map__det_insert(Map0, Qualifier, - set__list_to_set(Matches), Map) + list__map(parse_resolved_functor(Info), MatchesList, Matches), + svmap__det_insert(Qualifier, set__list_to_set(Matches), !Map) ; Reason = syntax_error(get_term_context(Term), - "error in functor match"), + "error in functor match"), throw_syntax_error(Reason, Info) ). :- pred parse_resolved_functor(recompilation_check_info::in, term::in, - resolved_functor::out) is det. + resolved_functor::out) is det. parse_resolved_functor(Info, Term, Ctor) :- ( Term = term__functor(term__atom(PredOrFuncStr), - [ModuleTerm, ArityTerm], _), + [ModuleTerm, ArityTerm], _), ( PredOrFuncStr = "predicate", PredOrFunc = predicate ; PredOrFuncStr = "function", PredOrFunc = function ), @@ -552,7 +561,7 @@ parse_resolved_functor(Info, Term, Ctor) :- Ctor = field(TypeName - TypeArity, ConsName - ConsArity) ; Reason = syntax_error(get_term_context(Term), - "error in functor match"), + "error in functor match"), throw_syntax_error(Reason, Info) ). @@ -568,7 +577,7 @@ parse_resolved_functor(Info, Term, Ctor) :- parse_resolved_item_set(Info, ParseMatches, Term, Set0, Set) :- ( Term = term__functor(term__atom("-"), - [NameTerm, MatchesTerm], _), + [NameTerm, MatchesTerm], _), NameTerm = term__functor(term__atom(Name), [], _) -> conjunction_to_list(MatchesTerm, MatchTermList), @@ -578,7 +587,7 @@ parse_resolved_item_set(Info, ParseMatches, Term, Set0, Set) :- map__det_insert(Set0, Name, Matches, Set) ; Reason = syntax_error(get_term_context(Term), - "error in resolved item matches"), + "error in resolved item matches"), throw_syntax_error(Reason, Info) ). @@ -586,8 +595,8 @@ parse_resolved_item_set(Info, ParseMatches, Term, Set0, Set) :- parse_resolved_item_matches(T)::in(parse_resolved_item_matches), term::in, pair(arity, resolved_item_map(T))::out) is det. -parse_resolved_item_arity_matches(Info, ParseMatches, - Term, Arity - MatchMap) :- +parse_resolved_item_arity_matches(Info, ParseMatches, Term, + Arity - MatchMap) :- ( Term = term__functor(term__atom("-"), [ArityTerm, MatchesTerm], _), @@ -602,7 +611,7 @@ parse_resolved_item_arity_matches(Info, ParseMatches, MatchTermList, map__init, MatchMap) ; Reason = syntax_error(get_term_context(Term), - "error in resolved item matches"), + "error in resolved item matches"), throw_syntax_error(Reason, Info) ). @@ -615,44 +624,45 @@ parse_resolved_item_arity_matches(Info, ParseMatches, % a recompilation. % :- pred check_imported_modules(recompilation_check_info::in, - recompilation_check_info::out, io__state::di, io__state::uo) is det. + recompilation_check_info::out, io::di, io::uo) is det. -check_imported_modules(Info0, Info) --> - parser__read_term(TermResult), +check_imported_modules(!Info, !IO) :- + parser__read_term(TermResult, !IO), ( - { TermResult = term(_, Term) }, - ( { Term = term__functor(term__atom("done"), [], _) } -> - { Info = Info0 } + TermResult = term(_, Term), + ( Term = term__functor(term__atom("done"), [], _) -> + true ; - check_imported_module(Term, Info0, Info1), - check_imported_modules(Info1, Info) + check_imported_module(Term, !Info, !IO), + check_imported_modules(!Info, !IO) ) ; - { TermResult = error(Message, Line) }, - io__input_stream_name(FileName), - { Reason = syntax_error(term__context(FileName, Line), - Message) }, - { throw_syntax_error(Reason, Info0) } + TermResult = error(Message, Line), + io__input_stream_name(FileName, !IO), + Reason = syntax_error(term__context(FileName, Line), + Message), + throw_syntax_error(Reason, !.Info) ; - { TermResult = eof }, + TermResult = eof, % % There should always be an item `done.' at the end of % the list of modules to check. This is used to make % sure that the writing of the `.used' file was not % interrupted. % - io__input_stream_name(FileName), - io__get_line_number(Line), - { Reason = syntax_error(term__context(FileName, Line), - "unexpected end of file") }, - { throw_syntax_error(Reason, Info0) } + io__input_stream_name(FileName, !IO), + io__get_line_number(Line, !IO), + Reason = syntax_error(term__context(FileName, Line), + "unexpected end of file"), + throw_syntax_error(Reason, !.Info) ). -:- pred check_imported_module(term::in, recompilation_check_info::in, - recompilation_check_info::out, io__state::di, io__state::uo) is det. +:- pred check_imported_module(term::in, + recompilation_check_info::in, recompilation_check_info::out, + io::di, io::uo) is det. -check_imported_module(Term, Info0, Info) --> - { +check_imported_module(Term, !Info, !IO) :- + ( Term = term__functor(term__atom("=>"), [TimestampTerm0, UsedItemsTerm0], _) -> @@ -661,36 +671,36 @@ check_imported_module(Term, Info0, Info) --> ; TimestampTerm = Term, MaybeUsedItemsTerm = no - }, - { parse_module_timestamp(Info0, TimestampTerm, - ImportedModuleName, ModuleTimestamp) }, + ), + parse_module_timestamp(!.Info, TimestampTerm, + ImportedModuleName, ModuleTimestamp), - { ModuleTimestamp = module_timestamp(Suffix, - RecordedTimestamp, NeedQualifier) }, + ModuleTimestamp = module_timestamp(Suffix, + RecordedTimestamp, NeedQualifier), ( % % If we're checking a sub-module, don't re-read % interface files read for other modules checked % during this compilation. % - { Info0 ^ is_inline_sub_module = yes }, - { find_read_module(Info0 ^ read_modules, ImportedModuleName, + !.Info ^ is_inline_sub_module = yes, + find_read_module(!.Info ^ read_modules, ImportedModuleName, Suffix, yes, Items0, MaybeNewTimestamp0, - Error0, FileName0) } + Error0, FileName0) -> - { Items = Items0 }, - { MaybeNewTimestamp = MaybeNewTimestamp0 }, - { Error = Error0 }, - { FileName = FileName0 }, - { Recorded = bool__yes } + Items = Items0, + MaybeNewTimestamp = MaybeNewTimestamp0, + Error = Error0, + FileName = FileName0, + Recorded = bool__yes ; - { Recorded = bool__no }, + Recorded = bool__no, read_mod_if_changed(ImportedModuleName, Suffix, "Reading interface file for module", yes, RecordedTimestamp, Items, Error, - FileName, MaybeNewTimestamp) + FileName, MaybeNewTimestamp, !IO) ), - { + ( MaybeNewTimestamp = yes(NewTimestamp), NewTimestamp \= RecordedTimestamp, Error = no_module_errors @@ -698,14 +708,14 @@ check_imported_module(Term, Info0, Info) --> ( Recorded = no -> record_read_file(ImportedModuleName, ModuleTimestamp ^ timestamp := NewTimestamp, - Items, Error, FileName, Info0, Info1) + Items, Error, FileName, !Info) ; - Info1 = Info0 + true ), ( MaybeUsedItemsTerm = yes(UsedItemsTerm), Items = [InterfaceItem, VersionNumberItem - | OtherItems], + | OtherItems], InterfaceItem = module_defn(_, interface) - _, VersionNumberItem = module_defn(_, version_numbers(_, VersionNumbers)) - _ @@ -713,10 +723,10 @@ check_imported_module(Term, Info0, Info) --> check_module_used_items(ImportedModuleName, NeedQualifier, RecordedTimestamp, UsedItemsTerm, VersionNumbers, - OtherItems, Info1, Info) + OtherItems, !Info) ; record_recompilation_reason(module_changed(FileName), - Info1, Info) + !Info) ) ; Error \= no_module_errors @@ -724,34 +734,32 @@ check_imported_module(Term, Info0, Info) --> throw_syntax_error( file_error(FileName, "error reading file `" ++ FileName ++ "'."), - Info0) + !.Info) ; - Info = Info0 - }. + true + ). :- pred check_module_used_items(module_name::in, need_qualifier::in, timestamp::in, term::in, version_numbers::in, item_list::in, recompilation_check_info::in, recompilation_check_info::out) is det. check_module_used_items(ModuleName, NeedQualifier, OldTimestamp, - UsedItemsTerm, NewVersionNumbers, - Items) --> + UsedItemsTerm, NewVersionNumbers, Items, !Info) :- - { recompilation__version__parse_version_numbers(UsedItemsTerm, - UsedItemsResult) }, - =(Info0), - { + recompilation__version__parse_version_numbers(UsedItemsTerm, + UsedItemsResult), + ( UsedItemsResult = ok(UsedVersionNumbers) ; UsedItemsResult = error(Msg, ErrorTerm), Reason = syntax_error(get_term_context(ErrorTerm), Msg), - throw_syntax_error(Reason, Info0) - }, + throw_syntax_error(Reason, !.Info) + ), - { UsedVersionNumbers = version_numbers(UsedItemVersionNumbers, - UsedInstanceVersionNumbers) }, - { NewVersionNumbers = version_numbers(NewItemVersionNumbers, - NewInstanceVersionNumbers) }, + UsedVersionNumbers = version_numbers(UsedItemVersionNumbers, + UsedInstanceVersionNumbers), + NewVersionNumbers = version_numbers(NewItemVersionNumbers, + NewInstanceVersionNumbers), % % Check whether any of the items which were used have changed. @@ -760,47 +768,44 @@ check_module_used_items(ModuleName, NeedQualifier, OldTimestamp, check_item_version_numbers(ModuleName, UsedItemVersionNumbers, NewItemVersionNumbers), [(type), type_body, (inst), (mode), (typeclass), - predicate, function]), + predicate, function], !Info), % % Check whether added or modified items could cause name % resolution ambiguities with items which were used. % - list__foldl( - check_for_ambiguities(NeedQualifier, - OldTimestamp, UsedItemVersionNumbers), - Items), + list__foldl(check_for_ambiguities(NeedQualifier, + OldTimestamp, UsedItemVersionNumbers), Items, !Info), % % Check whether any instances of used typeclasses have been % added, removed or changed. % check_instance_version_numbers(ModuleName, UsedInstanceVersionNumbers, - NewInstanceVersionNumbers), + NewInstanceVersionNumbers, !Info), % % Check for new instances for used typeclasses. % - { ModuleInstances = set__sorted_list_to_set( - map__sorted_keys(NewInstanceVersionNumbers)) }, - { UsedInstances = set__sorted_list_to_set( - map__sorted_keys(UsedInstanceVersionNumbers)) }, + ModuleInstances = set__sorted_list_to_set( + map__sorted_keys(NewInstanceVersionNumbers)), + UsedInstances = set__sorted_list_to_set( + map__sorted_keys(UsedInstanceVersionNumbers)), - UsedClasses =^ used_typeclasses, - { set__difference(set__intersect(UsedClasses, ModuleInstances), - UsedInstances, AddedInstances) }, - ( { [AddedInstance | _] = set__to_sorted_list(AddedInstances) } -> - { Reason1 = changed_or_added_instance(ModuleName, - AddedInstance) }, - record_recompilation_reason(Reason1) + UsedClasses = !.Info ^ used_typeclasses, + set__difference(set__intersect(UsedClasses, ModuleInstances), + UsedInstances, AddedInstances), + ( [AddedInstance | _] = set__to_sorted_list(AddedInstances) -> + Reason1 = changed_or_added_instance(ModuleName, AddedInstance), + record_recompilation_reason(Reason1, !Info) ; - [] + true ). :- func make_item_id(module_name, item_type, pair(string, arity)) = item_id. make_item_id(Module, ItemType, Name - Arity) = - item_id(ItemType, qualified(Module, Name) - Arity). + item_id(ItemType, qualified(Module, Name) - Arity). %-----------------------------------------------------------------------------% @@ -808,56 +813,60 @@ make_item_id(Module, ItemType, Name - Arity) = item_version_numbers::in, item_type::in, recompilation_check_info::in, recompilation_check_info::out) is det. -check_item_version_numbers(ModuleName, UsedVersionNumbers, - NewVersionNumbers, ItemType) --> - { NewItemTypeVersionNumbers = extract_ids(NewVersionNumbers, - ItemType) }, - map__foldl( - (pred(NameArity::in, UsedVersionNumber::in, in, out) is det --> - ( - { map__search(NewItemTypeVersionNumbers, - NameArity, NewVersionNumber) } - -> - ( { NewVersionNumber = UsedVersionNumber } -> - [] - ; - { Reason = changed_item( - make_item_id(ModuleName, ItemType, - NameArity)) }, - record_recompilation_reason(Reason) - ) +check_item_version_numbers(ModuleName, UsedVersionNumbers, NewVersionNumbers, + ItemType, !Info) :- + NewItemTypeVersionNumbers = extract_ids(NewVersionNumbers, ItemType), + map__foldl(check_item_version_number(ModuleName, + NewItemTypeVersionNumbers, ItemType), + extract_ids(UsedVersionNumbers, ItemType), !Info). + +:- pred check_item_version_number(module_name::in, version_number_map::in, + item_type::in, pair(string, arity)::in, version_number::in, + recompilation_check_info::in, recompilation_check_info::out) is det. + +check_item_version_number(ModuleName, NewItemTypeVersionNumbers, ItemType, + NameArity, UsedVersionNumber, !Info) :- + ( map__search(NewItemTypeVersionNumbers, NameArity, NewVersionNumber) -> + ( NewVersionNumber = UsedVersionNumber -> + true ; - { Reason = removed_item(make_item_id(ModuleName, - ItemType, NameArity)) }, - record_recompilation_reason(Reason) + Reason = changed_item(make_item_id(ModuleName, + ItemType, NameArity)), + record_recompilation_reason(Reason, !Info) ) - ), - extract_ids(UsedVersionNumbers, ItemType)). + ; + Reason = removed_item(make_item_id(ModuleName, ItemType, + NameArity)), + record_recompilation_reason(Reason, !Info) + ). :- pred check_instance_version_numbers(module_name::in, instance_version_numbers::in, instance_version_numbers::in, recompilation_check_info::in, recompilation_check_info::out) is det. check_instance_version_numbers(ModuleName, UsedInstanceVersionNumbers, - NewInstanceVersionNumbers) --> - map__foldl( - (pred(ClassId::in, UsedVersionNumber::in, in, out) is det --> - ( - { map__search(NewInstanceVersionNumbers, - ClassId, NewVersionNumber) } - -> - ( { UsedVersionNumber = NewVersionNumber } -> - [] - ; - { Reason = changed_or_added_instance( - ModuleName, ClassId) }, - record_recompilation_reason(Reason) - ) + NewInstanceVersionNumbers, !Info) :- + map__foldl(check_instance_version_number(ModuleName, + NewInstanceVersionNumbers), UsedInstanceVersionNumbers, !Info). + +:- pred check_instance_version_number(module_name::in, + instance_version_numbers::in, item_name::in, version_number::in, + recompilation_check_info::in, recompilation_check_info::out) is det. + +check_instance_version_number(ModuleName, NewInstanceVersionNumbers, + ClassId, UsedVersionNumber, !Info) :- + ( map__search(NewInstanceVersionNumbers, ClassId, NewVersionNumber) -> + ( UsedVersionNumber = NewVersionNumber -> + true ; - { Reason = removed_instance(ModuleName, ClassId) }, - record_recompilation_reason(Reason) + Reason = changed_or_added_instance(ModuleName, + ClassId) , + record_recompilation_reason(Reason, !Info) ) - ), UsedInstanceVersionNumbers). + ; + Reason = removed_instance(ModuleName, ClassId), + record_recompilation_reason(Reason, !Info) + ). %-----------------------------------------------------------------------------% @@ -871,68 +880,74 @@ check_instance_version_numbers(ModuleName, UsedInstanceVersionNumbers, item_version_numbers::in, item_and_context::in, recompilation_check_info::in, recompilation_check_info::out) is det. -check_for_ambiguities(_, _, _, clause(_, _, _, _, _) - _) --> - { error("check_for_ambiguities: clause") }. +check_for_ambiguities(_, _, _, clause(_, _, _, _, _) - _, !Info) :- + error("check_for_ambiguities: clause"). check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers, - type_defn(_, Name, Params, Body, _) - _) --> - { Arity = list__length(Params) }, + type_defn(_, Name, Params, Body, _) - _, !Info) :- + Arity = list__length(Params), check_for_simple_item_ambiguity(NeedQualifier, OldTimestamp, - VersionNumbers, (type), Name, Arity, NeedsCheck), - ( { NeedsCheck = yes } -> + VersionNumbers, (type), Name, Arity, NeedsCheck, !Info), + ( + NeedsCheck = yes, check_type_defn_ambiguity_with_functor(NeedQualifier, - Name - Arity, Body) + Name - Arity, Body, !Info) ; - [] + NeedsCheck = no ). check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers, - inst_defn(_, Name, Params, _, _) - _) --> + inst_defn(_, Name, Params, _, _) - _, !Info) :- check_for_simple_item_ambiguity(NeedQualifier, OldTimestamp, - VersionNumbers, (inst), Name, list__length(Params), _). + VersionNumbers, (inst), Name, list__length(Params), _, !Info). check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers, - mode_defn(_, Name, Params, _, _) - _) --> + mode_defn(_, Name, Params, _, _) - _, !Info) :- check_for_simple_item_ambiguity(NeedQualifier, OldTimestamp, - VersionNumbers, (mode), Name, list__length(Params), _). + VersionNumbers, (mode), Name, list__length(Params), _, !Info). check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers, - typeclass(_, Name, Params, Interface, _) - _) --> + typeclass(_, Name, Params, Interface, _) - _, !Info) :- check_for_simple_item_ambiguity(NeedQualifier, OldTimestamp, VersionNumbers, (typeclass), Name, list__length(Params), - NeedsCheck), - ( { NeedsCheck = yes, Interface = concrete(Methods) } -> + NeedsCheck, !Info), + ( + NeedsCheck = yes, + Interface = concrete(Methods) + -> list__foldl( - (pred(ClassMethod::in, in, out) is det --> - ( - { ClassMethod = pred_or_func(_, _, _, - PredOrFunc, MethodName, MethodArgs, - MethodWithType, _, _, _, _, _, _) }, - check_for_pred_or_func_item_ambiguity(yes, - NeedQualifier, OldTimestamp, - VersionNumbers, PredOrFunc, - MethodName, MethodArgs, MethodWithType) - ; - { ClassMethod = pred_or_func_mode(_, _, _, _, - _, _, _, _) } - ) - ), - Methods) + (pred(ClassMethod::in, IO0::in, IO::out) is det :- + ( + ClassMethod = pred_or_func(_, _, _, + PredOrFunc, MethodName, + MethodArgs, MethodWithType, + _, _, _, _, _, _), + check_for_pred_or_func_item_ambiguity( + yes, NeedQualifier, + OldTimestamp, VersionNumbers, + PredOrFunc, MethodName, + MethodArgs, MethodWithType, + IO0, IO) + ; + ClassMethod = pred_or_func_mode(_, _, + _, _, _, _, _, _), + IO = IO0 + ) + ), Methods, !Info) ; - [] + true ). check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers, pred_or_func(_, _, _, PredOrFunc, Name, Args, - WithType, _, _, _, _, _) - _) - --> + WithType, _, _, _, _, _) - _, !Info) :- check_for_pred_or_func_item_ambiguity(no, NeedQualifier, OldTimestamp, - VersionNumbers, PredOrFunc, Name, Args, WithType). + VersionNumbers, PredOrFunc, Name, Args, WithType, !Info). check_for_ambiguities(_, _, _, - pred_or_func_mode(_, _, _, _, _, _, _) - _) --> []. -check_for_ambiguities(_, _, _, pragma(_) - _) --> []. -check_for_ambiguities(_, _, _, promise(_, _, _, _) - _) --> []. -check_for_ambiguities(_, _, _, module_defn(_, _) - _) --> []. -check_for_ambiguities(_, _, _, instance(_, _, _, _, _, _) - _) --> []. -check_for_ambiguities(_, _, _, nothing(_) - _) --> []. + pred_or_func_mode(_, _, _, _, _, _, _) - _, !Info). +check_for_ambiguities(_, _, _, pragma(_) - _, !Info). +check_for_ambiguities(_, _, _, promise(_, _, _, _) - _, !Info). +check_for_ambiguities(_, _, _, module_defn(_, _) - _, !Info). +check_for_ambiguities(_, _, _, instance(_, _, _, _, _, _) - _, !Info). +check_for_ambiguities(_, _, _, nothing(_) - _, !Info). :- pred item_is_new_or_changed(timestamp::in, item_version_numbers::in, - item_type::in, sym_name::in, arity::in) is semidet. + item_type::in, sym_name::in, arity::in) is semidet. item_is_new_or_changed(UsedFileTimestamp, UsedVersionNumbers, ItemType, SymName, Arity) :- @@ -949,33 +964,32 @@ item_is_new_or_changed(UsedFileTimestamp, UsedVersionNumbers, :- pred check_for_simple_item_ambiguity(need_qualifier::in, timestamp::in, item_version_numbers::in, item_type::in(simple_item), sym_name::in, - arity::in, bool::out, recompilation_check_info::in, - recompilation_check_info::out) is det. + arity::in, bool::out, + recompilation_check_info::in, recompilation_check_info::out) is det. check_for_simple_item_ambiguity(NeedQualifier, UsedFileTimestamp, - VersionNumbers, ItemType, SymName, Arity, NeedsCheck) --> + VersionNumbers, ItemType, SymName, Arity, NeedsCheck, !Info) :- ( - { item_is_new_or_changed(UsedFileTimestamp, VersionNumbers, - ItemType, SymName, Arity) } + item_is_new_or_changed(UsedFileTimestamp, VersionNumbers, + ItemType, SymName, Arity) -> - { NeedsCheck = yes }, - UsedItems =^ used_items, - { UsedItemMap = extract_simple_item_set(UsedItems, ItemType) }, - { unqualify_name(SymName, Name) }, + NeedsCheck = yes, + UsedItems = !.Info ^ used_items, + UsedItemMap = extract_simple_item_set(UsedItems, ItemType), + unqualify_name(SymName, Name), ( - { map__search(UsedItemMap, Name - Arity, - MatchingQualifiers) } + map__search(UsedItemMap, Name - Arity, + MatchingQualifiers) -> map__foldl( - check_for_simple_item_ambiguity_2( - ItemType, NeedQualifier, - SymName, Arity), - MatchingQualifiers) + check_for_simple_item_ambiguity_2(ItemType, + NeedQualifier, SymName, Arity), + MatchingQualifiers, !Info) ; - [] + true ) ; - { NeedsCheck = no } + NeedsCheck = no ). :- pred check_for_simple_item_ambiguity_2(item_type::in, need_qualifier::in, @@ -983,29 +997,28 @@ check_for_simple_item_ambiguity(NeedQualifier, UsedFileTimestamp, recompilation_check_info::in, recompilation_check_info::out) is det. check_for_simple_item_ambiguity_2(ItemType, NeedQualifier, - SymName, Arity, OldModuleQualifier, OldMatchingModuleName) --> - { unqualify_name(SymName, Name) }, + SymName, Arity, OldModuleQualifier, OldMatchingModuleName, + !Info) :- + unqualify_name(SymName, Name), ( % XXX This is a bit conservative in the % case of partially qualified names but that % hopefully won't come up too often. - { NeedQualifier = must_be_qualified }, - { OldModuleQualifier = unqualified("") } + NeedQualifier = must_be_qualified, + OldModuleQualifier = unqualified("") -> - [] + true ; - { QualifiedName = module_qualify_name(OldModuleQualifier, - Name) }, - { match_sym_name(QualifiedName, SymName) }, - \+ { SymName = qualified(OldMatchingModuleName, _) } + QualifiedName = module_qualify_name(OldModuleQualifier, Name), + match_sym_name(QualifiedName, SymName), + \+ SymName = qualified(OldMatchingModuleName, _) -> - { OldMatchingName = qualified(OldMatchingModuleName, Name) }, - { Reason = item_ambiguity(item_id(ItemType, SymName - Arity), - [item_id(ItemType, OldMatchingName - Arity)] - ) }, - record_recompilation_reason(Reason) + OldMatchingName = qualified(OldMatchingModuleName, Name), + Reason = item_ambiguity(item_id(ItemType, SymName - Arity), + [item_id(ItemType, OldMatchingName - Arity)]), + record_recompilation_reason(Reason, !Info) ; - [] + true ). :- pred check_for_pred_or_func_item_ambiguity(bool::in, need_qualifier::in, @@ -1014,111 +1027,115 @@ check_for_simple_item_ambiguity_2(ItemType, NeedQualifier, recompilation_check_info::in, recompilation_check_info::out) is det. check_for_pred_or_func_item_ambiguity(NeedsCheck, NeedQualifier, OldTimestamp, - VersionNumbers, PredOrFunc, SymName, Args, WithType) --> - { + VersionNumbers, PredOrFunc, SymName, Args, WithType, !Info) :- + ( WithType = no, adjust_func_arity(PredOrFunc, Arity, list__length(Args)) ; WithType = yes(_), Arity = list__length(Args) - }, - { ItemType = pred_or_func_to_item_type(PredOrFunc) }, + ), + ItemType = pred_or_func_to_item_type(PredOrFunc), ( - { NeedsCheck = yes + ( NeedsCheck = yes ; item_is_new_or_changed(OldTimestamp, VersionNumbers, - ItemType, SymName, Arity) - } + ItemType, SymName, Arity) + ) -> - UsedItems =^ used_items, - { UsedItemMap = extract_pred_or_func_set(UsedItems, - ItemType) }, - { unqualify_name(SymName, Name) }, - ( { map__search(UsedItemMap, Name, MatchingArityList) } -> - list__foldl( - (pred((MatchArity - MatchingQualifiers)::in, - in, out) is det --> - ( - { - WithType = yes(_), - MatchArity >= Arity - ; - WithType = no, - MatchArity = Arity - } - -> - map__foldl( - check_for_pred_or_func_item_ambiguity_2( - ItemType, NeedQualifier, - SymName, MatchArity), - MatchingQualifiers) - ; - [] - ) - ), MatchingArityList) + UsedItems = !.Info ^ used_items, + UsedItemMap = extract_pred_or_func_set(UsedItems, ItemType), + unqualify_name(SymName, Name), + ( map__search(UsedItemMap, Name, MatchingArityList) -> + list__foldl(check_for_pred_or_func_item_ambiguity_1( + WithType, ItemType, NeedQualifier, SymName, + Arity), + MatchingArityList, !Info) ; - [] + true ), - { PredId = invalid_pred_id }, - ( { SymName = qualified(ModuleName, _) } -> - { + PredId = invalid_pred_id, + ( SymName = qualified(ModuleName, _) -> + ( WithType = yes(_), % We don't know the actual arity. AritiesToMatch = any ; WithType = no, AritiesToMatch = less_than_or_equal(Arity) - }, - check_functor_ambiguities(NeedQualifier, - SymName, AritiesToMatch, - pred_or_func(PredId, ModuleName, - PredOrFunc, Arity)) + ), + check_functor_ambiguities(NeedQualifier, SymName, + AritiesToMatch, pred_or_func(PredId, + ModuleName, PredOrFunc, Arity), !Info) ; - { error( - "check_for_pred_or_func_item_ambiguity: unqualified predicate name") } + error("check_for_pred_or_func_item_ambiguity: " ++ + "unqualified predicate name") ) ; - [] + true + ). + +:- pred check_for_pred_or_func_item_ambiguity_1(maybe(type)::in, item_type::in, + need_qualifier::in, sym_name::in, arity::in, + pair(arity, map(sym_name, set(pair(pred_id, module_name))))::in, + recompilation_check_info::in, recompilation_check_info::out) is det. + +check_for_pred_or_func_item_ambiguity_1(WithType, ItemType, NeedQualifier, + SymName, Arity, MatchArity - MatchingQualifiers, !Info) :- + ( + ( + WithType = yes(_), + MatchArity >= Arity + ; + WithType = no, + MatchArity = Arity + ) + -> + map__foldl(check_for_pred_or_func_item_ambiguity_2( + ItemType, NeedQualifier, SymName, MatchArity), + MatchingQualifiers, !Info) + ; + true ). :- pred check_for_pred_or_func_item_ambiguity_2(item_type::in, need_qualifier::in, sym_name::in, arity::in, module_qualifier::in, - set(pair(pred_id, module_name))::in, recompilation_check_info::in, - recompilation_check_info::out) is det. + set(pair(pred_id, module_name))::in, + recompilation_check_info::in, recompilation_check_info::out) is det. check_for_pred_or_func_item_ambiguity_2(ItemType, NeedQualifier, - SymName, Arity, OldModuleQualifier, OldMatchingModuleNames) --> - { unqualify_name(SymName, Name) }, + SymName, Arity, OldModuleQualifier, OldMatchingModuleNames, + !Info) :- + unqualify_name(SymName, Name), ( % XXX This is a bit conservative in the % case of partially qualified names but that % hopefully won't come up too often. - { NeedQualifier = must_be_qualified }, - { OldModuleQualifier = unqualified("") } + NeedQualifier = must_be_qualified, + OldModuleQualifier = unqualified("") -> - [] + true ; - { QualifiedName = module_qualify_name(OldModuleQualifier, - Name) }, - { match_sym_name(QualifiedName, SymName) }, - \+ { + QualifiedName = module_qualify_name(OldModuleQualifier, Name), + match_sym_name(QualifiedName, SymName), + \+ ( SymName = qualified(PredModuleName, _), - set__member(_ - PredModuleName, - OldMatchingModuleNames) - } + set__member(_ - PredModuleName, OldMatchingModuleNames) + ) -> - { AmbiguousDecls = list__map( - (func(_ - OldMatchingModule) = Item :- - OldMatchingName = qualified(OldMatchingModule, Name), - Item = item_id(ItemType, OldMatchingName - Arity) - ), - set__to_sorted_list(OldMatchingModuleNames)) }, - { Reason = item_ambiguity(item_id(ItemType, SymName - Arity), - AmbiguousDecls - ) }, - record_recompilation_reason(Reason) + AmbiguousDecls = list__map( + (func(_ - OldMatchingModule) = Item :- + OldMatchingName = qualified(OldMatchingModule, + Name), + Item = item_id(ItemType, + OldMatchingName - Arity) + ), + set__to_sorted_list(OldMatchingModuleNames)), + Reason = item_ambiguity(item_id(ItemType, SymName - Arity), + AmbiguousDecls), + record_recompilation_reason(Reason, !Info) ; - [] + true ). % @@ -1127,49 +1144,48 @@ check_for_pred_or_func_item_ambiguity_2(ItemType, NeedQualifier, % with functors used during the last compilation. % :- pred check_type_defn_ambiguity_with_functor(need_qualifier::in, - type_ctor::in, type_defn::in, recompilation_check_info::in, - recompilation_check_info::out) is det. + type_ctor::in, type_defn::in, + recompilation_check_info::in, recompilation_check_info::out) is det. -check_type_defn_ambiguity_with_functor(_, _, abstract_type(_)) --> []. -check_type_defn_ambiguity_with_functor(_, _, eqv_type(_)) --> []. -check_type_defn_ambiguity_with_functor(NeedQualifier, - TypeCtor, du_type(Ctors, _)) --> - list__foldl(check_functor_ambiguities(NeedQualifier, TypeCtor), - Ctors). -check_type_defn_ambiguity_with_functor(_, _, foreign_type(_, _, _)) --> []. -check_type_defn_ambiguity_with_functor(_, _, solver_type(_, _)) --> []. +check_type_defn_ambiguity_with_functor(_, _, abstract_type(_), !Info). +check_type_defn_ambiguity_with_functor(_, _, eqv_type(_), !Info). +check_type_defn_ambiguity_with_functor(NeedQualifier, TypeCtor, + du_type(Ctors, _), !Info) :- + list__foldl(check_functor_ambiguities(NeedQualifier, TypeCtor), Ctors, + !Info). +check_type_defn_ambiguity_with_functor(_, _, foreign_type(_, _, _), !Info). +check_type_defn_ambiguity_with_functor(_, _, solver_type(_, _), !Info). :- pred check_functor_ambiguities(need_qualifier::in, type_ctor::in, - constructor::in, recompilation_check_info::in, - recompilation_check_info::out) is det. + constructor::in, + recompilation_check_info::in, recompilation_check_info::out) is det. check_functor_ambiguities(NeedQualifier, TypeCtor, - ctor(_, _, Name, Args)) --> - { ResolvedCtor = constructor(TypeCtor) }, - { Arity = list__length(Args) }, + ctor(_, _, Name, Args), !Info) :- + ResolvedCtor = constructor(TypeCtor), + Arity = list__length(Args), check_functor_ambiguities(NeedQualifier, Name, exact(Arity), - ResolvedCtor), - list__foldl( - check_field_ambiguities(NeedQualifier, - field(TypeCtor, Name - Arity)), - Args). + ResolvedCtor, !Info), + list__foldl(check_field_ambiguities(NeedQualifier, + field(TypeCtor, Name - Arity)), Args, !Info). :- pred check_field_ambiguities(need_qualifier::in, resolved_functor::in, - constructor_arg::in, recompilation_check_info::in, - recompilation_check_info::out) is det. + constructor_arg::in, + recompilation_check_info::in, recompilation_check_info::out) is det. -check_field_ambiguities(_, _, no - _) --> []. -check_field_ambiguities(NeedQualifier, ResolvedCtor, yes(FieldName) - _) --> +check_field_ambiguities(_, _, no - _, !Info). +check_field_ambiguities(NeedQualifier, ResolvedCtor, yes(FieldName) - _, + !Info) :- % % XXX The arities to match below will need to change if we ever % allow taking the address of field access functions. % - { field_access_function_name(get, FieldName, ExtractFuncName) }, + field_access_function_name(get, FieldName, ExtractFuncName), check_functor_ambiguities(NeedQualifier, ExtractFuncName, - exact(1), ResolvedCtor), - { field_access_function_name(set, FieldName, UpdateFuncName) }, + exact(1), ResolvedCtor, !Info), + field_access_function_name(set, FieldName, UpdateFuncName), check_functor_ambiguities(NeedQualifier, UpdateFuncName, - exact(2), ResolvedCtor). + exact(2), ResolvedCtor, !Info). % % Predicates and functions used as functors can match @@ -1179,22 +1195,22 @@ check_field_ambiguities(NeedQualifier, ResolvedCtor, yes(FieldName) - _) --> :- type functor_match_arity ---> exact(arity) ; less_than_or_equal(arity) - ; any - . + ; any. :- pred check_functor_ambiguities(need_qualifier::in, sym_name::in, functor_match_arity::in, resolved_functor::in, recompilation_check_info::in, recompilation_check_info::out) is det. -check_functor_ambiguities(NeedQualifier, Name, MatchArity, ResolvedCtor) --> - UsedItems =^ used_items, - { unqualify_name(Name, UnqualName) }, - { UsedCtors = UsedItems ^ functors }, - ( { map__search(UsedCtors, UnqualName, UsedCtorAL) } -> +check_functor_ambiguities(NeedQualifier, Name, MatchArity, ResolvedCtor, + !Info) :- + UsedItems = !.Info ^ used_items, + unqualify_name(Name, UnqualName), + UsedCtors = UsedItems ^ functors, + ( map__search(UsedCtors, UnqualName, UsedCtorAL) -> check_functor_ambiguities_2(NeedQualifier, Name, MatchArity, - ResolvedCtor, UsedCtorAL) + ResolvedCtor, UsedCtorAL, !Info) ; - [] + true ). :- pred check_functor_ambiguities_2(need_qualifier::in, sym_name::in, @@ -1202,12 +1218,12 @@ check_functor_ambiguities(NeedQualifier, Name, MatchArity, ResolvedCtor) --> assoc_list(arity, resolved_functor_map)::in, recompilation_check_info::in, recompilation_check_info::out) is det. -check_functor_ambiguities_2(_, _, _, _, []) --> []. +check_functor_ambiguities_2(_, _, _, _, [], !Info). check_functor_ambiguities_2(NeedQualifier, Name, MatchArity, - ResolvedCtor, [Arity - UsedCtorMap | UsedCtorAL]) --> + ResolvedCtor, [Arity - UsedCtorMap | UsedCtorAL], !Info) :- ( - { MatchArity = exact(ArityToMatch) }, - { ArityToMatch = Arity -> + MatchArity = exact(ArityToMatch), + ( ArityToMatch = Arity -> Check = bool__yes, Continue = bool__no ; @@ -1217,34 +1233,34 @@ check_functor_ambiguities_2(NeedQualifier, Name, MatchArity, ; Continue = no ) - } + ) ; - { MatchArity = less_than_or_equal(ArityToMatch) }, - { Arity =< ArityToMatch -> + MatchArity = less_than_or_equal(ArityToMatch), + ( Arity =< ArityToMatch -> Check = yes, Continue = yes ; Check = no, Continue = no - } + ) ; - { MatchArity = any }, - { Check = yes }, - { Continue = yes } + MatchArity = any, + Check = yes, + Continue = yes ), - ( { Check = yes } -> - map__foldl( - check_functor_ambiguity(NeedQualifier, - Name, Arity, ResolvedCtor), - UsedCtorMap) + ( + Check = yes, + map__foldl(check_functor_ambiguity(NeedQualifier, Name, Arity, + ResolvedCtor), UsedCtorMap, !Info) ; - [] + Check = no ), - ( { Continue = yes } -> + ( + Continue = yes, check_functor_ambiguities_2(NeedQualifier, Name, MatchArity, - ResolvedCtor, UsedCtorAL) + ResolvedCtor, UsedCtorAL, !Info) ; - [] + Continue = no ). :- pred check_functor_ambiguity(need_qualifier::in, @@ -1253,46 +1269,46 @@ check_functor_ambiguities_2(NeedQualifier, Name, MatchArity, recompilation_check_info::in, recompilation_check_info::out) is det. check_functor_ambiguity(NeedQualifier, SymName, Arity, ResolvedCtor, - OldModuleQualifier, OldResolvedCtors) --> + OldModuleQualifier, OldResolvedCtors, !Info) :- ( % XXX This is a bit conservative in the % case of partially qualified names but that % hopefully won't come up too often. - { NeedQualifier = must_be_qualified }, - { OldModuleQualifier = unqualified("") } + NeedQualifier = must_be_qualified, + OldModuleQualifier = unqualified("") -> - [] + true ; - { unqualify_name(SymName, Name) }, - { OldName = module_qualify_name(OldModuleQualifier, Name) }, - { match_sym_name(OldName, SymName) }, - \+ { set__member(ResolvedCtor, OldResolvedCtors) } + unqualify_name(SymName, Name), + OldName = module_qualify_name(OldModuleQualifier, Name), + match_sym_name(OldName, SymName), + \+ set__member(ResolvedCtor, OldResolvedCtors) -> - { Reason = functor_ambiguity( - module_qualify_name(OldModuleQualifier, Name), - Arity, - ResolvedCtor, - set__to_sorted_list(OldResolvedCtors) - ) }, - record_recompilation_reason(Reason) + Reason = functor_ambiguity( + module_qualify_name(OldModuleQualifier, Name), + Arity, + ResolvedCtor, + set__to_sorted_list(OldResolvedCtors) + ), + record_recompilation_reason(Reason, !Info) ; - [] + true ). %-----------------------------------------------------------------------------% :- type recompilation_check_info - ---> recompilation_check_info( - module_name :: module_name, - is_inline_sub_module :: bool, - sub_modules :: list(module_name), - read_modules :: read_modules, - used_items :: resolved_used_items, - used_typeclasses :: set(item_name), - modules_to_recompile :: modules_to_recompile, - collect_all_reasons :: bool, - recompilation_reasons :: list(recompile_reason) - ). + ---> recompilation_check_info( + module_name :: module_name, + is_inline_sub_module :: bool, + sub_modules :: list(module_name), + read_modules :: read_modules, + used_items :: resolved_used_items, + used_typeclasses :: set(item_name), + modules_to_recompile :: modules_to_recompile, + collect_all_reasons :: bool, + recompilation_reasons :: list(recompile_reason) + ). :- type recompile_exception ---> recompile_exception( @@ -1328,8 +1344,7 @@ check_functor_ambiguity(NeedQualifier, SymName, Arity, ResolvedCtor, sym_name, arity, resolved_functor, % new item. - list(resolved_functor) - % ambiguous declarations. + list(resolved_functor) % ambiguous declarations. ) ; changed_item( @@ -1348,62 +1363,60 @@ check_functor_ambiguity(NeedQualifier, SymName, Arity, ResolvedCtor, ; removed_instance( module_name, item_name % class name - ) - . + ). :- pred add_module_to_recompile(module_name::in, recompilation_check_info::in, - recompilation_check_info::out) is det. + recompilation_check_info::out) is det. -add_module_to_recompile(Module, Info0, Info) :- - ModulesToRecompile0 = Info0 ^ modules_to_recompile, +add_module_to_recompile(Module, !Info) :- + ModulesToRecompile0 = !.Info ^ modules_to_recompile, ( - ModulesToRecompile0 = (all), - Info = Info0 + ModulesToRecompile0 = (all) ; ModulesToRecompile0 = some(Modules0), - Info = Info0 ^ modules_to_recompile := - some([Module | Modules0]) + !:Info = !.Info ^ modules_to_recompile := + some([Module | Modules0]) ). :- pred record_read_file(module_name::in, module_timestamp::in, item_list::in, - module_error::in, file_name::in, recompilation_check_info::in, - recompilation_check_info::out) is det. + module_error::in, file_name::in, + recompilation_check_info::in, recompilation_check_info::out) is det. -record_read_file(ModuleName, ModuleTimestamp, Items, Error, FileName) --> - Imports0 =^ read_modules, - { map__set(Imports0, ModuleName - ModuleTimestamp ^ suffix, - read_module(ModuleTimestamp, Items, Error, FileName), - Imports) }, - ^ read_modules := Imports. +record_read_file(ModuleName, ModuleTimestamp, Items, Error, FileName, !Info) :- + Imports0 = !.Info ^ read_modules, + map__set(Imports0, ModuleName - ModuleTimestamp ^ suffix, + read_module(ModuleTimestamp, Items, Error, FileName), Imports), + !:Info = !.Info ^ read_modules := Imports. %-----------------------------------------------------------------------------% -:- pred write_recompilation_message(pred(io__state, io__state), - io__state, io__state). -:- mode write_recompilation_message(pred(di, uo) is det, di, uo) is det. +:- pred write_recompilation_message(pred(io, io)::in(pred(di, uo) is det), + io::di, io::uo) is det. -write_recompilation_message(P) --> - globals__io_lookup_bool_option(verbose_recompilation, Verbose), - ( { Verbose = yes } -> - P +write_recompilation_message(P, !IO) :- + globals__io_lookup_bool_option(verbose_recompilation, Verbose, !IO), + ( + Verbose = yes, + P(!IO) ; - [] + Verbose = no ). :- pred write_recompile_reason(module_name::in, recompile_reason::in, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. -write_recompile_reason(ModuleName, Reason) --> - { recompile_reason_message(Reason, MaybeContext, ErrorPieces0) }, - { ErrorPieces = +write_recompile_reason(ModuleName, Reason, !IO) :- + recompile_reason_message(Reason, MaybeContext, ErrorPieces0), + ErrorPieces = [words("Recompiling module"), words(string__append(describe_sym_name(ModuleName), ":")), nl - | ErrorPieces0] }, - write_error_pieces_maybe_with_context(MaybeContext, 0, ErrorPieces). + | ErrorPieces0], + write_error_pieces_maybe_with_context(MaybeContext, 0, ErrorPieces, + !IO). :- pred recompile_reason_message(recompile_reason::in, maybe(context)::out, - list(format_component)::out) is det. + list(format_component)::out) is det. recompile_reason_message(file_error(_FileName, Msg), no, [words(Msg)]). recompile_reason_message(output_file_not_up_to_date(FileName), no, @@ -1424,7 +1437,7 @@ recompile_reason_message(item_ambiguity(Item, AmbiguousItems), no, Pieces) :- AmbiguousItemPieces]), '.'). recompile_reason_message(functor_ambiguity(SymName, Arity, - Functor, AmbiguousFunctors), no, Pieces) :- + Functor, AmbiguousFunctors), no, Pieces) :- FunctorPieces = describe_functor(SymName, Arity, Functor), AmbiguousFunctorPieces = component_lists_to_pieces( list__map(describe_functor(SymName, Arity), @@ -1480,7 +1493,7 @@ describe_item(item_id(ItemType0, SymName - Arity)) = Pieces :- body_item(type_body, (type)). :- func describe_functor(sym_name, arity, resolved_functor) = - list(format_component). + list(format_component). describe_functor(SymName, _Arity, pred_or_func(_, ModuleName, PredOrFunc, PredArity)) = @@ -1509,27 +1522,25 @@ describe_functor(SymName, Arity, %-----------------------------------------------------------------------------% :- pred read_term_check_for_error_or_eof(recompilation_check_info::in, - string::in, term::out, io__state::di, io__state::uo) is det. + string::in, term::out, io::di, io::uo) is det. -read_term_check_for_error_or_eof(Info, Item, Term) --> - parser__read_term(TermResult), +read_term_check_for_error_or_eof(Info, Item, Term, !IO) :- + parser__read_term(TermResult, !IO), ( - { TermResult = term(_, Term) } + TermResult = term(_, Term) ; - { TermResult = error(Message, Line) }, - io__input_stream_name(FileName), - { Reason = syntax_error(term__context(FileName, Line), - Message) }, - { throw_syntax_error(Reason, Info) } + TermResult = error(Message, Line), + io__input_stream_name(FileName, !IO), + Reason = syntax_error(term__context(FileName, Line), + Message), + throw_syntax_error(Reason, Info) ; - { TermResult = eof }, - io__input_stream_name(FileName), - io__get_line_number(Line), - { Reason = syntax_error(term__context(FileName, Line), - string__append_list( - ["unexpected end of file, expected ", - Item, "."])) }, - { throw_syntax_error(Reason, Info) } + TermResult = eof, + io__input_stream_name(FileName, !IO), + io__get_line_number(Line, !IO), + Reason = syntax_error(term__context(FileName, Line), + "unexpected end of file, expected " ++ Item ++ "."), + throw_syntax_error(Reason, Info) ). :- func get_term_context(term) = term__context. @@ -1544,12 +1555,12 @@ get_term_context(Term) = :- pred record_recompilation_reason(recompile_reason::in, recompilation_check_info::in, recompilation_check_info::out) is det. -record_recompilation_reason(Reason, Info0, Info) :- - ( Info0 ^ collect_all_reasons = yes -> - Info = Info0 ^ recompilation_reasons := - [Reason | Info0 ^ recompilation_reasons] +record_recompilation_reason(Reason, !Info) :- + ( !.Info ^ collect_all_reasons = yes -> + !:Info = !.Info ^ recompilation_reasons := + [Reason | !.Info ^ recompilation_reasons] ; - throw(recompile_exception(Reason, Info0)) + throw(recompile_exception(Reason, !.Info)) ). :- pred throw_syntax_error(recompile_reason::in, diff --git a/compiler/recompilation.m b/compiler/recompilation.m index ab01af31f..7a88f748f 100644 --- a/compiler/recompilation.m +++ b/compiler/recompilation.m @@ -42,8 +42,7 @@ % This could be done using a timestamp or a hash value. :- type version_number == timestamp. -:- pred write_version_number(version_number::in, - io__state::di, io__state::uo) is det. +:- pred write_version_number(version_number::in, io::di, io::uo) is det. :- func term_to_version_number(term(T)) = version_number is semidet. @@ -70,54 +69,50 @@ ; (typeclass) ; functor % The RHS of a var-functor unification. ; predicate - ; function - . + ; function. :- inst simple_item ---> (type) ; type_body ; (mode) ; (inst) - ; (typeclass) - . + ; (typeclass). :- inst pred_or_func ---> predicate - ; function - . + ; function. -:- pred is_simple_item_type( - item_type::(ground->simple_item)) is semidet. +:- pred is_simple_item_type(item_type::(ground->simple_item)) is semidet. -:- pred is_pred_or_func_item_type( - item_type::(ground->pred_or_func)) is semidet. +:- pred is_pred_or_func_item_type(item_type::(ground->pred_or_func)) is semidet. :- pred string_to_item_type(string, item_type). :- mode string_to_item_type(in, out) is semidet. :- mode string_to_item_type(out, in) is det. :- func pred_or_func_to_item_type(pred_or_func::in) - = (item_type::out(pred_or_func)) is det. + = (item_type::out(pred_or_func)) is det. %-----------------------------------------------------------------------------% :- type recompilation_info - ---> recompilation_info( - % name of the current module - module_name :: module_name, + ---> recompilation_info( + % name of the current module + module_name :: module_name, - % used items imported from other modules - used_items :: used_items, + % used items imported from other modules + used_items :: used_items, - % For now we only record dependencies of imported - % items on equivalence types. The rest of the - % dependencies can be found be examining the - % pred_infos, type_defns etc. of the items - % recorded in the used_items field above. - dependencies :: map(item_id, set(item_id)), + % For now we only record dependencies of + % imported items on equivalence types. + % The rest of the dependencies can be found + % by examining the pred_infos, type_defns etc. + % of the items recorded in the used_items + % field above. + dependencies :: map(item_id, set(item_id)), - version_numbers :: map(module_name, version_numbers) - ). + version_numbers :: map(module_name, version_numbers) + ). :- func init_recompilation_info(module_name) = recompilation_info. @@ -146,16 +141,16 @@ %-----------------------------------------------------------------------------% :- type item_id_set(Map, Set, Cons) - ---> item_id_set( - types :: Map, - type_bodies :: Map, - modes :: Map, - insts :: Map, - typeclasses :: Map, - functors :: Cons, - predicates :: Set, - functions :: Set - ). + ---> item_id_set( + types :: Map, + type_bodies :: Map, + modes :: Map, + insts :: Map, + typeclasses :: Map, + functors :: Cons, + predicates :: Set, + functions :: Set + ). :- type item_id_set(T) == item_id_set(T, T, T). @@ -166,8 +161,8 @@ %-----------------------------------------------------------------------------% % An simple_item_set records the single possible match for an item. -:- type simple_item_set == map(pair(string, arity), - map(module_qualifier, module_name)). +:- type simple_item_set == + map(pair(string, arity), map(module_qualifier, module_name)). % For constructors, predicates and functions we can't work out % which item is actually used until we've run typechecking. @@ -193,34 +188,33 @@ % :- func extract_simple_item_set(item_id_set(Simple, PorF, Cons)::in, - item_type::in(simple_item)) = (Simple::out) is det. + item_type::in(simple_item)) = (Simple::out) is det. :- func update_simple_item_set(item_id_set(Simple, PorF, Cons)::in, - item_type::in(simple_item), Simple::in) - = (item_id_set(Simple, PorF, Cons)::out) is det. + item_type::in(simple_item), Simple::in) + = (item_id_set(Simple, PorF, Cons)::out) is det. :- func extract_pred_or_func_set(item_id_set(Simple, PorF, Cons)::in, - item_type::in(pred_or_func)) = (PorF::out) is det. + item_type::in(pred_or_func)) = (PorF::out) is det. :- func update_pred_or_func_set(item_id_set(Simple, PorF, Cons)::in, - item_type::in(pred_or_func), PorF::in) - = (item_id_set(Simple, PorF, Cons)::out) is det. + item_type::in(pred_or_func), PorF::in) + = (item_id_set(Simple, PorF, Cons)::out) is det. :- func extract_ids(item_id_set(T), item_type) = T. :- func update_ids(item_id_set(T), item_type, T) = item_id_set(T). -:- func map_ids((func(item_type, T) = U), - item_id_set(T), U) = item_id_set(U). +:- func map_ids((func(item_type, T) = U), item_id_set(T), U) = item_id_set(U). %-----------------------------------------------------------------------------% % Version numbers for items in a single module. :- type version_numbers - ---> version_numbers( - item_version_numbers, - instance_version_numbers - ). + ---> version_numbers( + item_version_numbers, + instance_version_numbers + ). % The constructors set should always be empty - % constructors are never imported separately. @@ -258,12 +252,12 @@ term_to_version_number(Term) = term_to_timestamp(Term). term_to_timestamp(term__functor(term__string(TimestampString), [], _)) = - string_to_timestamp(TimestampString). + string_to_timestamp(TimestampString). -write_version_number(VersionNumber) --> - io__write_string(""""), - io__write_string(timestamp_to_string(VersionNumber)), - io__write_string(""""). +write_version_number(VersionNumber, !IO) :- + io__write_string("""", !IO), + io__write_string(timestamp_to_string(VersionNumber), !IO), + io__write_string("""", !IO). %-----------------------------------------------------------------------------% @@ -291,14 +285,13 @@ string_to_item_type("functor", functor). %-----------------------------------------------------------------------------% init_item_id_set(Init) = - item_id_set(Init, Init, Init, Init, Init, Init, Init, Init). + item_id_set(Init, Init, Init, Init, Init, Init, Init, Init). init_item_id_set(Simple, PorF, Cons) = - item_id_set(Simple, Simple, Simple, Simple, Simple, - Cons, PorF, PorF). + item_id_set(Simple, Simple, Simple, Simple, Simple, Cons, PorF, PorF). init_used_items = item_id_set(map__init, map__init, map__init, map__init, - map__init, map__init, map__init, map__init). + map__init, map__init, map__init, map__init). extract_simple_item_set(Items, type) = Items ^ types. extract_simple_item_set(Items, type_body) = Items ^ type_bodies. @@ -369,48 +362,48 @@ init_recompilation_info(ModuleName) = map__init ). -recompilation__record_used_item(ItemType, Id, QualifiedId) --> - ( - % Don't record builtin items (QualifiedId may be unqualified - % for predicates, functions and functors because they aren't - % qualified until after typechecking). - { ItemType \= predicate }, - { ItemType \= function }, - { ItemType \= functor }, - { QualifiedId = unqualified(_) - _ } - -> - [] - ; - ItemSet0 =^ used_items, - { IdSet0 = extract_ids(ItemSet0, ItemType) }, - { QualifiedId = QualifiedName - Arity }, - { unqualify_name(QualifiedName, UnqualifiedName) }, - { ModuleName = find_module_qualifier(QualifiedName) }, - { UnqualifiedId = UnqualifiedName - Arity }, - { Id = SymName - _ }, - { ModuleQualifier = find_module_qualifier(SymName) }, - ( { map__search(IdSet0, UnqualifiedId, MatchingNames0) } -> - { MatchingNames1 = MatchingNames0 } +recompilation__record_used_item(ItemType, Id, QualifiedId, !Info) :- + ( + % Don't record builtin items (QualifiedId may be unqualified + % for predicates, functions and functors because they aren't + % qualified until after typechecking). + ItemType \= predicate, + ItemType \= function, + ItemType \= functor, + QualifiedId = unqualified(_) - _ + -> + true ; - { map__init(MatchingNames1) } - ), - ( { map__contains(MatchingNames1, ModuleQualifier) } -> - [] - ; - { map__det_insert(MatchingNames1, ModuleQualifier, - ModuleName, MatchingNames) }, - { map__set(IdSet0, UnqualifiedId, - MatchingNames, IdSet) }, - { ItemSet = update_ids(ItemSet0, ItemType, IdSet) }, - ^ used_items := ItemSet - ) - ). + ItemSet0 = !.Info ^ used_items, + IdSet0 = extract_ids(ItemSet0, ItemType), + QualifiedId = QualifiedName - Arity, + unqualify_name(QualifiedName, UnqualifiedName), + ModuleName = find_module_qualifier(QualifiedName), + UnqualifiedId = UnqualifiedName - Arity, + Id = SymName - _, + ModuleQualifier = find_module_qualifier(SymName), + ( map__search(IdSet0, UnqualifiedId, MatchingNames0) -> + MatchingNames1 = MatchingNames0 + ; + map__init(MatchingNames1) + ), + ( map__contains(MatchingNames1, ModuleQualifier) -> + true + ; + map__det_insert(MatchingNames1, ModuleQualifier, + ModuleName, MatchingNames), + map__set(IdSet0, UnqualifiedId, + MatchingNames, IdSet), + ItemSet = update_ids(ItemSet0, ItemType, IdSet), + !:Info = !.Info ^ used_items := ItemSet + ) + ). -recompilation__record_expanded_items(Item, ExpandedItems, Info0, Info) :- +recompilation__record_expanded_items(Item, ExpandedItems, !Info) :- ( set__empty(ExpandedItems) -> - Info = Info0 + true ; - DepsMap0 = Info0 ^ dependencies, + DepsMap0 = !.Info ^ dependencies, ( map__search(DepsMap0, Item, Deps0) -> Deps1 = Deps0 ; @@ -418,7 +411,7 @@ recompilation__record_expanded_items(Item, ExpandedItems, Info0, Info) :- ), set__union(Deps1, ExpandedItems, Deps), map__set(DepsMap0, Item, Deps, DepsMap), - Info = Info0 ^ dependencies := DepsMap + !:Info = !.Info ^ dependencies := DepsMap ). %-----------------------------------------------------------------------------% diff --git a/compiler/recompilation.usage.m b/compiler/recompilation.usage.m index c27dfd7a8..6b07446fa 100644 --- a/compiler/recompilation.usage.m +++ b/compiler/recompilation.usage.m @@ -26,13 +26,13 @@ % an item which was used during a compilation. % :- type resolved_used_items == - item_id_set(simple_item_set, resolved_pred_or_func_set, - resolved_functor_set). + item_id_set(simple_item_set, resolved_pred_or_func_set, + resolved_functor_set). :- type resolved_pred_or_func_set == - resolved_item_set(set(pair(pred_id, module_name))). + resolved_item_set(set(pair(pred_id, module_name))). :- type resolved_pred_or_func_map == - resolved_item_map(set(pair(pred_id, module_name))). + resolved_item_map(set(pair(pred_id, module_name))). % A resolved_functor_set records all possible matches % for each functor application. @@ -64,12 +64,11 @@ ; field( item_name, % type_ctor item_name % cons_id - ) - . + ). :- pred recompilation__usage__write_usage_file(module_info::in, - list(module_name)::in, maybe(module_timestamps)::in, - io__state::di, io__state::uo) is det. + list(module_name)::in, maybe(module_timestamps)::in, + io::di, io::uo) is det. % Changes which modify the format of the `.used' files will % increment this number. recompilation_check.m should recompile @@ -77,6 +76,7 @@ :- func usage_file_version_number = int. %-----------------------------------------------------------------------------% + :- implementation. :- import_module check_hlds__type_util. @@ -93,360 +93,390 @@ :- import_module parse_tree__prog_out. :- import_module recompilation__version. -:- import_module assoc_list, bool, int, require. +:- import_module assoc_list, bool, int, require, svmap. :- import_module queue, std_util, string. recompilation__usage__write_usage_file(ModuleInfo, NestedSubModules, - MaybeTimestamps) --> - { module_info_get_maybe_recompilation_info(ModuleInfo, - MaybeRecompInfo) }, + MaybeTimestamps, !IO) :- + module_info_get_maybe_recompilation_info(ModuleInfo, + MaybeRecompInfo), ( - { MaybeRecompInfo = yes(RecompInfo) }, - { MaybeTimestamps = yes(Timestamps) } + MaybeRecompInfo = yes(RecompInfo), + MaybeTimestamps = yes(Timestamps) -> - globals__io_lookup_bool_option(verbose, Verbose), + globals__io_lookup_bool_option(verbose, Verbose, !IO), maybe_write_string(Verbose, "% Writing recompilation compilation " ++ - "dependency information\n"), + "dependency information\n", !IO), - { module_info_name(ModuleInfo, ModuleName) }, - module_name_to_file_name(ModuleName, ".used", yes, FileName), - io__open_output(FileName, FileResult), + module_info_name(ModuleInfo, ModuleName), + module_name_to_file_name(ModuleName, ".used", yes, FileName, + !IO), + io__open_output(FileName, FileResult, !IO), ( - { FileResult = ok(Stream0) }, - io__set_output_stream(Stream0, OldStream), + FileResult = ok(Stream0), + io__set_output_stream(Stream0, OldStream, !IO), recompilation__usage__write_usage_file_2(ModuleInfo, - NestedSubModules, RecompInfo, Timestamps), - io__set_output_stream(OldStream, Stream), - io__close_output(Stream) + NestedSubModules, RecompInfo, Timestamps, !IO), + io__set_output_stream(OldStream, Stream, !IO), + io__close_output(Stream, !IO) ; - { FileResult = error(IOError) }, - { io__error_message(IOError, IOErrorMessage) }, - io__write_string("\nError opening `"), - io__write_string(FileName), - io__write_string("'for output: "), - io__write_string(IOErrorMessage), - io__write_string(".\n"), - io__set_exit_status(1) + FileResult = error(IOError), + io__error_message(IOError, IOErrorMessage), + io__write_string("\nError opening `", !IO), + io__write_string(FileName, !IO), + io__write_string("'for output: ", !IO), + io__write_string(IOErrorMessage, !IO), + io__write_string(".\n", !IO), + io__set_exit_status(1, !IO) ) ; - [] + true ). :- pred recompilation__usage__write_usage_file_2(module_info::in, - list(module_name)::in, recompilation_info::in, - module_timestamps::in, io__state::di, io__state::uo) is det. + list(module_name)::in, recompilation_info::in, + module_timestamps::in, io::di, io::uo) is det. recompilation__usage__write_usage_file_2(ModuleInfo, NestedSubModules, - RecompInfo, Timestamps) --> - io__write_int(usage_file_version_number), - io__write_string(","), - io__write_int(version_numbers_version_number), - io__write_string(".\n\n"), + RecompInfo, Timestamps, !IO) :- + io__write_int(usage_file_version_number, !IO), + io__write_string(",", !IO), + io__write_int(version_numbers_version_number, !IO), + io__write_string(".\n\n", !IO), - { module_info_name(ModuleInfo, ThisModuleName) }, - { map__lookup(Timestamps, ThisModuleName, - module_timestamp(_, ThisModuleTimestamp, _)) }, - io__write_string("("), - mercury_output_bracketed_sym_name(ThisModuleName), - io__write_string(", "".m"", "), - write_version_number(ThisModuleTimestamp), - io__write_string(").\n\n"), + module_info_name(ModuleInfo, ThisModuleName), + map__lookup(Timestamps, ThisModuleName, + module_timestamp(_, ThisModuleTimestamp, _)), + io__write_string("(", !IO), + mercury_output_bracketed_sym_name(ThisModuleName, !IO), + io__write_string(", "".m"", ", !IO), + write_version_number(ThisModuleTimestamp, !IO), + io__write_string(").\n\n", !IO), - ( { NestedSubModules = [] } -> - io__write_string("sub_modules.\n\n") + ( + NestedSubModules = [], + io__write_string("sub_modules.\n\n", !IO) ; - io__write_string("sub_modules("), + NestedSubModules = [_ | _], + io__write_string("sub_modules(", !IO), io__write_list(NestedSubModules, ", ", - mercury_output_bracketed_sym_name), - io__write_string(").\n\n") + mercury_output_bracketed_sym_name, !IO), + io__write_string(").\n\n", !IO) ), - { UsedItems = RecompInfo ^ used_items }, - { recompilation__usage__find_all_used_imported_items(ModuleInfo, + UsedItems = RecompInfo ^ used_items, + recompilation__usage__find_all_used_imported_items(ModuleInfo, UsedItems, RecompInfo ^ dependencies, ResolvedUsedItems, - UsedClasses, ImportedItems, ModuleInstances) }, + UsedClasses, ImportedItems, ModuleInstances), - ( { UsedItems = init_used_items } -> - io__write_string("used_items.\n") + ( UsedItems = init_used_items -> + io__write_string("used_items.\n", !IO) ; - io__write_string("used_items(\n\t"), - { WriteComma0 = no }, + io__write_string("used_items(\n\t", !IO), + WriteComma0 = no, write_simple_item_matches((type), ResolvedUsedItems, - WriteComma0, WriteComma1), + WriteComma0, WriteComma1, !IO), write_simple_item_matches(type_body, ResolvedUsedItems, - WriteComma1, WriteComma2), + WriteComma1, WriteComma2, !IO), write_simple_item_matches((mode), ResolvedUsedItems, - WriteComma2, WriteComma3), + WriteComma2, WriteComma3, !IO), write_simple_item_matches((inst), ResolvedUsedItems, - WriteComma3, WriteComma4), + WriteComma3, WriteComma4, !IO), write_simple_item_matches((typeclass), ResolvedUsedItems, - WriteComma4, WriteComma5), + WriteComma4, WriteComma5, !IO), write_pred_or_func_matches((predicate), ResolvedUsedItems, - WriteComma5, WriteComma6), + WriteComma5, WriteComma6, !IO), write_pred_or_func_matches((function), ResolvedUsedItems, - WriteComma6, WriteComma7), + WriteComma6, WriteComma7, !IO), write_functor_matches(ResolvedUsedItems ^ functors, - WriteComma7, _), - io__write_string("\n).\n\n") + WriteComma7, _, !IO), + io__write_string("\n).\n\n", !IO) ), - ( { set__empty(UsedClasses) } -> - io__write_string("used_classes.\n") + ( set__empty(UsedClasses) -> + io__write_string("used_classes.\n", !IO) ; - io__write_string("used_classes("), + io__write_string("used_classes(", !IO), io__write_list(set__to_sorted_list(UsedClasses), ", ", - (pred((ClassName - ClassArity)::in, di, uo) is det --> - mercury_output_bracketed_sym_name(ClassName), - io__write_string("/"), - io__write_int(ClassArity) - )), - io__write_string(").\n") + write_classname_and_arity, !IO), + io__write_string(").\n", !IO) ), - map__foldl( - (pred(ModuleName::in, ModuleUsedItems::in, di, uo) is det --> - io__nl, - io__write_string("("), - mercury_output_bracketed_sym_name(ModuleName), - io__write_string(", """), - { map__lookup(Timestamps, ModuleName, - module_timestamp(Suffix, ModuleTimestamp, - NeedQualifier)) }, - io__write_string(Suffix), - io__write_string(""", "), - write_version_number(ModuleTimestamp), - ( { NeedQualifier = must_be_qualified } -> - io__write_string(", used)") - ; - io__write_string(")") - ), - ( - % XXX We don't yet record all uses of items - % from these modules in polymorphism.m, etc. - \+ { any_mercury_builtin_module(ModuleName) }, - { map__search(RecompInfo ^ version_numbers, - ModuleName, ModuleVersions) } - -> - % - % Select out from the version numbers of all items - % in the imported module the ones which are used. - % - - { ModuleVersions = version_numbers(ModuleItemVersions, - ModuleInstanceVersions) }, - { ModuleUsedItemVersions = map_ids( - (func(ItemType, Ids0) = Ids :- - ModuleItemNames = extract_ids( - ModuleUsedItems, ItemType), - map__select(Ids0, ModuleItemNames, Ids) - ), - ModuleItemVersions, - map__init) }, - - { - map__search(ModuleInstances, ModuleName, - ModuleUsedInstances) - -> - map__select(ModuleInstanceVersions, - ModuleUsedInstances, - ModuleUsedInstanceVersions) - ; - map__init(ModuleUsedInstanceVersions) - }, - - io__write_string(" => "), - { ModuleUsedVersionNumbers = - version_numbers(ModuleUsedItemVersions, - ModuleUsedInstanceVersions) }, - recompilation__version__write_version_numbers( - ModuleUsedVersionNumbers), - io__write_string(".\n") - ; - % If we don't have version numbers for a module - % we just recompile if the interface file's - % timestamp changes. - io__write_string(".\n") - ) - ), ImportedItems), - + map__foldl(write_module_name_and_used_items(RecompInfo, Timestamps, + ModuleInstances), ImportedItems, !IO), % % recompilation_check.m checks for this item when reading % in the `.used' file to make sure the earlier compilation % wasn't interrupted in the middle of writing the file. % - io__nl, - io__write_string("done.\n"). + io__nl(!IO), + io__write_string("done.\n", !IO). + +:- pred write_module_name_and_used_items(recompilation_info::in, + module_timestamps::in, map(module_name, set(item_name))::in, + module_name::in, item_id_set(set(pair(string, arity)))::in, + io::di, io::uo) is det. + +write_module_name_and_used_items(RecompInfo, Timestamps, ModuleInstances, + ModuleName, ModuleUsedItems, !IO) :- + io__nl(!IO), + io__write_string("(", !IO), + mercury_output_bracketed_sym_name(ModuleName, !IO), + io__write_string(", """, !IO), + map__lookup(Timestamps, ModuleName, + module_timestamp(Suffix, ModuleTimestamp, NeedQualifier)), + io__write_string(Suffix, !IO), + io__write_string(""", ", !IO), + write_version_number(ModuleTimestamp, !IO), + ( NeedQualifier = must_be_qualified -> + io__write_string(", used)", !IO) + ; + io__write_string(")", !IO) + ), + ( + % XXX We don't yet record all uses of items + % from these modules in polymorphism.m, etc. + \+ any_mercury_builtin_module(ModuleName), + map__search(RecompInfo ^ version_numbers, ModuleName, + ModuleVersions) + -> + % + % Select out from the version numbers of all items + % in the imported module the ones which are used. + % + + ModuleVersions = version_numbers(ModuleItemVersions, + ModuleInstanceVersions), + ModuleUsedItemVersions = map_ids( + (func(ItemType, Ids0) = Ids :- + ModuleItemNames = extract_ids(ModuleUsedItems, + ItemType), + map__select(Ids0, ModuleItemNames, Ids) + ), + ModuleItemVersions, map__init), + + ( + map__search(ModuleInstances, ModuleName, + ModuleUsedInstances) + -> + map__select(ModuleInstanceVersions, + ModuleUsedInstances, + ModuleUsedInstanceVersions) + ; + map__init(ModuleUsedInstanceVersions) + ), + + io__write_string(" => ", !IO), + ModuleUsedVersionNumbers = + version_numbers(ModuleUsedItemVersions, + ModuleUsedInstanceVersions), + recompilation__version__write_version_numbers( + ModuleUsedVersionNumbers, !IO), + io__write_string(".\n", !IO) + ; + % If we don't have version numbers for a module + % we just recompile if the interface file's + % timestamp changes. + io__write_string(".\n", !IO) + ). + +:- pred write_classname_and_arity(pair(class_name, arity)::in, + io::di, io::uo) is det. + +write_classname_and_arity(ClassName - ClassArity, !IO) :- + mercury_output_bracketed_sym_name(ClassName, !IO), + io__write_string("/", !IO), + io__write_int(ClassArity, !IO). + +:- pred write_comma_if_needed(bool::in, bool::out, io::di, io::uo) is det. + +write_comma_if_needed(!WriteComma, !IO) :- + ( + !.WriteComma = yes, + io__write_string(",\n\t", !IO) + ; + !.WriteComma = no + ), + !:WriteComma = yes. :- pred write_simple_item_matches(item_type::in(simple_item), - resolved_used_items::in, bool::in, bool::out, - io__state::di, io__state::uo) is det. + resolved_used_items::in, bool::in, bool::out, io::di, io::uo) is det. -write_simple_item_matches(ItemType, UsedItems, WriteComma0, WriteComma) --> - { Ids = extract_simple_item_set(UsedItems, ItemType) }, - ( { map__is_empty(Ids) } -> - { WriteComma = WriteComma0 } +write_simple_item_matches(ItemType, UsedItems, !WriteComma, !IO) :- + Ids = extract_simple_item_set(UsedItems, ItemType), + ( map__is_empty(Ids) -> + true ; - ( { WriteComma0 = yes } -> - io__write_string(",\n\t") - ; - [] - ), - { WriteComma = yes }, - write_simple_item_matches_2(ItemType, Ids) + write_comma_if_needed(!WriteComma, !IO), + write_simple_item_matches_2(ItemType, Ids, !IO) ). :- pred write_simple_item_matches_2(item_type::in, simple_item_set::in, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. -write_simple_item_matches_2(ItemType, ItemSet) --> - { string_to_item_type(ItemTypeStr, ItemType) }, - io__write_string(ItemTypeStr), - io__write_string("(\n\t\t"), - { map__to_assoc_list(ItemSet, ItemList) }, - io__write_list(ItemList, ",\n\t\t", - (pred(((Name - Arity) - Matches)::in, di, uo) is det --> - mercury_output_bracketed_sym_name(unqualified(Name), - next_to_graphic_token), - io__write_string("/"), - io__write_int(Arity), - io__write_string(" - ("), - { map__to_assoc_list(Matches, MatchList) }, - io__write_list(MatchList, ", ", - (pred((Qualifier - ModuleName)::in, di, uo) is det --> - mercury_output_bracketed_sym_name(Qualifier), - ( { Qualifier = ModuleName } -> - [] - ; - io__write_string(" => "), - mercury_output_bracketed_sym_name(ModuleName) - ) - ) - ), - io__write_string(")") - ) - ), - io__write_string("\n\t)"). +write_simple_item_matches_2(ItemType, ItemSet, !IO) :- + string_to_item_type(ItemTypeStr, ItemType), + io__write_string(ItemTypeStr, !IO), + io__write_string("(\n\t\t", !IO), + map__to_assoc_list(ItemSet, ItemList), + io__write_list(ItemList, ",\n\t\t", write_simple_item_matches_3, + !IO), + io__write_string("\n\t)", !IO). + +:- pred write_simple_item_matches_3( + pair(pair(string, arity), map(module_qualifier, module_name))::in, + io::di, io::uo) is det. + +write_simple_item_matches_3((Name - Arity) - Matches, !IO) :- + mercury_output_bracketed_sym_name(unqualified(Name), + next_to_graphic_token, !IO), + io__write_string("/", !IO), + io__write_int(Arity, !IO), + io__write_string(" - (", !IO), + map__to_assoc_list(Matches, MatchList), + io__write_list(MatchList, ", ", write_simple_item_matches_4, !IO), + io__write_string(")", !IO). + +:- pred write_simple_item_matches_4(pair(module_qualifier, module_name)::in, + io::di, io::uo) is det. + +write_simple_item_matches_4(Qualifier - ModuleName, !IO) :- + mercury_output_bracketed_sym_name(Qualifier, !IO), + ( Qualifier = ModuleName -> + true + ; + io__write_string(" => ", !IO), + mercury_output_bracketed_sym_name(ModuleName, !IO) + ). :- pred write_pred_or_func_matches(item_type::in(pred_or_func), - resolved_used_items::in, bool::in, bool::out, - io__state::di, io__state::uo) is det. + resolved_used_items::in, bool::in, bool::out, + io::di, io::uo) is det. -write_pred_or_func_matches(ItemType, UsedItems, WriteComma0, WriteComma) --> - { Ids = extract_pred_or_func_set(UsedItems, ItemType) }, - ( { map__is_empty(Ids) } -> - { WriteComma = WriteComma0 } +write_pred_or_func_matches(ItemType, UsedItems, !WriteComma, !IO) :- + Ids = extract_pred_or_func_set(UsedItems, ItemType), + ( map__is_empty(Ids) -> + true ; - ( { WriteComma0 = yes } -> - io__write_string(",\n\t") - ; - [] - ), - { WriteComma = yes }, - write_pred_or_func_matches_2(ItemType, Ids) + write_comma_if_needed(!WriteComma, !IO), + write_pred_or_func_matches_2(ItemType, Ids, !IO) ). :- pred write_pred_or_func_matches_2(item_type::in(pred_or_func), - resolved_pred_or_func_set::in, - io__state::di, io__state::uo) is det. + resolved_pred_or_func_set::in, io::di, io::uo) is det. -write_pred_or_func_matches_2(ItemType, ItemSet) --> +write_pred_or_func_matches_2(ItemType, ItemSet, !IO) :- write_resolved_item_set(ItemType, ItemSet, - (pred((Qualifier - PredIdModuleNames)::in, di, uo) is det --> - { ModuleNames = assoc_list__values(set__to_sorted_list( - PredIdModuleNames)) }, - mercury_output_bracketed_sym_name(Qualifier), - ( { ModuleNames = [Qualifier] } -> - [] - ; - io__write_string(" => ("), - io__write_list(ModuleNames, ", ", - mercury_output_bracketed_sym_name), - io__write_string(")") - ) - )). + write_pred_or_func_matches_3, !IO). -:- pred write_functor_matches(resolved_functor_set::in, - bool::in, bool::out, io__state::di, io__state::uo) is det. +:- pred write_pred_or_func_matches_3( + pair(sym_name, set(pair(pred_id, sym_name)))::in, + io::di, io::uo) is det. -write_functor_matches(Ids, WriteComma0, WriteComma) --> - ( { map__is_empty(Ids) } -> - { WriteComma = WriteComma0 } +write_pred_or_func_matches_3(Qualifier - PredIdModuleNames, !IO) :- + ModuleNames = + assoc_list__values(set__to_sorted_list(PredIdModuleNames)), + mercury_output_bracketed_sym_name(Qualifier, !IO), + ( ModuleNames = [Qualifier] -> + true ; - ( { WriteComma0 = yes } -> - io__write_string(",\n\t") - ; - [] - ), - { WriteComma = yes }, - write_resolved_item_set(functor, Ids, - (pred((Qualifier - MatchingCtors)::in, di, uo) is det --> - mercury_output_bracketed_sym_name(Qualifier), - io__write_string(" => ("), - io__write_list( - set__to_sorted_list(MatchingCtors), - ", ", write_resolved_functor), - io__write_string(")") - )) + io__write_string(" => (", !IO), + io__write_list(ModuleNames, ", ", + mercury_output_bracketed_sym_name, !IO), + io__write_string(")", !IO) ). -:- type write_resolved_item(T) == - pred(pair(module_qualifier, T), io__state, io__state). +:- pred write_functor_matches(resolved_functor_set::in, + bool::in, bool::out, io::di, io::uo) is det. + +write_functor_matches(Ids, !WriteComma, !IO) :- + ( map__is_empty(Ids) -> + true + ; + write_comma_if_needed(!WriteComma, !IO), + write_resolved_item_set(functor, Ids, write_functor_matches_2, + !IO) + ). + +:- pred write_functor_matches_2(pair(sym_name, set(resolved_functor))::in, + io::di, io::uo) is det. + +write_functor_matches_2(Qualifier - MatchingCtors, !IO) :- + mercury_output_bracketed_sym_name(Qualifier, !IO), + io__write_string(" => (", !IO), + io__write_list(set__to_sorted_list(MatchingCtors), ", ", + write_resolved_functor, !IO), + io__write_string(")", !IO). + +:- type write_resolved_item(T) == pred(pair(module_qualifier, T), io, io). :- inst write_resolved_item == (pred(in, di, uo) is det). :- pred write_resolved_item_set(item_type::in, resolved_item_set(T)::in, write_resolved_item(T)::in(write_resolved_item), - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. -write_resolved_item_set(ItemType, ItemSet, WriteMatches) --> - { string_to_item_type(ItemTypeStr, ItemType) }, - io__write_string(ItemTypeStr), - io__write_string("(\n\t\t"), - { map__to_assoc_list(ItemSet, ItemList) }, +write_resolved_item_set(ItemType, ItemSet, WriteMatches, !IO) :- + string_to_item_type(ItemTypeStr, ItemType), + io__write_string(ItemTypeStr, !IO), + io__write_string("(\n\t\t", !IO), + map__to_assoc_list(ItemSet, ItemList), io__write_list(ItemList, ",\n\t\t", - (pred((Name - MatchesAL)::in, di, uo) is det --> - mercury_output_bracketed_sym_name(unqualified(Name)), - io__write_string(" - ("), - io__write_list(MatchesAL, ",\n\t\t\t", - (pred((Arity - Matches)::in, di, uo) is det --> - io__write_int(Arity), - io__write_string(" - ("), - { map__to_assoc_list(Matches, MatchList) }, - io__write_list(MatchList, ",\n\t\t\t\t", - WriteMatches), - io__write_string(")") - )), - io__write_string(")") - )), - io__write_string("\n\t)"). + write_resolved_item_set_2(WriteMatches), !IO), + io__write_string("\n\t)", !IO). -:- pred write_resolved_functor(resolved_functor::in, - io__state::di, io__state::uo) is det. +:- pred write_resolved_item_set_2( + write_resolved_item(T)::in(write_resolved_item), + pair(string, list(pair(int, map(sym_name, T))))::in, + io::di, io::uo) is det. -write_resolved_functor(pred_or_func(_, ModuleName, PredOrFunc, Arity)) --> - io__write(PredOrFunc), - io__write_string("("), - mercury_output_bracketed_sym_name(ModuleName), - io__write_string(", "), - io__write_int(Arity), - io__write_string(")"). -write_resolved_functor(constructor(TypeName - Arity)) --> - io__write_string("ctor("), - mercury_output_bracketed_sym_name(TypeName, next_to_graphic_token), - io__write_string("/"), - io__write_int(Arity), - io__write_string(")"). -write_resolved_functor( - field(TypeName - TypeArity, ConsName - ConsArity)) --> - io__write_string("field("), - mercury_output_bracketed_sym_name(TypeName, next_to_graphic_token), - io__write_string("/"), - io__write_int(TypeArity), - io__write_string(", "), - mercury_output_bracketed_sym_name(ConsName, next_to_graphic_token), - io__write_string("/"), - io__write_int(ConsArity), - io__write_string(")"). +write_resolved_item_set_2(WriteMatches, Name - MatchesAL, !IO) :- + mercury_output_bracketed_sym_name(unqualified(Name), !IO), + io__write_string(" - (", !IO), + io__write_list(MatchesAL, ",\n\t\t\t", + write_resolved_item_set_3(WriteMatches), !IO), + io__write_string(")", !IO). + +:- pred write_resolved_item_set_3( + write_resolved_item(T)::in(write_resolved_item), + pair(int, map(sym_name, T))::in, io::di, io::uo) is det. + +write_resolved_item_set_3(WriteMatches, Arity - Matches, !IO) :- + io__write_int(Arity, !IO), + io__write_string(" - (", !IO), + map__to_assoc_list(Matches, MatchList), + io__write_list(MatchList, ",\n\t\t\t\t", WriteMatches, !IO), + io__write_string(")", !IO). + +:- pred write_resolved_functor(resolved_functor::in, io::di, io::uo) is det. + +write_resolved_functor(pred_or_func(_, ModuleName, PredOrFunc, Arity), !IO) :- + io__write(PredOrFunc, !IO), + io__write_string("(", !IO), + mercury_output_bracketed_sym_name(ModuleName, !IO), + io__write_string(", ", !IO), + io__write_int(Arity, !IO), + io__write_string(")", !IO). +write_resolved_functor(constructor(TypeName - Arity), !IO) :- + io__write_string("ctor(", !IO), + mercury_output_bracketed_sym_name(TypeName, next_to_graphic_token, + !IO), + io__write_string("/", !IO), + io__write_int(Arity, !IO), + io__write_string(")", !IO). +write_resolved_functor(field(TypeName - TypeArity, ConsName - ConsArity), + !IO) :- + io__write_string("field(", !IO), + mercury_output_bracketed_sym_name(TypeName, next_to_graphic_token, + !IO), + io__write_string("/", !IO), + io__write_int(TypeArity, !IO), + io__write_string(", ", !IO), + mercury_output_bracketed_sym_name(ConsName, next_to_graphic_token, + !IO), + io__write_string("/", !IO), + io__write_int(ConsArity, !IO), + io__write_string(")", !IO). usage_file_version_number = 2. @@ -454,17 +484,17 @@ usage_file_version_number = 2. %-----------------------------------------------------------------------------% :- type recompilation_usage_info - ---> recompilation_usage_info( - module_info :: module_info, - item_queue :: queue(item_id), - imported_items :: imported_items, - % For each module, the used typeclasses for - % which the module contains an instance. - module_instances :: map(module_name, set(item_name)), - dependencies :: map(item_id, set(item_id)), - used_items :: resolved_used_items, - used_typeclasses :: set(item_name) - ). + ---> recompilation_usage_info( + module_info :: module_info, + item_queue :: queue(item_id), + imported_items :: imported_items, + % For each module, the used typeclasses for + % which the module contains an instance. + module_instances :: map(module_name, set(item_name)), + dependencies :: map(item_id, set(item_id)), + used_items :: resolved_used_items, + used_typeclasses :: set(item_name) + ). :- type imported_items == map(module_name, module_imported_items). @@ -476,6 +506,19 @@ usage_file_version_number = 2. %-----------------------------------------------------------------------------% +:- pred visible_modules(module_info::in, module_name::out) is nondet. + +visible_modules(ModuleInfo, VisibleModule) :- + visible_module(VisibleModule, ModuleInfo), + \+ module_info_name(ModuleInfo, VisibleModule). + +:- pred insert_into_imported_items_map(module_name::in, + imported_items::in, imported_items::out) is det. + +insert_into_imported_items_map(VisibleModule, !ImportedItemsMap) :- + ModuleItems = init_item_id_set(set__init), + svmap__det_insert(VisibleModule, ModuleItems, !ImportedItemsMap). + % % Go over the set of imported items found to be used and % find the transitive closure of the imported items they use. @@ -497,32 +540,24 @@ recompilation__usage__find_all_used_imported_items(ModuleInfo, % map__init(ImportedItems0), ImportedItems2 = promise_only_solution( - (pred(ImportedItems1::out) is cc_multi :- - std_util__unsorted_aggregate( - (pred(VisibleModule::out) is nondet :- - visible_module(VisibleModule, ModuleInfo), - \+ module_info_name(ModuleInfo, VisibleModule) - ), - (pred(VisibleModule::in, ImportedItemsMap0::in, - ImportedItemsMap::out) is det :- - ModuleItems = init_item_id_set(set__init), - map__det_insert(ImportedItemsMap0, VisibleModule, - ModuleItems, ImportedItemsMap) - ), - ImportedItems0, ImportedItems1) - )), + (pred(ImportedItems1::out) is cc_multi :- + std_util__unsorted_aggregate( + visible_modules(ModuleInfo), + insert_into_imported_items_map, + ImportedItems0, ImportedItems1) + )), queue__init(ItemsToProcess0), map__init(ModuleUsedClasses), set__init(UsedClasses0), UsedItems = item_id_set(Types, TypeBodies, Modes, Insts, Classes, - _, _, _), + _, _, _), map__init(ResolvedCtors), map__init(ResolvedPreds), map__init(ResolvedFuncs), ResolvedUsedItems0 = item_id_set(Types, TypeBodies, Modes, Insts, - Classes, ResolvedCtors, ResolvedPreds, ResolvedFuncs), + Classes, ResolvedCtors, ResolvedPreds, ResolvedFuncs), Info0 = recompilation_usage_info(ModuleInfo, ItemsToProcess0, ImportedItems2, ModuleUsedClasses, Dependencies, @@ -539,101 +574,94 @@ recompilation__usage__find_all_used_imported_items(ModuleInfo, :- pred recompilation__usage__find_all_used_imported_items_2(used_items::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__find_all_used_imported_items_2(UsedItems) --> +recompilation__usage__find_all_used_imported_items_2(UsedItems, !Info) :- % % Find items used by imported instances for local classes. % - ModuleInfo =^ module_info, - { module_info_instances(ModuleInfo, Instances) }, - map__foldl( - (pred(ClassId::in, InstanceDefns::in, in, out) is det --> - { ClassId = class_id(Name, Arity) }, - =(Info), - { NameArity = Name - Arity }, - ( { item_is_local(Info, NameArity) } -> - recompilation__usage__record_expanded_items_used_by_item( - (typeclass), NameArity), - list__foldl( - recompilation__usage__find_items_used_by_instance( - NameArity), - InstanceDefns) - ; - [] - ) - ), Instances), + ModuleInfo = !.Info ^ module_info, + module_info_instances(ModuleInfo, Instances), + map__foldl(find_items_used_by_instances, Instances, !Info), - { Predicates = UsedItems ^ predicates }, - recompilation__usage__find_items_used_by_preds(predicate, Predicates), + Predicates = UsedItems ^ predicates, + recompilation__usage__find_items_used_by_preds(predicate, Predicates, + !Info), - { Functions = UsedItems ^ functions }, - recompilation__usage__find_items_used_by_preds(function, Functions), + Functions = UsedItems ^ functions, + recompilation__usage__find_items_used_by_preds(function, Functions, + !Info), - { Constructors = UsedItems ^ functors }, - recompilation__usage__find_items_used_by_functors(Constructors), + Constructors = UsedItems ^ functors, + recompilation__usage__find_items_used_by_functors(Constructors, + !Info), - { Types = UsedItems ^ types }, - recompilation__usage__find_items_used_by_simple_item_set((type), Types), + Types = UsedItems ^ types, + recompilation__usage__find_items_used_by_simple_item_set((type), Types, + !Info), - { TypeBodies = UsedItems ^ type_bodies }, + TypeBodies = UsedItems ^ type_bodies, recompilation__usage__find_items_used_by_simple_item_set((type_body), - TypeBodies), + TypeBodies, !Info), - { Modes = UsedItems ^ modes }, - recompilation__usage__find_items_used_by_simple_item_set((mode), Modes), + Modes = UsedItems ^ modes, + recompilation__usage__find_items_used_by_simple_item_set((mode), Modes, + !Info), - { Classes = UsedItems ^ typeclasses }, + Classes = UsedItems ^ typeclasses, recompilation__usage__find_items_used_by_simple_item_set((typeclass), - Classes), + Classes, !Info), - { Insts = UsedItems ^ insts }, - recompilation__usage__find_items_used_by_simple_item_set((inst), Insts), + Insts = UsedItems ^ insts, + recompilation__usage__find_items_used_by_simple_item_set((inst), Insts, + !Info), - recompilation__usage__process_imported_item_queue. + recompilation__usage__process_imported_item_queue(!Info). :- pred recompilation__usage__process_imported_item_queue( recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__process_imported_item_queue --> - Queue0 =^ item_queue, - ^ item_queue := queue__init, - recompilation__usage__process_imported_item_queue_2(Queue0), - Queue =^ item_queue, - ( { queue__is_empty(Queue) } -> - [] +recompilation__usage__process_imported_item_queue(!Info) :- + Queue0 = !.Info ^ item_queue, + !:Info = !.Info ^ item_queue := queue__init, + recompilation__usage__process_imported_item_queue_2(Queue0, !Info), + Queue = !.Info ^ item_queue, + ( queue__is_empty(Queue) -> + true ; - recompilation__usage__process_imported_item_queue + recompilation__usage__process_imported_item_queue(!Info) ). :- pred recompilation__usage__process_imported_item_queue_2( - queue(item_id)::in, recompilation_usage_info::in, - recompilation_usage_info::out) is det. + queue(item_id)::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__process_imported_item_queue_2(Queue0) --> - ( { queue__get(Queue0, Item, Queue) } -> - { Item = item_id(ItemType, ItemId) }, - recompilation__usage__find_items_used_by_item(ItemType, ItemId), - recompilation__usage__process_imported_item_queue_2(Queue) +recompilation__usage__process_imported_item_queue_2(Queue0, !Info) :- + ( queue__get(Queue0, Item, Queue) -> + Item = item_id(ItemType, ItemId), + recompilation__usage__find_items_used_by_item(ItemType, ItemId, + !Info), + recompilation__usage__process_imported_item_queue_2(Queue, + !Info) ; - [] + true ). %-----------------------------------------------------------------------------% :- pred recompilation__usage__record_used_pred_or_func(pred_or_func::in, - pair(sym_name, arity)::in, recompilation_usage_info::in, - recompilation_usage_info::out) is det. + pair(sym_name, arity)::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__record_used_pred_or_func(PredOrFunc, Id) --> - { ItemType = pred_or_func_to_item_type(PredOrFunc) }, - ItemSet0 =^ used_items, - { IdSet0 = extract_pred_or_func_set(ItemSet0, ItemType) }, - { Id = SymName - Arity }, +recompilation__usage__record_used_pred_or_func(PredOrFunc, Id, !Info) :- + ItemType = pred_or_func_to_item_type(PredOrFunc), + ItemSet0 = !.Info ^ used_items, + IdSet0 = extract_pred_or_func_set(ItemSet0, ItemType), + Id = SymName - Arity, record_resolved_item(SymName, Arity, recompilation__usage__do_record_used_pred_or_func(PredOrFunc), - IdSet0, IdSet), - { ItemSet = update_pred_or_func_set(ItemSet0, ItemType, IdSet) }, - ^ used_items := ItemSet. + IdSet0, IdSet, !Info), + ItemSet = update_pred_or_func_set(ItemSet0, ItemType, IdSet), + !:Info = !.Info ^ used_items := ItemSet. :- pred recompilation__usage__do_record_used_pred_or_func(pred_or_func::in, module_qualifier::in, sym_name::in, arity::in, bool::out, @@ -641,33 +669,30 @@ recompilation__usage__record_used_pred_or_func(PredOrFunc, Id) --> recompilation_usage_info::in, recompilation_usage_info::out) is det. recompilation__usage__do_record_used_pred_or_func(PredOrFunc, ModuleQualifier, - SymName, Arity, Recorded, MatchingNames0, MatchingNames) --> - ModuleInfo =^ module_info, + SymName, Arity, Recorded, !MatchingNames, !Info) :- + ModuleInfo = !.Info ^ module_info, ( - { module_info_get_predicate_table(ModuleInfo, PredTable) }, - { adjust_func_arity(PredOrFunc, OrigArity, Arity) }, - { predicate_table_search_pf_sym_arity(PredTable, + module_info_get_predicate_table(ModuleInfo, PredTable), + adjust_func_arity(PredOrFunc, OrigArity, Arity), + predicate_table_search_pf_sym_arity(PredTable, may_be_partially_qualified, PredOrFunc, SymName, - OrigArity, MatchingPredIds) } + OrigArity, MatchingPredIds) -> - { Recorded = yes }, - { PredModules = set__list_to_set(list__map( + Recorded = yes, + PredModules = set__list_to_set(list__map( (func(PredId) = PredId - PredModule :- module_info_pred_info(ModuleInfo, PredId, PredInfo), PredModule = pred_info_module(PredInfo) ), - MatchingPredIds)) }, - { map__det_insert(MatchingNames0, ModuleQualifier, - PredModules, MatchingNames) }, - { unqualify_name(SymName, Name) }, - set__fold( - recompilation__usage__find_items_used_by_pred( - PredOrFunc, Name - Arity), - PredModules) + MatchingPredIds)), + svmap__det_insert(ModuleQualifier, PredModules, + !MatchingNames), + unqualify_name(SymName, Name), + set__fold(recompilation__usage__find_items_used_by_pred( + PredOrFunc, Name - Arity), PredModules, !Info) ; - { Recorded = no }, - { MatchingNames = MatchingNames0 } + Recorded = no ). %-----------------------------------------------------------------------------% @@ -675,40 +700,37 @@ recompilation__usage__do_record_used_pred_or_func(PredOrFunc, ModuleQualifier, :- pred recompilation__usage__record_used_functor(pair(sym_name, arity)::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__record_used_functor(SymName - Arity) --> - ItemSet0 =^ used_items, - { IdSet0 = ItemSet0 ^ functors }, +recompilation__usage__record_used_functor(SymName - Arity, !Info) :- + ItemSet0 = !.Info ^ used_items, + IdSet0 = ItemSet0 ^ functors, record_resolved_item(SymName, Arity, recompilation__usage__do_record_used_functor, - IdSet0, IdSet), - { ItemSet = ItemSet0 ^ functors := IdSet }, - ^ used_items := ItemSet. + IdSet0, IdSet, !Info), + ItemSet = ItemSet0 ^ functors := IdSet, + !:Info = !.Info ^ used_items := ItemSet. :- pred recompilation__usage__do_record_used_functor(module_qualifier::in, sym_name::in, arity::in, bool::out, resolved_functor_map::in, - resolved_functor_map::out, recompilation_usage_info::in, - recompilation_usage_info::out) is det. + resolved_functor_map::out, + recompilation_usage_info::in, recompilation_usage_info::out) is det. recompilation__usage__do_record_used_functor(ModuleQualifier, SymName, Arity, - Recorded, ResolvedCtorMap0, ResolvedCtorMap) --> - ModuleInfo =^ module_info, + Recorded, !ResolvedCtorMap, !Info) :- + ModuleInfo = !.Info ^ module_info, - { recompilation__usage__find_matching_functors(ModuleInfo, - SymName, Arity, MatchingCtors) }, - { unqualify_name(SymName, Name) }, - set__fold( - recompilation__usage__find_items_used_by_functor( - Name, Arity), - MatchingCtors), + recompilation__usage__find_matching_functors(ModuleInfo, SymName, + Arity, MatchingCtors), + unqualify_name(SymName, Name), + set__fold(recompilation__usage__find_items_used_by_functor(Name, + Arity), MatchingCtors, !Info), - { set__empty(MatchingCtors) -> - Recorded = no, - ResolvedCtorMap = ResolvedCtorMap0 + ( set__empty(MatchingCtors) -> + Recorded = no ; Recorded = yes, - map__det_insert(ResolvedCtorMap0, ModuleQualifier, - MatchingCtors, ResolvedCtorMap) - }. + svmap__det_insert(ModuleQualifier, MatchingCtors, + !ResolvedCtorMap) + ). :- pred recompilation__usage__find_matching_functors(module_info::in, sym_name::in, arity::in, set(resolved_functor)::out) is det. @@ -768,13 +790,13 @@ recompilation__usage__find_matching_functors(ModuleInfo, SymName, Arity, MatchingFields = list__map( (func(FieldDefn) = FieldCtor :- FieldDefn = hlds_ctor_field_defn(_, _, - TypeCtor, ConsId, _), + TypeCtor, ConsId, _), ( ConsId = cons(ConsName, ConsArity) -> FieldCtor = field(TypeCtor, ConsName - ConsArity) ; - error( - "weird cons_id in hlds_field_defn") + error("weird cons_id in " ++ + "hlds_field_defn") ) ), FieldDefns) ; @@ -786,7 +808,7 @@ recompilation__usage__find_matching_functors(ModuleInfo, SymName, Arity, ). :- func recompilation__usage__get_pred_or_func_ctors(module_info, sym_name, - arity, pred_id) = resolved_functor is semidet. + arity, pred_id) = resolved_functor is semidet. recompilation__usage__get_pred_or_func_ctors(ModuleInfo, _SymName, Arity, PredId) = ResolvedCtor :- @@ -819,82 +841,87 @@ recompilation__usage__get_pred_or_func_ctors(ModuleInfo, _SymName, Arity, %-----------------------------------------------------------------------------% :- type record_resolved_item(T) == - pred(module_qualifier, sym_name, arity, bool, - resolved_item_map(T), resolved_item_map(T), - recompilation_usage_info, recompilation_usage_info). + pred(module_qualifier, sym_name, arity, bool, + resolved_item_map(T), resolved_item_map(T), + recompilation_usage_info, recompilation_usage_info). :- inst record_resolved_item == - (pred(in, in, in, out, in, out, in, out) is det). - + (pred(in, in, in, out, in, out, in, out) is det). :- pred record_resolved_item(sym_name::in, arity::in, record_resolved_item(T)::in(record_resolved_item), resolved_item_set(T)::in, resolved_item_set(T)::out, recompilation_usage_info::in, recompilation_usage_info::out) is det. -record_resolved_item(SymName, Arity, RecordItem, IdSet0, IdSet) --> - { unqualify_name(SymName, UnqualifiedName) }, - { ModuleQualifier = find_module_qualifier(SymName) }, - { map__search(IdSet0, UnqualifiedName, MatchingNames0) -> +record_resolved_item(SymName, Arity, RecordItem, !IdSet, !Info) :- + unqualify_name(SymName, UnqualifiedName), + ModuleQualifier = find_module_qualifier(SymName), + ( map__search(!.IdSet, UnqualifiedName, MatchingNames0) -> MatchingNames1 = MatchingNames0 ; MatchingNames1 = [] - }, + ), recompilation__usage__record_resolved_item_2(ModuleQualifier, SymName, - Arity, RecordItem, Recorded, - MatchingNames1, MatchingNames), - { Recorded = yes -> - map__set(IdSet0, UnqualifiedName, MatchingNames, IdSet) + Arity, RecordItem, Recorded, MatchingNames1, MatchingNames, + !Info), + ( + Recorded = yes, + svmap__set(UnqualifiedName, MatchingNames, !IdSet) ; - IdSet = IdSet0 - }. + Recorded = no + ). :- pred recompilation__usage__record_resolved_item_2( module_qualifier::in, sym_name::in, arity::in, - record_resolved_item(T)::in(record_resolved_item), - bool::out, resolved_item_list(T)::in, resolved_item_list(T)::out, + record_resolved_item(T)::in(record_resolved_item), bool::out, + resolved_item_list(T)::in, resolved_item_list(T)::out, recompilation_usage_info::in, recompilation_usage_info::out) is det. recompilation__usage__record_resolved_item_2(ModuleQualifier, - SymName, Arity, RecordItem, Recorded, [], List) --> - { map__init(Map0) }, + SymName, Arity, RecordItem, Recorded, !List, !Info) :- + !.List = [], + map__init(Map0), recompilation__usage__record_resolved_item_3(ModuleQualifier, - SymName, Arity, RecordItem, Recorded, Map0, Map), - { Recorded = yes -> - List = [Arity - Map] + SymName, Arity, RecordItem, Recorded, Map0, Map, !Info), + ( + Recorded = yes, + !:List = [Arity - Map] ; - List = [] - }. + Recorded = no + ). recompilation__usage__record_resolved_item_2(ModuleQualifier, - SymName, Arity, RecordItem, Recorded, List0, List) --> - { List0 = [ThisArity - ArityMap0 | ListRest0] }, - ( { Arity < ThisArity } -> - { map__init(NewArityMap0) }, + SymName, Arity, RecordItem, Recorded, !List, !Info) :- + !.List = [ThisArity - ArityMap0 | ListRest0], + ( Arity < ThisArity -> + map__init(NewArityMap0), recompilation__usage__record_resolved_item_3(ModuleQualifier, SymName, Arity, RecordItem, Recorded, - NewArityMap0, NewArityMap), - { Recorded = yes -> - List = [Arity - NewArityMap | List0] + NewArityMap0, NewArityMap, !Info), + ( + Recorded = yes, + !:List = [Arity - NewArityMap | !.List] ; - List = List0 - } - ; { Arity = ThisArity } -> + Recorded = no + ) + ; Arity = ThisArity -> recompilation__usage__record_resolved_item_3(ModuleQualifier, SymName, Arity, RecordItem, Recorded, - ArityMap0, ArityMap), - { Recorded = yes -> - List = [Arity - ArityMap | ListRest0] + ArityMap0, ArityMap, !Info), + ( + Recorded = yes, + !:List = [Arity - ArityMap | ListRest0] ; - List = List0 - } + Recorded = no + ) ; recompilation__usage__record_resolved_item_2(ModuleQualifier, SymName, Arity, RecordItem, Recorded, - ListRest0, ListRest), - { Recorded = yes -> - List = [ThisArity - ArityMap0 | ListRest] + ListRest0, ListRest, !Info), + ( + Recorded = yes, + !:List = [ThisArity - ArityMap0 | ListRest] ; - List = List0 - } + Recorded = no + ) ). :- pred recompilation__usage__record_resolved_item_3( @@ -904,237 +931,278 @@ recompilation__usage__record_resolved_item_2(ModuleQualifier, recompilation_usage_info::in, recompilation_usage_info::out) is det. recompilation__usage__record_resolved_item_3(ModuleQualifier, SymName, Arity, - RecordItem, Recorded, ResolvedMap0, ResolvedMap) --> - ( { map__contains(ResolvedMap0, ModuleQualifier) } -> - { Recorded = no }, - { ResolvedMap = ResolvedMap0 } + RecordItem, Recorded, !ResolvedMap, !Info) :- + ( map__contains(!.ResolvedMap, ModuleQualifier) -> + Recorded = no ; RecordItem(ModuleQualifier, SymName, Arity, Recorded, - ResolvedMap0, ResolvedMap) + !ResolvedMap, !Info) ). %-----------------------------------------------------------------------------% :- pred recompilation__usage__find_items_used_by_item(item_type::in, - item_name::in, recompilation_usage_info::in, - recompilation_usage_info::out) is det. + item_name::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__find_items_used_by_item((type), TypeCtor) --> - ModuleInfo =^ module_info, - { module_info_types(ModuleInfo, Types) }, - { map__lookup(Types, TypeCtor, TypeDefn) }, - { hlds_data__get_type_defn_body(TypeDefn, TypeBody) }, - ( { TypeBody = eqv_type(Type) } -> +recompilation__usage__find_items_used_by_item((type), TypeCtor, !Info) :- + ModuleInfo = !.Info ^ module_info, + module_info_types(ModuleInfo, Types), + map__lookup(Types, TypeCtor, TypeDefn), + hlds_data__get_type_defn_body(TypeDefn, TypeBody), + ( TypeBody = eqv_type(Type) -> % If we use an equivalence type we also use the % type it is equivalent to. - recompilation__usage__find_items_used_by_type(Type) + recompilation__usage__find_items_used_by_type(Type, !Info) ; - [] + true ). -recompilation__usage__find_items_used_by_item(type_body, TypeCtor) --> - ModuleInfo =^ module_info, - { module_info_types(ModuleInfo, Types) }, - { map__lookup(Types, TypeCtor, TypeDefn) }, - { hlds_data__get_type_defn_body(TypeDefn, TypeBody) }, - recompilation__usage__find_items_used_by_type_body(TypeBody). -recompilation__usage__find_items_used_by_item((mode), ModeId) --> - ModuleInfo =^ module_info, - { module_info_modes(ModuleInfo, Modes) }, - { mode_table_get_mode_defns(Modes, ModeDefns) }, - { map__lookup(ModeDefns, ModeId, ModeDefn) }, - recompilation__usage__find_items_used_by_mode_defn(ModeDefn). -recompilation__usage__find_items_used_by_item((inst), InstId) --> - ModuleInfo =^ module_info, - { module_info_insts(ModuleInfo, Insts) }, - { inst_table_get_user_insts(Insts, UserInsts) }, - { user_inst_table_get_inst_defns(UserInsts, UserInstDefns) }, - { map__lookup(UserInstDefns, InstId, InstDefn) }, - recompilation__usage__find_items_used_by_inst_defn(InstDefn). -recompilation__usage__find_items_used_by_item((typeclass), ClassItemId) --> - { ClassItemId = ClassName - ClassArity }, - { ClassId = class_id(ClassName, ClassArity) }, - ModuleInfo =^ module_info, - { module_info_classes(ModuleInfo, Classes) }, - { map__lookup(Classes, ClassId, ClassDefn) }, - { ClassDefn = hlds_class_defn(_, Constraints, _, ClassInterface, - _, _, _) }, +recompilation__usage__find_items_used_by_item(type_body, TypeCtor, !Info) :- + ModuleInfo = !.Info ^ module_info, + module_info_types(ModuleInfo, Types), + map__lookup(Types, TypeCtor, TypeDefn), + hlds_data__get_type_defn_body(TypeDefn, TypeBody), + recompilation__usage__find_items_used_by_type_body(TypeBody, !Info). +recompilation__usage__find_items_used_by_item((mode), ModeId, !Info):- + ModuleInfo = !.Info ^ module_info, + module_info_modes(ModuleInfo, Modes), + mode_table_get_mode_defns(Modes, ModeDefns), + map__lookup(ModeDefns, ModeId, ModeDefn), + recompilation__usage__find_items_used_by_mode_defn(ModeDefn, !Info). +recompilation__usage__find_items_used_by_item((inst), InstId, !Info):- + ModuleInfo = !.Info ^ module_info, + module_info_insts(ModuleInfo, Insts), + inst_table_get_user_insts(Insts, UserInsts), + user_inst_table_get_inst_defns(UserInsts, UserInstDefns), + map__lookup(UserInstDefns, InstId, InstDefn), + recompilation__usage__find_items_used_by_inst_defn(InstDefn, !Info). +recompilation__usage__find_items_used_by_item((typeclass), ClassItemId, + !Info) :- + ClassItemId = ClassName - ClassArity, + ClassId = class_id(ClassName, ClassArity), + ModuleInfo = !.Info ^ module_info, + module_info_classes(ModuleInfo, Classes), + map__lookup(Classes, ClassId, ClassDefn), + ClassDefn = hlds_class_defn(_, Constraints, _, ClassInterface, + _, _, _), recompilation__usage__find_items_used_by_class_constraints( - Constraints), + Constraints, !Info), ( - { ClassInterface = abstract } + ClassInterface = abstract ; - { ClassInterface = concrete(Methods) }, + ClassInterface = concrete(Methods), list__foldl( recompilation__usage__find_items_used_by_class_method, - Methods) + Methods, !Info) ), - { module_info_instances(ModuleInfo, Instances) }, - ( { map__search(Instances, ClassId, InstanceDefns) } -> - list__foldl( - recompilation__usage__find_items_used_by_instance( - ClassItemId), InstanceDefns) + module_info_instances(ModuleInfo, Instances), + ( map__search(Instances, ClassId, InstanceDefns) -> + list__foldl(recompilation__usage__find_items_used_by_instance( + ClassItemId), InstanceDefns, !Info) ; - [] + true ). -recompilation__usage__find_items_used_by_item(predicate, ItemId) --> - recompilation__usage__record_used_pred_or_func(predicate, ItemId). -recompilation__usage__find_items_used_by_item(function, ItemId) --> - recompilation__usage__record_used_pred_or_func(function, ItemId). -recompilation__usage__find_items_used_by_item(functor, _) --> - { error("recompilation__usage__find_items_used_by_item: functor") }. +recompilation__usage__find_items_used_by_item(predicate, ItemId, !Info) :- + recompilation__usage__record_used_pred_or_func(predicate, ItemId, + !Info). +recompilation__usage__find_items_used_by_item(function, ItemId, !Info) :- + recompilation__usage__record_used_pred_or_func(function, ItemId, + !Info). +recompilation__usage__find_items_used_by_item(functor, _, !Info) :- + error("recompilation__usage__find_items_used_by_item: functor"). + +:- pred find_items_used_by_instances(class_id::in, + list(hlds_instance_defn)::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. + +find_items_used_by_instances(ClassId, InstanceDefns, !Info) :- + ClassId = class_id(Name, Arity), + NameArity = Name - Arity, + ( item_is_local(!.Info, NameArity) -> + recompilation__usage__record_expanded_items_used_by_item( + (typeclass), NameArity, !Info), + list__foldl(recompilation__usage__find_items_used_by_instance( + NameArity), InstanceDefns, !Info) + ; + true + ). :- pred recompilation__usage__find_items_used_by_instance(item_name::in, - hlds_instance_defn::in, recompilation_usage_info::in, - recompilation_usage_info::out) is det. + hlds_instance_defn::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. recompilation__usage__find_items_used_by_instance(ClassId, hlds_instance_defn(InstanceModuleName, _, _, Constraints, - ArgTypes, _, _, _, _)) --> + ArgTypes, _, _, _, _), !Info) :- % XXX handle interface (currently not needed because % the interfaces for imported instances are only needed with % --intermodule-optimization, which isn't handled here yet) - ModuleInfo =^ module_info, + ModuleInfo = !.Info ^ module_info, ( - { module_info_name(ModuleInfo, InstanceModuleName) } + module_info_name(ModuleInfo, InstanceModuleName) -> - [] + true ; recompilation__usage__find_items_used_by_class_constraints( - Constraints), - recompilation__usage__find_items_used_by_types(ArgTypes), - ModuleInstances0 =^ module_instances, - { + Constraints, !Info), + recompilation__usage__find_items_used_by_types(ArgTypes, !Info), + ModuleInstances0 = !.Info ^ module_instances, + ( map__search(ModuleInstances0, InstanceModuleName, ClassIds0) -> ClassIds1 = ClassIds0 ; set__init(ClassIds1) - }, - { set__insert(ClassIds1, ClassId, ClassIds) }, - { map__set(ModuleInstances0, InstanceModuleName, ClassIds, - ModuleInstances) }, - ^ module_instances := ModuleInstances + ), + set__insert(ClassIds1, ClassId, ClassIds), + map__set(ModuleInstances0, InstanceModuleName, ClassIds, + ModuleInstances), + !:Info = !.Info ^ module_instances := ModuleInstances ). :- pred recompilation__usage__find_items_used_by_class_method( - class_method::in, recompilation_usage_info::in, - recompilation_usage_info::out) is det. + class_method::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. recompilation__usage__find_items_used_by_class_method( pred_or_func(_, _, _, _, _, ArgTypesAndModes, _, - _, _, _, _, Constraints, _)) --> + _, _, _, _, Constraints, _), !Info) :- recompilation__usage__find_items_used_by_class_context( - Constraints), - list__foldl( - (pred(TypeAndMode::in, in, out) is det --> - ( - { TypeAndMode = type_only(Type) } - ; - { TypeAndMode = type_and_mode(Type, Mode) }, - recompilation__usage__find_items_used_by_mode(Mode) - ), - recompilation__usage__find_items_used_by_type(Type) - ), ArgTypesAndModes). + Constraints, !Info), + list__foldl(recompilation__usage__find_items_used_by_type_and_mode, + ArgTypesAndModes, !Info). recompilation__usage__find_items_used_by_class_method( - pred_or_func_mode(_, _, _, Modes, _, _, _, _)) --> - recompilation__usage__find_items_used_by_modes(Modes). + pred_or_func_mode(_, _, _, Modes, _, _, _, _), !Info) :- + recompilation__usage__find_items_used_by_modes(Modes, !Info). + +:- pred recompilation__usage__find_items_used_by_type_and_mode( + type_and_mode::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. + +recompilation__usage__find_items_used_by_type_and_mode(TypeAndMode, !Info) :- + ( + TypeAndMode = type_only(Type) + ; + TypeAndMode = type_and_mode(Type, Mode), + recompilation__usage__find_items_used_by_mode(Mode, !Info) + ), + recompilation__usage__find_items_used_by_type(Type, !Info). :- pred recompilation__usage__find_items_used_by_type_body(hlds_type_body::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__find_items_used_by_type_body(TypeBody) --> - { Ctors = TypeBody ^ du_type_ctors }, - list__foldl( - (pred(Ctor::in, in, out) is det --> - { Ctor = ctor(_, Constraints, _, CtorArgs) }, - recompilation__usage__find_items_used_by_class_constraints( - Constraints), - list__foldl( - (pred(CtorArg::in, in, out) is det --> - { CtorArg = _ - ArgType }, - recompilation__usage__find_items_used_by_type(ArgType) - ), CtorArgs) - ), Ctors). -recompilation__usage__find_items_used_by_type_body(eqv_type(Type)) --> - recompilation__usage__find_items_used_by_type(Type). -recompilation__usage__find_items_used_by_type_body(abstract_type(_)) --> []. -recompilation__usage__find_items_used_by_type_body(foreign_type(_)) --> []. +recompilation__usage__find_items_used_by_type_body(TypeBody, !Info) :- + Ctors = TypeBody ^ du_type_ctors, + list__foldl(recompilation__usage__find_items_used_by_ctor, Ctors, + !Info). +recompilation__usage__find_items_used_by_type_body(eqv_type(Type), !Info) :- + recompilation__usage__find_items_used_by_type(Type, !Info). +recompilation__usage__find_items_used_by_type_body(abstract_type(_), !Info). +recompilation__usage__find_items_used_by_type_body(foreign_type(_), !Info). % rafe: XXX Should we trace the representation type? -recompilation__usage__find_items_used_by_type_body(solver_type(_, _)) --> []. +recompilation__usage__find_items_used_by_type_body(solver_type(_, _), !Info). + +:- pred recompilation__usage__find_items_used_by_ctor(constructor::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. + +recompilation__usage__find_items_used_by_ctor(Ctor, !Info) :- + Ctor = ctor(_, Constraints, _, CtorArgs), + recompilation__usage__find_items_used_by_class_constraints(Constraints, + !Info), + list__foldl(recompilation__usage__find_items_used_by_ctor_arg, + CtorArgs, !Info). + +:- pred recompilation__usage__find_items_used_by_ctor_arg(constructor_arg::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. + +recompilation__usage__find_items_used_by_ctor_arg(CtorArg, !Info) :- + CtorArg = _ - ArgType, + recompilation__usage__find_items_used_by_type(ArgType, !Info). :- pred recompilation__usage__find_items_used_by_mode_defn(hlds_mode_defn::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. recompilation__usage__find_items_used_by_mode_defn( - hlds_mode_defn(_, _, eqv_mode(Mode), _, _)) --> - recompilation__usage__find_items_used_by_mode(Mode). + hlds_mode_defn(_, _, eqv_mode(Mode), _, _), !Info) :- + recompilation__usage__find_items_used_by_mode(Mode, !Info). :- pred recompilation__usage__find_items_used_by_inst_defn(hlds_inst_defn::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. recompilation__usage__find_items_used_by_inst_defn( - hlds_inst_defn(_, _, InstBody, _, _)) --> + hlds_inst_defn(_, _, InstBody, _, _), !Info) :- ( - { InstBody = eqv_inst(Inst) }, - recompilation__usage__find_items_used_by_inst(Inst) + InstBody = eqv_inst(Inst), + recompilation__usage__find_items_used_by_inst(Inst, !Info) ; - { InstBody = abstract_inst } + InstBody = abstract_inst ). :- pred recompilation__usage__find_items_used_by_preds(pred_or_func::in, - pred_or_func_set::in, recompilation_usage_info::in, - recompilation_usage_info::out) is det. + pred_or_func_set::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__find_items_used_by_preds(PredOrFunc, Set) --> +recompilation__usage__find_items_used_by_preds(PredOrFunc, Set, !Info) :- map__foldl( - (pred((Name - Arity)::in, MatchingPredMap::in, in, out) is det --> - map__foldl( - (pred(ModuleQualifier::in, _::in, in, out) is det --> - { SymName = module_qualify_name(ModuleQualifier, - Name) }, - recompilation__usage__record_used_pred_or_func( - PredOrFunc, SymName - Arity) - ), MatchingPredMap) - ), Set). + recompilation__usage__find_items_used_by_preds_2(PredOrFunc), + Set, !Info). + +:- pred recompilation__usage__find_items_used_by_preds_2(pred_or_func::in, + pair(string, arity)::in, map(module_qualifier, module_name)::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. + +recompilation__usage__find_items_used_by_preds_2(PredOrFunc, Name - Arity, + MatchingPredMap, !Info) :- + map__foldl(recompilation__usage__find_items_used_by_preds_3( + PredOrFunc, Name, Arity), MatchingPredMap, !Info). + +:- pred recompilation__usage__find_items_used_by_preds_3(pred_or_func::in, + string::in, arity::in, module_qualifier::in, module_name::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. + +recompilation__usage__find_items_used_by_preds_3(PredOrFunc, Name, Arity, + ModuleQualifier, _, !Info) :- + SymName = module_qualify_name(ModuleQualifier, Name), + recompilation__usage__record_used_pred_or_func(PredOrFunc, + SymName - Arity, !Info). :- pred recompilation__usage__find_items_used_by_pred(pred_or_func::in, pair(string, arity)::in, pair(pred_id, module_name)::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. recompilation__usage__find_items_used_by_pred(PredOrFunc, Name - Arity, - PredId - PredModule) --> - =(Info0), - { ItemType = pred_or_func_to_item_type(PredOrFunc) }, - ModuleInfo =^ module_info, - { module_info_pred_info(ModuleInfo, PredId, PredInfo) }, + PredId - PredModule, !Info) :- + ItemType = pred_or_func_to_item_type(PredOrFunc), + ModuleInfo = !.Info ^ module_info, + module_info_pred_info(ModuleInfo, PredId, PredInfo), ( - { ItemId = qualified(PredModule, Name) - Arity }, - { - recompilation__usage__item_is_recorded_used(Info0, + ItemId = qualified(PredModule, Name) - Arity, + ( + recompilation__usage__item_is_recorded_used(!.Info, ItemType, ItemId) ; - recompilation__usage__item_is_local(Info0, ItemId) - } + recompilation__usage__item_is_local(!.Info, ItemId) + ) -> % We've already recorded the items used by this predicate. - [] + true ; % % Items used by class methods are recorded when processing % the typeclass declaration. Make sure that is done. % - { pred_info_get_markers(PredInfo, Markers) }, - { check_marker(Markers, class_method) } + pred_info_get_markers(PredInfo, Markers), + check_marker(Markers, class_method) -> % % The typeclass for which the predicate is a method is the % first of the universal class constraints in the pred_info. % - { pred_info_get_class_context(PredInfo, MethodClassContext) }, - { MethodClassContext = constraints(MethodUnivConstraints, _) }, - { + pred_info_get_class_context(PredInfo, MethodClassContext), + MethodClassContext = constraints(MethodUnivConstraints, _), + ( MethodUnivConstraints = [constraint(ClassName0, ClassArgs) | _] -> @@ -1142,295 +1210,340 @@ recompilation__usage__find_items_used_by_pred(PredOrFunc, Name - Arity, ClassArity = list__length(ClassArgs) ; error("class method with no class constraints") - }, + ), recompilation__usage__maybe_record_item_to_process( - typeclass, ClassName - ClassArity) + typeclass, ClassName - ClassArity, !Info) ; - { NameArity = qualified(PredModule, Name) - Arity }, + NameArity = qualified(PredModule, Name) - Arity, recompilation__usage__record_expanded_items_used_by_item( - ItemType, NameArity), - recompilation__usage__record_imported_item(ItemType, NameArity), - { pred_info_arg_types(PredInfo, ArgTypes) }, - recompilation__usage__find_items_used_by_types(ArgTypes), - { pred_info_procedures(PredInfo, Procs) }, - map__foldl( - (pred(_::in, ProcInfo::in, in, out) is det --> - { proc_info_argmodes(ProcInfo, ArgModes) }, - recompilation__usage__find_items_used_by_modes( - ArgModes) - ), Procs), - { pred_info_get_class_context(PredInfo, ClassContext) }, + ItemType, NameArity, !Info), + recompilation__usage__record_imported_item(ItemType, NameArity, + !Info), + pred_info_arg_types(PredInfo, ArgTypes), + recompilation__usage__find_items_used_by_types(ArgTypes, + !Info), + pred_info_procedures(PredInfo, Procs), + map__foldl(find_items_used_by_proc_arg_modes, Procs, !Info), + pred_info_get_class_context(PredInfo, ClassContext), recompilation__usage__find_items_used_by_class_context( - ClassContext), + ClassContext, !Info), % % Record items used by `:- pragma type_spec' declarations. % - { module_info_type_spec_info(ModuleInfo, TypeSpecInfo) }, - { TypeSpecInfo = type_spec_info(_, _, _, PragmaMap) }, - ( { map__search(PragmaMap, PredId, TypeSpecPragmas) } -> - list__foldl( - recompilation__usage__find_items_used_by_type_spec, - TypeSpecPragmas) + module_info_type_spec_info(ModuleInfo, TypeSpecInfo), + TypeSpecInfo = type_spec_info(_, _, _, PragmaMap), + ( map__search(PragmaMap, PredId, TypeSpecPragmas) -> + list__foldl(find_items_used_by_type_spec, + TypeSpecPragmas, !Info) ; - [] + true ) ). +:- pred find_items_used_by_proc_arg_modes(proc_id::in, proc_info::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. + +find_items_used_by_proc_arg_modes(_ProcId, ProcInfo, !Info) :- + proc_info_argmodes(ProcInfo, ArgModes), + recompilation__usage__find_items_used_by_modes(ArgModes, !Info). + :- pred recompilation__usage__find_items_used_by_type_spec(pragma_type::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__find_items_used_by_type_spec(Pragma) --> - ( { Pragma = type_spec(_, _, _, _, MaybeModes, Subst, _, _) } -> - ( { MaybeModes = yes(Modes) } -> - recompilation__usage__find_items_used_by_modes(Modes) +recompilation__usage__find_items_used_by_type_spec(Pragma, !Info) :- + ( Pragma = type_spec(_, _, _, _, MaybeModes, Subst, _, _) -> + ( + MaybeModes = yes(Modes), + recompilation__usage__find_items_used_by_modes(Modes, + !Info) ; - [] + MaybeModes = no ), - { assoc_list__values(Subst, SubstTypes) }, - recompilation__usage__find_items_used_by_types(SubstTypes) + assoc_list__values(Subst, SubstTypes), + recompilation__usage__find_items_used_by_types(SubstTypes, + !Info) ; - { error( -"recompilation__usage__find_items_used_by_type_spec: unexpected pragma type") } + error("recompilation__usage__find_items_used_by_type_spec: " ++ + "unexpected pragma type") ). :- pred recompilation__usage__find_items_used_by_functors( - functor_set::in, recompilation_usage_info::in, - recompilation_usage_info::out) is det. + functor_set::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__find_items_used_by_functors(Set) --> - map__foldl( - (pred((Name - Arity)::in, MatchingCtorMap::in, in, out) is det --> - map__foldl( - (pred(Qualifier::in, _::in, in, out) is det --> - { SymName = module_qualify_name(Qualifier, Name) }, - recompilation__usage__record_used_functor( - SymName - Arity) - ), MatchingCtorMap) - ), Set). +recompilation__usage__find_items_used_by_functors(Set, !Info) :- + map__foldl(recompilation__usage__find_items_used_by_functors_2, + Set, !Info). + +:- pred recompilation__usage__find_items_used_by_functors_2( + pair(string, arity)::in, map(module_qualifier, module_name)::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. + +recompilation__usage__find_items_used_by_functors_2(Name - Arity, + MatchingCtorMap, !Info) :- + map__foldl(recompilation__usage__find_items_used_by_functors_3(Name, + Arity), MatchingCtorMap, !Info). + +:- pred recompilation__usage__find_items_used_by_functors_3( + string::in, arity::in, module_qualifier::in, module_name::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. + +recompilation__usage__find_items_used_by_functors_3(Name, Arity, + Qualifier, _, !Info) :- + SymName = module_qualify_name(Qualifier, Name), + recompilation__usage__record_used_functor(SymName - Arity, !Info). :- pred recompilation__usage__find_items_used_by_functor( string::in, arity::in, resolved_functor::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. recompilation__usage__find_items_used_by_functor(Name, _Arity, - pred_or_func(PredId, PredModule, PredOrFunc, PredArity)) --> + pred_or_func(PredId, PredModule, PredOrFunc, PredArity), + !Info) :- recompilation__usage__find_items_used_by_pred(PredOrFunc, - Name - PredArity, PredId - PredModule). + Name - PredArity, PredId - PredModule, !Info). recompilation__usage__find_items_used_by_functor(_, _, - constructor(TypeCtor)) --> - recompilation__usage__maybe_record_item_to_process(type_body, TypeCtor). -recompilation__usage__find_items_used_by_functor(_, _, field(TypeCtor, _)) --> - recompilation__usage__maybe_record_item_to_process(type_body, TypeCtor). + constructor(TypeCtor), !Info) :- + recompilation__usage__maybe_record_item_to_process(type_body, TypeCtor, + !Info). +recompilation__usage__find_items_used_by_functor(_, _, field(TypeCtor, _), + !Info) :- + recompilation__usage__maybe_record_item_to_process(type_body, TypeCtor, + !Info). :- pred recompilation__usage__find_items_used_by_simple_item_set( item_type::in, simple_item_set::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__find_items_used_by_simple_item_set(ItemType, Set) --> - map__foldl( - (pred((Name - Arity)::in, MatchingIdMap::in, in, out) is det --> - map__foldl( - (pred(_::in, Module::in, in, out) is det --> - recompilation__usage__maybe_record_item_to_process( - ItemType, qualified(Module, Name) - Arity) - ), MatchingIdMap) - ), Set). +recompilation__usage__find_items_used_by_simple_item_set(ItemType, Set, + !Info) :- + map__foldl(recompilation__usage__find_items_used_by_simple_item_set_2( + ItemType), Set, !Info). + +:- pred recompilation__usage__find_items_used_by_simple_item_set_2( + item_type::in, pair(string, arity)::in, + map(module_qualifier, module_name)::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. + +recompilation__usage__find_items_used_by_simple_item_set_2(ItemType, + Name - Arity, MatchingIdMap, !Info) :- + map__foldl(recompilation__usage__find_items_used_by_simple_item_set_3( + ItemType, Name, Arity), MatchingIdMap, !Info). + +:- pred recompilation__usage__find_items_used_by_simple_item_set_3( + item_type::in, string::in, arity::in, + module_qualifier::in, module_name::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. + +recompilation__usage__find_items_used_by_simple_item_set_3(ItemType, + Name, Arity, _, Module, !Info) :- + recompilation__usage__maybe_record_item_to_process(ItemType, + qualified(Module, Name) - Arity, !Info). :- pred recompilation__usage__find_items_used_by_types(list(type)::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__find_items_used_by_types(Types) --> - list__foldl(recompilation__usage__find_items_used_by_type, Types). +recompilation__usage__find_items_used_by_types(Types, !Info) :- + list__foldl(recompilation__usage__find_items_used_by_type, Types, + !Info). :- pred recompilation__usage__find_items_used_by_type((type)::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__find_items_used_by_type(Type) --> - ( - { type_to_ctor_and_args(Type, TypeCtor, TypeArgs) } - -> +recompilation__usage__find_items_used_by_type(Type, !Info) :- + ( type_to_ctor_and_args(Type, TypeCtor, TypeArgs) -> ( % Unqualified type-ids are builtin types. - { TypeCtor = qualified(_, _) - _ }, - \+ { type_ctor_is_higher_order(TypeCtor, _, _, _) } + TypeCtor = qualified(_, _) - _, + \+ type_ctor_is_higher_order(TypeCtor, _, _, _) -> recompilation__usage__maybe_record_item_to_process( - (type), TypeCtor) + (type), TypeCtor, !Info) ; - [] + true ), - recompilation__usage__find_items_used_by_types(TypeArgs) + recompilation__usage__find_items_used_by_types(TypeArgs, !Info) ; - [] + true ). :- pred recompilation__usage__find_items_used_by_modes(list(mode)::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__find_items_used_by_modes(Modes) --> - list__foldl(recompilation__usage__find_items_used_by_mode, Modes). +recompilation__usage__find_items_used_by_modes(Modes, !Info) :- + list__foldl(recompilation__usage__find_items_used_by_mode, Modes, + !Info). :- pred recompilation__usage__find_items_used_by_mode((mode)::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__find_items_used_by_mode((Inst1 -> Inst2)) --> - recompilation__usage__find_items_used_by_inst(Inst1), - recompilation__usage__find_items_used_by_inst(Inst2). +recompilation__usage__find_items_used_by_mode((Inst1 -> Inst2), !Info) :- + recompilation__usage__find_items_used_by_inst(Inst1, !Info), + recompilation__usage__find_items_used_by_inst(Inst2, !Info). recompilation__usage__find_items_used_by_mode( - user_defined_mode(ModeName, ArgInsts)) --> - { list__length(ArgInsts, ModeArity) }, + user_defined_mode(ModeName, ArgInsts), !Info) :- + list__length(ArgInsts, ModeArity), recompilation__usage__maybe_record_item_to_process((mode), - ModeName - ModeArity), - recompilation__usage__find_items_used_by_insts(ArgInsts). + ModeName - ModeArity, !Info), + recompilation__usage__find_items_used_by_insts(ArgInsts, !Info). :- pred recompilation__usage__find_items_used_by_insts(list(inst)::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__find_items_used_by_insts(Modes) --> - list__foldl(recompilation__usage__find_items_used_by_inst, Modes). +recompilation__usage__find_items_used_by_insts(Modes, !Info) :- + list__foldl(recompilation__usage__find_items_used_by_inst, Modes, + !Info). :- pred recompilation__usage__find_items_used_by_inst((inst)::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__find_items_used_by_inst(any(_)) --> []. -recompilation__usage__find_items_used_by_inst(free) --> []. -recompilation__usage__find_items_used_by_inst(free(_)) --> []. -recompilation__usage__find_items_used_by_inst(bound(_, BoundInsts)) --> - list__foldl( - (pred(BoundInst::in, in, out) is det --> - { BoundInst = functor(ConsId, ArgInsts) }, - ( { ConsId = cons(Name, Arity) } -> - recompilation__usage__record_used_functor( - Name - Arity) - ; - [] - ), - recompilation__usage__find_items_used_by_insts(ArgInsts) - ), BoundInsts). -recompilation__usage__find_items_used_by_inst(ground(_, GroundInstInfo)) --> +recompilation__usage__find_items_used_by_inst(any(_), !Info). +recompilation__usage__find_items_used_by_inst(free, !Info). +recompilation__usage__find_items_used_by_inst(free(_), !Info). +recompilation__usage__find_items_used_by_inst(bound(_, BoundInsts), !Info) :- + list__foldl(recompilation__usage__find_items_used_by_bound_inst, + BoundInsts, !Info). +recompilation__usage__find_items_used_by_inst(ground(_, GroundInstInfo), + !Info) :- ( - { GroundInstInfo = higher_order(pred_inst_info(_, Modes, _)) }, - recompilation__usage__find_items_used_by_modes(Modes) + GroundInstInfo = higher_order(pred_inst_info(_, Modes, _)), + recompilation__usage__find_items_used_by_modes(Modes, !Info) ; - { GroundInstInfo = none } + GroundInstInfo = none ). -recompilation__usage__find_items_used_by_inst(not_reached) --> []. -recompilation__usage__find_items_used_by_inst(inst_var(_)) --> []. -recompilation__usage__find_items_used_by_inst(constrained_inst_vars(_, Inst)) --> - recompilation__usage__find_items_used_by_inst(Inst). -recompilation__usage__find_items_used_by_inst(defined_inst(InstName)) --> - recompilation__usage__find_items_used_by_inst_name(InstName). +recompilation__usage__find_items_used_by_inst(not_reached, !Info). +recompilation__usage__find_items_used_by_inst(inst_var(_), !Info). +recompilation__usage__find_items_used_by_inst(constrained_inst_vars(_, Inst), + !Info) :- + recompilation__usage__find_items_used_by_inst(Inst, !Info). +recompilation__usage__find_items_used_by_inst(defined_inst(InstName), !Info) :- + recompilation__usage__find_items_used_by_inst_name(InstName, !Info). recompilation__usage__find_items_used_by_inst( - abstract_inst(Name, ArgInsts)) --> - { list__length(ArgInsts, Arity) }, + abstract_inst(Name, ArgInsts), !Info) :- + list__length(ArgInsts, Arity), recompilation__usage__maybe_record_item_to_process((inst), - Name - Arity), - recompilation__usage__find_items_used_by_insts(ArgInsts). + Name - Arity, !Info), + recompilation__usage__find_items_used_by_insts(ArgInsts, !Info). + +:- pred recompilation__usage__find_items_used_by_bound_inst(bound_inst::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. + +recompilation__usage__find_items_used_by_bound_inst(BoundInst, !Info) :- + BoundInst = functor(ConsId, ArgInsts), + ( ConsId = cons(Name, Arity) -> + recompilation__usage__record_used_functor(Name - Arity, !Info) + ; + true + ), + recompilation__usage__find_items_used_by_insts(ArgInsts, !Info). :- pred recompilation__usage__find_items_used_by_inst_name(inst_name::in, recompilation_usage_info::in, recompilation_usage_info::out) is det. recompilation__usage__find_items_used_by_inst_name( - user_inst(Name, ArgInsts)) --> - { list__length(ArgInsts, Arity) }, + user_inst(Name, ArgInsts), !Info) :- + list__length(ArgInsts, Arity), recompilation__usage__maybe_record_item_to_process((inst), - Name - Arity), - recompilation__usage__find_items_used_by_insts(ArgInsts). + Name - Arity, !Info), + recompilation__usage__find_items_used_by_insts(ArgInsts, !Info). recompilation__usage__find_items_used_by_inst_name( - merge_inst(Inst1, Inst2)) --> - recompilation__usage__find_items_used_by_inst(Inst1), - recompilation__usage__find_items_used_by_inst(Inst2). + merge_inst(Inst1, Inst2), !Info) :- + recompilation__usage__find_items_used_by_inst(Inst1, !Info), + recompilation__usage__find_items_used_by_inst(Inst2, !Info). recompilation__usage__find_items_used_by_inst_name( - unify_inst(_, Inst1, Inst2, _)) --> - recompilation__usage__find_items_used_by_inst(Inst1), - recompilation__usage__find_items_used_by_inst(Inst2). + unify_inst(_, Inst1, Inst2, _), !Info) :- + recompilation__usage__find_items_used_by_inst(Inst1, !Info), + recompilation__usage__find_items_used_by_inst(Inst2, !Info). recompilation__usage__find_items_used_by_inst_name( - ground_inst(InstName, _, _, _)) --> - recompilation__usage__find_items_used_by_inst_name(InstName). + ground_inst(InstName, _, _, _), !Info) :- + recompilation__usage__find_items_used_by_inst_name(InstName, !Info). recompilation__usage__find_items_used_by_inst_name( - any_inst(InstName, _, _, _)) --> - recompilation__usage__find_items_used_by_inst_name(InstName). -recompilation__usage__find_items_used_by_inst_name(shared_inst(InstName)) --> - recompilation__usage__find_items_used_by_inst_name(InstName). + any_inst(InstName, _, _, _), !Info) :- + recompilation__usage__find_items_used_by_inst_name(InstName, !Info). +recompilation__usage__find_items_used_by_inst_name(shared_inst(InstName), + !Info) :- + recompilation__usage__find_items_used_by_inst_name(InstName, !Info). recompilation__usage__find_items_used_by_inst_name( - mostly_uniq_inst(InstName)) --> - recompilation__usage__find_items_used_by_inst_name(InstName). -recompilation__usage__find_items_used_by_inst_name(typed_ground(_, Type)) --> - recompilation__usage__find_items_used_by_type(Type). + mostly_uniq_inst(InstName), !Info) :- + recompilation__usage__find_items_used_by_inst_name(InstName, !Info). +recompilation__usage__find_items_used_by_inst_name(typed_ground(_, Type), + !Info) :- + recompilation__usage__find_items_used_by_type(Type, !Info). recompilation__usage__find_items_used_by_inst_name( - typed_inst(Type, InstName)) --> - recompilation__usage__find_items_used_by_type(Type), - recompilation__usage__find_items_used_by_inst_name(InstName). + typed_inst(Type, InstName), !Info) :- + recompilation__usage__find_items_used_by_type(Type, !Info), + recompilation__usage__find_items_used_by_inst_name(InstName, !Info). :- pred recompilation__usage__find_items_used_by_class_context( - class_constraints::in, recompilation_usage_info::in, - recompilation_usage_info::out) is det. + class_constraints::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. recompilation__usage__find_items_used_by_class_context( - constraints(Constraints1, Constraints2)) --> + constraints(Constraints1, Constraints2), !Info) :- recompilation__usage__find_items_used_by_class_constraints( - Constraints1), + Constraints1, !Info), recompilation__usage__find_items_used_by_class_constraints( - Constraints2). + Constraints2, !Info). :- pred recompilation__usage__find_items_used_by_class_constraints( - list(class_constraint)::in, recompilation_usage_info::in, - recompilation_usage_info::out) is det. + list(class_constraint)::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__find_items_used_by_class_constraints(Constraints) --> +recompilation__usage__find_items_used_by_class_constraints(Constraints, + !Info) :- list__foldl(recompilation__usage__find_items_used_by_class_constraint, - Constraints). + Constraints, !Info). :- pred recompilation__usage__find_items_used_by_class_constraint( - class_constraint::in, recompilation_usage_info::in, - recompilation_usage_info::out) is det. + class_constraint::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. recompilation__usage__find_items_used_by_class_constraint( - constraint(ClassName, ArgTypes)) --> - { ClassArity = list__length(ArgTypes) }, + constraint(ClassName, ArgTypes), !Info) :- + ClassArity = list__length(ArgTypes), recompilation__usage__maybe_record_item_to_process((typeclass), - ClassName - ClassArity), - recompilation__usage__find_items_used_by_types(ArgTypes). + ClassName - ClassArity, !Info), + recompilation__usage__find_items_used_by_types(ArgTypes, !Info). :- pred recompilation__usage__maybe_record_item_to_process(item_type::in, - pair(sym_name, arity)::in, recompilation_usage_info::in, - recompilation_usage_info::out) is det. + pair(sym_name, arity)::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__maybe_record_item_to_process(ItemType, NameArity) --> - ( { ItemType = (typeclass) } -> - Classes0 =^ used_typeclasses, - { set__insert(Classes0, NameArity, Classes) }, - ^ used_typeclasses := Classes +recompilation__usage__maybe_record_item_to_process(ItemType, NameArity, + !Info) :- + ( ItemType = (typeclass) -> + Classes0 = !.Info ^ used_typeclasses, + set__insert(Classes0, NameArity, Classes), + !:Info = !.Info ^ used_typeclasses := Classes ; - [] + true ), - =(Info), ( - { item_is_recorded_used(Info, ItemType, NameArity) } + item_is_recorded_used(!.Info, ItemType, NameArity) -> % This item has already been recorded. - [] + true ; - { item_is_local(Info, NameArity) } + item_is_local(!.Info, NameArity) -> % Ignore local items. The items used by them % have already been recorded by module_qual.m. - [] + true ; - Queue0 =^ item_queue, - { queue__put(Queue0, item_id(ItemType, NameArity), Queue) }, - ^ item_queue := Queue, + Queue0 = !.Info ^ item_queue, + queue__put(Queue0, item_id(ItemType, NameArity), Queue), + !:Info = !.Info ^ item_queue := Queue, - recompilation__usage__record_imported_item(ItemType, NameArity), + recompilation__usage__record_imported_item(ItemType, NameArity, + !Info), recompilation__usage__record_expanded_items_used_by_item( - ItemType, NameArity) + ItemType, NameArity, !Info) ). - :- pred item_is_recorded_used(recompilation_usage_info::in, item_type::in, - pair(sym_name, arity)::in) is semidet. + pair(sym_name, arity)::in) is semidet. item_is_recorded_used(Info, ItemType, NameArity) :- ImportedItems = Info ^ imported_items, @@ -1440,60 +1553,64 @@ item_is_recorded_used(Info, ItemType, NameArity) :- set__member(Name - Arity, ModuleItemIdSet). :- pred item_is_local(recompilation_usage_info::in, - pair(sym_name, arity)::in) is semidet. + pair(sym_name, arity)::in) is semidet. item_is_local(Info, NameArity) :- NameArity = qualified(ModuleName, _) - _, module_info_name(Info ^ module_info, ModuleName). :- pred recompilation__usage__record_imported_item(item_type::in, - pair(sym_name, arity)::in, recompilation_usage_info::in, - recompilation_usage_info::out) is det. + pair(sym_name, arity)::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__record_imported_item(ItemType, SymName - Arity) --> - { SymName = qualified(Module0, Name0) -> +recompilation__usage__record_imported_item(ItemType, SymName - Arity, !Info) :- + ( SymName = qualified(Module0, Name0) -> Module = Module0, Name = Name0 ; - error( -"recompilation__usage__maybe_record_item_to_process: unqualified item") - }, + error("recompilation__usage__maybe_record_item_to_process: " ++ + "unqualified item") + ), - ImportedItems0 =^ imported_items, - { map__search(ImportedItems0, Module, ModuleItems0) -> + ImportedItems0 = !.Info ^ imported_items, + ( map__search(ImportedItems0, Module, ModuleItems0) -> ModuleItems1 = ModuleItems0 ; ModuleItems1 = init_item_id_set(set__init) - }, - { ModuleItemIds0 = extract_ids(ModuleItems1, ItemType) }, - { set__insert(ModuleItemIds0, Name - Arity, ModuleItemIds) }, - { ModuleItems = update_ids(ModuleItems1, ItemType, ModuleItemIds) }, - { map__set(ImportedItems0, Module, ModuleItems, ImportedItems) }, - ^ imported_items := ImportedItems. + ), + ModuleItemIds0 = extract_ids(ModuleItems1, ItemType), + set__insert(ModuleItemIds0, Name - Arity, ModuleItemIds), + ModuleItems = update_ids(ModuleItems1, ItemType, ModuleItemIds), + map__set(ImportedItems0, Module, ModuleItems, ImportedItems), + !:Info = !.Info ^ imported_items := ImportedItems. % Uses of equivalence types have been expanded away by equiv_type.m. % equiv_type.m records which equivalence types were used by each % imported item. :- pred recompilation__usage__record_expanded_items_used_by_item( - item_type::in, item_name::in, recompilation_usage_info::in, - recompilation_usage_info::out) is det. + item_type::in, item_name::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. -recompilation__usage__record_expanded_items_used_by_item(ItemType, - NameArity) --> - Dependencies =^ dependencies, +recompilation__usage__record_expanded_items_used_by_item(ItemType, NameArity, + !Info) :- + Dependencies = !.Info ^ dependencies, ( - { map__search(Dependencies, item_id(ItemType, NameArity), - EquivTypes) } + map__search(Dependencies, item_id(ItemType, NameArity), + EquivTypes) -> - list__foldl( - (pred(Item::in, in, out) is det --> - { Item = item_id(DepItemType, DepItemId) }, - recompilation__usage__maybe_record_item_to_process( - DepItemType, DepItemId) - ), set__to_sorted_list(EquivTypes)) + list__foldl(record_expanded_items_used_by_item_2, + set__to_sorted_list(EquivTypes), !Info) ; - [] + true ). +:- pred record_expanded_items_used_by_item_2(item_id::in, + recompilation_usage_info::in, recompilation_usage_info::out) is det. + +record_expanded_items_used_by_item_2(Item, !Info) :- + Item = item_id(DepItemType, DepItemId), + recompilation__usage__maybe_record_item_to_process(DepItemType, + DepItemId, !Info). + %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% diff --git a/compiler/recompilation.version.m b/compiler/recompilation.version.m index ca1067d88..edf163010 100644 --- a/compiler/recompilation.version.m +++ b/compiler/recompilation.version.m @@ -24,7 +24,7 @@ item_list::in, maybe(item_list)::in, version_numbers::out) is det. :- pred recompilation__version__write_version_numbers(version_numbers::in, - io__state::di, io__state::uo) is det. + io::di, io::uo) is det. :- pred recompilation__version__parse_version_numbers(term::in, maybe1(version_numbers)::out) is det. @@ -34,6 +34,7 @@ :- func version_numbers_version_number = int. %-----------------------------------------------------------------------------% + :- implementation. :- import_module check_hlds__mode_util. @@ -45,7 +46,6 @@ :- import_module assoc_list, bool, list, map, require, string, varset. - recompilation__version__compute_version_numbers(SourceFileTime, Items, MaybeOldItems, version_numbers(ItemVersionNumbers, InstanceVersionNumbers)) :- @@ -59,7 +59,7 @@ recompilation__version__compute_version_numbers(SourceFileTime, Items, version_numbers(_, OldVersionNumbers)) - _ -> OldVersionNumbers = version_numbers(OldItemVersionNumbers, - OldInstanceVersionNumbers), + OldInstanceVersionNumbers), recompilation__version__gather_items(implementation, OldItems, GatheredOldItems, OldInstanceItems) ; @@ -86,28 +86,35 @@ recompilation__version__compute_version_numbers(SourceFileTime, Items, recompilation__version__compute_item_version_numbers(SourceFileTime, GatheredItems, GatheredOldItems, OldVersionNumbers, VersionNumbers) :- - VersionNumbers = map_ids( - (func(ItemType, Items0) = - map__map_values( - (func(NameArity, Items) = VersionNumber :- - OldIds = extract_ids(GatheredOldItems, ItemType), - ( - map__search(OldIds, NameArity, OldItems), - items_are_unchanged(OldItems, Items), - map__search( - extract_ids(OldVersionNumbers, ItemType), - NameArity, OldVersionNumber) - -> - VersionNumber = OldVersionNumber - ; - VersionNumber = SourceFileTime - ) - ), - Items0 - ) - ), - GatheredItems, - map__init + VersionNumbers = map_ids(compute_item_version_numbers_2(SourceFileTime, + GatheredOldItems, OldVersionNumbers), GatheredItems, map__init). + +:- func compute_item_version_numbers_2(timestamp, gathered_items, + item_version_numbers, item_type, + map(pair(string, arity), assoc_list(section, item_and_context))) + = map(pair(string, arity), timestamp). + +compute_item_version_numbers_2(SourceFileTime, GatheredOldItems, + OldVersionNumbers, ItemType, Items0) = + map__map_values(compute_item_version_numbers_3(SourceFileTime, + GatheredOldItems, OldVersionNumbers, ItemType), Items0). + +:- func compute_item_version_numbers_3(timestamp, gathered_items, + item_version_numbers, item_type, pair(string, arity), + assoc_list(section, item_and_context)) = timestamp. + +compute_item_version_numbers_3(SourceFileTime, GatheredOldItems, + OldVersionNumbers, ItemType, NameArity, Items) = + ( + OldIds = extract_ids(GatheredOldItems, ItemType), + map__search(OldIds, NameArity, OldItems), + items_are_unchanged(OldItems, Items), + map__search(extract_ids(OldVersionNumbers, ItemType), + NameArity, OldVersionNumber) + -> + OldVersionNumber + ; + SourceFileTime ). :- pred recompilation__version__compute_instance_version_numbers(timestamp::in, @@ -117,33 +124,33 @@ recompilation__version__compute_item_version_numbers(SourceFileTime, recompilation__version__compute_instance_version_numbers(SourceFileTime, InstanceItems, OldInstanceItems, OldInstanceVersionNumbers, InstanceVersionNumbers) :- - InstanceVersionNumbers = - map__map_values( + InstanceVersionNumbers = map__map_values( (func(ClassId, Items) = VersionNumber :- - ( - map__search(OldInstanceItems, ClassId, OldItems), - items_are_unchanged(OldItems, Items), - map__search(OldInstanceVersionNumbers, ClassId, - OldVersionNumber) - -> - VersionNumber = OldVersionNumber - ; - VersionNumber = SourceFileTime - ) + ( + map__search(OldInstanceItems, ClassId, + OldItems), + items_are_unchanged(OldItems, Items), + map__search(OldInstanceVersionNumbers, ClassId, + OldVersionNumber) + -> + VersionNumber = OldVersionNumber + ; + VersionNumber = SourceFileTime + ) ), InstanceItems - ). + ). :- pred recompilation__version__gather_items(section::in, item_list::in, - gathered_items::out, instance_item_map::out) is det. + gathered_items::out, instance_item_map::out) is det. -recompilation__version__gather_items(Section, - Items, GatheredItems, Instances) :- +recompilation__version__gather_items(Section, Items, GatheredItems, + Instances) :- list__reverse(Items, RevItems), Info0 = gathered_item_info(init_item_id_set(map__init), - [], [], map__init), + [], [], map__init), list__foldl2(recompilation__version__gather_items_2, RevItems, - Section, _, Info0, Info1), + Section, _, Info0, Info1), % % Items which could appear in _OtherItems (those which aren't @@ -153,17 +160,17 @@ recompilation__version__gather_items(Section, % work with `--intermodule-optimization'. % Info1 = gathered_item_info(GatheredItems1, PragmaItems, - _OtherItems, Instances), + _OtherItems, Instances), list__reverse(PragmaItems, RevPragmaItems), list__foldl(distribute_pragma_items, RevPragmaItems, GatheredItems1, GatheredItems). :- pred distribute_pragma_items( - {maybe_pred_or_func_id, item_and_context, section}::in, - gathered_items::in, gathered_items::out) is det. + {maybe_pred_or_func_id, item_and_context, section}::in, + gathered_items::in, gathered_items::out) is det. distribute_pragma_items({ItemId, ItemAndContext, Section}, - GatheredItems0, GatheredItems) :- + !GatheredItems) :- ItemId = MaybePredOrFunc - SymName / Arity, ItemAndContext = Item - ItemContext, @@ -182,186 +189,193 @@ distribute_pragma_items({ItemId, ItemAndContext, Section}, recompilation__version__add_gathered_item(Item, item_id(ItemType, SymName - Arity), ItemContext, Section, AddIfNotExisting, - GatheredItems0, GatheredItems2) + !GatheredItems) ; MaybePredOrFunc = no, recompilation__version__add_gathered_item(Item, item_id(predicate, SymName - Arity), ItemContext, Section, AddIfNotExisting, - GatheredItems0, GatheredItems1), + !GatheredItems), recompilation__version__add_gathered_item(Item, item_id(function, SymName - Arity), ItemContext, Section, AddIfNotExisting, - GatheredItems1, GatheredItems2) + !GatheredItems) ), % Pragmas can apply to typeclass methods. - map__map_values( - (pred(_::in, ClassItems0::in, ClassItems::out) is det :- + map__map_values(distribute_pragma_items_class_items(MaybePredOrFunc, + SymName, Arity, ItemAndContext, Section), + extract_ids(!.GatheredItems, typeclass), GatheredTypeClasses), + !:GatheredItems = update_ids(!.GatheredItems, typeclass, + GatheredTypeClasses). + +:- pred distribute_pragma_items_class_items(maybe(pred_or_func)::in, + sym_name::in, arity::in, item_and_context::in, section::in, + pair(string, int)::in, + assoc_list(section, item_and_context)::in, + assoc_list(section, item_and_context)::out) is det. + +distribute_pragma_items_class_items(MaybePredOrFunc, SymName, Arity, + ItemAndContext, Section, _, !ClassItems) :- + ( + % Does this pragma match any of the methods + % of this class. + list__member(_ - ClassItem, !.ClassItems), + ClassItem = typeclass(_, _, _, Interface, _) - _, + Interface = concrete(Methods), + list__member(Method, Methods), + Method = pred_or_func(_, _, _, MethodPredOrFunc, SymName, + TypesAndModes, WithType, _, _, _, _, _, _), + ( MaybePredOrFunc = yes(MethodPredOrFunc) + ; MaybePredOrFunc = no + ), ( - % Does this pragma match any of the methods - % of this class. - list__member(_ - ClassItem, ClassItems0), - ClassItem = typeclass(_, _, _, Interface, _) - _, - Interface = concrete(Methods), - list__member(Method, Methods), - Method = pred_or_func(_, _, _, MethodPredOrFunc, - SymName, TypesAndModes, WithType, _, - _, _, _, _, _), - ( MaybePredOrFunc = yes(MethodPredOrFunc) - ; MaybePredOrFunc = no - ), - ( - WithType = no, - adjust_func_arity(MethodPredOrFunc, - Arity, list__length(TypesAndModes)) - ; - % We don't know the actual arity, so just - % match on the name and pred_or_func. - WithType = yes(_) - ) - -> - % XXX O(N^2), but shouldn't happen too often. - ClassItems = ClassItems0 ++ [Section - ItemAndContext] + WithType = no, + adjust_func_arity(MethodPredOrFunc, Arity, + list__length(TypesAndModes)) ; - ClassItems = ClassItems0 + % We don't know the actual arity, so just + % match on the name and pred_or_func. + WithType = yes(_) ) - ), extract_ids(GatheredItems2, typeclass), GatheredTypeClasses), - GatheredItems = update_ids(GatheredItems2, typeclass, - GatheredTypeClasses). + -> + % XXX O(N^2), but shouldn't happen too often. + !:ClassItems = !.ClassItems ++ [Section - ItemAndContext] + ; + true + ). :- type gathered_item_info ---> gathered_item_info( - gathered_items :: gathered_items, - pragma_items :: list({maybe_pred_or_func_id, + gathered_items :: gathered_items, + pragma_items :: list({maybe_pred_or_func_id, item_and_context, section}), - other_items :: item_list, - instances :: instance_item_map + other_items :: item_list, + instances :: instance_item_map ). :- type instance_item_map == - map(item_name, assoc_list(section, item_and_context)). + map(item_name, assoc_list(section, item_and_context)). % The constructors set should always be empty. :- type gathered_items == item_id_set(gathered_item_map). :- type gathered_item_map == map(pair(string, arity), - assoc_list(section, item_and_context)). + assoc_list(section, item_and_context)). :- pred recompilation__version__gather_items_2(item_and_context::in, - section::in, section::out, - gathered_item_info::in, gathered_item_info::out) is det. + section::in, section::out, + gathered_item_info::in, gathered_item_info::out) is det. -recompilation__version__gather_items_2(ItemAndContext, !Section) --> - { ItemAndContext = Item - ItemContext }, +recompilation__version__gather_items_2(ItemAndContext, !Section, !Info) :- + ItemAndContext = Item - ItemContext, ( - { Item = module_defn(_, interface) } + Item = module_defn(_, interface) -> - { !:Section = interface } + !:Section = interface ; - { Item = module_defn(_, implementation) } + Item = module_defn(_, implementation) -> - { !:Section = implementation } + !:Section = implementation ; - { Item = type_defn(VarSet, Name, Args, Body, Cond) } + Item = type_defn(VarSet, Name, Args, Body, Cond) -> ( - { Body = abstract_type(_) }, - { NameItem = Item }, + Body = abstract_type(_), + NameItem = Item, % The body of an abstract type can be recorded % as used when generating a call to the automatically % generated unification procedure. - { BodyItem = Item } + BodyItem = Item ; - { Body = du_type(_, _) }, - { NameItem = type_defn(VarSet, Name, Args, - abstract_type(non_solver_type), - Cond) }, - { BodyItem = Item } + Body = du_type(_, _), + NameItem = type_defn(VarSet, Name, Args, + abstract_type(non_solver_type), Cond), + BodyItem = Item ; - { Body = eqv_type(_) }, + Body = eqv_type(_), % When we use an equivalence type we % always use the body. - { NameItem = Item }, - { BodyItem = Item } + NameItem = Item, + BodyItem = Item ; - { Body = solver_type(_, _) }, - { NameItem = Item }, - { BodyItem = Item } + Body = solver_type(_, _), + NameItem = Item, + BodyItem = Item ; - { Body = foreign_type(_, _, _) }, - { NameItem = Item }, - { BodyItem = Item } + Body = foreign_type(_, _, _), + NameItem = Item, + BodyItem = Item ), - { TypeCtor = Name - list__length(Args) }, - GatheredItems0 =^ gathered_items, - { recompilation__version__add_gathered_item(NameItem, + TypeCtor = Name - list__length(Args), + GatheredItems0 = !.Info ^ gathered_items, + recompilation__version__add_gathered_item(NameItem, item_id((type), TypeCtor), ItemContext, !.Section, - yes, GatheredItems0, GatheredItems1) }, - { recompilation__version__add_gathered_item(BodyItem, + yes, GatheredItems0, GatheredItems1), + recompilation__version__add_gathered_item(BodyItem, item_id(type_body, TypeCtor), ItemContext, !.Section, - yes, GatheredItems1, GatheredItems) }, - ^ gathered_items := GatheredItems + yes, GatheredItems1, GatheredItems), + !:Info = !.Info ^ gathered_items := GatheredItems ; - { Item = instance(_, ClassName, ClassArgs, _, _, _) } + Item = instance(_, ClassName, ClassArgs, _, _, _) -> - Instances0 =^ instances, - { ClassArity = list__length(ClassArgs) }, + Instances0 = !.Info ^ instances, + ClassArity = list__length(ClassArgs), ( - { map__search(Instances0, ClassName - ClassArity, - InstanceItems0) } + map__search(Instances0, ClassName - ClassArity, + InstanceItems0) -> - { InstanceItems = InstanceItems0 } + InstanceItems = InstanceItems0 ; - { InstanceItems = [] } + InstanceItems = [] ), - { map__set(Instances0, ClassName - ClassArity, + map__set(Instances0, ClassName - ClassArity, [!.Section - (Item - ItemContext) | InstanceItems], - Instances) }, - ^ instances := Instances + Instances), + !:Info = !.Info ^ instances := Instances ; % For predicates or functions defined using `with_inst` % annotations the pred_or_func and arity here won't be % correct, but equiv_type.m will record the dependency % on the version number with the `incorrect' pred_or_func % and arity, so this will work. - { Item = pred_or_func_mode(_, MaybePredOrFunc, - SymName, Modes, WithInst, _, _) }, - { MaybePredOrFunc = no }, - { WithInst = yes(_) } + Item = pred_or_func_mode(_, MaybePredOrFunc, + SymName, Modes, WithInst, _, _), + MaybePredOrFunc = no, + WithInst = yes(_) -> - GatheredItems0 =^ gathered_items, - { ItemName = SymName - list__length(Modes) }, - { recompilation__version__add_gathered_item(Item, + GatheredItems0 = !.Info ^ gathered_items, + ItemName = SymName - list__length(Modes), + recompilation__version__add_gathered_item(Item, item_id(predicate, ItemName), ItemContext, !.Section, - yes, GatheredItems0, GatheredItems1) }, - { recompilation__version__add_gathered_item(Item, + yes, GatheredItems0, GatheredItems1), + recompilation__version__add_gathered_item(Item, item_id(function, ItemName), ItemContext, - !.Section, yes, GatheredItems1, GatheredItems) }, - ^ gathered_items := GatheredItems + !.Section, yes, GatheredItems1, GatheredItems), + !:Info = !.Info ^ gathered_items := GatheredItems ; - - { item_to_item_id(Item, ItemId) } + item_to_item_id(Item, ItemId) -> - GatheredItems0 =^ gathered_items, - { recompilation__version__add_gathered_item(Item, ItemId, + GatheredItems0 = !.Info ^ gathered_items, + recompilation__version__add_gathered_item(Item, ItemId, ItemContext, !.Section, yes, - GatheredItems0, GatheredItems) }, - ^ gathered_items := GatheredItems + GatheredItems0, GatheredItems), + !:Info = !.Info ^ gathered_items := GatheredItems ; - { Item = pragma(PragmaType) }, - { is_pred_pragma(PragmaType, yes(PredOrFuncId)) } + Item = pragma(PragmaType), + is_pred_pragma(PragmaType, yes(PredOrFuncId)) -> - PragmaItems =^ pragma_items, - ^ pragma_items := - [{PredOrFuncId, ItemAndContext, !.Section} | PragmaItems] + PragmaItems = !.Info ^ pragma_items, + !:Info = !.Info ^ pragma_items := + [{PredOrFuncId, ItemAndContext, !.Section} + | PragmaItems] ; - OtherItems =^ other_items, - ^ other_items := [ItemAndContext | OtherItems] + OtherItems = !.Info ^ other_items, + !:Info = !.Info ^ other_items := [ItemAndContext | OtherItems] ). :- pred recompilation__version__add_gathered_item(item::in, item_id::in, - prog_context::in, section::in, bool::in, gathered_items::in, - gathered_items::out) is det. + prog_context::in, section::in, bool::in, gathered_items::in, + gathered_items::out) is det. recompilation__version__add_gathered_item(Item, ItemId, ItemContext, Section, AddIfNotExisting, GatheredItems0, GatheredItems) :- @@ -439,10 +453,10 @@ recompilation__version__add_gathered_item_2(Item, ItemType, NameArity, TypeclassItem = typeclass(Constraints, ClassName, ClassArgs, concrete(Methods), ClassTVarSet), MatchingItems = [Section - (TypeclassItem - ItemContext) - | MatchingItems0] + | MatchingItems0] ; MatchingItems = [Section - (Item - ItemContext) - | MatchingItems0] + | MatchingItems0] ), IdMap0 = extract_ids(GatheredItems0, ItemType), @@ -516,7 +530,7 @@ item_to_item_id_2(mode_defn(_, Name, Params, _, _), item_to_item_id_2(module_defn(_, _), no). item_to_item_id_2(Item, yes(item_id(ItemType, SymName - Arity))) :- Item = pred_or_func(_, _, _, PredOrFunc, SymName, - TypesAndModes, WithType, _, _, _, _, _), + TypesAndModes, WithType, _, _, _, _, _), % For predicates or functions defined using `with_type` annotations % the arity here won't be correct, but equiv_type.m will record % the dependency on the version number with the `incorrect' arity, @@ -533,7 +547,7 @@ item_to_item_id_2(Item, yes(item_id(ItemType, SymName - Arity))) :- item_to_item_id_2(Item, ItemId) :- Item = pred_or_func_mode(_, MaybePredOrFunc, SymName, Modes, - _, _, _), + _, _, _), ( MaybePredOrFunc = yes(PredOrFunc) -> adjust_func_arity(PredOrFunc, Arity, list__length(Modes)), ItemType = pred_or_func_to_item_type(PredOrFunc), @@ -559,11 +573,10 @@ item_to_item_id_2(Item, yes(item_id((typeclass), ClassName - ClassArity))) :- item_to_item_id_2(instance(_, _, _, _, _, _), no). item_to_item_id_2(nothing(_), no). -:- type maybe_pred_or_func_id == - pair(maybe(pred_or_func), sym_name_and_arity). +:- type maybe_pred_or_func_id == pair(maybe(pred_or_func), sym_name_and_arity). -:- pred is_pred_pragma(pragma_type::in, - maybe(maybe_pred_or_func_id)::out) is det. +:- pred is_pred_pragma(pragma_type::in, maybe(maybe_pred_or_func_id)::out) + is det. is_pred_pragma(foreign_decl(_, _, _), no). is_pred_pragma(foreign_import_module(_, _), no). @@ -615,7 +628,7 @@ is_pred_pragma(check_termination(Name, Arity), yes(no - Name / Arity)). % It will never succeed when it shouldn't, so it will never % cause a necessary recompilation to be missed. :- pred items_are_unchanged(assoc_list(section, item_and_context)::in, - assoc_list(section, item_and_context)::in) is semidet. + assoc_list(section, item_and_context)::in) is semidet. items_are_unchanged([], []). items_are_unchanged([Section - (Item1 - _) | Items1], @@ -653,20 +666,20 @@ items_are_unchanged([Section - (Item1 - _) | Items1], :- func item_is_unchanged(item, item) = bool. item_is_unchanged(type_defn(_, Name, Args, Defn, Cond), Item2) = - ( Item2 = type_defn(_, Name, Args, Defn, Cond) -> yes ; no ). + ( Item2 = type_defn(_, Name, Args, Defn, Cond) -> yes ; no ). item_is_unchanged(mode_defn(_VarSet, Name, Args, Defn, Cond), Item2) = - ( Item2 = mode_defn(_, Name, Args, Defn, Cond) -> yes ; no ). + ( Item2 = mode_defn(_, Name, Args, Defn, Cond) -> yes ; no ). item_is_unchanged(inst_defn(_VarSet, Name, Args, Defn, Cond), Item2) = - ( Item2 = inst_defn(_, Name, Args, Defn, Cond) -> yes ; no ). + ( Item2 = inst_defn(_, Name, Args, Defn, Cond) -> yes ; no ). item_is_unchanged(module_defn(_VarSet, Defn), Item2) = - ( Item2 = module_defn(_, Defn) -> yes ; no ). + ( Item2 = module_defn(_, Defn) -> yes ; no ). item_is_unchanged(instance(Constraints, Name, Types, Body, _VarSet, Module), Item2) = - ( Item2 = instance(Constraints, Name, Types, Body, _, Module) -> - yes - ; - no - ). + ( Item2 = instance(Constraints, Name, Types, Body, _, Module) -> + yes + ; + no + ). % XXX Need to compare the goals properly in clauses and assertions. % That's not necessary at the moment because smart recompilation @@ -681,33 +694,36 @@ item_is_unchanged(promise(PromiseType, Goal, _, UnivVars), Item2) = % to find the corresponding variables in the predicate or % function type declaration. item_is_unchanged(pragma(PragmaType1), Item2) = Result :- - ( Item2 = pragma(PragmaType2) -> - ( - PragmaType1 = type_spec(Name, SpecName, Arity, MaybePredOrFunc, - MaybeModes, TypeSubst1, TVarSet1, _), - PragmaType2 = type_spec(Name, SpecName, Arity, MaybePredOrFunc, - MaybeModes, TypeSubst2, TVarSet2, _) - -> - assoc_list__keys_and_values(TypeSubst1, TVars1, Types1), - var_list_to_term_list(TVars1, TVarTypes1), - assoc_list__keys_and_values(TypeSubst2, TVars2, Types2), - var_list_to_term_list(TVars2, TVarTypes2), - ( - type_list_is_unchanged(TVarSet1, TVarTypes1 ++ Types1, - TVarSet2, TVarTypes2 ++ Types2, _, _, _) - -> - Result = yes - ; - Result = no - ) + ( Item2 = pragma(PragmaType2) -> + ( + PragmaType1 = type_spec(Name, SpecName, Arity, + MaybePredOrFunc, MaybeModes, TypeSubst1, + TVarSet1, _), + PragmaType2 = type_spec(Name, SpecName, Arity, + MaybePredOrFunc, MaybeModes, TypeSubst2, + TVarSet2, _) + -> + assoc_list__keys_and_values(TypeSubst1, TVars1, Types1), + var_list_to_term_list(TVars1, TVarTypes1), + assoc_list__keys_and_values(TypeSubst2, TVars2, Types2), + var_list_to_term_list(TVars2, TVarTypes2), + ( + type_list_is_unchanged( + TVarSet1, TVarTypes1 ++ Types1, + TVarSet2, TVarTypes2 ++ Types2, + _, _, _) + -> + Result = yes + ; + Result = no + ) + ; + Result = ( PragmaType1 = PragmaType2 -> yes ; no ) + ) ; - Result = ( PragmaType1 = PragmaType2 -> yes ; no ) - ) - ; - Result = no - ). -item_is_unchanged(nothing(A), Item2) = - ( Item2 = nothing(A) -> yes ; no ). + Result = no + ). +item_is_unchanged(nothing(A), Item2) = ( Item2 = nothing(A) -> yes ; no ). item_is_unchanged(Item1, Item2) = Result :- Item1 = pred_or_func(TVarSet1, _, ExistQVars1, PredOrFunc, @@ -716,8 +732,7 @@ item_is_unchanged(Item1, Item2) = Result :- ( Item2 = pred_or_func(TVarSet2, _, ExistQVars2, PredOrFunc, Name, TypesAndModes2, WithType2, - _, Det2, Cond, Purity, - Constraints2), + _, Det2, Cond, Purity, Constraints2), % For predicates, ignore the determinism -- the modes and % determinism should have been split into a separate @@ -758,7 +773,6 @@ item_is_unchanged(Item1, Item2) = Result :- Result = no ). - item_is_unchanged(Item1, Item2) = Result :- Item1 = typeclass(Constraints, Name, Vars, Interface1, _VarSet), ( @@ -800,8 +814,8 @@ pred_or_func_type_is_unchanged(TVarSet1, ExistQVars1, TypesAndModes1, % This should have been split out into a % separate mode declaration by gather_items. TypeAndMode0 = type_and_mode(_, _), - error( - "pred_or_func_type_matches: type_and_mode") + error("pred_or_func_type_matches: " ++ + "type_and_mode") ) ), Types1 = list__map(GetArgTypes, TypesAndModes1), @@ -843,8 +857,8 @@ pred_or_func_type_is_unchanged(TVarSet1, ExistQVars1, TypesAndModes1, Constraints1 = SubstConstraints2. :- pred type_list_is_unchanged(tvarset::in, list(type)::in, - tvarset::in, list(type)::in, tvarset::out, - tsubst::out, tsubst::out) is semidet. + tvarset::in, list(type)::in, tvarset::out, + tsubst::out, tsubst::out) is semidet. type_list_is_unchanged(TVarSet1, Types1, TVarSet2, Types2, TVarSet, RenameSubst, Types2ToTypes1Subst) :- @@ -866,44 +880,48 @@ type_list_is_unchanged(TVarSet1, Types1, TVarSet2, Types2, % created. % ( all [VarInItem1, VarInItem2] - ( - map__member(Types2ToTypes1Subst, VarInItem2, SubstTerm), ( - SubstTerm = term__variable(VarInItem1) - ; - % The reverse subsumption test above should - % ensure that the substitutions are all var->var. - SubstTerm = term__functor(_, _, _), - error("pred_or_func_type_matches: invalid subst") + map__member(Types2ToTypes1Subst, VarInItem2, SubstTerm), + ( + SubstTerm = term__variable(VarInItem1) + ; + % The reverse subsumption test above should + % ensure that the substitutions are all + % var->var. + SubstTerm = term__functor(_, _, _), + error("pred_or_func_type_matches: " ++ + "invalid subst") + ) ) - ) => - ( - varset__lookup_name(TVarSet, VarInItem1, VarName1), - varset__lookup_name(TVarSet, VarInItem2, VarName2), ( - VarName1 = VarName2 - ; - % - % Variables written to interface files are always - % named, even if the variable in the source code - % was not, so we can't just use varset__search_name - % to check whether the variables are named. - % - VarIsNotNamed = - (pred(VarName::in) is semidet :- - string__append("V_", VarNum, VarName), - string__to_int(VarNum, _) - ), - VarIsNotNamed(VarName1), - VarIsNotNamed(VarName2) + varset__lookup_name(TVarSet, VarInItem1, VarName1), + varset__lookup_name(TVarSet, VarInItem2, VarName2), + ( + VarName1 = VarName2 + ; + % + % Variables written to interface files are + % always named, even if the variable in the + % source code was not, so we can't just use + % varset__search_name to check whether the + % variables are named. + % + VarIsNotNamed = + (pred(VarName::in) is semidet :- + string__append("V_", VarNum, + VarName), + string__to_int(VarNum, _) + ), + VarIsNotNamed(VarName1), + VarIsNotNamed(VarName2) + ) ) - ) ). :- pred pred_or_func_mode_is_unchanged(inst_varset::in, list(mode)::in, - maybe(inst)::in, inst_varset::in, list(mode)::in, - maybe(inst)::in) is semidet. + maybe(inst)::in, inst_varset::in, list(mode)::in, + maybe(inst)::in) is semidet. pred_or_func_mode_is_unchanged(InstVarSet1, Modes1, MaybeWithInst1, InstVarSet2, Modes2, MaybeWithInst2) :- @@ -951,14 +969,14 @@ pred_or_func_mode_is_unchanged(InstVarSet1, Modes1, MaybeWithInst1, % from an interface file. % :- pred class_interface_is_unchanged(class_interface::in, - class_interface::in) is semidet. + class_interface::in) is semidet. class_interface_is_unchanged(abstract, abstract). class_interface_is_unchanged(concrete(Methods1), concrete(Methods2)) :- class_methods_are_unchanged(Methods1, Methods2). :- pred class_methods_are_unchanged(list(class_method)::in, - list(class_method)::in) is semidet. + list(class_method)::in) is semidet. class_methods_are_unchanged([], []). class_methods_are_unchanged([Method1 | Methods1], [Method2 | Methods2]) :- @@ -985,58 +1003,71 @@ class_methods_are_unchanged([Method1 | Methods1], [Method2 | Methods2]) :- %-----------------------------------------------------------------------------% -recompilation__version__write_version_numbers( - version_numbers(VersionNumbers, InstanceVersionNumbers)) --> - { VersionNumbersList = list__filter_map( +recompilation__version__write_version_numbers(AllVersionNumbers, !IO) :- + AllVersionNumbers = version_numbers(VersionNumbers, + InstanceVersionNumbers), + VersionNumbersList = list__filter_map( (func(ItemType) = (ItemType - ItemVersions) is semidet :- ItemVersions = extract_ids(VersionNumbers, ItemType), \+ map__is_empty(ItemVersions) ), [(type), type_body, (mode), (inst), - predicate, function, (typeclass)]) }, - io__write_string("{\n\t"), + predicate, function, (typeclass)]), + io__write_string("{\n\t", !IO), io__write_list(VersionNumbersList, ",\n\t", - (pred((ItemType - ItemVersions)::in, di, uo) is det --> - { string_to_item_type(ItemTypeStr, ItemType) }, - io__write_string(ItemTypeStr), - io__write_string("(\n\t\t"), - { map__to_assoc_list(ItemVersions, ItemVersionsList) }, - io__write_list(ItemVersionsList, ",\n\t\t", - (pred((NameArity - VersionNumber)::in, di, uo) is det --> - { NameArity = Name - Arity }, - mercury_output_bracketed_sym_name(unqualified(Name), - next_to_graphic_token), - io__write_string("/"), - io__write_int(Arity), - io__write_string(" - "), - write_version_number(VersionNumber) - )), - io__write_string("\n\t)") - )), - ( { map__is_empty(InstanceVersionNumbers) } -> - [] + write_item_type_and_versions, !IO), + ( map__is_empty(InstanceVersionNumbers) -> + true ; - ( { VersionNumbersList = [] } -> - [] + ( + VersionNumbersList = [] ; - io__write_string(",\n\t") + VersionNumbersList = [_ | _], + io__write_string(",\n\t", !IO) ), - io__write_string("instance("), - { map__to_assoc_list(InstanceVersionNumbers, InstanceAL) }, + io__write_string("instance(", !IO), + map__to_assoc_list(InstanceVersionNumbers, InstanceAL), io__write_list(InstanceAL, ",\n\n\t", - (pred((ClassNameArity - ClassVersionNumber)::in, - di, uo) is det --> - { ClassNameArity = ClassName - ClassArity }, - mercury_output_bracketed_sym_name(ClassName, - next_to_graphic_token), - io__write_string("/"), - io__write_int(ClassArity), - io__write_string(" - "), - write_version_number(ClassVersionNumber) - )), - io__write_string(")\n\t") + write_symname_arity_version_number, !IO), + io__write_string(")\n\t", !IO) ), - io__write_string("\n}"). + io__write_string("\n}", !IO). + +:- pred write_item_type_and_versions( + pair(item_type, map(pair(string, int), version_number))::in, + io::di, io::uo) is det. + +write_item_type_and_versions(ItemType - ItemVersions, !IO) :- + string_to_item_type(ItemTypeStr, ItemType), + io__write_string(ItemTypeStr, !IO), + io__write_string("(\n\t\t", !IO), + map__to_assoc_list(ItemVersions, ItemVersionsList), + io__write_list(ItemVersionsList, ",\n\t\t", + write_name_arity_version_number, !IO), + io__write_string("\n\t)", !IO). + +:- pred write_name_arity_version_number( + pair(pair(string, int), version_number)::in, io::di, io::uo) is det. + +write_name_arity_version_number(NameArity - VersionNumber, !IO) :- + NameArity = Name - Arity, + mercury_output_bracketed_sym_name(unqualified(Name), + next_to_graphic_token, !IO), + io__write_string("/", !IO), + io__write_int(Arity, !IO), + io__write_string(" - ", !IO), + write_version_number(VersionNumber, !IO). + +:- pred write_symname_arity_version_number( + pair(pair(sym_name, int), version_number)::in, io::di, io::uo) is det. + +write_symname_arity_version_number(SymNameArity - VersionNumber, !IO) :- + SymNameArity = SymName - Arity, + mercury_output_bracketed_sym_name(SymName, next_to_graphic_token, !IO), + io__write_string("/", !IO), + io__write_int(Arity, !IO), + io__write_string(" - ", !IO), + write_version_number(VersionNumber, !IO). %-----------------------------------------------------------------------------% @@ -1053,24 +1084,25 @@ parse_version_numbers(VersionNumbersTerm, Result) :- ; VersionNumbersTermList = [VersionNumbersTerm] ), - map_parser(parse_item_type_version_numbers, - VersionNumbersTermList, Result0), + map_parser(parse_item_type_version_numbers, VersionNumbersTermList, + Result0), ( Result0 = ok(List), VersionNumbers0 = version_numbers(init_item_id_set(map__init), - map__init), + map__init), VersionNumbers = list__foldl( - (func(VNResult, version_numbers(VNs0, Instances0)) = - version_numbers(VNs, Instances) :- - ( - VNResult = items(ItemType, ItemVNs), - VNs = update_ids(VNs0, ItemType, ItemVNs), - Instances = Instances0 - ; - VNResult = instances(Instances), - VNs = VNs0 - ) - ), List, VersionNumbers0), + (func(VNResult, version_numbers(VNs0, Instances0)) = + version_numbers(VNs, Instances) :- + ( + VNResult = items(ItemType, ItemVNs), + VNs = update_ids(VNs0, ItemType, + ItemVNs), + Instances = Instances0 + ; + VNResult = instances(Instances), + VNs = VNs0 + ) + ), List, VersionNumbers0), Result = ok(VersionNumbers) ; Result0 = error(A, B), @@ -1079,22 +1111,22 @@ parse_version_numbers(VersionNumbersTerm, Result) :- :- type item_version_numbers_result ---> items(item_type, version_number_map) - ; instances(instance_version_numbers) - . + ; instances(instance_version_numbers). :- pred parse_item_type_version_numbers(term::in, - maybe1(item_version_numbers_result)::out) is det. + maybe1(item_version_numbers_result)::out) is det. parse_item_type_version_numbers(Term, Result) :- ( - Term = term__functor(term__atom(ItemTypeStr), - ItemsVNsTerms, _), + Term = term__functor(term__atom(ItemTypeStr), ItemsVNsTerms, + _), string_to_item_type(ItemTypeStr, ItemType) -> ParseName = - (pred(NameTerm::in, Name::out) is semidet :- - NameTerm = term__functor(term__atom(Name), [], _) - ), + (pred(NameTerm::in, Name::out) is semidet :- + NameTerm = term__functor(term__atom(Name), [], + _) + ), map_parser(parse_item_version_number(ParseName), ItemsVNsTerms, Result0), ( @@ -1107,12 +1139,12 @@ parse_item_type_version_numbers(Term, Result) :- ) ; Term = term__functor(term__atom("instance"), - InstanceVNsTerms, _) + InstanceVNsTerms, _) -> ParseName = - (pred(NameTerm::in, Name::out) is semidet :- - sym_name_and_args(NameTerm, Name, []) - ), + (pred(NameTerm::in, Name::out) is semidet :- + sym_name_and_args(NameTerm, Name, []) + ), map_parser(parse_item_version_number(ParseName), InstanceVNsTerms, Result1), ( @@ -1124,8 +1156,7 @@ parse_item_type_version_numbers(Term, Result) :- Result = error(A, B) ) ; - Result = error("invalid item type version numbers", - Term) + Result = error("invalid item type version numbers", Term) ). :- pred parse_item_version_number(pred(term, T)::(pred(in, out) is semidet), diff --git a/compiler/transform.m b/compiler/transform.m index 92851c14e..27e97f2d8 100644 --- a/compiler/transform.m +++ b/compiler/transform.m @@ -60,7 +60,7 @@ transform__reschedule_conj([Goal0 | Goals0], Goals, !ModeInfo) :- mode_info_get_instmap(!.ModeInfo, InstMap0), mode_info_get_delay_info(!.ModeInfo, DelayInfo0), - delay_info__wakeup_goals(DelayInfo0, WokenGoals, DelayInfo1), + delay_info__wakeup_goals(WokenGoals, DelayInfo0, DelayInfo1), mode_info_set_delay_info(DelayInfo1, !ModeInfo), ( WokenGoals \= [] -> list__append(WokenGoals, [Goal0 | Goals0], Goals1), diff --git a/compiler/unique_modes.m b/compiler/unique_modes.m index 81f775859..948af0bf1 100644 --- a/compiler/unique_modes.m +++ b/compiler/unique_modes.m @@ -251,7 +251,7 @@ make_var_mostly_uniq(Var, !ModeInfo) :- ; Inst1 = any(unique) ) -> - make_mostly_uniq_inst(Inst0, ModuleInfo0, Inst, ModuleInfo), + make_mostly_uniq_inst(Inst0, Inst, ModuleInfo0, ModuleInfo), mode_info_set_module_info(ModuleInfo, !ModeInfo), instmap__set(InstMap0, Var, Inst, InstMap), mode_info_set_instmap(InstMap, !ModeInfo) @@ -732,8 +732,8 @@ unique_modes__check_par_conj_0(NonLocalVarsBag, !ModeInfo) :- mode_info_get_instmap(!.ModeInfo, InstMap0), instmap__lookup_vars(SharedList, InstMap0, VarInsts), mode_info_get_module_info(!.ModeInfo, ModuleInfo0), - make_shared_inst_list(VarInsts, ModuleInfo0, - SharedVarInsts, ModuleInfo1), + make_shared_inst_list(VarInsts, SharedVarInsts, + ModuleInfo0, ModuleInfo1), mode_info_set_module_info(ModuleInfo1, !ModeInfo), instmap__set_vars(InstMap0, SharedList, SharedVarInsts, InstMap1), mode_info_set_instmap(InstMap1, !ModeInfo).