[m-rev.] diff: cleanup a bunch of modules handling types
Zoltan Somogyi
zs at cs.mu.OZ.AU
Sun Dec 21 16:03:11 AEDT 2003
This diff makes several files easier to read and to maintain (as well as
more than 400 lines shorter), but contains no changes in algorithms whatsoever.
compiler/deep_profiling.m:
compiler/foreign.m:
compiler/hlds_module.m:
compiler/hlds_data.m:
compiler/make_hlds.m:
compiler/post_typecheck.m:
compiler/prog_data.m:
compiler/purity.m:
compiler/type_util.m:
Bring these modules into line with our current coding standards.
Use predmode declarations and state variable syntax when appropriate.
Reorder arguments of predicates where necessary for the use of state
variable syntax, and where this improves readability.
Replace predicates with functions where appropriate.
Standardize indentation.
compiler/*.m:
Conform to the changes above.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/accumulator.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/accumulator.m,v
retrieving revision 1.25
diff -u -b -r1.25 accumulator.m
--- compiler/accumulator.m 2 Dec 2003 09:16:50 -0000 1.25
+++ compiler/accumulator.m 20 Dec 2003 08:59:49 -0000
@@ -1569,9 +1569,8 @@
AccName = unqualified(pred_info_name(AccPredInfo)),
module_info_get_predicate_table(ModuleInfo0, PredTable0),
- predicate_table_insert(PredTable0, AccPredInfo, AccPredId, PredTable),
+ predicate_table_insert(AccPredInfo, AccPredId, PredTable0, PredTable),
module_info_set_predicate_table(PredTable, ModuleInfo0, ModuleInfo1),
-
create_goal(RecCallId, Accs, AccPredId, AccProcId, AccName, Substs,
HeadToCallSubst, CallToHeadSubst, BaseCase,
BasePairs, Sets, C, CS, OrigBaseGoal,
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.51
diff -u -b -r1.51 check_typeclass.m
--- compiler/check_typeclass.m 5 Nov 2003 03:17:34 -0000 1.51
+++ compiler/check_typeclass.m 20 Dec 2003 09:05:56 -0000
@@ -479,13 +479,11 @@
:- type modes_and_detism
---> modes_and_detism(list(mode), inst_varset, maybe(determinism)).
-:- pred check_instance_pred_procs(class_id, list(tvar), sym_name, pred_markers,
- hlds_instance_defn, hlds_instance_defn,
- instance_methods, instance_methods,
- instance_method_info, instance_method_info,
- io__state, io__state).
-:- mode check_instance_pred_procs(in, in, in, in, in, out,
- in, out, in, out, di, uo) is det.
+:- pred check_instance_pred_procs(class_id::in, list(tvar)::in, sym_name::in,
+ pred_markers::in, hlds_instance_defn::in, hlds_instance_defn::out,
+ instance_methods::in, instance_methods::out,
+ instance_method_info::in, instance_method_info::out,
+ io::di, io::uo) is det.
check_instance_pred_procs(ClassId, ClassVars, MethodName, Markers,
InstanceDefn0, InstanceDefn, OrderedInstanceMethods0,
@@ -648,15 +646,16 @@
).
:- pred pred_or_func_to_string(pred_or_func::in, string::out) is det.
+
pred_or_func_to_string(predicate, "predicate").
pred_or_func_to_string(function, "function").
-:- pred produce_auxiliary_procs(class_id, list(tvar), pred_markers, list(type),
- list(class_constraint), tvarset, module_name, instance_proc_def,
- prog_context, pred_id, list(proc_id), instance_method_info,
- instance_method_info, io__state, io__state).
-:- mode produce_auxiliary_procs(in, in, in, in, in, in, in, in, in, out, out,
- in, out, di, uo) is det.
+:- pred produce_auxiliary_procs(class_id::in, list(tvar)::in, pred_markers::in,
+ list(type)::in, list(class_constraint)::in, tvarset::in,
+ module_name::in, instance_proc_def::in, prog_context::in,
+ pred_id::out, list(proc_id)::out,
+ instance_method_info::in, instance_method_info::out,
+ io::di, io::uo) is det.
produce_auxiliary_procs(ClassId, ClassVars, Markers0,
InstanceTypes0, InstanceConstraints0, InstanceVarSet,
@@ -753,9 +752,9 @@
AddProc = (pred(ModeAndDet::in, NewProcId::out,
OldPredInfo::in, NewPredInfo::out) is det :-
ModeAndDet = modes_and_detism(Modes, InstVarSet, MaybeDet),
- add_new_proc(OldPredInfo, InstVarSet, PredArity, Modes,
- yes(Modes), no, MaybeDet, Context, address_is_taken,
- NewPredInfo, NewProcId)
+ add_new_proc(InstVarSet, PredArity, Modes, yes(Modes), no,
+ MaybeDet, Context, address_is_taken,
+ OldPredInfo, NewPredInfo, NewProcId)
),
list__map_foldl(AddProc, ArgModes, InstanceProcIds,
PredInfo2, PredInfo),
@@ -764,8 +763,8 @@
module_info_get_partial_qualifier_info(ModuleInfo1, PQInfo),
% XXX why do we need to pass may_be_unqualified here,
% rather than passing must_be_qualified or calling the /4 version?
- predicate_table_insert(PredicateTable1, PredInfo,
- may_be_unqualified, PQInfo, PredId, PredicateTable),
+ predicate_table_insert(PredInfo, may_be_unqualified, PQInfo,
+ PredId, PredicateTable1, PredicateTable),
module_info_set_predicate_table(PredicateTable,
ModuleInfo1, ModuleInfo),
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.38
diff -u -b -r1.38 clause_to_proc.m
--- compiler/clause_to_proc.m 31 Oct 2003 03:27:20 -0000 1.38
+++ compiler/clause_to_proc.m 20 Dec 2003 08:32:19 -0000
@@ -97,9 +97,10 @@
MaybePredArgLives = no,
varset__init(InstVarSet),
% No inst_vars in default func mode.
- add_new_proc(PredInfo0, InstVarSet, PredArity, PredArgModes,
+ add_new_proc(InstVarSet, PredArity, PredArgModes,
yes(PredArgModes), MaybePredArgLives, yes(Determinism),
- Context, address_is_not_taken, PredInfo, ProcId),
+ Context, address_is_not_taken, PredInfo0, PredInfo,
+ ProcId),
MaybeProcId = yes(ProcId)
;
PredInfo = PredInfo0,
@@ -218,7 +219,7 @@
\+ goal_info_is_pure(SubGoalInfo)
->
list__map(get_purity, GoalList, PurityList),
- list__foldl(worst_purity, PurityList, (pure), Purity),
+ Purity = list__foldl(worst_purity, PurityList, (pure)),
add_goal_info_purity_feature(GoalInfo2, Purity,
GoalInfo)
;
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.118
diff -u -b -r1.118 code_gen.m
--- compiler/code_gen.m 31 Oct 2003 03:27:20 -0000 1.118
+++ compiler/code_gen.m 18 Dec 2003 08:54:57 -0000
@@ -1162,12 +1162,13 @@
code_gen__generate_goal_2(foreign_proc(Attributes, PredId, ProcId,
Args, ArgNames, OrigArgTypes, PragmaCode),
GoalInfo, CodeModel, Code, !CI) :-
- ( foreign_language(Attributes, c) ->
+ ( c = foreign_language(Attributes) ->
pragma_c_gen__generate_pragma_c_code(CodeModel, Attributes,
PredId, ProcId, Args, ArgNames, OrigArgTypes,
GoalInfo, PragmaCode, Code, !CI)
;
- error("code_gen__generate_goal_2: foreign code other than C unexpected")
+ error("code_gen__generate_goal_2: " ++
+ "foreign code other than C unexpected")
).
code_gen__generate_goal_2(shorthand(_), _, _, _, !CI) :-
% these should have been expanded out by now
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.85
diff -u -b -r1.85 dead_proc_elim.m
--- compiler/dead_proc_elim.m 5 Nov 2003 03:17:36 -0000 1.85
+++ compiler/dead_proc_elim.m 20 Dec 2003 09:00:31 -0000
@@ -812,8 +812,8 @@
module_info_get_predicate_table(!.ModuleInfo, PredTable0),
module_info_get_partial_qualifier_info(!.ModuleInfo, PartialQualInfo),
- predicate_table_restrict(PartialQualInfo, PredTable0,
- set__to_sorted_list(NeededPreds), PredTable),
+ predicate_table_restrict(PartialQualInfo,
+ set__to_sorted_list(NeededPreds), PredTable0, PredTable),
module_info_set_predicate_table(PredTable, !ModuleInfo).
:- pred dead_pred_elim_add_entity(entity::in, queue(pred_id)::in,
Index: compiler/deep_profiling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deep_profiling.m,v
retrieving revision 1.21
diff -u -b -r1.21 deep_profiling.m
--- compiler/deep_profiling.m 31 Oct 2003 03:27:21 -0000 1.21
+++ compiler/deep_profiling.m 20 Dec 2003 08:45:33 -0000
@@ -70,7 +70,7 @@
(pred(MaybeProcStatic::in, ProcStatic::out) is semidet :-
MaybeProcStatic = yes(ProcStatic)
), MaybeProcStatics, ProcStatics),
- predicate_table_set_preds(PredTable0, PredMap, PredTable),
+ predicate_table_set_preds(PredMap, PredTable0, PredTable),
module_info_set_predicate_table(PredTable, !ModuleInfo).
%-----------------------------------------------------------------------------%
@@ -361,7 +361,7 @@
Goal = GoalExpr - GoalInfo,
(
GoalExpr = foreign_proc(Attrs, _, _, _, _, _, _),
- ( may_call_mercury(Attrs, may_call_mercury) ->
+ ( may_call_mercury(Attrs) = may_call_mercury ->
N = N0 + 1
;
N = N0
@@ -945,38 +945,40 @@
:- pred transform_goal(goal_path::in, hlds_goal::in, hlds_goal::out, bool::out,
deep_info::in, deep_info::out) is det.
-transform_goal(Path, conj(Goals0) - Info0, conj(Goals) - Info,
- AddedImpurity) -->
- transform_conj(0, Path, Goals0, Goals, AddedImpurity),
- { add_impurity_if_needed(AddedImpurity, Info0, Info) }.
-
-transform_goal(Path, par_conj(Goals0) - Info0,
- par_conj(Goals) - Info, AddedImpurity) -->
- transform_conj(0, Path, Goals0, Goals, AddedImpurity),
- { add_impurity_if_needed(AddedImpurity, Info0, Info) }.
+transform_goal(Path, conj(Goals0) - GoalInfo0, conj(Goals) - GoalInfo,
+ AddedImpurity, !DeepInfo) :-
+ transform_conj(0, Path, Goals0, Goals, AddedImpurity, !DeepInfo),
+ add_impurity_if_needed(AddedImpurity, GoalInfo0, GoalInfo).
+
+transform_goal(Path, par_conj(Goals0) - GoalInfo0,
+ par_conj(Goals) - GoalInfo, AddedImpurity, !DeepInfo) :-
+ transform_conj(0, Path, Goals0, Goals, AddedImpurity, !DeepInfo),
+ add_impurity_if_needed(AddedImpurity, GoalInfo0, GoalInfo).
-transform_goal(Path, switch(Var, CF, Cases0) - Info0,
- switch(Var, CF, Cases) - Info, AddedImpurity) -->
+transform_goal(Path, switch(Var, CF, Cases0) - GoalInfo0,
+ switch(Var, CF, Cases) - GoalInfo, AddedImpurity, !DeepInfo) :-
transform_switch(list__length(Cases0), 0, Path, Cases0, Cases,
- AddedImpurity),
- { add_impurity_if_needed(AddedImpurity, Info0, Info) }.
+ AddedImpurity, !DeepInfo),
+ add_impurity_if_needed(AddedImpurity, GoalInfo0, GoalInfo).
-transform_goal(Path, disj(Goals0) - Info0, disj(Goals) - Info,
- AddedImpurity) -->
- transform_disj(0, Path, Goals0, Goals, AddedImpurity),
- { add_impurity_if_needed(AddedImpurity, Info0, Info) }.
-
-transform_goal(Path, not(Goal0) - Info0, not(Goal) - Info, AddedImpurity) -->
- transform_goal([neg | Path], Goal0, Goal, AddedImpurity),
- { add_impurity_if_needed(AddedImpurity, Info0, Info) }.
-
-transform_goal(Path, some(QVars, CanRemove, Goal0) - Info0,
- some(QVars, CanRemove, Goal) - Info, AddedImpurity) -->
- { Goal0 = _ - InnerInfo },
- { goal_info_get_determinism(Info0, OuterDetism) },
- { goal_info_get_determinism(InnerInfo, InnerDetism) },
- { InnerDetism = OuterDetism ->
- Info1 = Info0,
+transform_goal(Path, disj(Goals0) - GoalInfo0, disj(Goals) - GoalInfo,
+ AddedImpurity, !DeepInfo) :-
+ transform_disj(0, Path, Goals0, Goals, AddedImpurity, !DeepInfo),
+ add_impurity_if_needed(AddedImpurity, GoalInfo0, GoalInfo).
+
+transform_goal(Path, not(Goal0) - GoalInfo0, not(Goal) - GoalInfo,
+ AddedImpurity, !DeepInfo) :-
+ transform_goal([neg | Path], Goal0, Goal, AddedImpurity, !DeepInfo),
+ add_impurity_if_needed(AddedImpurity, GoalInfo0, GoalInfo).
+
+transform_goal(Path, some(QVars, CanRemove, Goal0) - GoalInfo0,
+ some(QVars, CanRemove, Goal) - GoalInfo, AddedImpurity,
+ !DeepInfo) :-
+ Goal0 = _ - InnerInfo,
+ goal_info_get_determinism(GoalInfo0, OuterDetism),
+ goal_info_get_determinism(InnerInfo, InnerDetism),
+ ( InnerDetism = OuterDetism ->
+ GoalInfo1 = GoalInfo0,
MaybeCut = no_cut
;
% Given a subgoal containing both nondet code and impure code,
@@ -985,19 +987,23 @@
% subgoal inside the `some' contains nondet code, and the deep
% profiling transformation will make it impure as well.
- goal_info_add_feature(Info0, keep_this_commit, Info1),
+ goal_info_add_feature(GoalInfo0, keep_this_commit, GoalInfo1),
MaybeCut = cut
- },
- transform_goal([exist(MaybeCut) | Path], Goal0, Goal, AddedImpurity),
- { add_impurity_if_needed(AddedImpurity, Info1, Info) }.
-
-transform_goal(Path, if_then_else(IVars, Cond0, Then0, Else0) - Info0,
- if_then_else(IVars, Cond, Then, Else) - Info,
- AddedImpurity) -->
- transform_goal([ite_cond | Path], Cond0, Cond, AddedImpurityC),
- transform_goal([ite_then | Path], Then0, Then, AddedImpurityT),
- transform_goal([ite_else | Path], Else0, Else, AddedImpurityE),
- {
+ ),
+ transform_goal([exist(MaybeCut) | Path], Goal0, Goal, AddedImpurity,
+ !DeepInfo),
+ add_impurity_if_needed(AddedImpurity, GoalInfo1, GoalInfo).
+
+transform_goal(Path, if_then_else(IVars, Cond0, Then0, Else0) - GoalInfo0,
+ if_then_else(IVars, Cond, Then, Else) - GoalInfo,
+ AddedImpurity, !DeepInfo) :-
+ transform_goal([ite_cond | Path], Cond0, Cond, AddedImpurityC,
+ !DeepInfo),
+ transform_goal([ite_then | Path], Then0, Then, AddedImpurityT,
+ !DeepInfo),
+ transform_goal([ite_else | Path], Else0, Else, AddedImpurityE,
+ !DeepInfo),
+ (
( AddedImpurityC = yes
; AddedImpurityT = yes
; AddedImpurityE = yes
@@ -1006,94 +1012,101 @@
AddedImpurity = yes
;
AddedImpurity = no
- },
- { add_impurity_if_needed(AddedImpurity, Info0, Info) }.
+ ),
+ add_impurity_if_needed(AddedImpurity, GoalInfo0, GoalInfo).
-transform_goal(_, shorthand(_) - _, _, _) -->
- { error("transform_goal/6: shorthand should have gone by now") }.
+transform_goal(_, shorthand(_) - _, _, _, !DeepInfo) :-
+ error("transform_goal/6: shorthand should have gone by now").
-transform_goal(Path, Goal0 - Info0, GoalAndInfo, AddedImpurity) -->
- { Goal0 = foreign_proc(Attrs, _, _, _, _, _, _) },
- ( { may_call_mercury(Attrs, may_call_mercury) } ->
- wrap_foreign_code(Path, Goal0 - Info0, GoalAndInfo),
- { AddedImpurity = yes }
+transform_goal(Path, Goal0 - GoalInfo0, GoalAndInfo, AddedImpurity,
+ !DeepInfo) :-
+ Goal0 = foreign_proc(Attrs, _, _, _, _, _, _),
+ ( may_call_mercury(Attrs) = may_call_mercury ->
+ wrap_foreign_code(Path, Goal0 - GoalInfo0, GoalAndInfo,
+ !DeepInfo),
+ AddedImpurity = yes
;
- { GoalAndInfo = Goal0 - Info0 },
- { AddedImpurity = no }
+ GoalAndInfo = Goal0 - GoalInfo0,
+ AddedImpurity = no
).
-transform_goal(_Path, Goal - Info, Goal - Info, no) -->
- { Goal = unify(_, _, _, _, _) }.
+transform_goal(_Path, Goal - GoalInfo, Goal - GoalInfo, no, !DeepInfo) :-
+ Goal = unify(_, _, _, _, _).
-transform_goal(Path, Goal0 - Info0, GoalAndInfo, yes) -->
- { Goal0 = call(_, _, _, BuiltinState, _, _) },
- ( { BuiltinState \= inline_builtin } ->
- wrap_call(Path, Goal0 - Info0, GoalAndInfo)
+transform_goal(Path, Goal0 - GoalInfo0, GoalAndInfo, yes, !DeepInfo) :-
+ Goal0 = call(_, _, _, BuiltinState, _, _),
+ ( BuiltinState \= inline_builtin ->
+ wrap_call(Path, Goal0 - GoalInfo0, GoalAndInfo, !DeepInfo)
;
- { GoalAndInfo = Goal0 - Info0 }
+ GoalAndInfo = Goal0 - GoalInfo0
).
-transform_goal(Path, Goal0 - Info0, GoalAndInfo, AddedImpurity) -->
- { Goal0 = generic_call(GenericCall, _, _, _) },
+transform_goal(Path, Goal0 - GoalInfo0, GoalAndInfo, AddedImpurity,
+ !DeepInfo) :-
+ Goal0 = generic_call(GenericCall, _, _, _),
(
- { GenericCall = higher_order(_, _, _, _) },
- wrap_call(Path, Goal0 - Info0, GoalAndInfo),
- { AddedImpurity = yes }
- ;
- { GenericCall = class_method(_, _, _, _) },
- wrap_call(Path, Goal0 - Info0, GoalAndInfo),
- { AddedImpurity = yes }
- ;
- { GenericCall = unsafe_cast },
- { GoalAndInfo = Goal0 - Info0 },
- { AddedImpurity = no }
+ GenericCall = higher_order(_, _, _, _),
+ wrap_call(Path, Goal0 - GoalInfo0, GoalAndInfo, !DeepInfo),
+ AddedImpurity = yes
;
- { GenericCall = aditi_builtin(_, _) },
- { error("deep_profiling__transform_call: aditi_builtin") }
+ GenericCall = class_method(_, _, _, _),
+ wrap_call(Path, Goal0 - GoalInfo0, GoalAndInfo, !DeepInfo),
+ AddedImpurity = yes
+ ;
+ GenericCall = unsafe_cast,
+ GoalAndInfo = Goal0 - GoalInfo0,
+ AddedImpurity = no
+ ;
+ GenericCall = aditi_builtin(_, _),
+ error("deep_profiling__transform_call: aditi_builtin")
).
:- pred transform_conj(int::in, goal_path::in,
list(hlds_goal)::in, list(hlds_goal)::out, bool::out,
deep_info::in, deep_info::out) is det.
-transform_conj(_, _, [], [], no) --> [].
-transform_conj(N, Path, [Goal0 | Goals0], [Goal | Goals], AddedImpurity) -->
- { N1 = N + 1 },
- transform_goal([conj(N1) | Path], Goal0, Goal, AddedImpurityFirst),
- transform_conj(N1, Path, Goals0, Goals, AddedImpurityLater),
- { bool__or(AddedImpurityFirst, AddedImpurityLater, AddedImpurity) }.
+transform_conj(_, _, [], [], no, !DeepInfo).
+transform_conj(N, Path, [Goal0 | Goals0], [Goal | Goals], AddedImpurity,
+ !DeepInfo) :-
+ N1 = N + 1,
+ transform_goal([conj(N1) | Path], Goal0, Goal, AddedImpurityFirst,
+ !DeepInfo),
+ transform_conj(N1, Path, Goals0, Goals, AddedImpurityLater, !DeepInfo),
+ bool__or(AddedImpurityFirst, AddedImpurityLater, AddedImpurity).
:- pred transform_disj(int::in, goal_path::in,
list(hlds_goal)::in, list(hlds_goal)::out, bool::out,
deep_info::in, deep_info::out) is det.
-transform_disj(_, _, [], [], no) --> [].
-transform_disj(N, Path, [Goal0 | Goals0], [Goal | Goals], AddedImpurity) -->
- { N1 = N + 1 },
- transform_goal([disj(N1) | Path], Goal0, Goal, AddedImpurityFirst),
- transform_disj(N1, Path, Goals0, Goals, AddedImpurityLater),
- { bool__or(AddedImpurityFirst, AddedImpurityLater, AddedImpurity) }.
+transform_disj(_, _, [], [], no, !DeepInfo).
+transform_disj(N, Path, [Goal0 | Goals0], [Goal | Goals], AddedImpurity,
+ !DeepInfo) :-
+ N1 = N + 1,
+ transform_goal([disj(N1) | Path], Goal0, Goal, AddedImpurityFirst,
+ !DeepInfo),
+ transform_disj(N1, Path, Goals0, Goals, AddedImpurityLater, !DeepInfo),
+ bool__or(AddedImpurityFirst, AddedImpurityLater, AddedImpurity).
:- pred transform_switch(int::in, int::in, goal_path::in,
list(case)::in, list(case)::out, bool::out,
deep_info::in, deep_info::out) is det.
-transform_switch(_, _, _, [], [], no) --> [].
+transform_switch(_, _, _, [], [], no, !DeepInfo).
transform_switch(NumCases, N, Path, [case(Id, Goal0) | Goals0],
- [case(Id, Goal) | Goals], AddedImpurity) -->
- { N1 = N + 1 },
+ [case(Id, Goal) | Goals], AddedImpurity, !DeepInfo) :-
+ N1 = N + 1,
transform_goal([switch(NumCases, N1) | Path], Goal0, Goal,
- AddedImpurityFirst),
+ AddedImpurityFirst, !DeepInfo),
transform_switch(NumCases, N1, Path, Goals0, Goals,
- AddedImpurityLater),
- { bool__or(AddedImpurityFirst, AddedImpurityLater, AddedImpurity) }.
+ AddedImpurityLater, !DeepInfo),
+ bool__or(AddedImpurityFirst, AddedImpurityLater, AddedImpurity).
:- pred wrap_call(goal_path::in, hlds_goal::in, hlds_goal::out,
deep_info::in, deep_info::out) is det.
-wrap_call(GoalPath, Goal0, Goal, DeepInfo0, DeepInfo) :-
+wrap_call(GoalPath, Goal0, Goal, !DeepInfo) :-
Goal0 = GoalExpr - GoalInfo0,
- ModuleInfo = DeepInfo0 ^ module_info,
+ ModuleInfo = !.DeepInfo ^ module_info,
goal_info_get_features(GoalInfo0, GoalFeatures),
goal_info_remove_feature(GoalInfo0, tailcall, GoalInfo1),
goal_info_add_feature(GoalInfo1, impure, GoalInfo),
@@ -1108,20 +1121,20 @@
% call port code).
Goal1 = GoalExpr - GoalInfo,
- SiteNumCounter0 = DeepInfo0 ^ site_num_counter,
+ SiteNumCounter0 = !.DeepInfo ^ site_num_counter,
counter__allocate(SiteNum, SiteNumCounter0, SiteNumCounter),
- varset__new_named_var(DeepInfo0 ^ vars, "SiteNum", SiteNumVar, Vars1),
+ varset__new_named_var(!.DeepInfo ^ vars, "SiteNum", SiteNumVar, Vars1),
IntType = int_type,
- map__set(DeepInfo0 ^ var_types, SiteNumVar, IntType, VarTypes1),
+ map__set(!.DeepInfo ^ var_types, SiteNumVar, IntType, VarTypes1),
generate_unify(int_const(SiteNum), SiteNumVar, SiteNumVarGoal),
- DeepInfo1 = (((DeepInfo0 ^ vars := Vars1)
+ !:DeepInfo = (((!.DeepInfo ^ vars := Vars1)
^ var_types := VarTypes1)
^ site_num_counter := SiteNumCounter),
goal_info_get_context(GoalInfo0, Context),
FileName0 = term__context_file(Context),
LineNumber = term__context_line(Context),
- compress_filename(DeepInfo1, FileName0, FileName),
+ compress_filename(!.DeepInfo, FileName0, FileName),
classify_call(ModuleInfo, GoalExpr, CallKind),
(
CallKind = normal(PredProcId),
@@ -1133,12 +1146,12 @@
[SiteNumVar], [], PrepareGoal)
),
PredProcId = proc(PredId, ProcId),
- TypeSubst = compute_type_subst(GoalExpr, DeepInfo1),
- MaybeRecInfo = DeepInfo1 ^ maybe_rec_info,
+ TypeSubst = compute_type_subst(GoalExpr, !.DeepInfo),
+ MaybeRecInfo = !.DeepInfo ^ maybe_rec_info,
(
MaybeRecInfo = yes(RecInfo1),
RecInfo1 ^ role = inner_proc(OuterPredProcId),
- PredProcId = DeepInfo1 ^ pred_proc_id
+ PredProcId = !.DeepInfo ^ pred_proc_id
->
OuterPredProcId = proc(OuterPredId, OuterProcId),
RttiProcLabel = rtti__make_rtti_proc_label(ModuleInfo,
@@ -1148,7 +1161,7 @@
RecInfo2 ^ role = outer_proc(InnerPredProcId),
PredProcId = InnerPredProcId
->
- OuterPredProcId = DeepInfo1 ^ pred_proc_id,
+ OuterPredProcId = !.DeepInfo ^ pred_proc_id,
OuterPredProcId = proc(OuterPredId, OuterProcId),
RttiProcLabel = rtti__make_rtti_proc_label(ModuleInfo,
OuterPredId, OuterProcId)
@@ -1158,15 +1171,13 @@
),
CallSite = normal_call(RttiProcLabel, TypeSubst,
FileName, LineNumber, GoalPath),
- Goal2 = Goal1,
- DeepInfo3 = DeepInfo1
+ Goal2 = Goal1
;
CallKind = special(_PredProcId, TypeInfoVar),
generate_call(ModuleInfo, "prepare_for_special_call", 2,
[SiteNumVar, TypeInfoVar], [], PrepareGoal),
CallSite = special_call(FileName, LineNumber, GoalPath),
- Goal2 = Goal1,
- DeepInfo3 = DeepInfo1
+ Goal2 = Goal1
;
CallKind = generic(Generic),
(
@@ -1174,18 +1185,17 @@
generate_call(ModuleInfo, "prepare_for_ho_call", 2,
[SiteNumVar, ClosureVar], [], PrepareGoal),
CallSite = higher_order_call(FileName, LineNumber,
- GoalPath),
- DeepInfo2 = DeepInfo1
+ GoalPath)
;
Generic = class_method(TypeClassInfoVar, MethodNum,
_, _),
- varset__new_named_var(DeepInfo1 ^ vars, "MethodNum",
+ varset__new_named_var(!.DeepInfo ^ vars, "MethodNum",
MethodNumVar, Vars2),
- map__set(DeepInfo1 ^ var_types, MethodNumVar, IntType,
+ map__set(!.DeepInfo ^ var_types, MethodNumVar, IntType,
VarTypes2),
generate_unify(int_const(MethodNum), MethodNumVar,
MethodNumVarGoal),
- DeepInfo2 = ((DeepInfo1 ^ vars := Vars2)
+ !:DeepInfo = ((!.DeepInfo ^ vars := Vars2)
^ var_types := VarTypes2),
generate_call(ModuleInfo, "prepare_for_method_call", 3,
[SiteNumVar, TypeClassInfoVar, MethodNumVar],
@@ -1209,35 +1219,33 @@
use_zeroing_for_ho_cycles, UseZeroing),
( UseZeroing = yes ->
transform_higher_order_call(Globals, GoalCodeModel,
- Goal1, Goal2, DeepInfo2, DeepInfo3)
+ Goal1, Goal2, !DeepInfo)
;
- Goal2 = Goal1,
- DeepInfo3 = DeepInfo2
+ Goal2 = Goal1
)
),
- DeepInfo4 = DeepInfo3 ^ call_sites :=
- (DeepInfo3 ^ call_sites ++ [CallSite]),
+ !:DeepInfo = !.DeepInfo ^ call_sites :=
+ (!.DeepInfo ^ call_sites ++ [CallSite]),
(
set__member(tailcall, GoalFeatures),
- DeepInfo4 ^ maybe_rec_info = yes(RecInfo),
+ !.DeepInfo ^ maybe_rec_info = yes(RecInfo),
RecInfo ^ role = outer_proc(_)
->
VisSCC = RecInfo ^ visible_scc,
- MiddleCSD = DeepInfo4 ^ current_csd,
+ MiddleCSD = !.DeepInfo ^ current_csd,
(
VisSCC = [],
CallGoals = [],
ExitGoals = [],
FailGoals = [],
- SaveRestoreVars = [],
- DeepInfo = DeepInfo4
+ SaveRestoreVars = []
;
VisSCC = [SCCmember],
generate_recursion_counter_saves_and_restores(
SCCmember ^ rec_call_sites, MiddleCSD,
CallGoals, ExitGoals, FailGoals,
- SaveRestoreVars, DeepInfo4, DeepInfo)
+ SaveRestoreVars, !DeepInfo)
;
VisSCC = [_, _ | _],
error("wrap_call: multi-procedure SCCs not yet implemented")
@@ -1288,17 +1296,15 @@
SiteNumVarGoal,
PrepareGoal,
Goal2
- ]) - GoalInfo,
- DeepInfo = DeepInfo4
+ ]) - GoalInfo
).
:- pred transform_higher_order_call(globals::in, code_model::in,
hlds_goal::in, hlds_goal::out, deep_info::in, deep_info::out) is det.
-transform_higher_order_call(Globals, CodeModel, Goal0, Goal,
- DeepInfo0, DeepInfo) :-
- Vars0 = DeepInfo0 ^ vars,
- VarTypes0 = DeepInfo0 ^ var_types,
+transform_higher_order_call(Globals, CodeModel, Goal0, Goal, !DeepInfo) :-
+ Vars0 = !.DeepInfo ^ vars,
+ VarTypes0 = !.DeepInfo ^ var_types,
CPointerType = c_pointer_type,
varset__new_named_var(Vars0, "SavedPtr", SavedPtrVar, Vars1),
@@ -1314,35 +1320,35 @@
Vars),
map__set(VarTypes1, SavedCountVar, IntType, VarTypes),
- DeepInfo1 = DeepInfo0 ^ vars := Vars,
- DeepInfo = DeepInfo1 ^ var_types := VarTypes,
+ !:DeepInfo = !.DeepInfo ^ vars := Vars,
+ !:DeepInfo = !.DeepInfo ^ var_types := VarTypes,
ExtraNonLocals = set__list_to_set(
[SavedCountVar, SavedPtrVar]),
- generate_call(DeepInfo ^ module_info,
+ generate_call(!.DeepInfo ^ module_info,
"save_and_zero_activation_info_ac", 2,
[SavedCountVar, SavedPtrVar],
[SavedCountVar, SavedPtrVar], SaveStuff),
- generate_call(DeepInfo ^ module_info,
+ generate_call(!.DeepInfo ^ module_info,
"reset_activation_info_ac", 2,
[SavedCountVar, SavedPtrVar], [], RestoreStuff),
- generate_call(DeepInfo ^ module_info,
+ generate_call(!.DeepInfo ^ module_info,
"rezero_activation_info_ac", 0,
[], [], ReZeroStuff)
;
UseActivationCounts = no,
- DeepInfo1 = DeepInfo0 ^ vars := Vars1,
- DeepInfo = DeepInfo1 ^ var_types := VarTypes1,
+ !:DeepInfo = !.DeepInfo ^ vars := Vars1,
+ !:DeepInfo = !.DeepInfo ^ var_types := VarTypes1,
ExtraNonLocals = set__list_to_set([SavedPtrVar]),
- generate_call(DeepInfo ^ module_info,
+ generate_call(!.DeepInfo ^ module_info,
"save_and_zero_activation_info_sr", 1,
[SavedPtrVar], [SavedPtrVar], SaveStuff),
- generate_call(DeepInfo ^ module_info,
+ generate_call(!.DeepInfo ^ module_info,
"reset_activation_info_sr", 1,
[SavedPtrVar], [], RestoreStuff),
- generate_call(DeepInfo ^ module_info,
+ generate_call(!.DeepInfo ^ module_info,
"rezero_activation_info_sr", 0,
[], [], ReZeroStuff)
),
@@ -1414,14 +1420,14 @@
:- pred wrap_foreign_code(goal_path::in, hlds_goal::in, hlds_goal::out,
deep_info::in, deep_info::out) is det.
-wrap_foreign_code(GoalPath, Goal0, Goal, DeepInfo0, DeepInfo) :-
+wrap_foreign_code(GoalPath, Goal0, Goal, !DeepInfo) :-
Goal0 = _ - GoalInfo0,
- ModuleInfo = DeepInfo0 ^ module_info,
+ ModuleInfo = !.DeepInfo ^ module_info,
- SiteNumCounter0 = DeepInfo0 ^ site_num_counter,
+ SiteNumCounter0 = !.DeepInfo ^ site_num_counter,
counter__allocate(SiteNum, SiteNumCounter0, SiteNumCounter),
- varset__new_named_var(DeepInfo0 ^ vars, "SiteNum", SiteNumVar, Vars),
- map__set(DeepInfo0 ^ var_types, SiteNumVar, int_type, VarTypes),
+ varset__new_named_var(!.DeepInfo ^ vars, "SiteNum", SiteNumVar, Vars),
+ map__set(!.DeepInfo ^ var_types, SiteNumVar, int_type, VarTypes),
generate_unify(int_const(SiteNum), SiteNumVar, SiteNumVarGoal),
generate_call(ModuleInfo, "prepare_for_callback", 1,
@@ -1430,7 +1436,7 @@
goal_info_get_context(GoalInfo0, Context),
LineNumber = term__context_line(Context),
FileName0 = term__context_file(Context),
- compress_filename(DeepInfo0, FileName0, FileName),
+ compress_filename(!.DeepInfo, FileName0, FileName),
CallSite = callback(FileName, LineNumber, GoalPath),
goal_info_add_feature(GoalInfo0, impure, GoalInfo),
@@ -1439,10 +1445,10 @@
PrepareGoal,
Goal0
]) - GoalInfo,
- DeepInfo = ((((DeepInfo0 ^ site_num_counter := SiteNumCounter)
+ !:DeepInfo = ((((!.DeepInfo ^ site_num_counter := SiteNumCounter)
^ vars := Vars)
^ var_types := VarTypes)
- ^ call_sites := DeepInfo0 ^ call_sites ++ [CallSite]).
+ ^ call_sites := !.DeepInfo ^ call_sites ++ [CallSite]).
:- pred compress_filename(deep_info::in, string::in, string::out) is det.
@@ -1516,11 +1522,10 @@
deep_info::in, deep_info::out) is det.
generate_recursion_counter_saves_and_restores(CSNs, CSDVar, CallGoals,
- ExitGoals, FailGoals, ExtraVars, DeepInfo0, DeepInfo) :-
+ ExitGoals, FailGoals, ExtraVars, !DeepInfo) :-
list__chunk(CSNs, max_save_restore_vector_size, CSNChunks),
generate_recursion_counter_saves_and_restores_2(CSNChunks, CSDVar,
- CallGoals, ExitGoals, FailGoals, ExtraVars,
- DeepInfo0, DeepInfo).
+ CallGoals, ExitGoals, FailGoals, ExtraVars, !DeepInfo).
:- pred generate_recursion_counter_saves_and_restores_2(list(list(int))::in,
prog_var::in, list(hlds_goal)::out, list(hlds_goal)::out,
@@ -1528,24 +1533,22 @@
deep_info::in, deep_info::out) is det.
generate_recursion_counter_saves_and_restores_2([], _, [], [], [], [],
- DeepInfo, DeepInfo).
+ !DeepInfo).
generate_recursion_counter_saves_and_restores_2([Chunk | Chunks], CSDVar,
- CallGoals, ExitGoals, FailGoals, ExtraVars,
- DeepInfo0, DeepInfo) :-
+ CallGoals, ExitGoals, FailGoals, ExtraVars, !DeepInfo) :-
- list__map_foldl(generate_depth_var, Chunk, DepthVars,
- DeepInfo0, DeepInfo1),
+ list__map_foldl(generate_depth_var, Chunk, DepthVars, !DeepInfo),
% We generate three separate variables to hold the constant CSN vector.
% If we used only one, the code generator would have to save its value
% on the stack when we enter the disjunction that wraps the goal.
list__length(Chunk, Length),
generate_csn_vector(Length, Chunk, CallVars1, CallGoals1, CallCellVar,
- DeepInfo1, DeepInfo2),
+ !DeepInfo),
generate_csn_vector(Length, Chunk, ExitVars1, ExitGoals1, ExitCellVar,
- DeepInfo2, DeepInfo3),
+ !DeepInfo),
generate_csn_vector(Length, Chunk, FailVars1, FailGoals1, FailCellVar,
- DeepInfo3, DeepInfo4),
+ !DeepInfo),
list__condense([CallVars1, ExitVars1, FailVars1], ExtraVars1),
CallPredName = string__format("save_recursion_depth_%d",
@@ -1554,7 +1557,7 @@
[i(Length)]),
FailPredName = string__format("restore_recursion_depth_fail_%d",
[i(Length)]),
- ModuleInfo = DeepInfo4 ^ module_info,
+ ModuleInfo = !.DeepInfo ^ module_info,
generate_call(ModuleInfo, CallPredName, Length + 2,
[CSDVar, CallCellVar | DepthVars], DepthVars, CallCellGoal),
generate_call(ModuleInfo, ExitPredName, Length + 2,
@@ -1563,8 +1566,7 @@
[CSDVar, FailCellVar | DepthVars], [], FailCellGoal),
generate_recursion_counter_saves_and_restores_2(Chunks, CSDVar,
- CallGoals2, ExitGoals2, FailGoals2, ExtraVars2,
- DeepInfo4, DeepInfo),
+ CallGoals2, ExitGoals2, FailGoals2, ExtraVars2, !DeepInfo),
list__append(CallGoals1, [CallCellGoal | CallGoals2], CallGoals),
list__append(ExitGoals1, [ExitCellGoal | ExitGoals2], ExitGoals),
@@ -1574,24 +1576,22 @@
:- pred generate_depth_var(int::in, prog_var::out,
deep_info::in, deep_info::out) is det.
-generate_depth_var(CSN, DepthVar, DeepInfo0, DeepInfo) :-
- Vars0 = DeepInfo0 ^ vars,
- VarTypes0 = DeepInfo0 ^ var_types,
+generate_depth_var(CSN, DepthVar, !DeepInfo) :-
+ Vars0 = !.DeepInfo ^ vars,
+ VarTypes0 = !.DeepInfo ^ var_types,
IntType = int_type,
VarName = string__format("Depth%d", [i(CSN)]),
varset__new_named_var(Vars0, VarName, DepthVar, Vars),
map__set(VarTypes0, DepthVar, IntType, VarTypes),
- DeepInfo = (DeepInfo0 ^ vars := Vars) ^ var_types := VarTypes.
+ !:DeepInfo = (!.DeepInfo ^ vars := Vars) ^ var_types := VarTypes.
:- pred generate_csn_vector(int::in, list(int)::in, list(prog_var)::out,
list(hlds_goal)::out, prog_var::out,
deep_info::in, deep_info::out) is det.
-generate_csn_vector(Length, CSNs, CSNVars, UnifyGoals, CellVar,
- DeepInfo0, DeepInfo) :-
+generate_csn_vector(Length, CSNs, CSNVars, UnifyGoals, CellVar, !DeepInfo) :-
( CSNs = [CSN] ->
- generate_single_csn_unify(CSN, CSNVar - UnifyGoal,
- DeepInfo0, DeepInfo),
+ generate_single_csn_unify(CSN, CSNVar - UnifyGoal, !DeepInfo),
CSNVars = [CSNVar],
UnifyGoals = [UnifyGoal],
CellVar = CSNVar
@@ -1599,11 +1599,11 @@
require(Length =< max_save_restore_vector_size,
"generate_csn_vector_unifies: too long"),
list__map_foldl(generate_single_csn_unify, CSNs, CSNVarsGoals,
- DeepInfo0, DeepInfo1),
+ !DeepInfo),
InnerVars = assoc_list__keys(CSNVarsGoals),
InnerGoals = assoc_list__values(CSNVarsGoals),
generate_csn_vector_cell(Length, InnerVars, CellVar, CellGoal,
- DeepInfo1, DeepInfo),
+ !DeepInfo),
CSNVars = [CellVar | InnerVars],
UnifyGoals = list__append(InnerGoals, [CellGoal])
).
@@ -1611,30 +1611,29 @@
:- pred generate_csn_vector_cell(int::in, list(prog_var)::in,
prog_var::out, hlds_goal::out, deep_info::in, deep_info::out) is det.
-generate_csn_vector_cell(Length, CSNVars, CellVar, CellGoal,
- DeepInfo0, DeepInfo) :-
- Vars0 = DeepInfo0 ^ vars,
- VarTypes0 = DeepInfo0 ^ var_types,
+generate_csn_vector_cell(Length, CSNVars, CellVar, CellGoal, !DeepInfo) :-
+ Vars0 = !.DeepInfo ^ vars,
+ VarTypes0 = !.DeepInfo ^ var_types,
varset__new_named_var(Vars0, "CSNCell", CellVar, Vars),
mercury_profiling_builtin_module(ProfilingBuiltin),
CellTypeName = string__format("call_site_nums_%d", [i(Length)]),
CellTypeId = qualified(ProfilingBuiltin, CellTypeName) - Length,
construct_type(CellTypeId, [], CellType),
map__set(VarTypes0, CellVar, CellType, VarTypes),
- DeepInfo = (DeepInfo0 ^ vars := Vars) ^ var_types := VarTypes,
+ !:DeepInfo = (!.DeepInfo ^ vars := Vars) ^ var_types := VarTypes,
ConsId = cons(qualified(ProfilingBuiltin, CellTypeName), Length),
generate_cell_unify(Length, ConsId, CSNVars, CellVar, CellGoal).
:- pred generate_single_csn_unify(int::in,
pair(prog_var, hlds_goal)::out, deep_info::in, deep_info::out) is det.
-generate_single_csn_unify(CSN, CSNVar - UnifyGoal, DeepInfo0, DeepInfo) :-
- Vars0 = DeepInfo0 ^ vars,
- VarTypes0 = DeepInfo0 ^ var_types,
+generate_single_csn_unify(CSN, CSNVar - UnifyGoal, !DeepInfo) :-
+ Vars0 = !.DeepInfo ^ vars,
+ VarTypes0 = !.DeepInfo ^ var_types,
VarName = string__format("CSN%d", [i(CSN)]),
varset__new_named_var(Vars0, VarName, CSNVar, Vars),
map__set(VarTypes0, CSNVar, int_type, VarTypes),
- DeepInfo = (DeepInfo0 ^ vars := Vars) ^ var_types := VarTypes,
+ !:DeepInfo = (!.DeepInfo ^ vars := Vars) ^ var_types := VarTypes,
generate_unify(int_const(CSN), CSNVar, UnifyGoal).
:- pred generate_call(module_info::in, string::in, int::in,
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.35
diff -u -b -r1.35 deforest.m
--- compiler/deforest.m 28 Nov 2003 02:23:06 -0000 1.35
+++ compiler/deforest.m 18 Dec 2003 09:41:19 -0000
@@ -1680,7 +1680,7 @@
{ det_conjunction_detism(Detism0, Detism1, Detism) },
{ goal_list_purity([EarlierGoal | BetweenGoals], Purity0) },
{ infer_goal_info_purity(LaterInfo, Purity1) },
- { worst_purity(Purity0, Purity1, Purity) },
+ { worst_purity(Purity0, Purity1) = Purity },
{ goal_info_init(NonLocals, Delta, Detism, Purity, GoalInfo) },
{ Goal2 = GoalExpr - GoalInfo },
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.2
diff -u -b -r1.2 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m 18 Dec 2003 01:54:47 -0000 1.2
+++ compiler/equiv_type_hlds.m 20 Dec 2003 09:00:37 -0000
@@ -79,10 +79,9 @@
hlds_type_defn::in, hlds_type_defn::out,
maybe(recompilation_info)::in, maybe(recompilation_info)::out) is det.
-replace_in_type_defn(ModuleName, EqvMap, TypeCtor,
- Defn0, Defn, !MaybeRecompInfo) :-
- hlds_data__get_type_defn_tvarset(Defn0, TVarSet0),
- hlds_data__get_type_defn_body(Defn0, Body0),
+replace_in_type_defn(ModuleName, EqvMap, TypeCtor, !Defn, !MaybeRecompInfo) :-
+ hlds_data__get_type_defn_tvarset(!.Defn, TVarSet0),
+ hlds_data__get_type_defn_body(!.Defn, Body0),
equiv_type__maybe_record_expanded_items(ModuleName, fst(TypeCtor),
!.MaybeRecompInfo, EquivTypeInfo0),
(
@@ -109,8 +108,8 @@
equiv_type__finish_recording_expanded_items(
item_id(type_body, TypeCtor), EquivTypeInfo,
!MaybeRecompInfo),
- hlds_data__set_type_defn_body(Defn0, Body, Defn1),
- hlds_data__set_type_defn_tvarset(Defn1, TVarSet, Defn).
+ hlds_data__set_type_defn_body(Body, !Defn),
+ hlds_data__set_type_defn_tvarset(TVarSet, !Defn).
:- pred replace_in_inst_table(eqv_map::in,
inst_table::in, inst_table::out,
@@ -157,13 +156,12 @@
EqvMap, SharedInsts0, SharedInsts, !Cache),
replace_in_inst_table(replace_in_maybe_inst(EqvMap),
EqvMap, MostlyUniqInsts0, MostlyUniqInsts, !.Cache, _),
- inst_table_set_unify_insts(!.InstTable, UnifyInsts, !:InstTable),
- inst_table_set_merge_insts(!.InstTable, MergeInsts, !:InstTable),
- inst_table_set_ground_insts(!.InstTable, GroundInsts, !:InstTable),
- inst_table_set_any_insts(!.InstTable, AnyInsts, !:InstTable),
- inst_table_set_shared_insts(!.InstTable, SharedInsts, !:InstTable),
- inst_table_set_mostly_uniq_insts(!.InstTable,
- MostlyUniqInsts, !:InstTable).
+ inst_table_set_unify_insts(UnifyInsts, !InstTable),
+ inst_table_set_merge_insts(MergeInsts, !InstTable),
+ inst_table_set_ground_insts(GroundInsts, !InstTable),
+ inst_table_set_any_insts(AnyInsts, !InstTable),
+ inst_table_set_shared_insts(SharedInsts, !InstTable),
+ inst_table_set_mostly_uniq_insts(MostlyUniqInsts, !InstTable).
:- pred replace_in_inst_table(
pred(T, T, inst_cache, inst_cache)::(pred(in, out, in, out) is det),
Index: compiler/foreign.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.31
diff -u -b -r1.31 foreign.m
--- compiler/foreign.m 24 Oct 2003 06:17:37 -0000 1.31
+++ compiler/foreign.m 18 Dec 2003 09:14:07 -0000
@@ -88,7 +88,7 @@
% Does the implementation of the given foreign type body on
% the current backend use a user-defined comparison predicate.
-:- func foreign_type_body_has_user_defined_equality_pred(module_info,
+:- func foreign_type_body_has_user_defined_eq_comp_pred(module_info,
foreign_type_body) = unify_compare is semidet.
% Given the exported_type representation for a type,
@@ -112,36 +112,35 @@
% would return the module_name
% unqualified("module__cpp_code")
%
-:- func foreign__foreign_import_module_name(foreign_import_module) = module_name.
+:- func foreign__foreign_import_module_name(foreign_import_module)
+ = module_name.
% foreign__foreign_import_module_name(ForeignImport, CurrentModule)
%
% returns the module name needed to refer to ForeignImport from the
% CurrentModule.
%
-:- func foreign__foreign_import_module_name(foreign_import_module, module_name) =
- module_name.
+:- func foreign__foreign_import_module_name(foreign_import_module,
+ module_name) = module_name.
% Filter the decls for the given foreign language.
% The first return value is the list of matches, the second is
% the list of mis-matches.
-:- pred foreign__filter_decls(foreign_language, foreign_decl_info,
- foreign_decl_info, foreign_decl_info).
-:- mode foreign__filter_decls(in, in, out, out) is det.
+:- pred foreign__filter_decls(foreign_language::in, foreign_decl_info::in,
+ foreign_decl_info::out, foreign_decl_info::out) is det.
% Filter the module imports for the given foreign language.
% The first return value is the list of matches, the second is
% the list of mis-matches.
-:- pred foreign__filter_imports(foreign_language, foreign_import_module_info,
- foreign_import_module_info, foreign_import_module_info).
-:- mode foreign__filter_imports(in, in, out, out) is det.
+:- pred foreign__filter_imports(foreign_language::in,
+ foreign_import_module_info::in, foreign_import_module_info::out,
+ foreign_import_module_info::out) is det.
% Filter the bodys for the given foreign language.
% The first return value is the list of matches, the second is
% the list of mis-matches.
-:- pred foreign__filter_bodys(foreign_language, foreign_body_info,
- foreign_body_info, foreign_body_info).
-:- mode foreign__filter_bodys(in, in, out, out) is det.
+:- pred foreign__filter_bodys(foreign_language::in, foreign_body_info::in,
+ foreign_body_info::out, foreign_body_info::out) is det.
% Given some foreign code, generate some suitable proxy code for
% calling the code via one of the given languages.
@@ -154,14 +153,11 @@
% code.
% XXX This implementation is currently incomplete, so in future
% this interface may change.
-:- pred foreign__extrude_pragma_implementation(list(foreign_language),
- list(pragma_var), sym_name, pred_or_func, prog_context,
- module_info, pragma_foreign_proc_attributes,
- pragma_foreign_code_impl,
- module_info, pragma_foreign_proc_attributes,
- pragma_foreign_code_impl).
-:- mode foreign__extrude_pragma_implementation(in, in, in, in, in,
- in, in, in, out, out, out) is det.
+:- pred foreign__extrude_pragma_implementation(list(foreign_language)::in,
+ list(pragma_var)::in, sym_name::in, pred_or_func::in, prog_context::in,
+ module_info::in, module_info::out,
+ pragma_foreign_proc_attributes::in, pragma_foreign_proc_attributes::out,
+ pragma_foreign_code_impl::in, pragma_foreign_code_impl::out) is det.
% make_pragma_import turns pragma imports into pragma foreign_code.
% Given the pred and proc info for this predicate, the name
@@ -170,12 +166,10 @@
% which imports the foreign function, and return the varset,
% pragma_vars, argument types and other information about the
% generated predicate body.
-:- pred foreign__make_pragma_import(pred_info, proc_info, string, prog_context,
- module_info, pragma_foreign_code_impl, prog_varset,
- list(pragma_var), list(type), arity, pred_or_func).
-:- mode foreign__make_pragma_import(in, in, in, in, in,
- out, out, out, out, out, out) is det.
-
+:- pred foreign__make_pragma_import(pred_info::in, proc_info::in, string::in,
+ prog_context::in, module_info::in, pragma_foreign_code_impl::out,
+ prog_varset::out, list(pragma_var)::out, list(type)::out, arity::out,
+ pred_or_func::out) is det.
% It is possible that more than one foreign language could be used to
% implement a particular piece of code.
@@ -285,7 +279,6 @@
% foreign language, we should add it here.
prefer_foreign_language(_Globals, java, _Lang1, _Lang2) = no.
-
foreign__filter_decls(WantedLang, Decls0, LangDecls, NotLangDecls) :-
list__filter((pred(foreign_decl_code(Lang, _, _)::in) is semidet :-
WantedLang = Lang),
@@ -303,35 +296,31 @@
Bodys0, LangBodys, NotLangBodys).
foreign__extrude_pragma_implementation([], _PragmaVars,
- _PredName, _PredOrFunc, _Context, _ModuleInfo0, _Attributes, _Impl0,
- _ModuleInfo, _NewAttributes, _Impl) :-
+ _PredName, _PredOrFunc, _Context,
+ !ModuleInfo, !NewAttributes, !Impl) :-
unexpected(this_file, "no suitable target languages available").
% We just use the first target language for now, it might be nice
% to try a few others if the backend supports multiple ones.
foreign__extrude_pragma_implementation([TargetLang | TargetLangs],
_PragmaVars, _PredName, _PredOrFunc, _Context,
- ModuleInfo0, Attributes, Impl0,
- ModuleInfo, NewAttributes, Impl) :-
- foreign_language(Attributes, ForeignLanguage),
+ !ModuleInfo, !Attributes, !Impl) :-
+ ForeignLanguage = foreign_language(!.Attributes),
% If the foreign language is available as a target language,
% we don't need to do anything.
( list__member(ForeignLanguage, [TargetLang | TargetLangs]) ->
- Impl = Impl0,
- ModuleInfo = ModuleInfo0,
- NewAttributes = Attributes
+ true
;
- set_foreign_language(Attributes, TargetLang, NewAttributes),
+ set_foreign_language(TargetLang, !Attributes),
extrude_pragma_implementation_2(TargetLang, ForeignLanguage,
- ModuleInfo0, Impl0, ModuleInfo, Impl)
+ !ModuleInfo, !Impl)
).
-
:- pred extrude_pragma_implementation_2(
foreign_language::in, foreign_language::in,
- module_info::in, pragma_foreign_code_impl::in,
- module_info::out, pragma_foreign_code_impl::out) is det.
+ module_info::in, module_info::out,
+ pragma_foreign_code_impl::in, pragma_foreign_code_impl::out) is det.
% This isn't finished yet, and we probably won't implement it for C
% calling MC++. For C calling normal C++ we would generate a proxy
@@ -365,16 +354,14 @@
extrude_pragma_implementation_2(c, java, _, _, _, _) :-
unimplemented_combination(c, java).
-extrude_pragma_implementation_2(c, c, ModuleInfo, Impl, ModuleInfo, Impl).
-
+extrude_pragma_implementation_2(c, c, !ModuleInfo, !Impl).
% Don't do anything - C and MC++ are embedded inside MC++
% without any changes.
extrude_pragma_implementation_2(managed_cplusplus, managed_cplusplus,
- ModuleInfo, Impl, ModuleInfo, Impl).
+ !ModuleInfo, !Impl).
-extrude_pragma_implementation_2(managed_cplusplus, c,
- ModuleInfo, Impl, ModuleInfo, Impl).
+extrude_pragma_implementation_2(managed_cplusplus, c, !ModuleInfo, !Impl).
extrude_pragma_implementation_2(managed_cplusplus, csharp, _, _, _, _) :-
unimplemented_combination(managed_cplusplus, csharp).
@@ -385,9 +372,7 @@
extrude_pragma_implementation_2(managed_cplusplus, java, _, _, _, _) :-
unimplemented_combination(managed_cplusplus, java).
-
-extrude_pragma_implementation_2(csharp, csharp,
- ModuleInfo, Impl, ModuleInfo, Impl).
+extrude_pragma_implementation_2(csharp, csharp, !ModuleInfo, !Impl).
extrude_pragma_implementation_2(csharp, c, _, _, _, _) :-
unimplemented_combination(csharp, c).
@@ -401,8 +386,7 @@
extrude_pragma_implementation_2(csharp, java, _, _, _, _) :-
unimplemented_combination(csharp, java).
-extrude_pragma_implementation_2(il, il,
- ModuleInfo, Impl, ModuleInfo, Impl).
+extrude_pragma_implementation_2(il, il, !ModuleInfo, !Impl).
extrude_pragma_implementation_2(il, c, _, _, _, _) :-
unimplemented_combination(il, c).
@@ -416,9 +400,8 @@
extrude_pragma_implementation_2(il, java, _, _, _, _) :-
unimplemented_combination(il, java).
-
extrude_pragma_implementation_2(java, java,
- ModuleInfo, Impl, ModuleInfo, Impl).
+ !ModuleInfo, !Impl).
extrude_pragma_implementation_2(java, c, _, _, _, _) :-
unimplemented_combination(java, c).
@@ -439,15 +422,16 @@
error("unimplemented: calling " ++ foreign_language_string(Lang2)
++ " foreign code from " ++ foreign_language_string(Lang1)).
-
% XXX we haven't implemented these functions yet.
% What is here is only a guide
:- func make_pred_name(foreign_language, sym_name) = string.
+
make_pred_name(Lang, SymName) =
"mercury_" ++ simple_foreign_language_string(Lang) ++ "__" ++
make_pred_name_rest(Lang, SymName).
:- func make_pred_name_rest(foreign_language, sym_name) = string.
+
make_pred_name_rest(c, _SymName) = "some_c_name".
make_pred_name_rest(managed_cplusplus, qualified(ModuleSpec, Name)) =
make_pred_name_rest(managed_cplusplus, ModuleSpec) ++ "__" ++ Name.
@@ -456,7 +440,6 @@
make_pred_name_rest(il, _SymName) = "some_il_name".
make_pred_name_rest(java, _SymName) = "some_java_name".
-
make_pragma_import(PredInfo, ProcInfo, C_Function, Context,
ModuleInfo, PragmaImpl, VarSet, PragmaVars, ArgTypes,
Arity, PredOrFunc) :-
@@ -513,10 +496,9 @@
% Returns in Args all of Args0 that must be passed as arguments
% (i.e. all of them, or all of them except the return value).
%
-:- pred handle_return_value(code_model, pred_or_func,
- assoc_list(pragma_var, type), module_info,
- assoc_list(pragma_var, type), string).
-:- mode handle_return_value(in, in, in, in, out, out) is det.
+:- pred handle_return_value(code_model::in, pred_or_func::in,
+ assoc_list(pragma_var, type)::in, module_info::in,
+ assoc_list(pragma_var, type)::out, string::out) is det.
handle_return_value(CodeModel, PredOrFunc, Args0, ModuleInfo, Args, C_Code0) :-
( CodeModel = model_det,
@@ -556,8 +538,8 @@
% function. Fails if `Arg' has a type such as `io__state' that
% is just a dummy argument that should not be passed to C.
%
-:- pred include_import_arg(module_info, pair(pragma_var, type)).
-:- mode include_import_arg(in, in) is semidet.
+:- pred include_import_arg(module_info::in, pair(pragma_var, type)::in)
+ is semidet.
include_import_arg(ModuleInfo, pragma_var(_Var, _Name, Mode) - Type) :-
mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
@@ -570,11 +552,10 @@
% allocate names to all the variables, and
% construct a single list containing the variables, names, and modes.
%
-:- pred create_pragma_vars(list(prog_var), list(mode), int, list(pragma_var)).
-:- mode create_pragma_vars(in, in, in, out) is det.
+:- pred create_pragma_vars(list(prog_var)::in, list(mode)::in, int::in,
+ list(pragma_var)::out) is det.
create_pragma_vars([], [], _Num, []).
-
create_pragma_vars([Var|Vars], [Mode|Modes], ArgNum0,
[PragmaVar | PragmaVars]) :-
%
@@ -583,11 +564,8 @@
ArgNum = ArgNum0 + 1,
string__int_to_string(ArgNum, ArgNumString),
string__append("Arg", ArgNumString, ArgName),
-
PragmaVar = pragma_var(Var, ArgName, Mode),
-
create_pragma_vars(Vars, Modes, ArgNum, PragmaVars).
-
create_pragma_vars([_|_], [], _, _) :-
error("create_pragma_vars: length mis-match").
create_pragma_vars([], [_|_], _, _) :-
@@ -598,12 +576,10 @@
% This predicate creates the C code fragments for each argument
% in PragmaVars, and appends them to C_Code0, returning C_Code.
%
-:- pred create_pragma_import_c_code(list(pragma_var), module_info,
- string, string).
-:- mode create_pragma_import_c_code(in, in, in, out) is det.
+:- pred create_pragma_import_c_code(list(pragma_var)::in, module_info::in,
+ string::in, string::out) is det.
create_pragma_import_c_code([], _ModuleInfo, C_Code, C_Code).
-
create_pragma_import_c_code([PragmaVar | PragmaVars], ModuleInfo,
C_Code0, C_Code) :-
PragmaVar = pragma_var(_Var, ArgName, Mode),
@@ -648,7 +624,6 @@
foreign_language_file_extension(il) = _ :- fail.
foreign_language_module_name(M, L) = FM :-
-
% Only succeed if this language generates external files.
_ = foreign_language_file_extension(L),
@@ -685,9 +660,9 @@
->
hlds_data__get_type_defn_body(TypeDefn, Body),
( Body = foreign_type(ForeignTypeBody, _IsSolverType) ->
- ExportType = foreign(fst(
foreign_type_body_to_exported_type(ModuleInfo,
- ForeignTypeBody)))
+ ForeignTypeBody, ForeignTypeName, _),
+ ExportType = foreign(ForeignTypeName)
;
ExportType = mercury(Type)
)
@@ -695,16 +670,18 @@
ExportType = mercury(Type)
).
-foreign_type_body_has_user_defined_equality_pred(ModuleInfo, Body) =
+foreign_type_body_has_user_defined_eq_comp_pred(ModuleInfo, Body) =
UserEqComp :-
- yes(UserEqComp) =
- snd(foreign_type_body_to_exported_type(ModuleInfo, Body)).
-
-:- func foreign_type_body_to_exported_type(module_info, foreign_type_body) =
- pair(sym_name, maybe(unify_compare)).
+ foreign_type_body_to_exported_type(ModuleInfo, Body, _,
+ MaybeUserEqComp),
+ MaybeUserEqComp = yes(UserEqComp).
+
+:- pred foreign_type_body_to_exported_type(module_info::in,
+ foreign_type_body::in, sym_name::out, maybe(unify_compare)::out)
+ is det.
-foreign_type_body_to_exported_type(ModuleInfo, ForeignTypeBody) =
- Name - MaybeUserEqComp :-
+foreign_type_body_to_exported_type(ModuleInfo, ForeignTypeBody, Name,
+ MaybeUserEqComp) :-
ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava),
module_info_globals(ModuleInfo, Globals),
globals__get_target(Globals, Target),
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.92
diff -u -b -r1.92 goal_util.m
--- compiler/goal_util.m 28 Nov 2003 02:23:07 -0000 1.92
+++ compiler/goal_util.m 20 Dec 2003 08:27:09 -0000
@@ -952,7 +952,7 @@
goal_util__case_to_disjunct(Var, ConsId, CaseGoal, InstMap, Disjunct,
!VarSet, !VarTypes, !ModuleInfo) :-
- cons_id_arity(ConsId, ConsArity),
+ ConsArity = cons_id_arity(ConsId),
varset__new_vars(!.VarSet, ConsArity, ArgVars, !:VarSet),
map__lookup(!.VarTypes, Var, VarType),
type_util__get_cons_id_arg_types(!.ModuleInfo,
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.114
diff -u -b -r1.114 higher_order.m
--- compiler/higher_order.m 1 Dec 2003 15:55:35 -0000 1.114
+++ compiler/higher_order.m 20 Dec 2003 09:00:58 -0000
@@ -2517,7 +2517,7 @@
pred_info_set_typevarset(TypeVarSet, NewPredInfo0, NewPredInfo1),
module_info_get_predicate_table(ModuleInfo0, PredTable0),
- predicate_table_insert(PredTable0, NewPredInfo1, NewPredId, PredTable),
+ predicate_table_insert(NewPredInfo1, NewPredId, PredTable0, PredTable),
module_info_set_predicate_table(PredTable, ModuleInfo0, ModuleInfo1),
!:Info = !.Info ^ module_info := ModuleInfo1,
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.81
diff -u -b -r1.81 hlds_data.m
--- compiler/hlds_data.m 1 Dec 2003 15:55:36 -0000 1.81
+++ compiler/hlds_data.m 20 Dec 2003 07:26:54 -0000
@@ -122,8 +122,7 @@
%
:- type field_access_type
---> get
- ; set
- .
+ ; set.
%-----------------------------------------------------------------------------%
@@ -132,33 +131,29 @@
% Given a cons_id and a list of argument terms, convert it into a
% term. Fails if the cons_id is a pred_const, or type_ctor_info_const.
-:- pred cons_id_and_args_to_term(cons_id, list(term(T)), term(T)).
-:- mode cons_id_and_args_to_term(in, in, out) is semidet.
+:- pred cons_id_and_args_to_term(cons_id::in, list(term(T))::in, term(T)::out)
+ is semidet.
% Get the arity of a cons_id, aborting on pred_const and
% type_ctor_info_const.
-:- pred cons_id_arity(cons_id, arity).
-:- mode cons_id_arity(in, out) is det.
+:- func cons_id_arity(cons_id) = arity.
% Get the arity of a cons_id. Return a `no' on those cons_ids
% where cons_id_arity/2 would normally abort.
-:- pred cons_id_maybe_arity(cons_id, maybe(arity)).
-:- mode cons_id_maybe_arity(in, out) is det.
+:- func cons_id_maybe_arity(cons_id) = maybe(arity).
% The reverse conversion - make a cons_id for a functor.
% Given a const and an arity for the functor, create a cons_id.
-:- pred make_functor_cons_id(const, arity, cons_id).
-:- mode make_functor_cons_id(in, in, out) is det.
+:- func make_functor_cons_id(const, arity) = cons_id.
% Another way of making a cons_id from a functor.
% Given the name, argument types, and type_ctor of a functor,
% create a cons_id for that functor.
-:- pred make_cons_id(sym_name, list(constructor_arg), type_ctor, cons_id).
-:- mode make_cons_id(in, in, in, out) is det.
+:- func make_cons_id(sym_name, list(constructor_arg), type_ctor) = cons_id.
% Another way of making a cons_id from a functor.
% Given the name, argument types, and type_ctor of a functor,
@@ -169,8 +164,7 @@
% need the module qualification of the type, (b) it can compute the
% arity from any list of the right length.
-:- pred make_cons_id_from_qualified_sym_name(sym_name, list(_), cons_id).
-:- mode make_cons_id_from_qualified_sym_name(in, in, out) is det.
+:- func make_cons_id_from_qualified_sym_name(sym_name, list(_)) = cons_id.
%-----------------------------------------------------------------------------%
@@ -178,7 +172,7 @@
:- import_module parse_tree__prog_util.
-:- import_module require, varset.
+:- import_module string, require, varset.
cons_id_and_args_to_term(int_const(Int), [], Term) :-
term__context_init(Context),
@@ -192,47 +186,50 @@
cons_id_and_args_to_term(cons(SymName, _Arity), Args, Term) :-
construct_qualified_term(SymName, Args, Term).
-cons_id_arity(cons(_, Arity), Arity).
-cons_id_arity(int_const(_), 0).
-cons_id_arity(string_const(_), 0).
-cons_id_arity(float_const(_), 0).
-cons_id_arity(pred_const(_, _, _), _) :-
- error("cons_id_arity: can't get arity of pred_const").
-cons_id_arity(type_ctor_info_const(_, _, _), _) :-
- error("cons_id_arity: can't get arity of type_ctor_info_const").
-cons_id_arity(base_typeclass_info_const(_, _, _, _), _) :-
- error("cons_id_arity: can't get arity of base_typeclass_info_const").
-cons_id_arity(type_info_cell_constructor(_), _) :-
- error("cons_id_arity: can't get arity of type_info_cell_constructor").
-cons_id_arity(typeclass_info_cell_constructor, _) :-
- error("cons_id_arity: can't get arity of typeclass_info_cell_constructor").
-cons_id_arity(tabling_pointer_const(_, _), _) :-
- error("cons_id_arity: can't get arity of tabling_pointer_const").
-cons_id_arity(deep_profiling_proc_static(_), _) :-
- error("cons_id_arity: can't get arity of deep_profiling_proc_static").
-cons_id_arity(table_io_decl(_), _) :-
- error("cons_id_arity: can't get arity of table_io_decl").
-
-cons_id_maybe_arity(cons(_, Arity), yes(Arity)).
-cons_id_maybe_arity(int_const(_), yes(0)).
-cons_id_maybe_arity(string_const(_), yes(0)).
-cons_id_maybe_arity(float_const(_), yes(0)).
-cons_id_maybe_arity(pred_const(_, _, _), no) .
-cons_id_maybe_arity(type_ctor_info_const(_, _, _), no) .
-cons_id_maybe_arity(base_typeclass_info_const(_, _, _, _), no).
-cons_id_maybe_arity(type_info_cell_constructor(_), no) .
-cons_id_maybe_arity(typeclass_info_cell_constructor, no) .
-cons_id_maybe_arity(tabling_pointer_const(_, _), no).
-cons_id_maybe_arity(deep_profiling_proc_static(_), no).
-cons_id_maybe_arity(table_io_decl(_), no).
-
-make_functor_cons_id(term__atom(Name), Arity,
- cons(unqualified(Name), Arity)).
-make_functor_cons_id(term__integer(Int), _, int_const(Int)).
-make_functor_cons_id(term__string(String), _, string_const(String)).
-make_functor_cons_id(term__float(Float), _, float_const(Float)).
+cons_id_arity(cons(_, Arity)) = Arity.
+cons_id_arity(int_const(_)) = 0.
+cons_id_arity(string_const(_)) = 0.
+cons_id_arity(float_const(_)) = 0.
+cons_id_arity(pred_const(_, _, _)) =
+ func_error("cons_id_arity: can't get arity of pred_const").
+cons_id_arity(type_ctor_info_const(_, _, _)) =
+ func_error("cons_id_arity: can't get arity of type_ctor_info_const").
+cons_id_arity(base_typeclass_info_const(_, _, _, _)) =
+ func_error("cons_id_arity: " ++
+ "can't get arity of base_typeclass_info_const").
+cons_id_arity(type_info_cell_constructor(_)) =
+ func_error("cons_id_arity: " ++
+ "can't get arity of type_info_cell_constructor").
+cons_id_arity(typeclass_info_cell_constructor) =
+ func_error("cons_id_arity: " ++
+ "can't get arity of typeclass_info_cell_constructor").
+cons_id_arity(tabling_pointer_const(_, _)) =
+ func_error("cons_id_arity: can't get arity of tabling_pointer_const").
+cons_id_arity(deep_profiling_proc_static(_)) =
+ func_error("cons_id_arity: " ++
+ "can't get arity of deep_profiling_proc_static").
+cons_id_arity(table_io_decl(_)) =
+ func_error("cons_id_arity: can't get arity of table_io_decl").
+
+cons_id_maybe_arity(cons(_, Arity)) = yes(Arity).
+cons_id_maybe_arity(int_const(_)) = yes(0).
+cons_id_maybe_arity(string_const(_)) = yes(0).
+cons_id_maybe_arity(float_const(_)) = yes(0).
+cons_id_maybe_arity(pred_const(_, _, _)) = no.
+cons_id_maybe_arity(type_ctor_info_const(_, _, _)) = no.
+cons_id_maybe_arity(base_typeclass_info_const(_, _, _, _)) = no.
+cons_id_maybe_arity(type_info_cell_constructor(_)) = no.
+cons_id_maybe_arity(typeclass_info_cell_constructor) = no.
+cons_id_maybe_arity(tabling_pointer_const(_, _)) = no.
+cons_id_maybe_arity(deep_profiling_proc_static(_)) = no.
+cons_id_maybe_arity(table_io_decl(_)) = no.
+
+make_functor_cons_id(term__atom(Name), Arity) = cons(unqualified(Name), Arity).
+make_functor_cons_id(term__integer(Int), _) = int_const(Int).
+make_functor_cons_id(term__string(String), _) = string_const(String).
+make_functor_cons_id(term__float(Float), _) = float_const(Float).
-make_cons_id(SymName0, Args, TypeCtor, cons(SymName, Arity)) :-
+make_cons_id(SymName0, Args, TypeCtor) = cons(SymName, Arity) :-
% Use the module qualifier on the SymName, if there is one,
% otherwise use the module qualifier on the Type, if there is one,
% otherwise leave it unqualified.
@@ -252,7 +249,7 @@
),
list__length(Args, Arity).
-make_cons_id_from_qualified_sym_name(SymName, Args, cons(SymName, Arity)) :-
+make_cons_id_from_qualified_sym_name(SymName, Args) = cons(SymName, Arity) :-
list__length(Args, Arity).
%-----------------------------------------------------------------------------%
@@ -273,40 +270,25 @@
:- type hlds_type_defn.
-:- pred hlds_data__set_type_defn(tvarset, list(type_param), hlds_type_body,
- import_status, need_qualifier, prog_context, hlds_type_defn).
-:- mode hlds_data__set_type_defn(in, in, in, in, in, in, out) is det.
-
-:- pred hlds_data__get_type_defn_tvarset(hlds_type_defn, tvarset).
-:- mode hlds_data__get_type_defn_tvarset(in, out) is det.
-
-:- pred hlds_data__get_type_defn_tparams(hlds_type_defn, list(type_param)).
-:- mode hlds_data__get_type_defn_tparams(in, out) is det.
-
-:- pred hlds_data__get_type_defn_body(hlds_type_defn, hlds_type_body).
-:- mode hlds_data__get_type_defn_body(in, out) is det.
-
-:- pred hlds_data__get_type_defn_status(hlds_type_defn, import_status).
-:- mode hlds_data__get_type_defn_status(in, out) is det.
-
-:- pred hlds_data__get_type_defn_need_qualifier(hlds_type_defn,
- need_qualifier).
-:- mode hlds_data__get_type_defn_need_qualifier(in, out) is det.
-
-:- pred hlds_data__get_type_defn_context(hlds_type_defn, prog_context).
-:- mode hlds_data__get_type_defn_context(in, out) is det.
-
-:- pred hlds_data__set_type_defn_status(hlds_type_defn, import_status,
- hlds_type_defn).
-:- mode hlds_data__set_type_defn_status(in, in, out) is det.
-
-:- pred hlds_data__set_type_defn_body(hlds_type_defn, hlds_type_body,
- hlds_type_defn).
-:- mode hlds_data__set_type_defn_body(in, in, out) is det.
-
-:- pred hlds_data__set_type_defn_tvarset(hlds_type_defn, tvarset,
- hlds_type_defn).
-:- mode hlds_data__set_type_defn_tvarset(in, in, out) is det.
+:- pred hlds_data__set_type_defn(tvarset::in, list(type_param)::in,
+ hlds_type_body::in, import_status::in, need_qualifier::in,
+ prog_context::in, hlds_type_defn::out) is det.
+
+:- pred get_type_defn_tvarset(hlds_type_defn::in, tvarset::out) is det.
+:- pred get_type_defn_tparams(hlds_type_defn::in, list(type_param)::out)
+ is det.
+:- pred get_type_defn_body(hlds_type_defn::in, hlds_type_body::out) is det.
+:- pred get_type_defn_status(hlds_type_defn::in, import_status::out) is det.
+:- pred get_type_defn_need_qualifier(hlds_type_defn::in, need_qualifier::out)
+ is det.
+:- pred get_type_defn_context(hlds_type_defn::in, prog_context::out) is det.
+
+:- pred set_type_defn_status(import_status::in,
+ hlds_type_defn::in, hlds_type_defn::out) is det.
+:- pred set_type_defn_body(hlds_type_body::in,
+ hlds_type_defn::in, hlds_type_defn::out) is det.
+:- pred set_type_defn_tvarset(tvarset::in,
+ hlds_type_defn::in, hlds_type_defn::out) is det.
% An `hlds_type_body' holds the body of a type definition:
% du = discriminated union, uu = undiscriminated union,
@@ -595,10 +577,10 @@
hlds_data__get_type_defn_need_qualifier(Defn, Defn ^ type_defn_need_qualifier).
hlds_data__get_type_defn_context(Defn, Defn ^ type_defn_context).
-hlds_data__set_type_defn_body(Defn, Body, Defn ^ type_defn_body := Body).
-hlds_data__set_type_defn_tvarset(Defn, TVarSet,
+hlds_data__set_type_defn_body(Body, Defn, Defn ^ type_defn_body := Body).
+hlds_data__set_type_defn_tvarset(TVarSet, Defn,
Defn ^ type_defn_tvarset := TVarSet).
-hlds_data__set_type_defn_status(Defn, Status,
+hlds_data__set_type_defn_status(Status, Defn,
Defn ^ type_defn_import_status := Status).
%-----------------------------------------------------------------------------%
@@ -675,66 +657,48 @@
%-----------------------------------------------------------------------------%
-:- pred inst_table_init(inst_table).
-:- mode inst_table_init(out) is det.
-
-:- pred inst_table_get_user_insts(inst_table, user_inst_table).
-:- mode inst_table_get_user_insts(in, out) is det.
-
-:- pred inst_table_get_unify_insts(inst_table, unify_inst_table).
-:- mode inst_table_get_unify_insts(in, out) is det.
-
-:- pred inst_table_get_merge_insts(inst_table, merge_inst_table).
-:- mode inst_table_get_merge_insts(in, out) is det.
-
-:- pred inst_table_get_ground_insts(inst_table, ground_inst_table).
-:- mode inst_table_get_ground_insts(in, out) is det.
-
-:- pred inst_table_get_any_insts(inst_table, any_inst_table).
-:- mode inst_table_get_any_insts(in, out) is det.
-
-:- pred inst_table_get_shared_insts(inst_table, shared_inst_table).
-:- mode inst_table_get_shared_insts(in, out) is det.
+:- pred inst_table_init(inst_table::out) is det.
-:- pred inst_table_get_mostly_uniq_insts(inst_table, mostly_uniq_inst_table).
-:- mode inst_table_get_mostly_uniq_insts(in, out) is det.
+:- pred inst_table_get_user_insts(inst_table::in, user_inst_table::out) is det.
+:- pred inst_table_get_unify_insts(inst_table::in, unify_inst_table::out)
+ is det.
+:- pred inst_table_get_merge_insts(inst_table::in, merge_inst_table::out)
+ is det.
+:- pred inst_table_get_ground_insts(inst_table::in, ground_inst_table::out)
+ is det.
+:- pred inst_table_get_any_insts(inst_table::in, any_inst_table::out) is det.
+:- pred inst_table_get_shared_insts(inst_table::in, shared_inst_table::out)
+ is det.
+:- pred inst_table_get_mostly_uniq_insts(inst_table::in,
+ mostly_uniq_inst_table::out) is det.
+
+:- pred inst_table_set_user_insts(user_inst_table::in,
+ inst_table::in, inst_table::out) is det.
+:- pred inst_table_set_unify_insts(unify_inst_table::in,
+ inst_table::in, inst_table::out) is det.
+:- pred inst_table_set_merge_insts(merge_inst_table::in,
+ inst_table::in, inst_table::out) is det.
+:- pred inst_table_set_ground_insts(ground_inst_table::in,
+ inst_table::in, inst_table::out) is det.
+:- pred inst_table_set_any_insts(any_inst_table::in,
+ inst_table::in, inst_table::out) is det.
+:- pred inst_table_set_shared_insts(shared_inst_table::in,
+ inst_table::in, inst_table::out) is det.
+:- pred inst_table_set_mostly_uniq_insts(mostly_uniq_inst_table::in,
+ inst_table::in, inst_table::out) is det.
+
+:- pred user_inst_table_get_inst_defns(user_inst_table::in,
+ user_inst_defns::out) is det.
+:- pred user_inst_table_get_inst_ids(user_inst_table::in,
+ list(inst_id)::out) is det.
-:- pred inst_table_set_user_insts(inst_table, user_inst_table, inst_table).
-:- mode inst_table_set_user_insts(in, in, out) is det.
-
-:- pred inst_table_set_unify_insts(inst_table, unify_inst_table, inst_table).
-:- mode inst_table_set_unify_insts(in, in, out) is det.
-
-:- pred inst_table_set_merge_insts(inst_table, merge_inst_table, inst_table).
-:- mode inst_table_set_merge_insts(in, in, out) is det.
-
-:- pred inst_table_set_ground_insts(inst_table, ground_inst_table, inst_table).
-:- mode inst_table_set_ground_insts(in, in, out) is det.
-
-:- pred inst_table_set_any_insts(inst_table, any_inst_table, inst_table).
-:- mode inst_table_set_any_insts(in, in, out) is det.
-
-:- pred inst_table_set_shared_insts(inst_table, shared_inst_table, inst_table).
-:- mode inst_table_set_shared_insts(in, in, out) is det.
-
-:- pred inst_table_set_mostly_uniq_insts(inst_table, mostly_uniq_inst_table,
- inst_table).
-:- mode inst_table_set_mostly_uniq_insts(in, in, out) is det.
-
-:- pred user_inst_table_get_inst_defns(user_inst_table, user_inst_defns).
-:- mode user_inst_table_get_inst_defns(in, out) is det.
-
-:- pred user_inst_table_get_inst_ids(user_inst_table, list(inst_id)).
-:- mode user_inst_table_get_inst_ids(in, out) is det.
-
-:- pred user_inst_table_insert(user_inst_table, inst_id, hlds_inst_defn,
- user_inst_table).
-:- mode user_inst_table_insert(in, in, in, out) is semidet.
+:- pred user_inst_table_insert(inst_id::in, hlds_inst_defn::in,
+ user_inst_table::in, user_inst_table::out) is semidet.
% Optimize the user_inst_table for lookups. This just sorts
% the cached list of inst_ids.
-:- pred user_inst_table_optimize(user_inst_table, user_inst_table).
-:- mode user_inst_table_optimize(in, out) is det.
+:- pred user_inst_table_optimize(user_inst_table::in, user_inst_table::out)
+ is det.
:- implementation.
@@ -753,8 +717,9 @@
:- type user_inst_table
---> user_inst_table(
- user_inst_defns,
- list(inst_id) % Cached for efficiency when module
+ uinst_table_defns :: user_inst_defns,
+ uinst_table_ids :: list(inst_id)
+ % Cached for efficiency when module
% qualifying the modes of lambda expressions.
).
@@ -778,34 +743,39 @@
inst_table_get_mostly_uniq_insts(InstTable,
InstTable ^ inst_table_mostly_uniq).
-inst_table_set_user_insts(InstTable, UserInsts,
+inst_table_set_user_insts(UserInsts, InstTable,
InstTable ^ inst_table_user := UserInsts).
-inst_table_set_unify_insts(InstTable, UnifyInsts,
+inst_table_set_unify_insts(UnifyInsts, InstTable,
InstTable ^ inst_table_unify := UnifyInsts).
-inst_table_set_merge_insts(InstTable, MergeInsts,
+inst_table_set_merge_insts(MergeInsts, InstTable,
InstTable ^ inst_table_merge := MergeInsts).
-inst_table_set_ground_insts(InstTable, GroundInsts,
+inst_table_set_ground_insts(GroundInsts, InstTable,
InstTable ^ inst_table_ground := GroundInsts).
-inst_table_set_any_insts(InstTable, AnyInsts,
+inst_table_set_any_insts(AnyInsts, InstTable,
InstTable ^ inst_table_any := AnyInsts).
-inst_table_set_shared_insts(InstTable, SharedInsts,
+inst_table_set_shared_insts(SharedInsts, InstTable,
InstTable ^ inst_table_shared := SharedInsts).
-inst_table_set_mostly_uniq_insts(InstTable, MostlyUniqInsts,
+inst_table_set_mostly_uniq_insts(MostlyUniqInsts, InstTable,
InstTable ^ inst_table_mostly_uniq := MostlyUniqInsts).
-user_inst_table_get_inst_defns(user_inst_table(InstDefns, _), InstDefns).
-
-user_inst_table_get_inst_ids(user_inst_table(_, InstIds), InstIds).
-
-user_inst_table_insert(user_inst_table(InstDefns0, InstIds0), InstId,
- InstDefn, user_inst_table(InstDefns, InstIds)) :-
+user_inst_table_get_inst_defns(UserInstTable,
+ UserInstTable ^ uinst_table_defns).
+user_inst_table_get_inst_ids(UserInstTable,
+ UserInstTable ^ uinst_table_ids).
+
+user_inst_table_insert(InstId, InstDefn, UserInstTable0, UserInstTable) :-
+ UserInstTable0 = user_inst_table(InstDefns0, InstIds0),
+ InstDefns0 = UserInstTable0 ^ uinst_table_defns,
map__insert(InstDefns0, InstId, InstDefn, InstDefns),
- InstIds = [InstId | InstIds0].
+ InstIds = [InstId | InstIds0],
+ UserInstTable = user_inst_table(InstDefns, InstIds).
-user_inst_table_optimize(user_inst_table(InstDefns0, InstIds0),
- user_inst_table(InstDefns, InstIds)) :-
+user_inst_table_optimize(UserInstTable0, UserInstTable) :-
+ UserInstTable0 = user_inst_table(InstDefns0, InstIds0),
map__optimize(InstDefns0, InstDefns),
- list__sort(InstIds0, InstIds).
+ list__sort(InstIds0, InstIds),
+ UserInstTable = user_inst_table(InstDefns, InstIds).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -859,55 +829,55 @@
% other mode.
% Given a mode table get the mode_id - hlds_mode_defn map.
-:- pred mode_table_get_mode_defns(mode_table, mode_defns).
-:- mode mode_table_get_mode_defns(in, out) is det.
+:- pred mode_table_get_mode_defns(mode_table::in, mode_defns::out) is det.
% Get the list of defined mode_ids from the mode_table.
-:- pred mode_table_get_mode_ids(mode_table, list(mode_id)).
-:- mode mode_table_get_mode_ids(in, out) is det.
+:- pred mode_table_get_mode_ids(mode_table::in, list(mode_id)::out) is det.
% Insert a mode_id and corresponding hlds_mode_defn into the
% mode_table. Fail if the mode_id is already present in the table.
-:- pred mode_table_insert(mode_table, mode_id, hlds_mode_defn, mode_table).
-:- mode mode_table_insert(in, in, in, out) is semidet.
+:- pred mode_table_insert(mode_id::in, hlds_mode_defn::in,
+ mode_table::in, mode_table::out) is semidet.
-:- pred mode_table_init(mode_table).
-:- mode mode_table_init(out) is det.
+:- pred mode_table_init(mode_table::out) is det.
% Optimize the mode table for lookups.
-:- pred mode_table_optimize(mode_table, mode_table).
-:- mode mode_table_optimize(in, out) is det.
+:- pred mode_table_optimize(mode_table::in, mode_table::out) is det.
:- implementation.
:- type mode_table
---> mode_table(
- mode_defns,
- list(mode_id) % Cached for efficiency
+ mode_table_defns :: mode_defns,
+ mode_table_ids :: list(mode_id)
+ % Cached for efficiency
).
-mode_table_get_mode_defns(mode_table(ModeDefns, _), ModeDefns).
-
-mode_table_get_mode_ids(mode_table(_, ModeIds), ModeIds).
+mode_table_get_mode_defns(ModeTable, ModeTable ^ mode_table_defns).
+mode_table_get_mode_ids(ModeTable, ModeTable ^ mode_table_ids).
-mode_table_insert(mode_table(ModeDefns0, ModeIds0), ModeId, ModeDefn,
- mode_table(ModeDefns, ModeIds)) :-
+mode_table_insert(ModeId, ModeDefn, ModeTable0, ModeTable) :-
+ ModeTable0 = mode_table(ModeDefns0, ModeIds0),
map__insert(ModeDefns0, ModeId, ModeDefn, ModeDefns),
- ModeIds = [ModeId | ModeIds0].
+ ModeIds = [ModeId | ModeIds0],
+ ModeTable = mode_table(ModeDefns, ModeIds).
mode_table_init(mode_table(ModeDefns, [])) :-
map__init(ModeDefns).
-mode_table_optimize(mode_table(ModeDefns0, ModeIds0),
- mode_table(ModeDefns, ModeIds)) :-
+mode_table_optimize(ModeTable0, ModeTable) :-
+ ModeTable0 = mode_table(ModeDefns0, ModeIds0),
map__optimize(ModeDefns0, ModeDefns), % NOP
- list__sort(ModeIds0, ModeIds). % Sort the list of mode_ids
+ % Sort the list of mode_ids
% for quick conversion to a set by module_qual
% when qualifying the modes of lambda expressions.
+ list__sort(ModeIds0, ModeIds),
+ ModeTable = mode_table(ModeDefns, ModeIds).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+
:- interface.
%
@@ -1082,8 +1052,8 @@
:- pred assertion_table_init(assertion_table::out) is det.
-:- pred assertion_table_add_assertion(pred_id::in, assertion_table::in,
- assert_id::out, assertion_table::out) is det.
+:- pred assertion_table_add_assertion(pred_id::in, assert_id::out,
+ assertion_table::in, assertion_table::out) is det.
:- pred assertion_table_lookup(assertion_table::in, assert_id::in,
pred_id::out) is det.
@@ -1102,7 +1072,7 @@
assertion_table_init(assertion_table(0, AssertionMap)) :-
map__init(AssertionMap).
-assertion_table_add_assertion(Assertion, AssertionTable0, Id, AssertionTable) :-
+assertion_table_add_assertion(Assertion, Id, AssertionTable0, AssertionTable) :-
AssertionTable0 = assertion_table(Id, AssertionMap0),
map__det_insert(AssertionMap0, Id, Assertion, AssertionMap),
AssertionTable = assertion_table(Id + 1, AssertionMap).
@@ -1145,28 +1115,26 @@
:- type exclusive_table.
% initialise the exclusive_table
-:- pred exclusive_table_init(exclusive_table).
-:- mode exclusive_table_init(out) is det.
+:- pred exclusive_table_init(exclusive_table::out) is det.
% search the exclusive table and return the list of exclusivity
% declarations that use the predicate given by pred_id
-:- pred exclusive_table_search(exclusive_table, pred_id, exclusive_ids).
-:- mode exclusive_table_search(in, in, out) is semidet.
+:- pred exclusive_table_search(exclusive_table::in, pred_id::in,
+ exclusive_ids::out) is semidet.
% as for search, but aborts if no exclusivity declarations are
% found
-:- pred exclusive_table_lookup(exclusive_table, pred_id, exclusive_ids).
-:- mode exclusive_table_lookup(in, in, out) is det.
+:- pred exclusive_table_lookup(exclusive_table::in, pred_id::in,
+ exclusive_ids::out) is det.
% optimises the exclusive_table
-:- pred exclusive_table_optimize(exclusive_table, exclusive_table).
-:- mode exclusive_table_optimize(in, out) is det.
+:- pred exclusive_table_optimize(exclusive_table::in, exclusive_table::out)
+ is det.
% add to the exclusive table that pred_id is used in the
% exclusivity declaration exclusive_id
-:- pred exclusive_table_add(pred_id, exclusive_id, exclusive_table,
- exclusive_table).
-:- mode exclusive_table_add(in, in, in, out) is det.
+:- pred exclusive_table_add(pred_id::in, exclusive_id::in,
+ exclusive_table::in, exclusive_table::out) is det.
%-----------------------------------------------------------------------------%
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.110
diff -u -b -r1.110 hlds_goal.m
--- compiler/hlds_goal.m 5 Nov 2003 03:17:37 -0000 1.110
+++ compiler/hlds_goal.m 18 Dec 2003 09:19:17 -0000
@@ -1688,7 +1688,7 @@
Purity = list__foldl(
(func(_ - GoalInfo, Purity0) = Purity1 :-
infer_goal_info_purity(GoalInfo, GoalPurity),
- worst_purity(GoalPurity, Purity0, Purity1)
+ worst_purity(GoalPurity, Purity0) = Purity1
), Goals, pure).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.94
diff -u -b -r1.94 hlds_module.m
--- compiler/hlds_module.m 5 Nov 2003 03:17:37 -0000 1.94
+++ compiler/hlds_module.m 20 Dec 2003 09:13:02 -0000
@@ -763,17 +763,17 @@
module_info_remove_predid(PredId, MI0, MI) :-
module_info_get_predicate_table(MI0, PredTable0),
- predicate_table_remove_predid(PredTable0, PredId, PredTable),
+ predicate_table_remove_predid(PredId, PredTable0, PredTable),
module_info_set_predicate_table(PredTable, MI0, MI).
module_info_remove_predicate(PredId, MI0, MI) :-
module_info_get_predicate_table(MI0, PredTable0),
- predicate_table_remove_predicate(PredTable0, PredId, PredTable),
+ predicate_table_remove_predicate(PredId, PredTable0, PredTable),
module_info_set_predicate_table(PredTable, MI0, MI).
module_info_set_preds(Preds, MI0, MI) :-
module_info_get_predicate_table(MI0, PredTable0),
- predicate_table_set_preds(PredTable0, Preds, PredTable),
+ predicate_table_set_preds(Preds, PredTable0, PredTable),
module_info_set_predicate_table(PredTable, MI0, MI).
module_info_set_pred_info(PredId, PredInfo, MI0, MI) :-
@@ -864,7 +864,7 @@
module_info_insts(!.ModuleInfo, InstTable0),
inst_table_get_user_insts(InstTable0, Insts0),
user_inst_table_optimize(Insts0, Insts),
- inst_table_set_user_insts(InstTable0, Insts, InstTable),
+ inst_table_set_user_insts(Insts, InstTable0, InstTable),
module_info_set_insts(InstTable, !ModuleInfo),
module_info_modes(!.ModuleInfo, Modes0),
@@ -1015,18 +1015,16 @@
% Initialize the predicate table
-:- pred predicate_table_init(predicate_table).
-:- mode predicate_table_init(out) is det.
+:- pred predicate_table_init(predicate_table::out) is det.
% Balance all the binary trees in the predicate table
-:- pred predicate_table_optimize(predicate_table, predicate_table).
-:- mode predicate_table_optimize(in, out) is det.
+:- pred predicate_table_optimize(predicate_table::in, predicate_table::out)
+ is det.
% Get the pred_id->pred_info map.
-:- pred predicate_table_get_preds(predicate_table, pred_table).
-:- mode predicate_table_get_preds(in, out) is det.
+:- pred predicate_table_get_preds(predicate_table::in, pred_table::out) is det.
% Restrict the predicate table to the list of predicates.
% This predicate should only be used when the set of predicates
@@ -1035,78 +1033,69 @@
% the table it builds a new table from scratch.
:- pred predicate_table_restrict(partial_qualifier_info::in,
- predicate_table::in, list(pred_id)::in,
- predicate_table::out) is det.
+ list(pred_id)::in, predicate_table::in, predicate_table::out) is det.
% Set the pred_id->pred_info map.
% NB You shouldn't modify the keys in this table, only
% use predicate_table_insert, predicate_table_remove_predid and
% predicate_table_remove_predicate.
-:- pred predicate_table_set_preds(predicate_table, pred_table, predicate_table).
-:- mode predicate_table_set_preds(in, in, out) is det.
+:- pred predicate_table_set_preds(pred_table::in,
+ predicate_table::in, predicate_table::out) is det.
% Get a list of all the valid predids in the predicate_table.
-:- pred predicate_table_get_predids(predicate_table, list(pred_id)).
-:- mode predicate_table_get_predids(in, out) is det.
+:- pred predicate_table_get_predids(predicate_table::in, list(pred_id)::out)
+ is det.
% Remove a pred_id from the valid list.
-:- pred predicate_table_remove_predid(predicate_table, pred_id,
- predicate_table).
-:- mode predicate_table_remove_predid(in, in, out) is det.
-
-:- pred predicate_table_remove_predicate(predicate_table, pred_id,
- predicate_table).
-:- mode predicate_table_remove_predicate(in, in, out) is det.
+:- pred predicate_table_remove_predid(pred_id::in,
+ predicate_table::in, predicate_table::out) is det.
+:- pred predicate_table_remove_predicate(pred_id::in,
+ predicate_table::in, predicate_table::out) is det.
% Search the table for (a) predicates or functions
% (b) predicates only or (c) functions only
% matching this (possibly module-qualified) sym_name.
-:- pred predicate_table_search_sym(predicate_table, is_fully_qualified,
- sym_name, list(pred_id)).
-:- mode predicate_table_search_sym(in, in, in, out) is semidet.
-
-:- pred predicate_table_search_pred_sym(predicate_table,
- is_fully_qualified, sym_name, list(pred_id)).
-:- mode predicate_table_search_pred_sym(in, in, in, out) is semidet.
-
-:- pred predicate_table_search_func_sym(predicate_table,
- is_fully_qualified, sym_name, list(pred_id)).
-:- mode predicate_table_search_func_sym(in, in, in, out) is semidet.
+:- pred predicate_table_search_sym(predicate_table::in, is_fully_qualified::in,
+ sym_name::in, list(pred_id)::out) is semidet.
+
+:- pred predicate_table_search_pred_sym(predicate_table::in,
+ is_fully_qualified::in, sym_name::in, list(pred_id)::out) is semidet.
+
+:- pred predicate_table_search_func_sym(predicate_table::in,
+ is_fully_qualified::in, sym_name::in, list(pred_id)::out) is semidet.
% Search the table for (a) predicates or functions
% (b) predicates only or (c) functions only matching this
% (possibly module-qualified) sym_name & arity.
-:- pred predicate_table_search_sym_arity(predicate_table, is_fully_qualified,
- sym_name, arity, list(pred_id)).
-:- mode predicate_table_search_sym_arity(in, in, in, in, out) is semidet.
-
-:- pred predicate_table_search_pred_sym_arity(predicate_table,
- is_fully_qualified, sym_name, arity, list(pred_id)).
-:- mode predicate_table_search_pred_sym_arity(in, in, in, in, out) is semidet.
-
-:- pred predicate_table_search_func_sym_arity(predicate_table,
- is_fully_qualified, sym_name, arity, list(pred_id)).
-:- mode predicate_table_search_func_sym_arity(in, in, in, in, out) is semidet.
+:- pred predicate_table_search_sym_arity(predicate_table::in,
+ is_fully_qualified::in, sym_name::in, arity::in, list(pred_id)::out)
+ is semidet.
+
+:- pred predicate_table_search_pred_sym_arity(predicate_table::in,
+ is_fully_qualified::in, sym_name::in, arity::in, list(pred_id)::out)
+ is semidet.
+
+:- pred predicate_table_search_func_sym_arity(predicate_table::in,
+ is_fully_qualified::in, sym_name::in, arity::in, list(pred_id)::out)
+ is semidet.
% Search the table for (a) predicates or functions
% (b) predicates only or (c) functions only
% matching this name.
-:- pred predicate_table_search_name(predicate_table, string, list(pred_id)).
-:- mode predicate_table_search_name(in, in, out) is semidet.
+:- pred predicate_table_search_name(predicate_table::in, string::in,
+ list(pred_id)::out) is semidet.
-:- pred predicate_table_search_pred_name(predicate_table, string,
- list(pred_id)).
-:- mode predicate_table_search_pred_name(in, in, out) is semidet.
-
-:- pred predicate_table_search_func_name(predicate_table, string,
- list(pred_id)).
-:- mode predicate_table_search_func_name(in, in, out) is semidet.
+:- pred predicate_table_search_pred_name(predicate_table::in, string::in,
+ list(pred_id)::out) is semidet.
+
+:- pred predicate_table_search_func_name(predicate_table::in, string::in,
+ list(pred_id)::out) is semidet.
% Search the table for (a) predicates or functions
% (b) predicates only or (c) functions only
@@ -1115,17 +1104,14 @@
% is the arity of the function, not the arity N+1 predicate
% that it gets converted to.
-:- pred predicate_table_search_name_arity(predicate_table, string, arity,
- list(pred_id)).
-:- mode predicate_table_search_name_arity(in, in, in, out) is semidet.
-
-:- pred predicate_table_search_pred_name_arity(predicate_table, string, arity,
- list(pred_id)).
-:- mode predicate_table_search_pred_name_arity(in, in, in, out) is semidet.
-
-:- pred predicate_table_search_func_name_arity(predicate_table, string, arity,
- list(pred_id)).
-:- mode predicate_table_search_func_name_arity(in, in, in, out) is semidet.
+:- pred predicate_table_search_name_arity(predicate_table::in, string::in,
+ arity::in, list(pred_id)::out) is semidet.
+
+:- pred predicate_table_search_pred_name_arity(predicate_table::in, string::in,
+ arity::in, list(pred_id)::out) is semidet.
+
+:- pred predicate_table_search_func_name_arity(predicate_table::in, string::in,
+ arity::in, list(pred_id)::out) is semidet.
% Search the table for (a) predicates or functions
% (b) predicates only or (c) functions only
@@ -1150,20 +1136,19 @@
% `pred baz.foo.bar/2'.
:- type is_fully_qualified
---> is_fully_qualified
- ; may_be_partially_qualified
- .
+ ; may_be_partially_qualified.
-:- pred predicate_table_search_m_n_a(predicate_table, is_fully_qualified,
- module_name, string, arity, list(pred_id)).
-:- mode predicate_table_search_m_n_a(in, in, in, in, in, out) is semidet.
-
-:- pred predicate_table_search_pred_m_n_a(predicate_table, is_fully_qualified,
- module_name, string, arity, list(pred_id)).
-:- mode predicate_table_search_pred_m_n_a(in, in, in, in, in, out) is semidet.
-
-:- pred predicate_table_search_func_m_n_a(predicate_table, is_fully_qualified,
- module_name, string, arity, list(pred_id)).
-:- mode predicate_table_search_func_m_n_a(in, in, in, in, in, out) is semidet.
+:- pred predicate_table_search_m_n_a(predicate_table::in,
+ is_fully_qualified::in, module_name::in, string::in, arity::in,
+ list(pred_id)::out) is semidet.
+
+:- pred predicate_table_search_pred_m_n_a(predicate_table::in,
+ is_fully_qualified::in, module_name::in, string::in, arity::in,
+ list(pred_id)::out) is semidet.
+
+:- pred predicate_table_search_func_m_n_a(predicate_table::in,
+ is_fully_qualified::in, module_name::in, string::in, arity::in,
+ list(pred_id)::out) is semidet.
% Search the table for predicates or functions matching
% this pred_or_func category, module, name, and arity.
@@ -1173,9 +1158,9 @@
% NB. This is opposite to what happens with the search
% predicates declared above!!
-:- pred predicate_table_search_pf_m_n_a(predicate_table, is_fully_qualified,
- pred_or_func, module_name, string, arity, list(pred_id)).
-:- mode predicate_table_search_pf_m_n_a(in, in, in, in, in, in, out) is semidet.
+:- pred predicate_table_search_pf_m_n_a(predicate_table::in,
+ is_fully_qualified::in, pred_or_func::in, module_name::in, string::in,
+ arity::in, list(pred_id)::out) is semidet.
% Search the table for predicates or functions matching
% this pred_or_func category, name, and arity.
@@ -1185,9 +1170,9 @@
% NB. This is opposite to what happens with the search
% predicates declared above!!
-:- pred predicate_table_search_pf_name_arity(predicate_table, pred_or_func,
- string, arity, list(pred_id)).
-:- mode predicate_table_search_pf_name_arity(in, in, in, in, out) is semidet.
+:- pred predicate_table_search_pf_name_arity(predicate_table::in,
+ pred_or_func::in, string::in, arity::in, list(pred_id)::out)
+ is semidet.
% Search the table for predicates or functions matching
% this pred_or_func category, sym_name, and arity.
@@ -1197,18 +1182,16 @@
% NB. This is opposite to what happens with the search
% predicates declared above!!
-:- pred predicate_table_search_pf_sym_arity(predicate_table,
- is_fully_qualified, pred_or_func,
- sym_name, arity, list(pred_id)) is semidet.
-:- mode predicate_table_search_pf_sym_arity(in,
- in, in, in, in, out) is semidet.
+:- pred predicate_table_search_pf_sym_arity(predicate_table::in,
+ is_fully_qualified::in, pred_or_func::in, sym_name::in, arity::in,
+ list(pred_id)::out) is semidet.
% Search the table for predicates or functions matching
% this pred_or_func category and sym_name.
-:- pred predicate_table_search_pf_sym(predicate_table, is_fully_qualified,
- pred_or_func, sym_name, list(pred_id)) is semidet.
-:- mode predicate_table_search_pf_sym(in, in, in, in, out) is semidet.
+:- pred predicate_table_search_pf_sym(predicate_table::in,
+ is_fully_qualified::in, pred_or_func::in, sym_name::in,
+ list(pred_id)::out) is semidet.
% predicate_table_insert(PredTable0, PredInfo,
% NeedQual, PartialQualInfo, PredId, PredTable).
@@ -1216,56 +1199,49 @@
% Insert PredInfo into PredTable0 and assign it a new pred_id.
% You should check beforehand that the pred doesn't already
% occur in the table.
-:- pred predicate_table_insert(predicate_table, pred_info, need_qualifier,
- partial_qualifier_info, pred_id, predicate_table).
-:- mode predicate_table_insert(in, in, in, in, out, out) is det.
+:- pred predicate_table_insert(pred_info::in, need_qualifier::in,
+ partial_qualifier_info::in, pred_id::out,
+ predicate_table::in, predicate_table::out) is det.
% Equivalent to predicate_table_insert/6, except that only the
% fully-qualified version of the predicate will be inserted into
% the predicate symbol table. This is useful for creating
% compiler-generated predicates which will only ever be accessed
% via fully-qualified names.
-:- pred predicate_table_insert(predicate_table, pred_info, pred_id,
- predicate_table).
-:- mode predicate_table_insert(in, in, out, out) is det.
+:- pred predicate_table_insert(pred_info::in, pred_id::out,
+ predicate_table::in, predicate_table::out) is det.
-:- pred predicate_id(module_info, pred_id, module_name, string, arity).
-:- mode predicate_id(in, in, out, out, out) is det.
+:- pred predicate_id(module_info::in, pred_id::in, module_name::out,
+ string::out, arity::out) is det.
-:- pred predicate_module(module_info, pred_id, module_name).
-:- mode predicate_module(in, in, out) is det.
-
-:- pred predicate_name(module_info, pred_id, string).
-:- mode predicate_name(in, in, out) is det.
-
-:- pred predicate_arity(module_info, pred_id, arity).
-:- mode predicate_arity(in, in, out) is det.
+:- pred predicate_module(module_info::in, pred_id::in, module_name::out)
+ is det.
+:- pred predicate_name(module_info::in, pred_id::in, string::out) is det.
+:- pred predicate_arity(module_info::in, pred_id::in, arity::out) is det.
% Get the pred_id and proc_id matching a higher-order term with
% the given argument types, aborting with an error if none is
% found.
-:- pred get_pred_id_and_proc_id(is_fully_qualified, sym_name, pred_or_func,
- tvarset, list(type), module_info, pred_id, proc_id).
-:- mode get_pred_id_and_proc_id(in, in, in, in, in, in, out, out) is det.
+:- pred get_pred_id_and_proc_id(is_fully_qualified::in, sym_name::in,
+ pred_or_func::in, tvarset::in, list(type)::in, module_info::in,
+ pred_id::out, proc_id::out) is det.
% Get the pred_id matching a higher-order term with
% the given argument types, failing if none is found.
-:- pred get_pred_id(is_fully_qualified, sym_name, pred_or_func,
- tvarset, list(type), module_info, pred_id).
-:- mode get_pred_id(in, in, in, in, in, in, out) is semidet.
+:- pred get_pred_id(is_fully_qualified::in, sym_name::in, pred_or_func::in,
+ tvarset::in, list(type)::in, module_info::in, pred_id::out) is semidet.
% Given a pred_id, return the single proc_id, aborting
% if there are no modes or more than one mode.
-:- pred get_proc_id(module_info, pred_id, proc_id).
-:- mode get_proc_id(in, in, out) is det.
+:- pred get_proc_id(module_info::in, pred_id::in, proc_id::out) is det.
:- type mode_no
---> only_mode % The pred must have exactly one mode.
; mode_no(int). % The Nth mode, counting from 0.
-:- pred lookup_builtin_pred_proc_id(module_info, module_name,
- string, pred_or_func, arity, mode_no, pred_id, proc_id).
-:- mode lookup_builtin_pred_proc_id(in, in, in, in, in, in, out, out) is det.
+:- pred lookup_builtin_pred_proc_id(module_info::in, module_name::in,
+ string::in, pred_or_func::in, arity::in, mode_no::in,
+ pred_id::out, proc_id::out) is det.
%-----------------------------------------------------------------------------%
@@ -1363,16 +1339,16 @@
predicate_table_get_preds(PredicateTable, PredicateTable ^ preds).
-predicate_table_set_preds(PredicateTable, Preds,
+predicate_table_set_preds(Preds, PredicateTable,
PredicateTable ^ preds := Preds).
predicate_table_get_predids(PredicateTable, PredicateTable ^ pred_ids).
-predicate_table_remove_predid(PredicateTable0, PredId, PredicateTable) :-
+predicate_table_remove_predid(PredId, PredicateTable0, PredicateTable) :-
list__delete_all(PredicateTable0 ^ pred_ids, PredId, PredIds),
PredicateTable = PredicateTable0 ^ pred_ids := PredIds.
-predicate_table_remove_predicate(PredicateTable0, PredId, PredicateTable) :-
+predicate_table_remove_predicate(PredId, PredicateTable0, PredicateTable) :-
PredicateTable0 = predicate_table(Preds0, NextPredId, PredIds0,
AccessibilityTable0,
PredN0, PredNA0, PredMNA0, FuncN0, FuncNA0, FuncMNA0),
@@ -1401,23 +1377,21 @@
PredN0, PredNA0, PredMNA0, FuncN, FuncNA, FuncMNA)
).
-:- pred predicate_table_remove_from_index(module_name, string, int, pred_id,
- name_index, name_index, name_arity_index, name_arity_index,
- module_name_arity_index, module_name_arity_index).
-:- mode predicate_table_remove_from_index(in, in, in, in, in, out,
- in, out, in, out) is det.
+:- pred predicate_table_remove_from_index(module_name::in, string::in, int::in,
+ pred_id::in, name_index::in, name_index::out,
+ name_arity_index::in, name_arity_index::out,
+ module_name_arity_index::in, module_name_arity_index::out) is det.
predicate_table_remove_from_index(Module, Name, Arity, PredId,
N0, N, NA0, NA, MNA0, MNA) :-
- do_remove_from_index(N0, Name, PredId, N),
- do_remove_from_index(NA0, Name / Arity, PredId, NA),
- do_remove_from_m_n_a_index(MNA0, Module, Name, Arity, PredId, MNA).
-
-:- pred do_remove_from_index(map(T, list(pred_id)), T, pred_id,
- map(T, list(pred_id))).
-:- mode do_remove_from_index(in, in, in, out) is det.
+ do_remove_from_index(Name, PredId, N0, N),
+ do_remove_from_index(Name / Arity, PredId, NA0, NA),
+ do_remove_from_m_n_a_index(Module, Name, Arity, PredId, MNA0, MNA).
+
+:- pred do_remove_from_index(T::in, pred_id::in,
+ map(T, list(pred_id))::in, map(T, list(pred_id))::out) is det.
-do_remove_from_index(Index0, T, PredId, Index) :-
+do_remove_from_index(T, PredId, Index0, Index) :-
( map__search(Index0, T, NamePredIds0) ->
list__delete_all(NamePredIds0, PredId, NamePredIds),
( NamePredIds = [] ->
@@ -1429,11 +1403,11 @@
Index = Index0
).
-:- pred do_remove_from_m_n_a_index(module_name_arity_index,
- module_name, string, int, pred_id, module_name_arity_index).
-:- mode do_remove_from_m_n_a_index(in, in, in, in, in, out) is det.
+:- pred do_remove_from_m_n_a_index(module_name::in, string::in, int::in,
+ pred_id::in, module_name_arity_index::in, module_name_arity_index::out)
+ is det.
-do_remove_from_m_n_a_index(MNA0, Module, Name, Arity, PredId, MNA) :-
+do_remove_from_m_n_a_index(Module, Name, Arity, PredId, MNA0, MNA) :-
map__lookup(MNA0, Module - Name, Arities0),
map__lookup(Arities0, Arity, PredIds0),
list__delete_all(PredIds0, PredId, PredIds),
@@ -1451,8 +1425,8 @@
%-----------------------------------------------------------------------------%
-:- pred predicate_table_reverse_predids(predicate_table, predicate_table).
-:- mode predicate_table_reverse_predids(in, out) is det.
+:- pred predicate_table_reverse_predids(predicate_table::in,
+ predicate_table::out) is det.
predicate_table_reverse_predids(PredicateTable0, PredicateTable) :-
list__reverse(PredicateTable0 ^ pred_ids, PredIds),
@@ -1551,9 +1525,9 @@
%-----------------------------------------------------------------------------%
-:- pred predicate_table_search_module_name(predicate_table, is_fully_qualified,
- module_name, string, list(pred_id)).
-:- mode predicate_table_search_module_name(in, in, in, in, out) is semidet.
+:- pred predicate_table_search_module_name(predicate_table::in,
+ is_fully_qualified::in, module_name::in, string::in,
+ list(pred_id)::out) is semidet.
predicate_table_search_module_name(PredicateTable, IsFullyQualified,
Module, Name, PredIds) :-
@@ -1576,9 +1550,9 @@
list__append(FuncPredIds, PredPredIds, PredIds),
PredIds \= [].
-:- pred predicate_table_search_pred_module_name(predicate_table,
- is_fully_qualified, module_name, string, list(pred_id)).
-:- mode predicate_table_search_pred_module_name(in, in, in, in, out) is semidet.
+:- pred predicate_table_search_pred_module_name(predicate_table::in,
+ is_fully_qualified::in, module_name::in, string::in,
+ list(pred_id)::out) is semidet.
predicate_table_search_pred_module_name(PredicateTable, IsFullyQualified,
Module, PredName, PredIds) :-
@@ -1589,10 +1563,9 @@
maybe_filter_pred_ids_matching_module(IsFullyQualified,
Module, PredicateTable, PredIds0, PredIds).
-:- pred predicate_table_search_func_module_name(predicate_table,
- is_fully_qualified, module_name, string, list(pred_id)).
-:- mode predicate_table_search_func_module_name(in,
- in, in, in, out) is semidet.
+:- pred predicate_table_search_func_module_name(predicate_table::in,
+ is_fully_qualified::in, module_name::in, string::in,
+ list(pred_id)::out) is semidet.
predicate_table_search_func_module_name(PredicateTable, IsFullyQualified,
Module, FuncName, PredIds) :-
@@ -1674,9 +1647,9 @@
maybe_filter_pred_ids_matching_module(IsFullyQualified,
Module, PredicateTable, PredIds0, PredIds).
-:- pred maybe_filter_pred_ids_matching_module(is_fully_qualified,
- module_name, predicate_table, list(pred_id), list(pred_id)).
-:- mode maybe_filter_pred_ids_matching_module(in, in, in, in, out) is det.
+:- pred maybe_filter_pred_ids_matching_module(is_fully_qualified::in,
+ module_name::in, predicate_table::in, list(pred_id)::in,
+ list(pred_id)::out) is det.
maybe_filter_pred_ids_matching_module(may_be_partially_qualified, _, _,
PredIds, PredIds).
@@ -1732,8 +1705,8 @@
%-----------------------------------------------------------------------------%
-predicate_table_restrict(PartialQualInfo,
- OrigPredicateTable, PredIds, PredicateTable) :-
+predicate_table_restrict(PartialQualInfo, PredIds, OrigPredicateTable,
+ PredicateTable) :-
predicate_table_reset(OrigPredicateTable, PredicateTable0),
predicate_table_get_preds(OrigPredicateTable, Preds),
AccessibilityTable = OrigPredicateTable ^ accessibility_table,
@@ -1749,24 +1722,27 @@
PredInfo = map__lookup(Preds, PredId),
Access = map__lookup(AccessibilityTable, PredId),
Access = access(Unqualified, PartiallyQualified),
- ( Unqualified = yes,
+ (
+ Unqualified = yes,
NeedQual = may_be_unqualified
- ; Unqualified = no,
+ ;
+ Unqualified = no,
NeedQual = must_be_qualified
),
- ( PartiallyQualified = yes,
+ (
+ PartiallyQualified = yes,
MaybeQualInfo = yes(PartialQualInfo)
- ; PartiallyQualified = no,
+ ;
+ PartiallyQualified = no,
MaybeQualInfo = no
),
- predicate_table_insert_2(Table0,
- yes(PredId), PredInfo,
- NeedQual, MaybeQualInfo,
- _, Table)
+ predicate_table_insert_2(yes(PredId), PredInfo,
+ NeedQual, MaybeQualInfo, _, Table0, Table)
), PredIds, PredicateTable0).
-:- pred predicate_table_reset(predicate_table::in, predicate_table::out) is det.
+:- pred predicate_table_reset(predicate_table::in, predicate_table::out)
+ is det.
predicate_table_reset(PredicateTable0, PredicateTable) :-
NextPredId = PredicateTable0 ^ next_pred_id,
@@ -1776,23 +1752,21 @@
%-----------------------------------------------------------------------------%
-predicate_table_insert(PredicateTable0, PredInfo, PredId, PredicateTable) :-
- predicate_table_insert_2(PredicateTable0, no, PredInfo,
- must_be_qualified, no, PredId, PredicateTable).
-
-predicate_table_insert(PredicateTable0, PredInfo, NeedQual, QualInfo,
- PredId, PredicateTable) :-
- predicate_table_insert_2(PredicateTable0, no, PredInfo,
- NeedQual, yes(QualInfo),
- PredId, PredicateTable).
-
-:- pred predicate_table_insert_2(predicate_table, maybe(pred_id),
- pred_info, need_qualifier,
- maybe(partial_qualifier_info), pred_id, predicate_table).
-:- mode predicate_table_insert_2(in, in, in, in, in, out, out) is det.
+predicate_table_insert(PredInfo, PredId, PredicateTable0, PredicateTable) :-
+ predicate_table_insert_2(no, PredInfo, must_be_qualified, no, PredId,
+ PredicateTable0, PredicateTable).
+
+predicate_table_insert(PredInfo, NeedQual, QualInfo, PredId,
+ PredicateTable0, PredicateTable) :-
+ predicate_table_insert_2(no, PredInfo, NeedQual, yes(QualInfo), PredId,
+ PredicateTable0, PredicateTable).
+
+:- pred predicate_table_insert_2(maybe(pred_id)::in, pred_info::in,
+ need_qualifier::in, maybe(partial_qualifier_info)::in, pred_id::out,
+ predicate_table::in, predicate_table::out) is det.
-predicate_table_insert_2(PredicateTable0, MaybePredId, PredInfo,
- NeedQual, MaybeQualInfo, PredId, PredicateTable) :-
+predicate_table_insert_2(MaybePredId, PredInfo, NeedQual, MaybeQualInfo,
+ PredId, PredicateTable0, PredicateTable) :-
PredicateTable0 = predicate_table(Preds0, NextPredId0, PredIds0,
AccessibilityTable0,
@@ -1801,16 +1775,15 @@
Module = pred_info_module(PredInfo),
Name = pred_info_name(PredInfo),
Arity = pred_info_arity(PredInfo),
-
- ( MaybePredId = yes(PredId),
+ (
+ MaybePredId = yes(PredId),
NextPredId = NextPredId0
-
+ ;
% allocate a new pred_id
- ; MaybePredId = no,
+ MaybePredId = no,
PredId = NextPredId0,
hlds_pred__next_pred_id(PredId, NextPredId)
),
-
% insert the pred_id into either the function or predicate
% indices, as appropriate
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
@@ -1852,13 +1825,12 @@
Pred_N_Index, Pred_NA_Index, Pred_MNA_Index,
Func_N_Index, Func_NA_Index, Func_MNA_Index).
-:- pred predicate_table_do_insert(module_name, string, arity,
- need_qualifier, maybe(partial_qualifier_info),
- pred_id, accessibility_table, accessibility_table,
- name_index, name_index, name_arity_index,
- name_arity_index, module_name_arity_index, module_name_arity_index).
-:- mode predicate_table_do_insert(in, in, in, in, in, in,
- in, out, in, out, in, out, in, out) is det.
+:- pred predicate_table_do_insert(module_name::in, string::in, arity::in,
+ need_qualifier::in, maybe(partial_qualifier_info)::in, pred_id::in,
+ accessibility_table::in, accessibility_table::out,
+ name_index::in, name_index::out,
+ name_arity_index::in, name_arity_index::out,
+ module_name_arity_index::in, module_name_arity_index::out) is det.
predicate_table_do_insert(Module, Name, Arity, NeedQual, MaybeQualInfo,
PredId, AccessibilityTable0, AccessibilityTable,
@@ -1879,7 +1851,6 @@
NA_Index = NA_Index0,
AccessibleByUnqualifiedName = no
),
-
( MaybeQualInfo = yes(QualInfo) ->
% insert partially module-qualified versions
@@ -1896,20 +1867,18 @@
MNA_Index1 = MNA_Index0,
AccessibleByPartiallyQualifiedNames = no
),
-
% insert the fully-qualified name into the
% module:name/arity index
insert_into_mna_index(Module, Name, Arity, PredId,
MNA_Index1, MNA_Index),
-
Access = access(AccessibleByUnqualifiedName,
AccessibleByPartiallyQualifiedNames),
- map__set(AccessibilityTable0, PredId, Access,
- AccessibilityTable).
+ map__set(AccessibilityTable0, PredId, Access, AccessibilityTable).
+
+:- pred insert_into_mna_index(module_name::in, string::in, arity::in,
+ pred_id::in, module_name_arity_index::in,
+ module_name_arity_index::out) is det.
-:- pred insert_into_mna_index(module_name, string, arity, pred_id,
- module_name_arity_index, module_name_arity_index).
-:- mode insert_into_mna_index(in, in, in, in, in, out) is det.
insert_into_mna_index(Module, Name, Arity, PredId, MNA_Index0, MNA_Index) :-
( map__search(MNA_Index0, Module - Name, MN_Arities0) ->
multi_map__set(MN_Arities0, Arity, PredId, MN_Arities),
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.321
diff -u -b -r1.321 hlds_out.m
--- compiler/hlds_out.m 3 Dec 2003 16:12:08 -0000 1.321
+++ compiler/hlds_out.m 20 Dec 2003 08:33:18 -0000
@@ -1760,7 +1760,7 @@
hlds_out__write_goal_2(foreign_proc(Attributes, _, _, ArgVars,
ArgNames, _, PragmaCode), _, _, _, Indent, Follow, _) -->
- { foreign_language(Attributes, ForeignLang) },
+ { ForeignLang = foreign_language(Attributes) },
hlds_out__write_indent(Indent),
io__write_string("$pragma_foreign_proc( /* "),
io__write_string(foreign_language_string(ForeignLang)),
@@ -3089,19 +3089,18 @@
hlds_out__write_constructors_2(Indent, Tvarset, Cs, TagValues)
).
-:- pred hlds_out__write_ctor(constructor, tvarset,
- cons_tag_values, io__state, io__state).
-:- mode hlds_out__write_ctor(in, in, in, di, uo) is det.
+:- pred hlds_out__write_ctor(constructor::in, tvarset::in,
+ cons_tag_values::in, io::di, io::uo) is det.
-hlds_out__write_ctor(C, Tvarset, TagValues) -->
- mercury_output_ctor(C, Tvarset),
- { C = ctor(_, _, Name, Args) },
- { make_cons_id_from_qualified_sym_name(Name, Args, ConsId) },
- ( { map__search(TagValues, ConsId, TagValue) } ->
- io__write_string("\t% tag: "),
- io__print(TagValue)
+hlds_out__write_ctor(C, Tvarset, TagValues, !IO) :-
+ mercury_output_ctor(C, Tvarset, !IO),
+ C = ctor(_, _, Name, Args),
+ ConsId = make_cons_id_from_qualified_sym_name(Name, Args),
+ ( map__search(TagValues, ConsId, TagValue) ->
+ io__write_string("\t% tag: ", !IO),
+ io__print(TagValue, !IO)
;
- []
+ true
).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.137
diff -u -b -r1.137 hlds_pred.m
--- compiler/hlds_pred.m 3 Dec 2003 16:12:09 -0000 1.137
+++ compiler/hlds_pred.m 20 Dec 2003 08:10:22 -0000
@@ -1488,8 +1488,7 @@
Owner, Assertions, ProcInfo, ProcId, PredInfo),
module_info_get_predicate_table(ModuleInfo0, PredTable0),
- predicate_table_insert(PredTable0, PredInfo, PredId,
- PredTable),
+ predicate_table_insert(PredInfo, PredId, PredTable0, PredTable),
module_info_set_predicate_table(PredTable, ModuleInfo0, ModuleInfo),
GoalExpr = call(PredId, ProcId, ArgVars, not_builtin, no, SymName),
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.114
diff -u -b -r1.114 inlining.m
--- compiler/inlining.m 11 Nov 2003 03:23:26 -0000 1.114
+++ compiler/inlining.m 18 Dec 2003 09:41:01 -0000
@@ -926,7 +926,7 @@
(
CalledGoal = foreign_proc(ForeignAttributes,
_,_,_,_,_,_) - _,
- foreign_language(ForeignAttributes, ForeignLanguage)
+ ForeignLanguage = foreign_language(ForeignAttributes)
)
=>
ok_to_inline_language(ForeignLanguage, Target)
Index: compiler/inst_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_util.m,v
retrieving revision 1.27
diff -u -b -r1.27 inst_util.m
--- compiler/inst_util.m 31 Oct 2003 03:27:23 -0000 1.27
+++ compiler/inst_util.m 20 Dec 2003 09:02:25 -0000
@@ -172,7 +172,7 @@
% `unknown'
map__det_insert(UnifyInsts0, ThisInstPair, unknown,
UnifyInsts1),
- inst_table_set_unify_insts(InstTable0, UnifyInsts1, InstTable1),
+ inst_table_set_unify_insts(UnifyInsts1, InstTable0, InstTable1),
module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1),
% unify the insts
inst_expand(ModuleInfo0, InstA, InstA2),
@@ -193,7 +193,7 @@
inst_table_get_unify_insts(InstTable2, UnifyInsts2),
map__det_update(UnifyInsts2, ThisInstPair, known(Inst1, Det),
UnifyInsts),
- inst_table_set_unify_insts(InstTable2, UnifyInsts, InstTable),
+ inst_table_set_unify_insts(UnifyInsts, InstTable2, InstTable),
module_info_set_insts(InstTable, ModuleInfo2, ModuleInfo)
),
% avoid expanding recursive insts
@@ -936,8 +936,8 @@
% value `unknown' for the moment
map__det_insert(GroundInsts0, GroundInstKey, unknown,
GroundInsts1),
- inst_table_set_ground_insts(InstTable0, GroundInsts1,
- InstTable1),
+ inst_table_set_ground_insts(GroundInsts1,
+ InstTable0, InstTable1),
module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1),
% expand the inst name, and invoke ourself recursively on
@@ -954,8 +954,8 @@
inst_table_get_ground_insts(InstTable2, GroundInsts2),
map__det_update(GroundInsts2, GroundInstKey,
known(GroundInst, Det), GroundInsts),
- inst_table_set_ground_insts(InstTable2, GroundInsts,
- InstTable),
+ inst_table_set_ground_insts(GroundInsts,
+ InstTable2, InstTable),
module_info_set_insts(InstTable, ModuleInfo2, ModuleInfo)
),
% avoid expanding recursive insts
@@ -1050,8 +1050,7 @@
% value `unknown' for the moment
map__det_insert(AnyInsts0, AnyInstKey, unknown,
AnyInsts1),
- inst_table_set_any_insts(InstTable0, AnyInsts1,
- InstTable1),
+ inst_table_set_any_insts(AnyInsts1, InstTable0, InstTable1),
module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1),
% expand the inst name, and invoke ourself recursively on
@@ -1068,8 +1067,7 @@
inst_table_get_any_insts(InstTable2, AnyInsts2),
map__det_update(AnyInsts2, AnyInstKey,
known(AnyInst, Det), AnyInsts),
- inst_table_set_any_insts(InstTable2, AnyInsts,
- InstTable),
+ inst_table_set_any_insts(AnyInsts, InstTable2, InstTable),
module_info_set_insts(InstTable, ModuleInfo2, ModuleInfo)
),
% avoid expanding recursive insts
@@ -1209,8 +1207,8 @@
% insert the inst name in the shared_inst table, with
% value `unknown' for the moment
map__det_insert(SharedInsts0, InstName, unknown, SharedInsts1),
- inst_table_set_shared_insts(InstTable0, SharedInsts1,
- InstTable1),
+ inst_table_set_shared_insts(SharedInsts1,
+ InstTable0, InstTable1),
module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1),
% expand the inst name, and invoke ourself recursively on
@@ -1226,8 +1224,8 @@
inst_table_get_shared_insts(InstTable2, SharedInsts2),
map__det_update(SharedInsts2, InstName, known(SharedInst),
SharedInsts),
- inst_table_set_shared_insts(InstTable2, SharedInsts,
- InstTable),
+ inst_table_set_shared_insts(SharedInsts,
+ InstTable2, InstTable),
module_info_set_insts(InstTable, ModuleInfo2, ModuleInfo)
),
% avoid expanding recursive insts
@@ -1311,8 +1309,8 @@
% value `unknown' for the moment
map__det_insert(NondetLiveInsts0, InstName, unknown,
NondetLiveInsts1),
- inst_table_set_mostly_uniq_insts(InstTable0, NondetLiveInsts1,
- InstTable1),
+ inst_table_set_mostly_uniq_insts(NondetLiveInsts1,
+ InstTable0, InstTable1),
module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1),
% expand the inst name, and invoke ourself recursively on
@@ -1329,8 +1327,8 @@
inst_table_get_mostly_uniq_insts(InstTable2, NondetLiveInsts2),
map__det_update(NondetLiveInsts2, InstName,
known(NondetLiveInst), NondetLiveInsts),
- inst_table_set_mostly_uniq_insts(InstTable2, NondetLiveInsts,
- InstTable),
+ inst_table_set_mostly_uniq_insts(NondetLiveInsts,
+ InstTable2, InstTable),
module_info_set_insts(InstTable, ModuleInfo2, ModuleInfo)
),
% avoid expanding recursive insts
@@ -1411,8 +1409,8 @@
% `unknown'
map__det_insert(MergeInstTable0, ThisInstPair, unknown,
MergeInstTable1),
- inst_table_set_merge_insts(InstTable0, MergeInstTable1,
- InstTable1),
+ inst_table_set_merge_insts(MergeInstTable1,
+ InstTable0, InstTable1),
module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1),
% merge the insts
@@ -1425,8 +1423,8 @@
inst_table_get_merge_insts(InstTable2, MergeInstTable2),
map__det_update(MergeInstTable2, ThisInstPair, known(Inst0),
MergeInstTable3),
- inst_table_set_merge_insts(InstTable2, MergeInstTable3,
- InstTable3),
+ inst_table_set_merge_insts(MergeInstTable3,
+ InstTable2, InstTable3),
module_info_set_insts(InstTable3, ModuleInfo2, ModuleInfo)
),
% avoid expanding recursive insts
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.154
diff -u -b -r1.154 intermod.m
--- compiler/intermod.m 3 Dec 2003 16:12:09 -0000 1.154
+++ compiler/intermod.m 20 Dec 2003 08:44:09 -0000
@@ -1026,32 +1026,33 @@
{ module_info_types(ModuleInfo, Types) },
map__foldl(intermod__gather_types_2, Types).
-:- pred intermod__gather_types_2(type_ctor::in,
- hlds_type_defn::in, intermod_info::in, intermod_info::out) is det.
+:- pred intermod__gather_types_2(type_ctor::in, hlds_type_defn::in,
+ intermod_info::in, intermod_info::out) is det.
-intermod__gather_types_2(TypeCtor, TypeDefn0, Info0, Info) :-
- intermod_info_get_module_info(ModuleInfo, Info0, Info1),
+intermod__gather_types_2(TypeCtor, TypeDefn0, !Info) :-
+ intermod_info_get_module_info(ModuleInfo, !Info),
module_info_name(ModuleInfo, ModuleName),
(
intermod__should_write_type(ModuleName, TypeCtor, TypeDefn0)
->
hlds_data__get_type_defn_body(TypeDefn0, TypeBody0),
(
- TypeBody0 = du_type(Ctors, Tags, Enum, MaybeUserEqComp0,
- ReservedTag, IsSolverType, MaybeForeign0)
+ TypeBody0 = du_type(Ctors, Tags, Enum,
+ MaybeUserEqComp0, ReservedTag, IsSolverType,
+ MaybeForeign0)
->
module_info_globals(ModuleInfo, Globals),
globals__get_target(Globals, Target),
%
- % Note that we don't resolve overloading for the definitions
- % which won't be used on this back-end, because their
- % unification and comparison predicates have not been
- % typechecked. They are only written to the `.opt' it
- % can be handy when building against a workspace for
- % the other definitions to be present (e.g. when testing
- % compiling a module to IL when the workspace was compiled
- % to C).
+ % Note that we don't resolve overloading for the
+ % definitions which won't be used on this back-end,
+ % because their unification and comparison predicates
+ % have not been typechecked. They are only written to
+ % the `.opt' it can be handy when building against a
+ % workspace for the other definitions to be present
+ % (e.g. when testing compiling a module to IL when
+ % the workspace was compiled to C).
%
(
MaybeForeign0 = yes(ForeignTypeBody0),
@@ -1060,35 +1061,36 @@
->
intermod__resolve_foreign_type_body_overloading(
ModuleInfo, TypeCtor, ForeignTypeBody0,
- ForeignTypeBody, Info1, Info3),
+ ForeignTypeBody, !Info),
MaybeForeign = yes(ForeignTypeBody),
MaybeUserEqComp = MaybeUserEqComp0
;
- intermod__resolve_unify_compare_overloading(ModuleInfo,
- TypeCtor, MaybeUserEqComp0, MaybeUserEqComp,
- Info1, Info3),
+ intermod__resolve_unify_compare_overloading(
+ ModuleInfo, TypeCtor, MaybeUserEqComp0,
+ MaybeUserEqComp, !Info),
MaybeForeign = MaybeForeign0
),
TypeBody = du_type(Ctors, Tags, Enum, MaybeUserEqComp,
ReservedTag, IsSolverType, MaybeForeign),
- hlds_data__set_type_defn_body(TypeDefn0, TypeBody, TypeDefn)
+ hlds_data__set_type_defn_body(TypeBody,
+ TypeDefn0, TypeDefn)
;
- TypeBody0 = foreign_type(ForeignTypeBody0, IsSolverType)
+ TypeBody0 = foreign_type(ForeignTypeBody0,
+ IsSolverType)
->
- intermod__resolve_foreign_type_body_overloading(ModuleInfo,
- TypeCtor, ForeignTypeBody0, ForeignTypeBody,
- Info1, Info3),
+ intermod__resolve_foreign_type_body_overloading(
+ ModuleInfo, TypeCtor,
+ ForeignTypeBody0, ForeignTypeBody, !Info),
TypeBody = foreign_type(ForeignTypeBody, IsSolverType),
- hlds_data__set_type_defn_body(TypeDefn0, TypeBody, TypeDefn)
+ hlds_data__set_type_defn_body(TypeBody,
+ TypeDefn0, TypeDefn)
;
- Info3 = Info1,
TypeDefn = TypeDefn0
),
- intermod_info_get_types(Types0, Info3, Info4),
- intermod_info_set_types([TypeCtor - TypeDefn | Types0],
- Info4, Info)
+ intermod_info_get_types(Types0, !Info),
+ intermod_info_set_types([TypeCtor - TypeDefn | Types0], !Info)
;
- Info = Info1
+ true
).
:- pred intermod__resolve_foreign_type_body_overloading(module_info::in,
@@ -1227,8 +1229,8 @@
intermod__write_intermod_info_2(IntermodInfo)
).
-:- pred intermod__write_intermod_info_2(intermod_info::in, io__state::di,
- io__state::uo) is det.
+:- pred intermod__write_intermod_info_2(intermod_info::in,
+ io__state::di, io__state::uo) is det.
intermod__write_intermod_info_2(IntermodInfo) -->
{ IntermodInfo = info(_, Preds0, PredDecls0, Instances, Types, _,
@@ -2062,14 +2064,12 @@
pair(type_ctor, hlds_type_defn)::out,
module_info::in, module_info::out) is det.
-adjust_type_status_2(TypeCtor - TypeDefn0, TypeCtor - TypeDefn,
- ModuleInfo0, ModuleInfo) :-
- module_info_name(ModuleInfo0, ModuleName),
+adjust_type_status_2(TypeCtor - TypeDefn0, TypeCtor - TypeDefn, !ModuleInfo) :-
+ module_info_name(!.ModuleInfo, ModuleName),
( intermod__should_write_type(ModuleName, TypeCtor, TypeDefn0) ->
- hlds_data__set_type_defn_status(TypeDefn0, exported, TypeDefn),
- fixup_special_preds(TypeCtor, ModuleInfo0, ModuleInfo)
+ hlds_data__set_type_defn_status(exported, TypeDefn0, TypeDefn),
+ fixup_special_preds(TypeCtor, !ModuleInfo)
;
- ModuleInfo = ModuleInfo0,
TypeDefn = TypeDefn0
).
@@ -2115,8 +2115,8 @@
ModuleInfo = ModuleInfo0
).
-:- pred class_procs_to_pred_ids(list(hlds_class_proc)::in,
- list(pred_id)::out) is det.
+:- pred class_procs_to_pred_ids(list(hlds_class_proc)::in, list(pred_id)::out)
+ is det.
class_procs_to_pred_ids(ClassProcs, PredIds) :-
list__map(
@@ -2180,12 +2180,12 @@
set_list_of_preds_exported_2(PredIds, Preds0, Preds),
module_info_set_preds(Preds, !ModuleInfo).
-:- pred set_list_of_preds_exported_2(list(pred_id)::in, pred_table::in,
- pred_table::out) is det.
+:- pred set_list_of_preds_exported_2(list(pred_id)::in,
+ pred_table::in, pred_table::out) is det.
-set_list_of_preds_exported_2([], Preds, Preds).
-set_list_of_preds_exported_2([PredId | PredIds], Preds0, Preds) :-
- map__lookup(Preds0, PredId, PredInfo0),
+set_list_of_preds_exported_2([], !Preds).
+set_list_of_preds_exported_2([PredId | PredIds], !Preds) :-
+ map__lookup(!.Preds, PredId, PredInfo0),
(
pred_info_import_status(PredInfo0, Status),
import_status_to_write(Status)
@@ -2204,11 +2204,11 @@
NewStatus = opt_exported
),
pred_info_set_import_status(NewStatus, PredInfo0, PredInfo),
- map__det_update(Preds0, PredId, PredInfo, Preds1)
+ map__det_update(!.Preds, PredId, PredInfo, !:Preds)
;
- Preds1 = Preds0
+ true
),
- set_list_of_preds_exported_2(PredIds, Preds1, Preds).
+ set_list_of_preds_exported_2(PredIds, !Preds).
% Should a declaration with the given status be written
% to the `.opt' file.
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.85
diff -u -b -r1.85 lambda.m
--- compiler/lambda.m 31 Oct 2003 03:27:24 -0000 1.85
+++ compiler/lambda.m 20 Dec 2003 09:02:36 -0000
@@ -571,8 +571,8 @@
% save the new predicate in the predicate table
module_info_get_predicate_table(ModuleInfo1, PredicateTable0),
- predicate_table_insert(PredicateTable0, PredInfo,
- PredId, PredicateTable),
+ predicate_table_insert(PredInfo, PredId,
+ PredicateTable0, PredicateTable),
module_info_set_predicate_table(PredicateTable,
ModuleInfo1, ModuleInfo)
),
Index: compiler/live_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/live_vars.m,v
retrieving revision 1.102
diff -u -b -r1.102 live_vars.m
--- compiler/live_vars.m 22 May 2003 05:54:38 -0000 1.102
+++ compiler/live_vars.m 18 Dec 2003 09:14:36 -0000
@@ -346,7 +346,7 @@
% won't clobber the registers.
CodeModel \= model_non,
- may_call_mercury(Attributes, will_not_call_mercury)
+ may_call_mercury(Attributes) = will_not_call_mercury
->
GoalInfo = GoalInfo0
;
Index: compiler/magic.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/magic.m,v
retrieving revision 1.40
diff -u -b -r1.40 magic.m
--- compiler/magic.m 5 Nov 2003 03:17:39 -0000 1.40
+++ compiler/magic.m 20 Dec 2003 08:31:09 -0000
@@ -664,8 +664,8 @@
magic_info_get_module_info(ModuleInfo1),
{ module_info_get_predicate_table(ModuleInfo1, PredTable0) },
- { predicate_table_insert(PredTable0, NewPredInfo, NewPredId,
- PredTable) },
+ { predicate_table_insert(NewPredInfo, NewPredId,
+ PredTable0, PredTable) },
{ module_info_set_predicate_table(PredTable,
ModuleInfo0, ModuleInfo) },
magic_info_set_module_info(ModuleInfo),
@@ -1161,7 +1161,7 @@
JoinProcInfo, JoinProcId, JoinPredInfo),
module_info_get_predicate_table(!.ModuleInfo, Preds0),
- predicate_table_insert(Preds0, JoinPredInfo, JoinPredId, Preds),
+ predicate_table_insert(JoinPredInfo, JoinPredId, Preds0, Preds),
JoinPredProcId = proc(JoinPredId, JoinProcId),
module_info_set_predicate_table(Preds, !ModuleInfo).
@@ -1298,8 +1298,8 @@
MagicPredInfo) },
{ module_info_get_predicate_table(ModuleInfo0, PredTable0) },
- { predicate_table_insert(PredTable0,
- MagicPredInfo, MagicPredId, PredTable) },
+ { predicate_table_insert(MagicPredInfo, MagicPredId,
+ PredTable0, PredTable) },
{ module_info_set_predicate_table(PredTable,
ModuleInfo0, ModuleInfo) },
magic_info_set_module_info(ModuleInfo),
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.458
diff -u -b -r1.458 make_hlds.m
--- compiler/make_hlds.m 18 Dec 2003 01:54:47 -0000 1.458
+++ compiler/make_hlds.m 20 Dec 2003 10:55:24 -0000
@@ -41,14 +41,14 @@
% Returns InvalidModes = yes if undefined or cyclic insts or modes found.
% QualInfo is an abstract type that is then passed back to
% produce_instance_method_clauses (see below).
-:- pred parse_tree_to_hlds(compilation_unit, mq_info, eqv_map, module_info,
- qual_info, bool, bool, io__state, io__state).
-:- mode parse_tree_to_hlds(in, in, in, out, out, out, out, di, uo) is det.
-
-:- pred add_new_proc(pred_info, inst_varset, arity, list(mode),
- maybe(list(mode)), maybe(list(is_live)), maybe(determinism),
- prog_context, is_address_taken, pred_info, proc_id).
-:- mode add_new_proc(in, in, in, in, in, in, in, in, in, out, out) is det.
+:- pred parse_tree_to_hlds(compilation_unit::in, mq_info::in, eqv_map::in,
+ module_info::out, qual_info::out, bool::out, bool::out, io::di, io::uo)
+ is det.
+
+:- pred add_new_proc(inst_varset::in, arity::in, list(mode)::in,
+ maybe(list(mode))::in, maybe(list(is_live))::in,
+ maybe(determinism)::in, prog_context::in, is_address_taken::in,
+ pred_info::in, pred_info::out, proc_id::out) is det.
% add_special_pred_for_real(SpecialPredId, TVarSet, Type, TypeCtor,
% TypeBody, TypeContext, TypeStatus, !ModuleInfo).
@@ -211,24 +211,29 @@
Module = !.Module
).
-:- pred check_for_errors(pred(module_info, module_info, io__state, io__state),
- bool, module_info, module_info, io__state, io__state).
-:- mode check_for_errors((pred(in, out, di, uo) is det),
- out, in, out, di, uo) is det.
-
-check_for_errors(P, FoundError, Module0, Module) -->
- io__get_exit_status(BeforeStatus),
- io__set_exit_status(0),
- { module_info_num_errors(Module0, BeforeNumErrors) },
- P(Module0, Module),
- { module_info_num_errors(Module, AfterNumErrors) },
- io__get_exit_status(AfterStatus),
- { FoundError =
- (AfterStatus = 0, BeforeNumErrors = AfterNumErrors -> no ; yes) },
- ( { BeforeStatus \= 0 } ->
- io__set_exit_status(BeforeStatus)
+:- pred check_for_errors(pred(module_info, module_info, io__state, io__state)
+ ::pred(in, out, di, uo) is det, bool::out,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+check_for_errors(P, FoundError, !Module, !IO) :-
+ io__get_exit_status(BeforeStatus, !IO),
+ io__set_exit_status(0, !IO),
+ module_info_num_errors(!.Module, BeforeNumErrors),
+ P(!Module, !IO),
+ module_info_num_errors(!.Module, AfterNumErrors),
+ io__get_exit_status(AfterStatus, !IO),
+ (
+ AfterStatus = 0,
+ BeforeNumErrors = AfterNumErrors
+ ->
+ FoundError = no
;
- []
+ FoundError = yes
+ ),
+ ( BeforeStatus \= 0 ->
+ io__set_exit_status(BeforeStatus, !IO)
+ ;
+ true
).
%-----------------------------------------------------------------------------%
@@ -247,19 +252,18 @@
% The `InvalidModes' bool records whether we detected
% any cyclic insts or modes.
-:- pred add_item_list_decls_pass_1(item_list, item_status,
- module_info, module_info, bool, bool, io__state, io__state).
-:- mode add_item_list_decls_pass_1(in, in, in, out, in, out, di, uo) is det.
-
-add_item_list_decls_pass_1([], _, Module, Module, InvalidModes, InvalidModes)
- --> [].
-add_item_list_decls_pass_1([Item - Context | Items], Status0, Module0, Module,
- InvalidModes0, InvalidModes) -->
- add_item_decl_pass_1(Item, Context, Status0, Status1, Module0,
- Module1, InvalidModes1),
- { InvalidModes2 = bool__or(InvalidModes0, InvalidModes1) },
- add_item_list_decls_pass_1(Items, Status1, Module1, Module,
- InvalidModes2, InvalidModes).
+:- pred add_item_list_decls_pass_1(item_list::in, item_status::in,
+ module_info::in, module_info::out, bool::in, bool::out,
+ io::di, io::uo) is det.
+
+add_item_list_decls_pass_1([], _, !Module, !InvalidModes, !IO).
+add_item_list_decls_pass_1([Item - Context | Items], Status0, !Module,
+ !InvalidModes, !IO) :-
+ add_item_decl_pass_1(Item, Context, Status0, Status1, !Module,
+ NewInvalidModes, !IO),
+ !:InvalidModes = bool__or(!.InvalidModes, NewInvalidModes),
+ add_item_list_decls_pass_1(Items, Status1, !Module, !InvalidModes,
+ !IO).
% pass 2:
% Add the type definitions and pragmas one by one to the module,
@@ -459,7 +463,6 @@
;
true
),
-
%
% switch on the pragma type
%
@@ -633,8 +636,8 @@
->
predicate_table_get_preds(PredTable0, Preds0),
maybe_add_default_func_modes(PredIds, Preds0, Preds),
- predicate_table_set_preds(PredTable0, Preds,
- PredTable),
+ predicate_table_set_preds(Preds,
+ PredTable0, PredTable),
module_info_set_predicate_table(PredTable, !Module)
;
error("make_hlds.m: can't find func declaration")
@@ -664,8 +667,8 @@
% If a module_defn updates the import_status, return the new
% status and whether uses of the following items must be module
% qualified, otherwise fail.
-:- pred module_defn_update_import_status(module_defn::in,
- item_status::out) is semidet.
+:- pred module_defn_update_import_status(module_defn::in, item_status::out)
+ is semidet.
module_defn_update_import_status(interface,
item_status(exported, may_be_unqualified)).
@@ -719,8 +722,8 @@
add_item_clause(clause(VarSet, PredOrFunc, PredName, Args, Body),
!Status, Context, !Module, !Info, !IO) :-
check_not_exported(!.Status, Context, "clause", !IO),
- GoalType = none, % at this stage we only need know that it's not
- % a promise declaration
+ GoalType = none,
+ % at this stage we only need know that it's not % a promise declaration
module_add_clause(VarSet, PredOrFunc, PredName, Args, Body, !.Status,
Context, GoalType, !Module, !Info, !IO).
add_item_clause(type_defn(_, _, _, _, _), !Status, _, !Module, !Info, !IO).
@@ -918,54 +921,54 @@
%-----------------------------------------------------------------------------%
-:- pred add_pragma_export(sym_name, pred_or_func, list(mode), string,
- prog_context, module_info, module_info, io__state, io__state).
-:- mode add_pragma_export(in, in, in, in, in, in, out, di, uo) is det.
-
-add_pragma_export(Name, PredOrFunc, Modes, C_Function, Context,
- Module0, Module) -->
- { module_info_get_predicate_table(Module0, PredTable) },
- { list__length(Modes, Arity) },
+:- pred add_pragma_export(sym_name::in, pred_or_func::in, list(mode)::in,
+ string::in, prog_context::in, module_info::in, module_info::out,
+ io::di, io::uo) is det.
+
+add_pragma_export(Name, PredOrFunc, Modes, C_Function, Context, !Module,
+ !IO) :-
+ module_info_get_predicate_table(!.Module, PredTable),
+ list__length(Modes, Arity),
(
- { predicate_table_search_pf_sym_arity(PredTable,
+ predicate_table_search_pf_sym_arity(PredTable,
may_be_partially_qualified, PredOrFunc, Name,
- Arity, [PredId]) }
+ Arity, [PredId])
+ ->
+ predicate_table_get_preds(PredTable, Preds),
+ map__lookup(Preds, PredId, PredInfo),
+ pred_info_procedures(PredInfo, Procs),
+ map__to_assoc_list(Procs, ExistingProcs),
+ (
+ get_procedure_matching_declmodes(ExistingProcs, Modes,
+ !.Module, ProcId)
->
- { predicate_table_get_preds(PredTable, Preds) },
- { map__lookup(Preds, PredId, PredInfo) },
- { pred_info_procedures(PredInfo, Procs) },
- { map__to_assoc_list(Procs, ExistingProcs) },
- (
- { get_procedure_matching_declmodes(
- ExistingProcs, Modes, Module0, ProcId)}
- ->
- { module_info_get_pragma_exported_procs(Module0,
- PragmaExportedProcs0) },
- { NewExportedProc = pragma_exported_proc(PredId,
- ProcId, C_Function, Context) },
- { PragmaExportedProcs =
- [NewExportedProc|PragmaExportedProcs0]},
- { module_info_set_pragma_exported_procs(
- PragmaExportedProcs, Module0, Module) }
+ module_info_get_pragma_exported_procs(!.Module,
+ PragmaExportedProcs0),
+ NewExportedProc = pragma_exported_proc(PredId,
+ ProcId, C_Function, Context),
+ PragmaExportedProcs =
+ [NewExportedProc | PragmaExportedProcs0],
+ module_info_set_pragma_exported_procs(
+ PragmaExportedProcs, !Module)
;
undefined_mode_error(Name, Arity, Context,
- "`:- pragma export' declaration"),
- { module_info_incr_errors(Module0, Module) }
+ "`:- pragma export' declaration", !IO),
+ module_info_incr_errors(!Module)
)
;
undefined_pred_or_func_error(Name, Arity, Context,
- "`:- pragma export' declaration"),
- { module_info_incr_errors(Module0, Module) }
+ "`:- pragma export' declaration", !IO),
+ module_info_incr_errors(!Module)
).
%-----------------------------------------------------------------------------%
-:- pred add_pragma_reserve_tag(sym_name, arity, import_status, prog_context,
- module_info, module_info, io__state, io__state).
-:- mode add_pragma_reserve_tag(in, in, in, in, in, out, di, uo) is det.
+:- pred add_pragma_reserve_tag(sym_name::in, arity::in, import_status::in,
+ prog_context::in, module_info::in, module_info::out,
+ io::di, io::uo) is det.
-add_pragma_reserve_tag(TypeName, TypeArity, PragmaStatus, Context,
- !Module, !IO) :-
+add_pragma_reserve_tag(TypeName, TypeArity, PragmaStatus, Context, !Module,
+ !IO) :-
TypeCtor = TypeName - TypeArity,
module_info_types(!.Module, Types0),
TypeStr = error_util__describe_sym_name_and_arity(
@@ -1037,8 +1040,8 @@
TypeBody = du_type(Body, CtorTags, IsEnum,
EqualityPred, ReservedTag, IsSolverType,
IsForeign),
- hlds_data__set_type_defn_body(TypeDefn0, TypeBody,
- TypeDefn),
+ hlds_data__set_type_defn_body(TypeBody,
+ TypeDefn0, TypeDefn),
map__set(Types0, TypeCtor, TypeDefn, Types),
module_info_set_types(Types, !Module)
;
@@ -1226,8 +1229,8 @@
NewPredInfo0, NewPredInfo),
module_info_get_predicate_table(ModuleInfo2,
PredTable0),
- predicate_table_insert(PredTable0, NewPredInfo,
- NewPredId, PredTable),
+ predicate_table_insert(NewPredInfo, NewPredId,
+ PredTable0, PredTable),
module_info_set_predicate_table(PredTable,
ModuleInfo2, ModuleInfo3),
@@ -1416,8 +1419,7 @@
)
).
-:- pred find_duplicate_list_elements(list(T), list(T)).
-:- mode find_duplicate_list_elements(in, out) is det.
+:- pred find_duplicate_list_elements(list(T)::in, list(T)::out) is det.
find_duplicate_list_elements([], []).
find_duplicate_list_elements([H | T], Vars) :-
@@ -1428,9 +1430,8 @@
Vars = Vars0
).
-:- pred report_subst_existq_tvars(pred_info, prog_context,
- list(tvar), io__state, io__state).
-:- mode report_subst_existq_tvars(in, in, in, di, uo) is det.
+:- pred report_subst_existq_tvars(pred_info::in, prog_context::in,
+ list(tvar)::in, io::di, io::uo) is det.
report_subst_existq_tvars(PredInfo0, Context, SubExistQVars) -->
report_pragma_type_spec(PredInfo0, Context),
@@ -1443,9 +1444,8 @@
report_variables(SubExistQVars, TVarSet),
io__write_string(".\n").
-:- pred report_recursive_subst(pred_info, prog_context, tvarset,
- list(tvar), io__state, io__state).
-:- mode report_recursive_subst(in, in, in, in, di, uo) is det.
+:- pred report_recursive_subst(pred_info::in, prog_context::in, tvarset::in,
+ list(tvar)::in, io::di, io::uo) is det.
report_recursive_subst(PredInfo0, Context, TVarSet, RecursiveVars) -->
report_pragma_type_spec(PredInfo0, Context),
@@ -1460,9 +1460,8 @@
prog_out__write_context(Context),
io__write_string(" on both sides of the substitution.\n").
-:- pred report_multiple_subst_vars(pred_info, prog_context, tvarset,
- list(tvar), io__state, io__state).
-:- mode report_multiple_subst_vars(in, in, in, in, di, uo) is det.
+:- pred report_multiple_subst_vars(pred_info::in, prog_context::in, tvarset::in,
+ list(tvar)::in, io::di, io::uo) is det.
report_multiple_subst_vars(PredInfo0, Context, TVarSet, MultiSubstVars) -->
report_pragma_type_spec(PredInfo0, Context),
@@ -1476,9 +1475,8 @@
),
io__write_string("multiple replacement types.\n").
-:- pred report_unknown_vars_to_subst(pred_info, prog_context, tvarset,
- list(tvar), io__state, io__state).
-:- mode report_unknown_vars_to_subst(in, in, in, in, di, uo) is det.
+:- pred report_unknown_vars_to_subst(pred_info::in, prog_context::in,
+ tvarset::in, list(tvar)::in, io::di, io::uo) is det.
report_unknown_vars_to_subst(PredInfo0, Context, TVarSet, UnknownVars) -->
report_pragma_type_spec(PredInfo0, Context),
@@ -1502,9 +1500,8 @@
io__write_string(Decl),
io__write_string(" declaration.\n").
-:- pred report_pragma_type_spec(pred_info, term__context,
- io__state, io__state).
-:- mode report_pragma_type_spec(in, in, di, uo) is det.
+:- pred report_pragma_type_spec(pred_info::in, term__context::in,
+ io::di, io::uo) is det.
report_pragma_type_spec(PredInfo0, Context) -->
{ Module = pred_info_module(PredInfo0) },
@@ -1517,8 +1514,7 @@
qualified(Module, Name)/Arity),
io__write_string(":\n").
-:- pred report_variables(list(tvar), tvarset, io__state, io__state).
-:- mode report_variables(in, in, di, uo) is det.
+:- pred report_variables(list(tvar)::in, tvarset::in, io::di, io::uo) is det.
report_variables(SubExistQVars, VarSet) -->
( { SubExistQVars = [_] } ->
@@ -1531,40 +1527,33 @@
% Check that the mode list for a `:- pragma type_spec' declaration
% specifies a known procedure.
-:- pred handle_pragma_type_spec_modes(sym_name, arity,
- prog_context, maybe(list(mode)), list(proc_id),
- proc_table, proc_table, bool, module_info, module_info,
- io__state, io__state).
-:- mode handle_pragma_type_spec_modes(in, in, in, in, out, in, out,
- out, in, out, di, uo) is det.
+:- pred handle_pragma_type_spec_modes(sym_name::in, arity::in,
+ prog_context::in, maybe(list(mode))::in, list(proc_id)::out,
+ proc_table::in, proc_table::out, bool::out,
+ module_info::in, module_info::out, io::di, io::uo) is det.
handle_pragma_type_spec_modes(SymName, Arity, Context, MaybeModes, ProcIds,
- Procs0, Procs, ModesOk, ModuleInfo0, ModuleInfo) -->
- ( { MaybeModes = yes(Modes) } ->
- { map__to_assoc_list(Procs0, ExistingProcs) },
- (
- { get_procedure_matching_argmodes(ExistingProcs,
- Modes, ModuleInfo0, ProcId) }
- ->
- { map__lookup(Procs0, ProcId, ProcInfo) },
- { map__init(Procs1) },
- { map__det_insert(Procs1, ProcId, ProcInfo, Procs) },
- { ProcIds = [ProcId] },
- { ModesOk = yes },
- { ModuleInfo = ModuleInfo0 }
- ;
- { ProcIds = [] },
- { Procs = Procs0 },
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+ !Procs, ModesOk, !ModuleInfo, !IO) :-
+ ( MaybeModes = yes(Modes) ->
+ map__to_assoc_list(!.Procs, ExistingProcs),
+ (
+ get_procedure_matching_argmodes(ExistingProcs,
+ Modes, !.ModuleInfo, ProcId)
+ ->
+ map__lookup(!.Procs, ProcId, ProcInfo),
+ map__det_insert(map__init, ProcId, ProcInfo, !:Procs),
+ ProcIds = [ProcId],
+ ModesOk = yes
+ ;
+ ProcIds = [],
+ module_info_incr_errors(!ModuleInfo),
undefined_mode_error(SymName, Arity, Context,
- "`:- pragma type_spec' declaration"),
- { ModesOk = no }
+ "`:- pragma type_spec' declaration", !IO),
+ ModesOk = no
)
;
- { Procs = Procs0 },
- { map__keys(Procs, ProcIds) },
- { ModesOk = yes },
- { ModuleInfo = ModuleInfo0 }
+ map__keys(!.Procs, ProcIds),
+ ModesOk = yes
).
%-----------------------------------------------------------------------------%
@@ -1649,9 +1638,9 @@
%-----------------------------------------------------------------------------%
-:- pred add_stratified_pred(string, sym_name, arity,
- term__context, module_info, module_info, io__state, io__state).
-:- mode add_stratified_pred(in, in, in, in, in, out, di, uo) is det.
+:- pred add_stratified_pred(string::in, sym_name::in, arity::in,
+ term__context::in, module_info::in, module_info::out, io::di, io::uo)
+ is det.
add_stratified_pred(PragmaName, Name, Arity, Context, !Module, !IO) :-
module_info_get_predicate_table(!.Module, PredTable0),
@@ -1834,8 +1823,7 @@
true
),
- predicate_table_set_preds(PredTable0, Preds,
- PredTable),
+ predicate_table_set_preds(Preds, PredTable0, PredTable),
module_info_set_predicate_table(PredTable, !Module)
;
PredIds = [],
@@ -1847,8 +1835,8 @@
module_info_incr_errors(!Module)
).
-:- pred get_matching_pred_ids(module_info, sym_name, arity, list(pred_id)).
-:- mode get_matching_pred_ids(in, in, in, out) is semidet.
+:- pred get_matching_pred_ids(module_info::in, sym_name::in, arity::in,
+ list(pred_id)::out) is semidet.
get_matching_pred_ids(Module0, Name, Arity, PredIds) :-
module_info_get_predicate_table(Module0, PredTable0),
@@ -1864,27 +1852,26 @@
%-----------------------------------------------------------------------------%
-:- pred module_mark_as_external(sym_name, int, prog_context,
- module_info, module_info, io__state, io__state).
-:- mode module_mark_as_external(in, in, in, in, out, di, uo) is det.
+:- pred module_mark_as_external(sym_name::in, int::in, prog_context::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
-module_mark_as_external(PredName, Arity, Context, Module0, Module) -->
+module_mark_as_external(PredName, Arity, Context, !Module, !IO) :-
% `external' declarations can only apply to things defined
% in this module, since everything else is already external.
- { module_info_get_predicate_table(Module0, PredicateTable0) },
+ module_info_get_predicate_table(!.Module, PredicateTable0),
(
- { predicate_table_search_sym_arity(PredicateTable0,
- is_fully_qualified, PredName, Arity, PredIdList) }
+ predicate_table_search_sym_arity(PredicateTable0,
+ is_fully_qualified, PredName, Arity, PredIdList)
->
- { module_mark_preds_as_external(PredIdList, Module0, Module) }
+ module_mark_preds_as_external(PredIdList, !Module)
;
undefined_pred_or_func_error(PredName, Arity,
- Context, "`:- external' declaration"),
- { module_info_incr_errors(Module0, Module) }
+ Context, "`:- external' declaration", !IO),
+ module_info_incr_errors(!Module)
).
-:- pred module_mark_preds_as_external(list(pred_id), module_info, module_info).
-:- mode module_mark_preds_as_external(in, in, out) is det.
+:- pred module_mark_preds_as_external(list(pred_id)::in,
+ module_info::in, module_info::out) is det.
module_mark_preds_as_external([], !Module).
module_mark_preds_as_external([PredId | PredIds], !Module) :-
@@ -1897,11 +1884,9 @@
%-----------------------------------------------------------------------------%
-:- pred module_add_inst_defn(inst_varset, sym_name, list(inst_var),
- inst_defn, condition, prog_context, item_status,
- module_info, module_info, bool, io__state, io__state).
-:- mode module_add_inst_defn(in, in, in, in, in, in, in,
- in, out, out, di, uo) is det.
+:- pred module_add_inst_defn(inst_varset::in, sym_name::in, list(inst_var)::in,
+ inst_defn::in, condition::in, prog_context::in, item_status::in,
+ module_info::in, module_info::out, bool::out, io::di, io::uo) is det.
module_add_inst_defn(VarSet, Name, Args, InstDefn, Cond, Context,
item_status(Status, _NeedQual), !Module, InvalidMode, !IO) :-
@@ -1910,9 +1895,9 @@
%
module_info_insts(!.Module, InstTable0),
inst_table_get_user_insts(InstTable0, Insts0),
- insts_add(Insts0, VarSet, Name, Args, InstDefn, Cond,
- Context, Status, Insts, !IO),
- inst_table_set_user_insts(InstTable0, Insts, InstTable),
+ insts_add(VarSet, Name, Args, InstDefn, Cond, Context, Status,
+ Insts0, Insts, !IO),
+ inst_table_set_user_insts(Insts, InstTable0, InstTable),
module_info_set_insts(InstTable, !Module),
%
% check if the inst is infinitely recursive (at the top level)
@@ -1923,151 +1908,147 @@
check_for_cyclic_inst(Insts, InstId, InstId, TestArgs, [], Context,
InvalidMode, !IO).
-:- pred insts_add(user_inst_table, inst_varset, sym_name, list(inst_var),
- inst_defn, condition, prog_context, import_status,
- user_inst_table, io__state, io__state).
-:- mode insts_add(in, in, in, in, in, in, in, in, out, di, uo) is det.
+:- pred insts_add(inst_varset::in, sym_name::in,
+ list(inst_var)::in, inst_defn::in, condition::in, prog_context::in,
+ import_status::in, user_inst_table::in, user_inst_table::out,
+ io::di, io::uo) is det.
% XXX handle abstract insts
-insts_add(_, _, _, _, abstract_inst, _, _, _, _) -->
- { error("sorry, abstract insts not implemented") }.
-insts_add(Insts0, VarSet, Name, Args, eqv_inst(Body),
- _Cond, Context, Status, Insts) -->
- { list__length(Args, Arity) },
- (
- { I = hlds_inst_defn(VarSet, Args, eqv_inst(Body),
- Context, Status) },
- { user_inst_table_insert(Insts0, Name - Arity, I, Insts1) }
+insts_add(_, _, _, abstract_inst, _, _, _, !Insts, !IO) :-
+ error("sorry, abstract insts not implemented").
+insts_add(VarSet, Name, Args, eqv_inst(Body), _Cond, Context, Status, !Insts,
+ !IO) :-
+ list__length(Args, Arity),
+ (
+ I = hlds_inst_defn(VarSet, Args, eqv_inst(Body),
+ Context, Status),
+ user_inst_table_insert(Name - Arity, I, !Insts)
->
- { Insts = Insts1 }
+ true
;
- { Insts = Insts0 },
% If abstract insts are implemented, this will need to change
% to update the hlds_inst_defn to the non-abstract inst.
% XXX we should record each error using
% module_info_incr_errors
- { user_inst_table_get_inst_defns(Insts, InstDefns) },
- { map__lookup(InstDefns, Name - Arity, OrigI) },
- { OrigI = hlds_inst_defn(_, _, _, OrigContext, _) },
+ user_inst_table_get_inst_defns(!.Insts, InstDefns),
+ map__lookup(InstDefns, Name - Arity, OrigI),
+ OrigI = hlds_inst_defn(_, _, _, OrigContext, _),
multiple_def_error(Status, Name, Arity, "inst",
- Context, OrigContext, _)
+ Context, OrigContext, _, !IO)
).
%
% check if the inst is infinitely recursive (at the top level)
%
-:- pred check_for_cyclic_inst(user_inst_table, inst_id, inst_id, list(inst),
- list(inst_id), prog_context, bool, io__state, io__state).
-:- mode check_for_cyclic_inst(in, in, in, in, in, in, out, di, uo) is det.
+:- pred check_for_cyclic_inst(user_inst_table::in, inst_id::in, inst_id::in,
+ list(inst)::in, list(inst_id)::in, prog_context::in, bool::out,
+ io::di, io::uo) is det.
check_for_cyclic_inst(UserInstTable, OrigInstId, InstId0, Args0, Expansions0,
- Context, InvalidMode) -->
- ( { list__member(InstId0, Expansions0) } ->
+ Context, InvalidMode, !IO) :-
+ ( list__member(InstId0, Expansions0) ->
report_circular_equiv_error("inst", OrigInstId, InstId0,
- Expansions0, Context),
- { InvalidMode = yes }
+ Expansions0, Context, !IO),
+ InvalidMode = yes
;
- { user_inst_table_get_inst_defns(UserInstTable, InstDefns) },
+ user_inst_table_get_inst_defns(UserInstTable, InstDefns),
(
- { map__search(InstDefns, InstId0, InstDefn) },
- { InstDefn = hlds_inst_defn(_, Params, Body, _, _) },
- { Body = eqv_inst(EqvInst0) },
- { inst_substitute_arg_list(EqvInst0, Params, Args0,
- EqvInst) },
- { EqvInst = defined_inst(user_inst(Name, Args)) }
- ->
- { Arity = list__length(Args) },
- { InstId = Name - Arity },
- { Expansions = [InstId0 | Expansions0] },
+ map__search(InstDefns, InstId0, InstDefn),
+ InstDefn = hlds_inst_defn(_, Params, Body, _, _),
+ Body = eqv_inst(EqvInst0),
+ inst_substitute_arg_list(EqvInst0, Params, Args0,
+ EqvInst),
+ EqvInst = defined_inst(user_inst(Name, Args))
+ ->
+ Arity = list__length(Args),
+ InstId = Name - Arity,
+ Expansions = [InstId0 | Expansions0],
check_for_cyclic_inst(UserInstTable, OrigInstId,
- InstId, Args, Expansions, Context, InvalidMode)
+ InstId, Args, Expansions, Context, InvalidMode,
+ !IO)
;
- { InvalidMode = no }
+ InvalidMode = no
)
).
%-----------------------------------------------------------------------------%
-:- pred module_add_mode_defn(inst_varset, sym_name, list(inst_var), mode_defn,
- condition, prog_context, item_status, module_info, module_info,
- bool, io__state, io__state).
-:- mode module_add_mode_defn(in, in, in, in, in, in,
- in, in, out, out, di, uo) is det.
+:- pred module_add_mode_defn(inst_varset::in, sym_name::in, list(inst_var)::in,
+ mode_defn::in, condition::in, prog_context::in, item_status::in,
+ module_info::in, module_info::out, bool::out, io::di, io::uo) is det.
module_add_mode_defn(VarSet, Name, Params, ModeDefn, Cond,
Context, item_status(Status, _NeedQual),
!Module, InvalidMode, !IO) :-
module_info_modes(!.Module, Modes0),
- modes_add(Modes0, VarSet, Name, Params, ModeDefn,
- Cond, Context, Status, Modes, InvalidMode, !IO),
+ modes_add(VarSet, Name, Params, ModeDefn,
+ Cond, Context, Status, Modes0, Modes, InvalidMode, !IO),
module_info_set_modes(Modes, !Module).
-:- pred modes_add(mode_table, inst_varset, sym_name, list(inst_var),
- mode_defn, condition, prog_context, import_status,
- mode_table, bool, io__state, io__state).
-:- mode modes_add(in, in, in, in, in, in, in, in, out, out, di, uo) is det.
-
-modes_add(Modes0, VarSet, Name, Args, eqv_mode(Body),
- _Cond, Context, Status, Modes, InvalidMode) -->
- { list__length(Args, Arity) },
- { ModeId = Name - Arity },
- (
- { I = hlds_mode_defn(VarSet, Args, eqv_mode(Body),
- Context, Status) },
- { mode_table_insert(Modes0, ModeId, I, Modes1) }
- ->
- { Modes = Modes1 }
- ;
- { Modes = Modes0 },
- { mode_table_get_mode_defns(Modes, ModeDefns) },
- { map__lookup(ModeDefns, ModeId, OrigI) },
- { OrigI = hlds_mode_defn(_, _, _, OrigContext, _) },
+:- pred modes_add(inst_varset::in, sym_name::in, list(inst_var)::in,
+ mode_defn::in, condition::in, prog_context::in, import_status::in,
+ mode_table::in, mode_table::out, bool::out, io::di, io::uo) is det.
+
+modes_add(VarSet, Name, Args, eqv_mode(Body), _Cond, Context, Status,
+ !Modes, InvalidMode, !IO) :-
+ list__length(Args, Arity),
+ ModeId = Name - Arity,
+ (
+ I = hlds_mode_defn(VarSet, Args, eqv_mode(Body),
+ Context, Status),
+ mode_table_insert(ModeId, I, !Modes)
+ ->
+ true
+ ;
+ mode_table_get_mode_defns(!.Modes, ModeDefns),
+ map__lookup(ModeDefns, ModeId, OrigI),
+ OrigI = hlds_mode_defn(_, _, _, OrigContext, _),
% XXX we should record each error using
% module_info_incr_errors
multiple_def_error(Status, Name, Arity, "mode",
- Context, OrigContext, _)
+ Context, OrigContext, _, !IO)
),
- check_for_cyclic_mode(Modes, ModeId, ModeId, [], Context,
- InvalidMode).
+ check_for_cyclic_mode(!.Modes, ModeId, ModeId, [], Context,
+ InvalidMode, !IO).
%
% check if the mode is infinitely recursive at the top level
%
-:- pred check_for_cyclic_mode(mode_table, mode_id, mode_id, list(mode_id),
- prog_context, bool, io__state, io__state).
-:- mode check_for_cyclic_mode(in, in, in, in, in, out, di, uo) is det.
+:- pred check_for_cyclic_mode(mode_table::in, mode_id::in, mode_id::in,
+ list(mode_id)::in, prog_context::in, bool::out, io::di, io::uo) is det.
check_for_cyclic_mode(ModeTable, OrigModeId, ModeId0, Expansions0, Context,
- InvalidMode) -->
- ( { list__member(ModeId0, Expansions0) } ->
+ InvalidMode, !IO) :-
+ ( list__member(ModeId0, Expansions0) ->
report_circular_equiv_error("mode", OrigModeId, ModeId0,
- Expansions0, Context),
- { InvalidMode = yes }
+ Expansions0, Context, !IO),
+ InvalidMode = yes
;
- { mode_table_get_mode_defns(ModeTable, ModeDefns) },
+ mode_table_get_mode_defns(ModeTable, ModeDefns),
(
- { map__search(ModeDefns, ModeId0, ModeDefn) },
- { ModeDefn = hlds_mode_defn(_, _, Body, _, _) },
- { Body = eqv_mode(EqvMode) },
- { EqvMode = user_defined_mode(Name, Args) }
- ->
- { Arity = list__length(Args) },
- { ModeId = Name - Arity },
- { Expansions = [ModeId0 | Expansions0] },
+ map__search(ModeDefns, ModeId0, ModeDefn),
+ ModeDefn = hlds_mode_defn(_, _, Body, _, _),
+ Body = eqv_mode(EqvMode),
+ EqvMode = user_defined_mode(Name, Args)
+ ->
+ Arity = list__length(Args),
+ ModeId = Name - Arity,
+ Expansions = [ModeId0 | Expansions0],
check_for_cyclic_mode(ModeTable, OrigModeId, ModeId,
- Expansions, Context, InvalidMode)
+ Expansions, Context, InvalidMode, !IO)
;
- { InvalidMode = no }
+ InvalidMode = no
)
).
:- type id == pair(sym_name, arity).
+
:- pred report_circular_equiv_error(string::in, id::in, id::in, list(id)::in,
prog_context::in, io__state::di, io__state::uo) is det.
-report_circular_equiv_error(Kind, OrigId, Id, Expansions, Context) -->
- ( { Id = OrigId } ->
+report_circular_equiv_error(Kind, OrigId, Id, Expansions, Context, !IO) :-
+ ( Id = OrigId ->
%
% Report an error message of the form
% Error: circular equivalence <kind> foo/0.
@@ -2078,24 +2059,24 @@
% and baz/2.
% where <kind> is either "inst" or "mode".
%
- { Kinds = (if Expansions = [_] then Kind else Kind ++ "s") },
- { Pieces0 = list__map(
+ Kinds = (if Expansions = [_] then Kind else Kind ++ "s"),
+ Pieces0 = list__map(
(func(SymName - Arity) =
error_util__describe_sym_name_and_arity(
SymName / Arity)),
- Expansions) },
- { error_util__list_to_pieces(Pieces0, Pieces1) },
- { Pieces = append_punctuation(
+ Expansions),
+ error_util__list_to_pieces(Pieces0, Pieces1),
+ Pieces = append_punctuation(
[words("Error: circular equivalence"),
- fixed(Kinds) | Pieces1], '.') },
- error_util__write_error_pieces(Context, 0, Pieces),
- io__set_exit_status(1)
+ fixed(Kinds) | Pieces1], '.'),
+ error_util__write_error_pieces(Context, 0, Pieces, !IO),
+ io__set_exit_status(1, !IO)
;
% We have an inst `OrigId' which is not itself circular,
% but which is defined in terms of `Id' which is circular.
% Don't bother reporting it now -- it have already been
% reported when we processed the definition of Id.
- []
+ true
).
%-----------------------------------------------------------------------------%
@@ -2105,11 +2086,9 @@
% e.g. `:- type t.', which is parsed as an type definition for
% t which defines t as an abstract_type.
-:- pred module_add_type_defn(tvarset, sym_name, list(type_param),
- type_defn, condition, prog_context, item_status,
- module_info, module_info, io__state, io__state).
-:- mode module_add_type_defn(in, in, in, in, in,
- in, in, in, out, di, uo) is det.
+:- pred module_add_type_defn(tvarset::in, sym_name::in, list(type_param)::in,
+ type_defn::in, condition::in, prog_context::in, item_status::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
module_add_type_defn(TVarSet, Name, Args, TypeDefn, _Cond, Context,
item_status(Status0, NeedQual), !Module, !IO) :-
@@ -2158,8 +2137,8 @@
!IO),
MaybeOldDefn = no
;
- hlds_data__set_type_defn_body(OldDefn0, OldBody,
- OldDefn),
+ hlds_data__set_type_defn_body(OldBody,
+ OldDefn0, OldDefn),
MaybeOldDefn = yes(OldDefn)
)
;
@@ -2390,6 +2369,7 @@
ReservedTag = Body ^ du_type_reserved_tag,
module_info_ctors(!.Module, Ctors0),
module_info_get_partial_qualifier_info(!.Module, PQInfo),
+ % ZZZ
check_for_errors(
(pred(M0::in, M::out, IO0::di, IO::uo) is det :-
module_info_ctor_field_table(M0, CtorFields0),
@@ -2450,8 +2430,8 @@
prog_context::in, bool::out, module_info::in, module_info::out,
io::di, io::uo) is det.
-check_foreign_type(TypeCtor, ForeignTypeBody, Context, FoundError,
- !Module, !IO) :-
+check_foreign_type(TypeCtor, ForeignTypeBody, Context, FoundError, !Module,
+ !IO) :-
TypeCtor = Name - Arity,
module_info_globals(!.Module, Globals),
generating_code(GeneratingCode, !IO),
@@ -2514,9 +2494,9 @@
TypeCheckOnly, ErrorCheckOnly, OutputGradeString],
NotGeneratingCode) }.
-:- pred merge_foreign_type_bodies(compilation_target::in,
- bool::in, hlds_type_body::in,
- hlds_type_body::in, hlds_type_body::out) is semidet.
+:- pred merge_foreign_type_bodies(compilation_target::in, bool::in,
+ hlds_type_body::in, hlds_type_body::in, hlds_type_body::out)
+ is semidet.
% Ignore Mercury definitions if we've got a foreign type
% declaration suitable for this back-end and we aren't making the
@@ -2526,12 +2506,14 @@
merge_foreign_type_bodies(Target, MakeOptInterface,
foreign_type(ForeignTypeBody0, IsSolverType), Body1, Body) :-
MaybeForeignTypeBody1 = Body1 ^ du_type_is_foreign_type,
- ( MaybeForeignTypeBody1 = yes(ForeignTypeBody1)
- ; MaybeForeignTypeBody1 = no,
+ (
+ MaybeForeignTypeBody1 = yes(ForeignTypeBody1)
+ ;
+ MaybeForeignTypeBody1 = no,
ForeignTypeBody1 = foreign_type_body(no, no, no)
),
- merge_foreign_type_bodies_2(ForeignTypeBody0,
- ForeignTypeBody1, ForeignTypeBody),
+ merge_foreign_type_bodies_2(ForeignTypeBody0, ForeignTypeBody1,
+ ForeignTypeBody),
(
have_foreign_type_for_backend(Target, ForeignTypeBody, yes),
MakeOptInterface = no
@@ -2560,12 +2542,12 @@
merge_maybe(MaybeJavaA, MaybeJavaB, MaybeJava).
:- pred merge_maybe(maybe(T)::in, maybe(T)::in, maybe(T)::out) is semidet.
+
merge_maybe(no, no, no).
merge_maybe(yes(T), no, yes(T)).
merge_maybe(no, yes(T), yes(T)).
-:- pred make_status_abstract(import_status, import_status).
-:- mode make_status_abstract(in, out) is det.
+:- pred make_status_abstract(import_status::in, import_status::out) is det.
make_status_abstract(Status, AbstractStatus) :-
( Status = exported ->
@@ -2576,8 +2558,8 @@
AbstractStatus = Status
).
-:- pred combine_status(import_status, import_status, import_status).
-:- mode combine_status(in, in, out) is det.
+:- pred combine_status(import_status::in, import_status::in,
+ import_status::out) is det.
combine_status(StatusA, StatusB, Status) :-
( combine_status_2(StatusA, StatusB, CombinedStatus) ->
@@ -2586,8 +2568,8 @@
error("unexpected status for type definition")
).
-:- pred combine_status_2(import_status, import_status, import_status).
-:- mode combine_status_2(in, in, out) is semidet.
+:- pred combine_status_2(import_status::in, import_status::in,
+ import_status::out) is semidet.
combine_status_2(imported(_), Status2, Status) :-
combine_status_imported(Status2, Status).
@@ -2607,8 +2589,8 @@
combine_status_2(abstract_exported, Status2, Status) :-
combine_status_abstract_exported(Status2, Status).
-:- pred combine_status_imported(import_status, import_status).
-:- mode combine_status_imported(in, out) is semidet.
+:- pred combine_status_imported(import_status::in, import_status::out)
+ is semidet.
combine_status_imported(imported(Section), imported(Section)).
combine_status_imported(local, imported(implementation)).
@@ -2619,8 +2601,7 @@
combine_status_imported(abstract_imported, imported(interface)).
combine_status_imported(abstract_exported, abstract_exported).
-:- pred combine_status_local(import_status, import_status).
-:- mode combine_status_local(in, out) is semidet.
+:- pred combine_status_local(import_status::in, import_status::out) is semidet.
combine_status_local(imported(_), local).
combine_status_local(local, local).
@@ -2629,8 +2610,8 @@
combine_status_local(abstract_imported, local).
combine_status_local(abstract_exported, abstract_exported).
-:- pred combine_status_abstract_exported(import_status, import_status).
-:- mode combine_status_abstract_exported(in, out) is det.
+:- pred combine_status_abstract_exported(import_status::in, import_status::out)
+ is det.
combine_status_abstract_exported(Status2, Status) :-
( Status2 = exported ->
@@ -2639,8 +2620,8 @@
Status = abstract_exported
).
-:- pred combine_status_abstract_imported(import_status, import_status).
-:- mode combine_status_abstract_imported(in, out) is det.
+:- pred combine_status_abstract_imported(import_status::in, import_status::out)
+ is det.
combine_status_abstract_imported(Status2, Status) :-
( Status2 = imported(Section) ->
@@ -2649,8 +2630,8 @@
Status = abstract_imported
).
-:- pred convert_type_defn(type_defn, type_ctor, globals, hlds_type_body).
-:- mode convert_type_defn(in, in, in, out) is det.
+:- pred convert_type_defn(type_defn::in, type_ctor::in, globals::in,
+ hlds_type_body::out) is det.
convert_type_defn(du_type(Body, IsSolverType, EqualityPred), TypeCtor, Globals,
du_type(Body, CtorTags, IsEnum, EqualityPred,
@@ -2681,130 +2662,117 @@
yes(JavaForeignType - UserEqComp))
).
-:- pred ctors_add(list(constructor), type_ctor, tvarset, need_qualifier,
- partial_qualifier_info, prog_context, import_status,
- ctor_field_table, ctor_field_table,
- cons_table, cons_table, io__state, io__state).
-:- mode ctors_add(in, in, in, in, in, in, in, in, out, in, out, di, uo) is det.
+:- pred ctors_add(list(constructor)::in, type_ctor::in, tvarset::in,
+ need_qualifier::in, partial_qualifier_info::in, prog_context::in,
+ import_status::in, ctor_field_table::in, ctor_field_table::out,
+ cons_table::in, cons_table::out, io::di, io::uo) is det.
-ctors_add([], _, _, _, _, _, _, FieldNameTable, FieldNameTable,
- Ctors, Ctors) --> [].
+ctors_add([], _, _, _, _, _, _, !FieldNameTable, !Ctors, !IO).
ctors_add([Ctor | Rest], TypeCtor, TVarSet, NeedQual, PQInfo, Context,
- ImportStatus, FieldNameTable0, FieldNameTable,
- Ctors0, Ctors) -->
- { Ctor = ctor(ExistQVars, Constraints, Name, Args) },
- { make_cons_id(Name, Args, TypeCtor, QualifiedConsId) },
- { ConsDefn = hlds_cons_defn(ExistQVars, Constraints, Args, TypeCtor,
- Context) },
+ ImportStatus, !FieldNameTable, !Ctors, !IO) :-
+ Ctor = ctor(ExistQVars, Constraints, Name, Args),
+ QualifiedConsId = make_cons_id(Name, Args, TypeCtor),
+ ConsDefn = hlds_cons_defn(ExistQVars, Constraints, Args, TypeCtor,
+ Context),
%
% Insert the fully-qualified version of this cons_id into the
% cons_table.
% Also check that there is at most one definition of a given
% cons_id in each type.
%
- (
- { map__search(Ctors0, QualifiedConsId, QualifiedConsDefns0) }
- ->
- { QualifiedConsDefns1 = QualifiedConsDefns0 }
+ ( map__search(!.Ctors, QualifiedConsId, QualifiedConsDefns0) ->
+ QualifiedConsDefns1 = QualifiedConsDefns0
;
- { QualifiedConsDefns1 = [] }
+ QualifiedConsDefns1 = []
),
(
- { list__member(OtherConsDefn, QualifiedConsDefns1) },
- { OtherConsDefn = hlds_cons_defn(_, _, _, TypeCtor, _) }
+ list__member(OtherConsDefn, QualifiedConsDefns1),
+ OtherConsDefn = hlds_cons_defn(_, _, _, TypeCtor, _)
->
% XXX we should record each error using module_info_incr_errors
- prog_out__write_context(Context),
- io__write_string("Error: constructor `"),
- hlds_out__write_cons_id(QualifiedConsId),
- io__write_string("' for type `"),
- hlds_out__write_type_ctor(TypeCtor),
- io__write_string("' multiply defined.\n"),
- io__set_exit_status(1),
- { QualifiedConsDefns = QualifiedConsDefns1 }
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: constructor `", !IO),
+ hlds_out__write_cons_id(QualifiedConsId, !IO),
+ io__write_string("' for type `", !IO),
+ hlds_out__write_type_ctor(TypeCtor, !IO),
+ io__write_string("' multiply defined.\n", !IO),
+ io__set_exit_status(1, !IO),
+ QualifiedConsDefns = QualifiedConsDefns1
;
- { QualifiedConsDefns = [ConsDefn | QualifiedConsDefns1] }
+ QualifiedConsDefns = [ConsDefn | QualifiedConsDefns1]
),
- { map__set(Ctors0, QualifiedConsId, QualifiedConsDefns, Ctors1) },
+ map__set(!.Ctors, QualifiedConsId, QualifiedConsDefns, !:Ctors),
- ( { QualifiedConsId = cons(qualified(Module, ConsName), Arity) } ->
+ ( QualifiedConsId = cons(qualified(Module, ConsName), Arity) ->
% Add unqualified version of the cons_id to the
% cons_table, if appropriate.
- {
+ (
NeedQual = may_be_unqualified
->
UnqualifiedConsId = cons(unqualified(ConsName), Arity),
- multi_map__set(Ctors1, UnqualifiedConsId, ConsDefn,
- Ctors2)
+ multi_map__set(!.Ctors, UnqualifiedConsId, ConsDefn,
+ !:Ctors)
;
- Ctors2 = Ctors1
- },
+ true
+ ),
% Add partially qualified versions of the cons_id
- { get_partial_qualifiers(Module, PQInfo, PartialQuals) },
- { list__map_foldl(add_ctor(ConsName, Arity, ConsDefn),
- PartialQuals, _PartiallyQualifiedConsIds,
- Ctors2, Ctors3) },
+ get_partial_qualifiers(Module, PQInfo, PartialQuals),
+ list__map_foldl(add_ctor(ConsName, Arity, ConsDefn),
+ PartialQuals, _PartiallyQualifiedConsIds, !Ctors),
- { assoc_list__keys(Args, FieldNames) },
- { FirstField = 1 },
+ assoc_list__keys(Args, FieldNames),
+ FirstField = 1,
add_ctor_field_names(FieldNames, NeedQual, PartialQuals,
TypeCtor, QualifiedConsId, Context, ImportStatus,
- FirstField, FieldNameTable0, FieldNameTable1)
+ FirstField, !FieldNameTable, !IO)
;
- { error("ctors_add: cons_id not qualified") }
+ error("ctors_add: cons_id not qualified")
),
-
ctors_add(Rest, TypeCtor, TVarSet, NeedQual, PQInfo, Context,
- ImportStatus, FieldNameTable1, FieldNameTable, Ctors3, Ctors).
+ ImportStatus, !FieldNameTable, !Ctors, !IO).
-:- pred add_ctor(string, int, hlds_cons_defn, module_name,
- cons_id, cons_table, cons_table).
-:- mode add_ctor(in, in, in, in, out, in, out) is det.
+:- pred add_ctor(string::in, int::in, hlds_cons_defn::in, module_name::in,
+ cons_id::out, cons_table::in, cons_table::out) is det.
add_ctor(ConsName, Arity, ConsDefn, ModuleQual, ConsId, CtorsIn, CtorsOut) :-
ConsId = cons(qualified(ModuleQual, ConsName), Arity),
multi_map__set(CtorsIn, ConsId, ConsDefn, CtorsOut).
-:- pred add_ctor_field_names(list(maybe(ctor_field_name)),
- need_qualifier, list(module_name), type_ctor, cons_id,
- prog_context, import_status, int, ctor_field_table,
- ctor_field_table, io__state, io__state).
-:- mode add_ctor_field_names(in, in, in, in, in, in, in, in,
- in, out, di, uo) is det.
+:- pred add_ctor_field_names(list(maybe(ctor_field_name))::in,
+ need_qualifier::in, list(module_name)::in, type_ctor::in, cons_id::in,
+ prog_context::in, import_status::in, int::in,
+ ctor_field_table::in, ctor_field_table::out, io::di, io::uo) is det.
-add_ctor_field_names([], _, _, _, _, _, _, _,
- FieldNameTable, FieldNameTable) --> [].
+add_ctor_field_names([], _, _, _, _, _, _, _, !FieldNameTable, !IO).
add_ctor_field_names([MaybeFieldName | FieldNames], NeedQual,
PartialQuals, TypeCtor, ConsId, Context, ImportStatus,
- FieldNumber, FieldNameTable0, FieldNameTable) -->
+ FieldNumber, !FieldNameTable, !IO) :-
(
- { MaybeFieldName = yes(FieldName) },
- { FieldDefn = hlds_ctor_field_defn(Context, ImportStatus,
- TypeCtor, ConsId, FieldNumber) },
+ MaybeFieldName = yes(FieldName),
+ FieldDefn = hlds_ctor_field_defn(Context, ImportStatus,
+ TypeCtor, ConsId, FieldNumber),
add_ctor_field_name(FieldName, FieldDefn, NeedQual,
- PartialQuals, FieldNameTable0, FieldNameTable2)
+ PartialQuals, !FieldNameTable, !IO)
;
- { MaybeFieldName = no },
- { FieldNameTable2 = FieldNameTable0 }
+ MaybeFieldName = no
),
add_ctor_field_names(FieldNames, NeedQual, PartialQuals, TypeCtor,
ConsId, Context, ImportStatus, FieldNumber + 1,
- FieldNameTable2, FieldNameTable).
+ !FieldNameTable, !IO).
-:- pred add_ctor_field_name(ctor_field_name, hlds_ctor_field_defn,
- need_qualifier, list(module_name), ctor_field_table,
- ctor_field_table, io__state, io__state).
-:- mode add_ctor_field_name(in, in, in, in, in, out, di, uo) is det.
+:- pred add_ctor_field_name(ctor_field_name::in, hlds_ctor_field_defn::in,
+ need_qualifier::in, list(module_name)::in,
+ ctor_field_table::in, ctor_field_table::out, io::di, io::uo) is det.
add_ctor_field_name(FieldName, FieldDefn, NeedQual, PartialQuals,
- FieldNameTable0, FieldNameTable) -->
- { FieldName = qualified(FieldModule0, _) ->
+ !FieldNameTable, !IO) :-
+ ( FieldName = qualified(FieldModule0, _) ->
FieldModule = FieldModule0
;
error("add_ctor_field_name: unqualified field name")
- },
+ ),
(
%
% Field names must be unique within a module, not
@@ -2812,67 +2780,60 @@
% user-defined override functions for the builtin field
% access functions must be unique within a module.
%
- { map__search(FieldNameTable0, FieldName, ConflictingDefns) }
+ map__search(!.FieldNameTable, FieldName, ConflictingDefns)
->
- { ConflictingDefns = [ConflictingDefn] ->
+ ( ConflictingDefns = [ConflictingDefn] ->
ConflictingDefn =
hlds_ctor_field_defn(OrigContext, _, _, _, _)
;
error(
"add_ctor_field_name: multiple conflicting fields")
- },
+ ),
% XXX we should record each error
% using module_info_incr_errors
- { FieldDefn = hlds_ctor_field_defn(Context, _, _, _, _) },
- { prog_out__sym_name_to_string(FieldName, FieldString) },
- { ErrorPieces = [
+ FieldDefn = hlds_ctor_field_defn(Context, _, _, _, _),
+ prog_out__sym_name_to_string(FieldName, FieldString),
+ ErrorPieces = [
words("Error: field"),
fixed(string__append_list(["`", FieldString, "'"])),
words("multiply defined.")
- ] },
- error_util__write_error_pieces(Context, 0, ErrorPieces),
+ ],
+ error_util__write_error_pieces(Context, 0, ErrorPieces, !IO),
% This type of error doesn't fit well with
% how error_util does things -- error_util.m
% wants to write everything with a single context.
- prog_out__write_context(OrigContext),
+ prog_out__write_context(OrigContext, !IO),
io__write_string(
- " Here is the previous definition of field `"),
- io__write_string(FieldString),
- io__write_string("'.\n"),
- io__set_exit_status(1),
- { FieldNameTable = FieldNameTable0 }
+ " Here is the previous definition of field `", !IO),
+ io__write_string(FieldString, !IO),
+ io__write_string("'.\n", !IO),
+ io__set_exit_status(1, !IO)
;
- { unqualify_name(FieldName, UnqualFieldName) },
+ unqualify_name(FieldName, UnqualFieldName),
% Add an unqualified version of the field name to the
% table, if appropriate.
- {
- NeedQual = may_be_unqualified
- ->
- multi_map__set(FieldNameTable0,
- unqualified(UnqualFieldName),
- FieldDefn, FieldNameTable1)
+ ( NeedQual = may_be_unqualified ->
+ multi_map__set(!.FieldNameTable,
+ unqualified(UnqualFieldName), FieldDefn,
+ !:FieldNameTable)
;
- FieldNameTable1 = FieldNameTable0
- },
+ true
+ ),
% Add partially qualified versions of the cons_id
- { list__foldl(
- do_add_ctor_field(UnqualFieldName, FieldDefn),
- [FieldModule | PartialQuals],
- FieldNameTable1, FieldNameTable) }
+ list__foldl(do_add_ctor_field(UnqualFieldName, FieldDefn),
+ [FieldModule | PartialQuals], !FieldNameTable)
).
-:- pred do_add_ctor_field(string, hlds_ctor_field_defn, module_name,
- ctor_field_table, ctor_field_table).
-:- mode do_add_ctor_field(in, in, in, in, out) is det.
-
-do_add_ctor_field(FieldName, FieldNameDefn, ModuleName,
- FieldNameTable0, FieldNameTable) :-
- multi_map__set(FieldNameTable0, qualified(ModuleName, FieldName),
- FieldNameDefn, FieldNameTable).
+:- pred do_add_ctor_field(string::in, hlds_ctor_field_defn::in,
+ module_name::in, ctor_field_table::in, ctor_field_table::out) is det.
+
+do_add_ctor_field(FieldName, FieldNameDefn, ModuleName, !FieldNameTable) :-
+ multi_map__set(!.FieldNameTable, qualified(ModuleName, FieldName),
+ FieldNameDefn, !:FieldNameTable).
%-----------------------------------------------------------------------------%
@@ -2941,8 +2902,8 @@
item_status::in, module_info::in, module_info::out,
io__state::di, io__state::uo) is det.
-module_add_class_defn(Constraints, Name, Vars, Interface, VarSet,
- Context, Status, !Module, !IO) :-
+module_add_class_defn(Constraints, Name, Vars, Interface, VarSet, Context,
+ Status, !Module, !IO) :-
module_info_classes(!.Module, Classes0),
module_info_superclasses(!.Module, SuperClasses0),
list__length(Vars, ClassArity),
@@ -3062,10 +3023,9 @@
true
).
-:- pred superclass_constraints_are_identical(list(tvar), tvarset,
- list(class_constraint), list(tvar), tvarset, list(class_constraint)).
-:- mode superclass_constraints_are_identical(in, in,
- in, in, in, in) is semidet.
+:- pred superclass_constraints_are_identical(list(tvar)::in, tvarset::in,
+ list(class_constraint)::in, list(tvar)::in, tvarset::in,
+ list(class_constraint)::in) is semidet.
superclass_constraints_are_identical(OldVars0, OldVarSet, OldConstraints0,
Vars, VarSet, Constraints) :-
@@ -3241,12 +3201,12 @@
"instance declaration", !IO)
).
-:- pred check_for_overlapping_instances(hlds_instance_defn,
- list(hlds_instance_defn), class_id, io__state, io__state).
-:- mode check_for_overlapping_instances(in, in, in, di, uo) is det.
+:- pred check_for_overlapping_instances(hlds_instance_defn::in,
+ list(hlds_instance_defn)::in, class_id::in, io::di, io::uo) is det.
-check_for_overlapping_instances(NewInstanceDefn, InstanceDefns, ClassId) -->
- { IsOverlapping = (pred((Context - OtherContext)::out) is nondet :-
+check_for_overlapping_instances(NewInstanceDefn, InstanceDefns, ClassId,
+ !IO) :-
+ IsOverlapping = (pred((Context - OtherContext)::out) is nondet :-
NewInstanceDefn = hlds_instance_defn(_, _Status, Context,
_, Types, Body, _, VarSet, _),
Body \= abstract, % XXX
@@ -3258,13 +3218,12 @@
varset__merge(VarSet, OtherVarSet, OtherTypes,
_NewVarSet, NewOtherTypes),
type_list_subsumes(Types, NewOtherTypes, _)
- ) },
+ ),
aggregate(IsOverlapping,
- report_overlapping_instance_declaration(ClassId)).
+ report_overlapping_instance_declaration(ClassId), !IO).
-:- pred report_overlapping_instance_declaration(class_id, pair(prog_context),
- io__state, io__state).
-:- mode report_overlapping_instance_declaration(in, in, di, uo) is det.
+:- pred report_overlapping_instance_declaration(class_id::in,
+ pair(prog_context)::in, io::di, io::uo) is det.
report_overlapping_instance_declaration(class_id(ClassName, ClassArity),
Context - OtherContext) -->
@@ -3293,9 +3252,9 @@
% lambda expressions into separate predicates, so any changes may need
% to be reflected there too.
-add_new_pred(TVarSet, ExistQVars, PredName, Types, Cond, Purity,
- ClassContext, Markers0, Context, ItemStatus, NeedQual,
- PredOrFunc, !Module, !IO) :-
+add_new_pred(TVarSet, ExistQVars, PredName, Types, Cond, Purity, ClassContext,
+ Markers0, Context, ItemStatus, NeedQual, PredOrFunc,
+ !Module, !IO) :-
% Only preds with opt_imported clauses are tagged as opt_imported, so
% that the compiler doesn't look for clauses for other preds read in
% from optimization interfaces.
@@ -3304,10 +3263,8 @@
;
Status = ItemStatus
),
-
check_tvars_in_constraints(ClassContext, Types, TVarSet,
PredOrFunc, PredName, Context, !Module, !IO),
-
module_info_name(!.Module, ModuleName),
list__length(Types, Arity),
(
@@ -3351,8 +3308,8 @@
;
module_info_get_partial_qualifier_info(!.Module,
PQInfo),
- predicate_table_insert(PredicateTable0, PredInfo0,
- NeedQual, PQInfo, PredId, PredicateTable1),
+ predicate_table_insert(PredInfo0, NeedQual, PQInfo,
+ PredId, PredicateTable0, PredicateTable1),
( pred_info_is_builtin(PredInfo0) ->
add_builtin(PredId, Types,
PredInfo0, PredInfo),
@@ -3360,8 +3317,8 @@
Preds1),
map__det_update(Preds1, PredId, PredInfo,
Preds),
- predicate_table_set_preds(PredicateTable1,
- Preds, PredicateTable)
+ predicate_table_set_preds(Preds,
+ PredicateTable1, PredicateTable)
;
PredicateTable = PredicateTable1
),
@@ -3376,26 +3333,24 @@
% check for type variables which occur in the the class constraints,
% but which don't occur in the predicate argument types
%
-:- pred check_tvars_in_constraints(class_constraints, list(type), tvarset,
- pred_or_func, sym_name, prog_context,
- module_info, module_info, io__state, io__state).
-:- mode check_tvars_in_constraints(in, in, in, in, in, in,
- in, out, di, uo) is det.
+:- pred check_tvars_in_constraints(class_constraints::in, list(type)::in,
+ tvarset::in, pred_or_func::in, sym_name::in, prog_context::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
check_tvars_in_constraints(ClassContext, ArgTypes, TVarSet,
- PredOrFunc, PredName, Context, Module0, Module) -->
- { solutions(constrained_tvar_not_in_arg_types(ClassContext, ArgTypes),
- UnboundTVars) },
- ( { UnboundTVars = [] } ->
- { Module = Module0 }
+ PredOrFunc, PredName, Context, !Module, !IO) :-
+ solutions(constrained_tvar_not_in_arg_types(ClassContext, ArgTypes),
+ UnboundTVars),
+ ( UnboundTVars = [] ->
+ true
;
- { module_info_incr_errors(Module0, Module) },
+ module_info_incr_errors(!Module),
report_unbound_tvars_in_class_context(UnboundTVars, ArgTypes,
- TVarSet, PredOrFunc, PredName, Context)
+ TVarSet, PredOrFunc, PredName, Context, !IO)
).
-:- pred constrained_tvar_not_in_arg_types(class_constraints, list(type), tvar).
-:- mode constrained_tvar_not_in_arg_types(in, in, out) is nondet.
+:- pred constrained_tvar_not_in_arg_types(class_constraints::in,
+ list(type)::in, tvar::out) is nondet.
constrained_tvar_not_in_arg_types(ClassContext, ArgTypes, TVar) :-
ClassContext = constraints(UnivCs, ExistCs),
@@ -3404,11 +3359,9 @@
list__member(TVar, TVars),
\+ term__contains_var_list(ArgTypes, TVar).
-:- pred report_unbound_tvars_in_class_context(list(tvar), list(type), tvarset,
- pred_or_func, sym_name, prog_context,
- io__state, io__state).
-:- mode report_unbound_tvars_in_class_context(in, in, in, in, in, in,
- di, uo) is det.
+:- pred report_unbound_tvars_in_class_context(list(tvar)::in, list(type)::in,
+ tvarset::in, pred_or_func::in, sym_name::in, prog_context::in,
+ io::di, io::uo) is det.
/*
The error message is intended to look like this:
@@ -3465,31 +3418,28 @@
%-----------------------------------------------------------------------------%
-:- pred maybe_check_field_access_function(sym_name, arity, import_status,
- prog_context, module_info, io__state, io__state).
-:- mode maybe_check_field_access_function(in, in, in, in, in, di, uo) is det.
+:- pred maybe_check_field_access_function(sym_name::in, arity::in,
+ import_status::in, prog_context::in, module_info::in,
+ io::di, io::uo) is det.
-maybe_check_field_access_function(FuncName, FuncArity,
- Status, Context, Module) -->
+maybe_check_field_access_function(FuncName, FuncArity, Status, Context,
+ Module, !IO) :-
(
- { is_field_access_function_name(Module, FuncName, FuncArity,
- AccessType, FieldName) }
+ is_field_access_function_name(Module, FuncName, FuncArity,
+ AccessType, FieldName)
->
check_field_access_function(AccessType, FieldName, FuncName,
- FuncArity, Status, Context, Module)
+ FuncArity, Status, Context, Module, !IO)
;
- []
+ true
).
-:- pred check_field_access_function(field_access_type,
- ctor_field_name, sym_name,
- arity, import_status, prog_context, module_info,
- io__state, io__state).
-:- mode check_field_access_function(in, in, in, in, in, in, in,
- di, uo) is det.
+:- pred check_field_access_function(field_access_type::in, ctor_field_name::in,
+ sym_name::in, arity::in, import_status::in, prog_context::in,
+ module_info::in, io::di, io::uo) is det.
check_field_access_function(_AccessType, FieldName, FuncName, FuncArity,
- FuncStatus, Context, Module, IO0, IO) :-
+ FuncStatus, Context, Module, !IO) :-
adjust_func_arity(function, FuncArity, PredArity),
FuncCallId = function - FuncName/PredArity,
@@ -3506,32 +3456,30 @@
FieldDefn = hlds_ctor_field_defn(_, DefnStatus, _, _, _),
DefnStatus = exported, FuncStatus \= exported
->
- report_field_status_mismatch(Context,
- FuncCallId, IO0, IO)
+ report_field_status_mismatch(Context, FuncCallId, !IO)
;
- IO = IO0
+ true
).
-:- pred report_field_status_mismatch(prog_context, simple_call_id,
- io__state, io__state).
-:- mode report_field_status_mismatch(in, in, di, uo) is det.
+:- pred report_field_status_mismatch(prog_context::in, simple_call_id::in,
+ io::di, io::uo) is det.
-report_field_status_mismatch(Context, CallId) -->
- { hlds_out__simple_call_id_to_string(CallId, CallIdString) },
- { ErrorPieces = [
+report_field_status_mismatch(Context, CallId, !IO) :-
+ hlds_out__simple_call_id_to_string(CallId, CallIdString),
+ ErrorPieces = [
words("In declaration of"),
fixed(string__append(CallIdString, ":")),
nl,
words("error: a field access function for an"),
words("exported field must also be exported.")
- ]},
- error_util__write_error_pieces(Context, 0, ErrorPieces),
- io__set_exit_status(1).
+ ],
+ error_util__write_error_pieces(Context, 0, ErrorPieces, !IO),
+ io__set_exit_status(1, !IO).
%-----------------------------------------------------------------------------%
-:- pred add_builtin(pred_id, list(type), pred_info, pred_info).
-:- mode add_builtin(in, in, in, out) is det.
+:- pred add_builtin(pred_id::in, list(type)::in, pred_info::in, pred_info::out)
+ is det.
% For a builtin predicate, say foo/2, we add a clause
%
@@ -3749,7 +3697,7 @@
add_special_pred_for_real(SpecialPredId, TVarSet, Type0, TypeCtor,
TypeBody, Context, Status0, !Module) :-
Type = adjust_types_with_special_preds_in_private_builtin(Type0),
- adjust_special_pred_status(Status0, SpecialPredId, Status),
+ adjust_special_pred_status(SpecialPredId, Status0, Status),
module_info_get_special_pred_map(!.Module, SpecialPredMap0),
( map__contains(SpecialPredMap0, SpecialPredId - TypeCtor) ->
true
@@ -3805,7 +3753,8 @@
( type_to_ctor_and_args(Type, TypeCtor, []) ->
( is_builtin_types_special_preds_defined_in_mercury(TypeCtor,
Name) ->
- construct_type(unqualified(Name) - 0, [], NormalizedType)
+ construct_type(unqualified(Name) - 0, [],
+ NormalizedType)
;
NormalizedType = Type
)
@@ -3853,7 +3802,7 @@
special_pred_name_arity(SpecialPredId, _, Arity),
Cond `with_type` condition = true,
clauses_info_init(Arity, ClausesInfo0),
- adjust_special_pred_status(Status0, SpecialPredId, Status),
+ adjust_special_pred_status(SpecialPredId, Status0, Status),
map__init(Proofs),
init_markers(Markers),
% XXX If/when we have "comparable" or "unifiable" typeclasses,
@@ -3871,13 +3820,13 @@
varset__init(InstVarSet),
% Should not be any inst vars here so it's ok to use a
% fresh inst_varset.
- add_new_proc(PredInfo1, InstVarSet, Arity, ArgModes, yes(ArgModes),
- ArgLives, yes(Det), Context, address_is_not_taken, PredInfo,
+ add_new_proc(InstVarSet, Arity, ArgModes, yes(ArgModes), ArgLives,
+ yes(Det), Context, address_is_not_taken, PredInfo1, PredInfo,
_),
module_info_get_predicate_table(!.Module, PredicateTable0),
- predicate_table_insert(PredicateTable0, PredInfo,
- PredId, PredicateTable),
+ predicate_table_insert(PredInfo, PredId,
+ PredicateTable0, PredicateTable),
module_info_set_predicate_table(PredicateTable, !Module),
module_info_get_special_pred_map(!.Module, SpecialPredMap0),
map__set(SpecialPredMap0, SpecialPredId - TypeCtor, PredId,
@@ -3903,35 +3852,34 @@
Status = pseudo_imported
).
-:- pred adjust_special_pred_status(import_status, special_pred_id,
- import_status).
-:- mode adjust_special_pred_status(in, in, out) is det.
-
-adjust_special_pred_status(Status0, SpecialPredId, Status) :-
- ( ( Status0 = opt_imported ; Status0 = abstract_imported ) ->
- Status1 = imported(interface)
- ; Status0 = abstract_exported ->
- Status1 = exported
+:- pred adjust_special_pred_status(special_pred_id::in,
+ import_status::in, import_status::out) is det.
+
+adjust_special_pred_status(SpecialPredId, !Status) :-
+ ( ( !.Status = opt_imported ; !.Status = abstract_imported ) ->
+ !:Status = imported(interface)
+ ; !.Status = abstract_exported ->
+ !:Status = exported
;
- Status1 = Status0
+ true
),
% unification predicates are special - they are
% "pseudo"-imported/exported (only mode 0 is imported/exported).
( SpecialPredId = unify ->
- ( Status1 = imported(_) ->
- Status = pseudo_imported
- ; Status1 = exported ->
- Status = pseudo_exported
+ ( !.Status = imported(_) ->
+ !:Status = pseudo_imported
+ ; !.Status = exported ->
+ !:Status = pseudo_exported
;
- Status = Status1
+ true
)
;
- Status = Status1
+ true
).
-add_new_proc(PredInfo0, InstVarSet, Arity, ArgModes, MaybeDeclaredArgModes,
- MaybeArgLives, MaybeDet, Context, IsAddressTaken, PredInfo,
+add_new_proc(InstVarSet, Arity, ArgModes, MaybeDeclaredArgModes, MaybeArgLives,
+ MaybeDet, Context, IsAddressTaken, PredInfo0, PredInfo,
ModeId) :-
pred_info_procedures(PredInfo0, Procs0),
pred_info_arg_types(PredInfo0, ArgTypes),
@@ -3985,54 +3933,55 @@
predicate_table_get_preds(PredicateTable1, Preds0),
map__lookup(Preds0, PredId, PredInfo0),
- module_do_add_mode(PredInfo0, InstVarSet, Arity, Modes, MaybeDet,
- IsClassMethod, MContext, PredInfo, ProcId, !IO),
+ module_do_add_mode(InstVarSet, Arity, Modes, MaybeDet,
+ IsClassMethod, MContext, PredInfo0, PredInfo, ProcId, !IO),
map__det_update(Preds0, PredId, PredInfo, Preds),
- predicate_table_set_preds(PredicateTable1, Preds, PredicateTable),
+ predicate_table_set_preds(Preds, PredicateTable1, PredicateTable),
module_info_set_predicate_table(PredicateTable, !ModuleInfo),
PredProcId = PredId - ProcId.
-:- pred module_do_add_mode(pred_info::in, inst_varset::in, arity::in,
- list(mode)::in, maybe(determinism)::in, bool::in, prog_context::in,
- pred_info::out, proc_id::out, io__state::di, io__state::uo) is det.
+:- pred module_do_add_mode(inst_varset::in, arity::in, list(mode)::in,
+ maybe(determinism)::in, bool::in, prog_context::in,
+ pred_info::in, pred_info::out, proc_id::out,
+ io__state::di, io__state::uo) is det.
-module_do_add_mode(PredInfo0, InstVarSet, Arity, Modes, MaybeDet,
- IsClassMethod, MContext, PredInfo, ProcId) -->
+module_do_add_mode(InstVarSet, Arity, Modes, MaybeDet, IsClassMethod, MContext,
+ !PredInfo, ProcId, !IO) :-
% check that the determinism was specified
(
- { MaybeDet = no }
+ MaybeDet = no
->
- { pred_info_import_status(PredInfo0, ImportStatus) },
- { PredOrFunc = pred_info_is_pred_or_func(PredInfo0) },
- { PredModule = pred_info_module(PredInfo0) },
- { PredName = pred_info_name(PredInfo0) },
- { PredSymName = qualified(PredModule, PredName) },
- ( { IsClassMethod = yes } ->
+ pred_info_import_status(!.PredInfo, ImportStatus),
+ PredOrFunc = pred_info_is_pred_or_func(!.PredInfo),
+ PredModule = pred_info_module(!.PredInfo),
+ PredName = pred_info_name(!.PredInfo),
+ PredSymName = qualified(PredModule, PredName),
+ ( IsClassMethod = yes ->
unspecified_det_for_method(PredSymName, Arity,
- PredOrFunc, MContext)
- ; { status_is_exported(ImportStatus, yes) } ->
+ PredOrFunc, MContext, !IO)
+ ; status_is_exported(ImportStatus, yes) ->
unspecified_det_for_exported(PredSymName, Arity,
- PredOrFunc, MContext)
+ PredOrFunc, MContext, !IO)
;
- globals__io_lookup_bool_option(infer_det, InferDet),
+ globals__io_lookup_bool_option(infer_det, InferDet,
+ !IO),
(
- { InferDet = no }
+ InferDet = no
->
unspecified_det_for_local(PredSymName, Arity,
- PredOrFunc, MContext)
+ PredOrFunc, MContext, !IO)
;
- []
+ true
)
)
;
- []
+ true
),
% add the mode declaration to the pred_info for this procedure.
- { ArgLives = no },
- { add_new_proc(PredInfo0, InstVarSet, Arity, Modes, yes(Modes),
- ArgLives, MaybeDet, MContext, address_is_not_taken, PredInfo,
- ProcId) }.
+ ArgLives = no,
+ add_new_proc(InstVarSet, Arity, Modes, yes(Modes), ArgLives, MaybeDet,
+ MContext, address_is_not_taken, !PredInfo, ProcId).
% Whenever there is a clause or mode declaration for an undeclared
% predicate, we add an implicit declaration
@@ -4058,47 +4007,38 @@
true
),
module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
- preds_add_implicit(!.ModuleInfo, PredicateTable0, ModuleName, PredName,
- Arity, Status, Context, PredOrFunc, PredId, PredicateTable),
+ preds_add_implicit(!.ModuleInfo, ModuleName, PredName, Arity, Status,
+ Context, PredOrFunc, PredId, PredicateTable0, PredicateTable),
module_info_set_predicate_table(PredicateTable, !ModuleInfo).
-:- pred preds_add_implicit(module_info, predicate_table, module_name,
- sym_name, arity, import_status, prog_context,
- pred_or_func, pred_id, predicate_table).
-:- mode preds_add_implicit(in, in, in, in, in, in, in, in, out, out) is det.
+:- pred preds_add_implicit(module_info::in, module_name::in, sym_name::in,
+ arity::in, import_status::in, prog_context::in, pred_or_func::in,
+ pred_id::out, predicate_table::in, predicate_table::out) is det.
-preds_add_implicit(ModuleInfo, PredicateTable0, ModuleName, PredName, Arity,
- Status, Context, PredOrFunc, PredId, PredicateTable) :-
+preds_add_implicit(ModuleInfo, ModuleName, PredName, Arity, Status, Context,
+ PredOrFunc, PredId, !PredicateTable) :-
clauses_info_init(Arity, ClausesInfo),
- preds_add_implicit_2(ClausesInfo, ModuleInfo, PredicateTable0,
- ModuleName, PredName, Arity, Status, Context,
- PredOrFunc, PredId, PredicateTable).
-
-:- pred preds_add_implicit_for_assertion(prog_vars, module_info,
- predicate_table, module_name, sym_name, arity,
- import_status, prog_context, pred_or_func,
- pred_id, predicate_table).
-:- mode preds_add_implicit_for_assertion(in, in, in,
- in, in, in, in, in, in, out, out) is det.
-
-preds_add_implicit_for_assertion(HeadVars,
- ModuleInfo, PredicateTable0, ModuleName,
- PredName, Arity, Status, Context,
- PredOrFunc, PredId, PredicateTable) :-
+ preds_add_implicit_2(ClausesInfo, ModuleInfo, ModuleName, PredName,
+ Arity, Status, Context, PredOrFunc, PredId, !PredicateTable).
+
+:- pred preds_add_implicit_for_assertion(prog_vars::in, module_info::in,
+ module_name::in, sym_name::in, arity::in, import_status::in,
+ prog_context::in, pred_or_func::in, pred_id::out,
+ predicate_table::in, predicate_table::out) is det.
+
+preds_add_implicit_for_assertion(HeadVars, ModuleInfo, ModuleName, PredName,
+ Arity, Status, Context, PredOrFunc, PredId, !PredicateTable) :-
clauses_info_init_for_assertion(HeadVars, ClausesInfo),
- preds_add_implicit_2(ClausesInfo, ModuleInfo, PredicateTable0,
- ModuleName, PredName, Arity, Status, Context,
- PredOrFunc, PredId, PredicateTable).
-
-:- pred preds_add_implicit_2(clauses_info, module_info, predicate_table,
- module_name, sym_name, arity, import_status, prog_context,
- pred_or_func, pred_id, predicate_table).
-:- mode preds_add_implicit_2(in, in, in,
- in, in, in, in, in, in, out, out) is det.
-
-preds_add_implicit_2(ClausesInfo, ModuleInfo, PredicateTable0, ModuleName,
- PredName, Arity, Status, Context,
- PredOrFunc, PredId, PredicateTable) :-
+ preds_add_implicit_2(ClausesInfo, ModuleInfo, ModuleName, PredName,
+ Arity, Status, Context, PredOrFunc, PredId, !PredicateTable).
+
+:- pred preds_add_implicit_2(clauses_info::in, module_info::in,
+ module_name::in, sym_name::in, arity::in, import_status::in,
+ prog_context::in, pred_or_func::in, pred_id::out,
+ predicate_table::in, predicate_table::out) is det.
+
+preds_add_implicit_2(ClausesInfo, ModuleInfo, ModuleName, PredName, Arity,
+ Status, Context, PredOrFunc, PredId, !PredicateTable) :-
varset__init(TVarSet0),
make_n_fresh_vars("T", Arity, TypeVars, TVarSet0, TVarSet),
term__var_list_to_term_list(TypeVars, Types),
@@ -4119,13 +4059,13 @@
add_marker(infer_type, Markers0, Markers),
pred_info_set_markers(Markers, PredInfo0, PredInfo),
(
- \+ predicate_table_search_pf_sym_arity(PredicateTable0,
+ \+ predicate_table_search_pf_sym_arity(!.PredicateTable,
is_fully_qualified, PredOrFunc, PredName, Arity, _)
->
module_info_get_partial_qualifier_info(ModuleInfo,
MQInfo),
- predicate_table_insert(PredicateTable0, PredInfo,
- may_be_unqualified, MQInfo, PredId, PredicateTable)
+ predicate_table_insert(PredInfo,
+ may_be_unqualified, MQInfo, PredId, !PredicateTable)
;
error("preds_add_implicit")
).
@@ -4202,9 +4142,9 @@
->
term__term_list_to_var_list(Args, HeadVars),
preds_add_implicit_for_assertion(HeadVars,
- !.ModuleInfo, PredicateTable0, ModuleName,
- PredName, Arity, Status, Context, PredOrFunc,
- PredId, PredicateTable1),
+ !.ModuleInfo, ModuleName, PredName, Arity,
+ Status, Context, PredOrFunc, PredId,
+ PredicateTable0, PredicateTable1),
module_info_set_predicate_table(PredicateTable1,
!ModuleInfo)
;
@@ -4330,8 +4270,8 @@
PredInfo = PredInfo6
),
map__det_update(Preds0, PredId, PredInfo, Preds),
- predicate_table_set_preds(PredicateTable2, Preds,
- PredicateTable),
+ predicate_table_set_preds(Preds,
+ PredicateTable2, PredicateTable),
module_info_set_predicate_table(PredicateTable, !ModuleInfo),
( Status \= opt_imported ->
% warn about singleton variables
@@ -4449,23 +4389,22 @@
:- pred get_mode_annotations(list(prog_term)::in, list(prog_term)::out,
mode_annotations::in, mode_annotations::out) is det.
-get_mode_annotations([], [], Annotations, Annotations).
-get_mode_annotations([Arg0 | Args0], [Arg | Args],
- Annotations0, Annotations) :-
+get_mode_annotations([], [], !Annotations).
+get_mode_annotations([Arg0 | Args0], [Arg | Args], !Annotations) :-
get_mode_annotation(Arg0, Arg, MaybeAnnotation),
- add_annotation(Annotations0, MaybeAnnotation, Annotations1),
- get_mode_annotations(Args0, Args, Annotations1, Annotations).
+ add_annotation(MaybeAnnotation, !Annotations),
+ get_mode_annotations(Args0, Args, !Annotations).
-:- pred add_annotation(mode_annotations::in, maybe(mode)::in,
- mode_annotations::out) is det.
+:- pred add_annotation(maybe(mode)::in,
+ mode_annotations::in, mode_annotations::out) is det.
-add_annotation(empty, no, none).
-add_annotation(empty, yes(Mode), modes([Mode])).
-add_annotation(modes(_ `with_type` list(mode)), no, mixed).
-add_annotation(modes(Modes), yes(Mode), modes(Modes ++ [Mode])).
-add_annotation(none, no, none).
-add_annotation(none, yes(_), mixed).
-add_annotation(mixed, _, mixed).
+add_annotation(no, empty, none).
+add_annotation(yes(Mode), empty, modes([Mode])).
+add_annotation(no, modes(_ `with_type` list(mode)), mixed).
+add_annotation(yes(Mode), modes(Modes), modes(Modes ++ [Mode])).
+add_annotation(no, none, none).
+add_annotation(yes(_), none, mixed).
+add_annotation(_, mixed, mixed).
% Extract the mode annotations (if any) from a single argument.
:- pred get_mode_annotation(prog_term::in, prog_term::out, maybe(mode)::out)
@@ -4474,8 +4413,8 @@
get_mode_annotation(Arg0, Arg, MaybeAnnotation) :-
(
Arg0 = term__functor(term__atom("::"), [Arg1, ModeTerm], _),
- convert_mode(allow_constrained_inst_var, term__coerce(ModeTerm),
- Mode)
+ convert_mode(allow_constrained_inst_var,
+ term__coerce(ModeTerm), Mode)
->
Arg = Arg1,
MaybeAnnotation = yes(Mode)
@@ -4502,13 +4441,9 @@
goal_info_set_context(GoalInfo0, Context, GoalInfo1),
set__list_to_set(HeadVars, NonLocals),
goal_info_set_nonlocals(GoalInfo1, NonLocals, GoalInfo2),
- (
- check_marker(Markers, (impure))
- ->
+ ( check_marker(Markers, (impure)) ->
goal_info_add_feature(GoalInfo2, (impure), GoalInfo)
- ;
- check_marker(Markers, (semipure))
- ->
+ ; check_marker(Markers, (semipure)) ->
goal_info_add_feature(GoalInfo2, (semipure), GoalInfo)
;
GoalInfo = GoalInfo2
@@ -4607,8 +4542,8 @@
prog_context::in, module_info::in, module_info::out,
qual_info::in, qual_info::out, io__state::di, io__state::uo) is det.
-module_add_pragma_import(PredName, PredOrFunc, Modes, Attributes,
- C_Function, Status, Context, !ModuleInfo, !Info, !IO) :-
+module_add_pragma_import(PredName, PredOrFunc, Modes, Attributes, C_Function,
+ Status, Context, !ModuleInfo, !Info, !IO) :-
module_info_name(!.ModuleInfo, ModuleName),
list__length(Modes, Arity),
@@ -4658,18 +4593,14 @@
;
PredInfo1 = PredInfo0
),
- (
- pred_info_is_imported(PredInfo1)
- ->
+ ( pred_info_is_imported(PredInfo1) ->
module_info_incr_errors(!ModuleInfo),
prog_out__write_context(Context, !IO),
io__write_string("Error: `:- pragma import' ", !IO),
io__write_string("declaration for imported ", !IO),
hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity, !IO),
io__write_string(".\n", !IO)
- ;
- pred_info_clause_goal_type(PredInfo1)
- ->
+ ; pred_info_clause_goal_type(PredInfo1) ->
module_info_incr_errors(!ModuleInfo),
prog_out__write_context(Context, !IO),
io__write_string("Error: `:- pragma import' declaration ", !IO),
@@ -4689,12 +4620,12 @@
get_procedure_matching_argmodes(ExistingProcs, Modes,
!.ModuleInfo, ProcId)
->
- pred_add_pragma_import(PredInfo2, PredId, ProcId,
- Attributes, C_Function, Context,
- PredInfo, !ModuleInfo, !Info, !IO),
+ pred_add_pragma_import(PredId, ProcId, Attributes,
+ C_Function, Context, PredInfo2, PredInfo,
+ !ModuleInfo, !Info, !IO),
map__det_update(Preds0, PredId, PredInfo, Preds),
- predicate_table_set_preds(PredicateTable2, Preds,
- PredicateTable),
+ predicate_table_set_preds(Preds,
+ PredicateTable2, PredicateTable),
module_info_set_predicate_table(PredicateTable,
!ModuleInfo)
;
@@ -4714,40 +4645,39 @@
% This is a subroutine of module_add_pragma_import which adds
% the c_code for a `pragma import' declaration to a pred_info.
-:- pred pred_add_pragma_import(pred_info, pred_id, proc_id,
- pragma_foreign_proc_attributes, string, prog_context, pred_info,
- module_info, module_info, qual_info, qual_info,
- io__state, io__state).
-:- mode pred_add_pragma_import(in, in, in, in, in, in, out, in, out, in, out,
- di, uo) is det.
-pred_add_pragma_import(PredInfo0, PredId, ProcId, Attributes, C_Function,
- Context, PredInfo, ModuleInfo0, ModuleInfo, Info0, Info) -->
- { pred_info_procedures(PredInfo0, Procs) },
- { map__lookup(Procs, ProcId, ProcInfo) },
- { foreign__make_pragma_import(PredInfo0, ProcInfo, C_Function, Context,
- ModuleInfo0, PragmaImpl, VarSet, PragmaVars, ArgTypes,
- Arity, PredOrFunc) },
+:- pred pred_add_pragma_import(pred_id::in, proc_id::in,
+ pragma_foreign_proc_attributes::in, string::in, prog_context::in,
+ pred_info::in, pred_info::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, io::di, io::uo) is det.
+
+pred_add_pragma_import(PredId, ProcId, Attributes, C_Function, Context,
+ !PredInfo, !ModuleInfo, !Info, !IO) :-
+ pred_info_procedures(!.PredInfo, Procs),
+ map__lookup(Procs, ProcId, ProcInfo),
+ foreign__make_pragma_import(!.PredInfo, ProcInfo, C_Function, Context,
+ !.ModuleInfo, PragmaImpl, VarSet, PragmaVars, ArgTypes,
+ Arity, PredOrFunc),
%
% lookup some information we need from the pred_info and proc_info
%
- { PredName = pred_info_name(PredInfo0) },
- { PredModule = pred_info_module(PredInfo0) },
- { pred_info_clauses_info(PredInfo0, Clauses0) },
- { pred_info_get_purity(PredInfo0, Purity) },
+ PredName = pred_info_name(!.PredInfo),
+ PredModule = pred_info_module(!.PredInfo),
+ pred_info_clauses_info(!.PredInfo, Clauses0),
+ pred_info_get_purity(!.PredInfo, Purity),
%
% Add the code for this `pragma import' to the clauses_info
%
- clauses_info_add_pragma_foreign_proc(Clauses0, Purity, Attributes,
+ clauses_info_add_pragma_foreign_proc(Purity, Attributes,
PredId, ProcId, VarSet, PragmaVars, ArgTypes, PragmaImpl,
Context, PredOrFunc, qualified(PredModule, PredName),
- Arity, Clauses, ModuleInfo0, ModuleInfo, Info0, Info),
+ Arity, Clauses0, Clauses, !ModuleInfo, !IO),
%
% Store the clauses_info etc. back into the pred_info
%
- { pred_info_set_clauses_info(Clauses, PredInfo0, PredInfo) }.
+ pred_info_set_clauses_info(Clauses, !PredInfo).
%-----------------------------------------------------------------------------%
@@ -4760,7 +4690,7 @@
module_add_pragma_foreign_proc(Attributes, PredName, PredOrFunc, PVars, VarSet,
PragmaImpl, Status, Context, !ModuleInfo, !Info, !IO) :-
module_info_name(!.ModuleInfo, ModuleName),
- foreign_language(Attributes, PragmaForeignLanguage),
+ PragmaForeignLanguage = foreign_language(Attributes),
list__length(PVars, Arity),
% print out a progress message
globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
@@ -4860,18 +4790,18 @@
pred_info_arg_types(PredInfo1, ArgTypes),
pred_info_get_purity(PredInfo1, Purity),
- clauses_info_add_pragma_foreign_proc(Clauses0, Purity,
+ clauses_info_add_pragma_foreign_proc(Purity,
Attributes, PredId, ProcId, VarSet, PVars,
ArgTypes, PragmaImpl, Context, PredOrFunc,
- PredName, Arity, Clauses, !ModuleInfo, !Info,
- !IO),
+ PredName, Arity, Clauses0, Clauses,
+ !ModuleInfo, !IO),
pred_info_set_clauses_info(Clauses,
PredInfo1, PredInfo2),
pred_info_update_goal_type(pragmas,
PredInfo2, PredInfo),
map__det_update(Preds0, PredId, PredInfo, Preds),
- predicate_table_set_preds(PredicateTable1, Preds,
- PredicateTable),
+ predicate_table_set_preds(Preds,
+ PredicateTable1, PredicateTable),
module_info_set_predicate_table(PredicateTable,
!ModuleInfo),
pragma_get_var_infos(PVars, ArgInfo),
@@ -5060,21 +4990,19 @@
)
).
-:- pred set_eval_method_list(assoc_list(proc_id, proc_info), eval_method,
- proc_table, proc_table).
-:- mode set_eval_method_list(in, in, in, out) is det.
+:- pred set_eval_method_list(assoc_list(proc_id, proc_info)::in,
+ eval_method::in, proc_table::in, proc_table::out) is det.
-set_eval_method_list([], _, Procs, Procs).
-set_eval_method_list([ProcId - ProcInfo0|Rest], EvalMethod, Procs0, Procs) :-
+set_eval_method_list([], _, !Procs).
+set_eval_method_list([ProcId - ProcInfo0|Rest], EvalMethod, !Procs) :-
proc_info_set_eval_method(EvalMethod, ProcInfo0, ProcInfo),
- map__det_update(Procs0, ProcId, ProcInfo, Procs1),
- set_eval_method_list(Rest, EvalMethod, Procs1, Procs).
+ map__det_update(!.Procs, ProcId, ProcInfo, !:Procs),
+ set_eval_method_list(Rest, EvalMethod, !Procs).
%-----------------------------------------------------------------------------%
% from the list of pragma_vars extract the modes.
-:- pred pragma_get_modes(list(pragma_var), list(mode)).
-:- mode pragma_get_modes(in, out) is det.
+:- pred pragma_get_modes(list(pragma_var)::in, list(mode)::out) is det.
pragma_get_modes([], []).
pragma_get_modes([PragmaVar | Vars], [Mode | Modes]) :-
@@ -5084,8 +5012,7 @@
%-----------------------------------------------------------------------------%
% from the list of pragma_vars , extract the vars.
-:- pred pragma_get_vars(list(pragma_var), list(prog_var)).
-:- mode pragma_get_vars(in, out) is det.
+:- pred pragma_get_vars(list(pragma_var)::in, list(prog_var)::out) is det.
pragma_get_vars([], []).
pragma_get_vars([PragmaVar | PragmaVars], [Var | Vars]) :-
@@ -5096,8 +5023,8 @@
% from the list of pragma_vars, extract the names.
-:- pred pragma_get_var_infos(list(pragma_var), list(maybe(pair(string, mode)))).
-:- mode pragma_get_var_infos(in, out) is det.
+:- pred pragma_get_var_infos(list(pragma_var)::in,
+ list(maybe(pair(string, mode)))::out) is det.
pragma_get_var_infos([], []).
pragma_get_var_infos([PragmaVar | PragmaVars], [yes(Name - Mode) | Info]) :-
@@ -5112,8 +5039,8 @@
% The bool indicates whether there was a conflicting marker
% present.
-:- pred pragma_check_markers(pred_table, list(pred_id), list(marker), bool).
-:- mode pragma_check_markers(in, in, in, out) is det.
+:- pred pragma_check_markers(pred_table::in, list(pred_id)::in,
+ list(marker)::in, bool::out) is det.
pragma_check_markers(_, [], _, no).
pragma_check_markers(PredTable, [PredId | PredIds], ConflictList,
@@ -5156,8 +5083,8 @@
MustBeExported, !PredTable, WrongStatus1),
bool__or(WrongStatus0, WrongStatus1, WrongStatus).
-:- pred add_marker_pred_info(marker, pred_info, pred_info).
-:- mode add_marker_pred_info(in, in, out) is det.
+:- pred add_marker_pred_info(marker::in, pred_info::in, pred_info::out)
+ is det.
add_marker_pred_info(Marker, !PredInfo) :-
pred_info_get_markers(!.PredInfo, Markers0),
@@ -5166,8 +5093,7 @@
% Succeed if a marker for an exported procedure must also
% be exported.
-:- pred marker_must_be_exported(marker).
-:- mode marker_must_be_exported(in) is semidet.
+:- pred marker_must_be_exported(marker::in) is semidet.
marker_must_be_exported(aditi).
marker_must_be_exported(base_relation).
@@ -5176,17 +5102,15 @@
% Find the procedure with argmodes which match the ones we want.
-:- pred get_procedure_matching_argmodes(assoc_list(proc_id, proc_info),
- list(mode), module_info, proc_id).
-:- mode get_procedure_matching_argmodes(in, in, in, out) is semidet.
+:- pred get_procedure_matching_argmodes(assoc_list(proc_id, proc_info)::in,
+ list(mode)::in, module_info::in, proc_id::out) is semidet.
get_procedure_matching_argmodes(Procs, Modes0, ModuleInfo, ProcId) :-
list__map(constrain_inst_vars_in_mode, Modes0, Modes),
get_procedure_matching_argmodes_2(Procs, Modes, ModuleInfo, ProcId).
-:- pred get_procedure_matching_argmodes_2(assoc_list(proc_id, proc_info),
- list(mode), module_info, proc_id).
-:- mode get_procedure_matching_argmodes_2(in, in, in, out) is semidet.
+:- pred get_procedure_matching_argmodes_2(assoc_list(proc_id, proc_info)::in,
+ list(mode)::in, module_info::in, proc_id::out) is semidet.
get_procedure_matching_argmodes_2([P|Procs], Modes, ModuleInfo, OurProcId) :-
P = ProcId - ProcInfo,
@@ -5201,17 +5125,15 @@
% Find the procedure with declared argmodes which match the ones
% we want. If there was no mode declaration, then use the inferred
% argmodes.
-:- pred get_procedure_matching_declmodes(assoc_list(proc_id, proc_info),
- list(mode), module_info, proc_id).
-:- mode get_procedure_matching_declmodes(in, in, in, out) is semidet.
+:- pred get_procedure_matching_declmodes(assoc_list(proc_id, proc_info)::in,
+ list(mode)::in, module_info::in, proc_id::out) is semidet.
get_procedure_matching_declmodes(Procs, Modes0, ModuleInfo, ProcId) :-
list__map(constrain_inst_vars_in_mode, Modes0, Modes),
get_procedure_matching_declmodes_2(Procs, Modes, ModuleInfo, ProcId).
-:- pred get_procedure_matching_declmodes_2(assoc_list(proc_id, proc_info),
- list(mode), module_info, proc_id).
-:- mode get_procedure_matching_declmodes_2(in, in, in, out) is semidet.
+:- pred get_procedure_matching_declmodes_2(assoc_list(proc_id, proc_info)::in,
+ list(mode)::in, module_info::in, proc_id::out) is semidet.
get_procedure_matching_declmodes_2([P|Procs], Modes, ModuleInfo, OurProcId) :-
P = ProcId - ProcInfo,
@@ -5223,8 +5145,8 @@
OurProcId)
).
-:- pred mode_list_matches(list(mode), list(mode), module_info).
-:- mode mode_list_matches(in, in, in) is semidet.
+:- pred mode_list_matches(list(mode)::in, list(mode)::in, module_info::in)
+ is semidet.
mode_list_matches([], [], _).
mode_list_matches([Mode1 | Modes1], [Mode2 | Modes2], ModuleInfo) :-
@@ -5240,9 +5162,8 @@
% an underscore, or about variables which do start with an underscore
% but occur more than once.
%
-:- pred maybe_warn_overlap(list(quant_warning), prog_varset,
- simple_call_id, io__state, io__state).
-:- mode maybe_warn_overlap(in, in, in, di, uo) is det.
+:- pred maybe_warn_overlap(list(quant_warning)::in, prog_varset::in,
+ simple_call_id::in, io::di, io::uo) is det.
maybe_warn_overlap(Warnings, VarSet, PredCallId) -->
globals__io_lookup_bool_option(warn_overlapping_scopes,
@@ -5253,9 +5174,8 @@
[]
).
-:- pred warn_overlap(list(quant_warning), prog_varset, simple_call_id,
- io__state, io__state).
-:- mode warn_overlap(in, in, in, di, uo) is det.
+:- pred warn_overlap(list(quant_warning)::in, prog_varset::in,
+ simple_call_id::in, io::di, io::uo) is det.
warn_overlap([], _, _) --> [].
warn_overlap([Warn|Warns], VarSet, PredCallId) -->
@@ -5285,9 +5205,8 @@
% but occur more than once, or about variables that do not occur in
% C code strings when they should.
%
-:- pred maybe_warn_singletons(prog_varset, simple_call_id, module_info,
- hlds_goal, io__state, io__state).
-:- mode maybe_warn_singletons(in, in, in, in, di, uo) is det.
+:- pred maybe_warn_singletons(prog_varset::in, simple_call_id::in,
+ module_info::in, hlds_goal::in, io::di, io::uo) is det.
maybe_warn_singletons(VarSet, PredCallId, ModuleInfo, Body) -->
globals__io_lookup_bool_option(warn_singleton_vars, WarnSingletonVars),
@@ -5299,18 +5218,17 @@
[]
).
-:- pred warn_singletons_in_goal(hlds_goal, set(prog_var), prog_varset,
- simple_call_id, module_info, io__state, io__state).
-:- mode warn_singletons_in_goal(in, in, in, in, in, di, uo) is det.
+:- pred warn_singletons_in_goal(hlds_goal::in, set(prog_var)::in,
+ prog_varset::in, simple_call_id::in, module_info::in,
+ io::di, io::uo) is det.
warn_singletons_in_goal(Goal - GoalInfo, QuantVars, VarSet, PredCallId, MI) -->
warn_singletons_in_goal_2(Goal, GoalInfo, QuantVars, VarSet,
PredCallId, MI).
-:- pred warn_singletons_in_goal_2(hlds_goal_expr, hlds_goal_info, set(prog_var),
- prog_varset, simple_call_id, module_info,
- io__state, io__state).
-:- mode warn_singletons_in_goal_2(in, in, in, in, in, in, di, uo) is det.
+:- pred warn_singletons_in_goal_2(hlds_goal_expr::in, hlds_goal_info::in,
+ set(prog_var)::in, prog_varset::in, simple_call_id::in,
+ module_info::in, io::di, io::uo) is det.
warn_singletons_in_goal_2(conj(Goals), _GoalInfo, QuantVars, VarSet,
PredCallId, MI) -->
@@ -5393,10 +5311,10 @@
warn_singletons_in_unify(Var, RHS, GoalInfo, QuantVars, VarSet,
PredCallId, MI).
-warn_singletons_in_goal_2(foreign_proc(Attrs, _, _, _, ArgInfo, _,
- PragmaImpl), GoalInfo, _QuantVars, _VarSet, PredCallId, MI) -->
+warn_singletons_in_goal_2(foreign_proc(Attrs, _, _, _, ArgInfo, _, PragmaImpl),
+ GoalInfo, _QuantVars, _VarSet, PredCallId, MI) -->
{ goal_info_get_context(GoalInfo, Context) },
- { foreign_language(Attrs, Lang) },
+ { Lang = foreign_language(Attrs) },
warn_singletons_in_pragma_foreign_proc(PragmaImpl, Lang,
ArgInfo, Context, PredCallId, MI).
@@ -5405,21 +5323,18 @@
warn_singletons_in_goal_2_shorthand(ShorthandGoal, GoalInfo,
QuantVars, VarSet, PredCallId, MI).
-:- pred warn_singletons_in_goal_2_shorthand(shorthand_goal_expr,
- hlds_goal_info, set(prog_var), prog_varset, simple_call_id,
- module_info, io__state, io__state).
-:- mode warn_singletons_in_goal_2_shorthand(in, in, in, in, in, in, di, uo)
- is det.
+:- pred warn_singletons_in_goal_2_shorthand(shorthand_goal_expr::in,
+ hlds_goal_info::in, set(prog_var)::in, prog_varset::in,
+ simple_call_id::in, module_info::in, io::di, io::uo) is det.
warn_singletons_in_goal_2_shorthand(bi_implication(LHS, RHS), _GoalInfo,
QuantVars, VarSet, PredCallId, MI) -->
warn_singletons_in_goal_list([LHS, RHS], QuantVars, VarSet,
PredCallId, MI).
-:- pred warn_singletons_in_goal_list(list(hlds_goal), set(prog_var),
- prog_varset, simple_call_id, module_info,
- io__state, io__state).
-:- mode warn_singletons_in_goal_list(in, in, in, in, in, di, uo) is det.
+:- pred warn_singletons_in_goal_list(list(hlds_goal)::in, set(prog_var)::in,
+ prog_varset::in, simple_call_id::in, module_info::in,
+ io::di, io::uo) is det.
warn_singletons_in_goal_list([], _, _, _, _) --> [].
warn_singletons_in_goal_list([Goal|Goals], QuantVars, VarSet, CallPredId, MI)
@@ -5427,9 +5342,9 @@
warn_singletons_in_goal(Goal, QuantVars, VarSet, CallPredId, MI),
warn_singletons_in_goal_list(Goals, QuantVars, VarSet, CallPredId, MI).
-:- pred warn_singletons_in_cases(list(case), set(prog_var), prog_varset,
- simple_call_id, module_info, io__state, io__state).
-:- mode warn_singletons_in_cases(in, in, in, in, in, di, uo) is det.
+:- pred warn_singletons_in_cases(list(case)::in, set(prog_var)::in,
+ prog_varset::in, simple_call_id::in, module_info::in,
+ io::di, io::uo) is det.
warn_singletons_in_cases([], _, _, _, _) --> [].
warn_singletons_in_cases([Case|Cases], QuantVars, VarSet, CallPredId, MI) -->
@@ -5437,10 +5352,9 @@
warn_singletons_in_goal(Goal, QuantVars, VarSet, CallPredId, MI),
warn_singletons_in_cases(Cases, QuantVars, VarSet, CallPredId, MI).
-:- pred warn_singletons_in_unify(prog_var, unify_rhs, hlds_goal_info,
- set(prog_var), prog_varset, simple_call_id, module_info,
- io__state, io__state).
-:- mode warn_singletons_in_unify(in, in, in, in, in, in, in, di, uo) is det.
+:- pred warn_singletons_in_unify(prog_var::in, unify_rhs::in,
+ hlds_goal_info::in, set(prog_var)::in, prog_varset::in,
+ simple_call_id::in, module_info::in, io::di, io::uo) is det.
warn_singletons_in_unify(X, var(Y), GoalInfo, QuantVars, VarSet, CallPredId, _)
-->
@@ -5482,18 +5396,20 @@
%-----------------------------------------------------------------------------%
-:- pred maybe_warn_pragma_singletons(pragma_foreign_code_impl,
- foreign_language, list(maybe(pair(string, mode))), prog_context,
- simple_call_id, module_info, io__state, io__state).
-:- mode maybe_warn_pragma_singletons(in, in, in, in, in, in, di, uo) is det.
+:- pred maybe_warn_pragma_singletons(pragma_foreign_code_impl::in,
+ foreign_language::in, list(maybe(pair(string, mode)))::in,
+ prog_context::in, simple_call_id::in, module_info::in,
+ io::di, io::uo) is det.
-maybe_warn_pragma_singletons(PragmaImpl, Lang, ArgInfo, Context, CallId, MI) -->
- globals__io_lookup_bool_option(warn_singleton_vars, WarnSingletonVars),
- ( { WarnSingletonVars = yes } ->
+maybe_warn_pragma_singletons(PragmaImpl, Lang, ArgInfo, Context, CallId, MI,
+ !IO) :-
+ globals__io_lookup_bool_option(warn_singleton_vars, WarnSingletonVars,
+ !IO),
+ ( WarnSingletonVars = yes ->
warn_singletons_in_pragma_foreign_proc(PragmaImpl, Lang,
- ArgInfo, Context, CallId, MI)
+ ArgInfo, Context, CallId, MI, !IO)
;
- []
+ true
).
% warn_singletons_in_pragma_foreign_proc checks to see if each
@@ -5504,107 +5420,111 @@
% appropriate to do this check, or you may need to add a
% transformation to map Mercury variable names into identifiers
% for that foreign language).
-:- pred warn_singletons_in_pragma_foreign_proc(pragma_foreign_code_impl,
- foreign_language, list(maybe(pair(string, mode))), prog_context,
- simple_call_id, module_info, io__state, io__state).
-:- mode warn_singletons_in_pragma_foreign_proc(in, in, in, in, in, in,
- di, uo) is det.
-
-warn_singletons_in_pragma_foreign_proc(PragmaImpl, Lang, ArgInfo,
- Context, PredOrFuncCallId, ModuleInfo) -->
- { LangStr = foreign_language_string(Lang) },
- (
- { PragmaImpl = ordinary(C_Code, _) },
- { c_code_to_name_list(C_Code, C_CodeList) },
- { solutions((pred(Name::out) is nondet :-
+:- pred warn_singletons_in_pragma_foreign_proc(pragma_foreign_code_impl::in,
+ foreign_language::in, list(maybe(pair(string, mode)))::in,
+ prog_context::in, simple_call_id::in, module_info::in,
+ io::di, io::uo) is det.
+
+warn_singletons_in_pragma_foreign_proc(PragmaImpl, Lang, ArgInfo, Context,
+ PredOrFuncCallId, ModuleInfo, !IO) :-
+ LangStr = foreign_language_string(Lang),
+ (
+ PragmaImpl = ordinary(C_Code, _),
+ c_code_to_name_list(C_Code, C_CodeList),
+ solutions((pred(Name::out) is nondet :-
list__member(yes(Name - _), ArgInfo),
\+ string__prefix(Name, "_"),
\+ list__member(Name, C_CodeList)
- ), UnmentionedVars) },
- ( { UnmentionedVars = [] } ->
- []
+ ), UnmentionedVars),
+ ( UnmentionedVars = [] ->
+ true
;
- prog_out__write_context(Context),
- io__write_string("In the " ++ LangStr ++ " code for "),
- hlds_out__write_simple_call_id(PredOrFuncCallId),
- io__write_string(":\n"),
- prog_out__write_context(Context),
- write_variable_warning_start(UnmentionedVars),
+ prog_out__write_context(Context, !IO),
+ io__write_string("In the " ++ LangStr ++ " code for ",
+ !IO),
+ hlds_out__write_simple_call_id(PredOrFuncCallId, !IO),
+ io__write_string(":\n", !IO),
+ prog_out__write_context(Context, !IO),
+ write_variable_warning_start(UnmentionedVars, !IO),
io__write_string("not occur in the " ++
- LangStr ++ " code.\n")
+ LangStr ++ " code.\n", !IO)
)
;
- { PragmaImpl = nondet(_, _, FirstCode, _,
- LaterCode, _, _, SharedCode, _) },
- { c_code_to_name_list(FirstCode, FirstCodeList) },
- { c_code_to_name_list(LaterCode, LaterCodeList) },
- { c_code_to_name_list(SharedCode, SharedCodeList) },
- { solutions((pred(Name::out) is nondet :-
+ PragmaImpl = nondet(_, _, FirstCode, _,
+ LaterCode, _, _, SharedCode, _),
+ c_code_to_name_list(FirstCode, FirstCodeList),
+ c_code_to_name_list(LaterCode, LaterCodeList),
+ c_code_to_name_list(SharedCode, SharedCodeList),
+ solutions((pred(Name::out) is nondet :-
list__member(yes(Name - Mode), ArgInfo),
mode_is_input(ModuleInfo, Mode),
\+ string__prefix(Name, "_"),
\+ list__member(Name, FirstCodeList)
- ), UnmentionedInputVars) },
- ( { UnmentionedInputVars = [] } ->
- []
+ ), UnmentionedInputVars),
+ ( UnmentionedInputVars = [] ->
+ true
;
- prog_out__write_context(Context),
- io__write_string("In the " ++ LangStr ++ " code for "),
- hlds_out__write_simple_call_id(PredOrFuncCallId),
- io__write_string(":\n"),
- prog_out__write_context(Context),
- write_variable_warning_start(UnmentionedInputVars),
+ prog_out__write_context(Context, !IO),
+ io__write_string("In the " ++ LangStr ++ " code for ",
+ !IO),
+ hlds_out__write_simple_call_id(PredOrFuncCallId, !IO),
+ io__write_string(":\n", !IO),
+ prog_out__write_context(Context, !IO),
+ write_variable_warning_start(UnmentionedInputVars, !IO),
io__write_string("not occur in the first " ++
- LangStr ++ " code.\n ")
+ LangStr ++ " code.\n ", !IO)
),
- { solutions((pred(Name::out) is nondet :-
+ solutions((pred(Name::out) is nondet :-
list__member(yes(Name - Mode), ArgInfo),
mode_is_output(ModuleInfo, Mode),
\+ string__prefix(Name, "_"),
\+ list__member(Name, FirstCodeList),
\+ list__member(Name, SharedCodeList)
- ), UnmentionedFirstOutputVars) },
- ( { UnmentionedFirstOutputVars = [] } ->
- []
+ ), UnmentionedFirstOutputVars),
+ ( UnmentionedFirstOutputVars = [] ->
+ true
;
- prog_out__write_context(Context),
- io__write_string("In the " ++ LangStr ++ " code for "),
- hlds_out__write_simple_call_id(PredOrFuncCallId),
- io__write_string(":\n"),
- prog_out__write_context(Context),
+ prog_out__write_context(Context, !IO),
+ io__write_string("In the " ++ LangStr ++ " code for ",
+ !IO),
+ hlds_out__write_simple_call_id(PredOrFuncCallId, !IO),
+ io__write_string(":\n", !IO),
+ prog_out__write_context(Context, !IO),
write_variable_warning_start(
- UnmentionedFirstOutputVars),
+ UnmentionedFirstOutputVars, !IO),
io__write_string("not occur in the first " ++
LangStr ++ " code or the shared " ++ LangStr ++
- " code.\n ")
+ " code.\n ", !IO)
),
- { solutions((pred(Name::out) is nondet :-
+ solutions((pred(Name::out) is nondet :-
list__member(yes(Name - Mode), ArgInfo),
mode_is_output(ModuleInfo, Mode),
\+ string__prefix(Name, "_"),
\+ list__member(Name, LaterCodeList),
\+ list__member(Name, SharedCodeList)
- ), UnmentionedLaterOutputVars) },
- ( { UnmentionedLaterOutputVars = [] } ->
- []
+ ), UnmentionedLaterOutputVars),
+ ( UnmentionedLaterOutputVars = [] ->
+ true
;
- prog_out__write_context(Context),
- io__write_string("In the " ++ LangStr ++ " code for "),
- hlds_out__write_simple_call_id(PredOrFuncCallId),
- io__write_string(":\n"),
- prog_out__write_context(Context),
+ prog_out__write_context(Context, !IO),
+ io__write_string("In the " ++ LangStr ++ " code for ",
+ !IO),
+ hlds_out__write_simple_call_id(PredOrFuncCallId, !IO),
+ io__write_string(":\n", !IO),
+ prog_out__write_context(Context, !IO),
write_variable_warning_start(
- UnmentionedLaterOutputVars),
+ UnmentionedLaterOutputVars, !IO),
io__write_string("not occur in the retry " ++
LangStr ++ " code or the shared " ++ LangStr ++
- " code.\n ")
+ " code.\n ", !IO)
)
;
- { PragmaImpl = import(_, _, _, _) }
+ PragmaImpl = import(_, _, _, _)
).
-:- pred write_variable_warning_start(list(string)::in, io__state::di,
- io__state::uo) is det.
+:- pred write_variable_warning_start(list(string)::in,
+ io__state::di, io__state::uo) is det.
+
write_variable_warning_start(UnmentionedVars) -->
( { UnmentionedVars = [_] } ->
io__write_string(" warning: variable `"),
@@ -5620,21 +5540,17 @@
% c_code_to_name_list(Code, List) is true iff List is a list of the
% identifiers used in the C code in Code.
-:- pred c_code_to_name_list(string, list(string)).
-:- mode c_code_to_name_list(in, out) is det.
+:- pred c_code_to_name_list(string::in, list(string)::out) is det.
c_code_to_name_list(Code, List) :-
string__to_char_list(Code, CharList),
c_code_to_name_list_2(CharList, List).
-:- pred c_code_to_name_list_2(list(char), list(string)).
-:- mode c_code_to_name_list_2(in, out) is det.
+:- pred c_code_to_name_list_2(list(char)::in, list(string)::out) is det.
c_code_to_name_list_2(C_Code, List) :-
get_first_c_name(C_Code, NameCharList, TheRest),
- (
- NameCharList = []
- ->
+ ( NameCharList = [] ->
% no names left
List = []
;
@@ -5643,30 +5559,26 @@
List = [Name|Names]
).
-:- pred get_first_c_name(list(char), list(char), list(char)).
-:- mode get_first_c_name(in, out, out) is det.
+:- pred get_first_c_name(list(char)::in, list(char)::out, list(char)::out)
+ is det.
get_first_c_name([], [], []).
-get_first_c_name([C|CodeChars], NameCharList, TheRest) :-
- (
- char__is_alnum_or_underscore(C)
- ->
+get_first_c_name([C | CodeChars], NameCharList, TheRest) :-
+ ( char__is_alnum_or_underscore(C) ->
get_first_c_name_in_word(CodeChars, NameCharList0, TheRest),
- NameCharList = [C|NameCharList0]
+ NameCharList = [C | NameCharList0]
;
% strip off any characters in the C code which
% don't form part of an identifier.
get_first_c_name(CodeChars, NameCharList, TheRest)
).
-:- pred get_first_c_name_in_word(list(char), list(char), list(char)).
-:- mode get_first_c_name_in_word(in, out, out) is det.
+:- pred get_first_c_name_in_word(list(char)::in, list(char)::out,
+ list(char)::out) is det.
get_first_c_name_in_word([], [], []).
-get_first_c_name_in_word([C|CodeChars], NameCharList, TheRest) :-
- (
- char__is_alnum_or_underscore(C)
- ->
+get_first_c_name_in_word([C | CodeChars], NameCharList, TheRest) :-
+ ( char__is_alnum_or_underscore(C) ->
% There are more characters in the word
get_first_c_name_in_word(CodeChars, NameCharList0, TheRest),
NameCharList = [C|NameCharList0]
@@ -5678,19 +5590,16 @@
%-----------------------------------------------------------------------------%
-:- pred write_string_list(list(string), io__state, io__state).
-:- mode write_string_list(in, di, uo) is det.
+:- pred write_string_list(list(string)::in, io::di, io::uo) is det.
-write_string_list([]) --> [].
-write_string_list([X|Xs]) -->
- io__write_string(X),
- (
- { Xs = [] }
- ->
- []
+write_string_list([], !IO).
+write_string_list([X | Xs], !IO) :-
+ io__write_string(X, !IO),
+ ( Xs = [] ->
+ true
;
- io__write_string(", "),
- write_string_list(Xs)
+ io__write_string(", ", !IO),
+ write_string_list(Xs, !IO)
).
%-----------------------------------------------------------------------------%
@@ -5701,10 +5610,9 @@
% in QuantVars, or if any of the underscore variables
% in Vars do occur in NonLocals.
-:- pred warn_singletons(list(prog_var), set(prog_var), set(prog_var),
- prog_varset, prog_context, simple_call_id,
- io__state, io__state).
-:- mode warn_singletons(in, in, in, in, in, in, di, uo) is det.
+:- pred warn_singletons(list(prog_var)::in, set(prog_var)::in,
+ set(prog_var)::in, prog_varset::in, prog_context::in,
+ simple_call_id::in, io::di, io::uo) is det.
warn_singletons(GoalVars, NonLocals, QuantVars, VarSet, Context,
PredOrFuncCallId) -->
@@ -5770,7 +5678,8 @@
( { MultiVars = [_] } ->
io__write_string(" warning: variable `"),
mercury_output_vars(MultiVars, VarSet, no),
- report_warning("' occurs more than once in this scope.\n")
+ report_warning("' occurs more than once " ++
+ "in this scope.\n")
;
io__write_string(" warning: variables `"),
mercury_output_vars(MultiVars, VarSet, no),
@@ -5780,8 +5689,8 @@
%-----------------------------------------------------------------------------
-:- pred clauses_info_init_for_assertion(prog_vars::in,
- clauses_info::out) is det.
+:- pred clauses_info_init_for_assertion(prog_vars::in, clauses_info::out)
+ is det.
clauses_info_init_for_assertion(HeadVars, ClausesInfo) :-
map__init(VarTypes),
@@ -5803,9 +5712,8 @@
map__init(TI_VarMap),
map__init(TCI_VarMap),
HasForeignClauses = no,
- ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap,
- VarTypes, HeadVars, [], TI_VarMap, TCI_VarMap,
- HasForeignClauses).
+ ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
+ HeadVars, [], TI_VarMap, TCI_VarMap, HasForeignClauses).
:- pred clauses_info_add_clause(list(proc_id)::in,
prog_varset::in, tvarset::in, list(prog_term)::in, goal::in,
@@ -5899,30 +5807,29 @@
% pragma foreign_proc declaration and the head vars of the pred. Also
% return the hlds_goal.
-:- pred clauses_info_add_pragma_foreign_proc(
- clauses_info::in, purity::in, pragma_foreign_proc_attributes::in,
- pred_id::in, proc_id::in, prog_varset::in, list(pragma_var)::in,
- list(type)::in, pragma_foreign_code_impl::in, prog_context::in,
- pred_or_func::in, sym_name::in, arity::in, clauses_info::out,
- module_info::in, module_info::out, qual_info::in,
- qual_info::out, io__state::di, io__state::uo) is det.
-
-clauses_info_add_pragma_foreign_proc(ClausesInfo0, Purity, Attributes0, PredId,
- ProcId, PVarSet, PVars, OrigArgTypes, PragmaImpl0, Context,
- PredOrFunc, PredName, Arity, ClausesInfo, ModuleInfo0,
- ModuleInfo, Info, Info) -->
+:- pred clauses_info_add_pragma_foreign_proc(purity::in,
+ pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
+ prog_varset::in, list(pragma_var)::in, list(type)::in,
+ pragma_foreign_code_impl::in, prog_context::in, pred_or_func::in,
+ sym_name::in, arity::in, clauses_info::in, clauses_info::out,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
+
+clauses_info_add_pragma_foreign_proc(Purity, Attributes0, PredId, ProcId,
+ PVarSet, PVars, OrigArgTypes, PragmaImpl0, Context, PredOrFunc,
+ PredName, Arity, !ClausesInfo, !ModuleInfo, !IO) :-
- { ClausesInfo0 = clauses_info(VarSet0, VarTypes, TVarNameMap,
+ !.ClausesInfo = clauses_info(VarSet0, VarTypes, TVarNameMap,
VarTypes1, HeadVars, ClauseList, TI_VarMap, TCI_VarMap,
- _HasForeignClauses) },
+ _HasForeignClauses),
% Find all the existing clauses for this mode, and
% extract their implementation language and clause number
% (that is, their index in the list).
- { foreign_language(Attributes0, NewLang) },
+ NewLang = foreign_language(Attributes0),
- globals__io_get_globals(Globals),
- globals__io_get_target(Target),
+ globals__io_get_globals(Globals, !IO),
+ globals__io_get_target(Target, !IO),
% We traverse the clauses, and decide which action to perform.
%
@@ -5939,7 +5846,7 @@
% - remove the matching proc_id from its proc_id list,
% and add this clause as a new clause for this mode.
- { list__foldl2(
+ list__foldl2(
(pred(C::in, Action0::in, Action::out, N0::in, N::out) is det :-
C = clause(ProcIds, B, ClauseLang, D),
(
@@ -5976,9 +5883,9 @@
Action = Action0
),
N = N0 + 1
- ), ClauseList, add, FinalAction, 1, _) },
+ ), ClauseList, add, FinalAction, 1, _),
- { UpdateClauses = (pred(NewCl::in, Cs::out) is det :-
+ UpdateClauses = (pred(NewCl::in, Cs::out) is det :-
( FinalAction = ignore,
Cs = ClauseList
; FinalAction = add,
@@ -5989,10 +5896,10 @@
list__replace_nth_det(ClauseList, X, Clause, Cs1),
Cs = [NewCl | Cs1]
)
- ) },
+ ),
- globals__io_get_backend_foreign_languages(BackendForeignLanguages),
- {
+ globals__io_get_backend_foreign_languages(BackendForeignLanguages,
+ !IO),
pragma_get_vars(PVars, Args0),
pragma_get_var_infos(PVars, ArgInfo),
@@ -6002,9 +5909,8 @@
% backend language.
%
foreign__extrude_pragma_implementation(BackendForeignLanguages,
- PVars, PredName, PredOrFunc, Context,
- ModuleInfo0, Attributes0, PragmaImpl0,
- ModuleInfo1, Attributes, PragmaImpl),
+ PVars, PredName, PredOrFunc, Context, !ModuleInfo,
+ Attributes0, Attributes, PragmaImpl0, PragmaImpl),
%
% Check for arguments occurring multiple times.
@@ -6017,38 +5923,33 @@
Arg = _ - Occurrences,
Occurrences > 1
), ArgBagAL0, ArgBagAL),
- assoc_list__keys(ArgBagAL, MultipleArgs)
- },
+ assoc_list__keys(ArgBagAL, MultipleArgs),
- ( { MultipleArgs = [_ | _] } ->
- { ClausesInfo = ClausesInfo0 },
- { ModuleInfo = ModuleInfo1 },
- prog_out__write_context(Context),
+ ( MultipleArgs = [_ | _] ->
+ prog_out__write_context(Context, !IO),
io__write_string(
- "In `:- pragma foreign_proc' declaration for "),
- { adjust_func_arity(PredOrFunc, OrigArity, Arity) },
+ "In `:- pragma foreign_proc' declaration for ", !IO),
+ adjust_func_arity(PredOrFunc, OrigArity, Arity),
hlds_out__write_simple_call_id(
- PredOrFunc - PredName/OrigArity),
- io__write_string(":\n"),
- prog_out__write_context(Context),
- io__write_string(" error: "),
+ PredOrFunc - PredName/OrigArity, !IO),
+ io__write_string(":\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" error: ", !IO),
(
- { MultipleArgs = [MultipleArg] },
- io__write_string("variable `"),
- mercury_output_var(MultipleArg, PVarSet, no),
- io__write_string("' occurs multiple times\n")
- ;
- { MultipleArgs = [_, _ | _] },
- io__write_string("variables `"),
- mercury_output_vars(MultipleArgs, PVarSet, no),
- io__write_string(
- "' occur multiple times\n")
+ MultipleArgs = [MultipleArg],
+ io__write_string("variable `", !IO),
+ mercury_output_var(MultipleArg, PVarSet, no, !IO),
+ io__write_string("' occurs multiple times\n", !IO)
+ ;
+ MultipleArgs = [_, _ | _],
+ io__write_string("variables `", !IO),
+ mercury_output_vars(MultipleArgs, PVarSet, no, !IO),
+ io__write_string("' occur multiple times\n", !IO)
),
- prog_out__write_context(Context),
- io__write_string(" in the argument list.\n"),
- io__set_exit_status(1)
+ prog_out__write_context(Context, !IO),
+ io__write_string(" in the argument list.\n", !IO),
+ io__set_exit_status(1, !IO)
;
- {
% build the pragma_c_code
goal_info_init(GoalInfo0),
goal_info_set_context(GoalInfo0, Context, GoalInfo1),
@@ -6058,30 +5959,27 @@
HldsGoal0 = foreign_proc(Attributes, PredId,
ProcId, HeadVars, ArgInfo, OrigArgTypes, PragmaImpl)
- GoalInfo,
- ModuleInfo = ModuleInfo1,
map__init(EmptyVarTypes),
- implicitly_quantify_clause_body(HeadVars, _Warnings,
- HldsGoal0, HldsGoal, VarSet0, VarSet,
- EmptyVarTypes, _),
+ implicitly_quantify_clause_body(HeadVars, _Warnings, HldsGoal0,
+ HldsGoal, VarSet0, VarSet, EmptyVarTypes, _),
NewClause = clause([ProcId], HldsGoal,
foreign_language(NewLang), Context),
UpdateClauses(NewClause, NewClauseList),
HasForeignClauses = yes,
- ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap,
+ !:ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap,
VarTypes1, HeadVars, NewClauseList,
TI_VarMap, TCI_VarMap, HasForeignClauses)
- }
).
-:- pred allocate_vars_for_saved_vars(list(string), list(pair(prog_var, string)),
- prog_varset, prog_varset).
-:- mode allocate_vars_for_saved_vars(in, out, in, out) is det.
+:- pred allocate_vars_for_saved_vars(list(string)::in,
+ list(pair(prog_var, string))::out,
+ prog_varset::in, prog_varset::out) is det.
-allocate_vars_for_saved_vars([], [], VarSet, VarSet).
+allocate_vars_for_saved_vars([], [], !VarSet).
allocate_vars_for_saved_vars([Name | Names], [Var - Name | VarNames],
- VarSet0, VarSet) :-
- varset__new_var(VarSet0, Var, VarSet1),
- allocate_vars_for_saved_vars(Names, VarNames, VarSet1, VarSet).
+ !VarSet) :-
+ varset__new_var(!.VarSet, Var, !:VarSet),
+ allocate_vars_for_saved_vars(Names, VarNames, !VarSet).
%-----------------------------------------------------------------------------
@@ -6102,8 +6000,8 @@
Goal, !VarSet, Warnings, !Info, !IO) :-
prepare_for_head(SInfo0),
term__apply_substitution_to_list(Args0, Subst, Args1),
- substitute_state_var_mappings(Args1, Args, !VarSet,
- SInfo0, SInfo1, !IO),
+ substitute_state_var_mappings(Args1, Args, !VarSet, SInfo0, SInfo1,
+ !IO),
hlds_goal__true_goal(Head0),
( GoalType = promise(_) ->
Head = Head0,
@@ -6114,12 +6012,11 @@
Head0, Head, !VarSet, !Info, SInfo1, SInfo2, !IO)
),
prepare_for_body(FinalSVarMap, !VarSet, SInfo2, SInfo3),
- transform_goal(Body0, Subst, Body, !VarSet, !Info,
- SInfo3, SInfo, !IO),
+ transform_goal(Body0, Subst, Body, !VarSet, !Info, SInfo3, SInfo, !IO),
finish_head_and_body(Context, FinalSVarMap, Head, Body, Goal0, SInfo),
VarTypes0 = !.Info ^ qual_info ^ vartypes,
- implicitly_quantify_clause_body(HeadVars, Warnings,
- Goal0, Goal, !VarSet, VarTypes0, VarTypes),
+ implicitly_quantify_clause_body(HeadVars, Warnings, Goal0, Goal,
+ !VarSet, VarTypes0, VarTypes),
!:Info = !.Info ^ qual_info ^ vartypes := VarTypes.
%-----------------------------------------------------------------------------%
@@ -7106,12 +7003,10 @@
output_expected_aditi_update_syntax(Context, Update, !IO)
).
-:- pred aditi_bulk_update_goal_info(aditi_bulk_update,
- pred_or_func, sym_name, arity, list(prog_var), pred_or_func,
- lambda_eval_method, list(mode), determinism,
- hlds_goal, hlds_goal).
-:- mode aditi_bulk_update_goal_info(in, in, in, in, in, out,
- out, out, out, in, out) is det.
+:- pred aditi_bulk_update_goal_info(aditi_bulk_update::in, pred_or_func::in,
+ sym_name::in, arity::in, list(prog_var)::in, pred_or_func::out,
+ lambda_eval_method::out, list(mode)::out, determinism::out,
+ hlds_goal::in, hlds_goal::out) is det.
aditi_bulk_update_goal_info(bulk_insert, PredOrFunc, _SymName,
PredArity, _Args, LambdaPredOrFunc, EvalMethod,
@@ -7329,10 +7224,11 @@
).
:- pred insert_arg_unifications_with_supplied_contexts(list(prog_var)::in,
- list(prog_term)::in, assoc_list(int, arg_context)::in, prog_context::in,
- hlds_goal::in, hlds_goal::out, prog_varset::in, prog_varset::out,
- transform_info::in, transform_info::out, svar_info::in, svar_info::out,
- io__state::di, io__state::uo) is det.
+ list(prog_term)::in, assoc_list(int, arg_context)::in,
+ prog_context::in, hlds_goal::in, hlds_goal::out,
+ prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out,
+ svar_info::in, svar_info::out, io__state::di, io__state::uo) is det.
insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms0, ArgContexts,
Context, !Goal, !VarSet, !Info, !SInfo, !IO) :-
@@ -7352,8 +7248,7 @@
:- pred insert_arg_unifications_with_supplied_contexts_2(list(prog_var)::in,
list(prog_term)::in, assoc_list(int, arg_context)::in,
- prog_context::in,
- list(hlds_goal)::in, list(hlds_goal)::out,
+ prog_context::in, list(hlds_goal)::in, list(hlds_goal)::out,
prog_varset::in, prog_varset::out,
transform_info::in, transform_info::out, svar_info::in, svar_info::out,
io__state::di, io__state::uo) is det.
@@ -7774,7 +7669,7 @@
% - any errors will be caught by typechecking
MaybeFunctor = error(_, _),
list__length(Args, Arity),
- make_functor_cons_id(F, Arity, ConsId),
+ ConsId = make_functor_cons_id(F, Arity),
FunctorArgs = Args
),
( FunctorArgs = [] ->
@@ -7848,8 +7743,7 @@
list__append(ConjList0, ConjList1, ConjList),
conj_list_to_goal(ConjList, GoalInfo, Goal).
-:- pred parse_purity_annotation(term(T), purity, term(T)).
-:- mode parse_purity_annotation(in, out, out) is det.
+:- pred parse_purity_annotation(term(T)::in, purity::out, term(T)::out) is det.
parse_purity_annotation(Term0, Purity, Term) :-
(
@@ -7899,8 +7793,8 @@
% Parse a term of the form `Head :- Body', treating
% a term not in that form as `Head :- true'.
-:- pred parse_rule_term(term__context, term(T), term(T), term(T)).
-:- mode parse_rule_term(in, in, out, out) is det.
+:- pred parse_rule_term(term__context::in, term(T)::in, term(T)::out,
+ term(T)::out) is det.
parse_rule_term(Context, RuleTerm, HeadTerm, GoalTerm) :-
(
@@ -8048,9 +7942,9 @@
adjust_func_arity(PredOrFunc, OrigArity, Arity),
record_called_pred_or_func(PredOrFunc, SymName, OrigArity, !Info).
-:- pred do_construct_pred_or_func_call(pred_id, pred_or_func, sym_name,
- list(prog_var), hlds_goal_info, hlds_goal).
-:- mode do_construct_pred_or_func_call(in, in, in, in, in, out) is det.
+:- pred do_construct_pred_or_func_call(pred_id::in, pred_or_func::in,
+ sym_name::in, list(prog_var)::in, hlds_goal_info::in, hlds_goal::out)
+ is det.
do_construct_pred_or_func_call(PredId, PredOrFunc, SymName, Args,
GoalInfo, Goal) :-
@@ -8070,10 +7964,9 @@
Goal = GoalExpr - GoalInfo
).
-:- pred make_atomic_unification(prog_var, unify_rhs, prog_context,
- unify_main_context, unify_sub_contexts, hlds_goal,
- transform_info, transform_info).
-:- mode make_atomic_unification(in, in, in, in, in, out, in, out) is det.
+:- pred make_atomic_unification(prog_var::in, unify_rhs::in, prog_context::in,
+ unify_main_context::in, unify_sub_contexts::in, hlds_goal::out,
+ transform_info::in, transform_info::out) is det.
make_atomic_unification(Var, Rhs, Context, MainContext, SubContext,
Goal, Info0, Info) :-
@@ -8093,25 +7986,23 @@
%-----------------------------------------------------------------------------%
% Process an explicit type qualification.
-:- pred process_type_qualification(prog_var, type, tvarset, prog_context,
- transform_info, transform_info, io__state, io__state).
-:- mode process_type_qualification(in, in, in, in, in, out, di, uo) is det.
-
-process_type_qualification(Var, Type0, VarSet, Context, Info0, Info) -->
- { Info0 ^ qual_info = qual_info(EqvMap, TVarSet0, TVarRenaming0,
- TVarNameMap0, VarTypes0, MQInfo0, Status, FoundError) },
+:- pred process_type_qualification(prog_var::in, (type)::in, tvarset::in,
+ prog_context::in, transform_info::in, transform_info::out,
+ io::di, io::uo) is det.
- ( { Status = opt_imported } ->
+process_type_qualification(Var, Type0, VarSet, Context, !Info, !IO) :-
+ !.Info ^ qual_info = qual_info(EqvMap, TVarSet0, TVarRenaming0,
+ TVarNameMap0, VarTypes0, MQInfo0, Status, FoundError),
+ ( Status = opt_imported ->
% Types in `.opt' files should already be
% fully module qualified.
- { Type1 = Type0 },
- { MQInfo = MQInfo0 }
+ Type1 = Type0,
+ MQInfo = MQInfo0
;
module_qual__qualify_type_qualification(Type0, Type1,
- Context, MQInfo0, MQInfo)
+ Context, MQInfo0, MQInfo, !IO)
),
- {
% Find any new type variables introduced by this type, and
% add them to the var-name index and the variable renaming.
term__vars(Type1, TVars),
@@ -8128,69 +8019,62 @@
% clause item.
RecordExpanded = no,
equiv_type__replace_in_type(EqvMap, Type2, Type, _, TVarSet1, TVarSet,
- RecordExpanded, _)
- },
- update_var_types(VarTypes0, Var, Type, Context, VarTypes),
- { Info = Info0 ^ qual_info := qual_info(EqvMap, TVarSet, TVarRenaming,
- TVarNameMap, VarTypes, MQInfo, Status, FoundError) }.
+ RecordExpanded, _),
+ update_var_types(Var, Type, Context, VarTypes0, VarTypes, !IO),
+ !:Info = !.Info ^ qual_info := qual_info(EqvMap, TVarSet, TVarRenaming,
+ TVarNameMap, VarTypes, MQInfo, Status, FoundError).
-:- pred update_var_types(map(prog_var, type), prog_var, type, prog_context,
- map(prog_var, type), io__state, io__state).
-:- mode update_var_types(in, in, in, in, out, di, uo) is det.
+:- pred update_var_types(prog_var::in, (type)::in, prog_context::in,
+ map(prog_var, type)::in, map(prog_var, type)::out, io::di, io::uo)
+ is det.
-update_var_types(VarTypes0, Var, Type, Context, VarTypes) -->
- ( { map__search(VarTypes0, Var, Type0) } ->
- ( { Type = Type0 } ->
- { VarTypes = VarTypes0 }
+update_var_types(Var, Type, Context, !VarTypes, !IO) :-
+ ( map__search(!.VarTypes, Var, Type0) ->
+ ( Type = Type0 ->
+ true
;
- prog_out__write_context(Context),
- io__write_string("Error: explicit type qualification does\n"),
- prog_out__write_context(Context),
- io__write_string(" not match prior qualification.\n"),
- io__set_exit_status(1),
- { VarTypes = VarTypes0 }
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: explicit type " ++
+ "qualification does\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" not match prior qualification.\n",
+ !IO),
+ io__set_exit_status(1, !IO)
)
;
- { map__det_insert(VarTypes0, Var, Type, VarTypes) }
+ map__det_insert(!.VarTypes, Var, Type, !:VarTypes)
).
% Add new type variables for those introduced by a type qualification.
-:- pred get_new_tvars(list(tvar), tvarset, tvarset, tvarset,
- tvar_name_map, tvar_name_map, map(tvar, tvar), map(tvar, tvar)).
-:- mode get_new_tvars(in, in, in, out, in, out, in, out) is det.
-
-get_new_tvars([], _, T, T, M, M, R, R).
-get_new_tvars([TVar | TVars], VarSet, TVarSet0, TVarSet,
- TVarNameMap0, TVarNameMap, TVarRenaming0, TVarRenaming) :-
- ( map__contains(TVarRenaming0, TVar) ->
- TVarRenaming1 = TVarRenaming0,
- TVarSet2 = TVarSet0,
- TVarNameMap1 = TVarNameMap0
+:- pred get_new_tvars(list(tvar)::in, tvarset::in, tvarset::in, tvarset::out,
+ tvar_name_map::in, tvar_name_map::out,
+ map(tvar, tvar)::in, map(tvar, tvar)::out) is det.
+
+get_new_tvars([], _, !TVarSet, !TVarNameMap, !TVarRenaming).
+get_new_tvars([TVar | TVars], VarSet, !TVarSet, !TVarNameMap, !TVarRenaming) :-
+ ( map__contains(!.TVarRenaming, TVar) ->
+ true
;
( varset__search_name(VarSet, TVar, TVarName) ->
- ( map__search(TVarNameMap0, TVarName, TVarSetVar) ->
- map__det_insert(TVarRenaming0, TVar,
- TVarSetVar, TVarRenaming1),
- TVarSet2 = TVarSet0,
- TVarNameMap1 = TVarNameMap0
- ;
- varset__new_var(TVarSet0, NewTVar, TVarSet1),
- varset__name_var(TVarSet1, NewTVar,
- TVarName, TVarSet2),
- map__det_insert(TVarNameMap0, TVarName,
- NewTVar, TVarNameMap1),
- map__det_insert(TVarRenaming0, TVar, NewTVar,
- TVarRenaming1)
- )
- ;
- TVarNameMap1 = TVarNameMap0,
- varset__new_var(TVarSet0, NewTVar, TVarSet2),
- map__det_insert(TVarRenaming0, TVar, NewTVar,
- TVarRenaming1)
+ ( map__search(!.TVarNameMap, TVarName, TVarSetVar) ->
+ map__det_insert(!.TVarRenaming,
+ TVar, TVarSetVar, !:TVarRenaming)
+ ;
+ varset__new_var(!.TVarSet, NewTVar, !:TVarSet),
+ varset__name_var(!.TVarSet, NewTVar, TVarName,
+ !:TVarSet),
+ map__det_insert(!.TVarNameMap,
+ TVarName, NewTVar, !:TVarNameMap),
+ map__det_insert(!.TVarRenaming, TVar, NewTVar,
+ !:TVarRenaming)
+ )
+ ;
+ varset__new_var(!.TVarSet, NewTVar, !:TVarSet),
+ map__det_insert(!.TVarRenaming, TVar, NewTVar,
+ !:TVarRenaming)
)
),
- get_new_tvars(TVars, VarSet, TVarSet2, TVarSet,
- TVarNameMap1, TVarNameMap, TVarRenaming1, TVarRenaming).
+ get_new_tvars(TVars, VarSet, !TVarSet, !TVarNameMap, !TVarRenaming).
%-----------------------------------------------------------------------------%
@@ -8198,8 +8082,8 @@
% apply substitiution `Subst' (which must only rename vars) to `Vars0',
% and return the result in `Vars'.
-:- pred substitute_vars(list(var(T)), substitution(T), list(var(T))).
-:- mode substitute_vars(in, in, out) is det.
+:- pred substitute_vars(list(var(T))::in, substitution(T)::in,
+ list(var(T))::out) is det.
substitute_vars(Vars0, Subst, Vars) :-
Vars = list__map(substitute_var(Subst), Vars0).
@@ -8305,8 +8189,7 @@
% in an Aditi update.
).
-:- pred init_qual_info(mq_info, eqv_map, qual_info).
-:- mode init_qual_info(in, in, out) is det.
+:- pred init_qual_info(mq_info::in, eqv_map::in, qual_info::out) is det.
init_qual_info(MQInfo0, EqvMap, QualInfo) :-
mq_info_set_need_qual_flag(MQInfo0, may_be_unqualified, MQInfo),
@@ -8315,8 +8198,8 @@
map__init(Index),
map__init(VarTypes),
FoundSyntaxError = no,
- QualInfo = qual_info(EqvMap, TVarSet, Renaming,
- Index, VarTypes, MQInfo, local, FoundSyntaxError).
+ QualInfo = qual_info(EqvMap, TVarSet, Renaming, Index, VarTypes,
+ MQInfo, local, FoundSyntaxError).
% Update the qual_info when processing a new clause.
:- pred update_qual_info(tvar_name_map::in, tvarset::in,
@@ -8359,18 +8242,17 @@
pred(recompilation_info, recompilation_info)::in(pred(in, out) is det),
transform_info::in, transform_info::out) is det.
-apply_to_recompilation_info(Pred, Info0, Info) :-
- MQInfo0 = Info0 ^ qual_info ^ mq_info,
+apply_to_recompilation_info(Pred, !Info) :-
+ MQInfo0 = !.Info ^ qual_info ^ mq_info,
mq_info_get_recompilation_info(MQInfo0, MaybeRecompInfo0),
(
MaybeRecompInfo0 = yes(RecompInfo0),
Pred(RecompInfo0, RecompInfo),
mq_info_set_recompilation_info(MQInfo0,
yes(RecompInfo), MQInfo),
- Info = Info0 ^ qual_info ^ mq_info := MQInfo
+ !:Info = !.Info ^ qual_info ^ mq_info := MQInfo
;
- MaybeRecompInfo0 = no,
- Info = Info0
+ MaybeRecompInfo0 = no
).
set_module_recompilation_info(QualInfo, !ModuleInfo) :-
@@ -8386,26 +8268,25 @@
recompilation__record_used_item(
pred_or_func_to_item_type(PredOrFunc), Id, Id)).
-:- pred record_used_functor(cons_id, transform_info, transform_info).
-:- mode record_used_functor(in, in, out) is det.
+:- pred record_used_functor(cons_id::in,
+ transform_info::in, transform_info::out) is det.
-record_used_functor(ConsId) -->
- (
- { ConsId = cons(SymName, Arity) }
- ->
- { Id = SymName - Arity },
+record_used_functor(ConsId, !Info) :-
+ ( ConsId = cons(SymName, Arity) ->
+ Id = SymName - Arity,
apply_to_recompilation_info(
- recompilation__record_used_item(functor, Id, Id))
+ recompilation__record_used_item(functor, Id, Id),
+ !Info)
;
- []
+ true
).
%-----------------------------------------------------------------------------%
% Predicates to write out the different warning and error messages.
-:- pred report_unexpected_decl(string, prog_context, io__state, io__state).
-:- mode report_unexpected_decl(in, in, di, uo) is det.
+:- pred report_unexpected_decl(string::in, prog_context::in,
+ io::di, io::uo) is det.
report_unexpected_decl(Descr, Context) -->
io__set_exit_status(1),
@@ -8414,12 +8295,12 @@
io__write_string(Descr),
io__write_string("' declaration.\n").
-:- pred multiple_def_error(import_status, sym_name, int, string, prog_context,
- prog_context, bool, io__state, io__state).
-:- mode multiple_def_error(in, in, in, in, in, in, out, di, uo) is det.
+:- pred multiple_def_error(import_status::in, sym_name::in, int::in,
+ string::in, prog_context::in, prog_context::in, bool::out,
+ io::di, io::uo) is det.
-multiple_def_error(Status, Name, Arity, DefType, Context,
- OrigContext, FoundError) -->
+multiple_def_error(Status, Name, Arity, DefType, Context, OrigContext,
+ FoundError) -->
( { Status \= opt_imported } ->
io__set_exit_status(1),
prog_out__write_context(Context),
@@ -8448,9 +8329,8 @@
{ FoundError = no }
).
-:- pred undefined_pred_or_func_error(sym_name, int, prog_context, string,
- io__state, io__state).
-:- mode undefined_pred_or_func_error(in, in, in, in, di, uo) is det.
+:- pred undefined_pred_or_func_error(sym_name::in, int::in, prog_context::in,
+ string::in, io::di, io::uo) is det.
undefined_pred_or_func_error(Name, Arity, Context, Description) -->
io__set_exit_status(1),
@@ -8463,10 +8343,10 @@
prog_out__write_context(Context),
% This used to say `preceding' instead of `corresponding.'
% Which is more correct?
- io__write_string(" without corresponding `pred' or `func' declaration.\n").
+ io__write_string(" without corresponding `pred' or `func' " ++
+ "declaration.\n").
-:- pred pred_method_with_no_modes_error(pred_info, io__state, io__state).
-:- mode pred_method_with_no_modes_error(in, di, uo) is det.
+:- pred pred_method_with_no_modes_error(pred_info::in, io::di, io::uo) is det.
pred_method_with_no_modes_error(PredInfo) -->
{ pred_info_context(PredInfo, Context) },
@@ -8484,9 +8364,8 @@
% Similar to undeclared_mode_error, but gives less information.
% XXX perhaps we should get rid of this, and change the callers to
% instead call undeclared_mode_error.
-:- pred undefined_mode_error(sym_name, int, prog_context, string,
- io__state, io__state).
-:- mode undefined_mode_error(in, in, in, in, di, uo) is det.
+:- pred undefined_mode_error(sym_name::in, int::in, prog_context::in,
+ string::in, io::di, io::uo) is det.
undefined_mode_error(Name, Arity, Context, Description) -->
io__set_exit_status(1),
@@ -8547,9 +8426,9 @@
true
).
-:- pred maybe_undefined_pred_error(sym_name, int, pred_or_func, import_status,
- bool, prog_context, string, io__state, io__state).
-:- mode maybe_undefined_pred_error(in, in, in, in, in, in, in, di, uo) is det.
+:- pred maybe_undefined_pred_error(sym_name::in, int::in, pred_or_func::in,
+ import_status::in, bool::in, prog_context::in, string::in,
+ io::di, io::uo) is det.
% This is not considered an unconditional error anymore:
% if there is no `:- pred' or `:- func' declaration,
@@ -8599,9 +8478,8 @@
io__write_string("' declaration.\n")
).
-:- pred undefined_type_class_error(sym_name, int, prog_context, string,
- io__state, io__state).
-:- mode undefined_type_class_error(in, in, in, in, di, uo) is det.
+:- pred undefined_type_class_error(sym_name::in, int::in, prog_context::in,
+ string::in, io::di, io::uo) is det.
undefined_type_class_error(ClassName, Arity, Context, Description) -->
io__set_exit_status(1),
@@ -8614,9 +8492,8 @@
prog_out__write_sym_name_and_arity(ClassName/Arity),
io__write_string("' without preceding typeclass declaration.\n").
-:- pred unspecified_det_for_local(sym_name, arity, pred_or_func, prog_context,
- io__state, io__state).
-:- mode unspecified_det_for_local(in, in, in, in, di, uo) is det.
+:- pred unspecified_det_for_local(sym_name::in, arity::in, pred_or_func::in,
+ prog_context::in, io::di, io::uo) is det.
unspecified_det_for_local(Name, Arity, PredOrFunc, Context) -->
prog_out__write_context(Context),
@@ -8639,9 +8516,8 @@
[]
).
-:- pred unspecified_det_for_method(sym_name, arity, pred_or_func,
- prog_context, io__state, io__state).
-:- mode unspecified_det_for_method(in, in, in, in, di, uo) is det.
+:- pred unspecified_det_for_method(sym_name::in, arity::in, pred_or_func::in,
+ prog_context::in, io::di, io::uo) is det.
unspecified_det_for_method(Name, Arity, PredOrFunc, Context) -->
io__set_exit_status(1),
@@ -8653,9 +8529,8 @@
hlds_out__write_simple_call_id(PredOrFunc, Name/Arity),
io__write_string(".\n").
-:- pred unspecified_det_for_exported(sym_name, arity, pred_or_func,
- prog_context, io__state, io__state).
-:- mode unspecified_det_for_exported(in, in, in, in, di, uo) is det.
+:- pred unspecified_det_for_exported(sym_name::in, arity::in, pred_or_func::in,
+ prog_context::in, io::di, io::uo) is det.
unspecified_det_for_exported(Name, Arity, PredOrFunc, Context) -->
io__set_exit_status(1),
@@ -8666,9 +8541,8 @@
hlds_out__write_simple_call_id(PredOrFunc, Name/Arity),
io__write_string(".\n").
-:- pred clause_for_imported_pred_error(sym_name, arity, pred_or_func,
- prog_context, io__state, io__state).
-:- mode clause_for_imported_pred_error(in, in, in, in, di, uo) is det.
+:- pred clause_for_imported_pred_error(sym_name::in, arity::in,
+ pred_or_func::in, prog_context::in, io::di, io::uo) is det.
clause_for_imported_pred_error(Name, Arity, PredOrFunc, Context) -->
io__set_exit_status(1),
@@ -8677,9 +8551,8 @@
hlds_out__write_simple_call_id(PredOrFunc, Name/Arity),
io__write_string(".\n").
-:- pred unqualified_pred_error(sym_name, int, prog_context,
- io__state, io__state).
-:- mode unqualified_pred_error(in, in, in, di, uo) is det.
+:- pred unqualified_pred_error(sym_name::in, int::in, prog_context::in,
+ io::di, io::uo) is det.
unqualified_pred_error(PredName, Arity, Context) -->
io__set_exit_status(1),
@@ -8692,9 +8565,8 @@
prog_out__write_context(Context),
io__write_string(" should have been qualified by prog_io.m.\n").
-:- pred pragma_status_error(sym_name, int, prog_context, string,
- io__state, io__state).
-:- mode pragma_status_error(in, in, in, in, di, uo) is det.
+:- pred pragma_status_error(sym_name::in, int::in, prog_context::in,
+ string::in, io::di, io::uo) is det.
pragma_status_error(Name, Arity, Context, PragmaName) -->
io__set_exit_status(1),
@@ -8707,9 +8579,8 @@
prog_out__write_sym_name_and_arity(Name/Arity),
io__write_string(" must also be exported.\n").
-:- pred pragma_conflict_error(sym_name, int, prog_context, string,
- io__state, io__state).
-:- mode pragma_conflict_error(in, in, in, in, di, uo) is det.
+:- pred pragma_conflict_error(sym_name::in, int::in, prog_context::in,
+ string::in, io::di, io::uo) is det.
pragma_conflict_error(Name, Arity, Context, PragmaName) -->
io__set_exit_status(1),
@@ -8798,23 +8669,22 @@
% `pragma fact_table's are represented in the HLDS by a
% `pragma c_code' for each mode of the predicate.
-:- pred module_add_fact_table_procedures(list(proc_id), proc_id, proc_table,
- sym_name, pred_or_func, arity, list(type), import_status,
- prog_context, module_info, module_info, qual_info, qual_info,
- io__state, io__state).
-:- mode module_add_fact_table_procedures(in, in, in, in, in, in, in, in,
- in, in, out, in, out, di, uo) is det.
+:- pred module_add_fact_table_procedures(list(proc_id)::in, proc_id::in,
+ proc_table::in, sym_name::in, pred_or_func::in, arity::in,
+ list(type)::in, import_status::in, prog_context::in,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ io::di, io::uo) is det.
-module_add_fact_table_procedures([],_,_,_,_,_,_,_,_,Mod,Mod,Inf,Inf) --> [].
+module_add_fact_table_procedures([],_,_,_,_,_,_,_,_, !Module, !Info, !IO).
module_add_fact_table_procedures([ProcID | ProcIDs], PrimaryProcID, ProcTable,
SymName, PredOrFunc, Arity, ArgTypes, Status, Context,
- Module0, Module, Info0, Info) -->
+ !Module, !Info, !IO) :-
module_add_fact_table_proc(ProcID, PrimaryProcID, ProcTable, SymName,
PredOrFunc, Arity, ArgTypes, Status, Context,
- Module0, Module1, Info0, Info1),
+ !Module, !Info, !IO),
module_add_fact_table_procedures(ProcIDs, PrimaryProcID, ProcTable,
SymName, PredOrFunc, Arity, ArgTypes, Status, Context,
- Module1, Module, Info1, Info).
+ !Module, !Info, !IO).
:- pred module_add_fact_table_proc(proc_id::in, proc_id::in, proc_table::in,
sym_name::in, pred_or_func::in, arity::in, list(type)::in,
@@ -8833,11 +8703,11 @@
ProcInfo, ArgTypes, !.Module, C_ProcCode, C_ExtraCode, !IO),
% XXX this should be modified to use nondet pragma c_code.
- default_attributes(c, Attrs0),
- set_may_call_mercury(Attrs0, will_not_call_mercury, Attrs1),
- set_thread_safe(Attrs1, thread_safe, Attrs2),
+ Attrs0 = default_attributes(c),
+ set_may_call_mercury(will_not_call_mercury, Attrs0, Attrs1),
+ set_thread_safe(thread_safe, Attrs1, Attrs2),
% fact tables procedures should be considered pure
- set_purity(Attrs2, pure, Attrs),
+ set_purity(pure, Attrs2, Attrs),
module_add_pragma_foreign_proc(Attrs, SymName, PredOrFunc,
PragmaVars, VarSet, ordinary(C_ProcCode, no),
Status, Context, !Module, !Info, !IO),
@@ -8860,9 +8730,8 @@
% This is required by module_add_pragma_c_code to add the C code for
% the procedure to the HLDS.
-:- pred fact_table_pragma_vars(list(prog_var), list(mode), prog_varset,
- list(pragma_var)).
-:- mode fact_table_pragma_vars(in, in, in, out) is det.
+:- pred fact_table_pragma_vars(list(prog_var)::in, list(mode)::in,
+ prog_varset::in, list(pragma_var)::out) is det.
fact_table_pragma_vars(Vars0, Modes0, VarSet, PragmaVars0) :-
(
@@ -8892,42 +8761,48 @@
% disjunction has at most one call, and otherwise has only unifications
% perform above checks on a promise ex declaration
-:- pred check_promise_ex_decl(prog_vars, promise_type, goal, prog_context,
- io__state, io__state).
-:- mode check_promise_ex_decl(in, in, in, in, di, uo) is det.
-check_promise_ex_decl(UnivVars, PromiseType, Goal, Context) -->
+:- pred check_promise_ex_decl(prog_vars::in, promise_type::in, goal::in,
+ prog_context::in, io::di, io::uo) is det.
+
+check_promise_ex_decl(UnivVars, PromiseType, Goal, Context, !IO) :-
% are universally quantified variables present?
(
- { UnivVars = [] },
- promise_ex_error(PromiseType, Context, "declaration has no universally quantified variables")
+ UnivVars = [],
+ promise_ex_error(PromiseType, Context,
+ "declaration has no universally quantified variables",
+ !IO)
;
- { UnivVars = [_ | _] }
+ UnivVars = [_ | _]
),
- check_promise_ex_goal(PromiseType, Goal).
+ check_promise_ex_goal(PromiseType, Goal, !IO).
% check for misplaced universal quantification, otherwise find the
% disjunction, flatten it out into list form and perform further
% checks
-:- pred check_promise_ex_goal(promise_type, goal, io__state, io__state).
-:- mode check_promise_ex_goal(in, in, di, uo) is det.
-check_promise_ex_goal(PromiseType, GoalExpr - Context) -->
- ( { GoalExpr = some(_, Goal) } ->
- check_promise_ex_goal(PromiseType, Goal)
- ; { GoalExpr = ( _ ; _ ) } ->
- { flatten_to_disj_list(GoalExpr - Context, DisjList) },
- { list__map(flatten_to_conj_list, DisjList, DisjConjList) },
- check_disjunction(PromiseType, DisjConjList)
- ; { GoalExpr = all(_UnivVars, Goal) } ->
- promise_ex_error(PromiseType, Context, "universal quantification should come before the declaration name"),
- check_promise_ex_goal(PromiseType, Goal)
+:- pred check_promise_ex_goal(promise_type::in, goal::in, io::di, io::uo)
+ is det.
+
+check_promise_ex_goal(PromiseType, GoalExpr - Context, !IO) :-
+ ( GoalExpr = some(_, Goal) ->
+ check_promise_ex_goal(PromiseType, Goal, !IO)
+ ; GoalExpr = ( _ ; _ ) ->
+ flatten_to_disj_list(GoalExpr - Context, DisjList),
+ list__map(flatten_to_conj_list, DisjList, DisjConjList),
+ check_disjunction(PromiseType, DisjConjList, !IO)
+ ; GoalExpr = all(_UnivVars, Goal) ->
+ promise_ex_error(PromiseType, Context,
+ "universal quantification should come before " ++
+ "the declaration name", !IO),
+ check_promise_ex_goal(PromiseType, Goal, !IO)
;
- promise_ex_error(PromiseType, Context, "goal in declaration is not a disjunction")
+ promise_ex_error(PromiseType, Context,
+ "goal in declaration is not a disjunction", !IO)
).
% turns the goal of a promise ex declaration into a list of goals,
% where each goal is an arm of the disjunction
-:- pred flatten_to_disj_list(goal, goals).
-:- mode flatten_to_disj_list(in, out) is det.
+:- pred flatten_to_disj_list(goal::in, goals::out) is det.
+
flatten_to_disj_list(GoalExpr - Context, GoalList) :-
( GoalExpr = ( GoalA ; GoalB ) ->
flatten_to_disj_list(GoalA, GoalListA),
@@ -8939,8 +8814,8 @@
% takes a goal representing an arm of a disjunction and turn it into
% a list of conjunct goals
-:- pred flatten_to_conj_list(goal, goals).
-:- mode flatten_to_conj_list(in, out) is det.
+:- pred flatten_to_conj_list(goal::in, goals::out) is det.
+
flatten_to_conj_list(GoalExpr - Context, GoalList) :-
( GoalExpr = ( GoalA , GoalB ) ->
flatten_to_conj_list(GoalA, GoalListA),
@@ -8952,60 +8827,67 @@
% taking a list of arms of the disjunction, check each arm
% individually
-:- pred check_disjunction(promise_type, list(goals), io__state, io__state).
-:- mode check_disjunction(in, in, di, uo) is det.
-check_disjunction(PromiseType, DisjConjList) -->
- (
- { DisjConjList = [] }
- ;
- { DisjConjList = [ConjList | Rest] },
- check_disj_arm(PromiseType, ConjList, no),
- check_disjunction(PromiseType, Rest)
+:- pred check_disjunction(promise_type::in, list(goals)::in, io::di, io::uo)
+ is det.
+
+check_disjunction(PromiseType, DisjConjList, !IO) :-
+ (
+ DisjConjList = []
+ ;
+ DisjConjList = [ConjList | Rest],
+ check_disj_arm(PromiseType, ConjList, no, !IO),
+ check_disjunction(PromiseType, Rest, !IO)
).
% only one goal in an arm is allowed to be a call, the rest must be
% unifications
-:- pred check_disj_arm(promise_type, goals, bool, io__state, io__state).
-:- mode check_disj_arm(in, in, in, di, uo) is det.
-check_disj_arm(PromiseType, Goals, CallUsed) -->
+:- pred check_disj_arm(promise_type::in, goals::in, bool::in,
+ io::di, io::uo) is det.
+
+check_disj_arm(PromiseType, Goals, CallUsed, !IO) :-
(
- { Goals = [] }
+ Goals = []
;
- { Goals = [GoalExpr - Context | Rest] },
- ( { GoalExpr = unify(_, _, _) } ->
- check_disj_arm(PromiseType, Rest, CallUsed)
- ; { GoalExpr = some(_, Goal) } ->
- check_disj_arm(PromiseType, [Goal | Rest], CallUsed)
- ; { GoalExpr = call(_, _, _) } ->
+ Goals = [GoalExpr - Context | Rest],
+ ( GoalExpr = unify(_, _, _) ->
+ check_disj_arm(PromiseType, Rest, CallUsed, !IO)
+ ; GoalExpr = some(_, Goal) ->
+ check_disj_arm(PromiseType, [Goal | Rest], CallUsed,
+ !IO)
+ ; GoalExpr = call(_, _, _) ->
(
- { CallUsed = no }
+ CallUsed = no
;
- { CallUsed = yes },
- promise_ex_error(PromiseType, Context, "disjunct contains more than one call")
+ CallUsed = yes,
+ promise_ex_error(PromiseType, Context,
+ "disjunct contains more than one call",
+ !IO)
),
- check_disj_arm(PromiseType, Rest, yes)
+ check_disj_arm(PromiseType, Rest, yes, !IO)
;
- promise_ex_error(PromiseType, Context, "disjunct is not a call or unification"),
- check_disj_arm(PromiseType, Rest, CallUsed)
+ promise_ex_error(PromiseType, Context,
+ "disjunct is not a call or unification", !IO),
+ check_disj_arm(PromiseType, Rest, CallUsed, !IO)
)
).
% called for any error in the above checks
-:- pred promise_ex_error(promise_type, prog_context, string,
- io__state, io__state).
-:- mode promise_ex_error(in, in, in, di, uo) is det.
-promise_ex_error(PromiseType, Context, Message) -->
- { ErrorPieces = [
+:- pred promise_ex_error(promise_type::in, prog_context::in, string::in,
+ io::di, io::uo) is det.
+
+promise_ex_error(PromiseType, Context, Message, !IO) :-
+ ErrorPieces = [
words("In"),
fixed("`" ++ prog_out__promise_to_string(PromiseType) ++ "'"),
words("declaration:"),
nl,
words("error:"),
words(Message)
- ] },
- error_util__write_error_pieces(Context, 0, ErrorPieces).
+ ],
+ error_util__write_error_pieces(Context, 0, ErrorPieces, !IO).
:- func this_file = string.
+
this_file = "make_hlds.m".
%------------------------------------------------------------------------------%
@@ -9086,48 +8968,30 @@
% Note that if !.X does not appear in the head then !:X must
% appear before !.X can be referenced.
%
-:- pred dot(prog_context, svar, prog_var,
- prog_varset, prog_varset, svar_info, svar_info, io, io).
-:- mode dot(in, in, out, in, out, in, out, di, uo) is det.
-
-dot(Context, StateVar, Var, VarSet0, VarSet, SInfo0, SInfo, IO0, IO) :-
-
- ( if SInfo0 ^ ctxt = in_head then
+:- pred dot(prog_context::in, svar::in, prog_var::out,
+ prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
- ( if SInfo0 ^ dot ^ elem(StateVar) = Var0 then
- Var = Var0,
- VarSet = VarSet0,
- SInfo = SInfo0,
- IO = IO0
- else
- new_dot_state_var(StateVar, Var,
- VarSet0, VarSet, SInfo0, SInfo),
- IO = IO0
+dot(Context, StateVar, Var, !VarSet, !SInfo, !IO) :-
+ ( !.SInfo ^ ctxt = in_head ->
+ ( !.SInfo ^ dot ^ elem(StateVar) = Var0 ->
+ Var = Var0
+ ;
+ new_dot_state_var(StateVar, Var, !VarSet, !SInfo)
)
-
- else
-
- ( if SInfo0 ^ dot ^ elem(StateVar) = Var0 then
- Var = Var0,
- VarSet = VarSet0,
- SInfo = SInfo0,
- IO = IO0
- else if SInfo0 ^ external_dot ^ elem(StateVar) = Var0 then
- Var = Var0,
- VarSet = VarSet0,
- SInfo = SInfo0,
- IO = IO0
- else if SInfo0 `has_svar_colon_mapping_for` StateVar then
- new_dot_state_var(StateVar, Var,
- VarSet0, VarSet, SInfo0, SInfo),
- report_unitialized_state_var(Context, VarSet, StateVar,
- IO0, IO)
- else
+ ;
+ ( !.SInfo ^ dot ^ elem(StateVar) = Var0 ->
+ Var = Var0
+ ; !.SInfo ^ external_dot ^ elem(StateVar) = Var0 ->
+ Var = Var0
+ ; !.SInfo `has_svar_colon_mapping_for` StateVar ->
+ new_dot_state_var(StateVar, Var, !VarSet, !SInfo),
+ report_unitialized_state_var(Context, !.VarSet,
+ StateVar, !IO)
+ ;
Var = StateVar,
- VarSet = VarSet0,
- SInfo = SInfo0,
- report_non_visible_state_var(".", Context,
- VarSet, StateVar, IO0, IO)
+ report_non_visible_state_var(".", Context, !.VarSet,
+ StateVar, !IO)
)
).
@@ -9155,105 +9019,93 @@
% We also keep track of which state variables have been updated
% in an atomic context.
%
-:- pred colon(prog_context, svar, prog_var,
- prog_varset, prog_varset, svar_info, svar_info, io, io).
-:- mode colon(in, in, out, in, out, in, out, di, uo) is det.
-
-colon(Context, StateVar, Var, VarSet0, VarSet, SInfo0, SInfo, IO0, IO) :-
-
- ( if SInfo0 ^ ctxt = in_head then
+:- pred colon(prog_context::in, svar::in, prog_var::out,
+ prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
- ( if SInfo0 ^ colon ^ elem(StateVar) = Var0 then
- Var = Var0,
- VarSet = VarSet0,
- SInfo = SInfo0,
- IO = IO0
- else
- new_final_state_var(StateVar, Var,
- VarSet0, VarSet, SInfo0, SInfo),
- IO = IO0
+colon(Context, StateVar, Var, !VarSet, !SInfo, !IO) :-
+ ( !.SInfo ^ ctxt = in_head ->
+ ( !.SInfo ^ colon ^ elem(StateVar) = Var0 ->
+ Var = Var0
+ ;
+ new_final_state_var(StateVar, Var, !VarSet, !SInfo)
)
-
- else
-
- ( if SInfo0 ^ colon ^ elem(StateVar) = Var0 then
+ ;
+ ( !.SInfo ^ colon ^ elem(StateVar) = Var0 ->
Var = Var0,
- VarSet = VarSet0,
- SInfo = SInfo0 `with_updated_svar` StateVar,
- IO = IO0
- else
+ !:SInfo = !.SInfo `with_updated_svar` StateVar
+ ;
Var = StateVar,
- VarSet = VarSet0,
- SInfo = SInfo0,
- PError = ( if SInfo0 ^ external_dot `contains` StateVar
- then report_illegal_state_var_update
- else report_non_visible_state_var(":")
+ ( !.SInfo ^ external_dot `contains` StateVar ->
+ PError = report_illegal_state_var_update
+ ;
+ PError = report_non_visible_state_var(":")
),
- PError(Context, VarSet, StateVar, IO0, IO)
+ PError(Context, !.VarSet, StateVar, !IO)
)
).
:- func svar_info `with_updated_svar` svar = svar_info.
SInfo `with_updated_svar` StateVar =
- ( if SInfo ^ ctxt = in_atom(UpdatedStateVars, ParentSInfo)
- then SInfo ^ ctxt := in_atom(set__insert(UpdatedStateVars, StateVar),
+ ( SInfo ^ ctxt = in_atom(UpdatedStateVars, ParentSInfo) ->
+ SInfo ^ ctxt := in_atom(set__insert(UpdatedStateVars, StateVar),
ParentSInfo)
- else SInfo
+ ;
+ SInfo
).
%------------------------------------------------------------------------------%
% Construct the initial and final mappings for a state variable.
%
-:- pred new_local_state_var(svar, prog_var, prog_var,
- prog_varset, prog_varset, svar_info, svar_info).
-:- mode new_local_state_var(in, out, out, in, out, in, out) is det.
-
-new_local_state_var(StateVar, VarD, VarC, VarSet0, VarSet, SInfo0, SInfo) :-
- new_dot_state_var(StateVar, VarD, VarSet0, VarSet1, SInfo0, SInfo1),
- new_final_state_var(StateVar, VarC, VarSet1, VarSet, SInfo1, SInfo).
+:- pred new_local_state_var(svar::in, prog_var::out, prog_var::out,
+ prog_varset::in, prog_varset::out, svar_info::in, svar_info::out)
+ is det.
+
+new_local_state_var(StateVar, VarD, VarC, !VarSet, !SInfo) :-
+ new_dot_state_var(StateVar, VarD, !VarSet, !SInfo),
+ new_final_state_var(StateVar, VarC, !VarSet, !SInfo).
% Construct the initial and final mappings for a state variable.
%
-:- pred new_dot_state_var(svar, prog_var,
- prog_varset, prog_varset, svar_info, svar_info).
-:- mode new_dot_state_var(in, out, in, out, in, out) is det.
-
-new_dot_state_var(StateVar, VarD, VarSet0, VarSet, SInfo0, SInfo) :-
- N = SInfo0 ^ num,
- Name = varset__lookup_name(VarSet0, StateVar),
+:- pred new_dot_state_var(svar::in, prog_var::out,
+ prog_varset::in, prog_varset::out, svar_info::in, svar_info::out)
+ is det.
+
+new_dot_state_var(StateVar, VarD, !VarSet, !SInfo) :-
+ N = !.SInfo ^ num,
+ Name = varset__lookup_name(!.VarSet, StateVar),
NameD = string__format("STATE_VARIABLE_%s_%d", [s(Name), i(N)]),
- varset__new_named_var(VarSet0, NameD, VarD, VarSet),
- SInfo = ( SInfo0 ^ dot ^ elem(StateVar) := VarD ).
+ varset__new_named_var(!.VarSet, NameD, VarD, !:VarSet),
+ !:SInfo = ( !.SInfo ^ dot ^ elem(StateVar) := VarD ).
+
+:- pred new_colon_state_var(svar::in, prog_var::out,
+ prog_varset::in, prog_varset::out, svar_info::in, svar_info::out)
+ is det.
-:- pred new_colon_state_var(svar, prog_var,
- prog_varset, prog_varset, svar_info, svar_info).
-:- mode new_colon_state_var(in, out, in, out, in, out) is det.
-
-new_colon_state_var(StateVar, VarC, VarSet0, VarSet, SInfo0, SInfo) :-
- N = SInfo0 ^ num,
- Name = varset__lookup_name(VarSet0, StateVar),
+new_colon_state_var(StateVar, VarC, !VarSet, !SInfo) :-
+ N = !.SInfo ^ num,
+ Name = varset__lookup_name(!.VarSet, StateVar),
NameC = string__format("STATE_VARIABLE_%s_%d", [s(Name), i(N)]),
- varset__new_named_var(VarSet0, NameC, VarC, VarSet),
- SInfo = ( SInfo0 ^ colon ^ elem(StateVar) := VarC ).
+ varset__new_named_var(!.VarSet, NameC, VarC, !:VarSet),
+ !:SInfo = ( !.SInfo ^ colon ^ elem(StateVar) := VarC ).
-:- pred new_final_state_var(svar, prog_var,
- prog_varset, prog_varset, svar_info, svar_info).
-:- mode new_final_state_var(in, out, in, out, in, out) is det.
+:- pred new_final_state_var(svar::in, prog_var::out,
+ prog_varset::in, prog_varset::out, svar_info::in, svar_info::out)
+ is det.
-new_final_state_var(StateVar, VarC, VarSet0, VarSet, SInfo0, SInfo) :-
- Name = varset__lookup_name(VarSet0, StateVar),
+new_final_state_var(StateVar, VarC, !VarSet, !SInfo) :-
+ Name = varset__lookup_name(!.VarSet, StateVar),
NameC = string__format("STATE_VARIABLE_%s", [s(Name)]),
- varset__new_named_var(VarSet0, NameC, VarC, VarSet),
- SInfo = ( SInfo0 ^ colon ^ elem(StateVar) := VarC ).
+ varset__new_named_var(!.VarSet, NameC, VarC, !:VarSet),
+ !:SInfo = ( !.SInfo ^ colon ^ elem(StateVar) := VarC ).
%------------------------------------------------------------------------------%
% Prepare for the head of a new clause.
%
-:- pred prepare_for_head(svar_info).
-:- mode prepare_for_head(out) is det.
+:- pred prepare_for_head(svar_info::out) is det.
prepare_for_head(new_svar_info).
@@ -9266,11 +9118,10 @@
% implicitly scoped over the body and have !. and !: mappings
% set up.
%
-:- pred prepare_for_lambda(svar_info, svar_info).
-:- mode prepare_for_lambda(in, out) is det.
+:- pred prepare_for_lambda(svar_info::in, svar_info::out) is det.
-prepare_for_lambda(SInfo0, SInfo) :-
- SInfo = ( new_svar_info ^ external_dot := SInfo0 ^ dot ).
+prepare_for_lambda(!SInfo) :-
+ !:SInfo = ( new_svar_info ^ external_dot := !.SInfo ^ dot ).
%------------------------------------------------------------------------------%
@@ -9278,17 +9129,16 @@
% (source-level) atomic conjunct. We return the final !:
% mappings identified while processing the head.
%
-:- pred prepare_for_body(svar_map, prog_varset, prog_varset,
- svar_info, svar_info).
-:- mode prepare_for_body(out, in, out, in, out) is det.
-
-prepare_for_body(FinalMap, VarSet0, VarSet, SInfo0, SInfo) :-
- FinalMap = SInfo0 ^ colon,
- N = SInfo0 ^ num + 1,
- StateVars = list__merge_and_remove_dups(map__keys(SInfo0 ^ colon),
- map__keys(SInfo0 ^ dot)),
- next_svar_mappings(N, StateVars, VarSet0, VarSet, Colon),
- SInfo = ((( SInfo0 ^ ctxt := in_body )
+:- pred prepare_for_body(svar_map::out, prog_varset::in, prog_varset::out,
+ svar_info::in, svar_info::out) is det.
+
+prepare_for_body(FinalMap, !VarSet, !SInfo) :-
+ FinalMap = !.SInfo ^ colon,
+ N = !.SInfo ^ num + 1,
+ StateVars = list__merge_and_remove_dups(map__keys(!.SInfo ^ colon),
+ map__keys(!.SInfo ^ dot)),
+ next_svar_mappings(N, StateVars, !VarSet, Colon),
+ !:SInfo = ((( !.SInfo ^ ctxt := in_body )
^ num := N )
^ colon := Colon ).
@@ -9297,9 +9147,8 @@
% We have to conjoin the head and body and add unifiers to tie up all
% the final values of the state variables to the head variables.
%
-:- pred finish_head_and_body(prog_context, svar_map,
- hlds_goal, hlds_goal, hlds_goal, svar_info).
-:- mode finish_head_and_body(in, in, in, in, out, in) is det.
+:- pred finish_head_and_body(prog_context::in, svar_map::in,
+ hlds_goal::in, hlds_goal::in, hlds_goal::out, svar_info::in) is det.
finish_head_and_body(Context, FinalSVarMap, Head, Body, Goal, SInfo) :-
goal_info_init(Context, GoalInfo),
@@ -9332,48 +9181,47 @@
% Add some local state variables.
%
-:- pred prepare_for_local_state_vars(svars, prog_varset, prog_varset,
- svar_info, svar_info).
-:- mode prepare_for_local_state_vars(in, in, out, in, out) is det.
+:- pred prepare_for_local_state_vars(svars::in,
+ prog_varset::in, prog_varset::out, svar_info::in, svar_info::out)
+ is det.
-prepare_for_local_state_vars(StateVars, VarSet0, VarSet, SInfo0, SInfo) :-
+prepare_for_local_state_vars(StateVars, !VarSet, !SInfo) :-
list__foldl2(add_new_local_state_var, StateVars,
- VarSet0, VarSet, SInfo0, SInfo).
+ !VarSet, !SInfo).
-:- pred add_new_local_state_var(svar, prog_varset, prog_varset,
- svar_info, svar_info).
-:- mode add_new_local_state_var(in, in, out, in, out) is det.
+:- pred add_new_local_state_var(svar::in,
+ prog_varset::in, prog_varset::out, svar_info::in, svar_info::out)
+ is det.
-add_new_local_state_var(StateVar, VarSet0, VarSet, SInfo0, SInfo) :-
- new_colon_state_var(StateVar, _, VarSet0, VarSet, SInfo0, SInfo).
+add_new_local_state_var(StateVar, !VarSet, !SInfo) :-
+ new_colon_state_var(StateVar, _, !VarSet, !SInfo).
%------------------------------------------------------------------------------%
% Remove some local state variables.
%
-:- pred finish_local_state_vars(svars, prog_vars,
- svar_info, svar_info, svar_info).
-:- mode finish_local_state_vars(in, out, in, in, out) is det.
-
-finish_local_state_vars(StateVars, Vars, SInfoBefore, SInfo0, SInfo) :-
- Dots = svar_mappings(SInfo0 ^ dot , StateVars),
- Colons = svar_mappings(SInfo0 ^ colon, StateVars),
+:- pred finish_local_state_vars(svars::in, prog_vars::out,
+ svar_info::in, svar_info::in, svar_info::out) is det.
+
+finish_local_state_vars(StateVars, Vars, SInfoBefore, !SInfo) :-
+ Dots = svar_mappings(!.SInfo ^ dot , StateVars),
+ Colons = svar_mappings(!.SInfo ^ colon, StateVars),
Vars = list__sort_and_remove_dups(Dots ++ Colons),
- SInfo = (( SInfo0 ^ dot := del_locals(StateVars,
+ !:SInfo = (( !.SInfo ^ dot := del_locals(StateVars,
SInfoBefore ^ dot,
- SInfo0 ^ dot) )
+ !.SInfo ^ dot) )
^ colon := del_locals(StateVars,
SInfoBefore ^ colon,
- SInfo0 ^ colon) ).
+ !.SInfo ^ colon) ).
:- func svar_mappings(svar_map, svars) = svars.
-svar_mappings(_, [] ) = [].
-
+svar_mappings(_, []) = [].
svar_mappings(Map, [StateVar | StateVars]) =
- ( if Map ^ elem(StateVar) = Var
- then [Var | svar_mappings(Map, StateVars)]
- else svar_mappings(Map, StateVars)
+ ( Map ^ elem(StateVar) = Var ->
+ [Var | svar_mappings(Map, StateVars)]
+ ;
+ svar_mappings(Map, StateVars)
).
:- func del_locals(svars, svar_map, svar_map) = svar_map.
@@ -9400,15 +9248,13 @@
% We construct new mappings for the state variables and then
% add unifiers.
%
-:- pred finish_if_then_else(prog_context, hlds_goal, hlds_goal, hlds_goal,
- hlds_goal, svar_info, svar_info, svar_info, svar_info,
- svar_info, prog_varset, prog_varset).
-:- mode finish_if_then_else(in, in, out, in, out, in, in, in, in, out,
- in, out) is det.
+:- pred finish_if_then_else(prog_context::in, hlds_goal::in, hlds_goal::out,
+ hlds_goal::in, hlds_goal::out, svar_info::in,
+ svar_info::in, svar_info::in, svar_info::in, svar_info::out,
+ prog_varset::in, prog_varset::out) is det.
finish_if_then_else(Context, Then0, Then, Else0, Else,
- SInfo0, SInfoC, SInfoT0, SInfoE, SInfo,
- VarSet0, VarSet) :-
+ SInfo0, SInfoC, SInfoT0, SInfoE, SInfo, !VarSet) :-
% Add unifiers to the Then arm for state variables that
% acquired new mappings in the condition, but not in the
@@ -9421,14 +9267,14 @@
goal_to_conj_list(Then0, Thens0),
add_then_arm_specific_unifiers(Context, StateVars,
SInfo0, SInfoC, SInfoT0, SInfoT,
- Thens0, Thens, VarSet0, VarSet),
+ Thens0, Thens, !VarSet),
conj_list_to_goal(Thens, GoalInfo, Then1),
% Calculate the svar_info with the highest numbered
% mappings from each arm.
%
DisjSInfos = [{Then1, SInfoT}, {Else0, SInfoE}],
- SInfo = reconciled_disj_svar_info(VarSet, DisjSInfos),
+ SInfo = reconciled_disj_svar_info(!.VarSet, DisjSInfos),
% Add unifiers to each arm to ensure they both construct
% the same final state variable mappings.
@@ -9444,29 +9290,27 @@
% to the then-goal because the new mapping was created in a
% negated context.
%
-:- pred add_then_arm_specific_unifiers(prog_context, svars,
- svar_info, svar_info, svar_info, svar_info,
- hlds_goals, hlds_goals, prog_varset, prog_varset).
-:- mode add_then_arm_specific_unifiers(in, in, in, in, in, out,
- in, out, in, out) is det.
+:- pred add_then_arm_specific_unifiers(prog_context::in, svars::in,
+ svar_info::in, svar_info::in, svar_info::in, svar_info::out,
+ hlds_goals::in, hlds_goals::out, prog_varset::in, prog_varset::out)
+ is det.
-add_then_arm_specific_unifiers(_, [],
- _, _, SInfoT, SInfoT,
+add_then_arm_specific_unifiers(_, [], _, _, SInfoT, SInfoT,
Thens, Thens, VarSet, VarSet).
add_then_arm_specific_unifiers(Context, [StateVar | StateVars],
SInfo0, SInfoC, !SInfoT, !Thens, !VarSet) :-
- ( if % the condition refers to !:X, but the then-goal doesn't
+ ( % the condition refers to !:X, but the then-goal doesn't
SInfoC ^ dot ^ elem(StateVar) \= SInfo0 ^ dot ^ elem(StateVar),
!.SInfoT ^ dot ^ elem(StateVar) = SInfoC ^ dot ^ elem(StateVar)
- then
+ ->
% add a new unifier !:X = !.X
Dot0 = !.SInfoT ^ dot ^ det_elem(StateVar),
new_colon_state_var(StateVar, Dot, !VarSet, !SInfoT),
!:Thens = [svar_unification(Context, Dot, Dot0) | !.Thens],
prepare_for_next_conjunct(set__make_singleton_set(StateVar),
!VarSet, !SInfoT)
- else
+ ;
true
),
add_then_arm_specific_unifiers(Context, StateVars,
@@ -9474,21 +9318,19 @@
%------------------------------------------------------------------------------%
-:- pred next_svar_mappings(int, svars, prog_varset, prog_varset, svar_map).
-:- mode next_svar_mappings(in, in, in, out, out) is det.
+:- pred next_svar_mappings(int::in, svars::in,
+ prog_varset::in, prog_varset::out, svar_map::out) is det.
next_svar_mappings(N, StateVars, VarSet0, VarSet, Map) :-
next_svar_mappings_2(N, StateVars, VarSet0, VarSet, map__init, Map).
-:- pred next_svar_mappings_2(int, svars, prog_varset, prog_varset,
- svar_map, svar_map).
-:- mode next_svar_mappings_2(in, in, in, out, in, out) is det.
-
-next_svar_mappings_2(_, [], VarSet, VarSet, Map, Map).
-
-next_svar_mappings_2(N, [StateVar | StateVars], VarSet0, VarSet, Map0, Map) :-
- next_svar_mapping(N, StateVar, _, VarSet0, VarSet1, Map0, Map1),
- next_svar_mappings_2(N, StateVars, VarSet1, VarSet, Map1, Map).
+:- pred next_svar_mappings_2(int::in, svars::in,
+ prog_varset::in, prog_varset::out, svar_map::in, svar_map::out) is det.
+
+next_svar_mappings_2(_, [], !VarSet, !Map).
+next_svar_mappings_2(N, [StateVar | StateVars], !VarSet, !Map) :-
+ next_svar_mapping(N, StateVar, _, !VarSet, !Map),
+ next_svar_mappings_2(N, StateVars, !VarSet, !Map).
%------------------------------------------------------------------------------%
@@ -9496,8 +9338,7 @@
% so we construct new mappings for the state variables and then
% add unifiers from their pre-negated goal mappings.
%
-:- pred finish_negation(svar_info, svar_info, svar_info).
-:- mode finish_negation(in, in, out) is det.
+:- pred finish_negation(svar_info::in, svar_info::in, svar_info::out) is det.
finish_negation(SInfoBefore, SInfoNeg, SInfo) :-
SInfo = (( SInfoBefore ^ num := SInfoNeg ^ num )
@@ -9508,9 +9349,8 @@
% We have to make sure that all arms of a disjunction produce the
% same state variable bindings by adding unifiers as necessary.
%
-:- pred finish_disjunction(prog_context, prog_varset, hlds_goal_svar_infos,
- hlds_goals, svar_info).
-:- mode finish_disjunction(in, in, in, out, out) is det.
+:- pred finish_disjunction(prog_context::in, prog_varset::in,
+ hlds_goal_svar_infos::in, hlds_goals::out, svar_info::out) is det.
finish_disjunction(Context, VarSet, DisjSInfos, Disjs, SInfo) :-
SInfo = reconciled_disj_svar_info(VarSet, DisjSInfos),
@@ -9590,14 +9430,14 @@
),
SInfo = ( SInfo2 ^ num := max(SInfo0 ^ num, SInfoX ^ num) ).
-:- func reconciled_svar_infos_dots(prog_varset, svar_info, svar, svar_info) =
- svar_info.
+:- func reconciled_svar_infos_dots(prog_varset, svar_info, svar, svar_info)
+ = svar_info.
reconciled_svar_infos_dots(VarSet, SInfoX, StateVar, SInfo0) = SInfo :-
- ( if
+ (
DotX = SInfoX ^ dot ^ elem(StateVar),
Dot0 = SInfo0 ^ dot ^ elem(StateVar)
- then
+ ->
NameX = varset__lookup_name(VarSet, DotX) `with_type` string,
Name0 = varset__lookup_name(VarSet, Dot0) `with_type` string,
compare_svar_names(RDot, NameX, Name0),
@@ -9611,18 +9451,18 @@
RDot = (>),
SInfo = ( SInfo0 ^ dot ^ elem(StateVar) := DotX )
)
- else
+ ;
SInfo = SInfo0
).
-:- func reconciled_svar_infos_colons(prog_varset, svar_info, svar, svar_info) =
- svar_info.
+:- func reconciled_svar_infos_colons(prog_varset, svar_info, svar, svar_info)
+ = svar_info.
reconciled_svar_infos_colons(VarSet, SInfoX, StateVar, SInfo0) = SInfo :-
- ( if
+ (
ColonX = SInfoX ^ colon ^ elem(StateVar),
Colon0 = SInfo0 ^ colon ^ elem(StateVar)
- then
+ ->
NameX = varset__lookup_name(VarSet, ColonX) `with_type` string,
Name0 = varset__lookup_name(VarSet, Colon0) `with_type` string,
compare_svar_names(RColon, NameX, Name0),
@@ -9636,32 +9476,31 @@
RColon = (>),
SInfo = ( SInfo0 ^ colon ^ elem(StateVar) := ColonX )
)
- else
+ ;
SInfo = SInfo0
).
-:- func add_disj_unifiers(prog_context, svar_info, svars,
- hlds_goal_svar_info) = hlds_goal.
+:- func add_disj_unifiers(prog_context, svar_info, svars, hlds_goal_svar_info)
+ = hlds_goal.
-add_disj_unifiers(Context, SInfo, StateVars, {GoalX, SInfoX}) =
- Goal :-
+add_disj_unifiers(Context, SInfo, StateVars, {GoalX, SInfoX}) = Goal :-
Unifiers = list__foldl(add_disj_unifier(Context, SInfo, SInfoX),
StateVars, []),
GoalX = _ - GoalInfo,
goal_to_conj_list(GoalX, GoalsX),
conj_list_to_goal(GoalsX ++ Unifiers, GoalInfo, Goal).
-:- func add_disj_unifier(prog_context, svar_info, svar_info, svar,
- hlds_goals) = hlds_goals.
+:- func add_disj_unifier(prog_context, svar_info, svar_info, svar, hlds_goals)
+ = hlds_goals.
add_disj_unifier(Context, SInfo, SInfoX, StateVar, Unifiers) =
- ( if
+ (
Dot = SInfo ^ dot ^ elem(StateVar),
DotX = SInfoX ^ dot ^ elem(StateVar),
Dot \= DotX
- then
+ ->
[svar_unification(Context, Dot, DotX) | Unifiers]
- else
+ ;
Unifiers
).
@@ -9676,8 +9515,8 @@
% state variable and N is a decimal number with no leading
% zeroes.
%
-:- pred compare_svar_names(comparison_result, string, string).
-:- mode compare_svar_names(out, in, in) is det.
+:- pred compare_svar_names(comparison_result::out, string::in, string::in)
+ is det.
compare_svar_names(R, A, B) :-
compare(R, int_suffix_of(A), int_suffix_of(B)).
@@ -9693,13 +9532,13 @@
:- func int_suffix_2(string, int, int, int) = int.
int_suffix_2(S, I, R, N) =
- ( if
+ (
0 =< I,
digit_to_int(S `unsafe_index` I, D),
D < 10
- then
+ ->
int_suffix_2(S, I - 1, 10 * R, (R * D) + N)
- else
+ ;
N
).
@@ -9708,8 +9547,8 @@
% We treat equivalence goals as if they were negations (they are
% in a negated context after all.)
%
-:- pred finish_equivalence(svar_info, svar_info, svar_info).
-:- mode finish_equivalence(in, in, out) is det.
+:- pred finish_equivalence(svar_info::in, svar_info::in, svar_info::out)
+ is det.
finish_equivalence(SInfoBefore, SInfoEqv, SInfo) :-
finish_negation(SInfoBefore, SInfoEqv, SInfo).
@@ -9720,14 +9559,14 @@
% already in an atom then we inherit the parent's set of "updated"
% state variables.
%
-:- pred prepare_for_call(svar_info, svar_info).
-:- mode prepare_for_call(in, out) is det.
+:- pred prepare_for_call(svar_info::in, svar_info::out) is det.
prepare_for_call(ParentSInfo, SInfo) :-
UpdatedStateVars =
- ( if ParentSInfo ^ ctxt = in_atom(UpdatedStateVars0, _)
- then UpdatedStateVars0
- else set__init
+ ( ParentSInfo ^ ctxt = in_atom(UpdatedStateVars0, _) ->
+ UpdatedStateVars0
+ ;
+ set__init
),
SInfo = ( ParentSInfo ^ ctxt := in_atom(UpdatedStateVars,ParentSInfo) ).
@@ -9870,17 +9709,17 @@
% may be none if, for example, the head only references !:X
% and there have been no prior references to !:X in the body.)
%
-:- pred next_dot_mapping(svar_set, svar_map, svar_map, svar, prog_var,
- svar_map, svar_map).
-:- mode next_dot_mapping(in, in, in, in, in, in, out) is det.
+:- pred next_dot_mapping(svar_set::in, svar_map::in, svar_map::in, svar::in,
+ prog_var::in, svar_map::in, svar_map::out) is det.
next_dot_mapping(UpdatedStateVars, OldDot, OldColon, StateVar, _, Dot0, Dot) :-
- ( if UpdatedStateVars `contains` StateVar
- then Var = OldColon ^ det_elem(StateVar),
+ ( UpdatedStateVars `contains` StateVar ->
+ Var = OldColon ^ det_elem(StateVar),
+ Dot = ( Dot0 ^ elem(StateVar) := Var )
+ ; Var = OldDot ^ elem(StateVar) ->
Dot = ( Dot0 ^ elem(StateVar) := Var )
- else if Var = OldDot ^ elem(StateVar)
- then Dot = ( Dot0 ^ elem(StateVar) := Var )
- else Dot = Dot0
+ ;
+ Dot = Dot0
).
% If the state variable has been updated (i.e. there was a !:X
@@ -9888,30 +9727,27 @@
% Otherwise, the next !:X mapping is the same as the current
% !:X mapping.
%
-:- pred next_colon_mapping(svar_set, svar_map, int, svar, prog_var,
- prog_varset, prog_varset, svar_map, svar_map).
-:- mode next_colon_mapping(in, in, in, in, in, in, out, in, out) is det.
+:- pred next_colon_mapping(svar_set::in, svar_map::in, int::in, svar::in,
+ prog_var::in, prog_varset::in, prog_varset::out,
+ svar_map::in, svar_map::out) is det.
next_colon_mapping(UpdatedStateVars, OldColon, N, StateVar, _,
- VarSet0, VarSet, Colon0, Colon) :-
- ( if UpdatedStateVars `contains` StateVar then
- next_svar_mapping(N, StateVar, _Var, VarSet0, VarSet,
- Colon0, Colon)
- else
- VarSet = VarSet0,
- Colon = ( Colon0 ^ elem(StateVar) :=
+ !VarSet, !Colon) :-
+ ( UpdatedStateVars `contains` StateVar ->
+ next_svar_mapping(N, StateVar, _Var, !VarSet, !Colon)
+ ;
+ !:Colon = ( !.Colon ^ elem(StateVar) :=
OldColon ^ det_elem(StateVar) )
).
-:- pred next_svar_mapping(int, svar, prog_var, prog_varset, prog_varset,
- svar_map, svar_map).
-:- mode next_svar_mapping(in, in, out, in, out, in, out) is det.
+:- pred next_svar_mapping(int::in, svar::in, prog_var::out,
+ prog_varset::in, prog_varset::out, svar_map::in, svar_map::out) is det.
-next_svar_mapping(N, StateVar, Var, VarSet0, VarSet, Map0, Map) :-
+next_svar_mapping(N, StateVar, Var, !VarSet, !Map) :-
Name = string__format("STATE_VARIABLE_%s_%d",
- [s(varset__lookup_name(VarSet0, StateVar)), i(N)]),
- varset__new_named_var(VarSet0, Name, Var, VarSet),
- Map = ( Map0 ^ elem(StateVar) := Var ).
+ [s(varset__lookup_name(!.VarSet, StateVar)), i(N)]),
+ varset__new_named_var(!.VarSet, Name, Var, !:VarSet),
+ !:Map = ( !.Map ^ elem(StateVar) := Var ).
%------------------------------------------------------------------------------%
@@ -9955,9 +9791,10 @@
Cs = list__map(expand_item_bsvs, Cs0),
% Note that the condition should always succeed...
%
- ( if Cs = [clause(_, _, _, Args, _) | _]
- then adjust_func_arity(PredOrFunc, Arity, list__length(Args))
- else Arity = Arity0
+ ( Cs = [clause(_, _, _, Args, _) | _] ->
+ adjust_func_arity(PredOrFunc, Arity, list__length(Args))
+ ;
+ Arity = Arity0
),
IM = instance_method(PredOrFunc, Method, clauses(Cs), Arity, Ctxt).
@@ -9966,10 +9803,11 @@
:- func expand_item_bsvs(item) = item.
expand_item_bsvs(Item) =
- ( if Item = clause(VarSet, PredOrFunc, SymName, Args, Body)
- then clause(VarSet, PredOrFunc, SymName,
+ ( Item = clause(VarSet, PredOrFunc, SymName, Args, Body) ->
+ clause(VarSet, PredOrFunc, SymName,
expand_bang_state_var_args(Args), Body)
- else Item
+ ;
+ Item
).
%------------------------------------------------------------------------------%
@@ -9979,19 +9817,17 @@
% already have been expanded into !.X, !:X via a call to
% expand_bang_state_var_args/1.
%
-:- pred substitute_state_var_mappings(list(prog_term), list(prog_term),
- prog_varset, prog_varset, svar_info, svar_info, io, io).
-:- mode substitute_state_var_mappings(in, out, in, out, in, out, di, uo) is det.
-
-substitute_state_var_mappings([], [],
- VarSet, VarSet, SInfo, SInfo) --> [].
+:- pred substitute_state_var_mappings(list(prog_term)::in,
+ list(prog_term)::out, prog_varset::in, prog_varset::out,
+ svar_info::in, svar_info::out, io::di, io::uo) is det.
+substitute_state_var_mappings([], [], !VarSet, !SInfo, !IO).
substitute_state_var_mappings([Arg0 | Args0], [Arg | Args],
- VarSet0, VarSet, SInfo0, SInfo) -->
+ !VarSet, !SInfo, !IO) :-
substitute_state_var_mapping(Arg0, Arg,
- VarSet0, VarSet1, SInfo0, SInfo1),
+ !VarSet, !SInfo, !IO),
substitute_state_var_mappings(Args0, Args,
- VarSet1, VarSet, SInfo1, SInfo ).
+ !VarSet, !SInfo, !IO).
:- pred substitute_state_var_mapping(prog_term::in, prog_term::out,
prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
@@ -10010,8 +9846,8 @@
%------------------------------------------------------------------------------%
-:- pred illegal_state_var_func_result(pred_or_func, list(prog_term), svar).
-:- mode illegal_state_var_func_result(in, in, out) is semidet.
+:- pred illegal_state_var_func_result(pred_or_func::in, list(prog_term)::in,
+ svar::out) is semidet.
illegal_state_var_func_result(function, Args, StateVar) :-
list__last(Args, functor(atom("!"), [variable(StateVar)], _Ctxt)).
@@ -10022,82 +9858,82 @@
% We might extend the syntax still further to accommodate
% this as an option, e.g. !IO::(di, uo).
%
-:- pred lambda_args_contain_bang_state_var(list(prog_term), prog_var).
-:- mode lambda_args_contain_bang_state_var(in, out) is semidet.
+:- pred lambda_args_contain_bang_state_var(list(prog_term)::in, prog_var::out)
+ is semidet.
lambda_args_contain_bang_state_var([Arg | Args], StateVar) :-
- ( if Arg = functor(atom("!"), [variable(StateVar0)], _)
- then StateVar = StateVar0
- else lambda_args_contain_bang_state_var(Args, StateVar)
+ ( Arg = functor(atom("!"), [variable(StateVar0)], _) ->
+ StateVar = StateVar0
+ ;
+ lambda_args_contain_bang_state_var(Args, StateVar)
).
%------------------------------------------------------------------------------%
-:- pred report_illegal_state_var_update(prog_context, prog_varset, svar,
- io, io).
-:- mode report_illegal_state_var_update(in, in, in, di, uo) is det.
+:- pred report_illegal_state_var_update(prog_context::in, prog_varset::in,
+ svar::in, io::di, io::uo) is det.
-report_illegal_state_var_update(Context, VarSet, StateVar) -->
- { Name = varset__lookup_name(VarSet, StateVar) },
- prog_out__write_context(Context),
+report_illegal_state_var_update(Context, VarSet, StateVar, !IO) :-
+ Name = varset__lookup_name(VarSet, StateVar),
+ prog_out__write_context(Context, !IO),
report_error(string__format("\
-cannot use !:%s in this context;", [s(Name)])),
- prog_out__write_context(Context),
+cannot use !:%s in this context;", [s(Name)]), !IO),
+ prog_out__write_context(Context, !IO),
io__format("\
- however !.%s may be used here.\n", [s(Name)]).
+ however !.%s may be used here.\n", [s(Name)], !IO).
%------------------------------------------------------------------------------%
-:- pred report_non_visible_state_var(string, prog_context, prog_varset, svar,
- io, io).
-:- mode report_non_visible_state_var(in, in, in, in, di, uo) is det.
+:- pred report_non_visible_state_var(string::in, prog_context::in,
+ prog_varset::in, svar::in, io::di, io::uo) is det.
-report_non_visible_state_var(DorC, Context, VarSet, StateVar) -->
- { Name = varset__lookup_name(VarSet, StateVar) },
- prog_out__write_context(Context),
+report_non_visible_state_var(DorC, Context, VarSet, StateVar, !IO) :-
+ Name = varset__lookup_name(VarSet, StateVar),
+ prog_out__write_context(Context, !IO),
report_error(string__format("\
-state variable !%s%s is not visible in this context.", [s(DorC), s(Name)])).
+state variable !%s%s is not visible in this context.",
+ [s(DorC), s(Name)]), !IO).
%------------------------------------------------------------------------------%
-:- pred report_unitialized_state_var(prog_context, prog_varset, svar, io, io).
-:- mode report_unitialized_state_var(in, in, in, di, uo) is det.
+:- pred report_unitialized_state_var(prog_context::in, prog_varset::in,
+ svar::in, io::di, io::uo) is det.
-report_unitialized_state_var(Context, VarSet, StateVar) -->
- { Name = varset__lookup_name(VarSet, StateVar) },
- prog_out__write_context(Context),
+report_unitialized_state_var(Context, VarSet, StateVar, !IO) :-
+ Name = varset__lookup_name(VarSet, StateVar),
+ prog_out__write_context(Context, !IO),
report_warning(string__format("\
-Warning: reference to unitialized state variable !.%s.\n", [s(Name)])).
+Warning: reference to unitialized state variable !.%s.\n",
+ [s(Name)]), !IO).
%------------------------------------------------------------------------------%
-:- pred report_illegal_func_svar_result(prog_context, prog_varset, svar,
- io, io).
-:- mode report_illegal_func_svar_result(in, in, in, di, uo) is det.
+:- pred report_illegal_func_svar_result(prog_context::in, prog_varset::in,
+ svar::in, io::di, io::uo) is det.
-report_illegal_func_svar_result(Context, VarSet, StateVar) -->
- { Name = varset__lookup_name(VarSet, StateVar) },
- prog_out__write_context(Context),
+report_illegal_func_svar_result(Context, VarSet, StateVar, !IO) :-
+ Name = varset__lookup_name(VarSet, StateVar),
+ prog_out__write_context(Context, !IO),
report_error(string__format("\
-!%s cannot be a function result.", [s(Name)])),
- prog_out__write_context(Context),
+!%s cannot be a function result.", [s(Name)]), !IO),
+ prog_out__write_context(Context, !IO),
io__format("\
- You probably meant !.%s or !:%s.\n", [s(Name), s(Name)]).
+ You probably meant !.%s or !:%s.\n", [s(Name), s(Name)],
+ !IO).
%------------------------------------------------------------------------------%
-:- pred report_illegal_bang_svar_lambda_arg(prog_context, prog_varset, svar,
- io, io).
-:- mode report_illegal_bang_svar_lambda_arg(in, in, in, di, uo) is det.
+:- pred report_illegal_bang_svar_lambda_arg(prog_context::in, prog_varset::in,
+ svar::in, io::di, io::uo) is det.
-report_illegal_bang_svar_lambda_arg(Context, VarSet, StateVar) -->
- { Name = varset__lookup_name(VarSet, StateVar) },
- prog_out__write_context(Context),
+report_illegal_bang_svar_lambda_arg(Context, VarSet, StateVar, !IO) :-
+ Name = varset__lookup_name(VarSet, StateVar),
+ prog_out__write_context(Context, !IO),
report_error(string__format("\
-!%s cannot be a lambda argument.", [s(Name)])),
- prog_out__write_context(Context),
+!%s cannot be a lambda argument.", [s(Name)]), !IO),
+ prog_out__write_context(Context, !IO),
io__format("\
- Perhaps you meant !.%s or !:%s.\n", [s(Name), s(Name)]).
+ Perhaps you meant !.%s or !:%s.\n", [s(Name), s(Name)], !IO).
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
Index: compiler/make_tags.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_tags.m,v
retrieving revision 1.41
diff -u -b -r1.41 make_tags.m
--- compiler/make_tags.m 24 Jun 2003 14:20:49 -0000 1.41
+++ compiler/make_tags.m 20 Dec 2003 08:34:33 -0000
@@ -134,8 +134,8 @@
ReserveTag, Globals,
SingleFunc, SingleArg, _)
->
- make_cons_id_from_qualified_sym_name(SingleFunc,
- [SingleArg], SingleConsId),
+ SingleConsId = make_cons_id_from_qualified_sym_name(
+ SingleFunc, [SingleArg]),
map__set(CtorTags0, SingleConsId, no_tag, CtorTags)
;
NumTagBits = 0
@@ -192,7 +192,7 @@
assign_enum_constants([], _, CtorTags, CtorTags).
assign_enum_constants([Ctor | Rest], Val, CtorTags0, CtorTags) :-
Ctor = ctor(_ExistQVars, _Constraints, Name, Args),
- make_cons_id_from_qualified_sym_name(Name, Args, ConsId),
+ ConsId = make_cons_id_from_qualified_sym_name(Name, Args),
Tag = int_constant(Val),
map__set(CtorTags0, ConsId, Tag, CtorTags1),
Val1 = Val + 1,
@@ -213,7 +213,7 @@
CtorTags = CtorTags0
;
Ctor = ctor(_ExistQVars, _Constraints, Name, Args),
- make_cons_id_from_qualified_sym_name(Name, Args, ConsId),
+ ConsId = make_cons_id_from_qualified_sym_name(Name, Args),
( Address = 0 ->
Tag = reserved_address(null_pointer)
;
@@ -241,7 +241,7 @@
Ctor = ctor(_ExistQVars, _Constraints, Name, Args),
Arity = list__length(Args),
Tag = reserved_address(reserved_object(TypeCtor, Name, Arity)),
- make_cons_id_from_qualified_sym_name(Name, Args, ConsId),
+ ConsId = make_cons_id_from_qualified_sym_name(Name, Args),
map__set(CtorTags0, ConsId, Tag, CtorTags1),
assign_reserved_symbolic_addresses(Ctors, LeftOverConstants,
TypeCtor, CtorTags1, CtorTags, Num + 1, Max)
@@ -279,7 +279,7 @@
assign_unshared_tags([Ctor | Rest], Val, MaxTag, ReservedAddresses,
CtorTags0, CtorTags) :-
Ctor = ctor(_ExistQVars, _Constraints, Name, Args),
- make_cons_id_from_qualified_sym_name(Name, Args, ConsId),
+ ConsId = make_cons_id_from_qualified_sym_name(Name, Args),
% If there's only one functor,
% give it the "single_functor" (untagged)
% representation, rather than giving it unshared_tag(0).
@@ -309,7 +309,7 @@
assign_shared_remote_tags([Ctor | Rest], PrimaryVal, SecondaryVal,
ReservedAddresses, CtorTags0, CtorTags) :-
Ctor = ctor(_ExistQVars, _Constraints, Name, Args),
- make_cons_id_from_qualified_sym_name(Name, Args, ConsId),
+ ConsId = make_cons_id_from_qualified_sym_name(Name, Args),
Tag = maybe_add_reserved_addresses(ReservedAddresses,
shared_remote_tag(PrimaryVal, SecondaryVal)),
map__set(CtorTags0, ConsId, Tag, CtorTags1),
@@ -325,7 +325,7 @@
assign_shared_local_tags([Ctor | Rest], PrimaryVal, SecondaryVal,
CtorTags0, CtorTags) :-
Ctor = ctor(_ExistQVars, _Constraints, Name, Args),
- make_cons_id_from_qualified_sym_name(Name, Args, ConsId),
+ ConsId = make_cons_id_from_qualified_sym_name(Name, Args),
Tag = shared_local_tag(PrimaryVal, SecondaryVal),
map__set(CtorTags0, ConsId, Tag, CtorTags1),
SecondaryVal1 = SecondaryVal + 1,
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.297
diff -u -b -r1.297 mercury_compile.m
--- compiler/mercury_compile.m 18 Dec 2003 01:54:48 -0000 1.297
+++ compiler/mercury_compile.m 18 Dec 2003 09:41:39 -0000
@@ -2554,7 +2554,7 @@
mercury_compile__puritycheck(FoundTypeError, HLDS0, Verbose, Stats,
HLDS, FoundPostTypecheckError) -->
{ module_info_num_errors(HLDS0, NumErrors0) },
- puritycheck(FoundTypeError, HLDS0, FoundPostTypecheckError, HLDS),
+ puritycheck(FoundTypeError, FoundPostTypecheckError, HLDS0, HLDS),
{ module_info_num_errors(HLDS, NumErrors) },
( { NumErrors \= NumErrors0 } ->
maybe_write_string(Verbose,
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.235
diff -u -b -r1.235 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 1 Dec 2003 15:55:42 -0000 1.235
+++ compiler/mercury_to_mercury.m 18 Dec 2003 09:44:44 -0000
@@ -2970,7 +2970,7 @@
mercury_format_pragma_foreign_code_2(Attributes, PredName, PredOrFunc, Vars0,
VarSet, PragmaCode) -->
add_string(":- pragma foreign_proc("),
- { foreign_language(Attributes, Lang) },
+ { Lang = foreign_language(Attributes) },
mercury_format_foreign_language_string(Lang),
add_string(", "),
mercury_format_sym_name(PredName),
@@ -3305,9 +3305,8 @@
mercury_format_pragma_foreign_attributes(Attributes) -->
% This is one case where it is a bad idea to use field
% accessors.
- { attributes_to_strings(Attributes, AttrStrings) },
add_string("["),
- add_list(AttrStrings, ", ", add_string),
+ add_list(attributes_to_strings(Attributes), ", ", add_string),
add_string("]").
%-----------------------------------------------------------------------------%
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.133
diff -u -b -r1.133 ml_code_gen.m
--- compiler/ml_code_gen.m 3 Dec 2003 16:12:09 -0000 1.133
+++ compiler/ml_code_gen.m 18 Dec 2003 09:20:17 -0000
@@ -2238,7 +2238,7 @@
LaterCode, LaterContext, SharedCode, SharedContext,
MLDS_Decls, MLDS_Statements) -->
- { foreign_language(Attributes, Lang) },
+ { Lang = foreign_language(Attributes) },
( { Lang = csharp } ->
{ sorry(this_file, "nondet pragma foreign_proc for C#") }
;
@@ -2286,7 +2286,7 @@
%
% Generate code fragments to obtain and release the global lock
%
- { thread_safe(Attributes, ThreadSafe) },
+ { ThreadSafe = thread_safe(Attributes) },
ml_gen_obtain_release_global_lock(ThreadSafe, PredId,
ObtainLock, ReleaseLock),
@@ -2389,7 +2389,7 @@
ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes,
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
Foreign_Code, Context, MLDS_Decls, MLDS_Statements) -->
- { foreign_language(Attributes, Lang) },
+ { Lang = foreign_language(Attributes) },
( { Lang = c },
ml_gen_ordinary_pragma_c_proc(CodeModel, Attributes,
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
@@ -2426,7 +2426,7 @@
_PredId, _ProcId, ArgVars, ArgDatas, OrigArgTypes,
JavaCode, Context, MLDS_Decls, MLDS_Statements) -->
- { foreign_language(Attributes, Lang) },
+ { Lang = foreign_language(Attributes) },
%
% Combine all the information about the each arg
%
@@ -2487,7 +2487,7 @@
{ ml_make_c_arg_list(ArgVars, ArgDatas, OrigArgTypes, ArgList) },
ml_gen_outline_args(ArgList, OutlineArgs),
- { foreign_language(Attributes, ForeignLang) },
+ { ForeignLang = foreign_language(Attributes) },
{ MLDSContext = mlds__make_context(Context) },
=(MLDSGenInfo),
{ ml_gen_info_get_value_output_vars(MLDSGenInfo, OutputVars) },
@@ -2782,7 +2782,7 @@
PredId, _ProcId, ArgVars, ArgDatas, OrigArgTypes,
C_Code, Context, MLDS_Decls, MLDS_Statements) -->
- { foreign_language(Attributes, Lang) },
+ { Lang = foreign_language(Attributes) },
%
% Combine all the information about the each arg
@@ -2809,7 +2809,7 @@
%
% Generate code fragments to obtain and release the global lock
%
- { thread_safe(Attributes, ThreadSafe) },
+ { ThreadSafe = thread_safe(Attributes) },
ml_gen_obtain_release_global_lock(ThreadSafe, PredId,
ObtainLock, ReleaseLock),
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.282
diff -u -b -r1.282 modules.m
--- compiler/modules.m 1 Dec 2003 15:55:43 -0000 1.282
+++ compiler/modules.m 18 Dec 2003 09:18:06 -0000
@@ -5246,8 +5246,18 @@
:- pred get_item_foreign_code(globals::in, item_and_context::in,
module_foreign_info::in, module_foreign_info::out) is det.
-get_item_foreign_code(Globals, Item, Info0, Info) :-
+get_item_foreign_code(Globals, Item, !Info) :-
( Item = pragma(Pragma) - Context ->
+ do_get_item_foreign_code(Globals, Pragma, Context, !Info)
+ ;
+ true
+ ).
+
+:- pred do_get_item_foreign_code(globals::in, pragma_type::in,
+ prog_context::in, module_foreign_info::in, module_foreign_info::out)
+ is det.
+
+do_get_item_foreign_code(Globals, Pragma, Context, Info0, Info) :-
globals__get_backend_foreign_languages(Globals, BackendLangs),
globals__get_target(Globals, Target),
@@ -5268,7 +5278,7 @@
;
Pragma = foreign_proc(Attrs, Name, _, _, _, _)
->
- foreign_language(Attrs, NewLang),
+ NewLang = foreign_language(Attrs),
( OldLang = Info0 ^ foreign_proc_languages ^ elem(Name) ->
% is it better than an existing one?
(
@@ -5327,9 +5337,6 @@
set__insert(Info0 ^ used_foreign_languages, c)
;
Info = Info0
- )
- ;
- Info = Info0
).
%-----------------------------------------------------------------------------%
Index: compiler/pd_cost.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_cost.m,v
retrieving revision 1.17
diff -u -b -r1.17 pd_cost.m
--- compiler/pd_cost.m 5 Nov 2003 03:17:42 -0000 1.17
+++ compiler/pd_cost.m 18 Dec 2003 09:40:33 -0000
@@ -95,7 +95,7 @@
pd_cost__goal(foreign_proc(Attributes, _, _, Args, _, _, _) - _,
Cost) :-
- ( may_call_mercury(Attributes, will_not_call_mercury) ->
+ ( may_call_mercury(Attributes) = will_not_call_mercury ->
Cost1 = 0
;
pd_cost__stack_flush(Cost1)
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.60
diff -u -b -r1.60 post_typecheck.m
--- compiler/post_typecheck.m 1 Dec 2003 15:55:46 -0000 1.60
+++ compiler/post_typecheck.m 20 Dec 2003 08:26:24 -0000
@@ -57,52 +57,45 @@
% should prevent further processing (e.g. polymorphism or
% mode analysis).
%
-:- pred post_typecheck__finish_preds(list(pred_id), bool,
- int, bool, module_info, module_info, io__state, io__state).
-:- mode post_typecheck__finish_preds(in, in, out, out,
- in, out, di, uo) is det.
+:- 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.
% As above, but don't check for `aditi__state's and return
% the list of procedures containing unbound inst variables
% instead of reporting the errors directly.
%
-:- pred post_typecheck__finish_pred_no_io(module_info, list(proc_id),
- pred_info, pred_info).
-:- mode post_typecheck__finish_pred_no_io(in, out, in, out) is det.
-
-:- pred post_typecheck__finish_imported_pred_no_io(module_info,
- list(proc_id), pred_info, pred_info).
-:- mode post_typecheck__finish_imported_pred_no_io(in, out, in, out) is det.
-
-:- pred post_typecheck__finish_ill_typed_pred(module_info, pred_id,
- pred_info, pred_info, io__state, io__state).
-:- mode post_typecheck__finish_ill_typed_pred(in, in, in, out, di, uo) is det.
+:- pred post_typecheck__finish_pred_no_io(module_info::in, list(proc_id)::out,
+ pred_info::in, pred_info::out) is det.
+
+:- pred post_typecheck__finish_imported_pred_no_io(module_info::in,
+ 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.
% 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, module_info, pred_id,
- module_info, io__state, io__state) is det.
-:- mode post_typecheck__finish_promise(in, in, in, out, di, uo) is det.
+:- 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.
% Handle any unresolved overloading for a predicate call.
%
-:- pred post_typecheck__resolve_pred_overloading(pred_id, list(prog_var),
- pred_info, module_info, sym_name, sym_name, pred_id).
-:- mode post_typecheck__resolve_pred_overloading(in, in, in, in, in,
- out, out) is det.
+:- pred post_typecheck__resolve_pred_overloading(list(prog_var)::in,
+ pred_info::in, module_info::in, sym_name::in, sym_name::out,
+ pred_id::in, pred_id::out) is det.
% Resolve overloading and fill in the argument modes
% of a call to an Aditi builtin.
% Check that a relation modified by one of the Aditi update
% goals is a base relation.
%
-:- pred post_typecheck__finish_aditi_builtin(module_info, pred_info,
- list(prog_var), term__context, aditi_builtin, aditi_builtin,
- simple_call_id, simple_call_id, list(mode),
- maybe(aditi_builtin_error)).
-:- mode post_typecheck__finish_aditi_builtin(in, in, in, in,
- in, out, in, out, out, out) is det.
+:- pred post_typecheck__finish_aditi_builtin(module_info::in, pred_info::in,
+ list(prog_var)::in, term__context::in,
+ aditi_builtin::in, aditi_builtin::out,
+ simple_call_id::in, simple_call_id::out, list(mode)::out,
+ maybe(aditi_builtin_error)::out) is det.
:- type aditi_builtin_error
---> aditi_update_of_derived_relation(prog_context,
@@ -114,12 +107,11 @@
% Work out whether a var-functor unification is actually a function
% call. If so, replace the unification goal with a call.
%
-:- pred post_typecheck__resolve_unify_functor(prog_var, cons_id,
- list(prog_var), unify_mode, unification, unify_context,
- hlds_goal_info, module_info, pred_info, pred_info,
- vartypes, vartypes, prog_varset, prog_varset, hlds_goal).
-:- mode post_typecheck__resolve_unify_functor(in, in, in, in, in, in,
- in, in, in, out, in, out, in, out, out) is det.
+:- pred post_typecheck__resolve_unify_functor(prog_var::in, cons_id::in,
+ list(prog_var)::in, unify_mode::in, unification::in, unify_context::in,
+ hlds_goal_info::in, module_info::in, pred_info::in, pred_info::out,
+ vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ hlds_goal::out) is det.
%-----------------------------------------------------------------------------%
@@ -149,14 +141,13 @@
%-----------------------------------------------------------------------------%
post_typecheck__finish_preds(PredIds, ReportTypeErrors, NumErrors,
- FoundTypeError, ModuleInfo0, ModuleInfo) -->
+ FoundTypeError, !ModuleInfo, !IO) :-
post_typecheck__finish_preds(PredIds, ReportTypeErrors,
- ModuleInfo0, ModuleInfo, 0, NumErrors, no, FoundTypeError).
+ !ModuleInfo, 0, NumErrors, no, FoundTypeError, !IO).
-:- pred post_typecheck__finish_preds(list(pred_id), bool,
- module_info, module_info, int, int, bool, bool, io__state, io__state).
-:- mode post_typecheck__finish_preds(in, in, in, out, in, out,
- in, out, di, uo) is det.
+:- 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.
post_typecheck__finish_preds([], _, !ModuleInfo, !NumErrors,
!PostTypecheckError, !IO).
@@ -176,9 +167,9 @@
% if we didn't get any type errors already; this avoids
% a lot of spurious diagnostics.
%
- post_typecheck__check_type_bindings(PredId, PredInfo0,
- !.ModuleInfo, ReportTypeErrors,
- PredInfo1, UnboundTypeErrsInThisPred, !IO),
+ post_typecheck__check_type_bindings(!.ModuleInfo, PredId,
+ PredInfo0, PredInfo1, ReportTypeErrors,
+ UnboundTypeErrsInThisPred, !IO),
%
% if there were any unsatisfied type class constraints,
@@ -235,13 +226,12 @@
% variables other than those that occur in the types of head
% variables, and that there are no unsatisfied type class constraints.
-:- pred post_typecheck__check_type_bindings(pred_id, pred_info, module_info,
- bool, pred_info, int, io__state, io__state).
-:- mode post_typecheck__check_type_bindings(in, in, in, in, out, out, di, uo)
- is det.
+:- 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.
-post_typecheck__check_type_bindings(PredId, PredInfo0, ModuleInfo, ReportErrs,
- PredInfo, NumErrors, IOState0, IOState) :-
+post_typecheck__check_type_bindings(ModuleInfo, PredId, PredInfo0, PredInfo,
+ ReportErrs, NumErrors, !IO) :-
(
ReportErrs = yes,
pred_info_get_unproven_body_constraints(PredInfo0,
@@ -251,11 +241,10 @@
list__sort_and_remove_dups(UnprovenConstraints0,
UnprovenConstraints),
report_unsatisfied_constraints(UnprovenConstraints,
- PredId, PredInfo0, ModuleInfo, IOState0, IOState1),
+ PredId, PredInfo0, ModuleInfo, !IO),
list__length(UnprovenConstraints, NumErrors)
;
- NumErrors = 0,
- IOState1 = IOState0
+ NumErrors = 0
),
pred_info_clauses_info(PredInfo0, ClausesInfo0),
@@ -264,20 +253,19 @@
clauses_info_vartypes(ClausesInfo0, VarTypesMap0),
map__to_assoc_list(VarTypesMap0, VarTypesList),
set__init(Set0),
- check_type_bindings_2(VarTypesList, HeadTypeParams,
- [], Errs, Set0, Set),
+ check_type_bindings_2(VarTypesList, HeadTypeParams, [], Errs,
+ Set0, Set),
( Errs = [] ->
- PredInfo = PredInfo0,
- IOState = IOState1
+ PredInfo = PredInfo0
;
( ReportErrs = yes ->
%
% report the warning
%
report_unresolved_type_warning(Errs, PredId, PredInfo0,
- ModuleInfo, VarSet, IOState1, IOState)
+ ModuleInfo, VarSet, !IO)
;
- IOState = IOState1
+ true
),
%
@@ -292,37 +280,31 @@
pred_info_set_constraint_proofs(Proofs, PredInfo1, PredInfo)
).
-:- pred check_type_bindings_2(assoc_list(prog_var, (type)), list(tvar),
- assoc_list(prog_var, (type)), assoc_list(prog_var, (type)),
- set(tvar), set(tvar)).
-:- mode check_type_bindings_2(in, in, in, out, in, out) is det.
-
-check_type_bindings_2([], _, Errs, Errs, Set, Set).
-check_type_bindings_2([Var - Type | VarTypes], HeadTypeParams,
- Errs0, Errs, Set0, Set) :-
+:- pred check_type_bindings_2(assoc_list(prog_var, (type))::in, list(tvar)::in,
+ assoc_list(prog_var, (type))::in, assoc_list(prog_var, (type))::out,
+ set(tvar)::in, set(tvar)::out) is det.
+
+check_type_bindings_2([], _, !Errs, !Set).
+check_type_bindings_2([Var - Type | VarTypes], HeadTypeParams, !Errs, !Set) :-
term__vars(Type, TVars),
set__list_to_set(TVars, TVarsSet0),
set__delete_list(TVarsSet0, HeadTypeParams, TVarsSet1),
( \+ set__empty(TVarsSet1) ->
- Errs1 = [Var - Type | Errs0],
- set__union(Set0, TVarsSet1, Set1)
+ !:Errs = [Var - Type | !.Errs],
+ set__union(!.Set, TVarsSet1, !:Set)
;
- Errs1 = Errs0,
- Set0 = Set1
+ true
),
- check_type_bindings_2(VarTypes, HeadTypeParams,
- Errs1, Errs, Set1, Set).
+ check_type_bindings_2(VarTypes, HeadTypeParams, !Errs, !Set).
%
% bind all the type variables in `UnboundTypeVarsSet' to the type `void' ...
%
-:- pred bind_type_vars_to_void(set(tvar),
- map(prog_var, type), map(prog_var, type),
- constraint_proof_map, constraint_proof_map).
-:- mode bind_type_vars_to_void(in, in, out, in, out) is det.
+:- pred bind_type_vars_to_void(set(tvar)::in,
+ map(prog_var, type)::in, map(prog_var, type)::out,
+ constraint_proof_map::in, constraint_proof_map::out) is det.
-bind_type_vars_to_void(UnboundTypeVarsSet,
- VarTypesMap0, VarTypesMap, Proofs0, Proofs) :-
+bind_type_vars_to_void(UnboundTypeVarsSet, !VarTypesMap, !Proofs) :-
%
% first create a pair of corresponding lists (UnboundTypeVars, Voids)
% that map the unbound type variables to void
@@ -335,28 +317,27 @@
% then create a *substitution* that maps the
% unbound type variables to void.
%
- map__from_corresponding_lists(UnboundTypeVars, Voids,
- VoidSubst),
+ map__from_corresponding_lists(UnboundTypeVars, Voids, VoidSubst),
%
% then apply the substitutions we just created to the variable types
% and constraint proofs
%
- map__keys(VarTypesMap0, Vars),
- map__values(VarTypesMap0, Types0),
+ map__keys(!.VarTypesMap, Vars),
+ map__values(!.VarTypesMap, Types0),
term__substitute_corresponding_list(UnboundTypeVars, Voids,
Types0, Types),
- map__from_corresponding_lists(Vars, Types, VarTypesMap),
+ map__from_corresponding_lists(Vars, Types, !:VarTypesMap),
- apply_subst_to_constraint_proofs(VoidSubst, Proofs0, Proofs).
+ apply_subst_to_constraint_proofs(VoidSubst, !Proofs).
%-----------------------------------------------------------------------------%
%
% report an error: unsatisfied type class constraints
%
-:- pred report_unsatisfied_constraints(list(class_constraint),
- pred_id, pred_info, module_info, io__state, io__state).
-:- mode report_unsatisfied_constraints(in, in, in, in, di, uo) is det.
+:- 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.
report_unsatisfied_constraints(Constraints, PredId, PredInfo, ModuleInfo) -->
io__set_exit_status(1),
@@ -383,9 +364,9 @@
%
% report a warning: uninstantiated type parameter
%
-:- pred report_unresolved_type_warning(assoc_list(prog_var, (type)), pred_id,
- pred_info, module_info, prog_varset, io__state, io__state).
-:- mode report_unresolved_type_warning(in, in, in, in, in, di, uo) is det.
+:- pred report_unresolved_type_warning(assoc_list(prog_var, (type))::in,
+ pred_id::in, pred_info::in, module_info::in, prog_varset::in,
+ io::di, io::uo) is det.
report_unresolved_type_warning(Errs, PredId, PredInfo, ModuleInfo, VarSet) -->
globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn),
@@ -431,9 +412,8 @@
[]
).
-:- pred write_type_var_list(assoc_list(prog_var, (type)), prog_context,
- prog_varset, tvarset, io__state, io__state).
-:- mode write_type_var_list(in, in, in, in, di, uo) is det.
+:- pred write_type_var_list(assoc_list(prog_var, (type))::in, prog_context::in,
+ prog_varset::in, tvarset::in, io::di, io::uo) is det.
write_type_var_list([], _, _, _) --> [].
write_type_var_list([Var - Type | Rest], Context, VarSet, TVarSet) -->
@@ -451,8 +431,8 @@
% In the case of a call to an overloaded predicate, typecheck.m
% does not figure out the correct pred_id. We must do that here.
-post_typecheck__resolve_pred_overloading(PredId0, Args0, CallerPredInfo,
- ModuleInfo, PredName0, PredName, PredId) :-
+post_typecheck__resolve_pred_overloading(Args0, CallerPredInfo,
+ ModuleInfo, PredName0, PredName, PredId0, PredId) :-
( PredId0 = invalid_pred_id ->
%
% Find the set of candidate pred_ids for predicates which
@@ -467,13 +447,13 @@
ArgTypes, TVarSet, PredName0, PredName, PredId)
;
PredId = PredId0,
- get_qualified_pred_name(ModuleInfo, PredId, PredName)
+ PredName = get_qualified_pred_name(ModuleInfo, PredId)
).
-:- pred get_qualified_pred_name(module_info, pred_id, sym_name).
-:- mode get_qualified_pred_name(in, in, out) is det.
+:- func get_qualified_pred_name(module_info, pred_id) = sym_name.
-get_qualified_pred_name(ModuleInfo, PredId, qualified(PredModule, PredName)) :-
+get_qualified_pred_name(ModuleInfo, PredId)
+ = qualified(PredModule, PredName) :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
PredModule = pred_info_module(PredInfo),
PredName = pred_info_name(PredInfo).
@@ -489,8 +469,8 @@
% The tuple to insert has the same argument types as
% the relation being inserted into.
- post_typecheck__resolve_pred_overloading(PredId0, OtherArgs,
- CallerPredInfo, ModuleInfo, SymName0, SymName, PredId),
+ post_typecheck__resolve_pred_overloading(OtherArgs, CallerPredInfo,
+ ModuleInfo, SymName0, SymName, PredId0, PredId),
Builtin = aditi_tuple_update(Update, PredId),
InsertCallId = PredOrFunc - SymName/Arity,
@@ -555,11 +535,9 @@
ClosureArgModes, ClosureDetism))),
Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode].
-:- pred post_typecheck__bulk_update_closure_info(
- aditi_bulk_update, pred_or_func, list(type),
- pred_or_func, list(mode), determinism).
-:- mode post_typecheck__bulk_update_closure_info(in, in, in,
- out, out, out) is det.
+:- pred post_typecheck__bulk_update_closure_info(aditi_bulk_update::in,
+ pred_or_func::in, list(type)::in, pred_or_func::out, list(mode)::out,
+ determinism::out) is det.
post_typecheck__bulk_update_closure_info(bulk_insert, PredOrFunc,
ArgTypes, PredOrFunc, ClosureArgModes, nondet) :-
@@ -593,11 +571,10 @@
% Use the type of the closure passed to an `aditi_delete',
% `aditi_bulk_insert', `aditi_bulk_delete' or `aditi_modify'
% call to work out which predicate is being updated.
-:- pred resolve_aditi_builtin_overloading(module_info, pred_info,
- list(prog_var), pred(list(type), list(type)),
- pred_id, pred_id, sym_name, sym_name).
-:- mode resolve_aditi_builtin_overloading(in, in, in, pred(in, out) is det,
- in, out, in, out) is det.
+:- pred resolve_aditi_builtin_overloading(module_info::in, pred_info::in,
+ list(prog_var)::in,
+ pred(list(type), list(type))::in(pred(in, out) is det),
+ pred_id::in, pred_id::out, sym_name::in, sym_name::out) is det.
resolve_aditi_builtin_overloading(ModuleInfo, CallerPredInfo, Args,
AdjustArgTypes, PredId0, PredId, SymName0, SymName) :-
@@ -625,15 +602,15 @@
)
;
PredId = PredId0,
- get_qualified_pred_name(ModuleInfo, PredId, SymName)
+ SymName = get_qualified_pred_name(ModuleInfo, PredId)
).
% Work out the modes of the arguments of a closure passed
% to an Aditi update.
% The `Mode' passed is the mode of all arguments apart
% from the `aditi__state'.
-:- pred aditi_builtin_modes((mode), (mode), list(type), list(mode)).
-:- mode aditi_builtin_modes(in, in, in, out) is det.
+:- pred aditi_builtin_modes((mode)::in, (mode)::in, list(type)::in,
+ list(mode)::out) is det.
aditi_builtin_modes(_, _, [], []).
aditi_builtin_modes(Mode, AditiStateMode, [ArgType | ArgTypes],
@@ -647,9 +624,8 @@
% Report an error if a predicate modified by an Aditi builtin
% is not a base relation.
-:- pred check_base_relation(prog_context, pred_info, aditi_builtin,
- simple_call_id, maybe(aditi_builtin_error)).
-:- mode check_base_relation(in, in, in, in, out) is det.
+:- pred check_base_relation(prog_context::in, pred_info::in, aditi_builtin::in,
+ simple_call_id::in, maybe(aditi_builtin_error)::out) is det.
check_base_relation(Context, PredInfo, Builtin, CallId, MaybeError) :-
( hlds_pred__pred_info_is_base_relation(PredInfo) ->
@@ -684,42 +660,39 @@
% so that any calls to that pred from correctly-typed predicates
% won't result in spurious mode errors.
%
-post_typecheck__finish_ill_typed_pred(ModuleInfo, PredId,
- PredInfo0, PredInfo) -->
- { post_typecheck__propagate_types_into_modes(ModuleInfo,
- ErrorProcs, PredInfo0, PredInfo1) },
- report_unbound_inst_vars(ModuleInfo, PredId,
- ErrorProcs, PredInfo1, PredInfo2),
- check_for_indistinguishable_modes(ModuleInfo, PredId,
- PredInfo2, PredInfo).
+post_typecheck__finish_ill_typed_pred(ModuleInfo, PredId, !PredInfo, !IO) :-
+ post_typecheck__propagate_types_into_modes(ModuleInfo, ErrorProcs,
+ !PredInfo),
+ report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo,
+ !IO),
+ check_for_indistinguishable_modes(ModuleInfo, PredId, !PredInfo, !IO).
%
% For imported preds, we just need to ensure that all
% constructors occurring in predicate mode declarations are
% module qualified.
%
-:- pred post_typecheck__finish_imported_pred(module_info, pred_id,
- pred_info, pred_info, io__state, io__state).
-:- mode post_typecheck__finish_imported_pred(in, in, in, out, di, uo) is det.
-
-post_typecheck__finish_imported_pred(ModuleInfo, PredId,
- PredInfo0, PredInfo) -->
- { pred_info_get_markers(PredInfo0, Markers) },
- (
- { check_marker(Markers, base_relation) },
- { ModuleName = pred_info_module(PredInfo0) },
- { module_info_name(ModuleInfo, ModuleName) }
+:- pred post_typecheck__finish_imported_pred(module_info::in, pred_id::in,
+ pred_info::in, pred_info::out, io::di, io::uo) is det.
+
+post_typecheck__finish_imported_pred(ModuleInfo, PredId, !PredInfo, !IO) :-
+ pred_info_get_markers(!.PredInfo, Markers),
+ (
+ check_marker(Markers, base_relation),
+ ModuleName = pred_info_module(!.PredInfo),
+ module_info_name(ModuleInfo, ModuleName)
->
- check_aditi_state(ModuleInfo, PredInfo0)
+ check_aditi_state(ModuleInfo, !.PredInfo, !IO)
;
- []
+ true
),
- { post_typecheck__finish_imported_pred_no_io(ModuleInfo, ErrorProcs,
- PredInfo0, PredInfo1) },
- report_unbound_inst_vars(ModuleInfo, PredId,
- ErrorProcs, PredInfo1, PredInfo2),
- check_for_indistinguishable_modes(ModuleInfo, PredId,
- PredInfo2, PredInfo).
+ % XXX maybe the rest should be replaced with a call to
+ % post_typecheck__finish_ill_typed_pred? [zs]
+ post_typecheck__finish_imported_pred_no_io(ModuleInfo, ErrorProcs,
+ !PredInfo),
+ report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo,
+ !IO),
+ check_for_indistinguishable_modes(ModuleInfo, PredId, !PredInfo, !IO).
post_typecheck__finish_imported_pred_no_io(ModuleInfo, Errors, !PredInfo) :-
% Make sure the var-types field in the clauses_info is
@@ -753,42 +726,39 @@
% record in the promise ex table the predicates used by the
% declaration.
%
-post_typecheck__finish_promise(PromiseType, Module0, PromiseId, Module) -->
+post_typecheck__finish_promise(PromiseType, PromiseId, !Module, !IO) :-
% Store the declaration in the appropriate table and get
% the goal for the promise
- { store_promise(PromiseType, Module0, PromiseId, Module1, Goal) },
+ store_promise(PromiseType, PromiseId, !Module, Goal),
% Remove from further processing.
- { module_info_remove_predid(PromiseId, Module1, Module2) },
+ module_info_remove_predid(PromiseId, !Module),
% If the promise is in the interface, then ensure that
% it doesn't refer to any local symbols.
- { module_info_pred_info(Module2, PromiseId, PredInfo) },
- ( { pred_info_is_exported(PredInfo) } ->
- assertion__in_interface_check(Goal, PredInfo,
- Module2, Module)
+ module_info_pred_info(!.Module, PromiseId, PredInfo),
+ ( pred_info_is_exported(PredInfo) ->
+ assertion__in_interface_check(Goal, PredInfo, !Module, !IO)
;
- { Module2 = Module }
+ true
).
% store promise declaration, normalise goal and return new
% module_info and the goal for further processing
-:- pred store_promise(promise_type, module_info, pred_id, module_info,
- hlds_goal).
-:- mode store_promise(in, in, in, out, out) is det.
-store_promise(PromiseType, Module0, PromiseId, Module, Goal) :-
+:- pred store_promise(promise_type::in, pred_id::in,
+ module_info::in, module_info::out, hlds_goal::out) is det.
+
+store_promise(PromiseType, PromiseId, !Module, Goal) :-
(
% case for assertions
PromiseType = true
->
- module_info_assertion_table(Module0, AssertTable0),
- assertion_table_add_assertion(PromiseId, AssertTable0,
- AssertionId, AssertTable),
- module_info_set_assertion_table(AssertTable,
- Module0, Module1),
- assertion__goal(AssertionId, Module1, Goal),
- assertion__record_preds_used_in(Goal, AssertionId, Module1,
- Module)
+ module_info_assertion_table(!.Module, AssertTable0),
+ assertion_table_add_assertion(PromiseId, AssertionId,
+ AssertTable0, AssertTable),
+ module_info_set_assertion_table(AssertTable, !Module),
+ assertion__goal(AssertionId, !.Module, Goal),
+ assertion__record_preds_used_in(Goal, AssertionId, !Module)
;
% case for exclusivity
(
@@ -797,22 +767,21 @@
PromiseType = exclusive_exhaustive
)
->
- promise_ex_goal(PromiseId, Module0, Goal),
+ promise_ex_goal(PromiseId, !.Module, Goal),
predids_from_goal(Goal, PredIds),
- module_info_exclusive_table(Module0, Table0),
- list__foldl(exclusive_table_add(PromiseId), PredIds, Table0,
- Table),
- module_info_set_exclusive_table(Table, Module0, Module)
+ module_info_exclusive_table(!.Module, Table0),
+ list__foldl(exclusive_table_add(PromiseId), PredIds,
+ Table0, Table),
+ module_info_set_exclusive_table(Table, !Module)
;
% case for exhaustiveness -- XXX not yet implemented
- promise_ex_goal(PromiseId, Module0, Goal),
- Module0 = Module
+ promise_ex_goal(PromiseId, !.Module, Goal)
).
% get the goal from a promise_ex declaration
-:- pred promise_ex_goal(pred_id, module_info, hlds_goal).
-:- mode promise_ex_goal(in, in, out) is det.
+:- pred promise_ex_goal(pred_id::in, module_info::in, hlds_goal::out) is det.
+
promise_ex_goal(ExclusiveDecl, Module, Goal) :-
module_info_pred_info(Module, ExclusiveDecl, PredInfo),
pred_info_clauses_info(PredInfo, ClausesInfo),
@@ -825,42 +794,40 @@
error("promise_ex__goal: not an promise")
).
-
%-----------------------------------------------------------------------------%
-:- pred check_type_of_main(pred_info, io__state, io__state).
-:- mode check_type_of_main(in, di, uo) is det.
+:- pred check_type_of_main(pred_info::in, io::di, io::uo) is det.
-check_type_of_main(PredInfo) -->
+check_type_of_main(PredInfo, !IO) :-
(
%
% Check if this predicate is the
% program entry point main/2.
%
- { pred_info_name(PredInfo) = "main" },
- { pred_info_arity(PredInfo) = 2 },
- { pred_info_is_exported(PredInfo) }
+ pred_info_name(PredInfo) = "main",
+ pred_info_arity(PredInfo) = 2,
+ pred_info_is_exported(PredInfo)
->
%
% Check that the arguments of main/2
% have type `io__state'.
%
- { pred_info_arg_types(PredInfo, ArgTypes) },
+ pred_info_arg_types(PredInfo, ArgTypes),
(
- { ArgTypes = [Arg1, Arg2] },
- { type_is_io_state(Arg1) },
- { type_is_io_state(Arg2) }
+ ArgTypes = [Arg1, Arg2],
+ type_is_io_state(Arg1),
+ type_is_io_state(Arg2)
->
- []
+ true
;
- { pred_info_context(PredInfo, Context) },
+ pred_info_context(PredInfo, Context),
error_util__write_error_pieces(Context, 0,
[words("Error: arguments of main/2"),
- words("must have type `io__state'.")]),
- io__set_exit_status(1)
+ words("must have type `io__state'.")], !IO),
+ io__set_exit_status(1, !IO)
)
;
- []
+ true
).
%-----------------------------------------------------------------------------%
@@ -869,10 +836,8 @@
% Ensure that all constructors occurring in predicate mode
% declarations are module qualified.
%
-:- pred post_typecheck__propagate_types_into_modes(module_info,
- list(proc_id), pred_info, pred_info).
-:- mode post_typecheck__propagate_types_into_modes(in, out, in, out)
- is det.
+:- pred post_typecheck__propagate_types_into_modes(module_info::in,
+ list(proc_id)::out, pred_info::in, pred_info::out) is det.
post_typecheck__propagate_types_into_modes(ModuleInfo, ErrorProcs,
!PredInfo) :-
@@ -885,14 +850,15 @@
%-----------------------------------------------------------------------------%
-:- pred propagate_types_into_proc_modes(module_info, list(proc_id),
- list(type), list(proc_id), list(proc_id), proc_table, proc_table).
-:- mode propagate_types_into_proc_modes(in, in, in, in, out, in, out) is det.
+:- pred propagate_types_into_proc_modes(module_info::in, list(proc_id)::in,
+ list(type)::in, list(proc_id)::in, list(proc_id)::out,
+ proc_table::in, proc_table::out) is det.
+
propagate_types_into_proc_modes(_, [], _,
- ErrorProcs, list__reverse(ErrorProcs), Procs, Procs).
-propagate_types_into_proc_modes(ModuleInfo, [ProcId | ProcIds],
- ArgTypes, ErrorProcs0, ErrorProcs, Procs0, Procs) :-
- map__lookup(Procs0, ProcId, ProcInfo0),
+ ErrorProcs, list__reverse(ErrorProcs), !Procs).
+propagate_types_into_proc_modes(ModuleInfo, [ProcId | ProcIds], ArgTypes,
+ !ErrorProcs, !Procs) :-
+ map__lookup(!.Procs, ProcId, ProcInfo0),
proc_info_argmodes(ProcInfo0, ArgModes0),
propagate_types_into_mode_list(ArgTypes, ModuleInfo,
ArgModes0, ArgModes),
@@ -904,19 +870,17 @@
% needs to be done before mode analysis, to avoid internal errors)
%
( mode_list_contains_inst_var(ArgModes, ModuleInfo, _InstVar) ->
- ErrorProcs1 = [ProcId | ErrorProcs0],
- Procs1 = Procs0
+ !:ErrorProcs = [ProcId | !.ErrorProcs]
;
- ErrorProcs1 = ErrorProcs0,
proc_info_set_argmodes(ArgModes, ProcInfo0, ProcInfo),
- map__det_update(Procs0, ProcId, ProcInfo, Procs1)
+ map__det_update(!.Procs, ProcId, ProcInfo, !:Procs)
),
- propagate_types_into_proc_modes(ModuleInfo, ProcIds,
- ArgTypes, ErrorProcs1, ErrorProcs, Procs1, Procs).
+ propagate_types_into_proc_modes(ModuleInfo, ProcIds, ArgTypes,
+ !ErrorProcs, !Procs).
-:- pred report_unbound_inst_vars(module_info, pred_id, list(proc_id),
- pred_info, pred_info, io__state, io__state).
-:- mode report_unbound_inst_vars(in, in, in, in, out, di, uo) is det.
+:- pred report_unbound_inst_vars(module_info::in, pred_id::in,
+ list(proc_id)::in, pred_info::in, pred_info::out,
+ io::di, io::uo) is det.
report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo, !IO) :-
( ErrorProcs = [] ->
@@ -939,9 +903,8 @@
% delete this mode, to avoid internal errors
map__det_remove(Procs0, ProcId, _, Procs).
-:- pred unbound_inst_var_error(pred_id, proc_info, module_info,
- io__state, io__state).
-:- mode unbound_inst_var_error(in, in, in, di, uo) is det.
+:- pred unbound_inst_var_error(pred_id::in, proc_info::in, module_info::in,
+ io::di, io::uo) is det.
unbound_inst_var_error(PredId, ProcInfo, ModuleInfo) -->
{ proc_info_context(ProcInfo, Context) },
@@ -957,9 +920,8 @@
%-----------------------------------------------------------------------------%
-:- pred check_for_indistinguishable_modes(module_info, pred_id,
- pred_info, pred_info, io__state, io__state).
-:- mode check_for_indistinguishable_modes(in, in, in, out, di, uo) is det.
+:- pred check_for_indistinguishable_modes(module_info::in, pred_id::in,
+ pred_info::in, pred_info::out, io::di, io::uo) is det.
check_for_indistinguishable_modes(ModuleInfo, PredId, !PredInfo, !IO) :-
(
@@ -983,104 +945,101 @@
ProcIds, [], !PredInfo, !IO)
).
-:- pred check_for_indistinguishable_modes(module_info, pred_id, list(proc_id),
- list(proc_id), pred_info, pred_info, io__state, io__state).
-:- mode check_for_indistinguishable_modes(in, in, in,
- in, in, out, di, uo) is det.
+:- pred check_for_indistinguishable_modes(module_info::in, pred_id::in,
+ list(proc_id)::in, list(proc_id)::in, pred_info::in, pred_info::out,
+ io::di, io::uo) is det.
-check_for_indistinguishable_modes(_, _, [], _, PredInfo, PredInfo) --> [].
+check_for_indistinguishable_modes(_, _, [], _, !PredInfo, !IO).
check_for_indistinguishable_modes(ModuleInfo, PredId, [ProcId | ProcIds],
- PrevProcIds, PredInfo0, PredInfo) -->
+ PrevProcIds, !PredInfo, !IO) :-
check_for_indistinguishable_mode(ModuleInfo, PredId, ProcId,
- PrevProcIds, Removed, PredInfo0, PredInfo1),
- { PrevProcIds1 =
+ PrevProcIds, Removed, !PredInfo, !IO),
+ PrevProcIds1 =
( if Removed = yes then PrevProcIds
else [ProcId | PrevProcIds]
- ) },
+ ),
check_for_indistinguishable_modes(ModuleInfo, PredId, ProcIds,
- PrevProcIds1, PredInfo1, PredInfo).
+ PrevProcIds1, !PredInfo, !IO).
-:- pred check_for_indistinguishable_mode(module_info, pred_id, proc_id,
- list(proc_id), bool, pred_info, pred_info, io__state, io__state).
-:- mode check_for_indistinguishable_mode(in, in, in,
- in, out, in, out, di, uo) is det.
+:- pred check_for_indistinguishable_mode(module_info::in, pred_id::in,
+ proc_id::in, list(proc_id)::in, bool::out,
+ pred_info::in, pred_info::out, io::di, io::uo) is det.
-check_for_indistinguishable_mode(_, _, _, [], no, !PredInfo) --> [].
+check_for_indistinguishable_mode(_, _, _, [], no, !PredInfo, !IO).
check_for_indistinguishable_mode(ModuleInfo, PredId, ProcId1,
- [ProcId | ProcIds], Removed, !PredInfo) -->
+ [ProcId | ProcIds], Removed, !PredInfo, !IO) :-
(
- { modes_are_indistinguishable(ProcId, ProcId1,
- !.PredInfo, ModuleInfo) }
+ modes_are_indistinguishable(ProcId, ProcId1,
+ !.PredInfo, ModuleInfo)
->
- { pred_info_import_status(!.PredInfo, Status) },
+ pred_info_import_status(!.PredInfo, Status),
globals__io_lookup_bool_option(intermodule_optimization,
- Intermod),
+ Intermod, !IO),
globals__io_lookup_bool_option(make_optimization_interface,
- MakeOptInt),
+ MakeOptInt, !IO),
(
% With `--intermodule-optimization' we can read
% the declarations for a predicate from the `.int'
% and `.int0' files, so ignore the error in that case.
- {
+ (
status_defined_in_this_module(Status, yes)
;
Intermod = no
;
MakeOptInt = yes
- }
+ )
->
report_indistinguishable_modes_error(ProcId1,
- ProcId, PredId, !.PredInfo, ModuleInfo)
+ ProcId, PredId, !.PredInfo, ModuleInfo, !IO)
;
- []
+ true
),
- { pred_info_remove_procid(ProcId1, !PredInfo) },
- { Removed = yes }
+ pred_info_remove_procid(ProcId1, !PredInfo),
+ Removed = yes
;
check_for_indistinguishable_mode(ModuleInfo, PredId, ProcId1,
- ProcIds, Removed, !PredInfo)
+ ProcIds, Removed, !PredInfo, !IO)
).
%-----------------------------------------------------------------------------%
-:- pred check_aditi_state(module_info, pred_info, io__state, io__state).
-:- mode check_aditi_state(in, in, di, uo) is det.
+:- pred check_aditi_state(module_info::in, pred_info::in,
+ io::di, io::uo) is det.
-check_aditi_state(ModuleInfo, PredInfo) -->
- { pred_info_arg_types(PredInfo, ArgTypes) },
- { list__filter(type_is_aditi_state, ArgTypes, AditiStateTypes) },
- ( { AditiStateTypes = [] } ->
- report_no_aditi_state(PredInfo)
+check_aditi_state(ModuleInfo, PredInfo, !IO) :-
+ pred_info_arg_types(PredInfo, ArgTypes),
+ list__filter(type_is_aditi_state, ArgTypes, AditiStateTypes),
+ ( AditiStateTypes = [] ->
+ report_no_aditi_state(PredInfo, !IO)
;
- { ProcIds = pred_info_procids(PredInfo) },
+ ProcIds = pred_info_procids(PredInfo),
list__foldl(
check_aditi_state_modes(ModuleInfo,
PredInfo, ArgTypes),
- ProcIds)
+ ProcIds, !IO)
).
% If the procedure has declared modes, check that there
% is an input `aditi__state' argument.
-:- pred check_aditi_state_modes(module_info, pred_info, list(type),
- proc_id, io__state, io__state).
-:- mode check_aditi_state_modes(in, in, in, in, di, uo) is det.
-
-check_aditi_state_modes(ModuleInfo, PredInfo, ArgTypes, ProcId) -->
- { pred_info_procedures(PredInfo, Procs) },
- { map__lookup(Procs, ProcId, ProcInfo) },
- { proc_info_maybe_declared_argmodes(ProcInfo, MaybeArgModes) },
- (
- { MaybeArgModes = yes(ArgModes) },
- { AditiUi = aditi_mui_mode },
- { mode_get_insts(ModuleInfo, AditiUi, AditiUiInitialInst, _) },
+:- pred check_aditi_state_modes(module_info::in, pred_info::in, list(type)::in,
+ proc_id::in, io::di, io::uo) is det.
+
+check_aditi_state_modes(ModuleInfo, PredInfo, ArgTypes, ProcId, !IO) :-
+ pred_info_procedures(PredInfo, Procs),
+ map__lookup(Procs, ProcId, ProcInfo),
+ proc_info_maybe_declared_argmodes(ProcInfo, MaybeArgModes),
+ (
+ MaybeArgModes = yes(ArgModes),
+ AditiUi = aditi_mui_mode,
+ mode_get_insts(ModuleInfo, AditiUi, AditiUiInitialInst, _),
(
- { check_aditi_state_modes_2(ModuleInfo, ArgTypes,
- ArgModes, AditiUiInitialInst) }
+ check_aditi_state_modes_2(ModuleInfo, ArgTypes,
+ ArgModes, AditiUiInitialInst)
->
- []
+ true
;
- { proc_info_context(ProcInfo, Context) },
- report_no_input_aditi_state(PredInfo, Context)
+ proc_info_context(ProcInfo, Context),
+ report_no_input_aditi_state(PredInfo, Context, !IO)
)
;
% XXX Handling procedures for which modes are inferred
@@ -1089,11 +1048,11 @@
% of `unused' for the `aditi__state' argument may be inferred.
% In the worst case, a runtime error will be reported
% if the predicate is called outside of a transaction.
- { MaybeArgModes = no }
+ MaybeArgModes = no
).
-:- pred check_aditi_state_modes_2(module_info, list(type), list(mode), (inst)).
-:- mode check_aditi_state_modes_2(in, in, in, in) is semidet.
+:- pred check_aditi_state_modes_2(module_info::in, list(type)::in,
+ list(mode)::in, (inst)::in) is semidet.
check_aditi_state_modes_2(ModuleInfo, [Type | Types], [Mode | Modes],
InitialAditiStateInst) :-
@@ -1108,32 +1067,29 @@
InitialAditiStateInst)
).
-:- pred report_no_aditi_state(pred_info, io__state, io__state).
-:- mode report_no_aditi_state(in, di, uo) is det.
-
-report_no_aditi_state(PredInfo) -->
- io__set_exit_status(1),
- { pred_info_context(PredInfo, Context) },
- { report_aditi_pragma(PredInfo, PredErrorPieces) },
- { list__append(PredErrorPieces,
- [words("without an `aditi__state' argument.")], ErrorPieces) },
- error_util__write_error_pieces(Context, 0, ErrorPieces).
-
-:- pred report_no_input_aditi_state(pred_info, prog_context,
- io__state, io__state).
-:- mode report_no_input_aditi_state(in, in, di, uo) is det.
+:- pred report_no_aditi_state(pred_info::in, io::di, io::uo) is det.
-report_no_input_aditi_state(PredInfo, Context) -->
- io__set_exit_status(1),
- { report_aditi_pragma(PredInfo, PredErrorPieces) },
- { list__append(PredErrorPieces,
+report_no_aditi_state(PredInfo, !IO) :-
+ io__set_exit_status(1, !IO),
+ pred_info_context(PredInfo, Context),
+ report_aditi_pragma(PredInfo, PredErrorPieces),
+ list__append(PredErrorPieces,
+ [words("without an `aditi__state' argument.")], ErrorPieces),
+ error_util__write_error_pieces(Context, 0, ErrorPieces, !IO).
+
+:- pred report_no_input_aditi_state(pred_info::in, prog_context::in,
+ io::di, io::uo) is det.
+
+report_no_input_aditi_state(PredInfo, Context, !IO) :-
+ io__set_exit_status(1, !IO),
+ report_aditi_pragma(PredInfo, PredErrorPieces),
+ list__append(PredErrorPieces,
[words(
"without an `aditi__state' argument with mode `aditi_mui'.")],
- ErrorPieces) },
- error_util__write_error_pieces(Context, 0, ErrorPieces).
+ ErrorPieces),
+ error_util__write_error_pieces(Context, 0, ErrorPieces, !IO).
-:- pred report_aditi_pragma(pred_info, list(format_component)).
-:- mode report_aditi_pragma(in, out) is det.
+:- pred report_aditi_pragma(pred_info::in, list(format_component)::out) is det.
report_aditi_pragma(PredInfo, ErrorPieces) :-
Module = pred_info_module(PredInfo),
@@ -1157,10 +1113,9 @@
post_typecheck__resolve_unify_functor(X0, ConsId0, ArgVars0, Mode0,
Unification0, UnifyContext, GoalInfo0,
- ModuleInfo, PredInfo0, PredInfo, VarTypes0, VarTypes,
- VarSet0, VarSet, Goal) :-
+ ModuleInfo, !PredInfo, !VarTypes, !VarSet, Goal) :-
- map__lookup(VarTypes0, X0, TypeOfX),
+ map__lookup(!.VarTypes, X0, TypeOfX),
list__length(ArgVars0, Arity),
(
%
@@ -1192,10 +1147,6 @@
HOCall = generic_call(
higher_order(FuncVar, Purity, function, FullArity),
ArgVars, Modes, Det),
-
- PredInfo = PredInfo0,
- VarTypes = VarTypes0,
- VarSet = VarSet0,
Goal = HOCall - GoalInfo0
;
%
@@ -1219,16 +1170,16 @@
% a type ambiguity error, but compiler-generated
% predicates are not type-checked.)
%
- \+ is_unify_or_compare_pred(PredInfo0),
+ \+ is_unify_or_compare_pred(!.PredInfo),
%
% We don't do this for the clause introduced by the
% compiler for a field access function -- that needs
% to be expanded into unifications below.
%
- \+ pred_info_is_field_access_function(ModuleInfo, PredInfo0),
+ \+ pred_info_is_field_access_function(ModuleInfo, !.PredInfo),
- pred_info_get_markers(PredInfo0, Markers),
+ pred_info_get_markers(!.PredInfo, Markers),
module_info_get_predicate_table(ModuleInfo, PredTable),
predicate_table_search_func_sym_arity(PredTable,
calls_are_fully_qualified(Markers),
@@ -1238,8 +1189,8 @@
% argument/return types which subsume the actual
% argument/return types of this function call
- pred_info_typevarset(PredInfo0, TVarSet),
- map__apply_to_list(ArgVars0, VarTypes0, ArgTypes0),
+ pred_info_typevarset(!.PredInfo, TVarSet),
+ map__apply_to_list(ArgVars0, !.VarTypes, ArgTypes0),
list__append(ArgTypes0, [TypeOfX], ArgTypes),
typecheck__find_matching_pred_id(PredIds, ModuleInfo,
TVarSet, ArgTypes, PredId, QualifiedFuncName)
@@ -1255,10 +1206,6 @@
functor(ConsId0, no, ArgVars0), UnifyContext),
FuncCall = call(PredId, ProcId, ArgVars, not_builtin,
yes(FuncCallUnifyContext), QualifiedFuncName),
-
- PredInfo = PredInfo0,
- VarTypes = VarTypes0,
- VarSet = VarSet0,
Goal = FuncCall - GoalInfo0
;
%
@@ -1274,25 +1221,22 @@
% compiler for a field access function -- that needs
% to be expanded into unifications below.
%
- \+ pred_info_is_field_access_function(ModuleInfo, PredInfo0),
+ \+ pred_info_is_field_access_function(ModuleInfo, !.PredInfo),
%
% Find the pred_id of the constant.
%
- map__apply_to_list(ArgVars0, VarTypes0, ArgTypes0),
+ map__apply_to_list(ArgVars0, !.VarTypes, ArgTypes0),
AllArgTypes = ArgTypes0 ++ HOArgTypes,
- pred_info_typevarset(PredInfo0, TVarSet),
- pred_info_get_markers(PredInfo0, Markers),
+ pred_info_typevarset(!.PredInfo, TVarSet),
+ pred_info_get_markers(!.PredInfo, Markers),
get_pred_id(calls_are_fully_qualified(Markers), Name,
PredOrFunc, TVarSet, AllArgTypes, ModuleInfo, PredId)
->
get_proc_id(ModuleInfo, PredId, ProcId),
ConsId = pred_const(PredId, ProcId, EvalMethod),
Goal = unify(X0, functor(ConsId, no, ArgVars0), Mode0,
- Unification0, UnifyContext) - GoalInfo0,
- PredInfo = PredInfo0,
- VarTypes = VarTypes0,
- VarSet = VarSet0
+ Unification0, UnifyContext) - GoalInfo0
;
%
% Is it a call to an automatically generated field access
@@ -1310,7 +1254,7 @@
% We don't do this for compiler-generated predicates --
% they will never contain calls to field access functions.
%
- \+ is_unify_or_compare_pred(PredInfo0),
+ \+ is_unify_or_compare_pred(!.PredInfo),
%
% If there is a constructor for which the argument types
@@ -1318,23 +1262,19 @@
% access function, otherwise there would have been an
% error reported for unresolved overloading.
%
- pred_info_typevarset(PredInfo0, TVarSet),
- map__apply_to_list(ArgVars0, VarTypes0, ArgTypes0),
+ pred_info_typevarset(!.PredInfo, TVarSet),
+ map__apply_to_list(ArgVars0, !.VarTypes, ArgTypes0),
\+ find_matching_constructor(ModuleInfo, TVarSet,
ConsId0, TypeOfX, ArgTypes0)
->
post_typecheck__finish_field_access_function(ModuleInfo,
- PredInfo0, PredInfo, VarTypes0, VarTypes,
- VarSet0, VarSet, AccessType, FieldName,
+ !PredInfo, !VarTypes, !VarSet, AccessType, FieldName,
UnifyContext, X0, ArgVars0, GoalInfo0, Goal)
;
%
% Module qualify ordinary construction/deconstruction
% unifications.
%
- PredInfo = PredInfo0,
- VarTypes = VarTypes0,
- VarSet = VarSet0,
(
ConsId0 = cons(Name0, Arity),
type_to_ctor_and_args(TypeOfX, TypeCtorOfX, _),
@@ -1353,9 +1293,8 @@
% Succeed if there is a constructor which matches the given
% cons_id, type and argument types.
-:- pred find_matching_constructor(module_info, tvarset,
- cons_id, type, list(type)).
-:- mode find_matching_constructor(in, in, in, in, in) is semidet.
+:- pred find_matching_constructor(module_info::in, tvarset::in,
+ cons_id::in, (type)::in, list(type)::in) is semidet.
find_matching_constructor(ModuleInfo, TVarSet, ConsId, Type, ArgTypes) :-
type_to_ctor_and_args(Type, TypeCtor, _),
@@ -1383,51 +1322,46 @@
% The error messages from mode analysis and determinism analysis
% shouldn't be too much worse than if the goals were special cases.
%
-:- pred post_typecheck__finish_field_access_function(module_info, pred_info,
- pred_info, vartypes, vartypes, prog_varset, prog_varset,
- field_access_type, ctor_field_name,
- unify_context, prog_var, list(prog_var),
- hlds_goal_info, hlds_goal).
-:- mode post_typecheck__finish_field_access_function(in, in, out, in, out,
- in, out, in, in, in, in, in, in, out) is det.
-
-post_typecheck__finish_field_access_function(ModuleInfo, PredInfo0, PredInfo,
- VarTypes0, VarTypes, VarSet0, VarSet, AccessType, FieldName,
- UnifyContext, Var, Args, GoalInfo, GoalExpr - GoalInfo) :-
+:- pred post_typecheck__finish_field_access_function(module_info::in,
+ pred_info::in, pred_info::out, vartypes::in, vartypes::out,
+ prog_varset::in, prog_varset::out,
+ field_access_type::in, ctor_field_name::in,
+ unify_context::in, prog_var::in, list(prog_var)::in,
+ hlds_goal_info::in, hlds_goal::out) is det.
+
+post_typecheck__finish_field_access_function(ModuleInfo, !PredInfo,
+ !VarTypes, !VarSet, AccessType, FieldName, UnifyContext,
+ Var, Args, GoalInfo, GoalExpr - GoalInfo) :-
(
AccessType = get,
field_extraction_function_args(Args, TermVar),
post_typecheck__translate_get_function(ModuleInfo,
- PredInfo0, PredInfo, VarTypes0, VarTypes,
- VarSet0, VarSet, FieldName, UnifyContext,
+ !PredInfo, !VarTypes, !VarSet, FieldName, UnifyContext,
Var, TermVar, GoalInfo, GoalExpr)
;
AccessType = set,
field_update_function_args(Args, TermInputVar, FieldVar),
post_typecheck__translate_set_function(ModuleInfo,
- PredInfo0, PredInfo, VarTypes0, VarTypes,
- VarSet0, VarSet, FieldName, UnifyContext,
+ !PredInfo, !VarTypes, !VarSet, FieldName, UnifyContext,
FieldVar, TermInputVar, Var,
GoalInfo, GoalExpr)
).
-:- pred post_typecheck__translate_get_function(module_info,
- pred_info, pred_info, vartypes, vartypes,
- prog_varset, prog_varset, ctor_field_name,
- unify_context, prog_var, prog_var,
- hlds_goal_info, hlds_goal_expr).
-:- mode post_typecheck__translate_get_function(in, in, out, in, out, in, out,
- in, in, in, in, in, out) is det.
+:- pred post_typecheck__translate_get_function(module_info::in,
+ pred_info::in, pred_info::out, vartypes::in, vartypes::out,
+ prog_varset::in, prog_varset::out, ctor_field_name::in,
+ unify_context::in, prog_var::in, prog_var::in,
+ hlds_goal_info::in, hlds_goal_expr::out) is det.
-post_typecheck__translate_get_function(ModuleInfo, PredInfo0, PredInfo,
- VarTypes0, VarTypes, VarSet0, VarSet, FieldName, UnifyContext,
+post_typecheck__translate_get_function(ModuleInfo, !PredInfo,
+ !VarTypes, !VarSet, FieldName, UnifyContext,
FieldVar, TermInputVar, OldGoalInfo, GoalExpr) :-
- map__lookup(VarTypes0, TermInputVar, TermType),
+ map__lookup(!.VarTypes, TermInputVar, TermType),
get_constructor_containing_field(ModuleInfo, TermType, FieldName,
ConsId, FieldNumber),
get_cons_id_arg_types_adding_existq_tvars(ModuleInfo, ConsId,
- TermType, ArgTypes0, ExistQVars, PredInfo0, PredInfo),
+ TermType, ArgTypes0, ExistQVars, !PredInfo),
%
% If the type of the field we are extracting contains existentially
@@ -1440,7 +1374,7 @@
% by typecheck.m because the result can't be well-typed).
%
( ExistQVars \= [] ->
- map__lookup(VarTypes0, FieldVar, FieldType),
+ map__lookup(!.VarTypes, FieldVar, FieldType),
list__index1_det(ArgTypes0, FieldNumber, FieldArgType),
(
type_list_subsumes([FieldArgType], [FieldType],
@@ -1449,8 +1383,8 @@
term__apply_rec_substitution_to_list(ArgTypes0,
FieldSubst, ArgTypes)
;
- error(
- "post_typecheck__translate_get_function: type_list_subsumes failed")
+ error("post_typecheck__translate_get_function: " ++
+ "type_list_subsumes failed")
)
;
ArgTypes = ArgTypes0
@@ -1459,10 +1393,8 @@
split_list_at_index(FieldNumber, ArgTypes,
TypesBeforeField, _, TypesAfterField),
- make_new_vars(TypesBeforeField, VarsBeforeField,
- VarTypes0, VarTypes1, VarSet0, VarSet1),
- make_new_vars(TypesAfterField, VarsAfterField,
- VarTypes1, VarTypes, VarSet1, VarSet),
+ make_new_vars(TypesBeforeField, VarsBeforeField, !VarTypes, !VarSet),
+ make_new_vars(TypesAfterField, VarsAfterField, !VarTypes, !VarSet),
list__append(VarsBeforeField, [FieldVar | VarsAfterField], ArgVars),
@@ -1473,33 +1405,29 @@
UnifyContext, FunctorGoal),
FunctorGoal = GoalExpr - _.
-:- pred post_typecheck__translate_set_function(module_info,
- pred_info, pred_info, vartypes, vartypes,
- prog_varset, prog_varset, ctor_field_name, unify_context,
- prog_var, prog_var, prog_var, hlds_goal_info, hlds_goal_expr).
-:- mode post_typecheck__translate_set_function(in, in, out, in, out, in, out,
- in, in, in, in, in, in, out) is det.
+:- pred post_typecheck__translate_set_function(module_info::in,
+ pred_info::in, pred_info::out, vartypes::in, vartypes::out,
+ prog_varset::in, prog_varset::out, ctor_field_name::in,
+ unify_context::in, prog_var::in, prog_var::in, prog_var::in,
+ hlds_goal_info::in, hlds_goal_expr::out) is det.
-post_typecheck__translate_set_function(ModuleInfo, PredInfo0, PredInfo,
- VarTypes0, VarTypes, VarSet0, VarSet, FieldName, UnifyContext,
+post_typecheck__translate_set_function(ModuleInfo, !PredInfo,
+ !VarTypes, !VarSet, FieldName, UnifyContext,
FieldVar, TermInputVar, TermOutputVar, OldGoalInfo, Goal) :-
- map__lookup(VarTypes0, TermInputVar, TermType),
+ map__lookup(!.VarTypes, TermInputVar, TermType),
get_constructor_containing_field(ModuleInfo, TermType, FieldName,
ConsId0, FieldNumber),
get_cons_id_arg_types_adding_existq_tvars(ModuleInfo, ConsId0,
- TermType, ArgTypes, ExistQVars, PredInfo0, PredInfo),
+ TermType, ArgTypes, ExistQVars, !PredInfo),
split_list_at_index(FieldNumber, ArgTypes,
TypesBeforeField, TermFieldType, TypesAfterField),
- make_new_vars(TypesBeforeField, VarsBeforeField, VarTypes0, VarTypes1,
- VarSet0, VarSet1),
- make_new_var(TermFieldType, SingletonFieldVar, VarTypes1, VarTypes2,
- VarSet1, VarSet2),
- make_new_vars(TypesAfterField, VarsAfterField, VarTypes2, VarTypes,
- VarSet2, VarSet),
+ make_new_vars(TypesBeforeField, VarsBeforeField, !VarTypes, !VarSet),
+ make_new_var(TermFieldType, SingletonFieldVar, !VarTypes, !VarSet),
+ make_new_vars(TypesAfterField, VarsAfterField, !VarTypes, !VarSet),
%
% Build a goal to deconstruct the input.
@@ -1533,8 +1461,8 @@
remove_new_prefix(ConsName, ConsName0),
ConsId = cons(ConsName, ConsArity)
;
- error(
- "post_typecheck__translate_set_function: invalid cons_id")
+ error("post_typecheck__translate_set_function: " ++
+ "invalid cons_id")
)
),
@@ -1549,10 +1477,9 @@
% as an atomic goal.
Goal = some([], can_remove, Conj).
-:- pred get_cons_id_arg_types_adding_existq_tvars(module_info, cons_id,
- (type), list(type), list(tvar), pred_info, pred_info).
-:- mode get_cons_id_arg_types_adding_existq_tvars(in, in, in,
- out, out, in, out) is det.
+:- pred get_cons_id_arg_types_adding_existq_tvars(module_info::in, cons_id::in,
+ (type)::in, list(type)::out, list(tvar)::out,
+ pred_info::in, pred_info::out) is det.
get_cons_id_arg_types_adding_existq_tvars(ModuleInfo, ConsId, TermType,
ArgTypes, NewExistQVars, !PredInfo) :-
@@ -1591,8 +1518,8 @@
),
term__apply_substitution_to_list(ArgTypes1, TSubst, ArgTypes).
-:- pred split_list_at_index(int, list(T), list(T), T, list(T)).
-:- mode split_list_at_index(in, in, out, out, out) is det.
+:- pred split_list_at_index(int::in, list(T)::in, list(T)::out, T::out,
+ list(T)::out) is det.
split_list_at_index(Index, List, Before, At, After) :-
(
@@ -1610,17 +1537,16 @@
% Work out which constructor of the type has an argument with the
% given field name.
-:- pred get_constructor_containing_field(module_info, (type), ctor_field_name,
- cons_id, int).
-:- mode get_constructor_containing_field(in, in, in, out, out) is det.
+:- pred get_constructor_containing_field(module_info::in, (type)::in,
+ ctor_field_name::in, cons_id::out, int::out) is det.
get_constructor_containing_field(ModuleInfo, TermType, FieldName,
ConsId, FieldNumber) :-
( type_to_ctor_and_args(TermType, TermTypeCtor0, _) ->
TermTypeCtor = TermTypeCtor0
;
- error(
- "get_constructor_containing_field: type_to_ctor_and_args failed")
+ error("get_constructor_containing_field: " ++
+ "type_to_ctor_and_args failed")
),
module_info_types(ModuleInfo, Types),
map__lookup(Types, TermTypeCtor, TermTypeDefn),
@@ -1632,9 +1558,8 @@
error("get_constructor_containing_field: not du type")
).
-:- pred get_constructor_containing_field_2(list(constructor),
- ctor_field_name, cons_id, int).
-:- mode get_constructor_containing_field_2(in, in, out, out) is det.
+:- pred get_constructor_containing_field_2(list(constructor)::in,
+ ctor_field_name::in, cons_id::out, int::out) is det.
get_constructor_containing_field_2([], _, _, _) :-
error("get_constructor_containing_field: can't find field").
@@ -1653,9 +1578,8 @@
ConsId, FieldNumber)
).
-:- pred get_constructor_containing_field_3(list(constructor_arg),
- ctor_field_name, int, int).
-:- mode get_constructor_containing_field_3(in, in, in, out) is semidet.
+:- pred get_constructor_containing_field_3(list(constructor_arg)::in,
+ ctor_field_name::in, int::in, int::out) is semidet.
get_constructor_containing_field_3([MaybeArgFieldName - _ | CtorArgs],
FieldName, FieldNumber0, FieldNumber) :-
@@ -1672,11 +1596,9 @@
%-----------------------------------------------------------------------------%
-:- pred create_atomic_unification_with_nonlocals(prog_var, unify_rhs,
- hlds_goal_info, set(prog_var), list(prog_var),
- unify_context, hlds_goal).
-:- mode create_atomic_unification_with_nonlocals(in, in,
- in, in, in, in, out) is det.
+:- pred create_atomic_unification_with_nonlocals(prog_var::in, unify_rhs::in,
+ hlds_goal_info::in, set(prog_var)::in, list(prog_var)::in,
+ unify_context::in, hlds_goal::out) is det.
create_atomic_unification_with_nonlocals(Var, RHS, OldGoalInfo,
RestrictNonLocals, VarsList, UnifyContext, Goal) :-
@@ -1692,23 +1614,21 @@
goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo),
Goal = GoalExpr0 - GoalInfo.
-:- pred make_new_vars(list(type), list(prog_var), vartypes, vartypes,
- prog_varset, prog_varset).
-:- mode make_new_vars(in, out, in, out, in, out) is det.
+:- pred make_new_vars(list(type)::in, list(prog_var)::out,
+ vartypes::in, vartypes::out, prog_varset::in, prog_varset::out) is det.
-make_new_vars(Types, Vars, VarTypes0, VarTypes, VarSet0, VarSet) :-
+make_new_vars(Types, Vars, !VarTypes, !VarSet) :-
list__length(Types, NumVars),
- varset__new_vars(VarSet0, NumVars, Vars, VarSet),
- map__det_insert_from_corresponding_lists(VarTypes0,
- Vars, Types, VarTypes).
-
-:- pred make_new_var((type), prog_var, vartypes, vartypes,
- prog_varset, prog_varset).
-:- mode make_new_var(in, out, in, out, in, out) is det.
-
-make_new_var(Type, Var, VarTypes0, VarTypes, VarSet0, VarSet) :-
- varset__new_var(VarSet0, Var, VarSet),
- map__det_insert(VarTypes0, Var, Type, VarTypes).
+ varset__new_vars(!.VarSet, NumVars, Vars, !:VarSet),
+ map__det_insert_from_corresponding_lists(!.VarTypes, Vars, Types,
+ !:VarTypes).
+
+:- pred make_new_var((type)::in, prog_var::out, vartypes::in, vartypes::out,
+ prog_varset::in, prog_varset::out) is det.
+
+make_new_var(Type, Var, !VarTypes, !VarSet) :-
+ varset__new_var(!.VarSet, Var, !:VarSet),
+ map__det_insert(!.VarTypes, Var, Type, !:VarTypes).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.64
diff -u -b -r1.64 pragma_c_gen.m
--- compiler/pragma_c_gen.m 5 Nov 2003 03:17:42 -0000 1.64
+++ compiler/pragma_c_gen.m 18 Dec 2003 09:09:55 -0000
@@ -367,8 +367,8 @@
%
% Extract the attributes
%
- may_call_mercury(Attributes, MayCallMercury),
- thread_safe(Attributes, ThreadSafe),
+ MayCallMercury = may_call_mercury(Attributes),
+ ThreadSafe = thread_safe(Attributes),
%
% First we need to get a list of input and output arguments
@@ -660,7 +660,7 @@
%
% Extract the may_call_mercury attribute
%
- may_call_mercury(Attributes, MayCallMercury),
+ MayCallMercury = may_call_mercury(Attributes),
%
% Generate #define MR_PROC_LABEL <procedure label> /* see note (5) */
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.101
diff -u -b -r1.101 prog_data.m
--- compiler/prog_data.m 1 Dec 2003 15:55:46 -0000 1.101
+++ compiler/prog_data.m 18 Dec 2003 09:22:49 -0000
@@ -512,7 +512,6 @@
% Currently we only support foreign_language_types for IL.
%
-
%
% It is important to distinguish between IL value types and
% reference types, the compiler may need to generate different code
@@ -619,7 +618,6 @@
% possible inputs.
; can_loop. % This procedure might not terminate.
-
%
% Stuff for the `unused_args' pragma.
%
@@ -819,59 +817,44 @@
% `pragma_c_code_attribute's.
:- type pragma_foreign_proc_attributes.
-:- pred default_attributes(foreign_language, pragma_foreign_proc_attributes).
-:- mode default_attributes(in, out) is det.
-
-:- pred may_call_mercury(pragma_foreign_proc_attributes, may_call_mercury).
-:- mode may_call_mercury(in, out) is det.
-
-:- pred set_may_call_mercury(pragma_foreign_proc_attributes, may_call_mercury,
- pragma_foreign_proc_attributes).
-:- mode set_may_call_mercury(in, in, out) is det.
-
-:- pred thread_safe(pragma_foreign_proc_attributes, thread_safe).
-:- mode thread_safe(in, out) is det.
-
-:- pred purity(pragma_foreign_proc_attributes, purity).
-:- mode purity(in, out) is det.
-
-:- pred legacy_purity_behaviour(pragma_foreign_proc_attributes, bool).
-:- mode legacy_purity_behaviour(in, out) is det.
-
-:- pred set_thread_safe(pragma_foreign_proc_attributes, thread_safe,
- pragma_foreign_proc_attributes).
-:- mode set_thread_safe(in, in, out) is det.
-
-:- pred foreign_language(pragma_foreign_proc_attributes, foreign_language).
-:- mode foreign_language(in, out) is det.
-
-:- pred set_foreign_language(pragma_foreign_proc_attributes, foreign_language,
- pragma_foreign_proc_attributes).
-:- mode set_foreign_language(in, in, out) is det.
-
-:- pred tabled_for_io(pragma_foreign_proc_attributes, tabled_for_io).
-:- mode tabled_for_io(in, out) is det.
-
-:- pred set_tabled_for_io(pragma_foreign_proc_attributes, tabled_for_io,
- pragma_foreign_proc_attributes).
-:- mode set_tabled_for_io(in, in, out) is det.
-
-:- pred set_purity(pragma_foreign_proc_attributes, purity,
- pragma_foreign_proc_attributes).
-:- mode set_purity(in, in, out) is det.
-
-:- pred set_legacy_purity_behaviour(pragma_foreign_proc_attributes, bool,
- pragma_foreign_proc_attributes).
-:- mode set_legacy_purity_behaviour(in, in, out) is det.
-
-:- pred add_extra_attribute(pragma_foreign_proc_attributes,
- pragma_foreign_proc_extra_attribute,
- pragma_foreign_proc_attributes).
-:- mode add_extra_attribute(in, in, out) is det.
-
+:- func default_attributes(foreign_language) = pragma_foreign_proc_attributes.
+:- func may_call_mercury(pragma_foreign_proc_attributes) = may_call_mercury.
+:- func thread_safe(pragma_foreign_proc_attributes) = thread_safe.
+:- func purity(pragma_foreign_proc_attributes) = purity.
+:- func legacy_purity_behaviour(pragma_foreign_proc_attributes) = bool.
+:- func foreign_language(pragma_foreign_proc_attributes) = foreign_language.
+:- func tabled_for_io(pragma_foreign_proc_attributes) = tabled_for_io.
:- func extra_attributes(pragma_foreign_proc_attributes)
= pragma_foreign_proc_extra_attributes.
+:- pred set_may_call_mercury(may_call_mercury::in,
+ pragma_foreign_proc_attributes::in,
+ pragma_foreign_proc_attributes::out) is det.
+
+:- pred set_thread_safe(thread_safe::in,
+ pragma_foreign_proc_attributes::in,
+ pragma_foreign_proc_attributes::out) is det.
+
+:- pred set_foreign_language(foreign_language::in,
+ pragma_foreign_proc_attributes::in,
+ pragma_foreign_proc_attributes::out) is det.
+
+:- pred set_tabled_for_io(tabled_for_io::in,
+ pragma_foreign_proc_attributes::in,
+ pragma_foreign_proc_attributes::out) is det.
+
+:- pred set_purity(purity::in,
+ pragma_foreign_proc_attributes::in,
+ pragma_foreign_proc_attributes::out) is det.
+
+:- pred set_legacy_purity_behaviour(bool::in,
+ pragma_foreign_proc_attributes::in,
+ pragma_foreign_proc_attributes::out) is det.
+
+:- pred add_extra_attribute(pragma_foreign_proc_extra_attribute::in,
+ pragma_foreign_proc_attributes::in,
+ pragma_foreign_proc_attributes::out) is det.
+
% For pragma c_code, there are two different calling conventions,
% one for C code that may recursively call Mercury code, and another
% more efficient one for the case when we know that the C code will
@@ -910,8 +893,7 @@
% the pragma (not all attributes have one).
% In particular, the foreign language attribute needs to be
% handled separately as it belongs at the start of the pragma.
-:- pred attributes_to_strings(pragma_foreign_proc_attributes::in,
- list(string)::out) is det.
+:- func attributes_to_strings(pragma_foreign_proc_attributes) = list(string).
%-----------------------------------------------------------------------------%
%
@@ -993,8 +975,7 @@
% produce a set of tuples to be inserted or deleted.
:- type lambda_eval_method
---> normal
- ; (aditi_bottom_up)
- .
+ ; (aditi_bottom_up).
%-----------------------------------------------------------------------------%
%
@@ -1281,8 +1262,7 @@
; ancestor
% The item is from the private interface of an ancestor module.
- ; ancestor_private_interface
- .
+ ; ancestor_private_interface.
:- type sym_list
---> sym(list(sym_specifier))
@@ -1370,42 +1350,24 @@
list(pragma_foreign_proc_extra_attribute)
).
-
-default_attributes(Language,
+default_attributes(Language) =
attributes(Language, may_call_mercury, not_thread_safe,
- not_tabled_for_io, impure, no, [])).
-
-may_call_mercury(Attrs, Attrs ^ may_call_mercury).
-
-thread_safe(Attrs, Attrs ^ thread_safe).
-
-foreign_language(Attrs, Attrs ^ foreign_language).
-
-tabled_for_io(Attrs, Attrs ^ tabled_for_io).
+ not_tabled_for_io, impure, no, []).
-purity(Attrs, Attrs ^ purity).
-
-legacy_purity_behaviour(Attrs, Attrs ^ legacy_purity_behaviour).
-
-set_may_call_mercury(Attrs0, MayCallMercury, Attrs) :-
+set_may_call_mercury(MayCallMercury, Attrs0, Attrs) :-
Attrs = Attrs0 ^ may_call_mercury := MayCallMercury.
-
-set_thread_safe(Attrs0, ThreadSafe, Attrs) :-
+set_thread_safe(ThreadSafe, Attrs0, Attrs) :-
Attrs = Attrs0 ^ thread_safe := ThreadSafe.
-
-set_foreign_language(Attrs0, ForeignLanguage, Attrs) :-
+set_foreign_language(ForeignLanguage, Attrs0, Attrs) :-
Attrs = Attrs0 ^ foreign_language := ForeignLanguage.
-
-set_tabled_for_io(Attrs0, TabledForIo, Attrs) :-
+set_tabled_for_io(TabledForIo, Attrs0, Attrs) :-
Attrs = Attrs0 ^ tabled_for_io := TabledForIo.
-
-set_purity(Attrs0, Purity, Attrs) :-
+set_purity(Purity, Attrs0, Attrs) :-
Attrs = Attrs0 ^ purity := Purity.
-
-set_legacy_purity_behaviour(Attrs0, Legacy, Attrs) :-
+set_legacy_purity_behaviour(Legacy, Attrs0, Attrs) :-
Attrs = Attrs0 ^ legacy_purity_behaviour := Legacy.
-attributes_to_strings(Attrs, StringList) :-
+attributes_to_strings(Attrs) = StringList :-
% We ignore Lang because it isn't an attribute that you can put
% in the attribute list -- the foreign language specifier string
% is at the start of the pragma.
@@ -1452,12 +1414,13 @@
PurityStrList] ++
list__map(extra_attribute_to_string, ExtraAttributes).
-add_extra_attribute(Attributes0, NewAttribute,
+add_extra_attribute(NewAttribute, Attributes0,
Attributes0 ^ extra_attributes :=
[NewAttribute | Attributes0 ^ extra_attributes]).
:- func extra_attribute_to_string(pragma_foreign_proc_extra_attribute)
= string.
+
extra_attribute_to_string(max_stack_size(Size)) =
"max_stack_size(" ++ string__int_to_string(Size) ++ ")".
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.62
diff -u -b -r1.62 prog_io_pragma.m
--- compiler/prog_io_pragma.m 1 Dec 2003 15:55:47 -0000 1.62
+++ compiler/prog_io_pragma.m 18 Dec 2003 09:46:36 -0000
@@ -604,8 +604,8 @@
Pragma = "c_code"
->
% may_call_mercury is a conservative default.
- default_attributes(ForeignLanguage, Attributes0),
- set_legacy_purity_behaviour(Attributes0, yes,
+ Attributes0 = default_attributes(ForeignLanguage),
+ set_legacy_purity_behaviour(yes, Attributes0,
Attributes),
(
CodeTerm = term__functor(term__string(Code), [],
@@ -691,9 +691,9 @@
)
;
PragmaTerms = [PredAndModesTerm, FunctionTerm],
- default_attributes(ForeignLanguage, Flags0),
+ Flags0 = default_attributes(ForeignLanguage),
% pragma import uses legacy purity behaviour
- set_legacy_purity_behaviour(Flags0, yes, Flags),
+ set_legacy_purity_behaviour(yes, Flags0, Flags),
FlagsResult = ok(Flags)
)
->
@@ -720,9 +720,8 @@
Result = error(Msg, Term)
)
;
- Result = error(
- "expected pragma import(PredName(ModeList), Function)",
- PredAndModesTerm)
+ Result = error("expected pragma import(PredName(ModeList), "
+ ++ "Function)", PredAndModesTerm)
)
;
Result =
@@ -1222,10 +1221,10 @@
parse_pragma_foreign_proc_attributes_term(ForeignLanguage, Pragma, Term,
MaybeAttributes) :-
- default_attributes(ForeignLanguage, Attributes0),
+ Attributes0 = default_attributes(ForeignLanguage),
( ( Pragma = "c_code" ; Pragma = "import" ) ->
- set_legacy_purity_behaviour(Attributes0, yes, Attributes1),
- set_purity(Attributes1, pure, Attributes2)
+ set_legacy_purity_behaviour(yes, Attributes0, Attributes1),
+ set_purity(pure, Attributes1, Attributes2)
;
Attributes2 = Attributes0
),
@@ -1278,16 +1277,16 @@
pragma_foreign_proc_attributes::in,
pragma_foreign_proc_attributes::out) is det.
-process_attribute(may_call_mercury(MayCallMercury), Attrs0, Attrs) :-
- set_may_call_mercury(Attrs0, MayCallMercury, Attrs).
-process_attribute(thread_safe(ThreadSafe), Attrs0, Attrs) :-
- set_thread_safe(Attrs0, ThreadSafe, Attrs).
-process_attribute(tabled_for_io(TabledForIO), Attrs0, Attrs) :-
- set_tabled_for_io(Attrs0, TabledForIO, Attrs).
-process_attribute(purity(Pure), Attrs0, Attrs) :-
- set_purity(Attrs0, Pure, Attrs).
-process_attribute(max_stack_size(Size), Attrs0, Attrs) :-
- add_extra_attribute(Attrs0, max_stack_size(Size), Attrs).
+process_attribute(may_call_mercury(MayCallMercury), !Attrs) :-
+ set_may_call_mercury(MayCallMercury, !Attrs).
+process_attribute(thread_safe(ThreadSafe), !Attrs) :-
+ set_thread_safe(ThreadSafe, !Attrs).
+process_attribute(tabled_for_io(TabledForIO), !Attrs) :-
+ set_tabled_for_io(TabledForIO, !Attrs).
+process_attribute(purity(Pure), !Attrs) :-
+ set_purity(Pure, !Attrs).
+process_attribute(max_stack_size(Size), !Attrs) :-
+ add_extra_attribute(max_stack_size(Size), !Attrs).
% Aliasing is currently ignored in the main branch compiler.
process_attribute(aliasing, Attrs, Attrs).
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.27
diff -u -b -r1.27 prog_io_util.m
--- compiler/prog_io_util.m 15 Mar 2003 03:09:07 -0000 1.27
+++ compiler/prog_io_util.m 20 Dec 2003 08:34:47 -0000
@@ -535,7 +535,7 @@
;
Args1 = Args0,
list__length(Args1, Arity),
- make_functor_cons_id(Functor, Arity, ConsId)
+ ConsId = make_functor_cons_id(Functor, Arity)
),
convert_inst_list(AllowConstrainedInstVar, Args1, Args).
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.62
diff -u -b -r1.62 purity.m
--- compiler/purity.m 31 Oct 2003 03:27:28 -0000 1.62
+++ compiler/purity.m 18 Dec 2003 08:41:17 -0000
@@ -135,8 +135,9 @@
% The third argument specifies whether post_typecheck.m detected
% any errors that would cause problems for later passes
% (if so, we stop compilation after this pass).
-:- pred puritycheck(bool, module_info, bool, module_info, io__state, io__state).
-:- mode puritycheck(in, in, out, out, di, uo) is det.
+
+:- pred puritycheck(bool::in, bool::out, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
% Rerun purity checking on a procedure after an optimization pass has
% performed transformations which might affect the procedure's purity.
@@ -144,26 +145,24 @@
% purity, and that the pred_info contains the promised_pure or
% promised_semipure markers which might be needed if a promised pure
% procedure was inlined into the procedure being checked.
-:- pred repuritycheck_proc(module_info, pred_proc_id, pred_info, pred_info).
-:- mode repuritycheck_proc(in, in, in, out) is det.
+
+:- pred repuritycheck_proc(module_info::in, pred_proc_id::in, pred_info::in,
+ pred_info::out) is det.
% Sort of a "maximum" for impurity.
-:- pred worst_purity(purity, purity, purity).
-:- mode worst_purity(in, in, out) is det.
+:- func worst_purity(purity, purity) = purity.
% Compare two purities.
-:- pred less_pure(purity, purity).
-:- mode less_pure(in, in) is semidet.
+:- pred less_pure(purity::in, purity::in) is semidet.
% Print out a purity name.
-:- pred write_purity(purity, io__state, io__state).
-:- mode write_purity(in, di, uo) is det.
+:- pred write_purity(purity::in, io__state::di, io__state::uo) is det.
% Print out a purity prefix.
% This works under the assumptions that all purity names but `pure' are prefix
% Operators, and that we never need `pure' indicators/declarations.
-:- pred write_purity_prefix(purity, io__state, io__state).
-:- mode write_purity_prefix(in, di, uo) is det.
+
+:- pred write_purity_prefix(purity::in, io__state::di, io__state::uo) is det.
:- func purity_prefix_to_string(purity) = string.
@@ -174,9 +173,8 @@
% Give an error message for unifications marked impure/semipure that are
% not function calls (e.g. impure X = 4)
-:- pred impure_unification_expr_error(prog_context, purity,
- io__state, io__state).
-:- mode impure_unification_expr_error(in, in, di, uo) is det.
+:- pred impure_unification_expr_error(prog_context::in, purity::in,
+ io__state::di, io__state::uo) is det.
:- implementation.
@@ -206,43 +204,41 @@
%-----------------------------------------------------------------------------%
% Public Predicates
-
-puritycheck(FoundTypeError, HLDS0, PostTypecheckError, HLDS) -->
- globals__io_lookup_bool_option(statistics, Statistics),
- globals__io_lookup_bool_option(verbose, Verbose),
-
- maybe_write_string(Verbose, "% Purity-checking clauses...\n"),
- check_preds_purity(FoundTypeError, HLDS0, PostTypecheckError, HLDS),
- maybe_report_stats(Statistics).
-
+puritycheck(FoundTypeError, PostTypecheckError, !HLDS, !IO) :-
+ globals__io_lookup_bool_option(statistics, Statistics, !IO),
+ globals__io_lookup_bool_option(verbose, Verbose, !IO),
+
+ maybe_write_string(Verbose, "% Purity-checking clauses...\n", !IO),
+ check_preds_purity(FoundTypeError, PostTypecheckError, !HLDS, !IO),
+ maybe_report_stats(Statistics, !IO).
% worst_purity/3 could be written more compactly, but this definition
% guarantees us a determinism error if we add to type `purity'. We also
% define less_pure/2 in terms of worst_purity/3 rather than the other way
% around for the same reason.
-worst_purity(pure, pure, pure).
-worst_purity(pure, (semipure), (semipure)).
-worst_purity(pure, (impure), (impure)).
-worst_purity((semipure), pure, (semipure)).
-worst_purity((semipure), (semipure), (semipure)).
-worst_purity((semipure), (impure), (impure)).
-worst_purity((impure), pure, (impure)).
-worst_purity((impure), (semipure), (impure)).
-worst_purity((impure), (impure), (impure)).
+worst_purity(pure, pure) = pure.
+worst_purity(pure, (semipure)) = (semipure).
+worst_purity(pure, (impure)) = (impure).
+worst_purity((semipure), pure) = (semipure).
+worst_purity((semipure), (semipure)) = (semipure).
+worst_purity((semipure), (impure)) = (impure).
+worst_purity((impure), pure) = (impure).
+worst_purity((impure), (semipure)) = (impure).
+worst_purity((impure), (impure)) = (impure).
less_pure(P1, P2) :-
- \+ worst_purity(P1, P2, P2).
+ \+ ( worst_purity(P1, P2) = P2).
% this works under the assumptions that all purity names but `pure' are prefix
% operators, and that we never need `pure' indicators/declarations.
-write_purity_prefix(Purity) -->
- ( { Purity = pure } ->
- []
+write_purity_prefix(Purity, !IO) :-
+ ( Purity = pure ->
+ true
;
- write_purity(Purity),
- io__write_string(" ")
+ write_purity(Purity, !IO),
+ io__write_string(" ", !IO)
).
purity_prefix_to_string(Purity) = String :-
@@ -253,75 +249,67 @@
String = string__append(PurityName, " ")
).
-write_purity(Purity) -->
- { purity_name(Purity, String) },
- io__write_string(String).
+write_purity(Purity, !IO) :-
+ purity_name(Purity, String),
+ io__write_string(String, !IO).
purity_name(pure, "pure").
purity_name((semipure), "semipure").
purity_name((impure), "impure").
-
-
%-----------------------------------------------------------------------------%
% Purity-check the code for all the predicates in a module
-:- pred check_preds_purity(bool, module_info, bool, module_info,
- io__state, io__state).
-:- mode check_preds_purity(in, in, out, out, di, uo) is det.
-
-check_preds_purity(FoundTypeError, ModuleInfo0,
- PostTypecheckError, ModuleInfo) -->
- { module_info_predids(ModuleInfo0, PredIds) },
+:- pred check_preds_purity(bool::in, bool::out,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
+
+check_preds_purity(FoundTypeError, PostTypecheckError, !ModuleInfo, !IO) :-
+ module_info_predids(!.ModuleInfo, PredIds),
% Only report error messages for unbound type variables
% if we didn't get any type errors already; this avoids
% a lot of spurious diagnostics.
- { ReportTypeErrors = bool__not(FoundTypeError) },
+ ReportTypeErrors = bool__not(FoundTypeError),
post_typecheck__finish_preds(PredIds, ReportTypeErrors, NumErrors1,
- PostTypecheckError, ModuleInfo0, ModuleInfo1),
+ PostTypecheckError, !ModuleInfo, !IO),
- check_preds_purity_2(PredIds, ModuleInfo1, ModuleInfo2,
- NumErrors1, NumErrors),
- { module_info_num_errors(ModuleInfo2, Errs0) },
- { Errs = Errs0 + NumErrors },
- { module_info_set_num_errors(Errs, ModuleInfo2, ModuleInfo) }.
-
-:- pred check_preds_purity_2(list(pred_id), module_info, module_info,
- int, int, io__state, io__state).
-:- mode check_preds_purity_2(in, in, out, in, out, di, uo) is det.
-
-check_preds_purity_2([], ModuleInfo, ModuleInfo, NumErrors, NumErrors) --> [].
-check_preds_purity_2([PredId | PredIds], ModuleInfo0, ModuleInfo,
- NumErrors0, NumErrors) -->
- { module_info_pred_info(ModuleInfo0, PredId, PredInfo0) },
+ check_preds_purity_2(PredIds, !ModuleInfo, NumErrors1, NumErrors, !IO),
+ module_info_num_errors(!.ModuleInfo, Errs0),
+ Errs = Errs0 + NumErrors,
+ module_info_set_num_errors(Errs, !ModuleInfo).
+
+:- pred check_preds_purity_2(list(pred_id)::in,
+ module_info::in, module_info::out, int::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+check_preds_purity_2([], !ModuleInfo, !NumErrors, !IO).
+check_preds_purity_2([PredId | PredIds], !ModuleInfo, !NumErrors, !IO) :-
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
(
- { pred_info_is_imported(PredInfo0)
- ; pred_info_is_pseudo_imported(PredInfo0) }
+ ( pred_info_is_imported(PredInfo0)
+ ; pred_info_is_pseudo_imported(PredInfo0)
+ )
->
- { ModuleInfo1 = ModuleInfo0 },
- { PredInfo = PredInfo0 },
- { NumErrors1 = NumErrors0 }
+ PredInfo = PredInfo0
;
write_pred_progress_message("% Purity-checking ", PredId,
- ModuleInfo0),
- puritycheck_pred(PredId, PredInfo0, PredInfo, ModuleInfo0,
- PurityErrsInThisPred),
- { NumErrors1 = NumErrors0 + PurityErrsInThisPred },
- { module_info_set_pred_info(PredId, PredInfo,
- ModuleInfo0, ModuleInfo1) }
+ !.ModuleInfo, !IO),
+ puritycheck_pred(PredId, PredInfo0, PredInfo, !.ModuleInfo,
+ PurityErrsInThisPred, !IO),
+ !:NumErrors = !.NumErrors + PurityErrsInThisPred,
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
),
% finish processing of promise declarations
- { pred_info_get_goal_type(PredInfo, GoalType) },
- ( { GoalType = promise(PromiseType) } ->
- post_typecheck__finish_promise(PromiseType, ModuleInfo1,
- PredId, ModuleInfo2)
+ pred_info_get_goal_type(PredInfo, GoalType),
+ ( GoalType = promise(PromiseType) ->
+ post_typecheck__finish_promise(PromiseType, PredId,
+ !ModuleInfo, !IO)
;
- { ModuleInfo2 = ModuleInfo1 }
+ true
),
- check_preds_purity_2(PredIds, ModuleInfo2, ModuleInfo,
- NumErrors1, NumErrors).
+ check_preds_purity_2(PredIds, !ModuleInfo, !NumErrors, !IO).
% Purity-check the code for single predicate, reporting any errors.
@@ -472,22 +460,22 @@
% Infer the purity of a single (non-pragma c_code) predicate
-:- pred compute_purity(goal_type, list(clause), list(clause), list(proc_id),
- purity, purity, purity_info, purity_info).
-:- mode compute_purity(in, in, out, in, in, out, in, out) is det.
-
-compute_purity(_, [], [], _, Purity, Purity) --> [].
-compute_purity(GoalType, [Clause0|Clauses0], [Clause|Clauses], ProcIds,
- Purity0, Purity) -->
- { Clause0 = clause(Ids, Body0 - Info0, Lang, Context) },
- compute_expr_purity(Body0, Body, Info0, Bodypurity0),
+:- pred compute_purity(goal_type::in, list(clause)::in, list(clause)::out,
+ list(proc_id)::in, purity::in, purity::out,
+ purity_info::in, purity_info::out) is det.
+
+compute_purity(_, [], [], _, Purity, Purity, !Info).
+compute_purity(GoalType, [Clause0 | Clauses0], [Clause | Clauses], ProcIds,
+ Purity0, Purity, !Info) :-
+ Clause0 = clause(Ids, Body0 - Info0, Lang, Context),
+ compute_expr_purity(Body0, Body, Info0, Bodypurity0, !Info),
% If this clause doesn't apply to all modes of this procedure,
% i.e. the procedure has different clauses for different modes,
% then we must treat it as impure.
% the default impurity of foreign_proc procedures is handled when
% processing the foreign_proc goal -- they are not counted as impure
% here simply because they have different clauses for different modes
- {
+ (
( applies_to_all_modes(Clause0, ProcIds)
; GoalType = pragmas
)
@@ -495,12 +483,13 @@
Clausepurity = (pure)
;
Clausepurity = (impure)
- },
- { worst_purity(Bodypurity0, Clausepurity, Bodypurity) },
- { add_goal_info_purity_feature(Info0, Bodypurity, Info) },
- { worst_purity(Purity0, Bodypurity, Purity1) },
- { Clause = clause(Ids, Body - Info, Lang, Context) },
- compute_purity(GoalType, Clauses0, Clauses, ProcIds, Purity1, Purity).
+ ),
+ worst_purity(Bodypurity0, Clausepurity) = Bodypurity,
+ add_goal_info_purity_feature(Info0, Bodypurity, Info),
+ worst_purity(Purity0, Bodypurity) = Purity1,
+ Clause = clause(Ids, Body - Info, Lang, Context),
+ compute_purity(GoalType, Clauses0, Clauses, ProcIds, Purity1, Purity,
+ !Info).
:- pred applies_to_all_modes(clause::in, list(proc_id)::in) is semidet.
@@ -517,25 +506,23 @@
SortedIds = ProcIds
).
-:- pred compute_expr_purity(hlds_goal_expr, hlds_goal_expr,
- hlds_goal_info, purity, purity_info, purity_info).
-:- mode compute_expr_purity(in, out, in, out, in, out) is det.
-
-compute_expr_purity(conj(Goals0), conj(Goals), _, Purity) -->
- compute_goals_purity(Goals0, Goals, pure, Purity).
-compute_expr_purity(par_conj(Goals0), par_conj(Goals), _,
- Purity) -->
- compute_goals_purity(Goals0, Goals, pure, Purity).
-compute_expr_purity(
- Goal0 @ call(PredId0, ProcId, Vars, BIState, UContext, Name0),
- Goal, GoalInfo, ActualPurity) -->
- RunPostTypecheck =^ run_post_typecheck,
- PredInfo =^ pred_info,
- ModuleInfo =^ module_info,
- {
+:- pred compute_expr_purity(hlds_goal_expr::in, hlds_goal_expr::out,
+ hlds_goal_info::in, purity::out, purity_info::in, purity_info::out)
+ is det.
+
+compute_expr_purity(conj(Goals0), conj(Goals), _, Purity, !Info) :-
+ compute_goals_purity(Goals0, Goals, pure, Purity, !Info).
+compute_expr_purity(par_conj(Goals0), par_conj(Goals), _, Purity, !Info) :-
+ compute_goals_purity(Goals0, Goals, pure, Purity, !Info).
+compute_expr_purity(Goal0, Goal, GoalInfo, ActualPurity, !Info) :-
+ Goal0 = call(PredId0, ProcId, Vars, BIState, UContext, Name0),
+ RunPostTypecheck = !.Info ^ run_post_typecheck,
+ PredInfo = !.Info ^ pred_info,
+ ModuleInfo = !.Info ^ module_info,
+ (
RunPostTypecheck = yes,
- post_typecheck__resolve_pred_overloading(PredId0,
- Vars, PredInfo, ModuleInfo, Name0, Name, PredId),
+ post_typecheck__resolve_pred_overloading(Vars, PredInfo,
+ ModuleInfo, Name0, Name, PredId0, PredId),
(
% Convert any calls to private_builtin.unsafe_type_cast
% into unsafe_cast goals.
@@ -555,71 +542,69 @@
RunPostTypecheck = no,
PredId = PredId0,
Goal = Goal0
- },
- { infer_goal_info_purity(GoalInfo, DeclaredPurity) },
- { goal_info_get_context(GoalInfo, CallContext) },
-
+ ),
+ infer_goal_info_purity(GoalInfo, DeclaredPurity),
+ goal_info_get_context(GoalInfo, CallContext),
perform_goal_purity_checks(CallContext, PredId,
- DeclaredPurity, ActualPurity).
-
+ DeclaredPurity, ActualPurity, !Info).
compute_expr_purity(generic_call(GenericCall0, Args, Modes0, Det),
- GoalExpr, GoalInfo, Purity) -->
+ GoalExpr, GoalInfo, Purity, !Info) :-
(
- { GenericCall0 = higher_order(_, Purity, _, _) },
- { GoalExpr = generic_call(GenericCall0, Args, Modes0, Det) }
- ;
- { GenericCall0 = class_method(_, _, _, _) },
- { Purity = pure }, % XXX this is wrong!
- { GoalExpr = generic_call(GenericCall0, Args, Modes0, Det) }
+ GenericCall0 = higher_order(_, Purity, _, _),
+ GoalExpr = generic_call(GenericCall0, Args, Modes0, Det)
;
- { GenericCall0 = unsafe_cast },
- { Purity = pure },
- { GoalExpr = generic_call(GenericCall0, Args, Modes0, Det) }
- ;
- { GenericCall0 = aditi_builtin(Builtin0, CallId0) },
- { Purity = pure },
- { goal_info_get_context(GoalInfo, Context) },
- RunPostTypecheck =^ run_post_typecheck,
+ GenericCall0 = class_method(_, _, _, _),
+ Purity = pure, % XXX this is wrong!
+ GoalExpr = generic_call(GenericCall0, Args, Modes0, Det)
+ ;
+ GenericCall0 = unsafe_cast,
+ Purity = pure,
+ GoalExpr = generic_call(GenericCall0, Args, Modes0, Det)
+ ;
+ GenericCall0 = aditi_builtin(Builtin0, CallId0),
+ Purity = pure,
+ goal_info_get_context(GoalInfo, Context),
+ RunPostTypecheck = !.Info ^ run_post_typecheck,
(
- { RunPostTypecheck = yes },
- ModuleInfo =^ module_info,
- PredInfo =^ pred_info,
- { post_typecheck__finish_aditi_builtin(ModuleInfo,
+ RunPostTypecheck = yes,
+ ModuleInfo = !.Info ^ module_info,
+ PredInfo = !.Info ^ pred_info,
+ post_typecheck__finish_aditi_builtin(ModuleInfo,
PredInfo, Args, Context, Builtin0, Builtin,
- CallId0, CallId, Modes, MaybeMessage) },
+ CallId0, CallId, Modes, MaybeMessage),
(
- { MaybeMessage = yes(Message) },
+ MaybeMessage = yes(Message),
purity_info_add_message(
- error(aditi_builtin_error(Message)))
+ error(aditi_builtin_error(Message)),
+ !Info)
;
- { MaybeMessage = no }
+ MaybeMessage = no
),
- { GenericCall = aditi_builtin(Builtin, CallId) }
+ GenericCall = aditi_builtin(Builtin, CallId)
;
- { RunPostTypecheck = no },
- { GenericCall = GenericCall0 },
- { Modes = Modes0 }
+ RunPostTypecheck = no,
+ GenericCall = GenericCall0,
+ Modes = Modes0
),
-
- { GoalExpr = generic_call(GenericCall, Args, Modes, Det) }
+ GoalExpr = generic_call(GenericCall, Args, Modes, Det)
).
compute_expr_purity(switch(Var, Canfail, Cases0),
- switch(Var, Canfail, Cases), _, Purity) -->
- compute_cases_purity(Cases0, Cases, pure, Purity).
-compute_expr_purity(Unif0, GoalExpr, GoalInfo, ActualPurity) -->
- { Unif0 = unify(Var, RHS0, Mode, Unification, UnifyContext) },
- (
- { RHS0 = lambda_goal(LambdaPurity, F, EvalMethod,
- FixModes, H, Vars, Modes0, K, Goal0 - Info0) }
- ->
- { RHS = lambda_goal(LambdaPurity, F, EvalMethod,
- modes_are_ok, H, Vars, Modes, K, Goal - Info0) },
- compute_expr_purity(Goal0, Goal, Info0, GoalPurity),
- check_closure_purity(GoalInfo, LambdaPurity, GoalPurity),
-
- VarTypes =^ vartypes,
+ switch(Var, Canfail, Cases), _, Purity, !Info) :-
+ compute_cases_purity(Cases0, Cases, pure, Purity, !Info).
+compute_expr_purity(Unif0, GoalExpr, GoalInfo, ActualPurity, !Info) :-
+ Unif0 = unify(Var, RHS0, Mode, Unification, UnifyContext),
+ (
+ RHS0 = lambda_goal(LambdaPurity, F, EvalMethod,
+ FixModes, H, Vars, Modes0, K, Goal0 - Info0)
+ ->
+ RHS = lambda_goal(LambdaPurity, F, EvalMethod,
+ modes_are_ok, H, Vars, Modes, K, Goal - Info0),
+ compute_expr_purity(Goal0, Goal, Info0, GoalPurity, !Info),
+ check_closure_purity(GoalInfo, LambdaPurity, GoalPurity,
+ !Info),
- {
+ VarTypes = !.Info ^ vartypes,
+ (
FixModes = modes_are_ok,
Modes = Modes0
;
@@ -638,151 +623,148 @@
SeenState = no,
fix_aditi_state_modes(SeenState, StateMode,
LambdaVarTypes, Modes0, Modes)
- },
- { GoalExpr = unify(Var, RHS, Mode, Unification, UnifyContext) },
+ ),
+ GoalExpr = unify(Var, RHS, Mode, Unification, UnifyContext),
% the unification itself is always pure,
% even if the lambda expression body is impure
- { ActualPurity = (pure) }
+ ActualPurity = (pure)
;
- { RHS0 = functor(ConsId, _, Args) }
+ RHS0 = functor(ConsId, _, Args)
->
- RunPostTypecheck =^ run_post_typecheck,
+ RunPostTypecheck = !.Info ^ run_post_typecheck,
(
- { RunPostTypecheck = yes },
- ModuleInfo =^ module_info,
- PredInfo0 =^ pred_info,
- VarTypes0 =^ vartypes,
- VarSet0 =^ varset,
- { post_typecheck__resolve_unify_functor(Var, ConsId,
+ RunPostTypecheck = yes,
+ ModuleInfo = !.Info ^ module_info,
+ PredInfo0 = !.Info ^ pred_info,
+ VarTypes0 = !.Info ^ vartypes,
+ VarSet0 = !.Info ^ varset,
+ post_typecheck__resolve_unify_functor(Var, ConsId,
Args, Mode, Unification, UnifyContext,
GoalInfo, ModuleInfo, PredInfo0, PredInfo,
- VarTypes0, VarTypes, VarSet0, VarSet, Goal1) },
- ^ vartypes := VarTypes,
- ^ varset := VarSet,
- ^ pred_info := PredInfo
+ VarTypes0, VarTypes, VarSet0, VarSet, Goal1),
+ !:Info = !.Info ^ vartypes := VarTypes,
+ !:Info = !.Info ^ varset := VarSet,
+ !:Info = !.Info ^ pred_info := PredInfo
;
- { RunPostTypecheck = no },
- { Goal1 = Unif0 - GoalInfo }
+ RunPostTypecheck = no,
+ Goal1 = Unif0 - GoalInfo
),
(
- { Goal1 = unify(_, _, _, _, _) - _ }
+ Goal1 = unify(_, _, _, _, _) - _
->
check_higher_order_purity(GoalInfo, ConsId,
- Var, Args, ActualPurity),
- { Goal = Goal1 }
+ Var, Args, ActualPurity, !Info),
+ Goal = Goal1
;
- compute_goal_purity(Goal1, Goal, ActualPurity)
+ compute_goal_purity(Goal1, Goal, ActualPurity, !Info)
),
- { Goal = GoalExpr - _ }
+ Goal = GoalExpr - _
;
- { GoalExpr = Unif0 },
- { ActualPurity = pure }
+ GoalExpr = Unif0,
+ ActualPurity = pure
).
-compute_expr_purity(disj(Goals0), disj(Goals), _, Purity) -->
- compute_goals_purity(Goals0, Goals, pure, Purity).
-compute_expr_purity(not(Goal0), NotGoal, GoalInfo0, Purity) -->
+compute_expr_purity(disj(Goals0), disj(Goals), _, Purity, !Info) :-
+ compute_goals_purity(Goals0, Goals, pure, Purity, !Info).
+compute_expr_purity(not(Goal0), NotGoal, GoalInfo0, Purity, !Info) :-
%
% eliminate double negation
%
- { negate_goal(Goal0, GoalInfo0, NotGoal0) },
- ( { NotGoal0 = not(Goal1) - _GoalInfo1 } ->
- compute_goal_purity(Goal1, Goal, Purity),
- { NotGoal = not(Goal) }
+ negate_goal(Goal0, GoalInfo0, NotGoal0),
+ ( NotGoal0 = not(Goal1) - _GoalInfo1 ->
+ compute_goal_purity(Goal1, Goal, Purity, !Info),
+ NotGoal = not(Goal)
;
- compute_goal_purity(NotGoal0, NotGoal1, Purity),
- { NotGoal1 = NotGoal - _ }
+ compute_goal_purity(NotGoal0, NotGoal1, Purity, !Info),
+ NotGoal1 = NotGoal - _
).
compute_expr_purity(some(Vars, CanRemove, Goal0), some(Vars, CanRemove, Goal),
- _, Purity) -->
- compute_goal_purity(Goal0, Goal, Purity).
+ _, Purity, !Info) :-
+ compute_goal_purity(Goal0, Goal, Purity, !Info).
compute_expr_purity(if_then_else(Vars, Cond0, Then0, Else0),
- if_then_else(Vars, Cond, Then, Else), _, Purity) -->
- compute_goal_purity(Cond0, Cond, Purity1),
- compute_goal_purity(Then0, Then, Purity2),
- compute_goal_purity(Else0, Else, Purity3),
- { worst_purity(Purity1, Purity2, Purity12) },
- { worst_purity(Purity12, Purity3, Purity) }.
-compute_expr_purity(ForeignProc0, ForeignProc, _, Purity) -->
- { ForeignProc0 = foreign_proc(_, _, _, _, _, _, _) },
- { Attributes = ForeignProc0 ^ foreign_attr },
- { PredId = ForeignProc0 ^ foreign_pred_id },
- ModuleInfo =^ module_info,
- {
- legacy_purity_behaviour(Attributes, yes)
- ->
+ if_then_else(Vars, Cond, Then, Else), _, Purity, !Info) :-
+ compute_goal_purity(Cond0, Cond, Purity1, !Info),
+ compute_goal_purity(Then0, Then, Purity2, !Info),
+ compute_goal_purity(Else0, Else, Purity3, !Info),
+ worst_purity(Purity1, Purity2) = Purity12,
+ worst_purity(Purity12, Purity3) = Purity.
+compute_expr_purity(ForeignProc0, ForeignProc, _, Purity, !Info) :-
+ ForeignProc0 = foreign_proc(_, _, _, _, _, _, _),
+ Attributes = ForeignProc0 ^ foreign_attr,
+ PredId = ForeignProc0 ^ foreign_pred_id,
+ ModuleInfo = !.Info ^ module_info,
+ ( legacy_purity_behaviour(Attributes) = yes ->
% get the purity from the declaration, and set it
% here so that it is correct for later use
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_purity(PredInfo, Purity),
- set_purity(Attributes, Purity, NewAttributes),
+ set_purity(Purity, Attributes, NewAttributes),
ForeignProc = ForeignProc0 ^ foreign_attr := NewAttributes
;
ForeignProc = ForeignProc0,
- purity(Attributes, AttributesPurity),
- Purity = AttributesPurity
- }.
+ Purity = purity(Attributes)
+ ).
-compute_expr_purity(shorthand(_), _, _, _) -->
+compute_expr_purity(shorthand(_), _, _, _, !Info) :-
% these should have been expanded out by now
- { error("compute_expr_purity: unexpected shorthand") }.
+ error("compute_expr_purity: unexpected shorthand").
+:- pred check_higher_order_purity(hlds_goal_info::in, cons_id::in,
+ prog_var::in, list(prog_var)::in, purity::out,
+ purity_info::in, purity_info::out) is det.
-:- pred check_higher_order_purity(hlds_goal_info, cons_id, prog_var,
- list(prog_var), purity, purity_info, purity_info).
-:- mode check_higher_order_purity(in, in, in, in, out, in, out) is det.
-check_higher_order_purity(GoalInfo, ConsId, Var, Args, ActualPurity) -->
+check_higher_order_purity(GoalInfo, ConsId, Var, Args, ActualPurity, !Info) :-
%
% Check that the purity of the ConsId matches the purity of the
% variable's type.
%
- VarTypes =^ vartypes,
- { map__lookup(VarTypes, Var, TypeOfVar) },
+ VarTypes = !.Info ^ vartypes,
+ map__lookup(VarTypes, Var, TypeOfVar),
(
- { ConsId = cons(PName, _) },
- { type_is_higher_order(TypeOfVar, TypePurity, PredOrFunc,
- _EvalMethod, VarArgTypes) }
- ->
- PredInfo =^ pred_info,
- { pred_info_typevarset(PredInfo, TVarSet) },
- { map__apply_to_list(Args, VarTypes, ArgTypes0) },
- { list__append(ArgTypes0, VarArgTypes, PredArgTypes) },
- ModuleInfo =^ module_info,
- CallerPredInfo =^ pred_info,
- { pred_info_get_markers(CallerPredInfo, CallerMarkers) },
+ ConsId = cons(PName, _),
+ type_is_higher_order(TypeOfVar, TypePurity, PredOrFunc,
+ _EvalMethod, VarArgTypes)
+ ->
+ PredInfo = !.Info ^ pred_info,
+ pred_info_typevarset(PredInfo, TVarSet),
+ map__apply_to_list(Args, VarTypes, ArgTypes0),
+ list__append(ArgTypes0, VarArgTypes, PredArgTypes),
+ ModuleInfo = !.Info ^ module_info,
+ CallerPredInfo = !.Info ^ pred_info,
+ pred_info_get_markers(CallerPredInfo, CallerMarkers),
(
- { get_pred_id(calls_are_fully_qualified(CallerMarkers),
+ get_pred_id(calls_are_fully_qualified(CallerMarkers),
PName, PredOrFunc, TVarSet, PredArgTypes,
- ModuleInfo, CalleePredId) }
+ ModuleInfo, CalleePredId)
->
- { module_info_pred_info(ModuleInfo,
- CalleePredId, CalleePredInfo) },
- { pred_info_get_purity(CalleePredInfo, CalleePurity) },
+ module_info_pred_info(ModuleInfo,
+ CalleePredId, CalleePredInfo),
+ pred_info_get_purity(CalleePredInfo, CalleePurity),
check_closure_purity(GoalInfo, TypePurity,
- CalleePurity)
+ CalleePurity, !Info)
;
% If we can't find the type of the function,
% it's because typecheck couldn't give it one.
% Typechecking gives an error in this case, we
% just keep silent.
- []
+ true
)
;
- []
+ true
),
% The unification itself is always pure,
% even if it is a unification with an impure higher-order term.
- { ActualPurity = pure },
+ ActualPurity = pure,
% Check for a bogus purity annotation on the unification
- { infer_goal_info_purity(GoalInfo, DeclaredPurity) },
- ( { DeclaredPurity \= pure } ->
- { goal_info_get_context(GoalInfo, Context) },
- { Message = impure_unification_expr_error(Context,
- DeclaredPurity) },
- purity_info_add_message(error(Message))
+ infer_goal_info_purity(GoalInfo, DeclaredPurity),
+ ( DeclaredPurity \= pure ->
+ goal_info_get_context(GoalInfo, Context),
+ Message = impure_unification_expr_error(Context,
+ DeclaredPurity),
+ purity_info_add_message(error(Message), !Info)
;
- []
+ true
).
% the possible results of a purity check
@@ -806,6 +788,7 @@
% Promised: Did we promise this pred as pure?
:- pred perform_pred_purity_checks(pred_info::in, purity::in, purity::in,
purity::in, purity_check_result::out) is det.
+
perform_pred_purity_checks(PredInfo, ActualPurity, DeclaredPurity,
PromisedPurity, PurityCheckResult) :-
(
@@ -878,88 +861,84 @@
:- pred perform_goal_purity_checks(prog_context::in, pred_id::in, purity::in,
purity::out, purity_info::in, purity_info::out) is det.
-perform_goal_purity_checks(Context, PredId, DeclaredPurity, ActualPurity) -->
- ModuleInfo =^ module_info,
- PredInfo =^ pred_info,
- { module_info_pred_info(ModuleInfo, PredId, CalleePredInfo) },
- { pred_info_get_purity(CalleePredInfo, ActualPurity) },
+perform_goal_purity_checks(Context, PredId, DeclaredPurity, ActualPurity,
+ !Info) :-
+ ModuleInfo = !.Info ^ module_info,
+ PredInfo = !.Info ^ pred_info,
+ module_info_pred_info(ModuleInfo, PredId, CalleePredInfo),
+ pred_info_get_purity(CalleePredInfo, ActualPurity),
(
% The purity of the callee should match the
% purity declared at the call
- { ActualPurity = DeclaredPurity }
+ ActualPurity = DeclaredPurity
->
- []
+ true
;
% Don't require purity annotations on calls in
% compiler-generated code.
- { is_unify_or_compare_pred(PredInfo) }
+ is_unify_or_compare_pred(PredInfo)
->
- []
+ true
;
- { less_pure(ActualPurity, DeclaredPurity) }
+ less_pure(ActualPurity, DeclaredPurity)
->
purity_info_add_message(
- error(missing_body_impurity_error(Context, PredId)))
+ error(missing_body_impurity_error(Context, PredId)),
+ !Info)
;
% We don't warn about exaggerated impurity decls in
% class methods or instance methods --- it just
% means that the predicate provided as an
% implementation was more pure than necessary.
- { pred_info_get_markers(PredInfo, Markers) },
- {
+ pred_info_get_markers(PredInfo, Markers),
+ (
check_marker(Markers, class_method)
;
check_marker(Markers, class_instance_method)
- }
+ )
->
- []
+ true
;
purity_info_add_message(
warning(unnecessary_body_impurity_decl(Context,
- PredId, DeclaredPurity)))
+ PredId, DeclaredPurity)),
+ !Info)
).
-:- pred compute_goal_purity(hlds_goal, hlds_goal,
- purity, purity_info, purity_info).
-:- mode compute_goal_purity(in, out, out, in, out) is det.
-
-compute_goal_purity(Goal0 - GoalInfo0, Goal - GoalInfo, Purity) -->
- compute_expr_purity(Goal0, Goal, GoalInfo0, Purity),
- { add_goal_info_purity_feature(GoalInfo0, Purity, GoalInfo) }.
+:- pred compute_goal_purity(hlds_goal::in, hlds_goal::out, purity::out,
+ purity_info::in, purity_info::out) is det.
+compute_goal_purity(Goal0 - GoalInfo0, Goal - GoalInfo, Purity, !Info) :-
+ compute_expr_purity(Goal0, Goal, GoalInfo0, Purity, !Info),
+ add_goal_info_purity_feature(GoalInfo0, Purity, GoalInfo).
% Compute the purity of a list of hlds_goals. Since the purity of a
% disjunction is computed the same way as the purity of a conjunction, we use
% the same code for both
-:- pred compute_goals_purity(list(hlds_goal), list(hlds_goal),
- purity, purity, purity_info, purity_info).
-:- mode compute_goals_purity(in, out, in, out, in, out) is det.
-
-compute_goals_purity([], [], Purity, Purity) --> [].
-compute_goals_purity([Goal0|Goals0], [Goal|Goals], Purity0, Purity) -->
- compute_goal_purity(Goal0, Goal, Purity1),
- { worst_purity(Purity0, Purity1, Purity2) },
- compute_goals_purity(Goals0, Goals, Purity2, Purity).
-
+:- pred compute_goals_purity(list(hlds_goal)::in, list(hlds_goal)::out,
+ purity::in, purity::out, purity_info::in, purity_info::out) is det.
-
-:- pred compute_cases_purity(list(case), list(case),
- purity, purity, purity_info, purity_info).
-:- mode compute_cases_purity(in, out, in, out, in, out) is det.
-
-compute_cases_purity([], [], Purity, Purity) --> [].
-compute_cases_purity([case(Ctor,Goal0)|Goals0], [case(Ctor,Goal)|Goals],
- Purity0, Purity) -->
- compute_goal_purity(Goal0, Goal, Purity1),
- { worst_purity(Purity0, Purity1, Purity2) },
- compute_cases_purity(Goals0, Goals, Purity2, Purity).
+compute_goals_purity([], [], !Purity, !Info).
+compute_goals_purity([Goal0 | Goals0], [Goal | Goals], !Purity, !Info) :-
+ compute_goal_purity(Goal0, Goal, GoalPurity, !Info),
+ worst_purity(GoalPurity, !.Purity) = !:Purity,
+ compute_goals_purity(Goals0, Goals, !Purity, !Info).
+
+:- pred compute_cases_purity(list(case)::in, list(case)::out,
+ purity::in, purity::out, purity_info::in, purity_info::out) is det.
+
+compute_cases_purity([], [], !Purity, !Info).
+compute_cases_purity([case(Ctor, Goal0) | Cases0], [case(Ctor, Goal) | Cases],
+ !Purity, !Info) :-
+ compute_goal_purity(Goal0, Goal, GoalPurity, !Info),
+ worst_purity(GoalPurity, !.Purity) = !:Purity,
+ compute_cases_purity(Cases0, Cases, !Purity, !Info).
% Make sure lambda expressions introduced by the compiler
% have the correct mode for their `aditi__state' arguments.
-:- pred fix_aditi_state_modes(bool, (mode), list(type),
- list(mode), list(mode)).
-:- mode fix_aditi_state_modes(in, in, in, in, out) is det.
+:- pred fix_aditi_state_modes(bool::in, (mode)::in, list(type)::in,
+ list(mode)::in, list(mode)::out) is det.
fix_aditi_state_modes(_, _, [], [], []).
fix_aditi_state_modes(_, _, [_|_], [], []) :-
@@ -990,9 +969,8 @@
%-----------------------------------------------------------------------------%
-:- pred error_inconsistent_promise(module_info, pred_info, pred_id, purity,
- io__state, io__state).
-:- mode error_inconsistent_promise(in, in, in, in, di, uo) is det.
+:- pred error_inconsistent_promise(module_info::in, pred_info::in,
+ pred_id::in, purity::in, io__state::di, io__state::uo) is det.
error_inconsistent_promise(ModuleInfo, PredInfo, PredId, Purity) -->
{ pred_info_context(PredInfo, Context) },
@@ -1016,10 +994,9 @@
[]
).
-
-:- pred warn_exaggerated_impurity_decl(module_info, pred_info, pred_id,
- purity, purity, io__state, io__state).
-:- mode warn_exaggerated_impurity_decl(in, in, in, in, in, di, uo) is det.
+:- pred warn_exaggerated_impurity_decl(module_info::in, pred_info::in,
+ pred_id::in, purity::in, purity::in,
+ io__state::di, io__state::uo) is det.
warn_exaggerated_impurity_decl(ModuleInfo, PredInfo, PredId,
DeclPurity, AcutalPurity) -->
@@ -1032,9 +1009,8 @@
write_purity(AcutalPurity),
io__write_string(".\n").
-:- pred warn_unnecessary_promise_pure(module_info, pred_info, pred_id, purity,
- io__state, io__state).
-:- mode warn_unnecessary_promise_pure(in, in, in, in, di, uo) is det.
+:- pred warn_unnecessary_promise_pure(module_info::in, pred_info::in,
+ pred_id::in, purity::in, io__state::di, io__state::uo) is det.
warn_unnecessary_promise_pure(ModuleInfo, PredInfo, PredId, PromisedPurity) -->
{ pred_info_context(PredInfo, Context) },
@@ -1073,10 +1049,8 @@
[]
).
-
-:- pred error_inferred_impure(module_info, pred_info, pred_id, purity,
- io__state, io__state).
-:- mode error_inferred_impure(in, in, in, in, di, uo) is det.
+:- pred error_inferred_impure(module_info::in, pred_info::in, pred_id::in,
+ purity::in, io__state::di, io__state::uo) is det.
error_inferred_impure(ModuleInfo, PredInfo, PredId, Purity) -->
{ pred_info_context(PredInfo, Context) },
@@ -1120,9 +1094,8 @@
:- type post_typecheck_warning
---> unnecessary_body_impurity_decl(prog_context, pred_id, purity).
-:- pred report_post_typecheck_message(module_info, post_typecheck_message,
- io__state, io__state).
-:- mode report_post_typecheck_message(in, in, di, uo) is det.
+:- pred report_post_typecheck_message(module_info::in,
+ post_typecheck_message::in, io__state::di, io__state::uo) is det.
report_post_typecheck_message(ModuleInfo, error(Message)) -->
io__set_exit_status(1),
@@ -1155,9 +1128,8 @@
warn_unnecessary_body_impurity_decl(ModuleInfo, PredId, Context,
DeclaredPurity).
-:- pred error_missing_body_impurity_decl(module_info, pred_id,
- prog_context, io__state, io__state).
-:- mode error_missing_body_impurity_decl(in, in, in, di, uo) is det.
+:- pred error_missing_body_impurity_decl(module_info::in, pred_id::in,
+ prog_context::in, io__state::di, io__state::uo) is det.
error_missing_body_impurity_decl(ModuleInfo, PredId, Context) -->
prog_out__write_context(Context),
@@ -1175,18 +1147,16 @@
write_purity(Purity),
io__write_string("' indicator.\n")
;
- io__write_string(" purity error: call must be in an explicit unification\n"),
+ io__write_string(" purity error: call must be " ++
+ "in an explicit unification\n"),
prog_out__write_context(Context),
io__write_string(" which is preceded by `"),
write_purity(Purity),
io__write_string("' indicator.\n")
-
).
-:- pred warn_unnecessary_body_impurity_decl(module_info, pred_id,
- prog_context, purity, io__state, io__state).
-:- mode warn_unnecessary_body_impurity_decl(in, in, in, in, di, uo)
- is det.
+:- pred warn_unnecessary_body_impurity_decl(module_info::in, pred_id::in,
+ prog_context::in, purity::in, io__state::di, io__state::uo) is det.
warn_unnecessary_body_impurity_decl(ModuleInfo, PredId, Context,
DeclaredPurity) -->
@@ -1209,9 +1179,8 @@
io__write_string("' is sufficient.\n")
).
-:- pred check_closure_purity(hlds_goal_info, purity, purity,
- purity_info, purity_info).
-:- mode check_closure_purity(in, in, in, in, out) is det.
+:- pred check_closure_purity(hlds_goal_info::in, purity::in, purity::in,
+ purity_info::in, purity_info::out) is det.
check_closure_purity(GoalInfo, DeclaredPurity, ActualPurity) -->
( { ActualPurity `less_pure` DeclaredPurity } ->
@@ -1225,9 +1194,8 @@
[]
).
-:- pred report_error_closure_purity(prog_context, purity, purity,
- io__state, io__state).
-:- mode report_error_closure_purity(in, in, in, di, uo) is det.
+:- pred report_error_closure_purity(prog_context::in, purity::in, purity::in,
+ io__state::di, io__state::uo) is det.
report_error_closure_purity(Context, _DeclaredPurity, ActualPurity) -->
prog_out__write_context(Context),
@@ -1239,9 +1207,8 @@
write_purity(ActualPurity),
io__write_string(".'\n").
-:- pred write_context_and_pred_id(module_info, pred_info, pred_id,
- io__state, io__state).
-:- mode write_context_and_pred_id(in, in, in, di, uo) is det.
+:- pred write_context_and_pred_id(module_info::in, pred_info::in, pred_id::in,
+ io__state::di, io__state::uo) is det.
write_context_and_pred_id(ModuleInfo, PredInfo, PredId) -->
{ pred_info_context(PredInfo, Context) },
@@ -1252,7 +1219,8 @@
impure_unification_expr_error(Context, Purity) -->
prog_out__write_context(Context),
- io__write_string("Purity error: unification with expression was declared\n"),
+ io__write_string(
+ "Purity error: unification with expression was declared\n"),
prog_out__write_context(Context),
io__write_string(" "),
write_purity(Purity),
@@ -1273,9 +1241,8 @@
messages :: post_typecheck_messages
).
-:- pred purity_info_add_message(post_typecheck_message,
- purity_info, purity_info).
-:- mode purity_info_add_message(in, in, out) is det.
+:- pred purity_info_add_message(post_typecheck_message::in,
+ purity_info::in, purity_info::out) is det.
purity_info_add_message(Message, Info,
Info ^ messages := [Message | Info ^ messages]).
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.126
diff -u -b -r1.126 simplify.m
--- compiler/simplify.m 1 Dec 2003 15:55:49 -0000 1.126
+++ compiler/simplify.m 20 Dec 2003 08:26:39 -0000
@@ -635,7 +635,7 @@
; Cases = [case(ConsId, SingleGoal)] ->
% a singleton switch is equivalent to the goal itself with
% a possibly can_fail unification with the functor on the front.
- cons_id_arity(ConsId, Arity),
+ Arity = cons_id_arity(ConsId),
(
SwitchCanFail = can_fail,
MaybeConsIds \= yes([ConsId])
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.55
diff -u -b -r1.55 table_gen.m
--- compiler/table_gen.m 31 Oct 2003 03:27:29 -0000 1.55
+++ compiler/table_gen.m 18 Dec 2003 09:48:06 -0000
@@ -465,7 +465,7 @@
some [SubGoal,Attrs] (
goal_contains_goal(Goal, SubGoal),
SubGoal = foreign_proc(Attrs, _,_,_,_,_,_) - _,
- may_call_mercury(Attrs, MayCallMercuryAttr)
+ MayCallMercuryAttr = may_call_mercury(Attrs)
).
:- pred tabled_for_io_attributes(hlds_goal::in, list(tabled_for_io)::out)
@@ -481,7 +481,7 @@
some [SubGoal,Attrs] (
goal_contains_goal(Goal, SubGoal),
SubGoal = foreign_proc(Attrs, _,_,_,_,_,_) - _,
- tabled_for_io(Attrs, TabledForIoAttr),
+ TabledForIoAttr = tabled_for_io(Attrs),
\+ TabledForIoAttr = not_tabled_for_io
).
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.50
diff -u -b -r1.50 type_ctor_info.m
--- compiler/type_ctor_info.m 28 Nov 2003 20:40:13 -0000 1.50
+++ compiler/type_ctor_info.m 20 Dec 2003 08:23:59 -0000
@@ -589,7 +589,7 @@
list__length(FunctorArgs, Arity),
require(unify(Arity, 0),
"functor in enum has nonzero arity"),
- make_cons_id_from_qualified_sym_name(SymName, FunctorArgs, ConsId),
+ ConsId = make_cons_id_from_qualified_sym_name(SymName, FunctorArgs),
map__lookup(ConsTagMap, ConsId, ConsTag),
require(unify(ConsTag, int_constant(NextOrdinal0)),
"mismatch on constant assigned to functor in enum"),
@@ -682,7 +682,8 @@
Functor = ctor(ExistTvars, Constraints, SymName, ConstructorArgs),
list__length(ConstructorArgs, Arity),
unqualify_name(SymName, FunctorName),
- make_cons_id_from_qualified_sym_name(SymName, ConstructorArgs, ConsId),
+ ConsId = make_cons_id_from_qualified_sym_name(SymName,
+ ConstructorArgs),
map__lookup(ConsTagMap, ConsId, ConsTag),
type_ctor_info__process_cons_tag(ConsTag, ConsRep),
list__map(type_ctor_info__generate_du_arg_info(TypeArity, ExistTvars),
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.134
diff -u -b -r1.134 type_util.m
--- compiler/type_util.m 1 Dec 2003 15:55:50 -0000 1.134
+++ compiler/type_util.m 20 Dec 2003 08:26:52 -0000
@@ -32,25 +32,21 @@
% Succeed iff type is an "atomic" type - one which can be
% unified using a simple_test rather than a complicated_unify.
-:- pred type_is_atomic(type, module_info).
-:- mode type_is_atomic(in, in) is semidet.
+:- pred type_is_atomic((type)::in, module_info::in) is semidet.
-:- pred type_ctor_is_atomic(type_ctor, module_info).
-:- mode type_ctor_is_atomic(in, in) is semidet.
+:- pred type_ctor_is_atomic(type_ctor::in, module_info::in) is semidet.
% type_is_higher_order(Type, Purity, PredOrFunc, ArgTypes, EvalMeth):
% succeeds iff Type is a higher-order predicate or function type with
% the specified argument types (for functions, the return type is
% appended to the end of the argument types), purity, and
% evaluation method.
-:- pred type_is_higher_order(type, purity, pred_or_func,
- lambda_eval_method, list(type)).
-:- mode type_is_higher_order(in, out, out, out, out) is semidet.
+:- pred type_is_higher_order((type)::in, purity::out, pred_or_func::out,
+ lambda_eval_method::out, list(type)::out) is semidet.
% Succeed if the given type is a tuple type, returning
% the argument types.
-:- pred type_is_tuple(type, list(type)).
-:- mode type_is_tuple(in, out) is semidet.
+:- pred type_is_tuple((type)::in, list(type)::out) is semidet.
% type_has_variable_arity_ctor(Type, TypeCtor, TypeArgs)
% Check if the principal type constructor of Type is of variable arity.
@@ -61,13 +57,11 @@
% type_ctor_is_higher_order(TypeCtor, PredOrFunc) succeeds iff
% TypeCtor is a higher-order predicate or function type.
-:- pred type_ctor_is_higher_order(type_ctor, purity, pred_or_func,
- lambda_eval_method).
-:- mode type_ctor_is_higher_order(in, out, out, out) is semidet.
+:- pred type_ctor_is_higher_order(type_ctor::in, purity::out, pred_or_func::out,
+ lambda_eval_method::out) is semidet.
% type_ctor_is_tuple(TypeCtor) succeeds iff TypeCtor is a tuple type.
-:- pred type_ctor_is_tuple(type_ctor).
-:- mode type_ctor_is_tuple(in) is semidet.
+:- pred type_ctor_is_tuple(type_ctor::in) is semidet.
% The list of type_ctors which are builtins which do not have a
% hlds_type_defn.
@@ -83,19 +77,17 @@
%
% If the type is a type variable and thus has no principal type
% constructor, fail.
-:- pred type_has_user_defined_equality_pred(module_info, (type),
- unify_compare).
-:- mode type_has_user_defined_equality_pred(in, in, out) is semidet.
+:- pred type_has_user_defined_equality_pred(module_info::in, (type)::in,
+ unify_compare::out) is semidet.
:- pred type_body_has_user_defined_equality_pred(module_info::in,
hlds_type_body::in, unify_compare::out) is semidet.
% Succeed if the inst `any' can be considered `bound' for this type.
-:- pred type_util__is_solver_type(module_info, (type)).
-:- mode type_util__is_solver_type(in, in) is semidet.
+:- pred type_util__is_solver_type(module_info::in, (type)::in) is semidet.
-:- pred type_body_is_solver_type(module_info, hlds_type_body).
-:- mode type_body_is_solver_type(in, in) is semidet.
+:- pred type_body_is_solver_type(module_info::in, hlds_type_body::in)
+ is semidet.
% Certain types, e.g. io__state and store__store(S),
@@ -103,32 +95,28 @@
% there is no need to actually pass them, and so when
% importing or exporting procedures to/from C, we don't
% include arguments with these types.
-:- pred type_util__is_dummy_argument_type(type).
-:- mode type_util__is_dummy_argument_type(in) is semidet.
+:- pred type_util__is_dummy_argument_type((type)::in) is semidet.
-:- pred type_util__constructors_are_dummy_argument_type(list(constructor)).
-:- mode type_util__constructors_are_dummy_argument_type(in) is semidet.
+:- pred type_util__constructors_are_dummy_argument_type(list(constructor)::in)
+ is semidet.
-:- pred type_is_io_state(type).
-:- mode type_is_io_state(in) is semidet.
+:- pred type_is_io_state((type)::in) is semidet.
-:- pred type_is_aditi_state(type).
-:- mode type_is_aditi_state(in) is semidet.
+:- pred type_is_aditi_state((type)::in) is semidet.
-:- pred type_ctor_is_array(type_ctor).
-:- mode type_ctor_is_array(in) is semidet.
+:- pred type_ctor_is_array(type_ctor::in) is semidet.
% Remove an `aditi:state' from the given list if one is present.
-:- pred type_util__remove_aditi_state(list(type), list(T), list(T)).
-:- mode type_util__remove_aditi_state(in, in, out) is det.
+:- pred type_util__remove_aditi_state(list(type)::in, list(T)::in,
+ list(T)::out) is det.
% A test for types that are defined in Mercury, but whose definitions
% are `lies', i.e. they are not sufficiently accurate for RTTI
% structures describing the types. Since the RTTI will be hand defined,
% the compiler shouldn't generate RTTI for these types.
-:- pred type_ctor_has_hand_defined_rtti(type_ctor, hlds_type_body).
-:- mode type_ctor_has_hand_defined_rtti(in, in) is semidet.
+:- pred type_ctor_has_hand_defined_rtti(type_ctor::in, hlds_type_body::in)
+ is semidet.
% A test for type_info-related types that are introduced by
% polymorphism.m. These need to be handled specially in certain
@@ -136,11 +124,9 @@
% for these types, since it would not be useful, and since we
% want to minimize the number of different modes that we infer.
-:- pred is_introduced_type_info_type(type).
-:- mode is_introduced_type_info_type(in) is semidet.
+:- pred is_introduced_type_info_type((type)::in) is semidet.
-:- pred is_introduced_type_info_type_ctor(type_ctor).
-:- mode is_introduced_type_info_type_ctor(in) is semidet.
+:- pred is_introduced_type_info_type_ctor(type_ctor::in) is semidet.
:- func is_introduced_type_info_type_category(type_category) = bool.
@@ -186,8 +172,8 @@
% Given a non-variable type, return its type-id and argument types.
-:- pred type_to_ctor_and_args(type, type_ctor, list(type)).
-:- mode type_to_ctor_and_args(in, out, out) is semidet.
+:- pred type_to_ctor_and_args((type)::in, type_ctor::out, list(type)::out)
+ is semidet.
% Given a variable type, return its type variable.
@@ -201,20 +187,16 @@
% Given a type_ctor and a list of argument types,
% construct a type.
-:- pred construct_type(type_ctor, list(type), (type)).
-:- mode construct_type(in, in, out) is det.
+:- pred construct_type(type_ctor::in, list(type)::in, (type)::out) is det.
+
+:- pred construct_higher_order_type(purity::in, pred_or_func::in,
+ lambda_eval_method::in, list(type)::in, (type)::out) is det.
-:- pred construct_higher_order_type(purity, pred_or_func, lambda_eval_method,
- list(type), (type)).
-:- mode construct_higher_order_type(in, in, in, in, out) is det.
-
-:- pred construct_higher_order_pred_type(purity, lambda_eval_method,
- list(type), (type)).
-:- mode construct_higher_order_pred_type(in, in, in, out) is det.
-
-:- pred construct_higher_order_func_type(purity, lambda_eval_method,
- list(type), (type), (type)).
-:- mode construct_higher_order_func_type(in, in, in, in, out) is det.
+:- pred construct_higher_order_pred_type(purity::in, lambda_eval_method::in,
+ list(type)::in, (type)::out) is det.
+
+:- pred construct_higher_order_func_type(purity::in, lambda_eval_method::in,
+ list(type)::in, (type)::in, (type)::out) is det.
% Construct builtin types.
:- func int_type = (type).
@@ -236,24 +218,23 @@
% Given a constant and an arity, return a type_ctor.
% Fails if the constant is not an atom.
-:- pred make_type_ctor(const, int, type_ctor).
-:- mode make_type_ctor(in, in, out) is semidet.
+:- pred make_type_ctor(const::in, int::in, type_ctor::out) is semidet.
% Given a type_ctor, look up its module/name/arity
-:- pred type_util__type_ctor_module(module_info, type_ctor, module_name).
-:- mode type_util__type_ctor_module(in, in, out) is det.
+:- pred type_util__type_ctor_module(module_info::in, type_ctor::in,
+ module_name::out) is det.
-:- pred type_util__type_ctor_name(module_info, type_ctor, string).
-:- mode type_util__type_ctor_name(in, in, out) is det.
+:- pred type_util__type_ctor_name(module_info::in, type_ctor::in, string::out)
+ is det.
-:- pred type_util__type_ctor_arity(module_info, type_ctor, arity).
-:- mode type_util__type_ctor_arity(in, in, out) is det.
+:- pred type_util__type_ctor_arity(module_info::in, type_ctor::in, arity::out)
+ is det.
% If the type is a du type or a tuple type,
% return the list of its constructors.
-:- pred type_constructors(type, module_info, list(constructor)).
-:- mode type_constructors(in, in, out) is semidet.
+:- pred type_constructors((type)::in, module_info::in, list(constructor)::out)
+ is semidet.
% Given a type on which it is possible to have a complete switch,
% return the number of alternatives. (It is possible to have a complete
@@ -292,9 +273,8 @@
% functor's argument types; they will be left unbound,
% so the caller can find out the original types from the constructor
% definition. The caller must do that sustitution itself if required.
-:- pred type_util__get_type_and_cons_defn(module_info, (type), cons_id,
- hlds_type_defn, hlds_cons_defn).
-:- mode type_util__get_type_and_cons_defn(in, in, in, out, out) is det.
+:- pred type_util__get_type_and_cons_defn(module_info::in, (type)::in,
+ cons_id::in, hlds_type_defn::out, hlds_cons_defn::out) is det.
% Like type_util__get_type_and_cons_defn (above), except that it
% only returns the definition of the constructor, not the type.
@@ -318,11 +298,11 @@
% functor's argument types; they will be left unbound,
% so the caller can find out the original types from the constructor
% definition. The caller must do that sustitution itself if required.
-:- pred type_util__get_existq_cons_defn(module_info::in,
- (type)::in, cons_id::in, ctor_defn::out) is semidet.
+:- pred type_util__get_existq_cons_defn(module_info::in, (type)::in,
+ cons_id::in, ctor_defn::out) is semidet.
-:- pred type_util__is_existq_cons(module_info::in,
- (type)::in, cons_id::in) is semidet.
+:- pred type_util__is_existq_cons(module_info::in, (type)::in, cons_id::in)
+ is semidet.
% This type is used to return information about a constructor
% definition, extracted from the hlds_type_defn and hlds_cons_defn
@@ -341,8 +321,8 @@
% whose one constructor has only one argument),
% and if so, return its constructor symbol and argument type.
-:- pred type_is_no_tag_type(module_info, type, sym_name, type).
-:- mode type_is_no_tag_type(in, in, out, out) is semidet.
+:- pred type_is_no_tag_type(module_info::in, (type)::in, sym_name::out,
+ (type)::out) is semidet.
% Check whether some constructors are a no_tag type
% (i.e. one with only one constructor, and
@@ -355,23 +335,20 @@
% you should use type_is_no_tag_type/4, or if you really know
% what you are doing, perform the checks yourself.
-:- pred type_constructors_are_no_tag_type(list(constructor), sym_name, type,
- maybe(string)).
-:- mode type_constructors_are_no_tag_type(in, out, out, out) is semidet.
+:- pred type_constructors_are_no_tag_type(list(constructor)::in, sym_name::out,
+ (type)::out, maybe(string)::out) is semidet.
% Given a list of constructors for a type, check whether that
% type is a private_builtin:type_info/n or similar type.
-:- pred type_constructors_are_type_info(list(constructor)).
-:- mode type_constructors_are_type_info(in) is semidet.
+:- pred type_constructors_are_type_info(list(constructor)::in) is semidet.
% type_constructors_should_be_no_tag(Ctors, ReservedTag, Globals,
% FunctorName, FunctorArgType, MaybeFunctorArgName):
% Check whether some constructors are a no_tag type, and that this
% is compatible with the ReservedTag setting for this type and
% the grade options set in the globals.
-:- pred type_constructors_should_be_no_tag(list(constructor), bool, globals,
- sym_name, type, maybe(string)).
-:- mode type_constructors_should_be_no_tag(in, in, in, out, out, out)
+:- pred type_constructors_should_be_no_tag(list(constructor)::in, bool::in,
+ globals::in, sym_name::out, (type)::out, maybe(string)::out)
is semidet.
% Unify (with occurs check) two types with respect to a type
@@ -379,35 +356,33 @@
% The third argument is a list of type variables which cannot
% be bound (i.e. head type variables).
-:- pred type_unify(type, type, list(tvar), tsubst, tsubst).
-:- mode type_unify(in, in, in, in, out) is semidet.
+:- pred type_unify((type)::in, (type)::in, list(tvar)::in, tsubst::in,
+ tsubst::out) is semidet.
-:- pred type_unify_list(list(type), list(type), list(tvar), tsubst, tsubst).
-:- mode type_unify_list(in, in, in, in, out) is semidet.
+:- pred type_unify_list(list(type)::in, list(type)::in, list(tvar)::in,
+ tsubst::in, tsubst::out) is semidet.
% Return a list of the type variables of a type.
-:- pred type_util__vars(type, list(tvar)).
-:- mode type_util__vars(in, out) is det.
+:- pred type_util__vars((type)::in, list(tvar)::out) is det.
% Return a list of the type variables of a type,
% ignoring any type variables if the variable in
% question is a type-info
-:- pred type_util__real_vars(type, list(tvar)).
-:- mode type_util__real_vars(in, out) is det.
+:- pred type_util__real_vars((type)::in, list(tvar)::out) is det.
% type_list_subsumes(TypesA, TypesB, Subst) succeeds iff the list
% TypesA subsumes (is more general than) TypesB, producing a
% type substitution which when applied to TypesA will give TypesB.
-:- pred type_list_subsumes(list(type), list(type), tsubst).
-:- mode type_list_subsumes(in, in, out) is semidet.
+:- pred type_list_subsumes(list(type)::in, list(type)::in, tsubst::out)
+ is semidet.
% This does the same as type_list_subsumes, but aborts instead of
% failing.
-:- pred type_list_subsumes_det(list(type), list(type), tsubst).
-:- mode type_list_subsumes_det(in, in, out) is det.
+:- pred type_list_subsumes_det(list(type)::in, list(type)::in, tsubst::out)
+ is det.
% arg_type_list_subsumes(TVarSet, ArgTypes,
% CalleeTVarSet, CalleeExistQVars, CalleeArgTypes).
@@ -417,24 +392,21 @@
% arguments of the call. This checks that none
% of the existentially quantified type variables of
% the callee are bound.
-:- pred arg_type_list_subsumes(tvarset, list(type),
- tvarset, existq_tvars, list(type)).
-:- mode arg_type_list_subsumes(in, in, in, in, in) is semidet.
+:- pred arg_type_list_subsumes(tvarset::in, list(type)::in,
+ tvarset::in, existq_tvars::in, list(type)::in) is semidet.
% apply a type substitution (i.e. map from tvar -> type)
% to all the types in a variable typing (i.e. map from var -> type).
-:- pred apply_substitution_to_type_map(map(prog_var, type), tsubst,
- map(prog_var, type)).
-:- mode apply_substitution_to_type_map(in, in, out) is det.
+:- pred apply_substitution_to_type_map(map(prog_var, type)::in, tsubst::in,
+ map(prog_var, type)::out) is det.
% same thing as above, except for a recursive substitution
% (i.e. we keep applying the substitution recursively until
% there are no more changes).
-:- pred apply_rec_substitution_to_type_map(map(prog_var, type), tsubst,
- map(prog_var, type)).
-:- mode apply_rec_substitution_to_type_map(in, in, out) is det.
+:- pred apply_rec_substitution_to_type_map(map(prog_var, type)::in, tsubst::in,
+ map(prog_var, type)::out) is det.
% Update a map from tvar to type_info_locn, using the type renaming
% and substitution to rename tvars and a variable substitution to
@@ -444,9 +416,9 @@
% If tvar maps to a another type variable, we keep the new
% variable, if it maps to a type, we remove it from the map.
-:- pred apply_substitutions_to_var_map(map(tvar, type_info_locn), tsubst,
- map(tvar, type), map(prog_var, prog_var), map(tvar, type_info_locn)).
-:- mode apply_substitutions_to_var_map(in, in, in, in, out) is det.
+:- pred apply_substitutions_to_var_map(map(tvar, type_info_locn)::in,
+ tsubst::in, map(tvar, type)::in, map(prog_var, prog_var)::in,
+ map(tvar, type_info_locn)::out) is det.
% Update a map from class_constraint to var, using the type renaming
% and substitution to rename tvars and a variable substition to
@@ -454,64 +426,52 @@
% substitution.
:- pred apply_substitutions_to_typeclass_var_map(
- map(class_constraint, prog_var), tsubst, map(tvar, type),
- map(prog_var, prog_var), map(class_constraint, prog_var)).
-:- mode apply_substitutions_to_typeclass_var_map(in, in, in, in, out) is det.
-
-:- pred apply_rec_subst_to_constraints(tsubst, class_constraints,
- class_constraints).
-:- mode apply_rec_subst_to_constraints(in, in, out) is det.
-
-:- pred apply_rec_subst_to_constraint_list(tsubst,
- list(class_constraint), list(class_constraint)).
-:- mode apply_rec_subst_to_constraint_list(in, in, out) is det.
-
-:- pred apply_rec_subst_to_constraint(tsubst, class_constraint,
- class_constraint).
-:- mode apply_rec_subst_to_constraint(in, in, out) is det.
-
-:- pred apply_subst_to_constraints(tsubst, class_constraints,
- class_constraints).
-:- mode apply_subst_to_constraints(in, in, out) is det.
-
-:- pred apply_subst_to_constraint_list(tsubst, list(class_constraint),
- list(class_constraint)).
-:- mode apply_subst_to_constraint_list(in, in, out) is det.
-
-:- pred apply_subst_to_constraint(tsubst, class_constraint,
- class_constraint).
-:- mode apply_subst_to_constraint(in, in, out) is det.
-
-:- pred apply_subst_to_constraint_proofs(tsubst,
- map(class_constraint, constraint_proof),
- map(class_constraint, constraint_proof)).
-:- mode apply_subst_to_constraint_proofs(in, in, out) is det.
-
-:- pred apply_rec_subst_to_constraint_proofs(tsubst,
- map(class_constraint, constraint_proof),
- map(class_constraint, constraint_proof)).
-:- mode apply_rec_subst_to_constraint_proofs(in, in, out) is det.
-
-:- pred apply_variable_renaming_to_type_map(map(tvar, tvar),
- vartypes, vartypes).
-:- mode apply_variable_renaming_to_type_map(in, in, out) is det.
-
-:- pred apply_variable_renaming_to_constraints(map(tvar, tvar),
- class_constraints, class_constraints).
-:- mode apply_variable_renaming_to_constraints(in, in, out) is det.
-
-:- pred apply_variable_renaming_to_constraint_list(map(tvar, tvar),
- list(class_constraint), list(class_constraint)).
-:- mode apply_variable_renaming_to_constraint_list(in, in, out) is det.
-
-:- pred apply_variable_renaming_to_constraint(map(tvar, tvar),
- class_constraint, class_constraint).
-:- mode apply_variable_renaming_to_constraint(in, in, out) is det.
+ map(class_constraint, prog_var)::in, tsubst::in, map(tvar, type)::in,
+ map(prog_var, prog_var)::in, map(class_constraint, prog_var)::out)
+ is det.
+
+:- pred apply_rec_subst_to_constraints(tsubst::in, class_constraints::in,
+ class_constraints::out) is det.
+
+:- pred apply_rec_subst_to_constraint_list(tsubst::in,
+ list(class_constraint)::in, list(class_constraint)::out) is det.
+
+:- pred apply_rec_subst_to_constraint(tsubst::in, class_constraint::in,
+ class_constraint::out) is det.
+
+:- pred apply_subst_to_constraints(tsubst::in, class_constraints::in,
+ class_constraints::out) is det.
+
+:- pred apply_subst_to_constraint_list(tsubst::in, list(class_constraint)::in,
+ list(class_constraint)::out) is det.
+
+:- pred apply_subst_to_constraint(tsubst::in, class_constraint::in,
+ class_constraint::out) is det.
+
+:- pred apply_subst_to_constraint_proofs(tsubst::in,
+ map(class_constraint, constraint_proof)::in,
+ map(class_constraint, constraint_proof)::out) is det.
+
+:- pred apply_rec_subst_to_constraint_proofs(tsubst::in,
+ map(class_constraint, constraint_proof)::in,
+ map(class_constraint, constraint_proof)::out) is det.
+
+:- pred apply_variable_renaming_to_type_map(map(tvar, tvar)::in,
+ vartypes::in, vartypes::out) is det.
+
+:- pred apply_variable_renaming_to_constraints(map(tvar, tvar)::in,
+ class_constraints::in, class_constraints::out) is det.
+
+:- pred apply_variable_renaming_to_constraint_list(map(tvar, tvar)::in,
+ list(class_constraint)::in, list(class_constraint)::out) is det.
+
+:- pred apply_variable_renaming_to_constraint(map(tvar, tvar)::in,
+ class_constraint::in, class_constraint::out) is det.
% Apply a renaming (partial map) to a list.
% Useful for applying a variable renaming to a list of variables.
-:- pred apply_partial_map_to_list(list(T), map(T, T), list(T)).
-:- mode apply_partial_map_to_list(in, in, out) is det.
+:- pred apply_partial_map_to_list(list(T)::in, map(T, T)::in, list(T)::out)
+ is det.
% cons_id_adjusted_arity(ModuleInfo, Type, ConsId):
% Returns the number of arguments of specified constructor id,
@@ -525,16 +485,15 @@
% return the list of type variables contained in a
% list of constraints
%
-:- pred constraint_list_get_tvars(list(class_constraint), list(tvar)).
-:- mode constraint_list_get_tvars(in, out) is det.
+:- pred constraint_list_get_tvars(list(class_constraint)::in, list(tvar)::out)
+ is det.
% constraint_list_get_tvars(Constraint, TVars):
% return the list of type variables contained in a constraint.
-:- pred constraint_get_tvars(class_constraint, list(tvar)).
-:- mode constraint_get_tvars(in, out) is det.
+:- pred constraint_get_tvars(class_constraint::in, list(tvar)::out) is det.
-:- pred get_unconstrained_tvars(list(tvar), list(class_constraint), list(tvar)).
-:- mode get_unconstrained_tvars(in, in, out) is det.
+:- pred get_unconstrained_tvars(list(tvar)::in, list(class_constraint)::in,
+ list(tvar)::out) is det.
%-----------------------------------------------------------------------------%
@@ -543,12 +502,11 @@
% from the cons_id because the arity in the cons_id will not
% include any extra type_info arguments for existentially
% quantified types.
-:- pred maybe_get_cons_id_arg_types(module_info, maybe(type), cons_id,
- arity, list(maybe(type))).
-:- mode maybe_get_cons_id_arg_types(in, in, in, in, out) is det.
+:- pred maybe_get_cons_id_arg_types(module_info::in, maybe(type)::in,
+ cons_id::in, arity::in, list(maybe(type))::out) is det.
-:- pred maybe_get_higher_order_arg_types(maybe(type), arity, list(maybe(type))).
-:- mode maybe_get_higher_order_arg_types(in, in, out) is det.
+:- pred maybe_get_higher_order_arg_types(maybe(type)::in, arity::in,
+ list(maybe(type))::out) is det.
:- type polymorphism_cell
---> type_info_cell(type_ctor)
@@ -723,9 +681,9 @@
).
% This parses a higher-order type without any purity indicator.
-:- pred type_is_higher_order_2(type, pred_or_func,
- lambda_eval_method, list(type)).
-:- mode type_is_higher_order_2(in, out, out, out) is semidet.
+:- pred type_is_higher_order_2((type)::in, pred_or_func::out,
+ lambda_eval_method::out, list(type)::out) is semidet.
+
type_is_higher_order_2(Type, PredOrFunc, EvalMethod, PredArgTypes) :-
(
Type = term__functor(term__atom("="),
@@ -743,9 +701,8 @@
% From the type of a lambda expression, work out how it should
% be evaluated and extract the argument types.
-:- pred get_lambda_eval_method_and_args(string, (type),
- lambda_eval_method, list(type)) is det.
-:- mode get_lambda_eval_method_and_args(in, in, out, out) is semidet.
+:- pred get_lambda_eval_method_and_args(string::in, (type)::in,
+ lambda_eval_method::out, list(type)::out) is semidet.
get_lambda_eval_method_and_args(PorFStr, Type0, EvalMethod, ArgTypes) :-
Type0 = term__functor(term__atom(Functor), Args, _),
@@ -788,8 +745,8 @@
).
:- pred get_purity_and_eval_method(sym_name::in, purity::out,
- lambda_eval_method::out,
- string::out) is semidet.
+ lambda_eval_method::out, string::out) is semidet.
+
get_purity_and_eval_method(SymName, Purity, EvalMethod, PorFStr) :-
(
SymName = qualified(unqualified(Qualifier), PorFStr),
@@ -832,17 +789,20 @@
(
TypeBody = du_type(_, _, _, _, _, _, _),
(
- TypeBody ^ du_type_is_foreign_type = yes(ForeignTypeBody),
- have_foreign_type_for_backend(Target, ForeignTypeBody, yes)
+ TypeBody ^ du_type_is_foreign_type =
+ yes(ForeignTypeBody),
+ have_foreign_type_for_backend(Target, ForeignTypeBody,
+ yes)
->
- UserEqComp = foreign_type_body_has_user_defined_equality_pred(
+ UserEqComp =
+ foreign_type_body_has_user_defined_eq_comp_pred(
ModuleInfo, ForeignTypeBody)
;
TypeBody ^ du_type_usereq = yes(UserEqComp)
)
;
TypeBody = foreign_type(ForeignTypeBody, _),
- UserEqComp = foreign_type_body_has_user_defined_equality_pred(
+ UserEqComp = foreign_type_body_has_user_defined_eq_comp_pred(
ModuleInfo, ForeignTypeBody)
).
@@ -893,6 +853,7 @@
:- pred type_util__is_dummy_argument_type_2(string::in, string::in, arity::in)
is semidet.
+
% XXX should we include aditi:state/0 in this list?
type_util__is_dummy_argument_type_2("io", "state", 0). % io:state/0
type_util__is_dummy_argument_type_2("store", "store", 1). % store:store/1.
@@ -923,8 +884,7 @@
Args = [Arg | Args1]
).
-:- pred type_ctor_is_enumeration(type_ctor, module_info).
-:- mode type_ctor_is_enumeration(in, in) is semidet.
+:- pred type_ctor_is_enumeration(type_ctor::in, module_info::in) is semidet.
type_ctor_is_enumeration(TypeCtor, ModuleInfo) :-
module_info_types(ModuleInfo, TypeDefnTable),
@@ -1057,8 +1017,8 @@
term__context_init)
).
-:- pred qualify_higher_order_type(lambda_eval_method, (type), (type)).
-:- mode qualify_higher_order_type(in, in, out) is det.
+:- pred qualify_higher_order_type(lambda_eval_method::in, (type)::in,
+ (type)::out) is det.
qualify_higher_order_type(normal, Type, Type).
qualify_higher_order_type((aditi_bottom_up), Type0,
@@ -1202,14 +1162,16 @@
->
ArgTypes = TypeArgs
;
- type_util__do_get_type_and_cons_defn(ModuleInfo, TypeCtor,
- ConsId, TypeDefn, ConsDefn),
+ type_util__do_get_type_and_cons_defn(ModuleInfo,
+ TypeCtor, ConsId, TypeDefn, ConsDefn),
ConsDefn = hlds_cons_defn(ExistQVars0, _Constraints0,
Args, _, _),
Args \= []
->
- hlds_data__get_type_defn_tparams(TypeDefn, TypeDefnParams),
- term__term_list_to_var_list(TypeDefnParams, TypeDefnVars),
+ hlds_data__get_type_defn_tparams(TypeDefn,
+ TypeDefnParams),
+ term__term_list_to_var_list(TypeDefnParams,
+ TypeDefnVars),
% XXX handle ExistQVars
( ExistQVars0 = [] ->
@@ -1217,16 +1179,19 @@
;
(
EQVarAction = abort_on_exist_qvar,
- error("type_util__get_cons_id_arg_types: existentially typed cons_id")
+ error("get_cons_id_arg_types: " ++
+ "existentially typed cons_id")
;
EQVarAction = fail_on_exist_qvar,
fail
)
),
- map__from_corresponding_lists(TypeDefnVars, TypeArgs, TSubst),
+ map__from_corresponding_lists(TypeDefnVars, TypeArgs,
+ TSubst),
assoc_list__values(Args, ArgTypes0),
- term__apply_substitution_to_list(ArgTypes0, TSubst, ArgTypes)
+ term__apply_substitution_to_list(ArgTypes0, TSubst,
+ ArgTypes)
;
ArgTypes = []
)
@@ -1974,7 +1939,7 @@
% figure out the arity of this constructor,
% _including_ any type-infos or typeclass-infos
% inserted for existential data types.
- cons_id_arity(ConsId, ConsArity),
+ ConsArity = cons_id_arity(ConsId),
(
type_util__get_existq_cons_defn(ModuleInfo, Type, ConsId,
ConsDefn)
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.129
diff -u -b -r1.129 unify_proc.m
--- compiler/unify_proc.m 1 Dec 2003 15:55:52 -0000 1.129
+++ compiler/unify_proc.m 20 Dec 2003 08:49:01 -0000
@@ -352,9 +352,9 @@
map__lookup(Preds0, PredId, PredInfo0),
list__length(ArgModes, Arity),
DeclaredArgModes = no,
- add_new_proc(PredInfo0, InstVarSet, Arity, ArgModes, DeclaredArgModes,
- ArgLives, MaybeDet, Context, address_is_not_taken,
- PredInfo1, ProcId),
+ add_new_proc(InstVarSet, Arity, ArgModes, DeclaredArgModes, ArgLives,
+ MaybeDet, Context, address_is_not_taken, PredInfo0, PredInfo1,
+ ProcId),
%
% copy the clauses for the procedure from the pred_info to the
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.89
diff -u -b -r1.89 unused_args.m
--- compiler/unused_args.m 5 Nov 2003 03:17:45 -0000 1.89
+++ compiler/unused_args.m 20 Dec 2003 09:03:21 -0000
@@ -949,8 +949,8 @@
% add the new proc to the pred table
module_info_get_predicate_table(!.ModuleInfo, PredTable0),
- predicate_table_insert(PredTable0,
- NewPredInfo, NewPredId, PredTable),
+ predicate_table_insert(NewPredInfo, NewPredId,
+ PredTable0, PredTable),
module_info_set_predicate_table(PredTable, !ModuleInfo),
% add the new proc to the proc_call_info map
@@ -1000,7 +1000,7 @@
map__set(ExtraProcs0, ProcId, ExtraProc, ExtraProcs),
pred_info_set_procedures(ExtraProcs, ExtraPredInfo0, ExtraPredInfo),
module_info_get_predicate_table(!.ModuleInfo, PredTable0),
- predicate_table_insert(PredTable0, ExtraPredInfo, _, PredTable),
+ predicate_table_insert(ExtraPredInfo, _, PredTable0, PredTable),
module_info_set_predicate_table(PredTable, !ModuleInfo).
:- pred make_new_pred_info(module_info::in, list(int)::in, import_status::in,
@@ -1133,7 +1133,7 @@
% Add the new proc to the pred table.
module_info_get_predicate_table(!.ModuleInfo, PredTable0),
- predicate_table_insert(PredTable0, NewPredInfo, NewPredId, PredTable1),
+ predicate_table_insert(NewPredInfo, NewPredId, PredTable0, PredTable1),
module_info_set_predicate_table(PredTable1, !ModuleInfo),
PredModule = pred_info_module(NewPredInfo),
PredName = pred_info_name(NewPredInfo),
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing java/library
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list