[m-rev.] diff: warn about X = f, X = g
Zoltan Somogyi
zs at cs.mu.OZ.AU
Sat Aug 27 19:40:24 AEST 2005
Only the changes to modecheck_unify, mode_errors, mode_info and inst_util
are algorithmic. The changes to the other compiler modules are voluminous
but trivial.
Zoltan.
Don't just detect when successive unifications unify the same variable with
incompatible function symbols: also issue a warning.
compiler/ml_code_gen.m:
compiler/stratify.m:
compiler/table_gen.m:
mdbcomp/trace_counts.m:
Fix pieces of code that get the new warning.
compiler/modecheck_unify.m:
When detecting such unifications, add warnings for them, except if
the initial inst of the current restricts the set of allowed bindings
of the input arguments. If the initial inst of X is bound(f), then
an otherwise correct unification Y = g may fail if Y has been computed
from X. (We don't whether it has, so we have to be conservative.)
There are examples of such code in the library, e.g. functor in
deconstruct.m.
Factor out some common code.
compiler/mode_errors.m:
Add the infrastructure needed for printing warnings, and the two forms
of this warning in particular.
compiler/mode_info.m:
Extend the mode_info structure to make room for warnings, and for the
initial inst of the procedure arguments.
Switch to four-space indentation.
compiler/inst_util.m:
Add a predicate that tests whether an inst may restrict the set of
possible cons_ids a variable may be bound to.
Change the argument order of some predicates to allow them to be
used in higher order code. We don't need to make the switched-on
argument the first argument anymore.
Switch to four-space indentation.
compiler/hlds_goal.m:
Change the argument order of some predicates to allow the use of state
variables.
compiler/higher_order.m:
compiler/instmap.m:
compiler/mode_constraints.m:
compiler/mode_debug.m:
compiler/mode_ordering.m:
compiler/modecheck_call.m:
compiler/trace.m:
Conform to the changed argument orders described above.
Switch to four-space indentation.
compiler/common.m:
compiler/inst_match.m:
compiler/hlds_pred.m:
compiler/lambda.m:
compiler/magic.m:
compiler/magic_util.m:
compiler/modes.m:
compiler/pd_util.m:
compiler/post_typecheck.m:
compiler/unique_modes.m:
Conform to the changed argument orders described above.
tests/invalid/occurs.err_exp:
Expect the extra warning.
tests/warnings/Mmakefile:
Enable the unify_f_g test case I accidentally committed earlier.
tests/warnings/unify_f_g.{m,err_exp}:
Finalize that test case.
tests/warnings/simple_code.err_exp:
Expect the extra warning.
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/common.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/common.m,v
retrieving revision 1.80
diff -u -b -r1.80 common.m
--- compiler/common.m 16 Aug 2005 15:36:15 -0000 1.80
+++ compiler/common.m 24 Aug 2005 09:41:34 -0000
@@ -550,7 +550,7 @@
OutputArgs2, PrevContext)
->
simplify_info_get_module_info(!.Info, ModuleInfo),
- mode_util__modes_to_uni_modes(Modes, Modes, ModuleInfo, UniModes),
+ modes_to_uni_modes(ModuleInfo, Modes, Modes, UniModes),
common__create_output_unifications(GoalInfo,
OutputArgs, OutputArgs2, UniModes, Goals, !Info),
Goal = conj(Goals),
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.132
diff -u -b -r1.132 higher_order.m
--- compiler/higher_order.m 24 Aug 2005 07:36:26 -0000 1.132
+++ compiler/higher_order.m 24 Aug 2005 09:36:46 -0000
@@ -197,63 +197,81 @@
%-----------------------------------------------------------------------------%
-:- type higher_order_global_info --->
- higher_order_global_info(
+:- type higher_order_global_info
+ ---> higher_order_global_info(
requests :: set(request),
% Requested versions.
+
new_preds :: new_preds,
% Specialized versions for each predicate
% not changed by traverse_goal.
+
version_info :: map(pred_proc_id, version_info),
% Extra information about each specialized
% version.
+
module_info :: module_info,
goal_sizes :: goal_sizes,
ho_params :: ho_params,
- next_higher_order_id :: counter
- % Number identifying a specialized version.
+
+ next_ho_id :: counter
+ % Number identifying a specialized
+ % version.
).
% Used while traversing goals.
%
-:- type higher_order_info --->
- higher_order_info(
+:- type higher_order_info
+ ---> higher_order_info(
global_info :: higher_order_global_info,
+
pred_vars :: pred_vars,
% higher_order variables.
+
pred_proc_id :: pred_proc_id,
% pred_proc_id of goal being traversed.
+
pred_info :: pred_info,
% pred_info of goal being traversed.
+
proc_info :: proc_info,
% proc_info of goal being traversed.
+
changed :: changed
).
-:- type request --->
- request(
+:- type request
+ ---> request(
rq_caller :: pred_proc_id,
% calling pred
+
rq_callee :: pred_proc_id,
% called pred
+
rq_args :: list(prog_var),
% call args
+
rq_tvars :: list(tvar),
% Type variables for which
% extra type-infos must be
% passed from the caller if
% --typeinfo-liveness is set.
+
rq_ho_args :: list(higher_order_arg),
rq_caller_types :: list(type),
% argument types in caller
+
rq_typeinfo_liveness :: bool,
% Should the interface of
% the specialized procedure
% use typeinfo liveness?
+
rq_caller_tvarset :: tvarset,
% Caller's typevarset.
+
rq_user_req_spec :: bool,
% Is this a user-requested specialization?
+
rq_call_context :: context
% Context of the call which
% caused the request to be
@@ -266,25 +284,30 @@
% For cons_ids other than pred_const and `type_info',
% the arguments must be constants
%
-:- type higher_order_arg --->
- higher_order_arg(
+:- type higher_order_arg
+ ---> higher_order_arg(
hoa_cons_id :: cons_id,
hoa_index :: int,
% Index in argument vector.
+
hoa_num_curried_args :: int,
% Number of curried args.
hoa_curry_arg_in_caller :: list(prog_var),
% Curried arguments in caller.
+
hoa_curry_type_in_caller :: list(type),
% Curried argument types in caller.
+
hoa_curry_rtti_type :: list(rtti_var_info),
% Types associated with type_infos and
- % constraints associated with typeclass_infos
- % in the arguments.
+ % constraints associated with
+ % typeclass_infos in the arguments.
+
hoa_known_curry_args :: list(higher_order_arg),
% Higher-order curried arguments
% with known values.
+
hoa_is_constant :: bool
% Is this higher_order_arg a constant?
).
@@ -1178,8 +1201,8 @@
;
unexpected(this_file, "maybe_specialize_pred_const")
),
- mode_util.modes_to_uni_modes(CurriedArgModes,
- CurriedArgModes, ModuleInfo, UniModes),
+ modes_to_uni_modes(ModuleInfo, CurriedArgModes,
+ CurriedArgModes, UniModes),
%
% The dummy arguments can't be used anywhere.
%
@@ -1303,13 +1326,10 @@
Result = not_specialized,
(
CanRequest = yes,
- set.insert(!.Info ^ global_info ^ requests,
- Request, Requests),
- update_changed_status(!.Info ^ changed,
- request, Changed),
- !:Info = (!.Info ^ global_info
- ^ requests := Requests)
- ^ changed := Changed
+ set.insert(!.Info ^ global_info ^ requests, Request, Requests),
+ update_changed_status(!.Info ^ changed, request, Changed),
+ !:Info = !.Info ^ global_info ^ requests := Requests,
+ !:Info = !.Info ^ changed := Changed
;
CanRequest = no
)
@@ -1330,7 +1350,7 @@
list(higher_order_arg)::out) is det.
find_higher_order_args(_, _, [], _, _, _, _, _, !HOArgs).
-find_higher_order_args(_, _, [_|_], [], _, _, _, _, _, _) :-
+find_higher_order_args(_, _, [_ | _], [], _, _, _, _, _, _) :-
unexpected(this_file, "find_higher_order_args: length mismatch").
find_higher_order_args(ModuleInfo, CalleeStatus, [Arg | Args],
[CalleeArgType | CalleeArgTypes], VarTypes, RttiVarMaps,
@@ -1409,7 +1429,7 @@
type_subst_makes_instance_known(ModuleInfo, CalleeUnivConstraints0, TVarSet0,
CallerHeadTypeParams, ArgTypes, CalleeTVarSet,
CalleeExistQVars, CalleeArgTypes0) :-
- CalleeUnivConstraints0 \= [],
+ CalleeUnivConstraints0 = [_ | _],
varset.merge_subst(TVarSet0, CalleeTVarSet, TVarSet, TypeRenaming),
term.apply_substitution_to_list(CalleeArgTypes0, TypeRenaming,
CalleeArgTypes1),
@@ -1444,8 +1464,8 @@
; request(request)
; no_request.
-:- type match --->
- match(
+:- type match
+ ---> match(
new_pred,
maybe(int),
@@ -1518,8 +1538,7 @@
UserTypeSpec = yes,
IsUserSpecProc = yes
;
- module_info_pred_info(ModuleInfo, CalledPred,
- CalledPredInfo),
+ module_info_pred_info(ModuleInfo, CalledPred, CalledPredInfo),
\+ pred_info_is_imported(CalledPredInfo),
(
% This handles the predicates introduced by
@@ -1576,11 +1595,9 @@
;
AllTVars = [_ | _],
proc_info_rtti_varmaps(Info ^ proc_info, RttiVarMaps),
- list.foldl(
- arg_contains_type_info_for_tvar(RttiVarMaps),
+ list.foldl(arg_contains_type_info_for_tvar(RttiVarMaps),
Args, [], TypeInfoTVars),
- list.delete_elems(AllTVars, TypeInfoTVars,
- ExtraTypeInfoTVars0),
+ list.delete_elems(AllTVars, TypeInfoTVars, ExtraTypeInfoTVars0),
list.remove_dups(ExtraTypeInfoTVars0, ExtraTypeInfoTVars)
).
@@ -1591,9 +1608,7 @@
rtti_varmaps_var_info(RttiVarMaps, Var, VarInfo),
(
VarInfo = type_info_var(Type),
- (
- prog_type.var(Type, TVar)
- ->
+ ( prog_type.var(Type, TVar) ->
!:TVars = [TVar | !.TVars]
;
true
@@ -1847,16 +1862,14 @@
map.search(PredVars, TypeClassInfoVar,
constant(_TypeClassInfoConsId, TypeClassInfoArgs)),
- map.search(PredVars, IndexVar,
- constant(int_const(Index0), [])),
+ map.search(PredVars, IndexVar, constant(int_const(Index0), [])),
% Extract the number of class constraints on the instance
% from the base_typeclass_info.
TypeClassInfoArgs = [BaseTypeClassInfoVar | OtherVars],
map.search(PredVars, BaseTypeClassInfoVar,
- constant(base_typeclass_info_const(_,
- ClassId, InstanceNum, _), _))
+ constant(base_typeclass_info_const(_, ClassId, InstanceNum, _), _))
->
module_info_instances(ModuleInfo, Instances),
map.lookup(Instances, ClassId, InstanceDefns),
@@ -1941,8 +1954,7 @@
%
specializeable_special_call(SpecialId, CalledProc),
type_is_atomic(SpecialPredType, ModuleInfo),
- \+ type_has_user_defined_equality_pred(ModuleInfo,
- SpecialPredType, _)
+ \+ type_has_user_defined_equality_pred(ModuleInfo, SpecialPredType, _)
->
(
SpecialId = unify,
@@ -1960,18 +1972,15 @@
;
SpecialId = compare,
SpecialPredArgs = [ComparisonResult, _, _],
- find_builtin_type_with_equivalent_compare(
- ModuleInfo, SpecialPredType, CompareType,
- NeedIntCast),
- polymorphism.get_special_proc(CompareType,
- SpecialId, ModuleInfo, SymName,
- SpecialPredId, SpecialProcId),
+ find_builtin_type_with_equivalent_compare(ModuleInfo,
+ SpecialPredType, CompareType, NeedIntCast),
+ polymorphism.get_special_proc(CompareType, SpecialId, ModuleInfo,
+ SymName, SpecialPredId, SpecialProcId),
(
NeedIntCast = no,
NewCallArgs = [ComparisonResult, Arg1, Arg2],
- Goal = call(SpecialPredId, SpecialProcId,
- NewCallArgs, not_builtin,
- MaybeContext, SymName)
+ Goal = call(SpecialPredId, SpecialProcId, NewCallArgs,
+ not_builtin, MaybeContext, SymName)
;
NeedIntCast = yes,
goal_info_get_context(OrigGoalInfo, Context),
@@ -1983,20 +1992,17 @@
ProcInfo1, ProcInfo),
NewCallArgs = [ComparisonResult,
CastArg1, CastArg2],
- Call = call(SpecialPredId, SpecialProcId,
- NewCallArgs, not_builtin,
- MaybeContext, SymName),
+ Call = call(SpecialPredId, SpecialProcId, NewCallArgs,
+ not_builtin, MaybeContext, SymName),
set.list_to_set([ComparisonResult,
Arg1, Arg2], NonLocals),
instmap_delta_from_assoc_list(
- [ComparisonResult -
- ground(shared,none)],
+ [ComparisonResult - ground(shared,none)],
InstMapDelta),
Detism = det,
goal_info_init(NonLocals, InstMapDelta,
Detism, pure, Context, GoalInfo),
- Goal = conj([CastGoal1, CastGoal2,
- Call - GoalInfo]),
+ Goal = conj([CastGoal1, CastGoal2, Call - GoalInfo]),
!:Info = !.Info ^ proc_info := ProcInfo
)
)
@@ -2045,14 +2051,12 @@
NonLocals = NonLocals0,
instmap_delta_init_reachable(InstMapDelta),
Detism = semidet,
- SpecialGoal = unify(UnwrappedArg1, var(UnwrappedArg2),
- (In - In),
+ SpecialGoal = unify(UnwrappedArg1, var(UnwrappedArg2), (In - In),
simple_test(UnwrappedArg1, UnwrappedArg2),
unify_context(explicit, [])),
goal_info_init(NonLocals, InstMapDelta, Detism, pure,
Context, GoalInfo),
- Goal = conj([ExtractGoal1, ExtractGoal2,
- SpecialGoal - GoalInfo]),
+ Goal = conj([ExtractGoal1, ExtractGoal2, SpecialGoal - GoalInfo]),
!:Info = !.Info ^ proc_info := ProcInfo2
;
SpecialId = compare,
@@ -2337,8 +2341,7 @@
maybe_write_string(VeryVerbose,
"% not specializing (goal too large).\n", !IO)
;
- higher_order_args_size(HOArgs) >
- Info ^ ho_params ^ arg_limit
+ higher_order_args_size(HOArgs) > Info ^ ho_params ^ arg_limit
->
% If the arguments are too large, we can end up producing a
% specialized version with massive numbers of arguments,
@@ -2356,23 +2359,19 @@
%
VersionInfoMap = Info ^ version_info,
(
- map.search(VersionInfoMap, CalledPredProcId,
- CalledVersionInfo)
+ map.search(VersionInfoMap, CalledPredProcId, CalledVersionInfo)
->
- CalledVersionInfo = version_info(
- OrigPredProcId, _, _, _)
+ CalledVersionInfo = version_info(OrigPredProcId, _, _, _)
;
OrigPredProcId = CalledPredProcId
),
- map.search(VersionInfoMap, CallingPredProcId,
- CallingVersionInfo),
- CallingVersionInfo = version_info(_, _, _,
- ParentVersions),
+ map.search(VersionInfoMap, CallingPredProcId, CallingVersionInfo),
+ CallingVersionInfo = version_info(_, _, _, ParentVersions),
ArgDepth = higher_order_args_depth(HOArgs),
some [ParentVersion] (
list.member(ParentVersion, ParentVersions),
- ParentVersion = parent_version_info(
- OrigPredProcId, OldArgDepth),
+ ParentVersion = parent_version_info(OrigPredProcId,
+ OldArgDepth),
ArgDepth >= OldArgDepth
)
->
@@ -2404,8 +2403,7 @@
% versions of the current pred.
\+ (
set.member(Version, SpecVersions0),
- version_matches(!.Info ^ ho_params,
- !.Info ^ module_info,
+ version_matches(!.Info ^ ho_params, !.Info ^ module_info,
Request, Version, _)
)
->
@@ -2498,9 +2496,9 @@
;
IsUserTypeSpec = no,
NewProcId = hlds_pred.initial_proc_id,
- IdCounter0 = !.Info ^ next_higher_order_id,
+ IdCounter0 = !.Info ^ next_ho_id,
counter.allocate(Id, IdCounter0, IdCounter),
- !:Info = !.Info ^ next_higher_order_id := IdCounter,
+ !:Info = !.Info ^ next_ho_id := IdCounter,
string.int_to_string(Id, IdStr),
string.append_list([Name0, "__ho", IdStr], PredName),
SymName = qualified(PredModule, PredName),
@@ -2645,8 +2643,7 @@
;
CurriedHOArgs = [_ | _],
io.write_string(":\n", !IO),
- output_higher_order_args(ModuleInfo, 0, Indent + 1,
- CurriedHOArgs, !IO)
+ output_higher_order_args(ModuleInfo, 0, Indent + 1, CurriedHOArgs, !IO)
),
output_higher_order_args(ModuleInfo, NumToDrop, Indent, HOArgs, !IO).
@@ -2693,9 +2690,8 @@
create_new_proc(NewPred, !.NewProcInfo, !NewPredInfo, !Info) :-
ModuleInfo = !.Info ^ module_info,
- NewPred = new_pred(NewPredProcId, OldPredProcId, CallerPredProcId,
- _Name, HOArgs0, CallArgs, ExtraTypeInfoTVars0, CallerArgTypes0,
- _, _, _),
+ NewPred = new_pred(NewPredProcId, OldPredProcId, CallerPredProcId, _Name,
+ HOArgs0, CallArgs, ExtraTypeInfoTVars0, CallerArgTypes0, _, _, _),
proc_info_headvars(!.NewProcInfo, HeadVars0),
proc_info_argmodes(!.NewProcInfo, ArgModes0),
@@ -2727,8 +2723,7 @@
inlining.get_type_substitution(OriginalArgTypes1, CallerArgTypes0,
CallerHeadParams, ExistQVars1, TypeSubn),
- term.apply_rec_substitution_to_list(ExistQTypes1, TypeSubn,
- ExistQTypes),
+ term.apply_rec_substitution_to_list(ExistQTypes1, TypeSubn, ExistQTypes),
ExistQVars = list.filter_map(
(func(ExistQType) = ExistQVar is semidet :-
ExistQType = term.variable(ExistQVar)
@@ -2741,23 +2736,25 @@
term.var_list_to_term_list(ExtraTypeInfoTVars0,
ExtraTypeInfoTVarTypes0),
- ( (map.is_empty(TypeSubn) ; ExistQVars = []) ->
+ (
+ ( map.is_empty(TypeSubn)
+ ; ExistQVars = []
+ )
+ ->
HOArgs = HOArgs0,
ExtraTypeInfoTVarTypes = ExtraTypeInfoTVarTypes0,
ExtraTypeInfoTVars = ExtraTypeInfoTVars0
;
% If there are existentially quantified variables in the
% callee we may need to bind type variables in the caller.
- list.map(substitute_higher_order_arg(TypeSubn),
- HOArgs0, HOArgs),
+ list.map(substitute_higher_order_arg(TypeSubn), HOArgs0, HOArgs),
term.apply_rec_substitution_to_list(ExtraTypeInfoTVarTypes0,
TypeSubn, ExtraTypeInfoTVarTypes),
% The substitution should never bind any of the type variables
% for which extra type-infos are needed, otherwise it
% wouldn't be necessary to add them.
- term.term_list_to_var_list(ExtraTypeInfoTVarTypes,
- ExtraTypeInfoTVars)
+ term.term_list_to_var_list(ExtraTypeInfoTVarTypes, ExtraTypeInfoTVars)
),
% Add in the extra typeinfo vars.
@@ -2841,18 +2838,15 @@
remove_const_higher_order_args(1, HeadVars0, HOArgs, HeadVars1),
remove_const_higher_order_args(1, ArgModes0, HOArgs, ArgModes1),
- list.condense([ExtraTypeInfoVars, ExtraHeadVars, HeadVars1],
- HeadVars),
- list.condense([ExtraTypeInfoModes, ExtraArgModes, ArgModes1],
- ArgModes),
+ list.condense([ExtraTypeInfoVars, ExtraHeadVars, HeadVars1], HeadVars),
+ list.condense([ExtraTypeInfoModes, ExtraArgModes, ArgModes1], ArgModes),
proc_info_set_headvars(HeadVars, !NewProcInfo),
proc_info_set_argmodes(ArgModes, !NewProcInfo),
proc_info_goal(!.NewProcInfo, Goal6),
Goal6 = _ - GoalInfo6,
goal_to_conj_list(Goal6, GoalList6),
- conj_list_to_goal(list.append(ConstGoals, GoalList6),
- GoalInfo6, Goal),
+ conj_list_to_goal(list.append(ConstGoals, GoalList6), GoalInfo6, Goal),
proc_info_set_goal(Goal, !NewProcInfo),
proc_info_vartypes(!.NewProcInfo, VarTypes7),
@@ -2861,8 +2855,7 @@
HOArgs, ModifiedOriginalArgTypes),
list.condense([ExtraTypeInfoTypes, ExtraHeadVarTypes0,
ModifiedOriginalArgTypes], ArgTypes),
- pred_info_set_arg_types(TypeVarSet, ExistQVars, ArgTypes,
- !NewPredInfo),
+ pred_info_set_arg_types(TypeVarSet, ExistQVars, ArgTypes, !NewPredInfo),
pred_info_set_typevarset(TypeVarSet, !NewPredInfo),
%
% The types of the headvars in the vartypes map in the proc_info may
@@ -3030,8 +3023,8 @@
% other constants which include it will be recognized as
% constant.
%
- mode_util.modes_to_uni_modes(CurriedArgModes1,
- CurriedArgModes1, ModuleInfo, UniModes),
+ modes_to_uni_modes(ModuleInfo, CurriedArgModes1,
+ CurriedArgModes1, UniModes),
set.list_to_set(CurriedHeadVars1, ConstNonLocals),
ConstInst = ground(shared, GroundInstInfo),
instmap_delta_from_assoc_list([LVar - ConstInst],
@@ -3071,24 +3064,20 @@
(
VarInfo = type_info_var(TypeInfoType),
rtti_det_insert_type_info_type(Var, TypeInfoType, !RttiVarMaps),
- (
- prog_type.var(TypeInfoType, TVar)
- ->
+ ( prog_type.var(TypeInfoType, TVar) ->
maybe_set_typeinfo_locn(TVar, type_info(Var), !RttiVarMaps)
;
true
)
;
VarInfo = typeclass_info_var(Constraint),
- (
- \+ rtti_search_typeclass_info_var(!.RttiVarMaps, Constraint, _)
- ->
+ ( rtti_search_typeclass_info_var(!.RttiVarMaps, Constraint, _) ->
+ true
+ ;
rtti_det_insert_typeclass_info_var(Constraint, Var, !RttiVarMaps),
Constraint = constraint(_, ConstraintTypes),
list.foldl2(update_type_info_locn(Var), ConstraintTypes, 1, _,
!RttiVarMaps)
- ;
- true
)
;
VarInfo = non_rtti_var
@@ -3098,9 +3087,7 @@
rtti_varmaps::in, rtti_varmaps::out) is det.
update_type_info_locn(Var, ConstraintType, Index, Index + 1, !RttiVarMaps) :-
- (
- prog_type.var(ConstraintType, ConstraintTVar)
- ->
+ ( prog_type.var(ConstraintType, ConstraintTVar) ->
maybe_set_typeinfo_locn(ConstraintTVar,
typeclass_info(Var, Index), !RttiVarMaps)
;
@@ -3111,9 +3098,7 @@
rtti_varmaps::in, rtti_varmaps::out) is det.
maybe_set_typeinfo_locn(TVar, Locn, !RttiVarMaps) :-
- (
- rtti_search_type_info_locn(!.RttiVarMaps, TVar, _)
- ->
+ ( rtti_search_type_info_locn(!.RttiVarMaps, TVar, _) ->
true
;
rtti_det_insert_type_info_locn(TVar, Locn, !RttiVarMaps)
@@ -3128,14 +3113,15 @@
HOArg = higher_order_arg(_, HOIndex, _, _, _, _, _, IsConst),
( HOIndex = Index ->
remove_const_higher_order_args(Index + 1, Args0, HOArgs, Args1),
- ( IsConst = yes ->
+ (
+ IsConst = yes,
Args = Args1
;
+ IsConst = no,
Args = [Arg | Args1]
)
; HOIndex > Index ->
- remove_const_higher_order_args(Index + 1, Args0,
- HOArgs0, Args1),
+ remove_const_higher_order_args(Index + 1, Args0, HOArgs0, Args1),
Args = [Arg | Args1]
;
unexpected(this_file, "remove_const_higher_order_args")
@@ -3164,9 +3150,9 @@
list.map(substitute_rtti_var_info(Subn), CurriedRttiTypes0,
CurriedRttiTypes),
list.map(substitute_higher_order_arg(Subn), CurriedHOArgs0, CurriedHOArgs),
- !:HOArg = ((!.HOArg ^ hoa_curry_type_in_caller := CurriedArgTypes)
- ^ hoa_curry_rtti_type := CurriedRttiTypes)
- ^ hoa_known_curry_args := CurriedHOArgs.
+ !:HOArg = !.HOArg ^ hoa_curry_type_in_caller := CurriedArgTypes,
+ !:HOArg = !.HOArg ^ hoa_curry_rtti_type := CurriedRttiTypes,
+ !:HOArg = !.HOArg ^ hoa_known_curry_args := CurriedHOArgs.
:- pred substitute_rtti_var_info(tsubst::in, rtti_var_info::in,
rtti_var_info::out) is det.
@@ -3238,13 +3224,11 @@
list(prog_constraint)::in, list(prog_constraint)::out) is det.
maybe_add_constraint(Constraint, !Constraints) :-
- (
- % Remove duplicates.
- \+ list.member(Constraint, !.Constraints)
- ->
- list.cons(Constraint, !Constraints)
- ;
+ % Don't create duplicates.
+ ( list.member(Constraint, !.Constraints) ->
true
+ ;
+ list.cons(Constraint, !Constraints)
).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.134
diff -u -b -r1.134 hlds_goal.m
--- compiler/hlds_goal.m 16 Aug 2005 10:42:37 -0000 1.134
+++ compiler/hlds_goal.m 22 Aug 2005 04:57:10 -0000
@@ -836,16 +836,16 @@
:- pred goal_info_get_need_visible_vars(hlds_goal_info::in, set(prog_var)::out)
is det.
-:- pred goal_info_set_occurring_vars(hlds_goal_info::in, set(prog_var)::in,
- hlds_goal_info::out) is det.
-:- pred goal_info_set_producing_vars(hlds_goal_info::in, set(prog_var)::in,
- hlds_goal_info::out) is det.
-:- pred goal_info_set_consuming_vars(hlds_goal_info::in, set(prog_var)::in,
- hlds_goal_info::out) is det.
-:- pred goal_info_set_make_visible_vars(hlds_goal_info::in, set(prog_var)::in,
- hlds_goal_info::out) is det.
-:- pred goal_info_set_need_visible_vars(hlds_goal_info::in, set(prog_var)::in,
- hlds_goal_info::out) is det.
+:- pred goal_info_set_occurring_vars(set(prog_var)::in,
+ hlds_goal_info::in, hlds_goal_info::out) is det.
+:- pred goal_info_set_producing_vars(set(prog_var)::in,
+ hlds_goal_info::in, hlds_goal_info::out) is det.
+:- pred goal_info_set_consuming_vars(set(prog_var)::in,
+ hlds_goal_info::in, hlds_goal_info::out) is det.
+:- pred goal_info_set_make_visible_vars(set(prog_var)::in,
+ hlds_goal_info::in, hlds_goal_info::out) is det.
+:- pred goal_info_set_need_visible_vars(set(prog_var)::in,
+ hlds_goal_info::in, hlds_goal_info::out) is det.
:- func producing_vars(hlds_goal_info) = set(prog_var).
:- func 'producing_vars :='(hlds_goal_info, set(prog_var)) = hlds_goal_info.
@@ -1616,10 +1616,13 @@
goal_info_set_code_gen_nonlocals(GoalInfo0, NonLocals, GoalInfo) :-
goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo).
-goal_info_set_occurring_vars(GoalInfo0, OccurringVars, GoalInfo) :-
- ( GoalInfo0 ^ maybe_mode_constraint_info = yes(MCI0) ->
+goal_info_set_occurring_vars(OccurringVars, !GoalInfo) :-
+ MMCI0 = !.GoalInfo ^ maybe_mode_constraint_info,
+ (
+ MMCI0 = yes(MCI0),
MCI = MCI0 ^ mci_occurring_vars := OccurringVars
;
+ MMCI0 = no,
set__init(ProducingVars),
set__init(ConsumingVars),
set__init(MakeVisibleVars),
@@ -1627,12 +1630,15 @@
MCI = mode_constraint_goal_info(OccurringVars, ProducingVars,
ConsumingVars, MakeVisibleVars, NeedVisibleVars)
),
- GoalInfo = GoalInfo0 ^ maybe_mode_constraint_info := yes(MCI).
+ !:GoalInfo = !.GoalInfo ^ maybe_mode_constraint_info := yes(MCI).
-goal_info_set_producing_vars(GoalInfo0, ProducingVars, GoalInfo) :-
- ( GoalInfo0 ^ maybe_mode_constraint_info = yes(MCI0) ->
+goal_info_set_producing_vars(ProducingVars, !GoalInfo) :-
+ MMCI0 = !.GoalInfo ^ maybe_mode_constraint_info,
+ (
+ MMCI0 = yes(MCI0),
MCI = MCI0 ^ mci_producing_vars := ProducingVars
;
+ MMCI0 = no,
set__init(OccurringVars),
set__init(ConsumingVars),
set__init(MakeVisibleVars),
@@ -1640,12 +1646,15 @@
MCI = mode_constraint_goal_info(OccurringVars, ProducingVars,
ConsumingVars, MakeVisibleVars, NeedVisibleVars)
),
- GoalInfo = GoalInfo0 ^ maybe_mode_constraint_info := yes(MCI).
+ !:GoalInfo = !.GoalInfo ^ maybe_mode_constraint_info := yes(MCI).
-goal_info_set_consuming_vars(GoalInfo0, ConsumingVars, GoalInfo) :-
- ( GoalInfo0 ^ maybe_mode_constraint_info = yes(MCI0) ->
+goal_info_set_consuming_vars(ConsumingVars, !GoalInfo) :-
+ MMCI0 = !.GoalInfo ^ maybe_mode_constraint_info,
+ (
+ MMCI0 = yes(MCI0),
MCI = MCI0 ^ mci_consuming_vars := ConsumingVars
;
+ MMCI0 = no,
set__init(OccurringVars),
set__init(ProducingVars),
set__init(MakeVisibleVars),
@@ -1653,12 +1662,15 @@
MCI = mode_constraint_goal_info(OccurringVars, ProducingVars,
ConsumingVars, MakeVisibleVars, NeedVisibleVars)
),
- GoalInfo = GoalInfo0 ^ maybe_mode_constraint_info := yes(MCI).
+ !:GoalInfo = !.GoalInfo ^ maybe_mode_constraint_info := yes(MCI).
-goal_info_set_make_visible_vars(GoalInfo0, MakeVisibleVars, GoalInfo) :-
- ( GoalInfo0 ^ maybe_mode_constraint_info = yes(MCI0) ->
+goal_info_set_make_visible_vars(MakeVisibleVars, !GoalInfo) :-
+ MMCI0 = !.GoalInfo ^ maybe_mode_constraint_info,
+ (
+ MMCI0 = yes(MCI0),
MCI = MCI0 ^ mci_make_visible_vars := MakeVisibleVars
;
+ MMCI0 = no,
set__init(OccurringVars),
set__init(ProducingVars),
set__init(ConsumingVars),
@@ -1666,12 +1678,15 @@
MCI = mode_constraint_goal_info(OccurringVars, ProducingVars,
ConsumingVars, MakeVisibleVars, NeedVisibleVars)
),
- GoalInfo = GoalInfo0 ^ maybe_mode_constraint_info := yes(MCI).
+ !:GoalInfo = !.GoalInfo ^ maybe_mode_constraint_info := yes(MCI).
-goal_info_set_need_visible_vars(GoalInfo0, NeedVisibleVars, GoalInfo) :-
- ( GoalInfo0 ^ maybe_mode_constraint_info = yes(MCI0) ->
+goal_info_set_need_visible_vars(NeedVisibleVars, !GoalInfo) :-
+ MMCI0 = !.GoalInfo ^ maybe_mode_constraint_info,
+ (
+ MMCI0 = yes(MCI0),
MCI = MCI0 ^ mci_need_visible_vars := NeedVisibleVars
;
+ MMCI0 = no,
set__init(OccurringVars),
set__init(ProducingVars),
set__init(ConsumingVars),
@@ -1679,31 +1694,31 @@
MCI = mode_constraint_goal_info(OccurringVars, ProducingVars,
ConsumingVars, MakeVisibleVars, NeedVisibleVars)
),
- GoalInfo = GoalInfo0 ^ maybe_mode_constraint_info := yes(MCI).
+ !:GoalInfo = !.GoalInfo ^ maybe_mode_constraint_info := yes(MCI).
producing_vars(GoalInfo) = ProducingVars :-
goal_info_get_producing_vars(GoalInfo, ProducingVars).
'producing_vars :='(GoalInfo0, ProducingVars) = GoalInfo :-
- goal_info_set_producing_vars(GoalInfo0, ProducingVars, GoalInfo).
+ goal_info_set_producing_vars(ProducingVars, GoalInfo0, GoalInfo).
consuming_vars(GoalInfo) = ConsumingVars :-
goal_info_get_consuming_vars(GoalInfo, ConsumingVars).
'consuming_vars :='(GoalInfo0, ConsumingVars) = GoalInfo :-
- goal_info_set_consuming_vars(GoalInfo0, ConsumingVars, GoalInfo).
+ goal_info_set_consuming_vars(ConsumingVars, GoalInfo0, GoalInfo).
make_visible_vars(GoalInfo) = MakeVisibleVars :-
goal_info_get_make_visible_vars(GoalInfo, MakeVisibleVars).
'make_visible_vars :='(GoalInfo0, MakeVisibleVars) = GoalInfo :-
- goal_info_set_make_visible_vars(GoalInfo0, MakeVisibleVars, GoalInfo).
+ goal_info_set_make_visible_vars(MakeVisibleVars, GoalInfo0, GoalInfo).
need_visible_vars(GoalInfo) = NeedVisibleVars :-
goal_info_get_need_visible_vars(GoalInfo, NeedVisibleVars).
'need_visible_vars :='(GoalInfo0, NeedVisibleVars) = GoalInfo :-
- goal_info_set_need_visible_vars(GoalInfo0, NeedVisibleVars, GoalInfo).
+ goal_info_set_need_visible_vars(NeedVisibleVars, GoalInfo0, GoalInfo).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.174
diff -u -b -r1.174 hlds_pred.m
--- compiler/hlds_pred.m 16 Aug 2005 15:36:16 -0000 1.174
+++ compiler/hlds_pred.m 22 Aug 2005 15:29:36 -0000
@@ -3101,7 +3101,7 @@
proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InstMap) :-
proc_info_headvars(ProcInfo, HeadVars),
proc_info_argmodes(ProcInfo, ArgModes),
- mode_list_get_initial_insts(ArgModes, ModuleInfo, InitialInsts),
+ mode_list_get_initial_insts(ModuleInfo, ArgModes, InitialInsts),
assoc_list__from_corresponding_lists(HeadVars, InitialInsts, InstAL),
instmap__from_assoc_list(InstAL, InstMap).
@@ -3149,7 +3149,7 @@
;
MaybeArgLives = no,
proc_info_argmodes(ProcInfo, Modes),
- get_arg_lives(Modes, ModuleInfo, ArgLives)
+ get_arg_lives(ModuleInfo, Modes, ArgLives)
).
proc_info_is_valid_mode(ProcInfo) :-
Index: compiler/inst_match.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_match.m,v
retrieving revision 1.63
diff -u -b -r1.63 inst_match.m
--- compiler/inst_match.m 22 Mar 2005 06:40:01 -0000 1.63
+++ compiler/inst_match.m 22 Aug 2005 15:25:16 -0000
@@ -547,8 +547,8 @@
bound_inst_list_is_ground(List, !.Info ^ module_info),
bound_inst_list_is_mostly_unique(List, !.Info ^ module_info).
inst_matches_initial_4(ground(UniqA, GroundInstInfoA), any(UniqB), _, !Info) :-
- \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoA,
- !.Info ^ module_info),
+ \+ ground_inst_info_is_nonstandard_func_mode(!.Info ^ module_info,
+ GroundInstInfoA),
compare_uniqueness(!.Info ^ uniqueness_comparison, UniqA, UniqB).
inst_matches_initial_4(ground(_Uniq, _PredInst), free, _, !Info).
inst_matches_initial_4(ground(UniqA, _GII_A), bound(UniqB, ListB), MaybeType,
@@ -746,8 +746,8 @@
inst_match_info::in, inst_match_info::out) is semidet.
ground_inst_info_matches_initial(GroundInstInfoA, none, _, _, !Info) :-
- \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoA,
- !.Info ^ module_info).
+ \+ ground_inst_info_is_nonstandard_func_mode(!.Info ^ module_info,
+ GroundInstInfoA).
ground_inst_info_matches_initial(none, higher_order(PredInstB), _, Type,
!Info) :-
PredInstB = pred_inst_info(function, ArgModes, _Det),
@@ -1007,13 +1007,13 @@
bound_inst_list_matches_uniq(ListA, UniqB, !.Info ^ module_info).
inst_matches_final_3(ground(UniqA, GroundInstInfoA), any(UniqB), _,
!Info) :-
- \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoA,
- !.Info ^ module_info),
+ \+ ground_inst_info_is_nonstandard_func_mode(!.Info ^ module_info,
+ GroundInstInfoA),
unique_matches_final(UniqA, UniqB).
inst_matches_final_3(ground(UniqA, GroundInstInfoA), bound(UniqB, ListB),
MaybeType, !Info) :-
- \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoA,
- !.Info ^ module_info),
+ \+ ground_inst_info_is_nonstandard_func_mode(!.Info ^ module_info,
+ GroundInstInfoA),
unique_matches_final(UniqA, UniqB),
bound_inst_list_is_ground(ListB, MaybeType, !.Info ^ module_info),
uniq_matches_bound_inst_list(UniqA, ListB, !.Info ^ module_info),
@@ -1057,8 +1057,8 @@
inst_match_info::in, inst_match_info::out) is semidet.
ground_inst_info_matches_final(GroundInstInfoA, none, _, !Info) :-
- \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoA,
- !.Info ^ module_info).
+ \+ ground_inst_info_is_nonstandard_func_mode(!.Info ^ module_info,
+ GroundInstInfoA).
ground_inst_info_matches_final(none, higher_order(PredInstB), Type, !Info) :-
PredInstB = pred_inst_info(function, ArgModes, _Det),
Arity = list__length(ArgModes),
@@ -1986,8 +1986,8 @@
(
type_constructors(Type, ModuleInfo, Constructors)
->
- constructors_to_bound_any_insts(Constructors, Uniq,
- ModuleInfo, BoundInsts0),
+ constructors_to_bound_any_insts(ModuleInfo, Uniq,
+ Constructors, BoundInsts0),
list__sort_and_remove_dups(BoundInsts0, BoundInsts),
Inst = bound(Uniq, BoundInsts)
;
Index: compiler/inst_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_util.m,v
retrieving revision 1.37
diff -u -b -r1.37 inst_util.m
--- compiler/inst_util.m 20 Jun 2005 08:22:25 -0000 1.37
+++ compiler/inst_util.m 22 Aug 2005 15:17:18 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1997-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -9,7 +11,6 @@
%
% This module defines some utility routines for manipulating insts.
%
-%
% The handling of `any' insts is not complete. (See also inst_match.m)
%
% The major limitation is that we don't allow `free' to be passed
@@ -33,6 +34,7 @@
% `bound', `ground', and `any' are all represented the same way.
% That works fine for the CLP(R) interface but might not be ideal
% in the general case.
+%
%-----------------------------------------------------------------------------%
:- module check_hlds__inst_util.
@@ -41,16 +43,16 @@
:- import_module hlds__hlds_module.
:- import_module parse_tree__prog_data.
+:- import_module bool.
:- import_module list.
:- import_module std_util.
- % Mode checking is like abstract interpretation.
- % The predicates below define the abstract unification operation
- % which unifies two instantiatednesses. If the unification
- % would be illegal, then abstract unification fails.
- % If the unification would fail, then the abstract unification
- % will succeed, and the resulting instantiatedness will be
- % `not_reached'.
+ % Mode checking is like abstract interpretation. The predicates below
+ % define the abstract unification operation which unifies two
+ % instantiatednesses. If the unification would be illegal, then
+ %% abstract unification fails. If the unification would fail, then
+ % the abstract unification will succeed, and the resulting
+ % instantiatedness will be `not_reached'.
% Compute the inst that results from abstractly unifying two variables.
%
@@ -68,17 +70,16 @@
%-----------------------------------------------------------------------------%
- % Given an inst, return a new inst which is the same as the
- % original inst but with all occurrences of `unique' replaced
- % with `mostly_unique'.
+ % Given an inst, return a new inst which is the same as the original inst
+ % but with all occurrences of `unique' replaced with `mostly_unique'.
%
:- pred make_mostly_uniq_inst((inst)::in, (inst)::out,
module_info::in, module_info::out) is det.
- % Given a list of insts, return a new list of insts which is the
- % same as the original list of insts, but with all occurrences
- % of `unique' replaced with `shared'. It is an error if any part
- % of the inst list is free.
+ % Given a list of insts, return a new list of insts which is the same
+ % as the original list of insts, but with all occurrences of `unique'
+ % replaced with `shared'. It is an error if any part of the inst list
+ % is free.
%
:- pred make_shared_inst_list(list(inst)::in, list(inst)::out,
module_info::in, module_info::out) is det.
@@ -86,12 +87,11 @@
%-----------------------------------------------------------------------------%
% inst_merge(InstA, InstB, InstC):
- % Combine the insts found in different arms of a
- % disjunction (or if-then-else).
- % The information in InstC is the minimum of the
- % information in InstA and InstB. Where InstA and
- % InstB specify a binding (free or bound), it must be
- % the same in both.
+ %
+ % Combine the insts found in different arms of a disjunction (or
+ % if-then-else). The information in InstC is the minimum of the information
+ % in InstA and InstB. Where InstA and InstB specify a binding (free or
+ % bound), it must be the same in both.
%
:- pred inst_merge((inst)::in, (inst)::in, maybe(type)::in, (inst)::out,
module_info::in, module_info::out) is semidet.
@@ -105,25 +105,31 @@
% standard func mode "func(in) = out", even though it isn't the same as
% the standard func mode.
%
-:- pred inst_contains_nonstandard_func_mode((inst)::in, module_info::in)
+:- pred inst_contains_nonstandard_func_mode(module_info::in, (inst)::in)
is semidet.
% Succeed iff the first argument is a function pred_inst_info
% whose mode does not match the standard func mode.
%
-:- pred pred_inst_info_is_nonstandard_func_mode(pred_inst_info::in,
- module_info::in) is semidet.
+:- pred pred_inst_info_is_nonstandard_func_mode(module_info::in,
+ pred_inst_info::in) is semidet.
% Succeed iff the first argument is a function ground_inst_info
% whose mode does not match the standard func mode.
%
-:- pred ground_inst_info_is_nonstandard_func_mode(ground_inst_info::in,
- module_info::in) is semidet.
+:- pred ground_inst_info_is_nonstandard_func_mode(module_info::in,
+ ground_inst_info::in) is semidet.
% Return the standard mode for a function of the given arity.
%
:- func pred_inst_info_standard_func_mode(arity) = pred_inst_info.
+ % Return true if the given inst may restrict the set of function symbols
+ % that may be successfully unified with the variable that has this inst.
+ %
+ %
+:- func inst_may_restrict_cons_ids(module_info, (inst)) = bool.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -136,7 +142,6 @@
:- import_module mdbcomp__prim_data.
:- import_module parse_tree__prog_mode.
-:- import_module bool.
:- import_module int.
:- import_module list.
:- import_module map.
@@ -146,12 +151,9 @@
:- import_module svmap.
:- import_module svset.
- % Abstractly unify two insts.
-
abstractly_unify_inst(Live, InstA, InstB, UnifyIsReal, Inst, Det,
!ModuleInfo) :-
- % check whether this pair of insts is already in
- % the unify_insts table
+ % Check whether this pair of insts is already in the unify_insts table.
ThisInstPair = unify_inst(Live, InstA, InstB, UnifyIsReal),
module_info_insts(!.ModuleInfo, InstTable0),
inst_table_get_unify_insts(InstTable0, UnifyInsts0),
@@ -161,38 +163,33 @@
Det = UnifyDet
;
Inst0 = defined_inst(ThisInstPair),
- % It's ok to assume that the unification is
- % deterministic here, because the only time that
- % this will happen is when we get to the
- % recursive case for a recursively defined inst.
- % If the unification as a whole is semidet then
- % it must be semidet somewhere else too.
+ % It's ok to assume that the unification is deterministic here,
+ % because the only time that this will happen is when we get to the
+ % recursive case for a recursively defined inst. If the unification
+ % as a whole is semidet then it must be semidet somewhere else too.
Det = det
),
Inst1 = Inst0
;
- % insert ThisInstPair into the table with value
- % `unknown'
- svmap__det_insert(ThisInstPair, unknown,
- UnifyInsts0, UnifyInsts1),
- inst_table_set_unify_insts(UnifyInsts1,
- InstTable0, InstTable1),
+ % Insert ThisInstPair into the table with value `unknown'.
+ svmap__det_insert(ThisInstPair, unknown, UnifyInsts0, UnifyInsts1),
+ inst_table_set_unify_insts(UnifyInsts1, InstTable0, InstTable1),
module_info_set_insts(InstTable1, !ModuleInfo),
- % unify the insts
+ % Unify the insts.
inst_expand(!.ModuleInfo, InstA, InstA2),
inst_expand(!.ModuleInfo, InstB, InstB2),
abstractly_unify_inst_2(Live, InstA2, InstB2, UnifyIsReal,
Inst0, Det, !ModuleInfo),
- % If this unification cannot possible succeed,
- % the correct inst is not_reached.
+ % If this unification cannot possible succeed, the correct inst
+ % is not_reached.
( determinism_components(Det, _, at_most_zero) ->
Inst1 = not_reached
;
Inst1 = Inst0
),
- % now update the value associated with ThisInstPair
+ % Now update the value associated with ThisInstPair.
module_info_insts(!.ModuleInfo, InstTable2),
inst_table_get_unify_insts(InstTable2, UnifyInsts2),
map__det_update(UnifyInsts2, ThisInstPair, known(Inst1, Det),
@@ -200,7 +197,7 @@
inst_table_set_unify_insts(UnifyInsts, InstTable2, InstTable),
module_info_set_insts(InstTable, !ModuleInfo)
),
- % avoid expanding recursive insts
+ % Avoid expanding recursive insts.
( inst_contains_instname(Inst1, !.ModuleInfo, ThisInstPair) ->
Inst = defined_inst(ThisInstPair)
;
@@ -231,13 +228,13 @@
% The is_live parameter is `live' iff *both* insts are live.
% Given the two insts to be unified, this produces
% a resulting inst and a determinism for the unification.
-
+ %
+ % XXX Could be extended to handle `any' insts better.
+ %
:- pred abstractly_unify_inst_3(is_live::in, (inst)::in, (inst)::in,
unify_is_real::in, (inst)::out, determinism::out,
module_info::in, module_info::out) is semidet.
-% XXX could be extended to handle `any' insts better
-
abstractly_unify_inst_3(live, not_reached, _, _, not_reached, det,
!ModuleInfo).
@@ -254,10 +251,10 @@
abstractly_unify_inst_3(live, free, bound(UniqY, List0), Real,
bound(Uniq, List), det, !ModuleInfo) :-
unify_uniq(live, Real, det, unique, UniqY, Uniq),
- % since both are live, we must disallow free-free unifications
+ % Since both are live, we must disallow free-free unifications.
bound_inst_list_is_ground_or_any(List0, !.ModuleInfo),
- % since both are live, we must make the result shared
- % (unless it was already shared)
+ % Since both are live, we must make the result shared
+ % (unless it was already shared).
( ( UniqY = unique ; UniqY = mostly_unique ) ->
make_shared_bound_inst_list(List0, List, !ModuleInfo)
;
@@ -281,7 +278,7 @@
abstractly_unify_inst_3(live, bound(UniqY, List0), free, Real,
bound(Uniq, List), det, !ModuleInfo) :-
unify_uniq(live, Real, det, unique, UniqY, Uniq),
- % since both are live, we must disallow free-free unifications
+ % Since both are live, we must disallow free-free unifications.
bound_inst_list_is_ground_or_any(List0, !.ModuleInfo),
make_shared_bound_inst_list(List0, List, !ModuleInfo).
@@ -311,8 +308,7 @@
unify_uniq(live, Real, det, UniqX, UniqY, Uniq).
abstractly_unify_inst_3(live, ground(Uniq0, higher_order(PredInst)), free,
- Real, ground(Uniq, higher_order(PredInst)), det,
- !ModuleInfo) :-
+ Real, ground(Uniq, higher_order(PredInst)), det, !ModuleInfo) :-
unify_uniq(live, Real, det, unique, Uniq0, Uniq).
abstractly_unify_inst_3(live, ground(UniqX, higher_order(_)),
@@ -330,12 +326,11 @@
% It is an error to unify higher-order preds,
% so if Real \= fake_unify, then we must fail.
Real = fake_unify,
- % In theory we should choose take the union of the
- % information specified by PredInstA and _GroundInstInfoB.
- % However, since our data representation provides no
- % way of doing that, and since this will only happen
- % for fake_unifys, for which it shouldn't make any difference,
- % we just choose the information specified by PredInstA.
+ % In theory we should choose take the union of the information specified
+ % by PredInstA and _GroundInstInfoB. However, since our data representation
+ % provides no way of doing that, and since this will only happen for
+ % fake_unifys, for which it shouldn't make any difference, we just choose
+ % the information specified by PredInstA.
GroundInstInfo = higher_order(PredInstA),
unify_uniq(live, Real, semidet, UniqA, UniqB, Uniq).
@@ -462,7 +457,7 @@
%-----------------------------------------------------------------------------%
% Abstractly unify two inst lists.
-
+ %
:- pred abstractly_unify_inst_list(list(inst)::in, list(inst)::in, is_live::in,
unify_is_real::in, list(inst)::out, determinism::out,
module_info::in, module_info::out) is semidet.
@@ -476,10 +471,9 @@
%-----------------------------------------------------------------------------%
- % This is the abstract unification operation which
- % unifies a variable (or rather, it's instantiatedness)
- % with a functor.
-
+ % This is the abstract unification operation which unifies a variable
+ % (or rather, it's instantiatedness) with a functor.
+ %
abstractly_unify_inst_functor(Live, InstA, ConsId, ArgInsts, ArgLives,
Real, Type, Inst, Det, !ModuleInfo) :-
inst_expand(!.ModuleInfo, InstA, InstA2),
@@ -494,19 +488,16 @@
;
% The inst has become too instantiated so we must remove
% the constrained_inst_var.
- % XXX This throws away the information that Inst is at
- % least as ground as InstVars and is a subtype of
- % InstVars. I don't think this is likely to be a
- % problem in practice because:
- % a) I don't think it's likely to occur very often in
- % typical uses of polymorphic modes (I suspect
- % InstA3 will nearly always be `ground' or `any'
- % in which case the only way inst_matches_final
- % can fail is if Inst0 is clobbered -- it can't be
- % less instantiated than InstA3); and
- % b) Even if this information is retained, I can't
- % see what sort of situations it would actually be
- % useful for.
+ % XXX This throws away the information that Inst is at least as
+ % ground as InstVars and is a subtype of InstVars. I don't think
+ % this is likely to be a problem in practice because:
+ % a) I don't think it's likely to occur very often in typical uses
+ % of polymorphic modes (I suspect InstA3 will nearly always be
+ % `ground' or `any' in which case the only way
+ % inst_matches_final can fail is if Inst0 is clobbered
+ % -- it can't be less instantiated than InstA3); and
+ % b) Even if this information is retained, I can't see what sort
+ % of situations it would actually be useful for.
Inst = Inst0
)
;
@@ -523,8 +514,7 @@
not_reached, erroneous, !ModuleInfo).
abstractly_unify_inst_functor_2(live, free, ConsId, Args0, ArgLives, _Real,
- _, bound(unique, [functor(ConsId, Args)]), det,
- !ModuleInfo) :-
+ _, bound(unique, [functor(ConsId, Args)]), det, !ModuleInfo) :-
inst_list_is_ground_or_any_or_dead(Args0, ArgLives, !.ModuleInfo),
maybe_make_shared_inst_list(Args0, ArgLives, Args, !ModuleInfo).
@@ -597,7 +587,7 @@
% One way of looking at this code is that it simulates mode
% and determinism checking of the goal for the unification
% predicate for the type.
-
+ %
:- pred abstractly_unify_bound_inst_list(is_live::in, list(bound_inst)::in,
list(bound_inst)::in, unify_is_real::in,
list(bound_inst)::out, determinism::out,
@@ -606,10 +596,10 @@
abstractly_unify_bound_inst_list(Live, Xs, Ys, Real, L, Det, !ModuleInfo) :-
( ( Xs = [] ; Ys = [] ) ->
%
- % This probably shouldn't happen. If we get here,
- % it means that a previous goal had determinism
- % `failure' or `erroneous', but we should have optimized
- % away the rest of the conjunction after that goal.
+ % This probably shouldn't happen. If we get here, it means that
+ % a previous goal had determinism `failure' or `erroneous',
+ % but we should have optimized away the rest of the conjunction
+ % after that goal.
%
L = [],
Det = erroneous
@@ -618,10 +608,10 @@
L, Det0, !ModuleInfo),
%
- % If there are multiple alternatives for either of
- % the inputs, or the constructor of the single
- % alternative for each input doesn't match, then the
- % unification can fail, so adjust the determinism.
+ % If there are multiple alternatives for either of the inputs,
+ % or the constructor of the single alternative for each input
+ % doesn't match, then the unification can fail, so adjust the
+ % determinism.
%
(
Xs = [functor(ConsIdX, _)],
@@ -737,9 +727,6 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred unify_uniq(is_live::in, unify_is_real::in, determinism::in,
- uniqueness::in, uniqueness::in, uniqueness::out) is semidet.
-
% Unifying shared with either shared or unique gives shared.
% Unifying unique with unique gives shared if live, unique if
% dead. Unifying clobbered with anything gives clobbered,
@@ -750,6 +737,7 @@
%
% The only way this predicate can abort is if a clobbered value
% is live.
+ %
% The only way this predicate can fail (indicating a unique mode error)
% is if we are attempting to unify with a clobbered value, and
% this was a "real" unification, not a "fake" one,
@@ -766,6 +754,9 @@
% later either. Only semidet unifications would test the value
% of a clobbered variable, so those are the only ones we need to
% disallow.
+ %
+:- pred unify_uniq(is_live::in, unify_is_real::in, determinism::in,
+ uniqueness::in, uniqueness::in, uniqueness::out) is semidet.
unify_uniq(_, _, _, shared, shared, shared).
unify_uniq(_, _, _, shared, unique, shared).
@@ -819,7 +810,7 @@
:- pred check_not_clobbered(uniqueness::in, unify_is_real::in) is det.
- % sanity check
+ % Sanity check.
check_not_clobbered(Uniq, Real) :-
( Real = real_unify, Uniq = clobbered ->
error("abstractly_unify_inst_3: clobbered inst")
@@ -862,9 +853,9 @@
!ModuleInfo),
det_par_conjunction_detism(Det1, Det2, Det).
-% abstractly unify an inst with `ground' and calculate the new inst
-% and the determinism of the unification.
-
+ % Abstractly unify an inst with `ground' and calculate the new inst
+ % and the determinism of the unification.
+ %
:- pred make_ground_inst((inst)::in, is_live::in, uniqueness::in,
unify_is_real::in, (inst)::out, determinism::out,
module_info::in, module_info::out) is semidet.
@@ -899,8 +890,7 @@
semidet, !ModuleInfo).
make_ground_inst(defined_inst(InstName), IsLive, Uniq, Real, Inst, Det,
!ModuleInfo) :-
- % check whether the inst name is already in the
- % ground_inst table
+ % Check whether the inst name is already in the ground_inst table.
module_info_insts(!.ModuleInfo, InstTable0),
inst_table_get_ground_insts(InstTable0, GroundInsts0),
GroundInstKey = ground_inst(InstName, IsLive, Uniq, Real),
@@ -913,39 +903,36 @@
;
GroundInst = defined_inst(GroundInstKey),
Det = det
- % We can safely assume this is det, since
- % if it were semidet, we would have noticed
- % this in the process of unfolding the
+ % We can safely assume this is det, since if it were semidet,
+ % we would have noticed this in the process of unfolding the
% definition.
)
;
- % insert the inst name in the ground_inst table, with
- % value `unknown' for the moment
+ % Insert the inst name in the ground_inst table, with value `unknown'
+ % for the moment.
svmap__det_insert(GroundInstKey, unknown,
GroundInsts0, GroundInsts1),
inst_table_set_ground_insts(GroundInsts1,
InstTable0, InstTable1),
module_info_set_insts(InstTable1, !ModuleInfo),
- % expand the inst name, and invoke ourself recursively on
- % it's expansion
+ % Expand the inst name, and invoke ourself recursively on its
+ % expansion.
inst_lookup(!.ModuleInfo, InstName, Inst0),
inst_expand(!.ModuleInfo, Inst0, Inst1),
make_ground_inst(Inst1, IsLive, Uniq, Real, GroundInst, Det,
!ModuleInfo),
- % now that we have determined the resulting Inst, store
- % the appropriate value `known(GroundInst, Det)' in the
- % ground_inst table
+ % Now that we have determined the resulting Inst, store the appropriate
+ % value `known(GroundInst, Det)' in the ground_inst table.
module_info_insts(!.ModuleInfo, InstTable2),
inst_table_get_ground_insts(InstTable2, GroundInsts2),
svmap__det_update(GroundInstKey, known(GroundInst, Det),
GroundInsts2, GroundInsts),
- inst_table_set_ground_insts(GroundInsts,
- InstTable2, InstTable),
+ inst_table_set_ground_insts(GroundInsts, InstTable2, InstTable),
module_info_set_insts(InstTable, !ModuleInfo)
),
- % avoid expanding recursive insts
+ % Avoid expanding recursive insts.
( inst_contains_instname(GroundInst, !.ModuleInfo, GroundInstKey) ->
Inst = defined_inst(GroundInstKey)
;
@@ -970,9 +957,9 @@
%-----------------------------------------------------------------------------%
-% abstractly unify an inst with `any' and calculate the new inst
-% and the determinism of the unification.
-
+ % Abstractly unify an inst with `any' and calculate the new inst
+ % and the determinism of the unification.
+ %
:- pred make_any_inst((inst)::in, is_live::in, uniqueness::in,
unify_is_real::in, (inst)::out, determinism::out,
module_info::in, module_info::out) is semidet.
@@ -1025,28 +1012,26 @@
;
AnyInst = defined_inst(AnyInstKey),
Det = det
- % We can safely assume this is det, since
- % if it were semidet, we would have noticed
- % this in the process of unfolding the
+ % We can safely assume this is det, since if it were semidet,
+ % we would have noticed this in the process of unfolding the
% definition.
)
;
- % insert the inst name in the any_inst table, with
- % value `unknown' for the moment
+ % Insert the inst name in the any_inst table, with value `unknown'
+ % for the moment.
svmap__det_insert(AnyInstKey, unknown, AnyInsts0, AnyInsts1),
inst_table_set_any_insts(AnyInsts1, InstTable0, InstTable1),
module_info_set_insts(InstTable1, !ModuleInfo),
- % expand the inst name, and invoke ourself recursively on
- % it's expansion
+ % Expand the inst name, and invoke ourself recursively on its
+ % expansion.
inst_lookup(!.ModuleInfo, InstName, Inst0),
inst_expand(!.ModuleInfo, Inst0, Inst1),
make_any_inst(Inst1, IsLive, Uniq, Real, AnyInst, Det,
!ModuleInfo),
- % now that we have determined the resulting Inst, store
- % the appropriate value `known(AnyInst, Det)' in the
- % any_inst table
+ % Now that we have determined the resulting Inst, store the appropriate
+ % value `known(AnyInst, Det)' in the any_inst table.
module_info_insts(!.ModuleInfo, InstTable2),
inst_table_get_any_insts(InstTable2, AnyInsts2),
svmap__det_update(AnyInstKey, known(AnyInst, Det),
@@ -1054,7 +1039,7 @@
inst_table_set_any_insts(AnyInsts, InstTable2, InstTable),
module_info_set_insts(InstTable, !ModuleInfo)
),
- % avoid expanding recursive insts
+ % Avoid expanding recursive insts.
( inst_contains_instname(AnyInst, !.ModuleInfo, AnyInstKey) ->
Inst = defined_inst(AnyInstKey)
;
@@ -1130,9 +1115,9 @@
make_shared_inst(Inst0, Inst, !ModuleInfo),
make_shared_inst_list(Insts0, Insts, !ModuleInfo).
-% make an inst shared; replace all occurrences of `unique' or `mostly_unique'
-% in the inst with `shared'.
-
+ % Make an inst shared; replace all occurrences of `unique' or
+ % `mostly_unique' in the inst with `shared'.
+ %
:- pred make_shared_inst((inst)::in, (inst)::out,
module_info::in, module_info::out) is det.
@@ -1140,10 +1125,10 @@
make_shared_inst(any(Uniq0), any(Uniq), !ModuleInfo) :-
make_shared(Uniq0, Uniq).
make_shared_inst(free, free, !ModuleInfo) :-
- % the caller should ensure that this never happens
+ % The caller should ensure that this never happens.
error("make_shared_inst: cannot make shared version of `free'").
make_shared_inst(free(T), free(T), !ModuleInfo) :-
- % the caller should ensure that this never happens
+ % The caller should ensure that this never happens.
error("make_shared_inst: cannot make shared version of `free(T)'").
make_shared_inst(bound(Uniq0, BoundInsts0), bound(Uniq, BoundInsts),
!ModuleInfo) :-
@@ -1156,9 +1141,7 @@
error("free inst var").
make_shared_inst(constrained_inst_vars(InstVars, Inst0), Inst, !ModuleInfo) :-
make_shared_inst(Inst0, Inst1, !ModuleInfo),
- (
- \+ inst_matches_final(Inst1, Inst0, !.ModuleInfo)
- ->
+ ( \+ inst_matches_final(Inst1, Inst0, !.ModuleInfo) ->
Inst = Inst1
;
Inst = constrained_inst_vars(InstVars, Inst1)
@@ -1166,36 +1149,30 @@
make_shared_inst(abstract_inst(_,_), _, !ModuleInfo) :-
error("make_shared_inst(abstract_inst)").
make_shared_inst(defined_inst(InstName), Inst, !ModuleInfo) :-
- % check whether the inst name is already in the
- % shared_inst table
+ % Check whether the inst name is already in the shared_inst table.
module_info_insts(!.ModuleInfo, InstTable0),
inst_table_get_shared_insts(InstTable0, SharedInsts0),
- (
- map__search(SharedInsts0, InstName, Result)
- ->
+ ( map__search(SharedInsts0, InstName, Result) ->
( Result = known(SharedInst0) ->
SharedInst = SharedInst0
;
SharedInst = defined_inst(InstName)
)
;
- % insert the inst name in the shared_inst table, with
- % value `unknown' for the moment
- svmap__det_insert(InstName, unknown,
- SharedInsts0, SharedInsts1),
- inst_table_set_shared_insts(SharedInsts1,
- InstTable0, InstTable1),
+ % Insert the inst name in the shared_inst table, with value `unknown'
+ % for the moment.
+ svmap__det_insert(InstName, unknown, SharedInsts0, SharedInsts1),
+ inst_table_set_shared_insts(SharedInsts1, InstTable0, InstTable1),
module_info_set_insts(InstTable1, !ModuleInfo),
- % expand the inst name, and invoke ourself recursively on
- % it's expansion
+ % Expand the inst name, and invoke ourself recursively on its
+ % expansion.
inst_lookup(!.ModuleInfo, InstName, Inst0),
inst_expand(!.ModuleInfo, Inst0, Inst1),
make_shared_inst(Inst1, SharedInst, !ModuleInfo),
- % now that we have determined the resulting Inst, store
- % the appropriate value `known(SharedInst)' in the shared_inst
- % table
+ % Now that we have determined the resulting Inst, store the appropriate
+ % value `known(SharedInst)' in the shared_inst table.
module_info_insts(!.ModuleInfo, InstTable2),
inst_table_get_shared_insts(InstTable2, SharedInsts2),
svmap__det_update(InstName, known(SharedInst),
@@ -1204,7 +1181,7 @@
InstTable2, InstTable),
module_info_set_insts(InstTable, !ModuleInfo)
),
- % avoid expanding recursive insts
+ % Avoid expanding recursive insts.
( inst_contains_instname(SharedInst, !.ModuleInfo, InstName) ->
Inst = defined_inst(InstName)
;
@@ -1232,10 +1209,10 @@
%-----------------------------------------------------------------------------%
-% make an inst mostly-uniq: replace all occurrences of `unique'
-% in the inst with `mostly_unique'. (Used by unique_modes.m to
-% change the insts of semidet-live or nondet-live insts.)
-
+ % Make an inst mostly-uniq: replace all occurrences of `unique'
+ % in the inst with `mostly_unique'. (Used by unique_modes.m to
+ % change the insts of semidet-live or nondet-live insts.)
+ %
make_mostly_uniq_inst(not_reached, not_reached, !ModuleInfo).
make_mostly_uniq_inst(any(Uniq0), any(Uniq), !ModuleInfo) :-
make_mostly_uniq(Uniq0, Uniq).
@@ -1254,9 +1231,7 @@
make_mostly_uniq_inst(constrained_inst_vars(InstVars, Inst0), Inst,
!ModuleInfo) :-
make_mostly_uniq_inst(Inst0, Inst1, !ModuleInfo),
- (
- \+ inst_matches_final(Inst1, Inst0, !.ModuleInfo)
- ->
+ ( \+ inst_matches_final(Inst1, Inst0, !.ModuleInfo) ->
Inst = Inst1
;
Inst = constrained_inst_vars(InstVars, Inst1)
@@ -1264,36 +1239,31 @@
make_mostly_uniq_inst(abstract_inst(_,_), _, !ModuleInfo) :-
error("make_mostly_uniq_inst(abstract_inst)").
make_mostly_uniq_inst(defined_inst(InstName), Inst, !ModuleInfo) :-
- % check whether the inst name is already in the
- % mostly_uniq_inst table
+ % Check whether the inst name is already in the mostly_uniq_inst table.
module_info_insts(!.ModuleInfo, InstTable0),
inst_table_get_mostly_uniq_insts(InstTable0, NondetLiveInsts0),
- (
- map__search(NondetLiveInsts0, InstName, Result)
- ->
+ ( map__search(NondetLiveInsts0, InstName, Result) ->
( Result = known(NondetLiveInst0) ->
NondetLiveInst = NondetLiveInst0
;
NondetLiveInst = defined_inst(InstName)
)
;
- % insert the inst name in the mostly_uniq_inst table, with
- % value `unknown' for the moment
- map__det_insert(NondetLiveInsts0, InstName, unknown,
- NondetLiveInsts1),
+ % Insert the inst name in the mostly_uniq_inst table, with value
+ % `unknown' for the moment.
+ map__det_insert(NondetLiveInsts0, InstName, unknown, NondetLiveInsts1),
inst_table_set_mostly_uniq_insts(NondetLiveInsts1,
InstTable0, InstTable1),
module_info_set_insts(InstTable1, !ModuleInfo),
- % expand the inst name, and invoke ourself recursively on
- % it's expansion
+ % Expand the inst name, and invoke ourself recursively on its
+ % expansion.
inst_lookup(!.ModuleInfo, InstName, Inst0),
inst_expand(!.ModuleInfo, Inst0, Inst1),
make_mostly_uniq_inst(Inst1, NondetLiveInst, !ModuleInfo),
- % now that we have determined the resulting Inst, store
- % the appropriate value `known(NondetLiveInst)' in the
- % mostly_uniq_inst table
+ % Now that we have determined the resulting Inst, store the appropriate
+ % value `known(NondetLiveInst)' in the mostly_uniq_inst table.
module_info_insts(!.ModuleInfo, InstTable2),
inst_table_get_mostly_uniq_insts(InstTable2, NondetLiveInsts2),
svmap__det_update(InstName, known(NondetLiveInst),
@@ -1342,7 +1312,7 @@
% and `any' insts?
% Previously we only allowed this for fake_unifies,
% but now we allow it for real_unifies too.
-
+ %
:- pred allow_unify_bound_any(unify_is_real::in) is det.
allow_unify_bound_any(_) :- true.
@@ -1350,16 +1320,14 @@
%-----------------------------------------------------------------------------%
% inst_merge(InstA, InstB, InstC):
- % Combine the insts found in different arms of a
- % disjunction (or if-then-else).
- % The information in InstC is the minimum of the
- % information in InstA and InstB. Where InstA and
- % InstB specify a binding (free or bound), it must be
- % the same in both.
-
+ %
+ % Combine the insts found in different arms of a disjunction (or
+ % if-then-else). The information in InstC is the minimum of the information
+ % in InstA and InstB. Where InstA and InstB specify a binding (free
+ % or bound), it must be the same in both.
+ %
inst_merge(InstA, InstB, MaybeType, Inst, !ModuleInfo) :-
- % check whether this pair of insts is already in
- % the merge_insts table
+ % Check whether this pair of insts is already in the merge_insts table.
module_info_insts(!.ModuleInfo, InstTable0),
inst_table_get_merge_insts(InstTable0, MergeInstTable0),
ThisInstPair = InstA - InstB,
@@ -1370,32 +1338,25 @@
Inst0 = defined_inst(merge_inst(InstA, InstB))
)
;
- % insert ThisInstPair into the table with value
- % `unknown'
+ % Insert ThisInstPair into the table with value `unknown'.
map__det_insert(MergeInstTable0, ThisInstPair, unknown,
MergeInstTable1),
- inst_table_set_merge_insts(MergeInstTable1,
- InstTable0, InstTable1),
+ inst_table_set_merge_insts(MergeInstTable1, InstTable0, InstTable1),
module_info_set_insts(InstTable1, !ModuleInfo),
- % merge the insts
- inst_merge_2(InstA, InstB, MaybeType, Inst0,
- !ModuleInfo),
+ % Merge the insts.
+ inst_merge_2(InstA, InstB, MaybeType, Inst0, !ModuleInfo),
- % now update the value associated with ThisInstPair
+ % Now update the value associated with ThisInstPair.
module_info_insts(!.ModuleInfo, InstTable2),
inst_table_get_merge_insts(InstTable2, MergeInstTable2),
map__det_update(MergeInstTable2, ThisInstPair, known(Inst0),
MergeInstTable3),
- inst_table_set_merge_insts(MergeInstTable3,
- InstTable2, InstTable3),
+ inst_table_set_merge_insts(MergeInstTable3, InstTable2, InstTable3),
module_info_set_insts(InstTable3, !ModuleInfo)
),
- % avoid expanding recursive insts
- (
- inst_contains_instname(Inst0, !.ModuleInfo,
- merge_inst(InstA, InstB))
- ->
+ % Avoid expanding recursive insts.
+ ( inst_contains_instname(Inst0, !.ModuleInfo, merge_inst(InstA, InstB)) ->
Inst = defined_inst(merge_inst(InstA, InstB))
;
Inst = Inst0
@@ -1405,12 +1366,10 @@
module_info::in, module_info::out) is semidet.
inst_merge_2(InstA, InstB, MaybeType, Inst, !ModuleInfo) :-
-/*********
- % would this test improve efficiency??
- ( InstA = InstB ->
- Inst = InstA,
- ;
-*********/
+% % would this test improve efficiency??
+% ( InstA = InstB ->
+% Inst = InstA,
+% ;
inst_expand(!.ModuleInfo, InstA, InstA2),
inst_expand(!.ModuleInfo, InstB, InstB2),
( InstB2 = not_reached ->
@@ -1425,16 +1384,14 @@
inst_merge_3(InstA, InstB, MaybeType, Inst, !ModuleInfo) :-
( InstA = constrained_inst_vars(InstVarsA, InstA1) ->
( InstB = constrained_inst_vars(InstVarsB, InstB1) ->
- inst_merge(InstA1, InstB1, MaybeType, Inst0,
- !ModuleInfo),
+ inst_merge(InstA1, InstB1, MaybeType, Inst0, !ModuleInfo),
InstVars = InstVarsA `set__intersect` InstVarsB,
( set__non_empty(InstVars) ->
Inst = constrained_inst_vars(InstVars, Inst0)
- % We can keep the constrained_inst_vars here
- % since Inst0 = InstA1 `lub` InstB1 and the
- % original constraint on the InstVars, InstC,
- % must have been such that
- % InstA1 `lub` InstB1 =< InstC
+ % We can keep the constrained_inst_vars here since
+ % Inst0 = InstA1 `lub` InstB1 and the original constraint
+ % on the InstVars, InstC, must have been such that
+ % InstA1 `lub` InstB1 =< InstC.
;
Inst = Inst0
)
@@ -1463,11 +1420,11 @@
inst_merge_4(any(UniqA), any(UniqB), _, any(Uniq), !ModuleInfo) :-
merge_uniq(UniqA, UniqB, Uniq).
inst_merge_4(any(Uniq), free, _, any(Uniq), !ModuleInfo) :-
- % we do not yet allow merge of any with free, except for clobbered anys
+ % We do not yet allow merge of any with free, except for clobbered anys.
( Uniq = clobbered ; Uniq = mostly_clobbered ).
inst_merge_4(any(UniqA), bound(UniqB, ListB), _, any(Uniq), !ModuleInfo) :-
merge_uniq_bound(UniqA, UniqB, ListB, !.ModuleInfo, Uniq),
- % we do not yet allow merge of any with free, except for clobbered anys
+ % We do not yet allow merge of any with free, except for clobbered anys.
( ( Uniq = clobbered ; Uniq = mostly_clobbered ) ->
true
;
@@ -1477,14 +1434,14 @@
merge_uniq(UniqA, UniqB, Uniq).
inst_merge_4(any(UniqA), abstract_inst(_, _), _, any(Uniq), !ModuleInfo) :-
merge_uniq(UniqA, shared, Uniq),
- % we do not yet allow merge of any with free, except for clobbered anys
+ % We do not yet allow merge of any with free, except for clobbered anys.
( Uniq = clobbered ; Uniq = mostly_clobbered ).
inst_merge_4(free, any(Uniq), _, any(Uniq), !ModuleInfo) :-
- % we do not yet allow merge of any with free, except for clobbered anys
+ % We do not yet allow merge of any with free, except for clobbered anys.
( Uniq = clobbered ; Uniq = mostly_clobbered ).
inst_merge_4(bound(UniqA, ListA), any(UniqB), _, any(Uniq), !ModuleInfo) :-
merge_uniq_bound(UniqB, UniqA, ListA, !.ModuleInfo, Uniq),
- % we do not yet allow merge of any with free, except for clobbered anys
+ % We do not yet allow merge of any with free, except for clobbered anys.
( ( Uniq = clobbered ; Uniq = mostly_clobbered ) ->
true
;
@@ -1494,7 +1451,7 @@
merge_uniq(UniqA, UniqB, Uniq).
inst_merge_4(abstract_inst(_, _), any(UniqB), _, any(Uniq), !ModuleInfo) :-
merge_uniq(shared, UniqB, Uniq),
- % we do not yet allow merge of any with free, except for clobbered anys
+ % We do not yet allow merge of any with free, except for clobbered anys.
( Uniq = clobbered ; Uniq = mostly_clobbered ).
inst_merge_4(free, free, _, free, !ModuleInfo).
inst_merge_4(bound(UniqA, ListA), bound(UniqB, ListB), MaybeType,
@@ -1515,9 +1472,9 @@
GroundInstInfoA = higher_order(PredA),
GroundInstInfoB = higher_order(PredB)
->
- % if they specify matching pred insts, but one is more
- % precise (specifies more info) than the other,
- % then we want to choose the least precise one
+ % If they specify matching pred insts, but one is more precise
+ % (specifies more info) than the other, then we want to choose
+ % the least precise one.
( pred_inst_matches(PredA, PredB, !.ModuleInfo) ->
GroundInstInfo = higher_order(PredB)
; pred_inst_matches(PredB, PredA, !.ModuleInfo) ->
@@ -1526,17 +1483,15 @@
% If either is a function inst with non-standard
% modes, don't allow the higher-order
% information to be lost.
- \+ pred_inst_info_is_nonstandard_func_mode(PredA,
- !.ModuleInfo),
- \+ pred_inst_info_is_nonstandard_func_mode(PredB,
- !.ModuleInfo),
+ \+ pred_inst_info_is_nonstandard_func_mode(!.ModuleInfo, PredA),
+ \+ pred_inst_info_is_nonstandard_func_mode(!.ModuleInfo, PredB),
GroundInstInfo = none
)
;
- \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoA,
- !.ModuleInfo),
- \+ ground_inst_info_is_nonstandard_func_mode(GroundInstInfoB,
- !.ModuleInfo),
+ \+ ground_inst_info_is_nonstandard_func_mode(!.ModuleInfo,
+ GroundInstInfoA),
+ \+ ground_inst_info_is_nonstandard_func_mode(!.ModuleInfo,
+ GroundInstInfoB),
GroundInstInfo = none
),
merge_uniq(UniqA, UniqB, Uniq).
@@ -1547,12 +1502,11 @@
inst_list_merge(ArgsA, ArgsB, MaybeTypes, Args, !ModuleInfo).
inst_merge_4(not_reached, Inst, _, Inst, !ModuleInfo).
+ % merge_uniq(A, B, C) succeeds if C is minimum of A and B in the ordering
+ % clobbered < mostly_clobbered < shared < mostly_unique < unique.
+ %
:- pred merge_uniq(uniqueness::in, uniqueness::in, uniqueness::out) is det.
- % merge_uniq(A, B, C) succeeds if C is minimum of A and B in
- % the ordering
- % clobbered < mostly_clobbered < shared < mostly_unique < unique
-
merge_uniq(UniqA, UniqB, Merged) :-
( unique_matches_initial(UniqA, UniqB) -> % A >= B
Merged = UniqB
@@ -1562,7 +1516,7 @@
% merge_uniq_bound(UniqA, UniqB, ListB, ModuleInfo, Uniq) succeeds iff
% Uniq is the result of merging
-
+ %
:- pred merge_uniq_bound(uniqueness::in, uniqueness::in, list(bound_inst)::in,
module_info::in, uniqueness::out) is det.
@@ -1640,15 +1594,14 @@
(
MaybeType = yes(Type),
type_constructors(Type, !.ModuleInfo, Constructors),
- constructors_to_bound_insts(Constructors, UniqB,
- !.ModuleInfo, ListB0),
+ constructors_to_bound_insts(!.ModuleInfo, UniqB, Constructors,
+ ListB0),
list__sort_and_remove_dups(ListB0, ListB),
inst_merge_4(bound(UniqA, ListA), bound(UniqB, ListB),
MaybeType, Result, !ModuleInfo)
;
MaybeType = no,
- merge_uniq_bound(UniqB, UniqA, ListA, !.ModuleInfo,
- Uniq),
+ merge_uniq_bound(UniqB, UniqA, ListA, !.ModuleInfo, Uniq),
Result = any(Uniq)
)
).
@@ -1669,7 +1622,7 @@
% Here we perform a sorted merge operation,
% so that the functors of the output list Zs are the union
% of the functors of the input lists Xs and Ys.
-
+ %
:- pred bound_inst_list_merge(list(bound_inst)::in, list(bound_inst)::in,
maybe(type)::in, list(bound_inst)::out,
module_info::in, module_info::out) is semidet.
@@ -1687,61 +1640,57 @@
( cons_ids_match(ConsIdX, ConsIdY) ->
maybe_get_cons_id_arg_types(!.ModuleInfo, MaybeType,
ConsIdX, list__length(ArgsX), MaybeTypes),
- inst_list_merge(ArgsX, ArgsY, MaybeTypes, Args,
- !ModuleInfo),
+ inst_list_merge(ArgsX, ArgsY, MaybeTypes, Args, !ModuleInfo),
Z = functor(ConsIdX, Args),
Zs = [Z | Zs1],
- bound_inst_list_merge(Xs1, Ys1, MaybeType, Zs1,
- !ModuleInfo)
+ bound_inst_list_merge(Xs1, Ys1, MaybeType, Zs1, !ModuleInfo)
; compare(<, ConsIdX, ConsIdY) ->
Zs = [X | Zs1],
- bound_inst_list_merge(Xs1, Ys, MaybeType, Zs1,
- !ModuleInfo)
+ bound_inst_list_merge(Xs1, Ys, MaybeType, Zs1, !ModuleInfo)
;
Zs = [Y | Zs1],
- bound_inst_list_merge(Xs, Ys1, MaybeType, Zs1,
- !ModuleInfo)
+ bound_inst_list_merge(Xs, Ys1, MaybeType, Zs1, !ModuleInfo)
)
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-inst_contains_nonstandard_func_mode(Inst, ModuleInfo) :-
+inst_contains_nonstandard_func_mode(ModuleInfo, Inst) :-
set__init(Expansions0),
- inst_contains_nonstandard_func_mode_2(Inst, ModuleInfo, Expansions0).
+ inst_contains_nonstandard_func_mode_2(ModuleInfo, Inst, Expansions0).
-:- pred inst_contains_nonstandard_func_mode_2((inst)::in, module_info::in,
+:- pred inst_contains_nonstandard_func_mode_2(module_info::in, (inst)::in,
set(inst)::in) is semidet.
-inst_contains_nonstandard_func_mode_2(ground(_, GroundInstInfo), ModuleInfo,
+inst_contains_nonstandard_func_mode_2(ModuleInfo, ground(_, GroundInstInfo),
_Expansions) :-
- ground_inst_info_is_nonstandard_func_mode(GroundInstInfo, ModuleInfo).
-inst_contains_nonstandard_func_mode_2(bound(_, BoundInsts), ModuleInfo,
+ ground_inst_info_is_nonstandard_func_mode(ModuleInfo, GroundInstInfo).
+inst_contains_nonstandard_func_mode_2(ModuleInfo, bound(_, BoundInsts),
Expansions) :-
list__member(functor(_, Insts), BoundInsts),
list__member(Inst, Insts),
- inst_contains_nonstandard_func_mode_2(Inst, ModuleInfo, Expansions).
-inst_contains_nonstandard_func_mode_2(inst_var(_), _, _) :-
+ inst_contains_nonstandard_func_mode_2(ModuleInfo, Inst, Expansions).
+inst_contains_nonstandard_func_mode_2(_, inst_var(_), _) :-
error("internal error: uninstantiated inst parameter").
-inst_contains_nonstandard_func_mode_2(Inst, ModuleInfo, Expansions0) :-
+inst_contains_nonstandard_func_mode_2(ModuleInfo, Inst, Expansions0) :-
Inst = defined_inst(InstName),
\+ set__member(Inst, Expansions0),
set__insert(Expansions0, Inst, Expansions1),
inst_lookup(ModuleInfo, InstName, Inst2),
- inst_contains_nonstandard_func_mode_2(Inst2, ModuleInfo, Expansions1).
+ inst_contains_nonstandard_func_mode_2(ModuleInfo, Inst2, Expansions1).
%-----------------------------------------------------------------------------%
-pred_inst_info_is_nonstandard_func_mode(PredInstInfo, ModuleInfo) :-
+pred_inst_info_is_nonstandard_func_mode(ModuleInfo, PredInstInfo) :-
PredInstInfo = pred_inst_info(function, ArgModes, _),
Arity = list__length(ArgModes),
\+ pred_inst_matches(PredInstInfo,
pred_inst_info_standard_func_mode(Arity), ModuleInfo).
-ground_inst_info_is_nonstandard_func_mode(GroundInstInfo, ModuleInfo) :-
+ground_inst_info_is_nonstandard_func_mode(ModuleInfo, GroundInstInfo) :-
GroundInstInfo = higher_order(PredInstInfo),
- pred_inst_info_is_nonstandard_func_mode(PredInstInfo, ModuleInfo).
+ pred_inst_info_is_nonstandard_func_mode(ModuleInfo, PredInstInfo).
pred_inst_info_standard_func_mode(Arity) =
pred_inst_info(function, ArgModes, det) :-
@@ -1780,5 +1729,39 @@
).
%-----------------------------------------------------------------------------%
-:- end_module inst_util.
+
+inst_may_restrict_cons_ids(ModuleInfo, Inst) = MayRestrict :-
+ (
+ Inst = any(_),
+ MayRestrict = yes
+ ;
+ Inst = free,
+ MayRestrict = no
+ ;
+ Inst = free(_),
+ MayRestrict = no
+ ;
+ Inst = bound(_, _),
+ MayRestrict = yes
+ ;
+ Inst = ground(_, _),
+ MayRestrict = no
+ ;
+ Inst = not_reached,
+ MayRestrict = no
+ ;
+ Inst = inst_var(_),
+ MayRestrict = yes
+ ;
+ Inst = constrained_inst_vars(_, _),
+ MayRestrict = yes
+ ;
+ Inst = defined_inst(InstName),
+ inst_lookup(ModuleInfo, InstName, NewInst),
+ MayRestrict = inst_may_restrict_cons_ids(ModuleInfo, NewInst)
+ ;
+ Inst = abstract_inst(_, _),
+ MayRestrict = yes
+ ).
+
%-----------------------------------------------------------------------------%
Index: compiler/instmap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/instmap.m,v
retrieving revision 1.40
diff -u -b -r1.40 instmap.m
--- compiler/instmap.m 23 May 2005 03:15:35 -0000 1.40
+++ compiler/instmap.m 22 Aug 2005 14:36:22 -0000
@@ -1,8 +1,11 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2001, 2003-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
+%
% File: instmap.m
% Main author: bromage.
%
@@ -120,8 +123,7 @@
%-----------------------------------------------------------------------------%
- % Given an instmap and a variable, determine the inst of
- % that variable.
+ % Given an instmap and a variable, determine the inst of that variable.
%
:- pred instmap__lookup_var(instmap::in, prog_var::in, (inst)::out) is det.
@@ -181,30 +183,28 @@
; test_size.
% Given two instmaps and a set of variables, compute an instmap delta
- % which records the change in the instantiation state of those
- % variables.
+ % which records the change in the instantiation state of those variables.
%
:- pred compute_instmap_delta(instmap::in, instmap::in, set(prog_var)::in,
instmap_delta::out) is det.
- % Given an instmap and an instmap_delta, apply the instmap_delta
- % to the instmap to produce a new instmap.
+ % Given an instmap and an instmap_delta, overlay the entries in the
+ % instmap_delta on top of those in the instmap to produce a new instmap.
%
:- pred instmap__apply_instmap_delta(instmap::in, instmap_delta::in,
instmap::out) is det.
- % Given an instmap_delta and an instmap_delta, apply the
- % second instmap_delta to the first to produce a new instmap_delta.
+ % Given two instmap_deltas, overlay the entries in the second instmap_delta
+ % on top of those in the first to produce a new instmap_delta.
%
:- pred instmap_delta_apply_instmap_delta(instmap_delta::in, instmap_delta::in,
overlay_how::in, instmap_delta::out) is det.
% instmap_merge(NonLocalVars, InstMaps, MergeContext):
%
- % Merge the `InstMaps' resulting from different branches of a
- % disjunction or if-then-else, and update the instantiatedness
- % of all the nonlocal variables, checking that it is the same
- % for every branch.
+ % Merge the `InstMaps' resulting from different branches of a disjunction
+ % or if-then-else, and update the instantiatedness of all the nonlocal
+ % variables, checking that it is the same for every branch.
%
:- pred instmap__merge(set(prog_var)::in, list(instmap)::in, merge_context::in,
mode_info::in, mode_info::out) is det.
@@ -220,23 +220,20 @@
:- pred instmap__unify(set(prog_var)::in, list(pair(instmap,
set(prog_var)))::in, mode_info::in, mode_info::out) is det.
- % instmap__restrict takes an instmap and a set of vars and
- % returns an instmap with its domain restricted to those
- % vars.
+ % instmap__restrict takes an instmap and a set of vars and returns
+ % an instmap with its domain restricted to those vars.
%
:- pred instmap__restrict(instmap::in, set(prog_var)::in, instmap::out)
is det.
- % instmap_delta_restrict takes an instmap and a set of vars
- % and returns an instmap_delta with its domain restricted to
- % those vars.
+ % instmap_delta_restrict takes an instmap and a set of vars and returns
+ % an instmap_delta with its domain restricted to those vars.
%
:- pred instmap_delta_restrict(instmap_delta::in, set(prog_var)::in,
instmap_delta::out) is det.
- % instmap_delta_delete_vars takes an instmap_delta and a list of
- % vars and returns an instmap_delta with those vars removed from
- % its domain.
+ % instmap_delta_delete_vars takes an instmap_delta and a list of vars
+ % and returns an instmap_delta with those vars removed from its domain.
%
:- pred instmap_delta_delete_vars(instmap_delta::in, list(prog_var)::in,
instmap_delta::out) is det.
@@ -370,10 +367,10 @@
instmap_delta_from_assoc_list(AL, reachable(Instmapping)) :-
map__from_assoc_list(AL, Instmapping).
-instmap_delta_map_foldl(_, unreachable, unreachable, T, T).
+instmap_delta_map_foldl(_, unreachable, unreachable, !T).
instmap_delta_map_foldl(P, reachable(Instmapping0), reachable(Instmapping),
- T0, T) :-
- map__map_foldl(P, Instmapping0, Instmapping, T0, T).
+ !T) :-
+ map__map_foldl(P, Instmapping0, Instmapping, !T).
%-----------------------------------------------------------------------------%
@@ -386,20 +383,18 @@
module_info::in, instmap_delta::in, instmap_delta::out) is det.
instmap_delta_from_mode_list_2([], [], _, !InstMapDelta).
-instmap_delta_from_mode_list_2([], [_|_], _, !InstMapDelta) :-
+instmap_delta_from_mode_list_2([], [_ | _], _, !InstMapDelta) :-
error("instmap_delta_from_mode_list_2").
-instmap_delta_from_mode_list_2([_|_], [], _, !InstMapDelta) :-
+instmap_delta_from_mode_list_2([_ | _], [], _, !InstMapDelta) :-
error("instmap_delta_from_mode_list_2").
instmap_delta_from_mode_list_2([Var | Vars], [Mode | Modes], ModuleInfo,
!InstMapDelta) :-
mode_get_insts(ModuleInfo, Mode, Inst1, Inst2),
( Inst1 = Inst2 ->
- instmap_delta_from_mode_list_2(Vars, Modes, ModuleInfo,
- !InstMapDelta)
+ instmap_delta_from_mode_list_2(Vars, Modes, ModuleInfo, !InstMapDelta)
;
instmap_delta_set(!.InstMapDelta, Var, Inst2, !:InstMapDelta),
- instmap_delta_from_mode_list_2(Vars, Modes, ModuleInfo,
- !InstMapDelta)
+ instmap_delta_from_mode_list_2(Vars, Modes, ModuleInfo, !InstMapDelta)
).
%-----------------------------------------------------------------------------%
@@ -430,7 +425,7 @@
changed_vars_2([], _InstMapA, _InstMapB, _Types, _ModuleInfo, ChangedVars) :-
set__init(ChangedVars).
-changed_vars_2([VarB|VarBs], InstMapA, InstMapB, VarTypes, ModuleInfo,
+changed_vars_2([VarB | VarBs], InstMapA, InstMapB, VarTypes, ModuleInfo,
ChangedVars) :-
changed_vars_2(VarBs, InstMapA, InstMapB, VarTypes, ModuleInfo,
ChangedVars0),
@@ -439,9 +434,7 @@
instmap__lookup_var(InstMapB, VarB, FinalInst),
map__lookup(VarTypes, VarB, Type),
- (
- inst_matches_final(InitialInst, FinalInst, Type, ModuleInfo)
- ->
+ ( inst_matches_final(InitialInst, FinalInst, Type, ModuleInfo) ->
ChangedVars = ChangedVars0
;
set__insert(ChangedVars0, VarB, ChangedVars)
@@ -449,9 +442,6 @@
%-----------------------------------------------------------------------------%
- % Given an instmap and a variable, determine the inst of
- % that variable.
-
instmap__lookup_var(unreachable, _Var, not_reached).
instmap__lookup_var(reachable(InstMap), Var, Inst) :-
instmapping_lookup_var(InstMap, Var, Inst).
@@ -476,8 +466,7 @@
instmap__lookup_vars(Args, InstMap, Insts).
instmap__set(unreachable, _Var, _Inst, unreachable).
-instmap__set(reachable(InstMapping0), Var, Inst,
- reachable(InstMapping)) :-
+instmap__set(reachable(InstMapping0), Var, Inst, reachable(InstMapping)) :-
map__set(InstMapping0, Var, Inst, InstMapping).
instmap__set_vars(InstMap, [], [], InstMap).
@@ -517,16 +506,11 @@
;
InstmapDelta0 = reachable(InstmappingDelta0),
- %
% Get the initial inst from the InstMap
- %
instmap__lookup_var(InstMap, Var, OldInst),
- %
- % Compute the new inst by taking the old inst,
- % applying the instmap delta to it,
- % and then unifying with bound(ConsId, ...)
- %
+ % Compute the new inst by taking the old inst, applying the instmap
+ % delta to it, and then unifying with bound(ConsId, ...).
( map__search(InstmappingDelta0, Var, NewInst0) ->
NewInst1 = NewInst0
;
@@ -535,12 +519,9 @@
bind_inst_to_functor(Type, ConsId, NewInst1, NewInst,
!ModuleInfo),
- %
- % add `Var :: OldInst -> NewInst' to the instmap delta
- %
+ % add `Var :: OldInst -> NewInst' to the instmap delta.
( NewInst \= OldInst ->
- instmap_delta_set(InstmapDelta0, Var, NewInst,
- InstmapDelta)
+ instmap_delta_set(InstmapDelta0, Var, NewInst, InstmapDelta)
;
InstmapDelta = InstmapDelta0
)
@@ -571,27 +552,19 @@
%-----------------------------------------------------------------------------%
instmap__pre_lambda_update(ModuleInfo, Vars, Modes, InstMap0, InstMap) :-
- mode_list_get_initial_insts(Modes, ModuleInfo, Insts),
+ mode_list_get_initial_insts(ModuleInfo, Modes, Insts),
assoc_list__from_corresponding_lists(Vars, Insts, VarInsts),
instmap_delta_from_assoc_list(VarInsts, InstMapDelta),
instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap).
%-----------------------------------------------------------------------------%
- % Given an instmap and an instmap_delta, overlay the
- % entries in the instmap_delta on top of those in the
- % instmap to produce a new instmap.
-
instmap__apply_instmap_delta(unreachable, _, unreachable).
instmap__apply_instmap_delta(reachable(_), unreachable, unreachable).
instmap__apply_instmap_delta(reachable(InstMapping0),
reachable(InstMappingDelta), reachable(InstMapping)) :-
map__overlay(InstMapping0, InstMappingDelta, InstMapping).
- % Given two instmap_deltas, overlay the entries in the second
- % instmap_delta on top of those in the first to produce a new
- % instmap_delta.
-
instmap_delta_apply_instmap_delta(InstMap1, InstMap2, How, InstMap) :-
(
InstMap1 = unreachable,
@@ -647,11 +620,10 @@
%-----------------------------------------------------------------------------%
% instmap__merge(NonLocalVars, InstMaps, MergeContext):
- % Merge the `InstMaps' resulting from different branches
- % of a disjunction or if-then-else, and update the
- % instantiatedness of all the nonlocal variables,
- % checking that it is the same for every branch.
-
+ % Merge the `InstMaps' resulting from different branches of a disjunction
+ % or if-then-else, and update the instantiatedness of all the nonlocal
+ % variables, checking that it is the same for every branch.
+ %
instmap__merge(NonLocals, InstMapList, MergeContext, ModeInfo0, ModeInfo) :-
mode_info_get_instmap(ModeInfo0, InstMap0),
mode_info_get_module_info(ModeInfo0, ModuleInfo0),
@@ -663,16 +635,13 @@
set__to_sorted_list(NonLocals, NonLocalsList),
mode_info_get_var_types(ModeInfo0, VarTypes),
instmap__merge_2(NonLocalsList, InstMapList, VarTypes,
- InstMapping0, InstMapping, ModuleInfo0, ModuleInfo,
- ErrorList),
+ InstMapping0, InstMapping, ModuleInfo0, ModuleInfo, ErrorList),
mode_info_set_module_info(ModuleInfo, ModeInfo0, ModeInfo1),
( ErrorList = [FirstError | _] ->
FirstError = Var - _,
set__singleton_set(WaitingVars, Var),
mode_info_error(WaitingVars,
- mode_error_disj(MergeContext, ErrorList),
- ModeInfo1, ModeInfo2
- )
+ mode_error_disj(MergeContext, ErrorList), ModeInfo1, ModeInfo2)
;
ModeInfo2 = ModeInfo1
),
@@ -698,10 +667,9 @@
%-----------------------------------------------------------------------------%
% instmap__merge_2(Vars, InstMaps, ModuleInfo, ErrorList):
- % Let `ErrorList' be the list of variables in `Vars' for
- % there are two instmaps in `InstMaps' for which the inst
- % the variable is incompatible.
-
+ % Let `ErrorList' be the list of variables in `Vars' for there are two
+ % instmaps in `InstMaps' for which the inst the variable is incompatible.
+ %
:- pred instmap__merge_2(list(prog_var)::in, list(instmap)::in, vartypes::in,
instmapping::in, instmapping::out, module_info::in, module_info::out,
merge_errors::out) is det.
@@ -777,14 +745,13 @@
instmap__unify(NonLocals, InstMapList, !ModeInfo) :-
(
- % If any of the instmaps is unreachable, then
- % the final instmap is unreachable.
+ % If any of the instmaps is unreachable, then the final instmap
+ % is unreachable.
list__member(unreachable - _, InstMapList)
->
mode_info_set_instmap(unreachable, !ModeInfo)
;
- % If there is only one instmap, then we just
- % stick it in the mode_info.
+ % If there is only one instmap, then we just stick it in the mode_info.
InstMapList = [InstMap - _]
->
mode_info_set_instmap(InstMap, !ModeInfo)
@@ -792,19 +759,17 @@
InstMapList = [InstMap0 - _|InstMapList1],
InstMap0 = reachable(InstMapping0)
->
- % having got the first instmapping, to use as
- % an accumulator, all instmap__unify_2 which
- % unifies each of the nonlocals from each instmap
- % with the corresponding inst in the accumulator.
+ % Having got the first instmapping, to use as an accumulator,
+ % all instmap__unify_2 which unifies each of the nonlocals from
+ % each instmap with the corresponding inst in the accumulator.
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
set__to_sorted_list(NonLocals, NonLocalsList),
instmap__unify_2(NonLocalsList, InstMap0, InstMapList1,
- ModuleInfo0, InstMapping0, ModuleInfo,
- InstMapping, ErrorList),
+ ModuleInfo0, InstMapping0, ModuleInfo, InstMapping, ErrorList),
mode_info_set_module_info(ModuleInfo, !ModeInfo),
- % If there were any errors, then add the error
- % to the list of possible errors in the mode_info.
+ % If there were any errors, then add the error to the list
+ % of possible errors in the mode_info.
(
ErrorList = [FirstError | _],
FirstError = Var - _,
@@ -821,12 +786,11 @@
%-----------------------------------------------------------------------------%
- % instmap__unify_2(Vars, InitialInstMap, InstMaps, ModuleInfo,
- % ErrorList):
+ % instmap__unify_2(Vars, InitialInstMap, InstMaps, ModuleInfo, ErrorList):
%
- % Let `ErrorList' be the list of variables in `Vars' for which
- % there are two instmaps in `InstMaps' for which the insts
- % of the variable is incompatible.
+ % Let `ErrorList' be the list of variables in `Vars' for which there are
+ % two instmaps in `InstMaps' for which the insts of the variable is
+ % incompatible.
%
:- pred instmap__unify_2(list(prog_var)::in, instmap::in,
list(pair(instmap, set(prog_var)))::in, module_info::in,
@@ -841,15 +805,18 @@
instmap__lookup_var(InitialInstMap, Var, InitialVarInst),
instmap__unify_var(InstMapList, Var, [], Insts, InitialVarInst, Inst,
ModuleInfo1, ModuleInfo, no, Error),
- ( Error = yes ->
+ (
+ Error = yes,
ErrorList = [Var - Insts | ErrorList1]
;
+ Error = no,
ErrorList = ErrorList1
),
map__set(InstMap1, Var, Inst, InstMap).
% instmap__unify_var(InstMaps, Var, InitialInstMap, ModuleInfo,
% Insts, Error):
+ %
% Let `Insts' be the list of the inst of `Var' in each of the
% corresponding `InstMaps'. Let `Error' be yes iff there are two
% instmaps for which the inst of `Var' is incompatible.
@@ -866,9 +833,7 @@
(
% We can ignore the determinism of the unification:
% if it isn't det, then there will be a mode error
- % or a determinism error in one of the parallel
- % conjuncts.
-
+ % or a determinism error in one of the parallel conjuncts.
abstractly_unify_inst(live, !.Inst, VarInst,
fake_unify, !:Inst, _Det, !ModuleInfo)
->
@@ -885,10 +850,6 @@
%-----------------------------------------------------------------------------%
- % Given two instmaps and a set of variables, compute an instmap delta
- % which records the change in the instantiation state of those
- % variables.
- %
compute_instmap_delta(unreachable, _, _, unreachable).
compute_instmap_delta(reachable(_), unreachable, _, unreachable).
compute_instmap_delta(reachable(InstMapA), reachable(InstMapB), NonLocals,
@@ -925,14 +886,13 @@
instmap__no_output_vars_2([], _, _, _, _).
instmap__no_output_vars_2([Var | Vars], InstMap0, InstMapDelta, VarTypes,
ModuleInfo) :-
- % We use `inst_matches_binding' to check that the new inst
- % has only added information or lost uniqueness,
- % not bound anything.
- % If the instmap delta contains the variable, the variable may
- % still not be output, if the change is just an increase in
- % information rather than an increase in instantiatedness.
- % If the instmap delta doesn't contain the variable, it may still
- % have been (partially) output, if its inst is (or contains) `any'.
+ % We use `inst_matches_binding' to check that the new inst has only
+ % added information or lost uniqueness, not bound anything.
+ % If the instmap delta contains the variable, the variable may still
+ % not be output, if the change is just an increase in information
+ % rather than an increase in instantiatedness. If the instmap delta
+ % doesn't contain the variable, it may still have been (partially) output,
+ % if its inst is (or contains) `any'.
instmap__lookup_var(InstMap0, Var, Inst0),
( map__search(InstMapDelta, Var, Inst1) ->
Inst = Inst1
@@ -947,15 +907,12 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
- % Given two instmap deltas, merge them to produce a new instmap_delta.
- %
merge_instmap_delta(_, _, _, unreachable, InstMapDelta, InstMapDelta,
!ModuleInfo).
merge_instmap_delta(_, _, _, reachable(InstMapping), unreachable,
reachable(InstMapping), !ModuleInfo).
merge_instmap_delta(InstMap, NonLocals, VarTypes, reachable(InstMappingA),
- reachable(InstMappingB), reachable(InstMapping),
- !ModuleInfo) :-
+ reachable(InstMappingB), reachable(InstMapping), !ModuleInfo) :-
merge_instmapping_delta(InstMap, NonLocals, VarTypes,
InstMappingA, InstMappingB, InstMapping, !ModuleInfo).
@@ -972,8 +929,7 @@
set__intersect(SetofVars0, NonLocals, SetofVars),
set__to_sorted_list(SetofVars, ListofVars),
merge_instmapping_delta_2(ListofVars, InstMap, VarTypes,
- InstMappingA, InstMappingB, map__init, InstMapping,
- !ModuleInfo).
+ InstMappingA, InstMappingB, map__init, InstMapping, !ModuleInfo).
:- pred merge_instmapping_delta_2(list(prog_var)::in, instmap::in,
vartypes::in, instmapping::in, instmapping::in,
@@ -1017,8 +973,7 @@
svmap__det_insert(Var, Inst, !InstMapping)
;
term__var_to_int(Var, VarInt),
- string__format(
- "merge_instmapping_delta_2: error merging var %i",
+ string__format("merge_instmapping_delta_2: error merging var %i",
[i(VarInt)], Msg),
error(Msg)
),
@@ -1034,8 +989,7 @@
unify_instmap_delta(_, _, reachable(InstMapping), unreachable,
reachable(InstMapping), !ModuleInfo).
unify_instmap_delta(InstMap, NonLocals, reachable(InstMappingA),
- reachable(InstMappingB), reachable(InstMapping),
- !ModuleInfo) :-
+ reachable(InstMappingB), reachable(InstMapping), !ModuleInfo) :-
unify_instmapping_delta(InstMap, NonLocals, InstMappingA, InstMappingB,
InstMapping, !ModuleInfo).
@@ -1051,9 +1005,8 @@
set__insert_list(SetofVarsInA, VarsInB, SetofVars0),
set__intersect(SetofVars0, NonLocals, SetofVars),
set__to_sorted_list(SetofVars, ListofVars),
- unify_instmapping_delta_2(ListofVars, InstMap,
- InstMappingA, InstMappingB, map__init, InstMapping,
- !ModuleInfo).
+ unify_instmapping_delta_2(ListofVars, InstMap, InstMappingA, InstMappingB,
+ map__init, InstMapping, !ModuleInfo).
:- pred unify_instmapping_delta_2(list(prog_var)::in, instmap::in,
instmapping::in, instmapping::in, instmapping::in, instmapping::out,
@@ -1065,18 +1018,16 @@
( map__search(InstMappingA, Var, InstA) ->
( map__search(InstMappingB, Var, InstB) ->
(
- % We can ignore the determinism of the
- % unification: if it isn't det, then there
- % will be a mode error or a determinism error
- % in one of the parallel conjuncts.
+ % We can ignore the determinism of the unification: if it
+ % isn't det, then there will be a mode error or a determinism
+ % error in one of the parallel conjuncts.
abstractly_unify_inst(live, InstA, InstB,
fake_unify, Inst, _Det, !ModuleInfo)
->
svmap__det_insert(Var, Inst, !InstMapping)
;
- error("unify_instmapping_delta_2: " ++
- "unexpected error")
+ error("unify_instmapping_delta_2: unexpected error")
)
;
svmap__det_insert(Var, InstA, !InstMapping)
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.101
diff -u -b -r1.101 lambda.m
--- compiler/lambda.m 16 Aug 2005 15:36:17 -0000 1.101
+++ compiler/lambda.m 22 Aug 2005 15:53:13 -0000
@@ -440,8 +440,8 @@
ArgVars = InitialVars,
PredId = PredId0,
ProcId = ProcId0,
- mode_util__modes_to_uni_modes(CurriedArgModes, CurriedArgModes,
- ModuleInfo0, UniModes),
+ mode_util__modes_to_uni_modes(ModuleInfo0,
+ CurriedArgModes, CurriedArgModes, UniModes),
%
% we need to mark the procedure as having had its
% address taken
@@ -496,8 +496,8 @@
map__apply_to_list(ArgVars, ArgModesMap1, ArgModes1),
% Recompute the uni_modes.
- mode_util__modes_to_uni_modes(ArgModes1, ArgModes1,
- ModuleInfo1, UniModes),
+ mode_util__modes_to_uni_modes(ModuleInfo1,
+ ArgModes1, ArgModes1, UniModes),
list__append(ArgModes1, Modes, AllArgModes),
map__apply_to_list(AllArgVars, VarTypes, ArgTypes),
Index: compiler/magic.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/magic.m,v
retrieving revision 1.53
diff -u -b -r1.53 magic.m
--- compiler/magic.m 22 Jul 2005 12:31:56 -0000 1.53
+++ compiler/magic.m 22 Aug 2005 14:36:33 -0000
@@ -1244,8 +1244,8 @@
%
{ list__index1_det(MagicArgs, N, CurrPredVar) },
{ set__list_to_set([CurrPredVar | InputArgs0], NonLocals0) },
- { mode_list_get_final_insts(OutputModes0, ModuleInfo0,
- OutputInsts0) },
+ { mode_list_get_final_insts(ModuleInfo0,
+ OutputModes0, OutputInsts0) },
{ assoc_list__from_corresponding_lists(InputArgs0,
OutputInsts0, InstAL0) },
{ instmap_delta_from_assoc_list(InstAL0, InstMapDelta0) },
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.48
diff -u -b -r1.48 magic_util.m
--- compiler/magic_util.m 22 Jul 2005 12:31:57 -0000 1.48
+++ compiler/magic_util.m 22 Aug 2005 14:36:45 -0000
@@ -844,8 +844,8 @@
nondet))) },
{ UnifyMode = (free -> LambdaInst) -
(LambdaInst -> LambdaInst) },
- { mode_util__modes_to_uni_modes(LambdaModes, LambdaModes,
- ModuleInfo, UniModes) },
+ { mode_util__modes_to_uni_modes(ModuleInfo, LambdaModes,
+ LambdaModes, UniModes) },
% Construct the unify_rhs.
{ module_info_pred_info(ModuleInfo, SuppPredId, PredInfo) },
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.151
diff -u -b -r1.151 ml_code_gen.m
--- compiler/ml_code_gen.m 24 Mar 2005 13:33:33 -0000 1.151
+++ compiler/ml_code_gen.m 23 Aug 2005 02:04:12 -0000
@@ -3126,11 +3126,10 @@
% a cast is for polymorphic types, which are
% `Word' in the C interface but `MR_Box' in the
% MLDS back-end.
- % Except for MC++, where polymorphic types
- % are MR_Box.
+ % Except for MC++, where polymorphic types are MR_Box,
+ % but we get here only if Lang is c or java.
(
- prog_type__var(OrigType, _),
- Lang \= managed_cplusplus
+ prog_type__var(OrigType, _)
->
Cast = "(MR_Word) "
;
Index: compiler/mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_constraints.m,v
retrieving revision 1.11
diff -u -b -r1.11 mode_constraints.m
--- compiler/mode_constraints.m 12 Aug 2005 05:14:13 -0000 1.11
+++ compiler/mode_constraints.m 22 Aug 2005 05:29:27 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2001-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -44,6 +46,7 @@
% :- import_module mode_robdd__check.
% :- import_module mode_robdd__tfeir.
:- import_module mode_robdd__tfeirn.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_mode.
:- import_module parse_tree.prog_io.
@@ -114,9 +117,7 @@
clear_caches(!IO)
;
New = yes,
- list__foldl3(
- prop_mode_constraints__process_scc(!.ModuleInfo),
- SCCs,
+ list__foldl3(prop_mode_constraints__process_scc(!.ModuleInfo), SCCs,
varset.init, ConstraintVarset,
bimap.init, _ConstraintVarMap,
map.init, AbstractModeConstraints
@@ -125,61 +126,54 @@
hlds_module.module_info_name(!.ModuleInfo, ModuleName),
CreateDirectories = yes,
- parse_tree.modules.module_name_to_file_name(
- ModuleName, ".mode_constraints",
- CreateDirectories,
- FileName, !IO
- ),
+ parse_tree.modules.module_name_to_file_name(ModuleName,
+ ".mode_constraints", CreateDirectories, FileName, !IO),
OutputFile = FileName,
io.open_output(OutputFile, IOResult, !IO),
(
IOResult = ok(OutputStream),
io.set_output_stream(OutputStream, OldOutStream, !IO),
- pretty_print_pred_constraints_map(
- !.ModuleInfo,
- ConstraintVarset,
- AbstractModeConstraints,
- !IO
- ),
+ pretty_print_pred_constraints_map(!.ModuleInfo, ConstraintVarset,
+ AbstractModeConstraints, !IO),
io.set_output_stream(OldOutStream, _, !IO),
io.close_output(OutputStream, !IO)
;
IOResult = error(_),
- error("mode_constraints.m: failed to open " ++
- FileName ++ " for output.")
+ unexpected(this_file,
+ "failed to open " ++ FileName ++ " for output.")
)
).
:- pred mode_constraints__process_scc(bool::in, list(pred_id)::in,
module_info::in, module_info::out,
- pred_constraint_map::in, pred_constraint_map::out,
- io::di, io::uo) is det.
+ pred_constraint_map::in, pred_constraint_map::out, io::di, io::uo) is det.
mode_constraints__process_scc(Simple, SCC, !ModuleInfo, !PredConstraintMap,
!IO) :-
- ModeConstraint0 = one,
- ModeConstraintInfo0 = init_mode_constraint_info(Simple),
+ some [!ModeConstraint, !ModeConstraintInfo] (
+ !:ModeConstraint = one,
+ !:ModeConstraintInfo = init_mode_constraint_info(Simple),
list__foldl2(number_robdd_variables_in_pred, SCC, !ModuleInfo,
- ModeConstraintInfo0, ModeConstraintInfo1),
+ !ModeConstraintInfo),
- save_threshold(Threshold, ModeConstraintInfo1, ModeConstraintInfo2),
+ save_threshold(Threshold, !ModeConstraintInfo),
mode_constraints__process_scc_pass_1(SCC, SCC, !ModuleInfo,
- ModeConstraint0, ModeConstraint1,
- ModeConstraintInfo2, ModeConstraintInfo, !IO),
-
- ModeConstraint2 = restrict_threshold(Threshold, ModeConstraint1),
- ModeConstraint = ensure_normalised(ModeConstraint2),
- mode_constraints__process_scc_pass_2(SCC, ModeConstraint,
- ModeConstraintInfo, !ModuleInfo, !IO),
-
- !:PredConstraintMap = list__foldl((func(PredId, PCM) =
- map__det_insert(PCM, PredId,
- pci(ModeConstraint,
- ModeConstraintInfo ^ pred_id := PredId))
- ), SCC, !.PredConstraintMap).
+ !ModeConstraint, !ModeConstraintInfo, !IO),
+ !:ModeConstraint = restrict_threshold(Threshold, !.ModeConstraint),
+ !:ModeConstraint = ensure_normalised(!.ModeConstraint),
+ mode_constraints__process_scc_pass_2(SCC, !.ModeConstraint,
+ !.ModeConstraintInfo, !ModuleInfo, !IO),
+
+ Insert = (pred(PredId::in, PCM0::in, PCM::out) is det :-
+ NewPCI = pci(!.ModeConstraint,
+ !.ModeConstraintInfo ^ pred_id := PredId),
+ map__det_insert(PCM0, PredId, NewPCI, PCM)
+ ),
+ list__foldl(Insert, SCC, !PredConstraintMap)
% clear_caches(!IO).
+ ).
:- type number_robdd_info
---> number_robdd_info(
@@ -235,9 +229,10 @@
% to remove all unwanted variables.
% `Restrict_threshold' is much faster than using `robdd__filter'
% or `robdd__restrict'.
-:- pred number_robdd_variables_in_pred(pred_id::in, module_info::in,
- module_info::out, mode_constraint_info::in, mode_constraint_info::out)
- is det.
+ %
+:- pred number_robdd_variables_in_pred(pred_id::in,
+ module_info::in, module_info::out,
+ mode_constraint_info::in, mode_constraint_info::out) is det.
number_robdd_variables_in_pred(PredId, !ModuleInfo, !MCI) :-
!:MCI = !.MCI ^ pred_id := PredId,
@@ -276,8 +271,7 @@
NRInfo0 = number_robdd_info(!.MCI, !.ModuleInfo, VarTypes),
list__map_foldl(
- (pred(Clause0::in, Clause::out, S0::in, S::out)
- is det :-
+ (pred(Clause0::in, Clause::out, S0::in, S::out) is det :-
Clause0 = clause(A, Goal0, C, D),
number_robdd_variables_in_goal(InstGraph,
set__init, _, Goal0, Goal, S0, S),
@@ -301,7 +295,7 @@
goal_info_get_goal_path(GoalInfo0, GoalPath),
number_robdd_variables_in_goal_2(InstGraph, GoalPath, ParentNonLocals,
NonLocals, Occurring, GoalExpr0, GoalExpr, !RInfo),
- goal_info_set_occurring_vars(GoalInfo0, Occurring, GoalInfo).
+ goal_info_set_occurring_vars(Occurring, GoalInfo0, GoalInfo).
:- pred number_robdd_variables_in_goal_2(inst_graph::in, goal_path::in,
set(prog_var)::in, set(prog_var)::in, set(prog_var)::out,
@@ -343,7 +337,7 @@
number_robdd_variables_in_goals(InstGraph, NonLocals, Occurring,
Goals0, Goals, !RInfo).
number_robdd_variables_in_goal_2(_, _, _, _, _, shorthand(_), _, !RInfo) :-
- error("number_robdd_variables_in_goal_2: shorthand").
+ unexpected(this_file, "number_robdd_variables_in_goal_2: shorthand").
number_robdd_variables_in_goal_2(InstGraph, GoalPath, ParentNonLocals, _,
Occurring, GoalExpr, GoalExpr, !RInfo) :-
@@ -421,8 +415,7 @@
% XXX We may be able to make this more efficient.
inst_graph__foldl_reachable_from_list(
(pred(V::in, S0::in, S::out) is det :-
- update_mc_info(mode_constraint_var(V `at` GoalPath),
- _, S0, S)
+ update_mc_info(mode_constraint_var(V `at` GoalPath), _, S0, S)
), InstGraph, Vars, !NRInfo).
:- pred number_robdd_variables_in_goals(inst_graph::in, set(prog_var)::in,
@@ -451,7 +444,7 @@
Goal0, Goal, !RInfo),
number_robdd_variables_in_cases(InstGraph, NonLocals, Occurring1,
Cases0, Cases, !RInfo),
- Occurring = Occurring0 `set__union` Occurring1 .
+ Occurring = Occurring0 `set__union` Occurring1.
:- pred mode_constraints__process_scc_pass_1(list(pred_id)::in,
list(pred_id)::in, module_info::in,
@@ -659,8 +652,7 @@
add_atomic_goal(GoalPath, !GCInfo) :-
AtomicGoals = !.GCInfo ^ atomic_goals,
- !:GCInfo = !.GCInfo ^ atomic_goals :=
- AtomicGoals `set__insert` GoalPath.
+ !:GCInfo = !.GCInfo ^ atomic_goals := AtomicGoals `set__insert` GoalPath.
:- type mode_decl_info
---> mode_decl_info(
@@ -679,6 +671,7 @@
].
% Convert a procedure's arg_modes to a constraint.
+ %
:- pred mode_constraints__mode_decl_to_constraint(module_info::in,
inst_graph::in, list(prog_var)::in, pred_info::in, proc_id::in,
proc_info::in, proc_info::out,
@@ -781,9 +774,10 @@
mode_constraint_var(F(V), CV, !MCI),
!:C = !.C ^ var(CV).
-:- pred false_var(func(prog_var) = rep_var, prog_var, mode_constraint,
- mode_constraint, mode_constraint_info, mode_constraint_info).
-:- mode false_var(func(in) = out is det, in, in, out, in, out) is det.
+:- pred false_var((func(prog_var) = rep_var)::in(func(in) = out is det),
+ prog_var::in,
+ mode_constraint::in, mode_constraint::out,
+ mode_constraint_info::in, mode_constraint_info::out) is det.
false_var(F, V, !C, !MCI) :-
mode_constraint_var(F(V), CV, !MCI),
@@ -834,12 +828,10 @@
( Inst = defined_inst(InstName) ->
inst_lookup(ModuleInfo, InstName, Inst1),
mode_constraints__process_inst(ModuleInfo, InstGraph,
- Free, Bound, DoHO, Inst1, Seen, Var,
- !Constraint, !MDI)
+ Free, Bound, DoHO, Inst1, Seen, Var, !Constraint, !MDI)
;
- mode_constraints__do_process_inst(ModuleInfo,
- InstGraph, Free, Bound, DoHO, Inst,
- Seen, Var, !Constraint, !MDI)
+ mode_constraints__do_process_inst(ModuleInfo, InstGraph,
+ Free, Bound, DoHO, Inst, Seen, Var, !Constraint, !MDI)
)
).
@@ -860,7 +852,9 @@
->
Bound(Var, !.Constraint, C, S0, S)
;
- ( Inst = free ; Inst = free(_) )
+ ( Inst = free
+ ; Inst = free(_)
+ )
->
Free(Var, !.Constraint, C, S0, S)
;
@@ -878,10 +872,8 @@
Insts, VarInsts),
list__foldl2((pred((V - I)::in, C1::in, C2::out,
T0::in, T::out) is det :-
- mode_constraints__process_inst(
- ModuleInfo, InstGraph,
- Free, Bound, DoHO, I,
- Seen `set__insert` Var,
+ mode_constraints__process_inst(ModuleInfo, InstGraph,
+ Free, Bound, DoHO, I, Seen `set__insert` Var,
V, C1, C2, T0, T)
), VarInsts, C0, C, S0, S)
;
@@ -889,9 +881,10 @@
S = S0
)
;
- list__foldl2(mode_constraints__process_inst(
- ModuleInfo, InstGraph, Free, Bound, DoHO, Inst,
- Seen `set__insert` Var), Vs, C0, C, S0, S)
+ list__foldl2(
+ mode_constraints__process_inst(ModuleInfo, InstGraph,
+ Free, Bound, DoHO, Inst, Seen `set__insert` Var),
+ Vs, C0, C, S0, S)
)), Functors, !Constraint, !MDI),
(
@@ -934,8 +927,7 @@
EmptyGoalPath = [],
AtomicGoals0 = set__init,
Info0 = goal_constraints_info(ModuleInfo, SCC, InstGraph, HeadVars,
- VarSet0, AtomicGoals0, !.ConstraintInfo, HOModes0,
- map__init),
+ VarSet0, AtomicGoals0, !.ConstraintInfo, HOModes0, map__init),
NonLocals = set__list_to_set(HeadVars),
GoalVars = set__sorted_list_to_set(map__sorted_keys(InstGraph)),
@@ -963,6 +955,7 @@
% 1.2.1 Input output constraints.
% These constraints relate the relationships between the above
% variables and relationships of boundedness on input and output.
+ %
:- pred input_output_constraints(list(prog_var)::in, inst_graph::in,
prog_var::in, inst_graph__node::in,
mode_constraint::in, mode_constraint::out,
@@ -978,11 +971,9 @@
( TopLevel `list__member` HeadVars ->
% For each variable V in the instantiation graph, add
% (Vout = Vin + V), ~(Vin * V)
- !:Constraint = !.Constraint ^
- io_constraint(V_in, V_out, V_)
+ !:Constraint = !.Constraint ^ io_constraint(V_in, V_out, V_)
;
- !:Constraint = !.Constraint ^
- not_var(V_in) ^ eq_vars(V_out, V_)
+ !:Constraint = !.Constraint ^ not_var(V_in) ^ eq_vars(V_out, V_)
),
% For each node V in the graph with child f with child W, add
@@ -997,8 +988,7 @@
;
mode_constraint_var(in(W), W_in, S0, S1),
mode_constraint_var(out(W), W_out, S1, S),
- Cs = Cs0 ^ imp_vars(W_out, V_out)
- ^ imp_vars(W_in, V_in)
+ Cs = Cs0 ^ imp_vars(W_out, V_out) ^ imp_vars(W_in, V_in)
)
), Children, !Constraint, !MCI).
@@ -1167,13 +1157,11 @@
map__values(ProcTable, ProcInfos),
update_md_info((pred(C::out, S0::in, S::out) is det :-
list__foldl2(
- mode_constraints__process_mode_decl_for_proc(
- ModuleInfo, InstGraph, Args,
- ignore,
- call_in(GoalPath), no,
- false_var(goal_path(GoalPath)),
- call_out(GoalPath), yes
- ), ProcInfos, zero, C, S0, S)),
+ mode_constraints__process_mode_decl_for_proc(ModuleInfo,
+ InstGraph, Args, ignore, call_in(GoalPath), no,
+ false_var(goal_path(GoalPath)), call_out(GoalPath),
+ yes),
+ ProcInfos, zero, C, S0, S)),
CallConstraint, !GCInfo)
;
@@ -1181,14 +1169,12 @@
% mode-analysed) SCC, but does not have any mode
% declarations.
ArgModes = PredInfo ^ modes,
- PredInstGraph = PredInfo ^ inst_graph_info
- ^ interface_inst_graph,
+ PredInstGraph = PredInfo ^ inst_graph_info ^ interface_inst_graph,
pred_info_clauses_info(PredInfo, PredClausesInfo),
clauses_info_headvars(PredClausesInfo, PredHeadVars),
solutions((pred((V - W)::out) is nondet :-
inst_graph__corresponding_nodes_from_lists(
- PredInstGraph, InstGraph, PredHeadVars,
- Args, V, W)
+ PredInstGraph, InstGraph, PredHeadVars, Args, V, W)
), CorrespondingNodes),
list__foldl2((pred(ArgMap::in, Cn0::in, Cn::out,
S0::in, S::out) is det :-
@@ -1198,8 +1184,7 @@
get_var(W `at` GoalPath, Wgp, T0, T1),
get_var(out(W), Wout, T1, T),
( map__lookup(InArgs, V, yes) ->
- C = C0 ^ var(Wout)
- ^ not_var(Wgp)
+ C = C0 ^ var(Wout) ^ not_var(Wgp)
; map__lookup(OutArgs, V, yes) ->
C = C0 ^ var(Wgp)
;
@@ -1232,8 +1217,7 @@
CanSucceed = yes % XXX should check this
;
GenericCall = class_method(Var, _, _, _),
- generic_call_constrain_var(Var, GoalPath, !Constraint,
- !GCInfo),
+ generic_call_constrain_var(Var, GoalPath, !Constraint, !GCInfo),
error("mode_constraints.m: class_method call in clause")
;
GenericCall = cast(_),
@@ -1347,8 +1331,9 @@
conj_constraints(UseKnownVars, KnownTrue, KnownFalse, GoalPath, UsageMap,
!Constraint, !GCInfo) :-
UsageList = map__to_assoc_list(UsageMap), % XXX needed for deep profiler
- list__foldl2(conj_constraints_process_var(UseKnownVars,
- KnownTrue, KnownFalse, GoalPath),
+ list__foldl2(
+ conj_constraints_process_var(UseKnownVars, KnownTrue, KnownFalse,
+ GoalPath),
UsageList, !Constraint, !GCInfo).
:- pred conj_constraints_process_var(bool::in, mode_constraint_vars::in,
@@ -1369,43 +1354,45 @@
% which are 2-sat. If UseKnownVars = no, we generate the other
% constraints.
( KnownFalse `contains` VConj ->
- ( UseKnownVars = yes ->
- !:Constraint = !.Constraint ^
- conj_not_vars(ConstraintVarSet)
+ (
+ UseKnownVars = yes,
+ !:Constraint = !.Constraint ^ conj_not_vars(ConstraintVarSet)
;
- true
+ UseKnownVars = no
)
; KnownTrue `contains` VConj ->
( ConstraintVars = [] ->
!:Constraint = zero
; ConstraintVars = [ConstraintVar] ->
- ( UseKnownVars = yes ->
- !:Constraint = !.Constraint
- ^ var(ConstraintVar)
+ (
+ UseKnownVars = yes,
+ !:Constraint = !.Constraint ^ var(ConstraintVar)
;
- true
+ UseKnownVars = no
)
; ConstraintVars = [ConstraintVar1, ConstraintVar2] ->
- ( UseKnownVars = yes ->
+ (
+ UseKnownVars = yes,
!:Constraint = !.Constraint
- ^ neq_vars(ConstraintVar1,
- ConstraintVar2)
+ ^ neq_vars(ConstraintVar1, ConstraintVar2)
;
- true
+ UseKnownVars = no
)
;
- ( UseKnownVars = yes ->
- true
+ (
+ UseKnownVars = yes
;
+ UseKnownVars = no,
!:Constraint = !.Constraint
^ at_most_one_of(ConstraintVarSet)
^ disj_vars_eq(ConstraintVarSet, VConj)
)
)
;
- ( UseKnownVars = yes ->
- true
+ (
+ UseKnownVars = yes
;
+ UseKnownVars = no,
!:Constraint = !.Constraint
^ at_most_one_of(ConstraintVarSet)
^ disj_vars_eq(ConstraintVarSet, VConj)
@@ -1477,8 +1464,7 @@
% In the simple system a var-functor unification must be either
% a construction or a deconstruction.
list__map_foldl(
- ( pred(ProgVar::in, RepVar::out, S0::in, S::out)
- is det :-
+ ( pred(ProgVar::in, RepVar::out, S0::in, S::out) is det :-
get_var(ProgVar `at` GoalPath, RepVar, S0, S)
), Args, ArgsGp0, !GCInfo),
ArgsGp = list_to_set(ArgsGp0),
@@ -1559,9 +1545,7 @@
% [i(NumNodes3), i(Depth3)])),
update_mc_info((pred(C::out, S0::in, S::out) is det :-
- map__foldl2(
- input_output_constraints(LambdaHeadVars,
- InstGraph),
+ map__foldl2(input_output_constraints(LambdaHeadVars, InstGraph),
InstGraph, !.Constraint, C, S0, S)
), !:Constraint, !GCInfo),
@@ -1727,7 +1711,8 @@
( Declared = [] ->
DeclaredPreds = DeclaredPreds0
;
- list__foldl((pred(Pred::in, Preds0::in, Preds::out) is det :-
+ list__foldl(
+ (pred(Pred::in, Preds0::in, Preds::out) is det :-
Preds = [[Pred] | Preds0]
), Declared, DeclaredPreds0, DeclaredPreds)
),
@@ -1748,7 +1733,8 @@
add_imported_preds(ModuleInfo, SCCs0, SCCs) :-
module_info_predids(ModuleInfo, PredIds),
- list__filter_map((pred(PredId::in, [PredId]::out) is semidet :-
+ list__filter_map(
+ (pred(PredId::in, [PredId]::out) is semidet :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_is_imported(PredInfo)
), PredIds, ImportedPredIds),
@@ -1851,8 +1837,7 @@
get_prog_var_level(VarB, B, !MCI),
( map__search(HoModes0, A, AModes) ->
( map__search(HoModes0, B, BModes) ->
- Modes = list__sort_and_remove_dups(
- AModes `list__append` BModes),
+ Modes = list__sort_and_remove_dups(AModes `list__append` BModes),
map__det_update(HoModes0, A, Modes, HoModes1),
map__det_update(HoModes1, B, Modes, HoModes)
;
@@ -1980,6 +1965,7 @@
% A predicate can succeed if at least one of its procedures
% can succeed.
+ %
:- pred pred_can_succeed(pred_info::in) is semidet.
pred_can_succeed(PredInfo) :-
@@ -1993,6 +1979,7 @@
% it has a declared determinism that allows more than zero solutions.
% (This is a conservative approximation since we can't use the results
% of determinism inference -- it hasn't been run yet.)
+ %
:- pred proc_can_succeed(proc_info::in) is semidet.
proc_can_succeed(ProcInfo) :-
@@ -2028,5 +2015,11 @@
% "
% N = conjnum++;
% ").
+
+%------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "mode_constraints.m".
%------------------------------------------------------------------------%
Index: compiler/mode_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_debug.m,v
retrieving revision 1.21
diff -u -b -r1.21 mode_debug.m
--- compiler/mode_debug.m 24 Mar 2005 05:34:09 -0000 1.21
+++ compiler/mode_debug.m 22 Aug 2005 08:07:12 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1996-1997, 2003-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -96,12 +98,11 @@
mode_info_get_instmap(!.ModeInfo, InstMap),
( instmap__is_reachable(InstMap) ->
instmap__to_assoc_list(InstMap, NewInsts),
- mode_info_get_last_checkpoint_insts(!.ModeInfo,
- OldInstMap),
+ mode_info_get_last_checkpoint_insts(!.ModeInfo, OldInstMap),
mode_info_get_varset(!.ModeInfo, VarSet),
mode_info_get_instvarset(!.ModeInfo, InstVarSet),
- write_var_insts(NewInsts, OldInstMap, VarSet,
- InstVarSet, Verbose, Minimal, !IO)
+ write_var_insts(NewInsts, OldInstMap, VarSet, InstVarSet,
+ Verbose, Minimal, !IO)
;
io__write_string("\tUnreachable\n", !IO)
),
@@ -146,22 +147,21 @@
;
Minimal = no,
io__write_string("\n", !IO),
- mercury_output_structured_inst(Inst, 2, InstVarSet,
- !IO)
+ mercury_output_structured_inst(Inst, 2, InstVarSet, !IO)
)
),
- write_var_insts(VarInsts, OldInstMap, VarSet, InstVarSet, Verbose,
- Minimal, !IO).
+ write_var_insts(VarInsts, OldInstMap, VarSet, InstVarSet,
+ Verbose, Minimal, !IO).
% In the usual case of a C backend, this predicate allows us to
% conclude that two insts are identical without traversing them.
% Since the terms can be very large, this is a big gain; it can
- % turn the complexity of printing a checking from quadratic in the
+ % turn the complexity of printing a checkpoint from quadratic in the
% number of variables live at the checkpoint (when the variables
% are e.g. all part of a single long list) to linear. The minor
% increase in the constant factor in cases where identical_insts fails
% is much easier to live with.
-
+ %
:- pred identical_insts((inst)::in, (inst)::in) is semidet.
identical_insts(_, _) :-
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.88
diff -u -b -r1.88 mode_errors.m
--- compiler/mode_errors.m 22 Aug 2005 03:55:11 -0000 1.88
+++ compiler/mode_errors.m 22 Aug 2005 14:37:03 -0000
@@ -156,6 +156,17 @@
mode_context % Where the error occurred.
).
+:- type mode_warning
+ ---> cannot_succeed_var_var(prog_var, prog_var, inst, inst)
+ ; cannot_succeed_var_functor(prog_var, inst, cons_id).
+
+:- type mode_warning_info
+ ---> mode_warning_info(
+ mode_warning, % The nature of the error.
+ prog_context, % Where the error occurred.
+ mode_context % Where the error occurred.
+ ).
+
%-----------------------------------------------------------------------------%
% If there were any errors recorded in the mode_info,
@@ -175,6 +186,17 @@
:- pred maybe_report_error_no_modes(pred_id::in, pred_info::in,
module_info::in, io::di, io::uo) is det.
+ % If there were any warnings recorded in the mode_info,
+ % report them to the user now.
+ %
+:- pred report_mode_warnings(mode_info::in, mode_info::out,
+ io::di, io::uo) is det.
+
+ % Print a warning message.
+ %
+:- pred report_mode_warning(mode_info::in, mode_warning_info::in,
+ io::di, io::uo) is det.
+
% Initialize the mode_context.
%
:- pred mode_context_init(mode_context::out) is det.
@@ -227,6 +249,11 @@
Specs = mode_error_to_specs(ModeError, ModeInfo),
write_error_specs(Specs, !IO).
+report_mode_warning(ModeInfo, Warning, !IO) :-
+ Specs = mode_warning_to_specs(ModeInfo, Warning),
+ write_error_specs(Specs, !IO),
+ record_warning(!IO).
+
:- func mode_error_to_specs(mode_error::in, mode_info::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
@@ -298,6 +325,23 @@
Inst, Reason)
).
+:- func mode_warning_to_specs(mode_info::in, mode_warning_info::in)
+ = (list(error_msg_spec)::out(error_msg_specs)) is det.
+
+mode_warning_to_specs(!.ModeInfo, Warning) = Specs :-
+ Warning = mode_warning_info(ModeWarning, Context, ModeContext),
+ mode_info_set_context(Context, !ModeInfo),
+ mode_info_set_mode_context(ModeContext, !ModeInfo),
+ (
+ ModeWarning = cannot_succeed_var_var(VarA, VarB, InstA, InstB),
+ Specs = mode_warning_cannot_succeed_var_var(!.ModeInfo, VarA, VarB,
+ InstA, InstB)
+ ;
+ ModeWarning = cannot_succeed_var_functor(Var, Inst, ConsId),
+ Specs = mode_warning_cannot_succeed_var_functor(!.ModeInfo,
+ Var, Inst, ConsId)
+ ).
+
%-----------------------------------------------------------------------------%
:- func mode_error_conj_to_specs(mode_info::in, list(delayed_goal)::in,
@@ -899,6 +943,47 @@
%-----------------------------------------------------------------------------%
+:- func mode_warning_cannot_succeed_var_var(mode_info::in,
+ prog_var::in, prog_var::in, (inst)::in, (inst)::in)
+ = (list(error_msg_spec)::out(error_msg_specs)) is det.
+
+mode_warning_cannot_succeed_var_var(ModeInfo, X, Y, InstX, InstY) = Specs :-
+ mode_info_get_context(ModeInfo, Context),
+ mode_info_get_varset(ModeInfo, VarSet),
+ Pieces = [words("warning: unification of"),
+ words(add_quotes(mercury_var_to_string(X, VarSet, no))),
+ words("and"),
+ words(add_quotes(mercury_var_to_string(Y, VarSet, no))),
+ words("cannot succeed"), nl,
+ words(add_quotes(mercury_var_to_string(X, VarSet, no))),
+ words("has instantiatedness"),
+ words(add_quotes(inst_to_string(ModeInfo, InstX))), suffix(","), nl,
+ words(add_quotes(mercury_var_to_string(Y, VarSet, no))),
+ words("has instantiatedness"),
+ words(add_quotes(inst_to_string(ModeInfo, InstY))), suffix("."), nl],
+ Specs = [mode_info_context_to_spec(ModeInfo),
+ error_msg_spec(no, Context, 0, Pieces)].
+
+:- func mode_warning_cannot_succeed_var_functor(mode_info::in,
+ prog_var::in, (inst)::in, cons_id::in)
+ = (list(error_msg_spec)::out(error_msg_specs)) is det.
+
+mode_warning_cannot_succeed_var_functor(ModeInfo, X, InstX, ConsId) = Specs :-
+ mode_info_get_context(ModeInfo, Context),
+ mode_info_get_varset(ModeInfo, VarSet),
+ Pieces = [words("warning: unification of"),
+ words(add_quotes(mercury_var_to_string(X, VarSet, no))),
+ words("and"),
+ words(mercury_cons_id_to_string(ConsId, does_not_need_brackets)),
+ words("cannot succeed"), nl,
+ words(add_quotes(mercury_var_to_string(X, VarSet, no))),
+ words("has instantiatedness"),
+ words(add_quotes(inst_to_string(ModeInfo, InstX))), suffix("."), nl],
+ Specs = [mode_info_context_to_spec(ModeInfo),
+ error_msg_spec(no, Context, 0, Pieces)].
+
+%-----------------------------------------------------------------------------%
+
:- func mode_info_context_to_spec(mode_info::in)
= (error_msg_spec::out(error_msg_spec)) is det.
@@ -1101,7 +1186,7 @@
% since they won't be valid anyway -- they are just
% the results of whatever partial inference we did
% before detecting the error.
- mode_list_get_initial_insts(!.ArgModes, ModuleInfo, InitialInsts),
+ mode_list_get_initial_insts(ModuleInfo, !.ArgModes, InitialInsts),
DummyInst = defined_inst(user_inst(unqualified("..."), [])),
list__duplicate(PredArity, DummyInst, FinalInsts),
!:ArgModes = list__map(func(I - F) = (I -> F),
@@ -1139,6 +1224,10 @@
;
Errors = []
).
+
+report_mode_warnings(!ModeInfo, !IO) :-
+ mode_info_get_warnings(!.ModeInfo, Warnings),
+ list__foldl(report_mode_warning(!.ModeInfo), Warnings, !IO).
%-----------------------------------------------------------------------------%
Index: compiler/mode_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_info.m,v
retrieving revision 1.72
diff -u -b -r1.72 mode_info.m
--- compiler/mode_info.m 24 Mar 2005 05:34:09 -0000 1.72
+++ compiler/mode_info.m 22 Aug 2005 09:52:44 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1994-2001, 2003-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -42,10 +44,9 @@
:- type mode_context
---> call(
call_id,
- int % argument number (offset so that
- % the real arguments start at number 1
- % whereas the type_info arguments
- % have numbers <= 0).
+ int % Argument number (offset so that the real
+ % arguments start at number 1 whereas the
+ % type_info arguments have numbers <= 0).
)
; unify(
unify_context, % original source of the unification
@@ -53,7 +54,9 @@
)
; uninitialized.
-:- type side ---> left ; right.
+:- type side
+ ---> left
+ ; right.
:- type call_context
---> unify(unify_context)
@@ -65,8 +68,7 @@
; lambda(pred_or_func)
; par_conj.
- % Specify how to process goals - using either
- % modes.m or unique_modes.m.
+ % Specify how to process goals - using either modes.m or unique_modes.m.
:- type how_to_check_goal
---> check_modes
; check_unique_modes.
@@ -96,10 +98,11 @@
% The value --debug-modes-statistics
).
+ % Initialize the mode_info.
+ %
:- pred mode_info_init(module_info::in, pred_id::in,
proc_id::in, prog_context::in, set(prog_var)::in, instmap::in,
- how_to_check_goal::in, may_change_called_proc::in,
- mode_info::out) is det.
+ how_to_check_goal::in, may_change_called_proc::in, mode_info::out) is det.
%-----------------------------------------------------------------------------%
@@ -116,6 +119,8 @@
:- pred mode_info_get_instmap(mode_info::in, instmap::out) is det.
:- pred mode_info_get_locked_vars(mode_info::in, locked_vars::out) is det.
:- pred mode_info_get_errors(mode_info::in, list(mode_error_info)::out) is det.
+:- pred mode_info_get_warnings(mode_info::in, list(mode_warning_info)::out)
+ is det.
:- pred mode_info_get_num_errors(mode_info::in, int::out) is det.
:- pred mode_info_get_liveness(mode_info::in, set(prog_var)::out) is det.
:- pred mode_info_get_varset(mode_info::in, prog_varset::out) is det.
@@ -135,6 +140,7 @@
how_to_check_goal::out) is det.
:- pred mode_info_get_may_change_called_proc(mode_info::in,
may_change_called_proc::out) is det.
+:- pred mode_info_get_initial_instmap(mode_info::in, instmap::out) is det.
%-----------------------------------------------------------------------------%
@@ -160,6 +166,8 @@
mode_info::in, mode_info::out) is det.
:- pred mode_info_set_errors(list(mode_error_info)::in,
mode_info::in, mode_info::out) is det.
+:- pred mode_info_set_warnings(list(mode_warning_info)::in,
+ mode_info::in, mode_info::out) is det.
:- pred mode_info_add_live_vars(set(prog_var)::in,
mode_info::in, mode_info::out) is det.
:- pred mode_info_remove_live_vars(set(prog_var)::in,
@@ -203,6 +211,7 @@
% Find the simple_call_id to use in error messages
% for the given pred_id.
+ %
:- pred mode_info_get_call_id(mode_info::in, pred_id::in,
simple_call_id::out) is det.
@@ -217,20 +226,26 @@
%-----------------------------------------------------------------------------%
- % record a mode error (and associated context info) in the mode_info.
-
+ % Record a mode error (and associated context info) in the mode_info.
+ %
:- pred mode_info_error(set(prog_var)::in, mode_error::in,
mode_info::in, mode_info::out) is det.
:- pred mode_info_add_error(mode_error_info::in,
mode_info::in, mode_info::out) is det.
-%-----------------------------------------------------------------------------%
+:- pred mode_info_warning(mode_warning::in,
+ mode_info::in, mode_info::out) is det.
+
+:- pred mode_info_add_warning(mode_warning_info::in,
+ mode_info::in, mode_info::out) is det.
- % The mode_info contains a flag indicating whether initialisation
- % calls, converting a solver variable from `free' to `any', may be
- % inserted during mode analysis.
+%-----------------------------------------------------------------------------%
+ % The mode_info contains a flag indicating whether initialisation calls,
+ % converting a solver variable from `free' to `any', may be inserted
+ % during mode analysis.
+ %
:- pred mode_info_may_initialise_solver_vars(mode_info::in)
is semidet.
@@ -250,6 +265,7 @@
:- import_module check_hlds__mode_util.
:- import_module libs__globals.
:- import_module libs__options.
+:- import_module parse_tree__error_util.
:- import_module int.
:- import_module queue.
@@ -260,134 +276,119 @@
:- import_module term.
:- import_module varset.
-:- type mode_sub_info --->
- mode_sub_info(
- procid :: proc_id,
+:- type mode_sub_info
+ ---> mode_sub_info(
% The mode which we are checking.
+ procid :: proc_id,
- varset :: prog_varset,
% The variables in the current proc.
+ varset :: prog_varset,
- last_checkpoint_insts :: instmap,
- % This field is used by the checkpoint
- % code when debug_modes is on. It has the
- % instmap that was current at the last
- % mode checkpoint, so that checkpoints
- % do not print out the insts of variables
- % whose insts have not changed since the
- % last checkpoint. This field will always
- % contain an unreachable instmap if debug_modes
- % is off, since its information is not
+ % This field is used by the checkpoint code when debug_modes
+ % is on. It has the instmap that was current at the last mode
+ % checkpoint, so that checkpoints do not print out the insts
+ % of variables whose insts have not changed since the last
+ % checkpoint. This field will always contain an unreachable
+ % instmap if debug_modes is off, since its information is not
% needed then.
+ last_checkpoint_insts :: instmap,
+ % Changed flag: if `yes', then we may need to repeat
+ % mode inference.
changed_flag :: bool,
- % Changed flag: if `yes', then we may need
- % to repeat mode inference.
- checking_extra_goals :: bool
- % Are we rechecking a goal after introducing
- % unifications for complicated sub-unifications
- % or an implied mode? If so, redoing the
- % mode check should not introduce more
- % extra unifications.
+ % Are we rechecking a goal after introducing unifications
+ % for complicated sub-unifications or an implied mode? If so,
+ % redoing the mode check should not introduce more extra
+ % unifications.
+ checking_extra_goals :: bool,
+
+ % The initial instmap of the procedure body. Used to decide
+ % whether a unification that cannot fail could be influenced
+ % by an argument mode that enforces a subtype.
+ initial_instmap :: instmap,
+
+ % The mode warnings found.
+ warnings :: list(mode_warning_info)
).
-:- type mode_info --->
- mode_info(
+:- type mode_info
+ ---> mode_info(
module_info :: module_info,
- predid :: pred_id,
% The pred we are checking.
+ predid :: pred_id,
- var_types :: vartypes,
% The types of the variables.
+ var_types :: vartypes,
+ % Is mode debugging of this procedure enabled? If yes,
+ % is verbose mode debugging enabled, is minimal mode debugging
+ % enabled, and is statistics printing enabled?
debug :: maybe(debug_flags),
- % Is mode debugging of this procedure enabled?
- % If yes, is verbose mode debugging enabled,
- % is minimal mode debugging enabled,
- % and is statistics printing enabled?
+ % The line number of the subgoal we are currently checking.
context :: prog_context,
- % The line number of the subgoal we
- % are currently checking.
+ % A description of where in the goal the error occurred.
mode_context :: mode_context,
- % A description of where in the
- % goal the error occurred.
+ % The current instantiatedness of the variables.
instmap :: instmap,
- % The current instantiatedness
- % of the variables.
+ % The "locked" variables, i.e. variables which cannot be
+ % further instantiated inside a negated context.
locked_vars :: locked_vars,
- % The "locked" variables,
- % i.e. variables which cannot be
- % further instantiated inside a
- % negated context.
- delay_info :: delay_info,
% Info about delayed goals.
+ delay_info :: delay_info,
- errors :: list(mode_error_info),
% The mode errors found.
+ errors :: list(mode_error_info),
+ % The live variables, i.e. those variables which may be
+ % referenced again on forward execution or after shallow
+ % backtracking. (By shallow backtracking, I mean semidet
+ % backtracking in a negation, if-then-else, or semidet
+ % disjunction within the current predicate.)
live_vars :: bag(prog_var),
- % The live variables, i.e. those variables
- % which may be referenced again on forward
- % execution or after shallow backtracking.
- % (By shallow backtracking, I mean semidet
- % backtracking in a negation, if-then-else,
- % or semidet disjunction within the current
- % predicate.)
+ % The nondet-live variables, i.e. those variables which may be
+ % referenced again after deep backtracking TO THE CURRENT
+ % EXECUTION POINT. These are the variables which need to be
+ % made mostly_unique rather than unique when we get to a
+ % nondet disjunction or a nondet call. We do not include
+ % variables which may be referenced again after backtracking
+ % to a point EARLIER THAN the current execution point, since
+ % those variables will *already* have been marked as
+ % mostly_unique rather than unique.)
nondet_live_vars :: bag(prog_var),
- % The nondet-live variables,
- % i.e. those variables which may be
- % referenced again after deep backtracking
- % TO THE CURRENT EXECUTION POINT.
- % These are the variables which need to be
- % made mostly_unique rather than unique
- % when we get to a nondet disjunction
- % or a nondet call. We do not include
- % variables which may be referenced again
- % after backtracking to a point EARLIER THAN
- % the current execution point, since those
- % variables will *already* have been marked
- % as mostly_unique rather than unique.)
instvarset :: inst_varset,
+ % A stack of pairs of sets of variables used to mode-check
+ % parallel conjunctions. The first set is the nonlocals of the
+ % parallel conjunction. The second set is a subset of the
+ % first, and is the set of variables that have been [further]
+ % bound inside the current parallel conjunct - the stack
+ % is for the correct handling of nested parallel conjunctions.
parallel_vars :: list(pair(set(prog_var), set(prog_var))),
- % A stack of pairs of sets of variables used
- % to mode-check parallel conjunctions. The
- % first set is the nonlocals of the
- % parallel conjunction. The second set is
- % a subset of the first, and is the set of
- % variables that have been [further] bound
- % inside the current parallel conjunct -
- % the stack is for the correct handling
- % of nested parallel conjunctions.
how_to_check :: how_to_check_goal,
+ % Is mode analysis allowed to change which procedure is called?
may_change_called_proc :: may_change_called_proc,
- % Is mode analysis allowed to change
- % which procedure is called?
+ % `yes' if calls to the initialisation predicates for solver
+ % vars can be inserted during mode analysis in order to make
+ % goals schedulable.
may_initialise_solver_vars :: bool,
- % `yes' if calls to the initialisation
- % predicates for solver vars can be
- % inserted during mode analysis in order
- % to make goals schedulable.
mode_sub_info :: mode_sub_info
).
%-----------------------------------------------------------------------------%
- % Initialize the mode_info
-
mode_info_init(ModuleInfo, PredId, ProcId, Context, LiveVars, InstMapping0,
HowToCheck, MayChangeProc, ModeInfo) :-
module_info_globals(ModuleInfo, Globals),
@@ -416,6 +417,7 @@
LockedVars = [],
delay_info__init(DelayInfo),
ErrorList = [],
+ WarningList = [],
% look up the varset and var types
module_info_preds(ModuleInfo, Preds),
map__lookup(Preds, PredId, PredInfo),
@@ -433,14 +435,12 @@
MayInitSolverVars = yes,
ModeSubInfo = mode_sub_info(ProcId, VarSet, Unreachable, Changed,
- CheckingExtraGoals
- ),
+ CheckingExtraGoals, InstMapping0, WarningList),
ModeInfo = mode_info(ModuleInfo, PredId, VarTypes, Debug,
Context, ModeContext, InstMapping0, LockedVars, DelayInfo,
ErrorList, LiveVarsBag, NondetLiveVarsBag, InstVarSet, [],
- HowToCheck, MayChangeProc, MayInitSolverVars, ModeSubInfo
- ).
+ HowToCheck, MayChangeProc, MayInitSolverVars, ModeSubInfo).
%-----------------------------------------------------------------------------%
@@ -456,6 +456,7 @@
mode_info_get_instvarset(ModeInfo, ModeInfo ^ instvarset).
mode_info_get_locked_vars(MI, MI ^ locked_vars).
mode_info_get_errors(MI, MI ^ errors).
+mode_info_get_warnings(MI, MI ^ mode_sub_info ^ warnings).
mode_info_get_delay_info(MI, MI ^ delay_info).
mode_info_get_live_vars(MI, MI ^ live_vars).
mode_info_get_nondet_live_vars(MI, MI ^ nondet_live_vars).
@@ -464,8 +465,8 @@
mode_info_get_parallel_vars(MI, MI ^ parallel_vars).
mode_info_get_changed_flag(MI, MI ^ mode_sub_info ^ changed_flag).
mode_info_get_how_to_check(MI, MI ^ how_to_check).
-mode_info_get_may_change_called_proc(MI,
- MI ^ may_change_called_proc).
+mode_info_get_may_change_called_proc(MI, MI ^ may_change_called_proc).
+mode_info_get_initial_instmap(MI, MI ^ mode_sub_info ^ initial_instmap).
mode_info_set_module_info(ModuleInfo, MI, MI ^ module_info := ModuleInfo).
mode_info_set_predid(PredId, MI, MI ^ predid := PredId).
@@ -476,6 +477,8 @@
mode_info_set_mode_context(ModeContext, MI, MI ^ mode_context := ModeContext).
mode_info_set_locked_vars(LockedVars, MI, MI ^ locked_vars := LockedVars).
mode_info_set_errors(Errors, MI, MI ^ errors := Errors).
+mode_info_set_warnings(Warnings, MI,
+ MI ^ mode_sub_info ^ warnings := Warnings).
mode_info_set_delay_info(DelayInfo, MI, MI ^ delay_info := DelayInfo).
mode_info_set_live_vars(LiveVarsList, MI, MI ^ live_vars := LiveVarsList).
mode_info_set_nondet_live_vars(NondetLiveVars, MI,
@@ -516,7 +519,7 @@
% For that case, we don't care about the ArgNum.
ModeInfo = ModeInfo0
;
- error("mode_info_set_call_arg_context")
+ unexpected(this_file, "mode_info_set_call_arg_context")
).
mode_info_unset_call_context(!MI) :-
@@ -686,6 +689,17 @@
list__append(Errors0, [ModeErrorInfo], Errors),
mode_info_set_errors(Errors, !ModeInfo).
+mode_info_warning(ModeWarning, !ModeInfo) :-
+ mode_info_get_context(!.ModeInfo, Context),
+ mode_info_get_mode_context(!.ModeInfo, ModeContext),
+ ModeWarningInfo = mode_warning_info(ModeWarning, Context, ModeContext),
+ mode_info_add_warning(ModeWarningInfo, !ModeInfo).
+
+mode_info_add_warning(ModeWarningInfo, !ModeInfo) :-
+ mode_info_get_warnings(!.ModeInfo, Warnings0),
+ list__append(Warnings0, [ModeWarningInfo], Warnings),
+ mode_info_set_warnings(Warnings, !ModeInfo).
+
%-----------------------------------------------------------------------------%
mode_info_may_initialise_solver_vars(ModeInfo) :-
@@ -698,4 +712,9 @@
!:ModeInfo = !.ModeInfo ^ may_initialise_solver_vars := MayInit.
%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "mode_info.m".
+
%-----------------------------------------------------------------------------%
Index: compiler/mode_ordering.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_ordering.m,v
retrieving revision 1.5
diff -u -b -r1.5 mode_ordering.m
--- compiler/mode_ordering.m 24 Mar 2005 05:34:09 -0000 1.5
+++ compiler/mode_ordering.m 22 Aug 2005 04:55:38 -0000
@@ -1,12 +1,13 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2001-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
-% File: mode_constraint.m
+% File: mode_ordering.m
% Main author: dmo
-%
:- module check_hlds__mode_ordering.
@@ -21,17 +22,18 @@
:- import_module list.
:- import_module map.
-:- type pred_constraint_info --->
- pci( % pci: pred_constrain_info
+:- type pred_constraint_info
+ ---> pci(
mode_constraint,
mode_constraint_info
).
:- type pred_constraint_map == map(pred_id, pred_constraint_info).
-% Given a top-down list of predicate SCCs, attempt to schedule goals for mode
-% of each predicate, and determine which modes are needed for each predicate.
-
+ % Given a top-down list of predicate SCCs, attempt to schedule goals
+ % for mode of each predicate, and determine which modes are needed
+ % for each predicate.
+ %
:- pred mode_ordering(pred_constraint_map::in, list(list(pred_id))::in,
module_info::in, module_info::out, io::di, io::uo) is det.
@@ -59,15 +61,14 @@
mode_ordering(PredConstraintMap, SCCs, !ModuleInfo, !IO) :-
list__foldl(mode_ordering__scc(PredConstraintMap), SCCs, !ModuleInfo),
- report_mode_errors(!.ModuleInfo, !IO).
+ report_ordering_mode_errors(!.ModuleInfo, !IO).
:- pred mode_ordering__scc(pred_constraint_map::in, list(pred_id)::in,
module_info::in, module_info::out) is det.
mode_ordering__scc(PredConstraintMap, SCC, !ModuleInfo) :-
copy_module_clauses_to_procs(SCC, !ModuleInfo),
- list__foldl(mode_ordering__pred(PredConstraintMap, SCC), SCC,
- !ModuleInfo).
+ list__foldl(mode_ordering__pred(PredConstraintMap, SCC), SCC, !ModuleInfo).
:- pred mode_ordering__pred(pred_constraint_map::in, list(pred_id)::in,
pred_id::in, module_info::in, module_info::out) is det.
@@ -81,9 +82,9 @@
ModeConstraint0, ModeConstraintInfo),
( pred_info_infer_modes(PredInfo0) ->
( map__search(RequestedProcsMap0, PredId, RequestedProcs) ->
- list__foldl(mode_ordering__infer_proc(ModeConstraint0,
- ModeConstraintInfo, !.ModuleInfo,
- PredConstraintMap),
+ list__foldl(
+ mode_ordering__infer_proc(ModeConstraint0,
+ ModeConstraintInfo, !.ModuleInfo, PredConstraintMap),
RequestedProcs, PredInfo0, PredInfo)
;
% XXX Maybe we should remove the predicate from the
@@ -92,9 +93,9 @@
)
;
ProcIds = pred_info_non_imported_procids(PredInfo0),
- list__foldl(mode_ordering__check_proc(ModeConstraint0,
- ModeConstraintInfo, !.ModuleInfo,
- PredConstraintMap),
+ list__foldl(
+ mode_ordering__check_proc(ModeConstraint0,
+ ModeConstraintInfo, !.ModuleInfo, PredConstraintMap),
ProcIds, PredInfo0, PredInfo)
),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
@@ -104,36 +105,36 @@
mode_constraint::in, pred_info::in, pred_info::out) is det.
mode_ordering__infer_proc(Constraint0, ModeConstraintInfo, ModuleInfo,
- PredConstraintMap, ModeDeclConstraint, PredInfo0, PredInfo) :-
- pred_info_create_proc_info_for_mode_decl_constraint(PredInfo0,
- ModeDeclConstraint, ProcId, PredInfo1),
+ PredConstraintMap, ModeDeclConstraint, !PredInfo) :-
+ pred_info_create_proc_info_for_mode_decl_constraint(
+ ModeDeclConstraint, ProcId, !PredInfo),
mode_ordering__check_proc(Constraint0, ModeConstraintInfo, ModuleInfo,
- PredConstraintMap, ProcId, PredInfo1, PredInfo).
+ PredConstraintMap, ProcId, !PredInfo).
:- pred mode_ordering__check_proc(mode_constraint::in,
mode_constraint_info::in, module_info::in, pred_constraint_map::in,
proc_id::in, pred_info::in, pred_info::out) is det.
mode_ordering__check_proc(Constraint0, ModeConstraintInfo, ModuleInfo,
- PredConstraintMap, ProcId, PredInfo0, PredInfo) :-
- pred_info_proc_info(PredInfo0, ProcId, ProcInfo0),
+ PredConstraintMap, ProcId, !PredInfo) :-
+ pred_info_proc_info(!.PredInfo, ProcId, ProcInfo0),
proc_info_head_modes_constraint(ProcInfo0, ModeDeclConstraint),
Constraint = Constraint0 * ModeDeclConstraint,
- InstGraph = PredInfo0 ^ inst_graph_info ^ implementation_inst_graph,
+ InstGraph = !.PredInfo ^ inst_graph_info ^ implementation_inst_graph,
mode_ordering__proc(InstGraph, Constraint, ModeConstraintInfo,
ModuleInfo, PredConstraintMap, ProcInfo0, ProcInfo),
- pred_info_set_proc_info(ProcId, ProcInfo, PredInfo0, PredInfo).
-
-% Perform mode ordering for a procedure. The ModeConstraint must be constrained
-% to contain just the mode information for this procedure.
+ pred_info_set_proc_info(ProcId, ProcInfo, !PredInfo).
+ % Perform mode ordering for a procedure. The ModeConstraint must be
+ % constrained to contain just the mode information for this procedure.
+ %
mode_ordering__proc(InstGraph, ModeConstraint, ModeConstraintInfo, ModuleInfo,
PredConstraintMap, !ProcInfo) :-
- Info0 = mode_ordering__info(InstGraph,
+ MOI = mode_ordering__info(InstGraph,
atomic_prodvars_map(ModeConstraint, ModeConstraintInfo),
stack__init, ModuleInfo, PredConstraintMap),
proc_info_goal(!.ProcInfo, Goal0),
- mode_ordering__goal(Goal0, Goal, Info0, _Info),
+ mode_ordering__goal(Goal0, Goal, MOI, _MOI),
proc_info_set_goal(Goal, !ProcInfo).
:- type mode_ordering__info
@@ -145,13 +146,12 @@
pred_constraint_map :: pred_constraint_map
).
-:- pred enter_lambda_goal(goal_path::in, mode_ordering__info::in,
- mode_ordering__info::out) is det.
+:- pred enter_lambda_goal(goal_path::in,
+ mode_ordering__info::in, mode_ordering__info::out) is det.
enter_lambda_goal(GoalPath, !MOI) :-
LambdaNesting0 = !.MOI ^ lambda_nesting,
- !:MOI = !.MOI ^ lambda_nesting
- := stack__push(LambdaNesting0, GoalPath).
+ !:MOI = !.MOI ^ lambda_nesting := stack__push(LambdaNesting0, GoalPath).
:- pred leave_lambda_goal(mode_ordering__info::in, mode_ordering__info::out)
is det.
@@ -171,46 +171,44 @@
hlds_goal_info::in, hlds_goal_info::out,
mode_ordering__info::in, mode_ordering__info::out) is det.
-mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+mode_ordering__goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
Goal0 = conj(Goals0),
Goal = conj(Goals),
list__map_foldl(mode_ordering__goal, Goals0, Goals1, !MOI),
mode_ordering__conj(Goals1, Goals),
- union_mode_vars_sets(Goals, GoalInfo0, GoalInfo1),
- ConsVars = GoalInfo1 ^ consuming_vars,
- GoalInfo2 = GoalInfo1 ^ consuming_vars :=
- ConsVars `difference` GoalInfo1 ^ producing_vars,
- NeedVars = GoalInfo2 ^ need_visible_vars,
- GoalInfo = GoalInfo2 ^ need_visible_vars :=
- NeedVars `difference` GoalInfo2 ^ make_visible_vars.
+ union_mode_vars_sets(Goals, !GoalInfo),
+ ConsVars = !.GoalInfo ^ consuming_vars,
+ !:GoalInfo = !.GoalInfo ^ consuming_vars :=
+ ConsVars `difference` !.GoalInfo ^ producing_vars,
+ NeedVars = !.GoalInfo ^ need_visible_vars,
+ !:GoalInfo = !.GoalInfo ^ need_visible_vars :=
+ NeedVars `difference` !.GoalInfo ^ make_visible_vars.
-mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+mode_ordering__goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
Goal0 = call(PredId, _, Args, _, _, _),
Goal = Goal0 ^ call_proc_id := ProcId,
- set_atomic_prod_vars(ProdVars, GoalInfo0, GoalInfo1, !MOI),
+ set_atomic_prod_vars(ProdVars, !GoalInfo, !MOI),
MakeVisibleVars = list_to_set(Args) `intersect` ProdVars,
find_matching_proc(PredId, Args, ProdVars, ProcId, ConsumingVars, !MOI),
NeedVisibleVars = list_to_set(Args) `intersect` ConsumingVars,
- goal_info_set_consuming_vars(GoalInfo1, ConsumingVars, GoalInfo2),
- goal_info_set_make_visible_vars(GoalInfo2, MakeVisibleVars,
- GoalInfo3),
- goal_info_set_need_visible_vars(GoalInfo3, NeedVisibleVars,
- GoalInfo).
+ goal_info_set_consuming_vars(ConsumingVars, !GoalInfo),
+ goal_info_set_make_visible_vars(MakeVisibleVars, !GoalInfo),
+ goal_info_set_need_visible_vars(NeedVisibleVars, !GoalInfo).
-mode_ordering__goal_2(Goal0, _, _, _, !MOI) :-
+mode_ordering__goal_2(Goal0, _, !GoalInfo, !MOI) :-
Goal0 = generic_call(_GenericCall0, _Args, _Modes0, _Det),
error("mode_ordering__goal_2: generic_call NYI").
-mode_ordering__goal_2(Goal0, _, _, _, !MOI) :-
+mode_ordering__goal_2(Goal0, _, !GoalInfo, !MOI) :-
Goal0 = switch(_Var, _CanFail0, _Cases0),
error("mode_ordering__goal_2: switch").
-mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+mode_ordering__goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
Goal0 = unify(VarA, RHS0, UnifyMode, Unification0, Context),
Goal = unify(VarA, RHS, UnifyMode, Unification, Context),
- set_atomic_prod_vars(ProdVars, GoalInfo0, GoalInfo1, !MOI),
+ set_atomic_prod_vars(ProdVars, !GoalInfo, !MOI),
InstGraph = !.MOI ^ inst_graph,
(
RHS0 = var(VarB),
@@ -267,7 +265,7 @@
RHS = lambda_goal(A, B, C, D, NonLocals, LambdaVars, Modes,
H, SubGoal),
- goal_info_get_goal_path(GoalInfo1, GoalPath),
+ goal_info_get_goal_path(!.GoalInfo, GoalPath),
enter_lambda_goal(GoalPath, !MOI),
mode_ordering__goal(SubGoal0, SubGoal, !MOI),
leave_lambda_goal(!MOI),
@@ -277,31 +275,29 @@
MakeVisibleVars = make_singleton_set(VarA),
NeedVisibleVars = list_to_set(NonLocals)
),
- goal_info_set_consuming_vars(GoalInfo1, ConsumingVars, GoalInfo2),
- goal_info_set_make_visible_vars(GoalInfo2, MakeVisibleVars,
- GoalInfo3),
- goal_info_set_need_visible_vars(GoalInfo3, NeedVisibleVars,
- GoalInfo).
+ goal_info_set_consuming_vars(ConsumingVars, !GoalInfo),
+ goal_info_set_make_visible_vars(MakeVisibleVars, !GoalInfo),
+ goal_info_set_need_visible_vars(NeedVisibleVars, !GoalInfo).
-mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+mode_ordering__goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
Goal0 = disj(Goals0),
Goal = disj(Goals),
list__map_foldl(mode_ordering__goal, Goals0, Goals, !MOI),
- mode_ordering__disj(Goals, GoalInfo0, GoalInfo).
+ mode_ordering__disj(Goals, !GoalInfo).
-mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+mode_ordering__goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
Goal0 = not(SubGoal0),
Goal = not(SubGoal),
mode_ordering__goal(SubGoal0, SubGoal, !MOI),
- goal_info_copy_mode_var_sets(SubGoal ^ snd, GoalInfo0, GoalInfo).
+ goal_info_copy_mode_var_sets(SubGoal ^ snd, !GoalInfo).
-mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+mode_ordering__goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
Goal0 = scope(Reason, SubGoal0),
Goal = scope(Reason, SubGoal),
mode_ordering__goal(SubGoal0, SubGoal, !MOI),
- goal_info_copy_mode_var_sets(SubGoal ^ snd, GoalInfo0, GoalInfo).
+ goal_info_copy_mode_var_sets(SubGoal ^ snd, !GoalInfo).
-mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+mode_ordering__goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
Goal0 = if_then_else(Locals, Cond0, Then0, Else0),
Goal = if_then_else(Locals, Cond, Then, Else),
mode_ordering__goal(Cond0, Cond, !MOI),
@@ -309,27 +305,27 @@
mode_ordering__goal(Else0, Else, !MOI),
% XXX Ned to make sure that Cond can be scheduled before Then and Else.
- union_mode_vars_sets([Cond, Then], GoalInfo0, GoalInfo1),
- ConsVars = GoalInfo1 ^ consuming_vars,
- GoalInfo2 = GoalInfo1 ^ consuming_vars :=
- ConsVars `difference` GoalInfo1 ^ producing_vars,
- NeedVars = GoalInfo2 ^ need_visible_vars,
- GoalInfo3 = GoalInfo2 ^ need_visible_vars :=
- NeedVars `difference` GoalInfo2 ^ make_visible_vars,
+ union_mode_vars_sets([Cond, Then], !GoalInfo),
+ ConsVars = !.GoalInfo ^ consuming_vars,
+ !:GoalInfo = !.GoalInfo ^ consuming_vars :=
+ ConsVars `difference` !.GoalInfo ^ producing_vars,
+ NeedVars = !.GoalInfo ^ need_visible_vars,
+ !:GoalInfo = !.GoalInfo ^ need_visible_vars :=
+ NeedVars `difference` !.GoalInfo ^ make_visible_vars,
- combine_mode_vars_sets(Else ^ snd, GoalInfo3, GoalInfo).
+ combine_mode_vars_sets(Else ^ snd, !GoalInfo).
-mode_ordering__goal_2(Goal0, _, _, _, !MOI) :-
+mode_ordering__goal_2(Goal0, _, !GoalInfo, !MOI) :-
Goal0 = foreign_proc(_, _, _, _, _, _),
error("mode_ordering__goal_2: pragma_foreign_code NYI").
-mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+mode_ordering__goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
Goal0 = par_conj(Goals0),
Goal = par_conj(Goals),
list__map_foldl(mode_ordering__goal, Goals0, Goals, !MOI),
- union_mode_vars_sets(Goals, GoalInfo0, GoalInfo).
+ union_mode_vars_sets(Goals, !GoalInfo).
-mode_ordering__goal_2(Goal0, _, _, _, !MOI) :-
+mode_ordering__goal_2(Goal0, _, !GoalInfo, !MOI) :-
Goal0 = shorthand(_),
error("mode_ordering__goal_2: shorthand").
@@ -350,42 +346,54 @@
:- pred combine_mode_vars_sets(hlds_goal_info::in,
hlds_goal_info::in, hlds_goal_info::out) is det.
-combine_mode_vars_sets(GI) -->
- ProdVars0 =^ producing_vars,
- ConsumVars0 =^ consuming_vars,
- MakeVisibleVars0 =^ make_visible_vars,
- NeedVisibleVars0 =^ need_visible_vars,
-
- ^producing_vars := ProdVars0 `intersect` GI^producing_vars,
- ^consuming_vars := ConsumVars0 `union` GI^consuming_vars,
- ^make_visible_vars := MakeVisibleVars0 `intersect` GI^make_visible_vars,
- ^need_visible_vars := NeedVisibleVars0 `union` GI^need_visible_vars.
+combine_mode_vars_sets(GI, !GoalInfo) :-
+ ProdVars0 = !.GoalInfo ^ producing_vars,
+ ConsumVars0 = !.GoalInfo ^ consuming_vars,
+ MakeVisibleVars0 = !.GoalInfo ^ make_visible_vars,
+ NeedVisibleVars0 = !.GoalInfo ^ need_visible_vars,
+
+ !:GoalInfo = !.GoalInfo ^ producing_vars
+ := ProdVars0 `intersect` GI ^ producing_vars,
+ !:GoalInfo = !.GoalInfo ^ consuming_vars
+ := ConsumVars0 `union` GI ^ consuming_vars,
+ !:GoalInfo = !.GoalInfo ^ make_visible_vars
+ := MakeVisibleVars0 `intersect` GI ^ make_visible_vars,
+ !:GoalInfo = !.GoalInfo ^ need_visible_vars
+ := NeedVisibleVars0 `union` GI ^ need_visible_vars.
:- pred union_mode_vars_sets(hlds_goals::in,
hlds_goal_info::in, hlds_goal_info::out) is det.
-union_mode_vars_sets(Goals) -->
- list__foldl((pred(Goal::in, in, out) is det -->
- ProdVars0 =^ producing_vars,
- ConsumVars0 =^ consuming_vars,
- MakeVisibleVars0 =^ make_visible_vars,
- NeedVisibleVars0 =^ need_visible_vars,
- { Goal = _ - GI },
-
- ^producing_vars := ProdVars0 `union` GI^producing_vars,
- ^consuming_vars := ConsumVars0 `union` GI^consuming_vars,
- ^make_visible_vars := MakeVisibleVars0 `union` GI^make_visible_vars,
- ^need_visible_vars := NeedVisibleVars0 `union` GI^need_visible_vars
- ), Goals).
+union_mode_vars_sets(Goals, !GoalInfo) :-
+ list__foldl(union_mode_vars_set, Goals, !GoalInfo).
+
+:- pred union_mode_vars_set(hlds_goal::in,
+ hlds_goal_info::in, hlds_goal_info::out) is det.
+
+union_mode_vars_set(Goal, !GoalInfo) :-
+ ProdVars0 = !.GoalInfo ^ producing_vars,
+ ConsumVars0 = !.GoalInfo ^ consuming_vars,
+ MakeVisibleVars0 = !.GoalInfo ^ make_visible_vars,
+ NeedVisibleVars0 = !.GoalInfo ^ need_visible_vars,
+ Goal = _ - GI,
+
+ !:GoalInfo = !.GoalInfo ^ producing_vars
+ := ProdVars0 `union` GI ^ producing_vars,
+ !:GoalInfo = !.GoalInfo ^ consuming_vars
+ := ConsumVars0 `union` GI ^ consuming_vars,
+ !:GoalInfo = !.GoalInfo ^ make_visible_vars
+ := MakeVisibleVars0 `union` GI ^ make_visible_vars,
+ !:GoalInfo = !.GoalInfo ^ need_visible_vars
+ := NeedVisibleVars0 `union` GI ^ need_visible_vars.
:- pred goal_info_copy_mode_var_sets(hlds_goal_info::in,
hlds_goal_info::in, hlds_goal_info::out) is det.
-goal_info_copy_mode_var_sets(GI) -->
- ^ producing_vars := GI^producing_vars,
- ^ consuming_vars := GI^consuming_vars,
- ^ make_visible_vars := GI^make_visible_vars,
- ^ need_visible_vars := GI^need_visible_vars.
+goal_info_copy_mode_var_sets(GI, !GoalInfo) :-
+ !:GoalInfo = !.GoalInfo ^ producing_vars := GI ^ producing_vars,
+ !:GoalInfo = !.GoalInfo ^ consuming_vars := GI ^ consuming_vars,
+ !:GoalInfo = !.GoalInfo ^ make_visible_vars := GI ^ make_visible_vars,
+ !:GoalInfo = !.GoalInfo ^ need_visible_vars := GI ^ need_visible_vars.
:- pred mode_ordering__conj(hlds_goals::in, hlds_goals::out) is det.
@@ -442,34 +450,34 @@
error("mode_ordering__conj: Cycle in goal dependencies.")
).
-:- pred set_atomic_prod_vars(set(prog_var)::out, hlds_goal_info::in,
- hlds_goal_info::out, mode_ordering__info::in,
- mode_ordering__info::out) is det.
-
-set_atomic_prod_vars(ProdVars, GoalInfo0, GoalInfo) -->
- LambdaNesting =^ lambda_nesting,
- AtomicProdVars =^ prodvars_map,
- { goal_info_get_goal_path(GoalInfo0, GoalPath) },
- { ProdVars = ( map__search(AtomicProdVars,
- stack__push(LambdaNesting, GoalPath), ProdVars0)
+:- pred set_atomic_prod_vars(set(prog_var)::out,
+ hlds_goal_info::in, hlds_goal_info::out,
+ mode_ordering__info::in, mode_ordering__info::out) is det.
+
+set_atomic_prod_vars(ProdVars, !GoalInfo, !MOI) :-
+ LambdaNesting = !.MOI ^ lambda_nesting,
+ AtomicProdVars = !.MOI ^ prodvars_map,
+ goal_info_get_goal_path(!.GoalInfo, GoalPath),
+ (
+ map__search(AtomicProdVars, stack__push(LambdaNesting, GoalPath),
+ ProdVars0)
->
- ProdVars0
+ ProdVars = ProdVars0
;
- set__init
- )},
- { goal_info_set_producing_vars(GoalInfo0, ProdVars, GoalInfo) }.
+ ProdVars = set__init
+ ),
+ goal_info_set_producing_vars(ProdVars, !GoalInfo).
-:- pred pred_info_create_proc_info_for_mode_decl_constraint(pred_info::in,
- mode_constraint::in, proc_id::out, pred_info::out) is det.
+:- pred pred_info_create_proc_info_for_mode_decl_constraint(
+ mode_constraint::in, proc_id::out, pred_info::in, pred_info::out) is det.
-pred_info_create_proc_info_for_mode_decl_constraint(PredInfo0,
- _ModeDeclConstraint, ProcId, PredInfo) :-
+pred_info_create_proc_info_for_mode_decl_constraint(_ModeDeclConstraint,
+ ProcId, !PredInfo) :-
( semidet_succeed ->
% XXX
error("NYI: pred_info_create_proc_info_for_mode_decl_constraint")
;
% XXX keep det checker happy.
- PredInfo = PredInfo0,
ProcId = initial_proc_id
).
@@ -477,34 +485,32 @@
proc_id::out, set(prog_var)::out,
mode_ordering__info::in, mode_ordering__info::out) is det.
-find_matching_proc(PredId, Args, ProdVars, ProcId, ConsumingVars) -->
- ModuleInfo =^ module_info,
- CallerInstGraph =^ inst_graph,
- PredConstraintMap =^ pred_constraint_map,
- { lookup_pred_constraint(PredConstraintMap, PredId, _, MCInfo) },
-
- { module_info_pred_info(ModuleInfo, PredId, PredInfo) },
- { CalleeInstGraph = PredInfo^inst_graph_info^interface_inst_graph },
- { pred_info_procedures(PredInfo, ProcTable) },
- { map__to_assoc_list(ProcTable, ProcList) },
+find_matching_proc(PredId, Args, ProdVars, ProcId, ConsumingVars, !MOI) :-
+ ModuleInfo = !.MOI ^ module_info,
+ CallerInstGraph = !.MOI ^ inst_graph,
+ PredConstraintMap = !.MOI ^ pred_constraint_map,
+ lookup_pred_constraint(PredConstraintMap, PredId, _, MCInfo),
+
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ CalleeInstGraph = PredInfo^inst_graph_info^interface_inst_graph,
+ pred_info_procedures(PredInfo, ProcTable),
+ map__to_assoc_list(ProcTable, ProcList),
(
- { find_matching_proc_2(ProcList, ProdVars, Args,
- CallerInstGraph, CalleeInstGraph, MCInfo, ProcId0,
- ConsumingVars0) }
+ find_matching_proc_2(ProcList, ProdVars, Args,
+ CallerInstGraph, CalleeInstGraph, MCInfo, ProcId0, ConsumingVars0)
->
- { ProcId = ProcId0 },
- { ConsumingVars = ConsumingVars0 }
+ ProcId = ProcId0,
+ ConsumingVars = ConsumingVars0
;
- { pred_info_infer_modes(PredInfo) }
+ pred_info_infer_modes(PredInfo)
->
- % XXX We are inferring modes for the called predicate. Need to
- % add a new mode to the requested procs map.
- { error("find_matching_proc: infer_modes NYI") }
- ;
- % If we get here, it means there is a mode error which should
- % have been picked up by the constraints pass but was missed
- % some how.
- { error("find_matching_proc: unexpected mode error") }
+ % XXX We are inferring modes for the called predicate. Need to add
+ % a new mode to the requested procs map.
+ error("find_matching_proc: infer_modes NYI")
+ ;
+ % If we get here, it means there is a mode error which should have been
+ % picked up by the constraints pass but was missed some how.
+ error("find_matching_proc: unexpected mode error")
).
:- pred find_matching_proc_2(assoc_list(proc_id, proc_info)::in,
@@ -512,12 +518,12 @@
mode_constraint_info::in, proc_id::out, set(prog_var)::out) is semidet.
find_matching_proc_2([ProcId0 - ProcInfo | ProcList], ProdVars, Args,
- CallerInstGraph, CalleeInstGraph, MCInfo, ProcId,
- ConsumingVars) :-
+ CallerInstGraph, CalleeInstGraph, MCInfo, ProcId, ConsumingVars) :-
proc_info_headvars(ProcInfo, HeadVars),
proc_info_head_modes_constraint(ProcInfo, Constraint0),
Constraint = ensure_normalised(Constraint0),
(
+ (
all [X, Y] inst_graph__corresponding_nodes_from_lists(
CallerInstGraph, CalleeInstGraph, Args, HeadVars, X, Y)
=>
@@ -531,6 +537,7 @@
mode_constraint_var(MCInfo, in(Y)))
)
)
+ )
->
ProcId = ProcId0,
ConsumingVars = solutions_set(pred(X::out) is nondet :-
@@ -538,18 +545,19 @@
inst_graph__corresponding_nodes_from_lists(CallerInstGraph,
CalleeInstGraph, Args, HeadVars, X, Y),
var_entailed(Constraint, mode_constraint_var(MCInfo, in(Y)))
- ))
+ )
+ )
;
find_matching_proc_2(ProcList, ProdVars, Args, CallerInstGraph,
CalleeInstGraph, MCInfo, ProcId, ConsumingVars)
).
-:- pred report_mode_errors(module_info::in, io::di, io::uo) is det.
+:- pred report_ordering_mode_errors(module_info::in, io::di, io::uo) is det.
-report_mode_errors(_, !IO).
+report_ordering_mode_errors(_, !IO).
% XXX
- %io__stderr_stream(StdErr, !IO),
- %io__write_string(StdErr, "Mode error reporting NYI", !IO).
+ % io__stderr_stream(StdErr, !IO),
+ % io__write_string(StdErr, "Mode error reporting NYI", !IO).
:- pred lookup_pred_constraint(pred_constraint_map::in, pred_id::in,
mode_constraint::out, mode_constraint_info::out) is det.
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.168
diff -u -b -r1.168 mode_util.m
--- compiler/mode_util.m 12 Aug 2005 03:18:26 -0000 1.168
+++ compiler/mode_util.m 22 Aug 2005 15:35:01 -0000
@@ -86,14 +86,18 @@
:- pred modes_to_arg_modes(module_info::in, list(mode)::in, list(type)::in,
list(arg_mode)::out) is det.
-:- pred mode_list_get_initial_insts(list(mode)::in, module_info::in,
- list(inst)::out) is det.
+:- func mode_get_initial_inst(module_info, (mode)) = (inst).
-:- pred mode_list_get_final_insts(list(mode)::in, module_info::in,
- list(inst)::out) is det.
+:- func mode_get_final_inst(module_info, (mode)) = (inst).
+
+:- pred mode_list_get_initial_insts(module_info::in,
+ list(mode)::in, list(inst)::out) is det.
-:- pred mode_util__modes_to_uni_modes(list(mode)::in, list(mode)::in,
- module_info::in, list(uni_mode)::out) is det.
+:- pred mode_list_get_final_insts(module_info::in,
+ list(mode)::in, list(inst)::out) is det.
+
+:- pred modes_to_uni_modes(module_info::in, list(mode)::in, list(mode)::in,
+ list(uni_mode)::out) is det.
% Given a user-defined or compiler-defined inst name, lookup the
% corresponding inst in the inst table.
@@ -120,16 +124,15 @@
% of modes which includes the information provided by the
% corresponding types.
%
-:- pred propagate_types_into_mode_list(list(type)::in, module_info::in,
+:- pred propagate_types_into_mode_list(module_info::in, list(type)::in,
list(mode)::in, list(mode)::out) is det.
% Given corresponding lists of types and insts and a substitution
% for the type variables in the type, produce a new list of insts
- % which includes the information provided by the corresponding
- % types.
+ % which includes the information provided by the corresponding types.
%
-:- pred propagate_types_into_inst_list(list(type)::in, tsubst::in,
- module_info::in, list(inst)::in, list(inst)::out) is det.
+:- pred propagate_types_into_inst_list(module_info::in, tsubst::in,
+ list(type)::in, list(inst)::in, list(inst)::out) is det.
% Convert a list of constructors to a list of bound_insts where the
% arguments are `ground'.
@@ -137,8 +140,8 @@
% NOTE: the list(bound_inst) is not sorted and may contain
% duplicates.
%
-:- pred constructors_to_bound_insts(list(constructor)::in, uniqueness::in,
- module_info::in, list(bound_inst)::out) is det.
+:- pred constructors_to_bound_insts(module_info::in, uniqueness::in,
+ list(constructor)::in, list(bound_inst)::out) is det.
% Convert a list of constructors to a list of bound_insts where the
% arguments are `any'.
@@ -146,14 +149,14 @@
% NOTE: the list(bound_inst) is not sorted and may contain
% duplicates.
%
-:- pred constructors_to_bound_any_insts(list(constructor)::in, uniqueness::in,
- module_info::in, list(bound_inst)::out) is det.
+:- pred constructors_to_bound_any_insts(module_info::in, uniqueness::in,
+ list(constructor)::in, list(bound_inst)::out) is det.
% Given the mode of a predicate, work out which arguments are live
% (might be used again by the caller of that predicate) and which
% are dead.
%
-:- pred get_arg_lives(list(mode)::in, module_info::in, list(is_live)::out)
+:- pred get_arg_lives(module_info::in, list(mode)::in, list(is_live)::out)
is det.
% Given the switched on variable and the instmaps before the switch
@@ -165,10 +168,10 @@
%-----------------------------------------------------------------------------%
-:- pred normalise_insts(list(inst)::in, list(type)::in, module_info::in,
- list(inst)::out) is det.
+:- pred normalise_insts(module_info::in, list(type)::in,
+ list(inst)::in, list(inst)::out) is det.
-:- pred normalise_inst((inst)::in, (type)::in, module_info::in, (inst)::out)
+:- pred normalise_inst(module_info::in, (type)::in, (inst)::in, (inst)::out)
is det.
%-----------------------------------------------------------------------------%
@@ -208,15 +211,21 @@
%-----------------------------------------------------------------------------%
-mode_list_get_final_insts([], _ModuleInfo, []).
-mode_list_get_final_insts([Mode | Modes], ModuleInfo, [Inst | Insts]) :-
- mode_get_insts(ModuleInfo, Mode, _, Inst),
- mode_list_get_final_insts(Modes, ModuleInfo, Insts).
+mode_get_initial_inst(ModuleInfo, Mode) = Inst :-
+ mode_get_insts(ModuleInfo, Mode, Inst, _).
+
+mode_get_final_inst(ModuleInfo, Mode) = Inst :-
+ mode_get_insts(ModuleInfo, Mode, _, Inst).
-mode_list_get_initial_insts([], _ModuleInfo, []).
-mode_list_get_initial_insts([Mode | Modes], ModuleInfo, [Inst | Insts]) :-
+mode_list_get_initial_insts(_ModuleInfo, [], []).
+mode_list_get_initial_insts(ModuleInfo, [Mode | Modes], [Inst | Insts]) :-
mode_get_insts(ModuleInfo, Mode, Inst, _),
- mode_list_get_initial_insts(Modes, ModuleInfo, Insts).
+ mode_list_get_initial_insts(ModuleInfo, Modes, Insts).
+
+mode_list_get_final_insts(_ModuleInfo, [], []).
+mode_list_get_final_insts(ModuleInfo, [Mode | Modes], [Inst | Insts]) :-
+ mode_get_insts(ModuleInfo, Mode, _, Inst),
+ mode_list_get_final_insts(ModuleInfo, Modes, Insts).
%-----------------------------------------------------------------------------%
@@ -278,12 +287,10 @@
mode_to_arg_mode_2(ModuleInfo, Mode, Type, ContainingTypes, ArgMode) :-
%
- % We need to handle no_tag types (types which have
- % exactly one constructor, and whose one constructor
- % has exactly one argument) specially here,
- % since for them an inst of bound(f(free)) is not really bound
- % as far as code generation is concerned, since the f/1
- % will get optimized away.
+ % We need to handle no_tag types (types which have exactly one constructor,
+ % and whose one constructor has exactly one argument) specially here,
+ % since for them an inst of bound(f(free)) is not really bound as far as
+ % code generation is concerned, since the f/1 will get optimized away.
%
(
% Is this a no_tag type?
@@ -298,10 +305,8 @@
%
mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
ConsId = cons(FunctorName, 1),
- get_single_arg_inst(InitialInst, ModuleInfo, ConsId,
- InitialArgInst),
- get_single_arg_inst(FinalInst, ModuleInfo, ConsId,
- FinalArgInst),
+ get_single_arg_inst(InitialInst, ModuleInfo, ConsId, InitialArgInst),
+ get_single_arg_inst(FinalInst, ModuleInfo, ConsId, FinalArgInst),
ModeOfArg = (InitialArgInst -> FinalArgInst),
mode_to_arg_mode_2(ModuleInfo, ModeOfArg, ArgType,
[TypeCtor | ContainingTypes], ArgMode)
@@ -325,9 +330,9 @@
%-----------------------------------------------------------------------------%
% get_single_arg_inst(Inst, ConsId, Arity, ArgInsts):
- % Given an inst `Inst', figure out what the inst of the argument
- % would be, assuming that the functor is the one given by the
- % specified ConsId, whose arity is 1.
+ % Given an inst `Inst', figure out what the inst of the argument would be,
+ % assuming that the functor is the one given by the specified ConsId,
+ % whose arity is 1.
%
:- pred get_single_arg_inst((inst)::in, module_info::in, cons_id::in,
(inst)::out) is det.
@@ -341,7 +346,7 @@
( get_single_arg_inst_2(List, ConsId, ArgInst0) ->
ArgInst = ArgInst0
;
- % the code is unreachable
+ % The code is unreachable.
ArgInst = not_reached
).
get_single_arg_inst(free, _, _, free).
@@ -371,16 +376,16 @@
% Given two lists of modes (inst mappings) of equal length, convert
% them into a single list of inst pair mappings.
%
-mode_util__modes_to_uni_modes([], [], _ModuleInfo, []).
-mode_util__modes_to_uni_modes([], [_|_], _, _) :-
- unexpected(this_file, "mode_util.modes_to_uni_modes: length mismatch").
-mode_util__modes_to_uni_modes([_|_], [], _, _) :-
- unexpected(this_file, "mode_util.modes_to_uni_modes: length mismatch").
-mode_util__modes_to_uni_modes([X|Xs], [Y|Ys], ModuleInfo, [A|As]) :-
+modes_to_uni_modes(_ModuleInfo, [], [], []).
+modes_to_uni_modes(_ModuleInfo, [], [_ | _], _) :-
+ unexpected(this_file, "modes_to_uni_modes: length mismatch").
+modes_to_uni_modes(_ModuleInfo, [_ | _], [], _) :-
+ unexpected(this_file, "modes_to_uni_modes: length mismatch").
+modes_to_uni_modes(ModuleInfo, [X | Xs], [Y | Ys], [A | As]) :-
mode_get_insts(ModuleInfo, X, InitialX, FinalX),
mode_get_insts(ModuleInfo, Y, InitialY, FinalY),
A = ((InitialX - InitialY) -> (FinalX - FinalY)),
- mode_util__modes_to_uni_modes(Xs, Ys, ModuleInfo, As).
+ modes_to_uni_modes(ModuleInfo, Xs, Ys, As).
%-----------------------------------------------------------------------------%
@@ -453,22 +458,21 @@
user_inst_table_get_inst_defns(UserInstTable, InstDefns),
list__length(Args, Arity),
( map__search(InstDefns, Name - Arity, InstDefn) ->
- InstDefn = hlds_inst_defn(_VarSet, Params, Inst0,
- _C, _),
- inst_lookup_subst_args(Inst0, Params, Name, Args, Inst)
+ InstDefn = hlds_inst_defn(_VarSet, Params, InstBody, _C, _),
+ inst_lookup_subst_args(InstBody, Params, Name, Args, Inst)
;
Inst = abstract_inst(Name, Args)
)
;
InstName = typed_ground(Uniq, Type),
map__init(Subst),
- propagate_type_into_inst(Type, Subst, ModuleInfo,
+ propagate_type_into_inst(ModuleInfo, Subst, Type,
ground(Uniq, none), Inst)
;
InstName = typed_inst(Type, TypedInstName),
inst_lookup(ModuleInfo, TypedInstName, Inst0),
map__init(Subst),
- propagate_type_into_inst(Type, Subst, ModuleInfo, Inst0, Inst)
+ propagate_type_into_inst(ModuleInfo, Subst, Type, Inst0, Inst)
).
%-----------------------------------------------------------------------------%
@@ -477,43 +481,39 @@
% list of modes which includes the information provided by the
% corresponding types.
%
-propagate_types_into_mode_list([], _, [], []).
-propagate_types_into_mode_list([Type | Types], ModuleInfo, [Mode0 | Modes0],
- [Mode | Modes]) :-
- propagate_type_into_mode(Type, ModuleInfo, Mode0, Mode),
- propagate_types_into_mode_list(Types, ModuleInfo, Modes0, Modes).
-propagate_types_into_mode_list([], _, [_|_], []) :-
- unexpected(this_file,
- "propagate_types_into_mode_list: length mismatch").
-propagate_types_into_mode_list([_|_], _, [], []) :-
- unexpected(this_file,
- "propagate_types_into_mode_list: length mismatch").
+propagate_types_into_mode_list(_, [], [], []).
+propagate_types_into_mode_list(ModuleInfo, [Type | Types],
+ [Mode0 | Modes0], [Mode | Modes]) :-
+ propagate_type_into_mode(ModuleInfo, Type, Mode0, Mode),
+ propagate_types_into_mode_list(ModuleInfo, Types, Modes0, Modes).
+propagate_types_into_mode_list(_, [], [_ | _], []) :-
+ unexpected(this_file, "propagate_types_into_mode_list: length mismatch").
+propagate_types_into_mode_list(_, [_ | _], [], []) :-
+ unexpected(this_file, "propagate_types_into_mode_list: length mismatch").
-propagate_types_into_inst_list([], _, _, [], []).
-propagate_types_into_inst_list([Type | Types], Subst, ModuleInfo,
+propagate_types_into_inst_list(_, _, [], [], []).
+propagate_types_into_inst_list(ModuleInfo, Subst, [Type | Types],
[Inst0 | Insts0], [Inst | Insts]) :-
- propagate_type_into_inst(Type, Subst, ModuleInfo, Inst0, Inst),
- propagate_types_into_inst_list(Types, Subst, ModuleInfo, Insts0, Insts).
-propagate_types_into_inst_list([], _, _, [_|_], []) :-
- unexpected(this_file,
- "propagate_types_into_inst_list: length mismatch").
-propagate_types_into_inst_list([_|_], _, _, [], []) :-
- unexpected(this_file,
- "propagate_types_into_inst_list: length mismatch").
+ propagate_type_into_inst(ModuleInfo, Subst, Type, Inst0, Inst),
+ propagate_types_into_inst_list(ModuleInfo, Subst, Types, Insts0, Insts).
+propagate_types_into_inst_list(_, _, [], [_ | _], []) :-
+ unexpected(this_file, "propagate_types_into_inst_list: length mismatch").
+propagate_types_into_inst_list(_, _, [_ | _], [], []) :-
+ unexpected(this_file, "propagate_types_into_inst_list: length mismatch").
% Given a type and a mode, produce a new mode that includes the
% information provided by the type.
%
-:- pred propagate_type_into_mode((type)::in, module_info::in,
+:- pred propagate_type_into_mode(module_info::in, (type)::in,
(mode)::in, (mode)::out) is det.
-propagate_type_into_mode(Type, ModuleInfo, Mode0, Mode) :-
+propagate_type_into_mode(ModuleInfo, Type, Mode0, Mode) :-
mode_get_insts(ModuleInfo, Mode0, InitialInst0, FinalInst0),
map__init(Subst),
- propagate_type_into_inst_lazily(Type, Subst, ModuleInfo, InitialInst0,
- InitialInst),
- propagate_type_into_inst_lazily(Type, Subst, ModuleInfo, FinalInst0,
- FinalInst),
+ propagate_type_into_inst_lazily(ModuleInfo, Subst, Type,
+ InitialInst0, InitialInst),
+ propagate_type_into_inst_lazily(ModuleInfo, Subst, Type,
+ FinalInst0, FinalInst),
Mode = (InitialInst -> FinalInst).
% Given a type, an inst and a substitution for the type variables in
@@ -540,11 +540,11 @@
% imported procedures will not be called, so for the insts in
% imported mode declarations N is often zero.
%
-:- pred propagate_type_into_inst((type)::in, tsubst::in, module_info::in,
+:- pred propagate_type_into_inst(module_info::in, tsubst::in, (type)::in,
(inst)::in, (inst)::out) is det.
-:- pred propagate_type_into_inst_lazily((type)::in, tsubst::in,
- module_info::in, (inst)::in, (inst)::out) is det.
+:- pred propagate_type_into_inst_lazily(module_info::in, tsubst::in,
+ (type)::in, (inst)::in, (inst)::out) is det.
% % XXX We ought to expand things eagerly here, using the commented
% % out code below. However, that causes efficiency problems,
@@ -554,157 +554,178 @@
% (
% type_constructors(Type, ModuleInfo, Constructors)
% ->
-% propagate_ctor_info(Inst0, Type, Constructors, ModuleInfo,
-% Inst)
+% propagate_ctor_info(Inst0, Type, Constructors, ModuleInfo, Inst)
% ;
% Inst = Inst0
% ).
-propagate_type_into_inst(Type, Subst, ModuleInfo, Inst0, Inst) :-
- propagate_ctor_info_lazily(Inst0, Type, Subst, ModuleInfo, Inst).
+propagate_type_into_inst(ModuleInfo, Subst, Type, Inst0, Inst) :-
+ propagate_ctor_info_lazily(ModuleInfo, Subst, Type, Inst0, Inst).
-propagate_type_into_inst_lazily(Type, Subst, ModuleInfo, Inst0, Inst) :-
- propagate_ctor_info_lazily(Inst0, Type, Subst, ModuleInfo, Inst).
+propagate_type_into_inst_lazily(ModuleInfo, Subst, Type, Inst0, Inst) :-
+ propagate_ctor_info_lazily(ModuleInfo, Subst, Type, Inst0, Inst).
%-----------------------------------------------------------------------------%
-:- pred propagate_ctor_info((inst)::in, (type)::in, list(constructor)::in,
- module_info::in, (inst)::out) is det.
-
-propagate_ctor_info(any(Uniq), _Type, _, _, any(Uniq)). % XXX loses type info!
-
-% propagate_ctor_info(free, Type, _, _, free(Type)). % temporarily disabled
-propagate_ctor_info(free, _Type, _, _, free). % XXX temporary hack
+:- pred propagate_ctor_info(module_info::in, (type)::in,
+ list(constructor)::in, (inst)::in, (inst)::out) is det.
-propagate_ctor_info(free(_), _, _, _, _) :-
- unexpected(this_file,
- "propagate_ctor_info: type info already present").
-propagate_ctor_info(bound(Uniq, BoundInsts0), Type, _Constructors, ModuleInfo,
- Inst) :-
- propagate_ctor_info_2(BoundInsts0, Type, ModuleInfo, BoundInsts),
- ( BoundInsts = [] ->
+propagate_ctor_info(ModuleInfo, Type, Constructors, Inst0, Inst) :-
+ (
+ Inst0 = any(_Uniq),
+ Inst = Inst0 % XXX loses type info!
+ ;
+ Inst0 = free,
+ % Inst = free(Type)
+ Inst = free % XXX temporary hack
+ ;
+ Inst0 = free(_),
+ unexpected(this_file, "propagate_ctor_info: type info already present")
+ ;
+ Inst0 = bound(Uniq, BoundInsts0),
+ propagate_ctor_info_2(ModuleInfo, Type, BoundInsts0, BoundInsts),
+ (
+ BoundInsts = [],
Inst = not_reached
;
+ BoundInsts = [_ | _],
% XXX do we need to sort the BoundInsts?
Inst = bound(Uniq, BoundInsts)
- ).
-propagate_ctor_info(ground(Uniq, none), Type, Constructors, ModuleInfo, Inst)
- :-
+ )
+ ;
+ Inst0 = ground(Uniq, none),
( type_is_higher_order(Type, _Purity, function, _, ArgTypes) ->
- default_higher_order_func_inst(ArgTypes, ModuleInfo,
+ default_higher_order_func_inst(ModuleInfo, ArgTypes,
HigherOrderInstInfo),
Inst = ground(Uniq, higher_order(HigherOrderInstInfo))
;
- constructors_to_bound_insts(Constructors, Uniq, ModuleInfo,
- BoundInsts0),
+ constructors_to_bound_insts(ModuleInfo, Uniq,
+ Constructors, BoundInsts0),
list__sort_and_remove_dups(BoundInsts0, BoundInsts),
Inst = bound(Uniq, BoundInsts)
- ).
-propagate_ctor_info(ground(Uniq, higher_order(PredInstInfo0)), Type, _Ctors,
- ModuleInfo, ground(Uniq, higher_order(PredInstInfo))) :-
+ )
+ ;
+ Inst0 = ground(Uniq, higher_order(PredInstInfo0)),
PredInstInfo0 = pred_inst_info(PredOrFunc, Modes0, Det),
- PredInstInfo = pred_inst_info(PredOrFunc, Modes, Det),
(
type_is_higher_order(Type, _Purity, PredOrFunc, _, ArgTypes),
list__same_length(ArgTypes, Modes0)
->
- propagate_types_into_mode_list(ArgTypes, ModuleInfo,
- Modes0, Modes)
+ propagate_types_into_mode_list(ModuleInfo, ArgTypes, Modes0, Modes)
;
% The inst is not a valid inst for the type, so leave it alone.
% This can only happen if the user has made a mistake. A mode
% error should hopefully be reported if anything tries to match
% with the inst.
Modes = Modes0
+ ),
+ PredInstInfo = pred_inst_info(PredOrFunc, Modes, Det),
+ Inst = ground(Uniq, higher_order(PredInstInfo))
+ ;
+ Inst0 = not_reached,
+ Inst = Inst0
+ ;
+ Inst0 = inst_var(_),
+ Inst = Inst0
+ ;
+ Inst0 = constrained_inst_vars(V, SubInst0),
+ propagate_ctor_info(ModuleInfo, Type, Constructors, SubInst0, SubInst),
+ Inst = constrained_inst_vars(V, SubInst)
+ ;
+ Inst0 = abstract_inst(_Name, _Args),
+ Inst = Inst0 % XXX loses info
+ ;
+ Inst0 = defined_inst(InstName),
+ inst_lookup(ModuleInfo, InstName, NamedInst),
+ propagate_ctor_info(ModuleInfo, Type, Constructors, NamedInst, Inst)
).
-propagate_ctor_info(not_reached, _Type, _Constructors, _ModuleInfo,
- not_reached).
-propagate_ctor_info(inst_var(V), _, _, _, inst_var(V)).
-propagate_ctor_info(constrained_inst_vars(V, Inst0), Type, Constructors,
- ModuleInfo, constrained_inst_vars(V, Inst)) :-
- propagate_ctor_info(Inst0, Type, Constructors, ModuleInfo, Inst).
-propagate_ctor_info(abstract_inst(Name, Args), _, _, _,
- abstract_inst(Name, Args)). % XXX loses info
-propagate_ctor_info(defined_inst(InstName), Type, Ctors, ModuleInfo, Inst) :-
- inst_lookup(ModuleInfo, InstName, Inst0),
- propagate_ctor_info(Inst0, Type, Ctors, ModuleInfo, Inst).
-
-:- pred propagate_ctor_info_lazily((inst)::in, (type)::in, tsubst::in,
- module_info::in, (inst)::out) is det.
-
-propagate_ctor_info_lazily(any(Uniq), _Type, _, _, any(Uniq)).
- % XXX loses type info!
-
-% propagate_ctor_info_lazily(free, Type, _, _, free(Type)).
- % temporarily disabled
-propagate_ctor_info_lazily(free, _Type, _, _, free). % XXX temporary hack
-
-propagate_ctor_info_lazily(free(_), _, _, _, _) :-
- error("propagate_ctor_info_lazily: type info already present").
-propagate_ctor_info_lazily(bound(Uniq, BoundInsts0), Type0, Subst,
- ModuleInfo, Inst) :-
+
+:- pred propagate_ctor_info_lazily(module_info::in, tsubst::in, (type)::in,
+ (inst)::in, (inst)::out) is det.
+
+propagate_ctor_info_lazily(ModuleInfo, Subst, Type0, Inst0, Inst) :-
+ (
+ Inst0 = any(_Uniq),
+ Inst = Inst0 % XXX loses type info!
+ ;
+ Inst0 = free,
+ % Inst = free(Type0)
+ Inst = free % XXX temporary hack
+ ;
+ Inst0 = free(_),
+ error("propagate_ctor_info_lazily: type info already present")
+ ;
+ Inst0 = bound(Uniq, BoundInsts0),
apply_type_subst(Type0, Subst, Type),
- propagate_ctor_info_2(BoundInsts0, Type, ModuleInfo, BoundInsts),
- ( BoundInsts = [] ->
+ propagate_ctor_info_2(ModuleInfo, Type, BoundInsts0, BoundInsts),
+ (
+ BoundInsts = [],
Inst = not_reached
;
- % XXX do we need to sort the BoundInsts?
+ BoundInsts = [_ | _],
+ % XXX Do we need to sort the BoundInsts?
Inst = bound(Uniq, BoundInsts)
- ).
-propagate_ctor_info_lazily(ground(Uniq, none), Type0, Subst, ModuleInfo, Inst)
- :-
+ )
+ ;
+ Inst0 = ground(Uniq, none),
apply_type_subst(Type0, Subst, Type),
( type_is_higher_order(Type, _Purity, function, _, ArgTypes) ->
- default_higher_order_func_inst(ArgTypes, ModuleInfo,
+ default_higher_order_func_inst(ModuleInfo, ArgTypes,
HigherOrderInstInfo),
Inst = ground(Uniq, higher_order(HigherOrderInstInfo))
;
- % XXX The information added by this is not yet used,
- % so it's disabled since it unnecessarily complicates
- % the insts.
+ % XXX The information added by this is not yet used, so it's
+ % disabled since it unnecessarily complicates the insts.
%
% Inst = defined_inst(typed_ground(Uniq, Type))
Inst = ground(Uniq, none)
- ).
-
-propagate_ctor_info_lazily(ground(Uniq, higher_order(PredInstInfo0)), Type0,
- Subst, ModuleInfo, ground(Uniq, higher_order(PredInstInfo))) :-
+ )
+ ;
+ Inst0 = ground(Uniq, higher_order(PredInstInfo0)),
PredInstInfo0 = pred_inst_info(PredOrFunc, Modes0, Det),
- PredInstInfo = pred_inst_info(PredOrFunc, Modes, Det),
apply_type_subst(Type0, Subst, Type),
(
type_is_higher_order(Type, _Purity, PredOrFunc, _, ArgTypes),
list__same_length(ArgTypes, Modes0)
->
- propagate_types_into_mode_list(ArgTypes, ModuleInfo,
- Modes0, Modes)
+ propagate_types_into_mode_list(ModuleInfo, ArgTypes, Modes0, Modes)
;
- % The inst is not a valid inst for the type,
- % so leave it alone. This can only happen if the user
- % has made a mistake. A mode error should hopefully
- % be reported if anything tries to match with the inst.
+ % The inst is not a valid inst for the type, so leave it alone.
+ % This can only happen if the user has made a mistake. A mode error
+ % should hopefully be reported if anything tries to match with the
+ % inst.
Modes = Modes0
- ).
-propagate_ctor_info_lazily(not_reached, _Type, _, _ModuleInfo, not_reached).
-propagate_ctor_info_lazily(inst_var(Var), _, _, _, inst_var(Var)).
-propagate_ctor_info_lazily(constrained_inst_vars(V, Inst0), Type, Constructors,
- ModuleInfo, constrained_inst_vars(V, Inst)) :-
- propagate_ctor_info_lazily(Inst0, Type, Constructors, ModuleInfo, Inst).
-propagate_ctor_info_lazily(abstract_inst(Name, Args), _, _, _,
- abstract_inst(Name, Args)). % XXX loses info
-propagate_ctor_info_lazily(defined_inst(InstName0), Type0, Subst, _,
- defined_inst(InstName)) :-
+ ),
+ PredInstInfo = pred_inst_info(PredOrFunc, Modes, Det),
+ Inst = ground(Uniq, higher_order(PredInstInfo))
+ ;
+ Inst0 = not_reached,
+ Inst = Inst0
+ ;
+ Inst0 = inst_var(_),
+ Inst = Inst0
+ ;
+ Inst0 = constrained_inst_vars(V, SubInst0),
+ propagate_ctor_info_lazily(ModuleInfo, Subst, Type0,
+ SubInst0, SubInst),
+ Inst = constrained_inst_vars(V, SubInst)
+ ;
+ Inst0 = abstract_inst(_Name, _Args),
+ Inst = Inst0 % XXX loses info
+ ;
+ Inst0 = defined_inst(InstName0),
apply_type_subst(Type0, Subst, Type),
( InstName0 = typed_inst(_, _) ->
- % If this happens, it means that we have already
- % lazily propagated type info into this inst.
- % We want to avoid creating insts of the form
- % typed_inst(_, typed_inst(...)), because that would be
- % unnecessary, and could cause efficiency problems
- % or perhaps even infinite loops (?).
+ % If this happens, it means that we have already lazily propagated
+ % type info into this inst. We want to avoid creating insts of
+ % the form typed_inst(_, typed_inst(...)), because that would be
+ % unnecessary, and could cause efficiency problems or perhaps
+ % even infinite loops.
InstName = InstName0
;
InstName = typed_inst(Type, InstName0)
+ ),
+ Inst = defined_inst(InstName)
).
%
@@ -715,10 +736,10 @@
% This applies recursively to the arguments and return
% value too.
%
-:- pred default_higher_order_func_inst(list(type)::in, module_info::in,
+:- pred default_higher_order_func_inst(module_info::in, list(type)::in,
pred_inst_info::out) is det.
-default_higher_order_func_inst(PredArgTypes, ModuleInfo, PredInstInfo) :-
+default_higher_order_func_inst(ModuleInfo, PredArgTypes, PredInstInfo) :-
In = (ground(shared, none) -> ground(shared, none)),
Out = (free -> ground(shared, none)),
list__length(PredArgTypes, NumPredArgs),
@@ -726,30 +747,29 @@
list__duplicate(NumFuncArgs, In, FuncArgModes),
FuncRetMode = Out,
list__append(FuncArgModes, [FuncRetMode], PredArgModes0),
- propagate_types_into_mode_list(PredArgTypes, ModuleInfo,
+ propagate_types_into_mode_list(ModuleInfo, PredArgTypes,
PredArgModes0, PredArgModes),
PredInstInfo = pred_inst_info(function, PredArgModes, det).
-constructors_to_bound_insts(Constructors, Uniq, ModuleInfo, BoundInsts) :-
- constructors_to_bound_insts_2(Constructors, Uniq, ModuleInfo,
- ground(Uniq, none), BoundInsts).
-
-constructors_to_bound_any_insts(Constructors, Uniq, ModuleInfo, BoundInsts) :-
- constructors_to_bound_insts_2(Constructors, Uniq, ModuleInfo,
- any(Uniq), BoundInsts).
+constructors_to_bound_insts(ModuleInfo, Uniq, Constructors, BoundInsts) :-
+ constructors_to_bound_insts_2(ModuleInfo, Uniq,
+ Constructors, ground(Uniq, none), BoundInsts).
+
+constructors_to_bound_any_insts(ModuleInfo, Uniq, Constructors, BoundInsts) :-
+ constructors_to_bound_insts_2(ModuleInfo, Uniq,
+ Constructors, any(Uniq), BoundInsts).
-:- pred constructors_to_bound_insts_2(list(constructor)::in, uniqueness::in,
- module_info::in, (inst)::in, list(bound_inst)::out) is det.
+:- pred constructors_to_bound_insts_2(module_info::in, uniqueness::in,
+ list(constructor)::in, (inst)::in, list(bound_inst)::out) is det.
-constructors_to_bound_insts_2([], _, _, _, []).
-constructors_to_bound_insts_2([Ctor | Ctors], Uniq, ModuleInfo, ArgInst,
+constructors_to_bound_insts_2(_, _, [], _, []).
+constructors_to_bound_insts_2(ModuleInfo, Uniq, [Ctor | Ctors], ArgInst,
[BoundInst | BoundInsts]) :-
Ctor = ctor(_ExistQVars, _Constraints, Name, Args),
ctor_arg_list_to_inst_list(Args, ArgInst, Insts),
list__length(Insts, Arity),
BoundInst = functor(cons(Name, Arity), Insts),
- constructors_to_bound_insts_2(Ctors, Uniq, ModuleInfo, ArgInst,
- BoundInsts).
+ constructors_to_bound_insts_2(ModuleInfo, Uniq, Ctors, ArgInst, BoundInsts).
:- pred ctor_arg_list_to_inst_list(list(constructor_arg)::in, (inst)::in,
list(inst)::out) is det.
@@ -758,10 +778,10 @@
ctor_arg_list_to_inst_list([_Name - _Type | Args], Inst, [Inst | Insts]) :-
ctor_arg_list_to_inst_list(Args, Inst, Insts).
-:- pred propagate_ctor_info_2(list(bound_inst)::in, (type)::in,
- module_info::in, list(bound_inst)::out) is det.
+:- pred propagate_ctor_info_2(module_info::in, (type)::in,
+ list(bound_inst)::in, list(bound_inst)::out) is det.
-propagate_ctor_info_2(BoundInsts0, Type, ModuleInfo, BoundInsts) :-
+propagate_ctor_info_2(ModuleInfo, Type, BoundInsts0, BoundInsts) :-
(
type_is_tuple(Type, TupleArgTypes)
->
@@ -778,8 +798,8 @@
->
term__term_list_to_var_list(TypeParams0, TypeParams),
map__from_corresponding_lists(TypeParams, TypeArgs, ArgSubst),
- propagate_ctor_info_3(BoundInsts0, TypeModule, Constructors,
- ArgSubst, ModuleInfo, BoundInsts1),
+ propagate_ctor_info_3(ModuleInfo, ArgSubst, TypeModule, Constructors,
+ BoundInsts0, BoundInsts1),
list__sort(BoundInsts1, BoundInsts)
;
% Builtin types don't need processing.
@@ -798,8 +818,8 @@
ArgInstsLen = TupleArgTypesLen
->
map__init(Subst),
- propagate_types_into_inst_list(TupleArgTypes,
- Subst, ModuleInfo, ArgInsts0, ArgInsts)
+ propagate_types_into_inst_list(ModuleInfo, Subst, TupleArgTypes,
+ ArgInsts0, ArgInsts)
;
% The bound_inst's arity does not match the
% tuple's arity, so leave it alone. This can
@@ -810,13 +830,13 @@
),
BoundInst = functor(Functor, ArgInsts).
-:- pred propagate_ctor_info_3(list(bound_inst)::in, module_name::in,
- list(constructor)::in, tsubst::in, module_info::in,
- list(bound_inst)::out) is det.
-
-propagate_ctor_info_3([], _, _, _, _, []).
-propagate_ctor_info_3([BoundInst0 | BoundInsts0], TypeModule, Constructors,
- Subst, ModuleInfo, [BoundInst | BoundInsts]) :-
+:- pred propagate_ctor_info_3(module_info::in, tsubst::in,
+ module_name::in, list(constructor)::in,
+ list(bound_inst)::in, list(bound_inst)::out) is det.
+
+propagate_ctor_info_3(_, _, _, _, [], []).
+propagate_ctor_info_3(ModuleInfo, Subst, TypeModule, Constructors,
+ [BoundInst0 | BoundInsts0], [BoundInst | BoundInsts]) :-
BoundInst0 = functor(ConsId0, ArgInsts0),
( ConsId0 = cons(unqualified(Name), Ar) ->
ConsId = cons(qualified(TypeModule, Name), Ar)
@@ -836,8 +856,8 @@
CtorArg = _ArgName - ArgType
),
list__map(GetArgTypes, Args, ArgTypes),
- propagate_types_into_inst_list(ArgTypes, Subst,
- ModuleInfo, ArgInsts0, ArgInsts),
+ propagate_types_into_inst_list(ModuleInfo, Subst, ArgTypes,
+ ArgInsts0, ArgInsts),
BoundInst = functor(ConsId, ArgInsts)
;
% The cons_id is not a valid constructor for the type,
@@ -846,8 +866,8 @@
% tries to match with the inst.
BoundInst = functor(ConsId, ArgInsts0)
),
- propagate_ctor_info_3(BoundInsts0, TypeModule,
- Constructors, Subst, ModuleInfo, BoundInsts).
+ propagate_ctor_info_3(ModuleInfo, Subst, TypeModule,
+ Constructors, BoundInsts0, BoundInsts).
:- pred apply_type_subst((type)::in, tsubst::in, (type)::out) is det.
@@ -882,8 +902,7 @@
module_info_modes(ModuleInfo, Modes),
mode_table_get_mode_defns(Modes, ModeDefns),
map__search(ModeDefns, Name - Arity, HLDS_Mode),
- HLDS_Mode = hlds_mode_defn(_VarSet, Params, ModeDefn,
- _Context, _Status),
+ HLDS_Mode = hlds_mode_defn(_VarSet, Params, ModeDefn, _Context, _Status),
ModeDefn = eqv_mode(Mode0),
mode_substitute_arg_list(Mode0, Params, Args, Mode),
mode_get_insts_semidet(ModuleInfo, Mode, Initial, Final).
@@ -922,7 +941,7 @@
RI0 = recompute_info(ModuleInfo0, InstVarSet),
recompute_instmap_delta_1(RecomputeAtomic, Goal0, Goal, VarTypes,
InstMap0, _, RI0, RI),
- ModuleInfo = RI^module_info.
+ ModuleInfo = RI ^ module_info.
:- pred recompute_instmap_delta_1(bool::in, hlds_goal::in, hlds_goal::out,
vartypes::in, instmap::in, instmap_delta::out,
@@ -942,10 +961,8 @@
recompute_instmap_delta_2(RecomputeAtomic, Goal0, GoalInfo0,
Goal, VarTypes, InstMap0, InstMapDelta0, !RI),
goal_info_get_nonlocals(GoalInfo0, NonLocals),
- instmap_delta_restrict(InstMapDelta0, NonLocals,
- InstMapDelta1),
- goal_info_set_instmap_delta(GoalInfo0,
- InstMapDelta1, GoalInfo1)
+ instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta1),
+ goal_info_set_instmap_delta(GoalInfo0, InstMapDelta1, GoalInfo1)
),
% If the initial instmap is unreachable so is the final instmap.
@@ -982,8 +999,7 @@
instmap_delta::out, recompute_info::in, recompute_info::out) is det.
recompute_instmap_delta_2(Atomic, switch(Var, Det, Cases0), GoalInfo,
- switch(Var, Det, Cases), VarTypes, InstMap, InstMapDelta,
- !RI) :-
+ switch(Var, Det, Cases), VarTypes, InstMap, InstMapDelta, !RI) :-
( goal_info_has_feature(GoalInfo, mode_check_clauses_goal) ->
Cases = Cases0,
goal_info_get_instmap_delta(GoalInfo, InstMapDelta)
@@ -1034,7 +1050,8 @@
instmap_delta_apply_instmap_delta(InstMapDeltaCond, InstMapDeltaThen,
test_size, InstMapDeltaCondThen),
goal_info_get_nonlocals(GoalInfo, NonLocals),
- update_module_info(merge_instmap_delta(InstMap0, NonLocals,
+ update_module_info(
+ merge_instmap_delta(InstMap0, NonLocals,
VarTypes, InstMapDeltaElse, InstMapDeltaCondThen),
InstMapDelta, !RI).
@@ -1210,8 +1227,7 @@
InstVarSet = !.RI ^ inst_varset,
rename_apart_inst_vars(InstVarSet, ProcInstVarSet,
ArgModes0, ArgModes1),
- mode_list_get_initial_insts(ArgModes1, ModuleInfo,
- InitialInsts),
+ mode_list_get_initial_insts(ModuleInfo, ArgModes1, InitialInsts),
% Compute the inst_var substitution from the initial insts
% of the called procedure and the insts of the argument
@@ -1221,16 +1237,15 @@
InitialInsts, InstVarSub0), InstVarSub, !RI),
% Apply the inst_var substitution to the argument modes.
- mode_list_apply_substitution(ArgModes1, InstVarSub,
- ArgModes2),
+ mode_list_apply_substitution(ArgModes1, InstVarSub, ArgModes2),
% Calculate the final insts of the argument variables from their
% initial insts and the final insts of the called procedure
% (with inst_var substitutions applied).
- update_module_info(recompute_instmap_delta_call_2(Args, InstMap,
- ArgModes2), ArgModes, !RI),
- instmap_delta_from_mode_list(Args, ArgModes,
- ModuleInfo, InstMapDelta)
+ update_module_info(
+ recompute_instmap_delta_call_2(Args, InstMap, ArgModes2),
+ ArgModes, !RI),
+ instmap_delta_from_mode_list(Args, ArgModes, ModuleInfo, InstMapDelta)
).
:- pred compute_inst_var_sub(list(prog_var)::in, vartypes::in, instmap::in,
@@ -1238,9 +1253,9 @@
module_info::in, module_info::out) is det.
compute_inst_var_sub([], _, _, [], !Sub, !ModuleInfo).
-compute_inst_var_sub([_|_], _, _, [], !Sub, !ModuleInfo) :-
+compute_inst_var_sub([_ | _], _, _, [], !Sub, !ModuleInfo) :-
unexpected(this_file, "compute_inst_var_sub").
-compute_inst_var_sub([], _, _, [_|_], !Sub, !ModuleInfo) :-
+compute_inst_var_sub([], _, _, [_ | _], !Sub, !ModuleInfo) :-
unexpected(this_file, "compute_inst_var_sub").
compute_inst_var_sub([Arg | Args], VarTypes, InstMap, [Inst | Insts],
!Sub, !ModuleInfo) :-
@@ -1250,10 +1265,7 @@
( instmap__is_reachable(InstMap) ->
instmap__lookup_var(InstMap, Arg, ArgInst),
map__lookup(VarTypes, Arg, Type),
- (
- inst_matches_initial(ArgInst, Inst, Type, !ModuleInfo,
- !Sub)
- ->
+ ( inst_matches_initial(ArgInst, Inst, Type, !ModuleInfo, !Sub) ->
true
;
% error("compute_inst_var_sub: " ++
@@ -1269,8 +1281,7 @@
;
true
),
- compute_inst_var_sub(Args, VarTypes, InstMap, Insts, !Sub,
- !ModuleInfo).
+ compute_inst_var_sub(Args, VarTypes, InstMap, Insts, !Sub, !ModuleInfo).
:- pred recompute_instmap_delta_call_2(list(prog_var)::in, instmap::in,
list(mode)::in, list(mode)::out, module_info::in, module_info::out)
@@ -1294,8 +1305,7 @@
Mode = (ArgInst0 -> UnifyInst)
;
unexpected(this_file,
- "recompute_instmap_delta_call_2: " ++
- "unify_inst failed")
+ "recompute_instmap_delta_call_2: unify_inst failed")
)
;
Mode = (not_reached -> not_reached)
@@ -1352,34 +1362,35 @@
% Arguments with final inst `clobbered' are dead, any
% others are assumed to be live.
%
-get_arg_lives([], _, []).
-get_arg_lives([Mode|Modes], ModuleInfo, [IsLive|IsLives]) :-
+get_arg_lives(_, [], []).
+get_arg_lives(ModuleInfo, [Mode | Modes], [IsLive | IsLives]) :-
mode_get_insts(ModuleInfo, Mode, _InitialInst, FinalInst),
( inst_is_clobbered(ModuleInfo, FinalInst) ->
IsLive = dead
;
IsLive = live
),
- get_arg_lives(Modes, ModuleInfo, IsLives).
+ get_arg_lives(ModuleInfo, Modes, IsLives).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-normalise_insts([], [], _, []).
-normalise_insts([], [_|_], _, _) :-
+normalise_insts(_, [], [], []).
+normalise_insts(_, [], [_ | _], _) :-
unexpected(this_file, "normalise_insts: length mismatch").
-normalise_insts([_|_], [], _, _) :-
+normalise_insts(_, [_ | _], [], _) :-
unexpected(this_file, "normalise_insts: length mismatch").
-normalise_insts([Inst0|Insts0], [Type|Types], ModuleInfo, [Inst|Insts]) :-
- normalise_inst(Inst0, Type, ModuleInfo, Inst),
- normalise_insts(Insts0, Types, ModuleInfo, Insts).
+normalise_insts(ModuleInfo, [Type | Types],
+ [Inst0 | Insts0], [Inst | Insts]) :-
+ normalise_inst(ModuleInfo, Type, Inst0, Inst),
+ normalise_insts(ModuleInfo, Types, Insts0, Insts).
% This is a bit of a hack.
% The aim is to avoid non-termination due to the creation
% of ever-expanding insts.
% XXX should also normalise partially instantiated insts.
%
-normalise_inst(Inst0, Type, ModuleInfo, NormalisedInst) :-
+normalise_inst(ModuleInfo, Type, Inst0, NormalisedInst) :-
inst_expand(ModuleInfo, Inst0, Inst),
( Inst = bound(_, _) ->
(
@@ -1389,7 +1400,7 @@
% arguments, because that leads to an increase
% in the number of inferred modes without any benefit
\+ is_introduced_type_info_type(Type),
- \+ inst_contains_nonstandard_func_mode(Inst, ModuleInfo)
+ \+ inst_contains_nonstandard_func_mode(ModuleInfo, Inst)
->
NormalisedInst = ground(unique, none)
;
@@ -1399,13 +1410,13 @@
% arguments, because that leads to an increase
% in the number of inferred modes without any benefit
\+ is_introduced_type_info_type(Type),
- \+ inst_contains_nonstandard_func_mode(Inst, ModuleInfo)
+ \+ inst_contains_nonstandard_func_mode(ModuleInfo, Inst)
->
NormalisedInst = ground(mostly_unique, none)
;
inst_is_ground(ModuleInfo, Inst),
\+ inst_is_clobbered(ModuleInfo, Inst),
- \+ inst_contains_nonstandard_func_mode(Inst, ModuleInfo)
+ \+ inst_contains_nonstandard_func_mode(ModuleInfo, Inst)
->
NormalisedInst = ground(shared, none)
;
@@ -1435,18 +1446,18 @@
%-----------------------------------------------------------------------------%
-partition_args(_, [], [_|_], _, _) :- unexpected(this_file, "partition_args").
-partition_args(_, [_|_], [], _, _) :- unexpected(this_file, "partition_args").
+partition_args(_, [], [_ | _], _, _) :-
+ unexpected(this_file, "partition_args").
+partition_args(_, [_ | _], [], _, _) :-
+ unexpected(this_file, "partition_args").
partition_args(_, [], [], [], []).
partition_args(ModuleInfo, [ArgMode | ArgModes], [Arg | Args],
- InputArgs, OutputArgs) :-
- partition_args(ModuleInfo, ArgModes, Args, InputArgs1, OutputArgs1),
+ !:InputArgs, !:OutputArgs) :-
+ partition_args(ModuleInfo, ArgModes, Args, !:InputArgs, !:OutputArgs),
( mode_is_input(ModuleInfo, ArgMode) ->
- InputArgs = [Arg | InputArgs1],
- OutputArgs = OutputArgs1
+ !:InputArgs = [Arg | !.InputArgs]
;
- InputArgs = InputArgs1,
- OutputArgs = [Arg | OutputArgs1]
+ !:OutputArgs = [Arg | !.OutputArgs]
).
%-----------------------------------------------------------------------------%
@@ -1455,6 +1466,4 @@
this_file = "mode_util.m".
-%-----------------------------------------------------------------------------%
-:- end_module mode_util.
%-----------------------------------------------------------------------------%
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_call.m,v
retrieving revision 1.58
diff -u -b -r1.58 modecheck_call.m
--- compiler/modecheck_call.m 22 Mar 2005 06:40:14 -0000 1.58
+++ compiler/modecheck_call.m 22 Aug 2005 15:27:45 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2001, 2003-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -50,24 +52,19 @@
list(prog_var)::in, list(prog_var)::out, determinism::out,
extra_goals::out, mode_info::in, mode_info::out) is det.
- %
- % Given two modes of a predicate, figure out whether
- % they are indistinguishable; that is, whether any valid call to
- % one mode would also be a valid call to the other.
- % (If so, it is a mode error.)
+ % Given two modes of a predicate, figure out whether they are
+ % indistinguishable; that is, whether any valid call to one mode
+ % would also be a valid call to the other. (If so, it is a mode error.)
% Note that mode declarations which only have different final insts
% do not count as distinguishable.
%
:- pred modes_are_indistinguishable(proc_id::in, proc_id::in, pred_info::in,
module_info::in) is semidet.
- %
- % Given two modes of a predicate, figure out whether
- % they are identical, except that one is cc_nondet/cc_multi
- % and the other is nondet/multi.
- % This is used by determinism analysis to substitute
- % a multi mode for a cc_multi one if the call occurs in a
- % non-cc context.
+ % Given two modes of a predicate, figure out whether they are identical,
+ % except that one is cc_nondet/cc_multi and the other is nondet/multi.
+ % This is used by determinism analysis to substitute a multi mode
+ % for a cc_multi one if the call occurs in a non-cc context.
%
:- pred modes_are_identical_bar_cc(proc_id::in, proc_id::in, pred_info::in,
module_info::in) is semidet.
@@ -117,24 +114,21 @@
ProcIds = [ProcId0]
)
;
- % Get the list of different possible
- % modes for the called predicate
+ % Get the list of different possible modes for the called predicate.
ProcIds = pred_info_all_procids(PredInfo)
),
compute_arg_offset(PredInfo, ArgOffset),
pred_info_get_markers(PredInfo, Markers),
- % In order to give better diagnostics, we handle the
- % cases where there are zero or one modes for the called
- % predicate specially.
+ % In order to give better diagnostics, we handle the cases where there are
+ % zero or one modes for the called predicate specially.
(
ProcIds = [],
\+ check_marker(Markers, infer_modes)
->
set__init(WaitingVars),
- mode_info_error(WaitingVars, mode_error_no_mode_decl,
- !ModeInfo),
+ mode_info_error(WaitingVars, mode_error_no_mode_decl, !ModeInfo),
TheProcId = invalid_proc_id,
ArgVars = ArgVars0,
ExtraGoals = no_extra_goals
@@ -166,25 +160,22 @@
mode_info_get_instvarset(!.ModeInfo, InstVarSet),
rename_apart_inst_vars(InstVarSet, ProcInstVarSet,
ProcArgModes0, ProcArgModes),
- mode_list_get_initial_insts(ProcArgModes, ModuleInfo,
- InitialInsts),
+ mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts),
modecheck_var_has_inst_list(ArgVars0, InitialInsts,
NeedExactMatch, ArgOffset, InstVarSub, !ModeInfo),
modecheck_end_of_call(ProcInfo, Purity, ProcArgModes, ArgVars0,
ArgOffset, InstVarSub, ArgVars, ExtraGoals, !ModeInfo)
;
- % set the current error list to empty (and
- % save the old one in `OldErrors'). This is so the
- % test for `Errors = []' in find_matching_modes
- % will work.
+ % Set the current error list to empty (and save the old one in
+ % `OldErrors'). This is so the test for `Errors = []' in
+ % find_matching_modes will work.
mode_info_get_errors(!.ModeInfo, OldErrors),
mode_info_set_errors([], !ModeInfo),
set__init(WaitingVars0),
modecheck_find_matching_modes(ProcIds, PredId, Procs, ArgVars0,
- [], RevMatchingProcIds, WaitingVars0, WaitingVars1,
- !ModeInfo),
+ [], RevMatchingProcIds, WaitingVars0, WaitingVars1, !ModeInfo),
( RevMatchingProcIds = [],
no_matching_modes(PredId, ArgVars0, DeterminismKnown,
@@ -194,9 +185,8 @@
;
RevMatchingProcIds = [_|_],
list__reverse(RevMatchingProcIds, MatchingProcIds),
- choose_best_match(!.ModeInfo, MatchingProcIds,
- PredId, Procs, ArgVars0, TheProcId, InstVarSub,
- ProcArgModes),
+ choose_best_match(!.ModeInfo, MatchingProcIds, PredId, Procs,
+ ArgVars0, TheProcId, InstVarSub, ProcArgModes),
map__lookup(Procs, TheProcId, ProcInfo),
CalleeModeErrors = ProcInfo ^ mode_errors,
( CalleeModeErrors = [_|_] ->
@@ -205,23 +195,19 @@
WaitingVars = set__list_to_set(ArgVars),
ExtraGoals = no_extra_goals,
mode_info_get_instmap(!.ModeInfo, InstMap),
- instmap__lookup_vars(ArgVars, InstMap,
- ArgInsts),
+ instmap__lookup_vars(ArgVars, InstMap, ArgInsts),
mode_info_set_call_arg_context(0, !ModeInfo),
mode_info_error(WaitingVars,
- mode_error_in_callee(ArgVars, ArgInsts,
- PredId, TheProcId,
+ mode_error_in_callee(ArgVars, ArgInsts, PredId, TheProcId,
CalleeModeErrors),
!ModeInfo)
;
- modecheck_end_of_call(ProcInfo, Purity,
- ProcArgModes, ArgVars0, ArgOffset,
- InstVarSub, ArgVars, ExtraGoals,
- !ModeInfo)
+ modecheck_end_of_call(ProcInfo, Purity, ProcArgModes, ArgVars0,
+ ArgOffset, InstVarSub, ArgVars, ExtraGoals, !ModeInfo)
)
),
- % restore the error list, appending any new error(s)
+ % Restore the error list, appending any new error(s).
mode_info_get_errors(!.ModeInfo, NewErrors),
list__append(OldErrors, NewErrors, Errors),
mode_info_set_errors(Errors, !ModeInfo)
@@ -249,8 +235,7 @@
GroundInstInfo = none,
mode_info_get_var_types(!.ModeInfo, VarTypes),
map__lookup(VarTypes, PredVar, Type),
- type_is_higher_order(Type, _Purity, function, _,
- ArgTypes),
+ type_is_higher_order(Type, _Purity, function, _, ArgTypes),
PredInstInfo = pred_inst_info_standard_func_mode(
list__length(ArgTypes))
),
@@ -274,8 +259,8 @@
mode_info_set_call_arg_context(1, !ModeInfo),
set__singleton_set(WaitingVars, PredVar),
mode_info_error(WaitingVars,
- mode_error_higher_order_pred_var(
- PredOrFunc, PredVar, PredVarInst, Arity),
+ mode_error_higher_order_pred_var(PredOrFunc, PredVar, PredVarInst,
+ Arity),
!ModeInfo),
Modes = [],
Det = erroneous,
@@ -302,8 +287,7 @@
Det = det,
% These should always be mode correct.
ArgOffset = 0,
- modecheck_arg_list(ArgOffset, Modes, ExtraGoals, Args0, Args,
- !ModeInfo).
+ modecheck_arg_list(ArgOffset, Modes, ExtraGoals, Args0, Args, !ModeInfo).
%-----------------------------------------------------------------------------%
@@ -312,13 +296,12 @@
is det.
modecheck_arg_list(ArgOffset, Modes, ExtraGoals, Args0, Args, !ModeInfo) :-
-
%
% Check that `Args0' have livenesses which match the
% expected livenesses.
%
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
- get_arg_lives(Modes, ModuleInfo0, ExpectedArgLives),
+ get_arg_lives(ModuleInfo0, Modes, ExpectedArgLives),
NeedExactMatch = no,
modecheck_var_list_is_live(Args0, ExpectedArgLives, NeedExactMatch,
ArgOffset, !ModeInfo),
@@ -328,10 +311,10 @@
% initial insts, and set their new final insts (introducing
% extra unifications for implied modes, if necessary).
%
- mode_list_get_initial_insts(Modes, ModuleInfo0, InitialInsts),
+ mode_list_get_initial_insts(ModuleInfo0, Modes, InitialInsts),
modecheck_var_has_inst_list(Args0, InitialInsts, NeedExactMatch,
ArgOffset, InstVarSub, !ModeInfo),
- mode_list_get_final_insts(Modes, ModuleInfo0, FinalInsts0),
+ mode_list_get_final_insts(ModuleInfo0, Modes, FinalInsts0),
inst_list_apply_substitution(FinalInsts0, InstVarSub, FinalInsts),
modecheck_set_var_inst_list(Args0, InitialInsts, FinalInsts,
ArgOffset, Args, ExtraGoals, !ModeInfo).
@@ -368,8 +351,7 @@
instmap__lookup_vars(ArgVars, InstMap, ArgInsts),
mode_info_set_call_arg_context(0, !ModeInfo),
mode_info_error(WaitingVars,
- mode_error_no_matching_mode(ArgVars, ArgInsts),
- !ModeInfo)
+ mode_error_no_matching_mode(ArgVars, ArgInsts), !ModeInfo)
).
:- type proc_mode ---> proc_mode(proc_id, inst_var_sub, list(mode)).
@@ -384,8 +366,8 @@
modecheck_find_matching_modes([ProcId | ProcIds], PredId, Procs, ArgVars0,
!MatchingProcIds, !WaitingVars, !ModeInfo) :-
- % find the initial insts and the final livenesses
- % of the arguments for this mode of the called pred
+ % Find the initial insts and the final livenesses of the arguments
+ % for this mode of the called pred.
map__lookup(Procs, ProcId, ProcInfo),
proc_info_argmodes(ProcInfo, ProcArgModes0),
proc_info_inst_varset(ProcInfo, ProcInstVarSet),
@@ -395,16 +377,14 @@
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
proc_info_arglives(ProcInfo, ModuleInfo, ProcArgLives0),
- % check whether the livenesses of the args matches their
- % expected liveness
+ % Check whether the livenesses of the args matches their expected liveness.
NeedLivenessExactMatch = no,
modecheck_var_list_is_live(ArgVars0, ProcArgLives0,
NeedLivenessExactMatch, 0, !ModeInfo),
- % If we're doing mode inference for the called
- % procedure, and the called procedure has been inferred as
- % an invalid mode, then don't use it unless it is an exact
- % match.
+ % If we're doing mode inference for the called procedure, and the
+ % called procedure has been inferred as an invalid mode, then
+ % don't use it unless it is an exact match.
%
% XXX Do we really want mode inference to use implied modes?
% Would it be better to always require an exact match when
@@ -416,15 +396,13 @@
NeedExactMatch = yes
),
- % Check whether the insts of the args matches their expected
- % initial insts.
- mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts),
+ % Check whether the insts of the args matches their expected initial insts.
+ mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts),
modecheck_var_has_inst_list(ArgVars0, InitialInsts, NeedExactMatch, 0,
InstVarSub, !ModeInfo),
- % If we got an error, reset the error list
- % and save the list of vars to wait on.
- % Otherwise, insert the proc_id in the list of matching
+ % If we got an error, reset the error list and save the list of vars
+ % to wait on. Otherwise, insert the proc_id in the list of matching
% proc_ids.
mode_info_get_errors(!.ModeInfo, Errors),
(
@@ -438,7 +416,7 @@
!:MatchingProcIds = [NewMatch | !.MatchingProcIds]
),
- % keep trying with the other modes for the called pred
+ % Keep trying with the other modes for the called pred.
modecheck_find_matching_modes(ProcIds, PredId, Procs, ArgVars0,
!MatchingProcIds, !WaitingVars, !ModeInfo).
@@ -451,10 +429,8 @@
mode_info_get_may_initialise_solver_vars(MayInitSolverVars,
!.ModeInfo),
- % Since we can't reschedule impure goals, we must allow
- % the initialisation of free solver type args if
- % necessary in impure calls.
- %
+ % Since we can't reschedule impure goals, we must allow the initialisation
+ % of free solver type args if necessary in impure calls.
( Purity = (impure) ->
mode_info_set_may_initialise_solver_vars(yes, !ModeInfo)
;
@@ -462,18 +438,19 @@
),
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
- mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts0),
+ mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts0),
inst_list_apply_substitution(InitialInsts0, InstVarSub, InitialInsts),
- mode_list_get_final_insts(ProcArgModes, ModuleInfo, FinalInsts0),
+ mode_list_get_final_insts(ModuleInfo, ProcArgModes, FinalInsts0),
inst_list_apply_substitution(FinalInsts0, InstVarSub, FinalInsts),
modecheck_set_var_inst_list(ArgVars0, InitialInsts, FinalInsts,
ArgOffset, ArgVars, ExtraGoals, !ModeInfo),
proc_info_never_succeeds(ProcInfo, NeverSucceeds),
- ( NeverSucceeds = yes ->
+ (
+ NeverSucceeds = yes,
instmap__init_unreachable(Instmap),
mode_info_set_instmap(Instmap, !ModeInfo)
;
- true
+ NeverSucceeds = no
),
mode_info_set_may_initialise_solver_vars(MayInitSolverVars, !ModeInfo).
@@ -486,7 +463,7 @@
% version of the call pattern (i.e. the insts of the arg vars).
% The final insts are initially just assumed to be all `not_reached'.
% The determinism for this mode will be inferred.
-
+ %
insert_new_mode(PredId, ArgVars, MaybeDet, ProcId, !ModeInfo) :-
% figure out the values of all the variables we need to
% create a new mode for this predicate
@@ -500,10 +477,9 @@
inst_lists_to_mode_list(InitialInsts, FinalInsts, Modes),
mode_info_get_instvarset(!.ModeInfo, InstVarSet),
- %
- % call unify_proc__request_proc, which will
- % create the new procedure, set its "can-process" flag to `no',
- % and insert it into the queue of requested procedures.
+ % Call unify_proc__request_proc, which will create the new procedure,
+ % set its "can-process" flag to `no', and insert it into the queue
+ % of requested procedures.
%
unify_proc__request_proc(PredId, Modes, InstVarSet, yes(ArgLives),
MaybeDet, Context, ProcId, ModuleInfo0, ModuleInfo),
@@ -526,18 +502,19 @@
mode_info_get_var_types(ModeInfo, VarTypes),
instmap__lookup_var(InstMap, Var, Inst0),
map__lookup(VarTypes, Var, Type),
- normalise_inst(Inst0, Type, ModuleInfo, Inst),
+ normalise_inst(ModuleInfo, Type, Inst0, Inst),
mode_info_var_is_live(ModeInfo, Var, IsLive0),
-
- ( IsLive0 = live ->
+ (
+ IsLive0 = live,
IsLive = live
;
- % To reduce the potentially exponential explosion in the
- % number of modes, we only set IsLive to `dead' - meaning
- % that the procedure requires its argument to be dead, so
- % that it can do destructive update - if there really is
- % a good chance of being able to do destructive update.
+ IsLive0 = dead,
+ % To reduce the potentially exponential explosion in the number of
+ % modes, we only set IsLive to `dead' - meaning that the procedure
+ % requires its argument to be dead, so that it can do destructive
+ % update - if there really is a good chance of being able to do
+ % destructive update.
(
inst_is_ground(ModuleInfo, Inst),
inst_is_mostly_unique(ModuleInfo, Inst)
@@ -552,7 +529,6 @@
%-----------------------------------------------------------------------------%
- %
% Given two modes of a predicate, figure out whether
% they are indistinguishable; that is, whether any valid call to
% one mode would also be a valid call to the other.
@@ -573,8 +549,8 @@
%
proc_info_argmodes(ProcInfo, ProcArgModes),
proc_info_argmodes(OtherProcInfo, OtherProcArgModes),
- mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts),
- mode_list_get_initial_insts(OtherProcArgModes, ModuleInfo,
+ mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts),
+ mode_list_get_initial_insts(ModuleInfo, OtherProcArgModes,
OtherInitialInsts),
pred_info_arg_types(PredInfo, ArgTypes),
compare_inst_list(ModuleInfo, InitialInsts, OtherInitialInsts, no,
@@ -584,8 +560,8 @@
%
% Compare the expected livenesses of the arguments
%
- get_arg_lives(ProcArgModes, ModuleInfo, ProcArgLives),
- get_arg_lives(OtherProcArgModes, ModuleInfo, OtherProcArgLives),
+ get_arg_lives(ModuleInfo, ProcArgModes, ProcArgLives),
+ get_arg_lives(ModuleInfo, OtherProcArgModes, OtherProcArgLives),
compare_liveness_list(ProcArgLives, OtherProcArgLives, CompareLives),
CompareLives = same,
@@ -604,7 +580,6 @@
%-----------------------------------------------------------------------------%
- %
% Given two modes of a predicate, figure out whether
% they are identical, except that one is cc_nondet/cc_multi
% and the other is nondet/multi.
@@ -622,8 +597,8 @@
%
proc_info_argmodes(ProcInfo, ProcArgModes),
proc_info_argmodes(OtherProcInfo, OtherProcArgModes),
- mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts),
- mode_list_get_initial_insts(OtherProcArgModes, ModuleInfo,
+ mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts),
+ mode_list_get_initial_insts(ModuleInfo, OtherProcArgModes,
OtherInitialInsts),
pred_info_arg_types(PredInfo, ArgTypes),
compare_inst_list(ModuleInfo, InitialInsts, OtherInitialInsts, no,
@@ -633,8 +608,8 @@
%
% Compare the final insts of the arguments
%
- mode_list_get_final_insts(ProcArgModes, ModuleInfo, FinalInsts),
- mode_list_get_final_insts(OtherProcArgModes, ModuleInfo,
+ mode_list_get_final_insts(ModuleInfo, ProcArgModes, FinalInsts),
+ mode_list_get_final_insts(ModuleInfo, OtherProcArgModes,
OtherFinalInsts),
compare_inst_list(ModuleInfo, FinalInsts, OtherFinalInsts, no,
ArgTypes, CompareFinalInsts),
@@ -643,8 +618,8 @@
%
% Compare the expected livenesses of the arguments
%
- get_arg_lives(ProcArgModes, ModuleInfo, ProcArgLives),
- get_arg_lives(OtherProcArgModes, ModuleInfo, OtherProcArgLives),
+ get_arg_lives(ModuleInfo, ProcArgModes, ProcArgLives),
+ get_arg_lives(ModuleInfo, OtherProcArgModes, OtherProcArgLives),
compare_liveness_list(ProcArgLives, OtherProcArgLives, CompareLives),
CompareLives = same,
@@ -714,8 +689,7 @@
(
\+ (
list__member(proc_mode(OtherProcId, _, _), ProcIds),
- compare_proc(ModeInfo, OtherProcId, ProcId, ArgVars,
- Procs, better)
+ compare_proc(ModeInfo, OtherProcId, ProcId, ArgVars, Procs, better)
)
->
TheProcId = ProcId,
@@ -726,10 +700,8 @@
TheProcId, TheInstVarSub, TheArgModes)
).
- %
- % Given two modes of a predicate, figure out whether
- % one of them is a better match than the other,
- % for calls which could match either mode.
+ % Given two modes of a predicate, figure out whether one of them is a
+ % better match than the other, for calls which could match either mode.
%
% The code for this is similar to the code for
% modes_are_indistinguishable/4 and
@@ -749,8 +721,8 @@
mode_info_get_module_info(ModeInfo, ModuleInfo),
mode_info_get_var_types(ModeInfo, VarTypes),
list__map(map__lookup(VarTypes), ArgVars, ArgTypes),
- mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts),
- mode_list_get_initial_insts(OtherProcArgModes, ModuleInfo,
+ mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts),
+ mode_list_get_initial_insts(ModuleInfo, OtherProcArgModes,
OtherInitialInsts),
get_var_insts_and_lives(ArgVars, ModeInfo, ArgInitialInsts, _ArgLives),
compare_inst_list(ModuleInfo, InitialInsts, OtherInitialInsts,
@@ -758,8 +730,8 @@
%
% Compare the expected livenesses of the arguments
%
- get_arg_lives(ProcArgModes, ModuleInfo, ProcArgLives),
- get_arg_lives(OtherProcArgModes, ModuleInfo, OtherProcArgLives),
+ get_arg_lives(ModuleInfo, ProcArgModes, ProcArgLives),
+ get_arg_lives(ModuleInfo, OtherProcArgModes, OtherProcArgLives),
compare_liveness_list(ProcArgLives, OtherProcArgLives, CompareLives),
%
% Compare the determinisms
@@ -820,11 +792,9 @@
compare_liveness_list(LiveAs, LiveBs, Result1),
combine_results(Result0, Result1, Result).
- %
- % compare_liveness -- prefer dead to live
- % (if either is a valid match, then the actual argument
- % must be dead, so prefer the mode which can take advantage
- % of that).
+ % Compare_liveness -- prefer dead to live. If either is a valid match,
+ % then the actual argument must be dead, so prefer the mode which can take
+ % advantage of that).
%
:- pred compare_liveness(is_live::in, is_live::in, match::out) is det.
@@ -833,8 +803,7 @@
compare_liveness(live, dead, worse).
compare_liveness(live, live, same).
- %
- % combine two results, giving priority to the first one
+ % Combine two results, giving priority to the first one.
%
:- pred prioritized_combine_results(match::in, match::in, match::out) is det.
@@ -843,8 +812,7 @@
prioritized_combine_results(same, Result, Result).
prioritized_combine_results(incomparable, _, incomparable).
- %
- % combine two results, giving them equal priority
+ % Combine two results, giving them equal priority.
%
:- pred combine_results(match::in, match::in, match::out) is det.
@@ -859,9 +827,7 @@
combine_results(same, Result, Result).
combine_results(incomparable, _, incomparable).
- %
- % Compare two initial insts, to figure out which would be a better
- % match.
+ % Compare two initial insts, to figure out which would be a better match.
%
% More information is better:
% prefer bound(f) to ground
@@ -875,7 +841,7 @@
% prefer ground to free (i.e. prefer in to out)
% prefer ground to any (e.g. prefer in to in(any))
% prefer any to free (e.g. prefer any->ground to out)
-
+ %
:- pred compare_inst(module_info::in, (inst)::in, (inst)::in, maybe(inst)::in,
(type)::in, match::out) is det.
@@ -935,9 +901,8 @@
),
( Result0 = same ->
%
- % if the actual arg inst is not available,
- % or comparing with the arg inst doesn't help,
- % then compare the two proc insts
+ % If the actual arg inst is not available, or comparing with
+ % the arg inst doesn't help, then compare the two proc insts.
%
(
inst_matches_initial_no_implied_modes(InstA,
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.83
diff -u -b -r1.83 modecheck_unify.m
--- compiler/modecheck_unify.m 16 Aug 2005 10:42:37 -0000 1.83
+++ compiler/modecheck_unify.m 22 Aug 2005 15:28:55 -0000
@@ -274,13 +274,13 @@
( HowToCheckGoal = check_modes ->
% This only needs to be done once.
mode_info_get_types_of_vars(!.ModeInfo, Vars, VarTypes),
- propagate_types_into_mode_list(VarTypes, ModuleInfo0, Modes0, Modes)
+ propagate_types_into_mode_list(ModuleInfo0, VarTypes, Modes0, Modes)
;
Modes = Modes0
),
% Initialize the initial insts of the lambda variables.
- mode_list_get_initial_insts(Modes, ModuleInfo0, VarInitialInsts),
+ mode_list_get_initial_insts(ModuleInfo0, Modes, VarInitialInsts),
assoc_list__from_corresponding_lists(Vars, VarInitialInsts, VarInstAL),
instmap_delta_from_assoc_list(VarInstAL, VarInstMapDelta),
mode_info_get_instmap(!.ModeInfo, InstMap0),
@@ -288,7 +288,7 @@
mode_info_set_instmap(InstMap1, !ModeInfo),
% Mark the non-clobbered lambda variables as live.
- get_arg_lives(Modes, ModuleInfo0, ArgLives),
+ get_arg_lives(ModuleInfo0, Modes, ArgLives),
get_live_vars(Vars, ArgLives, LiveVarsList),
set__list_to_set(LiveVarsList, LiveVars),
mode_info_add_live_vars(LiveVars, !ModeInfo),
@@ -346,7 +346,7 @@
;
modecheck_goal(Goal0, Goal1, !ModeInfo, !IO)
),
- mode_list_get_final_insts(Modes, ModuleInfo0, FinalInsts),
+ mode_list_get_final_insts(ModuleInfo0, Modes, FinalInsts),
modecheck_lambda_final_insts(Vars, FinalInsts, Goal1, Goal, !ModeInfo),
mode_checkpoint(exit, "lambda goal", !ModeInfo, !IO),
@@ -377,7 +377,8 @@
mode_info_error(WaitingVars,
mode_error_non_local_lambda_var(BadVar, BadInst), !ModeInfo)
;
- error("modecheck_unification(lambda): very strange var")
+ unexpected(this_file,
+ "modecheck_unification(lambda): very strange var")
),
% Return any old garbage.
RHS = lambda_goal(Purity, PredOrFunc, EvalMethod, modes_are_ok,
@@ -507,7 +508,6 @@
mode_info_var_list_is_live(!.ModeInfo, ArgVars0, LiveArgs),
InstOfY = bound(unique, [functor(InstConsId, InstArgs)]),
(
-
% The occur check: X = f(X) is considered a mode error unless X is
% ground. (Actually it wouldn't be that hard to generate code for it
% - it always fails! - but it's most likely to be a programming error,
@@ -531,12 +531,8 @@
Mode = ModeOfX - ModeOfY,
modecheck_set_var_inst(X, Inst, no, !ModeInfo),
NoArgInsts = list__duplicate(length(ArgVars0), no),
- ( bind_args(Inst, ArgVars0, NoArgInsts, !ModeInfo) ->
- true
- ;
- error("bind_args failed")
- ),
- % return any old garbage
+ bind_args(Inst, ArgVars0, NoArgInsts, !ModeInfo),
+ % Return any old garbage.
Unification = Unification0,
ArgVars = ArgVars0,
ExtraGoals2 = no_extra_goals
@@ -569,20 +565,19 @@
( get_mode_of_args(Inst, InstArgs, ModeArgs0) ->
ModeArgs = ModeArgs0
;
- error("get_mode_of_args failed")
+ unexpected(this_file, "get_mode_of_args failed")
),
(
inst_expand_and_remove_constrained_inst_vars(ModuleInfo1,
InstOfX, InstOfX1),
list__length(ArgVars0, Arity),
- get_arg_insts(InstOfX1, InstConsId, Arity,
- InstOfXArgs0),
+ get_arg_insts(InstOfX1, InstConsId, Arity, InstOfXArgs0),
get_mode_of_args(Inst, InstOfXArgs0, ModeOfXArgs0)
->
ModeOfXArgs = ModeOfXArgs0,
InstOfXArgs = InstOfXArgs0
;
- error("get_(inst/mode)_of_args failed")
+ unexpected(this_file, "get_(inst/mode)_of_args failed")
),
categorize_unify_var_functor(ModeOfX, ModeOfXArgs, ModeArgs,
X, ConsId, ArgVars0, VarTypes, UnifyContext,
@@ -591,13 +586,7 @@
ArgVars0, ArgVars, ExtraGoals2, !ModeInfo),
modecheck_set_var_inst(X, Inst, yes(InstOfY), !ModeInfo),
UnifyArgInsts = list__map(func(I) = yes(I), InstOfXArgs),
- (
bind_args(Inst, ArgVars, UnifyArgInsts, !ModeInfo)
- ->
- true
- ;
- error("bind_args failed")
- )
;
set__list_to_set([X | ArgVars0], WaitingVars), % conservative
mode_info_error(WaitingVars,
@@ -614,11 +603,7 @@
Mode = ModeOfX - ModeOfY,
modecheck_set_var_inst(X, Inst, no, !ModeInfo),
NoArgInsts = list__duplicate(length(ArgVars0), no),
- ( bind_args(Inst, ArgVars0, NoArgInsts, !ModeInfo) ->
- true
- ;
- error("bind_args failed")
- ),
+ bind_args(Inst, ArgVars0, NoArgInsts, !ModeInfo),
% Return any old garbage.
Unification = Unification0,
ArgVars = ArgVars0,
@@ -626,9 +611,8 @@
),
%
- % Optimize away construction of unused terms by
- % replacing the unification with `true'. Optimize
- % away unifications which always fail by replacing
+ % Optimize away construction of unused terms by replacing the unification
+ % with `true'. Optimize % away unifications which always fail by replacing
% them with `fail'.
%
(
@@ -645,7 +629,19 @@
%
% Unifying two preds is not erroneous as far as the mode checker
% is concerned, but a mode _error_.
- Goal = disj([])
+ Goal = disj([]),
+ InitMayHaveSubtype = init_instmap_may_have_subtype(!.ModeInfo),
+ (
+ InitMayHaveSubtype = yes
+ % Suppress the warning, since the unification may succeed
+ % in another mode in which the initial inst of X,
+ % or of another head variable that is unified with it,
+ % is not so constrained.
+ ;
+ InitMayHaveSubtype = no,
+ Warning = cannot_succeed_var_functor(X, InstOfX, ConsId),
+ mode_info_warning(Warning, !ModeInfo)
+ )
;
Functor = functor(ConsId, IsExistConstruction, ArgVars),
Unify = unify(X, Functor, Mode, Unification, UnifyContext),
@@ -681,11 +677,13 @@
all_arg_vars_are_non_free_or_solver_vars([], [], _, _, []).
all_arg_vars_are_non_free_or_solver_vars([], [_|_], _, _, _) :-
- error("modecheck_unify.all_arg_vars_are_non_free_or_solver_vars: " ++
+ unexpected(this_file,
+ "modecheck_unify.all_arg_vars_are_non_free_or_solver_vars: " ++
"mismatch in list lengths").
all_arg_vars_are_non_free_or_solver_vars([_|_], [], _, _, _) :-
- error("modecheck_unify.all_arg_vars_are_non_free_or_solver_vars: " ++
+ unexpected(this_file,
+ "modecheck_unify.all_arg_vars_are_non_free_or_solver_vars: " ++
"mismatch in list lengths").
all_arg_vars_are_non_free_or_solver_vars([Arg | Args], [Inst | Insts],
@@ -855,9 +853,9 @@
mode_is_unused(ModuleInfo0, ModeOfX),
mode_is_unused(ModuleInfo0, ModeOfY)
->
- % For free-free unifications, we pretend for a moment that they
- % are an assignment to the dead variable - they will then.
- % be optimized away.
+ % For free-free unifications, we pretend for a moment that they are
+ % an assignment to the dead variable - they will then be optimized
+ % away.
( LiveX = dead ->
Unification = assign(X, Y)
; LiveY = dead ->
@@ -920,7 +918,21 @@
%
% Unifying two preds is not erroneous as far as the
% mode checker is concerned, but a mode _error_.
- Unify = disj([])
+ Unify = disj([]),
+ InitMayHaveSubtype = init_instmap_may_have_subtype(!.ModeInfo),
+ (
+ InitMayHaveSubtype = yes
+ % Suppress the warning, since the unification may succeed
+ % in another mode in which the initial inst of X or Y,
+ % or of another head variable that is unified with one of them,
+ % is not so constrained.
+ ;
+ InitMayHaveSubtype = no,
+ mode_get_insts(ModuleInfo0, ModeOfX, InstOfX, _),
+ mode_get_insts(ModuleInfo0, ModeOfY, InstOfY, _),
+ Warning = cannot_succeed_var_var(X, Y, InstOfX, InstOfY),
+ mode_info_warning(Warning, !ModeInfo)
+ )
;
Unify = unify(X, var(Y), ModeOfX - ModeOfY, Unification, UnifyContext)
).
@@ -1061,7 +1073,7 @@
ConsId = cons(unqualified("__LambdaGoal__"), Arity)
),
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
- mode_util__modes_to_uni_modes(ArgModes0, ArgModes0, ModuleInfo, ArgModes),
+ mode_util__modes_to_uni_modes(ModuleInfo, ArgModes0, ArgModes0, ArgModes),
mode_info_get_instmap(!.ModeInfo, InstMap),
( mode_is_output(ModuleInfo, ModeOfX) ->
(
@@ -1144,8 +1156,8 @@
MaybeSize = no,
ConsId = NewConsId
),
- mode_util__modes_to_uni_modes(ModeOfXArgs, ArgModes0,
- ModuleInfo, ArgModes),
+ mode_util__modes_to_uni_modes(ModuleInfo, ModeOfXArgs,
+ ArgModes0, ArgModes),
( mode_is_output(ModuleInfo, ModeOfX) ->
% It's a construction.
Unification = construct(X, ConsId, ArgVars, ArgModes,
@@ -1229,14 +1241,24 @@
%-----------------------------------------------------------------------------%
:- pred bind_args((inst)::in, list(prog_var)::in, list(maybe(inst))::in,
+ mode_info::in, mode_info::out) is det.
+
+bind_args(Inst, Args, UnifyArgInsts, !ModeInfo) :-
+ ( try_bind_args(Inst, Args, UnifyArgInsts, !ModeInfo) ->
+ true
+ ;
+ unexpected(this_file, "bind_args: try_bind_args failed")
+ ).
+
+:- pred try_bind_args((inst)::in, list(prog_var)::in, list(maybe(inst))::in,
mode_info::in, mode_info::out) is semidet.
-bind_args(not_reached, _, _, !ModeInfo) :-
+try_bind_args(not_reached, _, _, !ModeInfo) :-
instmap__init_unreachable(InstMap),
mode_info_set_instmap(InstMap, !ModeInfo).
-bind_args(ground(Uniq, none), Args, UnifyArgInsts, !ModeInfo) :-
+try_bind_args(ground(Uniq, none), Args, UnifyArgInsts, !ModeInfo) :-
ground_args(Uniq, Args, UnifyArgInsts, !ModeInfo).
-bind_args(bound(_Uniq, List), Args, UnifyArgInsts, !ModeInfo) :-
+try_bind_args(bound(_Uniq, List), Args, UnifyArgInsts, !ModeInfo) :-
(
List = [],
% The code is unreachable.
@@ -1245,27 +1267,27 @@
;
List = [_ | _],
List = [functor(_, InstList)],
- bind_args_2(Args, InstList, UnifyArgInsts, !ModeInfo)
+ try_bind_args_2(Args, InstList, UnifyArgInsts, !ModeInfo)
).
-bind_args(constrained_inst_vars(_, Inst), Args, UnifyArgInsts, !ModeInfo) :-
- bind_args(Inst, Args, UnifyArgInsts, !ModeInfo).
+try_bind_args(constrained_inst_vars(_, Inst), Args, UnifyArgInsts,
+ !ModeInfo) :-
+ try_bind_args(Inst, Args, UnifyArgInsts, !ModeInfo).
-:- pred bind_args_2(list(prog_var)::in, list(inst)::in, list(maybe(inst))::in,
- mode_info::in, mode_info::out) is semidet.
+:- pred try_bind_args_2(list(prog_var)::in, list(inst)::in,
+ list(maybe(inst))::in, mode_info::in, mode_info::out) is semidet.
-bind_args_2([], [], [], !ModeInfo).
-bind_args_2([Arg | Args], [Inst | Insts], [UnifyArgInst | UnifyArgInsts],
+try_bind_args_2([], [], [], !ModeInfo).
+try_bind_args_2([Arg | Args], [Inst | Insts], [UnifyArgInst | UnifyArgInsts],
!ModeInfo) :-
modecheck_set_var_inst(Arg, Inst, UnifyArgInst, !ModeInfo),
- bind_args_2(Args, Insts, UnifyArgInsts, !ModeInfo).
+ try_bind_args_2(Args, Insts, UnifyArgInsts, !ModeInfo).
:- pred ground_args(uniqueness::in, list(prog_var)::in, list(maybe(inst))::in,
mode_info::in, mode_info::out) is semidet.
ground_args(_Uniq, [], [], !ModeInfo).
ground_args(Uniq, [Arg | Args], [UnifyArgInst | UnifyArgInsts], !ModeInfo) :-
- modecheck_set_var_inst(Arg, ground(Uniq, none), UnifyArgInst,
- !ModeInfo),
+ modecheck_set_var_inst(Arg, ground(Uniq, none), UnifyArgInst, !ModeInfo),
ground_args(Uniq, Args, UnifyArgInsts, !ModeInfo).
%-----------------------------------------------------------------------------%
@@ -1312,6 +1334,19 @@
mode_set_args([Inst | Insts], FinalInst, [Mode | Modes]) :-
Mode = (Inst -> FinalInst),
mode_set_args(Insts, FinalInst, Modes).
+
+%-----------------------------------------------------------------------------%
+
+:- func init_instmap_may_have_subtype(mode_info) = bool.
+
+init_instmap_may_have_subtype(ModeInfo) = MayHaveSubtype :-
+ mode_info_get_initial_instmap(ModeInfo, InitialInstMap),
+ instmap__to_assoc_list(InitialInstMap, InitVarsInsts),
+ assoc_list__values(InitVarsInsts, InitInsts),
+ mode_info_get_module_info(ModeInfo, ModuleInfo),
+ MayRestrictList =
+ list__map(inst_may_restrict_cons_ids(ModuleInfo), InitInsts),
+ bool__or_list(MayRestrictList, MayHaveSubtype).
%-----------------------------------------------------------------------------%
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.307
diff -u -b -r1.307 modes.m
--- compiler/modes.m 18 Aug 2005 07:57:51 -0000 1.307
+++ compiler/modes.m 22 Aug 2005 15:29:13 -0000
@@ -768,9 +768,8 @@
proc_info_arglives(!.ProcInfo, !.ModuleInfo, ArgLives0),
proc_info_goal(!.ProcInfo, Body0),
- % We use the context of the first clause, unless
- % there weren't any clauses at all, in which case
- % we use the context of the mode declaration.
+ % We use the context of the first clause, unless there weren't any clauses
+ % at all, in which case we use the context of the mode declaration.
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
pred_info_clauses_info(PredInfo, ClausesInfo),
clauses_info_clauses_only(ClausesInfo, ClauseList),
@@ -782,15 +781,13 @@
proc_info_context(!.ProcInfo, Context)
),
- %
% Modecheck the body. First set the initial instantiation of the head
% arguments, then modecheck the body, and then check that the final
% instantiation matches that in the mode declaration.
- %
some [!ModeInfo] (
% Construct the initial instmap.
- mode_list_get_initial_insts(ArgModes0, !.ModuleInfo, ArgInitialInsts),
+ mode_list_get_initial_insts(!.ModuleInfo, ArgModes0, ArgInitialInsts),
assoc_list__from_corresponding_lists(HeadVars, ArgInitialInsts,
InstAL),
instmap__from_assoc_list(InstAL, InstMap0),
@@ -811,7 +808,7 @@
;
InferModes = no
),
- mode_list_get_final_insts(ArgModes0, !.ModuleInfo, ArgFinalInsts0),
+ mode_list_get_final_insts(!.ModuleInfo, ArgModes0, ArgFinalInsts0),
(
InferModes = no,
@@ -923,21 +920,22 @@
(
InferModes = yes,
- % For inferred predicates, we don't report the
- % error(s) here; instead we just save them in the
- % proc_info, thus marking that procedure as invalid.
- % This is sometimes handy for debugging:
+ % For inferred predicates, we don't report the error(s) here;
+ % instead we just save them in the proc_info, thus marking that
+ % procedure as invalid. Uncommenting the next call is sometimes
+ % handy for debugging:
% report_mode_errors(!ModeInfo),
mode_info_get_errors(!.ModeInfo, ModeErrors),
!:ProcInfo = !.ProcInfo ^ mode_errors := ModeErrors,
NumErrors = 0
;
InferModes = no,
- % report any errors we found
+ % Report any errors we found.
report_mode_errors(!ModeInfo, !IO),
- mode_info_get_num_errors(!.ModeInfo, NumErrors)
+ mode_info_get_num_errors(!.ModeInfo, NumErrors),
+ report_mode_warnings(!ModeInfo, !IO)
),
- % save away the results
+ % Save away the results.
inst_lists_to_mode_list(ArgInitialInsts, ArgFinalInsts, ArgModes),
mode_info_get_changed_flag(!.ModeInfo, !:Changed),
mode_info_get_module_info(!.ModeInfo, !:ModuleInfo),
@@ -1094,7 +1092,7 @@
map__apply_to_list(HeadVars, VarTypes, ArgTypes),
(
InferModes = yes,
- normalise_insts(VarFinalInsts1, ArgTypes, ModuleInfo, VarFinalInsts2),
+ normalise_insts(ModuleInfo, ArgTypes, VarFinalInsts1, VarFinalInsts2),
%
% make sure we set the final insts of any variables which
% we assumed were dead to `clobbered'.
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.38
diff -u -b -r1.38 pd_util.m
--- compiler/pd_util.m 19 Aug 2005 08:35:57 -0000 1.38
+++ compiler/pd_util.m 22 Aug 2005 15:32:26 -0000
@@ -911,8 +911,8 @@
Uniq = unique,
inst_is_unique(ModuleInfo, bound(unique, List))
),
- \+ inst_contains_nonstandard_func_mode(bound(shared, List),
- ModuleInfo),
+ \+ inst_contains_nonstandard_func_mode(ModuleInfo,
+ bound(shared, List)),
Inst = ground(Uniq, none)
).
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.75
diff -u -b -r1.75 post_typecheck.m
--- compiler/post_typecheck.m 8 Aug 2005 02:33:10 -0000 1.75
+++ compiler/post_typecheck.m 22 Aug 2005 15:29:27 -0000
@@ -881,7 +881,7 @@
!ErrorProcs, !Procs) :-
map__lookup(!.Procs, ProcId, ProcInfo0),
proc_info_argmodes(ProcInfo0, ArgModes0),
- propagate_types_into_mode_list(ArgTypes, ModuleInfo,
+ propagate_types_into_mode_list(ModuleInfo, ArgTypes,
ArgModes0, ArgModes),
%
Index: compiler/stratify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stratify.m,v
retrieving revision 1.38
diff -u -b -r1.38 stratify.m
--- compiler/stratify.m 24 Mar 2005 05:34:15 -0000 1.38
+++ compiler/stratify.m 23 Aug 2005 00:49:38 -0000
@@ -282,7 +282,7 @@
globals__io_lookup_bool_option(warn_non_stratification, Warn, !IO),
Error = no,
(
- ( Error = yes ; Warn = yes ),
+ Warn = yes,
map__search(HOInfo, PredProcId, HigherOrderInfo)
->
HigherOrderInfo = info(HOCalls, _),
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.87
diff -u -b -r1.87 table_gen.m
--- compiler/table_gen.m 14 Aug 2005 03:20:41 -0000 1.87
+++ compiler/table_gen.m 23 Aug 2005 02:06:18 -0000
@@ -434,11 +434,8 @@
allocate_slot_numbers(InputVarModeMethods, 0, NumberedInputVars),
allocate_slot_numbers(OutputVarModeMethods, 0, NumberedOutputVars),
tabling_via_extra_args(!.ModuleInfo, TablingViaExtraArgs),
+ % The case EvalMethod = eval_normal was caught by the code above.
(
- EvalMethod = eval_normal,
- % This should have been caught by our caller.
- unexpected(this_file, "table_gen__transform_proc: eval_normal")
- ;
EvalMethod = eval_table_io(Decl, Unitize),
module_info_globals(!.ModuleInfo, Globals),
globals__lookup_bool_option(Globals, trace_table_io_states,
@@ -919,6 +916,8 @@
set__list_to_set([TableTipVar | HeadVars], InactiveNonLocals),
OutputVars = list__map(project_var, NumberedOutputVars),
InactiveInstmapDelta = bind_vars(OutputVars),
+
+ % The case CodeModel = model_non was caught by the code above.
(
CodeModel = model_det,
InactiveGoalExpr = conj([OrigGoal | SaveAnswerGoals]),
@@ -975,9 +974,6 @@
case(cons(qualified(TB, "memo_semi_succeeded"), 0), SucceededGoal),
case(cons(qualified(TB, "memo_semi_failed"), 0), FailedGoal)
]
- ;
- CodeModel = model_non,
- unexpected(this_file, "create_new_memo_goal: model_non")
),
SwitchExpr = switch(StatusVar, cannot_fail, SwitchArms),
Index: compiler/trace.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trace.m,v
retrieving revision 1.71
diff -u -b -r1.71 trace.m
--- compiler/trace.m 22 Mar 2005 06:40:28 -0000 1.71
+++ compiler/trace.m 22 Aug 2005 15:54:58 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1997-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -81,8 +83,8 @@
:- type trace_info.
-:- type trace_slot_info --->
- trace_slot_info(
+:- type trace_slot_info
+ ---> trace_slot_info(
slot_from_full :: maybe(int),
% If the procedure is shallow traced,
% this will be yes(N), where stack
@@ -130,11 +132,13 @@
% of the procedure (those partially clobbered may still be of interest,
% although to handle them properly we need to record insts in stack
% layouts), and those of dummy types.
+ %
:- pred trace__fail_vars(module_info::in, proc_info::in,
set(prog_var)::out) is det.
% Figure out whether we need a slot for storing the value of maxfr
% on entry, and record the result in the proc info.
+ %
:- pred trace__do_we_need_maxfr_slot(globals::in, pred_info::in, proc_info::in,
proc_info::out) is det.
@@ -144,54 +148,59 @@
% It is possible that one of these reserved slots contains a variable.
% If so, the variable and its slot number are returned in the last
% argument.
+ %
:- pred trace__reserved_slots(module_info::in, pred_info::in, proc_info::in,
globals::in, int::out, maybe(pair(prog_var, int))::out) is det.
% Construct and return an abstract struct that represents the
% tracing-specific part of the code generator state. Return also
% info about the non-fixed slots used by the tracing system,
- % for eventual use in the constructing the procedure's layout
- % structure.
+ % for eventual use in the constructing the procedure's layout structure.
+ %
:- pred trace__setup(module_info::in, pred_info::in, proc_info::in,
globals::in, trace_slot_info::out, trace_info::out,
code_info::in, code_info::out) is det.
% Generate code to fill in the reserved stack slots.
+ %
:- pred trace__generate_slot_fill_code(code_info::in, trace_info::in,
code_tree::out) is det.
- % If we are doing execution tracing, generate code to prepare for
- % a call.
+ % If we are doing execution tracing, generate code to prepare for a call.
+ %
:- pred trace__prepare_for_call(code_info::in, code_tree::out) is det.
% If we are doing execution tracing, generate code for an internal
- % trace event. This predicate must be called just before generating
- % code for the given goal.
+ % trace event. This predicate must be called just before generating code
+ % for the given goal.
+ %
:- pred trace__maybe_generate_internal_event_code(hlds_goal::in,
- hlds_goal_info::in, code_tree::out, code_info::in, code_info::out)
- is det.
+ hlds_goal_info::in, code_tree::out, code_info::in, code_info::out) is det.
% If we are doing execution tracing, generate code for an trace event
% that represents leaving a negated goal (via success or failure).
+ %
:- pred trace__maybe_generate_negated_event_code(hlds_goal::in,
hlds_goal_info::in, negation_end_port::in, code_tree::out,
code_info::in, code_info::out) is det.
% If we are doing execution tracing, generate code for a nondet
% pragma C code trace event.
+ %
:- pred trace__maybe_generate_pragma_event_code(nondet_pragma_trace_port::in,
- prog_context::in, code_tree::out, code_info::in, code_info::out)
- is det.
+ prog_context::in, code_tree::out, code_info::in, code_info::out) is det.
:- type external_event_info
---> external_event_info(
label, % The label associated with the
% external event.
+
map(tvar, set(layout_locn)),
% The map saying where the typeinfo
% variables needed to describe the
% types of the variables live at the
% event are.
+
code_tree % The code generated for the event.
).
@@ -200,6 +209,7 @@
% the trace liveness information and data on the type variables in the
% liveness information, since some of our callers also need this
% information.
+ %
:- pred trace__generate_external_event_code(external_trace_port::in,
trace_info::in, prog_context::in, maybe(external_event_info)::out,
code_info::in, code_info::out) is det.
@@ -208,6 +218,7 @@
% a temporary nondet stack frame whose redoip slot contains the
% address of one of the labels in the runtime that calls MR_trace
% for a redo event. Otherwise, generate empty code.
+ %
:- pred trace__maybe_setup_redo_event(trace_info::in, code_tree::out) is det.
%-----------------------------------------------------------------------------%
@@ -228,6 +239,7 @@
:- import_module ll_backend__layout_out.
:- import_module ll_backend__llds_out.
:- import_module mdbcomp__prim_data.
+:- import_module parse_tree__error_util.
:- import_module bool.
:- import_module int.
@@ -259,22 +271,21 @@
proc_info_argmodes(ProcInfo, Modes),
proc_info_arg_info(ProcInfo, ArgInfos),
proc_info_vartypes(ProcInfo, VarTypes),
- mode_list_get_final_insts(Modes, ModuleInfo, Insts),
+ mode_list_get_final_insts(ModuleInfo, Modes, Insts),
(
trace__build_fail_vars(HeadVars, Insts, ArgInfos,
ModuleInfo, VarTypes, FailVarsList)
->
set__list_to_set(FailVarsList, FailVars)
;
- error("length mismatch in trace__fail_vars")
+ unexpected(this_file, "length mismatch in trace__fail_vars")
).
trace__do_we_need_maxfr_slot(Globals, PredInfo0, !ProcInfo) :-
globals__get_trace_level(Globals, TraceLevel),
proc_info_interface_code_model(!.ProcInfo, CodeModel),
(
- eff_trace_level_is_none(PredInfo0, !.ProcInfo, TraceLevel)
- = no,
+ eff_trace_level_is_none(PredInfo0, !.ProcInfo, TraceLevel) = no,
CodeModel \= model_non,
proc_info_goal(!.ProcInfo, Goal),
code_util__goal_may_alloc_temp_frame(Goal)
@@ -391,15 +402,19 @@
;
FromFull = 0
),
- ( TraceTableIo = yes ->
+ (
+ TraceTableIo = yes,
IoSeq = 1
;
+ TraceTableIo = no,
IoSeq = 0
),
globals__lookup_bool_option(Globals, use_trail, UseTrail),
- ( UseTrail = yes ->
+ (
+ UseTrail = yes,
Trail = 2
;
+ UseTrail = no,
Trail = 0
),
proc_info_get_need_maxfr_slot(ProcInfo, NeedMaxfr),
@@ -410,13 +425,14 @@
NeedMaxfr = no,
Maxfr = 0
),
- ReservedSlots0 = Fixed + RedoLayout + FromFull + IoSeq
- + Trail + Maxfr,
+ ReservedSlots0 = Fixed + RedoLayout + FromFull + IoSeq + Trail + Maxfr,
proc_info_get_call_table_tip(ProcInfo, MaybeCallTableVar),
- ( MaybeCallTableVar = yes(CallTableVar) ->
+ (
+ MaybeCallTableVar = yes(CallTableVar),
ReservedSlots = ReservedSlots0 + 1,
MaybeTableVarInfo = yes(CallTableVar - ReservedSlots)
;
+ MaybeCallTableVar = no,
ReservedSlots = ReservedSlots0,
MaybeTableVarInfo = no
)
@@ -469,7 +485,9 @@
MaybeIoSeqLval = no,
NextSlotAfterIoSeq = NextSlotAfterFromFull
),
- ( globals__lookup_bool_option(Globals, use_trail, yes) ->
+ globals__lookup_bool_option(Globals, use_trail, UseTrail),
+ (
+ UseTrail = yes,
MaybeTrailSlot = yes(NextSlotAfterIoSeq),
TrailLval = llds__stack_slot_num_to_lval(CodeModel,
NextSlotAfterIoSeq),
@@ -478,6 +496,7 @@
MaybeTrailLvals = yes(TrailLval - TicketLval),
NextSlotAfterTrail = NextSlotAfterIoSeq + 2
;
+ UseTrail = no,
MaybeTrailSlot = no,
MaybeTrailLvals = no,
NextSlotAfterTrail = NextSlotAfterIoSeq
@@ -548,8 +567,7 @@
string__append_list([
FillSlotsUptoIoSeq,
"\t\t", RedoLayoutStr,
- " = (MR_Word) (const MR_Word *) &",
- LayoutAddrStr, ";\n"
+ " = (MR_Word) (const MR_Word *) &", LayoutAddrStr, ";\n"
], FillSlotsUptoRedo),
MaybeLayoutLabel = yes(RedoLayoutLabel)
;
@@ -608,9 +626,7 @@
(
MaybeCallTableLval = yes(CallTableLval),
trace__stackref_to_string(CallTableLval, CallTableLvalStr),
- string__append_list([
- "\t\t", CallTableLvalStr, " = 0;\n"
- ], TraceStmt3),
+ TraceStmt3 = "\t\t" ++ CallTableLvalStr ++ " = 0;\n",
TraceCode3 = node([
pragma_c([], [pragma_c_raw_code(TraceStmt3,
live_lvals_info(set__init))],
@@ -627,8 +643,7 @@
code_info__get_maybe_trace_info(CI, MaybeTraceInfo),
CodeModel = code_info__get_proc_model(CI),
(
- MaybeTraceInfo = yes(TraceInfo)
- ->
+ MaybeTraceInfo = yes(TraceInfo),
MaybeFromFullSlot = TraceInfo ^ from_full_lval,
trace__call_depth_slot(CodeModel, CallDepthLval),
trace__stackref_to_string(CallDepthLval, CallDepthStr),
@@ -639,20 +654,20 @@
MaybeFromFullSlot = no,
MacroStr = "MR_trace_reset_depth_from_full"
),
- string__append_list([
- MacroStr, "(", CallDepthStr, ");\n"
- ], ResetStmt),
+ ResetStmt = MacroStr ++ "(" ++ CallDepthStr ++ ");\n",
TraceCode = node([
c_code(ResetStmt, live_lvals_info(set__init))
- ""
])
;
+ MaybeTraceInfo = no,
TraceCode = empty
).
trace__maybe_generate_internal_event_code(Goal, OutsideGoalInfo, Code, !CI) :-
code_info__get_maybe_trace_info(!.CI, MaybeTraceInfo),
- ( MaybeTraceInfo = yes(TraceInfo) ->
+ (
+ MaybeTraceInfo = yes(TraceInfo),
Goal = _ - GoalInfo,
goal_info_get_goal_path(GoalInfo, Path),
(
@@ -679,7 +694,7 @@
->
Port = PortPrime
;
- error("trace__generate_internal_event_code: bad path")
+ unexpected(this_file, "generate_internal_event_code: bad path")
),
(
code_info__get_pred_info(!.CI, PredInfo),
@@ -690,21 +705,18 @@
->
goal_info_get_pre_deaths(GoalInfo, PreDeaths),
goal_info_get_context(GoalInfo, Context),
- (
- goal_info_has_feature(OutsideGoalInfo,
- hide_debug_event)
- ->
+ ( goal_info_has_feature(OutsideGoalInfo, hide_debug_event) ->
HideEvent = yes
;
HideEvent = no
),
- trace__generate_event_code(Port,
- internal(Path, PreDeaths), TraceInfo,
- Context, HideEvent, _, _, Code, !CI)
+ trace__generate_event_code(Port, internal(Path, PreDeaths),
+ TraceInfo, Context, HideEvent, _, _, Code, !CI)
;
Code = empty
)
;
+ MaybeTraceInfo = no,
Code = empty
).
@@ -891,13 +903,13 @@
trace__maybe_setup_redo_event(TraceInfo, Code) :-
TraceRedoLabel = TraceInfo ^ redo_label,
- ( TraceRedoLabel = yes(_) ->
+ (
+ TraceRedoLabel = yes(_),
MaybeFromFullSlot = TraceInfo ^ from_full_lval,
(
MaybeFromFullSlot = yes(Lval),
- % The code in the runtime looks for the from-full
- % flag in framevar 5; see the comment before
- % trace__reserved_slots.
+ % The code in the runtime looks for the from-full flag in
+ % framevar 5; see the comment before trace__reserved_slots.
require(unify(Lval, framevar(5)),
"from-full flag not stored in expected slot"),
Code = node([
@@ -914,6 +926,7 @@
])
)
;
+ TraceRedoLabel = no,
Code = empty
).
@@ -996,12 +1009,12 @@
trace__stackref_to_string(Lval, LvalStr) :-
( Lval = stackvar(Slot) ->
string__int_to_string(Slot, SlotString),
- string__append_list(["MR_sv(", SlotString, ")"], LvalStr)
+ LvalStr = "MR_sv(" ++ SlotString ++ ")"
; Lval = framevar(Slot) ->
string__int_to_string(Slot, SlotString),
- string__append_list(["MR_fv(", SlotString, ")"], LvalStr)
+ LvalStr = "MR_fv(" ++ SlotString ++ ")"
;
- error("non-stack lval in stackref_to_string")
+ unexpected(this_file, "non-stack lval in stackref_to_string")
).
%-----------------------------------------------------------------------------%
@@ -1061,33 +1074,39 @@
% Information for tracing that is valid throughout the execution
% of a procedure.
-:- type trace_info --->
- trace_info(
+:- type trace_info
+ ---> trace_info(
trace_level :: trace_level,
trace_suppress_items :: trace_suppress_items,
+
from_full_lval :: maybe(lval),
% If the trace level is shallow,
% the lval of the slot that holds the
% from-full flag.
+
io_seq_lval :: maybe(lval),
% If the procedure has I/O state
% arguments, the lval of the slot
% that holds the initial value of the
% I/O action counter.
+
trail_lvals :: maybe(pair(lval)),
% If trailing is enabled, the lvals
% of the slots that hold the value
% of the trail pointer and the ticket
% counter at the time of the call.
+
maxfr_lval :: maybe(lval),
% If we reserve a slot for holding
% the value of maxfr at entry for use
% in implementing retry, the lval of
% the slot.
+
call_table_tip_lval :: maybe(lval),
% If we reserve a slot for holding
% the value of the call table tip
% variable, the lval of this variable.
+
redo_label :: maybe(label)
% If we are generating redo events,
% this has the label associated with
@@ -1098,3 +1117,11 @@
% layout for the redo event (the
% two events have identical layouts).
).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "trace.m".
+
+%-----------------------------------------------------------------------------%
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.92
diff -u -b -r1.92 unique_modes.m
--- compiler/unique_modes.m 12 Aug 2005 05:14:17 -0000 1.92
+++ compiler/unique_modes.m 22 Aug 2005 14:35:59 -0000
@@ -655,12 +655,11 @@
unique_modes__check_call_modes(ArgVars, ProcArgModes, ArgOffset,
Determinism, NeverSucceeds, !ModeInfo) :-
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
- mode_list_get_initial_insts(ProcArgModes, ModuleInfo,
- InitialInsts),
+ mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts),
NeedExactMatch = no,
modecheck_var_has_inst_list(ArgVars, InitialInsts,
NeedExactMatch, ArgOffset, InstVarSub, !ModeInfo),
- mode_list_get_final_insts(ProcArgModes, ModuleInfo, FinalInsts0),
+ mode_list_get_final_insts(ModuleInfo, ProcArgModes, FinalInsts0),
inst_list_apply_substitution(FinalInsts0, InstVarSub, FinalInsts),
modecheck_set_var_inst_list(ArgVars, InitialInsts, FinalInsts,
ArgOffset, NewArgVars, ExtraGoals, !ModeInfo),
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/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
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/gears
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/moose/tests
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 extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
Index: mdbcomp/trace_counts.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/trace_counts.m,v
retrieving revision 1.7
diff -u -b -r1.7 trace_counts.m
--- mdbcomp/trace_counts.m 24 Aug 2005 09:07:10 -0000 1.7
+++ mdbcomp/trace_counts.m 24 Aug 2005 23:50:15 -0000
@@ -404,9 +404,6 @@
error("read_trace_counts_from_cur_stream: " ++
"unexpected exception type: " ++ string(Exception))
)
- ;
- Result = failed,
- error("read_trace_counts_from_cur_stream: try_io failed")
)
;
ReadResult = syntax_error("no info on trace count file type")
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 slice
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
Index: tests/invalid/occurs.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/occurs.err_exp,v
retrieving revision 1.8
diff -u -b -r1.8 occurs.err_exp
--- tests/invalid/occurs.err_exp 22 Aug 2005 03:55:18 -0000 1.8
+++ tests/invalid/occurs.err_exp 23 Aug 2005 04:10:18 -0000
@@ -7,6 +7,9 @@
occurs.m:008: term `occurs.f(X)' has instantiatedness `occurs.f(
occurs.m:008: free
occurs.m:008: )'.
+occurs.m:013: In clause for `p2':
+occurs.m:013: warning: unification of `X' and occurs.f cannot succeed
+occurs.m:013: `X' has instantiatedness `unique((occurs.[]))'.
occurs.m:018: In clause for `p3':
occurs.m:018: mode error in unification of `X' and `occurs.f(X)'.
occurs.m:018: Variable `X' has instantiatedness `unique(occurs.f(free))',
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
Index: tests/warnings/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/Mmakefile,v
retrieving revision 1.38
diff -u -b -r1.38 Mmakefile
--- tests/warnings/Mmakefile 6 May 2005 08:42:35 -0000 1.38
+++ tests/warnings/Mmakefile 22 Aug 2005 08:21:46 -0000
@@ -29,6 +29,7 @@
state_vars_test \
table_with_inline \
unused_args_analysis \
+ unify_f_g \
unused_args_test \
unused_import \
warn_stubs
Index: tests/warnings/simple_code.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/simple_code.exp,v
retrieving revision 1.12
diff -u -b -r1.12 simple_code.exp
--- tests/warnings/simple_code.exp 17 Jan 2005 05:01:48 -0000 1.12
+++ tests/warnings/simple_code.exp 23 Aug 2005 04:24:23 -0000
@@ -1,3 +1,6 @@
+simple_code.m:018: In clause for `p(in, out)':
+simple_code.m:018: warning: unification of `X' and 2 cannot succeed
+simple_code.m:018: `X' has instantiatedness `unique(3)'.
simple_code.m:010: Warning: this disjunct will never have any solutions.
simple_code.m:015: Warning: the condition of this if-then-else cannot fail.
simple_code.m:035: Warning: the condition of this if-then-else cannot fail.
Index: tests/warnings/unify_f_g.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/unify_f_g.exp,v
retrieving revision 1.1
diff -u -b -r1.1 unify_f_g.exp
--- tests/warnings/unify_f_g.exp 18 Aug 2005 07:58:09 -0000 1.1
+++ tests/warnings/unify_f_g.exp 23 Aug 2005 11:20:54 -0000
@@ -0,0 +1,5 @@
+unify_f_g.m:024: In clause for `p(in, in, out, in, out)':
+unify_f_g.m:024: warning: unification of `STATE_VARIABLE_In_0' and
+unify_f_g.m:024: std_util.yes cannot succeed
+unify_f_g.m:024: `STATE_VARIABLE_In_0' has instantiatedness
+unify_f_g.m:024: `bound((std_util.no))'.
Index: tests/warnings/unify_f_g.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/unify_f_g.m,v
retrieving revision 1.1
diff -u -b -r1.1 unify_f_g.m
--- tests/warnings/unify_f_g.m 18 Aug 2005 07:58:09 -0000 1.1
+++ tests/warnings/unify_f_g.m 23 Aug 2005 04:35:54 -0000
@@ -1,5 +1,7 @@
% This tests the warnings you should get when a conjunction unifies the same
-% variable with different function symbols.
+% variable with different function symbols. It is a cut-down version of the
+% predicate proc_info_has_io_state_pair_2 from hlds_pred.m, in which the bug
+% marked below took me a long time to find.
:- module unify_f_g.
:- interface.
@@ -19,7 +21,7 @@
( H < 10 ->
(
!.In = no,
- !.In = yes(H)
+ !.In = yes(H) % hard to see bug: !.In should be !:In
;
!.In = yes(_),
fail
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