[m-dev.] for review: polymorphic ground insts
David Overton
dmo at ender.cs.mu.oz.au
Mon Feb 21 17:22:47 AEDT 2000
--- ./mercury/compiler/inst_match.m Fri Feb 11 10:45:00 2000
+++ .././mercury/compiler/inst_match.m Fri Feb 18 13:03:36 2000
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1995-2000 The University of Melbourne.
+% Copyright (C) 1995-1998, 2000 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.
%-----------------------------------------------------------------------------%
@@ -60,8 +60,8 @@
inst_var_sub, inst_var_sub).
:- mode inst_matches_initial(in, in, in, in, out, in, out) is semidet.
-:- pred inst_matches_final(inst, inst, module_info).
-:- mode inst_matches_final(in, in, in) is semidet.
+:- pred inst_matches_final(inst, inst, type, module_info).
+:- mode inst_matches_final(in, in, in, in) is semidet.
% inst_matches_initial(InstA, InstB, ModuleInfo):
% Succeed iff `InstA' specifies at least as much
@@ -112,8 +112,8 @@
% unique_matches_final(A, B) succeeds if A >= B in the ordering
% clobbered < mostly_clobbered < shared < mostly_unique < unique
-:- pred inst_matches_binding(inst, inst, module_info).
-:- mode inst_matches_binding(in, in, in) is semidet.
+:- pred inst_matches_binding(inst, inst, type, module_info).
+:- mode inst_matches_binding(in, in, in, in) is semidet.
% inst_matches_binding(InstA, InstB, ModuleInfo):
% Succeed iff the binding of InstA is definitely exactly the
@@ -325,14 +325,19 @@
bound_inst_list_is_ground(ListA, ModuleInfo),
bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo).
inst_matches_initial_3(bound(UniqA, ListA),
- ground(UniqB, constrained_inst_var(V)), _, _,
+ ground(UniqB, constrained_inst_var(InstVarB)), _, _,
ModuleInfo0, ModuleInfo, Sub0, Sub) :-
unique_matches_initial(UniqA, UniqB),
bound_inst_list_is_ground(ListA, ModuleInfo0),
bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo0),
- abstractly_unify_inst(live, bound(UniqA, ListA), ground(UniqB, none),
+
+ % Call abstractly_unify_inst to calculate the uniqueness of the
+ % bound_inst arguments. We pass `Live = dead' because we want
+ % abstractly_unify(unique, unique) = unique, not shared.
+ Live = dead,
+ abstractly_unify_inst(Live, bound(UniqA, ListA), ground(UniqB, none),
fake_unify, ModuleInfo0, Inst, _Det, ModuleInfo1),
- update_inst_var_sub(V, Inst, ModuleInfo1, ModuleInfo, Sub0, Sub).
+ update_inst_var_sub(InstVarB, Inst, ModuleInfo1, ModuleInfo, Sub0, Sub).
inst_matches_initial_3(bound(Uniq, List), abstract_inst(_,_), _, _, ModuleInfo,
ModuleInfo, S, S) :-
Uniq = unique,
@@ -347,23 +352,23 @@
:-
unique_matches_initial(UniqA, UniqB).
inst_matches_initial_3(ground(_Uniq, _PredInst), free, _, _, M, M, S, S).
-inst_matches_initial_3(ground(UniqA, GII), bound(UniqB, List), MaybeType,
+inst_matches_initial_3(ground(UniqA, GII_A), bound(UniqB, ListB), MaybeType,
Expansions, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
MaybeType = yes(Type),
% We can only check this case properly if the type is known.
- GII \= constrained_inst_var(_),
+ GII_A \= constrained_inst_var(_),
% Don't overly constrain the inst_var.
unique_matches_initial(UniqA, UniqB),
- bound_inst_list_is_complete_for_type(set__init, ModuleInfo0, List,
+ bound_inst_list_is_complete_for_type(set__init, ModuleInfo0, ListB,
Type),
- ground_matches_initial_bound_inst_list(UniqA, List, yes(Type),
+ ground_matches_initial_bound_inst_list(UniqA, ListB, yes(Type),
Expansions, ModuleInfo0, ModuleInfo, Sub0, Sub).
inst_matches_initial_3(ground(UniqA, GroundInstInfoA),
ground(UniqB, GroundInstInfoB), Type, Expansions,
ModuleInfo0, ModuleInfo, Sub0, Sub) :-
unique_matches_initial(UniqA, UniqB),
ground_inst_info_matches_initial(GroundInstInfoA, GroundInstInfoB,
- UniqA, UniqB, Type, Expansions, ModuleInfo0, ModuleInfo,
+ UniqB, Type, Expansions, ModuleInfo0, ModuleInfo,
Sub0, Sub).
inst_matches_initial_3(ground(_UniqA, none), abstract_inst(_,_),_,_,_,_,_,_) :-
% I don't know what this should do.
@@ -381,6 +386,8 @@
%-----------------------------------------------------------------------------%
+ % This predicate assumes that the check of
+ % `bound_inst_list_is_complete_for_type' is done by the caller.
:- pred ground_matches_initial_bound_inst_list(uniqueness, list(bound_inst),
maybe(type), expansions, module_info, module_info,
inst_var_sub, inst_var_sub).
@@ -390,7 +397,7 @@
ground_matches_initial_bound_inst_list(_, [], _, _, M, M, S, S).
ground_matches_initial_bound_inst_list(Uniq, [functor(ConsId, Args) | List],
MaybeType, Expansions, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
- maybe_get_arg_types(ModuleInfo0, MaybeType, ConsId, MaybeTypes),
+ maybe_get_cons_id_arg_types(ModuleInfo0, MaybeType, ConsId, MaybeTypes),
ground_matches_initial_inst_list(Uniq, Args, MaybeTypes, Expansions,
ModuleInfo0, ModuleInfo1, Sub0, Sub1),
ground_matches_initial_bound_inst_list(Uniq, List, MaybeType,
@@ -412,6 +419,9 @@
%-----------------------------------------------------------------------------%
+ % A list(bound_inst) is ``complete'' for a given type iff it
+ % includes each functor of the type and each argument of each
+ % functor is also ``complete'' for the type.
:- pred bound_inst_list_is_complete_for_type(set(inst_name), module_info,
list(bound_inst), type).
:- mode bound_inst_list_is_complete_for_type(in, in, in, in) is semidet.
@@ -441,21 +451,23 @@
:- mode inst_is_complete_for_type(in, in, in, in) is semidet.
inst_is_complete_for_type(Expansions, ModuleInfo, Inst, Type) :-
- ( Inst = defined_inst(InstName) ->
- ( set__member(InstName, Expansions) ->
+ ( Inst = defined_inst(Name) ->
+ ( set__member(Name, Expansions) ->
true
;
- inst_lookup(ModuleInfo, InstName, ExpandedInst),
- inst_is_complete_for_type(Expansions `insert` InstName,
+ inst_lookup(ModuleInfo, Name, ExpandedInst),
+ inst_is_complete_for_type(Expansions `set__insert` Name,
ModuleInfo, ExpandedInst, Type)
)
; Inst = bound(_, List) ->
bound_inst_list_is_complete_for_type(Expansions, ModuleInfo,
List, Type)
;
- true
+ Inst \= not_reached
).
+ % Check that two cons_ids are the same, except that one may be less
+ % module qualified than the other.
:- pred equivalent_cons_ids(cons_id, cons_id).
:- mode equivalent_cons_ids(in, in) is semidet.
@@ -481,44 +493,46 @@
%-----------------------------------------------------------------------------%
+ % Update the inst_var_sub that is computed by inst_matches_initial.
+ % The inst_var_sub records what inst should be substituted for each
+ % inst_var that occurs in the called procedure's argument modes.
:- pred update_inst_var_sub(inst_var, inst, module_info, module_info,
inst_var_sub, inst_var_sub).
:- mode update_inst_var_sub(in, in, in, out, in, out) is semidet.
-update_inst_var_sub(V, InstA, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
- ( map__search(Sub0, V, InstB) ->
+update_inst_var_sub(InstVar, InstA, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
+ ( map__search(Sub0, InstVar, InstB) ->
+ % If InstVar already has an inst associated with it,
+ % merge the old inst and the new inst. Fail is this merge
+ % is not possible.
inst_merge(InstA, InstB, ModuleInfo0, Inst, ModuleInfo),
- map__det_update(Sub0, V, Inst, Sub)
+ map__det_update(Sub0, InstVar, Inst, Sub)
;
ModuleInfo = ModuleInfo0,
- map__det_insert(Sub0, V, InstA, Sub)
+ map__det_insert(Sub0, InstVar, InstA, Sub)
).
%-----------------------------------------------------------------------------%
+ % This predicate checks if two ground_inst_infos match_initial.
+ % It does not check uniqueness.
:- pred ground_inst_info_matches_initial(ground_inst_info, ground_inst_info,
- uniqueness, uniqueness, maybe(type), expansions,
+ uniqueness, maybe(type), expansions,
module_info, module_info, inst_var_sub, inst_var_sub).
-:- mode ground_inst_info_matches_initial(in, in, in, in, in, in, in, out, in,
+:- mode ground_inst_info_matches_initial(in, in, in, in, in, in, out, in,
out) is semidet.
-ground_inst_info_matches_initial(_, none, _, _, _, _, M, M) --> [].
+ground_inst_info_matches_initial(_, none, _, _, _, M, M) --> [].
ground_inst_info_matches_initial(higher_order(PredInstA),
- higher_order(PredInstB), _, _, Type, Expansions,
+ higher_order(PredInstB), _, Type, Expansions,
ModuleInfo0, ModuleInfo) -->
pred_inst_matches_initial(PredInstA, PredInstB, Type, Expansions,
ModuleInfo0, ModuleInfo).
-ground_inst_info_matches_initial(GroundInstInfoA, constrained_inst_var(V),
- UniqA, UniqB, _, _, ModuleInfo0, ModuleInfo) -->
- { GroundInstInfoA = constrained_inst_var(_) ->
- Inst = ground(UniqA, GroundInstInfoA),
- ModuleInfo1 = ModuleInfo0
- ;
- abstractly_unify_inst(live, ground(UniqA, GroundInstInfoA),
- ground(UniqB, none), fake_unify, ModuleInfo0, Inst,
- _Det, ModuleInfo1)
- },
- update_inst_var_sub(V, Inst, ModuleInfo1, ModuleInfo).
+ground_inst_info_matches_initial(GroundInstInfoA,
+ constrained_inst_var(InstVarB), UniqB, _, _,
+ ModuleInfo0, ModuleInfo) -->
+ { Inst = ground(UniqB, GroundInstInfoA) },
+ update_inst_var_sub(InstVarB, Inst, ModuleInfo0, ModuleInfo).
:- pred pred_inst_matches_initial(pred_inst_info, pred_inst_info, maybe(type),
expansions, module_info, module_info, inst_var_sub, inst_var_sub).
@@ -527,19 +541,12 @@
pred_inst_matches_initial(pred_inst_info(PredOrFunc, ModesA, Det),
pred_inst_info(PredOrFunc, ModesB, Det), MaybeType,
Expansions, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
- (
- MaybeType = yes(Type),
- type_is_higher_order(Type, _, _, Types)
- ->
- list__map(pred(T::in, yes(T)::out) is det, Types, MaybeTypes)
- ;
- list__duplicate(length(ModesA), no, MaybeTypes)
- ),
+ maybe_get_higher_order_arg_types(MaybeType, length(ModesA), MaybeTypes),
pred_inst_argmodes_matches_initial(ModesA, ModesB, MaybeTypes,
Expansions, ModuleInfo0, ModuleInfo, Sub0, Sub),
mode_list_apply_substitution(ModesA, Sub, ModesASub),
mode_list_apply_substitution(ModesB, Sub, ModesBSub),
- pred_inst_argmodes_matches(ModesASub, ModesBSub, ModuleInfo,
+ pred_inst_argmodes_matches(ModesASub, ModesBSub, MaybeTypes, ModuleInfo,
Expansions).
% pred_inst_matches_argmodes(ModesA, ModesB, ModuleInfo, Expansions):
@@ -569,8 +576,16 @@
ModuleInfo2, ModuleInfo, Sub2, Sub).
pred_inst_matches(PredInstA, PredInstB, ModuleInfo) :-
+ pred_inst_matches_1(PredInstA, PredInstB, no, ModuleInfo).
+
+:- pred pred_inst_matches_1(pred_inst_info, pred_inst_info, maybe(type),
+ module_info).
+:- mode pred_inst_matches_1(in, in, in, in) is semidet.
+
+pred_inst_matches_1(PredInstA, PredInstB, MaybeType, ModuleInfo) :-
set__init(Expansions),
- pred_inst_matches_2(PredInstA, PredInstB, ModuleInfo, Expansions).
+ pred_inst_matches_2(PredInstA, PredInstB, MaybeType, ModuleInfo,
+ Expansions).
% pred_inst_matches_2(PredInstA, PredInstB, ModuleInfo, Expansions)
% Same as pred_inst_matches/3, except that inst pairs in
@@ -578,14 +593,16 @@
% (This avoids infinite loops when calling inst_matches_final
% on higher-order recursive insts.)
%
-:- pred pred_inst_matches_2(pred_inst_info, pred_inst_info, module_info,
- expansions).
-:- mode pred_inst_matches_2(in, in, in, in) is semidet.
+:- pred pred_inst_matches_2(pred_inst_info, pred_inst_info, maybe(type),
+ module_info, expansions).
+:- mode pred_inst_matches_2(in, in, in, in, in) is semidet.
pred_inst_matches_2(pred_inst_info(PredOrFunc, ModesA, Det),
pred_inst_info(PredOrFunc, ModesB, Det),
- ModuleInfo, Expansions) :-
- pred_inst_argmodes_matches(ModesA, ModesB, ModuleInfo, Expansions).
+ MaybeType, ModuleInfo, Expansions) :-
+ maybe_get_higher_order_arg_types(MaybeType, length(ModesA), MaybeTypes),
+ pred_inst_argmodes_matches(ModesA, ModesB, MaybeTypes, ModuleInfo,
+ Expansions).
% pred_inst_matches_argmodes(ModesA, ModesB, ModuleInfo, Expansions):
% succeeds if the initial insts of ModesB specify at least as
@@ -595,18 +612,20 @@
% final insts of ModesB. Any inst pairs in Expansions are assumed
% to match_final each other.
%
-:- pred pred_inst_argmodes_matches(list(mode), list(mode),
+:- pred pred_inst_argmodes_matches(list(mode), list(mode), list(maybe(type)),
module_info, expansions).
-:- mode pred_inst_argmodes_matches(in, in, in, in) is semidet.
+:- mode pred_inst_argmodes_matches(in, in, in, in, in) is semidet.
-pred_inst_argmodes_matches([], [], _, _).
+pred_inst_argmodes_matches([], [], _, _, _).
pred_inst_argmodes_matches([ModeA|ModeAs], [ModeB|ModeBs],
- ModuleInfo, Expansions) :-
+ [MaybeType | MaybeTypes], ModuleInfo, Expansions) :-
mode_get_insts(ModuleInfo, ModeA, InitialA, FinalA),
mode_get_insts(ModuleInfo, ModeB, InitialB, FinalB),
- inst_matches_final_2(InitialB, InitialA, ModuleInfo, Expansions),
- inst_matches_final_2(FinalA, FinalB, ModuleInfo, Expansions),
- pred_inst_argmodes_matches(ModeAs, ModeBs, ModuleInfo, Expansions).
+ inst_matches_final_2(InitialB, InitialA, MaybeType, ModuleInfo,
+ Expansions),
+ inst_matches_final_2(FinalA, FinalB, MaybeType, ModuleInfo, Expansions),
+ pred_inst_argmodes_matches(ModeAs, ModeBs, MaybeTypes, ModuleInfo,
+ Expansions).
%-----------------------------------------------------------------------------%
@@ -676,7 +695,7 @@
X = functor(ConsIdX, ArgsX),
Y = functor(ConsIdY, ArgsY),
( ConsIdX = ConsIdY ->
- maybe_get_arg_types(ModuleInfo0, MaybeType, ConsIdX,
+ maybe_get_cons_id_arg_types(ModuleInfo0, MaybeType, ConsIdX,
MaybeTypes),
inst_list_matches_initial(ArgsX, ArgsY, MaybeTypes, Expansions,
ModuleInfo0, ModuleInfo1, Sub0, Sub1),
@@ -705,11 +724,11 @@
inst_list_matches_initial(Xs, Ys, Types, Expansions, ModuleInfo1,
ModuleInfo, Sub1, Sub).
-:- pred maybe_get_arg_types(module_info, maybe(type), cons_id,
+:- pred maybe_get_cons_id_arg_types(module_info, maybe(type), cons_id,
list(maybe(type))).
-:- mode maybe_get_arg_types(in, in, in, out) is det.
+:- mode maybe_get_cons_id_arg_types(in, in, in, out) is det.
-maybe_get_arg_types(ModuleInfo, MaybeType, ConsId0, MaybeTypes) :-
+maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsId0, MaybeTypes) :-
( ConsId0 = cons(SymName, Arity) ->
( SymName = qualified(_, Name) ->
% type_util__get_cons_id_arg_types expects an
@@ -732,6 +751,20 @@
;
MaybeTypes = []
).
+
+:- pred maybe_get_higher_order_arg_types(maybe(type), arity, list(maybe(type))).
+:- mode maybe_get_higher_order_arg_types(in, in, out) is det.
+
+maybe_get_higher_order_arg_types(MaybeType, Arity, MaybeTypes) :-
+ (
+ MaybeType = yes(Type),
+ type_is_higher_order(Type, _, _, Types)
+ ->
+ list__map(pred(T::in, yes(T)::out) is det, Types, MaybeTypes)
+ ;
+ list__duplicate(Arity, no, MaybeTypes)
+ ).
+
%-----------------------------------------------------------------------------%
inst_expand(ModuleInfo, Inst0, Inst) :-
@@ -744,14 +777,14 @@
%-----------------------------------------------------------------------------%
-inst_matches_final(InstA, InstB, ModuleInfo) :-
+inst_matches_final(InstA, InstB, Type, ModuleInfo) :-
set__init(Expansions),
- inst_matches_final_2(InstA, InstB, ModuleInfo, Expansions).
+ inst_matches_final_2(InstA, InstB, yes(Type), ModuleInfo, Expansions).
-:- pred inst_matches_final_2(inst, inst, module_info, expansions).
-:- mode inst_matches_final_2(in, in, in, in) is semidet.
+:- pred inst_matches_final_2(inst, inst, maybe(type), module_info, expansions).
+:- mode inst_matches_final_2(in, in, in, in, in) is semidet.
-inst_matches_final_2(InstA, InstB, ModuleInfo, Expansions) :-
+inst_matches_final_2(InstA, InstB, MaybeType, ModuleInfo, Expansions) :-
ThisExpansion = InstA - InstB,
( set__member(ThisExpansion, Expansions) ->
true
@@ -761,81 +794,95 @@
inst_expand(ModuleInfo, InstA, InstA2),
inst_expand(ModuleInfo, InstB, InstB2),
set__insert(Expansions, ThisExpansion, Expansions2),
- inst_matches_final_3(InstA2, InstB2, ModuleInfo,
+ inst_matches_final_3(InstA2, InstB2, MaybeType, ModuleInfo,
Expansions2)
).
-:- pred inst_matches_final_3(inst, inst, module_info, expansions).
-:- mode inst_matches_final_3(in, in, in, in) is semidet.
+:- pred inst_matches_final_3(inst, inst, maybe(type), module_info, expansions).
+:- mode inst_matches_final_3(in, in, in, in, in) is semidet.
-inst_matches_final_3(any(UniqA), any(UniqB), _, _) :-
+inst_matches_final_3(any(UniqA), any(UniqB), _, _, _) :-
unique_matches_final(UniqA, UniqB).
-inst_matches_final_3(free, any(Uniq), _, _) :-
+inst_matches_final_3(free, any(Uniq), _, _, _) :-
% We do not yet allow `free' to match `any',
% unless the `any' is `clobbered_any' or `mostly_clobbered_any'.
% Among other things, changing this would break compare_inst
% in modecheck_call.m.
( Uniq = clobbered ; Uniq = mostly_clobbered ).
-inst_matches_final_3(free, free, _, _).
-inst_matches_final_3(bound(UniqA, ListA), any(UniqB), ModuleInfo, _) :-
+inst_matches_final_3(free, free, _, _, _).
+inst_matches_final_3(bound(UniqA, ListA), any(UniqB), _, ModuleInfo, _) :-
unique_matches_final(UniqA, UniqB),
bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo),
% We do not yet allow `free' to match `any'.
% Among other things, changing this would break compare_inst
% in modecheck_call.m.
bound_inst_list_is_ground_or_any(ListA, ModuleInfo).
-inst_matches_final_3(bound(UniqA, ListA), bound(UniqB, ListB), ModuleInfo,
- Expansions) :-
+inst_matches_final_3(bound(UniqA, ListA), bound(UniqB, ListB), MaybeType,
+ ModuleInfo, Expansions) :-
unique_matches_final(UniqA, UniqB),
- bound_inst_list_matches_final(ListA, ListB, ModuleInfo, Expansions).
-inst_matches_final_3(bound(UniqA, ListA), ground(UniqB, none), ModuleInfo,
+ bound_inst_list_matches_final(ListA, ListB, MaybeType, ModuleInfo,
+ Expansions).
+inst_matches_final_3(bound(UniqA, ListA), ground(UniqB, none), _, ModuleInfo,
_Exps) :-
unique_matches_final(UniqA, UniqB),
bound_inst_list_is_ground(ListA, ModuleInfo),
bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo).
-inst_matches_final_3(ground(UniqA, _), any(UniqB), _ModuleInfo, _Expansions) :-
+inst_matches_final_3(ground(UniqA, _), any(UniqB), _, _ModuleInfo, _Expansions)
+ :-
unique_matches_final(UniqA, UniqB).
-inst_matches_final_3(ground(UniqA, _), bound(UniqB, ListB), ModuleInfo,
- _Exps) :-
+inst_matches_final_3(ground(UniqA, _), bound(UniqB, ListB), MaybeType,
+ ModuleInfo, _Exps) :-
unique_matches_final(UniqA, UniqB),
bound_inst_list_is_ground(ListB, ModuleInfo),
- uniq_matches_bound_inst_list(UniqA, ListB, ModuleInfo).
- % XXX BUG! Should fail if there are not_reached
- % insts in ListB, or if ListB does not contain a complete list
- % of all the constructors for the type in question.
- %%% error("not implemented: `ground' matches_final `bound(...)'").
+ uniq_matches_bound_inst_list(UniqA, ListB, ModuleInfo),
+ (
+ MaybeType = yes(Type),
+ % We can only do this check if the type is known.
+ bound_inst_list_is_complete_for_type(set__init, ModuleInfo,
+ ListB, Type)
+ ;
+ true
+ % XXX enabling this check makes the mode checker too
+ % conservative in the absence of alias tracking.
+ ).
inst_matches_final_3(ground(UniqA, GroundInstInfoA),
- ground(UniqB, GroundInstInfoB), ModuleInfo, Expansions) :-
+ ground(UniqB, GroundInstInfoB), MaybeType, ModuleInfo,
+ Expansions) :-
ground_inst_info_matches_final(GroundInstInfoA, GroundInstInfoB,
- ModuleInfo, Expansions),
+ MaybeType, ModuleInfo, Expansions),
unique_matches_final(UniqA, UniqB).
-inst_matches_final_2(abstract_inst(_, _), any(shared), _, _).
+inst_matches_final_3(abstract_inst(_, _), any(shared), _, _, _).
inst_matches_final_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
- ModuleInfo, Expansions) :-
- inst_list_matches_final(ArgsA, ArgsB, ModuleInfo, Expansions).
-inst_matches_final_3(not_reached, _, _, _).
+ _MaybeType, ModuleInfo, Expansions) :-
+ list__duplicate(length(ArgsA), no, MaybeTypes),
+ % XXX how do we get the argument types for an abstract inst?
+ inst_list_matches_final(ArgsA, ArgsB, MaybeTypes, ModuleInfo,
+ Expansions).
+inst_matches_final_3(not_reached, _, _, _, _).
:- pred ground_inst_info_matches_final(ground_inst_info, ground_inst_info,
- module_info, expansions).
-:- mode ground_inst_info_matches_final(in, in, in, in) is semidet.
+ maybe(type), module_info, expansions).
+:- mode ground_inst_info_matches_final(in, in, in, in, in) is semidet.
-ground_inst_info_matches_final(_, none, _, _).
+ground_inst_info_matches_final(_, none, _, _, _).
ground_inst_info_matches_final(higher_order(PredInstA),
- higher_order(PredInstB), ModuleInfo, Expansions) :-
- pred_inst_matches_2(PredInstA, PredInstB, ModuleInfo, Expansions).
-ground_inst_info_matches_final(constrained_inst_var(I),
- constrained_inst_var(I), _, _).
+ higher_order(PredInstB), MaybeType, ModuleInfo, Expansions) :-
+ pred_inst_matches_2(PredInstA, PredInstB, MaybeType, ModuleInfo,
+ Expansions).
+ground_inst_info_matches_final(constrained_inst_var(InstVar),
+ constrained_inst_var(InstVar), _, _, _).
+
+:- pred inst_list_matches_final(list(inst), list(inst), list(maybe(type)),
+ module_info, expansions).
+:- mode inst_list_matches_final(in, in, in, in, in) is semidet.
-:- pred inst_list_matches_final(list(inst), list(inst), module_info,
- expansions).
-:- mode inst_list_matches_final(in, in, in, in) is semidet.
-
-inst_list_matches_final([], [], _ModuleInfo, _).
-inst_list_matches_final([ArgA | ArgsA], [ArgB | ArgsB], ModuleInfo,
- Expansions) :-
- inst_matches_final_2(ArgA, ArgB, ModuleInfo, Expansions),
- inst_list_matches_final(ArgsA, ArgsB, ModuleInfo, Expansions).
+inst_list_matches_final([], [], _, _ModuleInfo, _).
+inst_list_matches_final([ArgA | ArgsA], [ArgB | ArgsB],
+ [MaybeType | MaybeTypes], ModuleInfo, Expansions) :-
+ inst_matches_final_2(ArgA, ArgB, MaybeType, ModuleInfo, Expansions),
+ inst_list_matches_final(ArgsA, ArgsB, MaybeTypes, ModuleInfo,
+ Expansions).
% Here we check that the functors in the first list are a
% subset of the functors in the second list.
@@ -847,16 +894,21 @@
% are sorted.
:- pred bound_inst_list_matches_final(list(bound_inst), list(bound_inst),
- module_info, expansions).
-:- mode bound_inst_list_matches_final(in, in, in, in) is semidet.
+ maybe(type), module_info, expansions).
+:- mode bound_inst_list_matches_final(in, in, in, in, in) is semidet.
-bound_inst_list_matches_final([], _, _, _).
-bound_inst_list_matches_final([X|Xs], [Y|Ys], ModuleInfo, Expansions) :-
+bound_inst_list_matches_final([], _, _, _, _).
+bound_inst_list_matches_final([X|Xs], [Y|Ys], MaybeType, ModuleInfo,
+ Expansions) :-
X = functor(ConsIdX, ArgsX),
Y = functor(ConsIdY, ArgsY),
( ConsIdX = ConsIdY ->
- inst_list_matches_final(ArgsX, ArgsY, ModuleInfo, Expansions),
- bound_inst_list_matches_final(Xs, Ys, ModuleInfo, Expansions)
+ maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsIdX,
+ MaybeTypes),
+ inst_list_matches_final(ArgsX, ArgsY, MaybeTypes, ModuleInfo,
+ Expansions),
+ bound_inst_list_matches_final(Xs, Ys, MaybeType, ModuleInfo,
+ Expansions)
;
compare(>, ConsIdX, ConsIdY),
% ConsIdY does not occur in [X|Xs].
@@ -864,18 +916,19 @@
% for the args of ConsIdY, and hence
% automatically matches_final Y. We just need to
% check that [X|Xs] matches_final Ys.
- bound_inst_list_matches_final([X|Xs], Ys, ModuleInfo,
+ bound_inst_list_matches_final([X|Xs], Ys, MaybeType, ModuleInfo,
Expansions)
).
-inst_matches_binding(InstA, InstB, ModuleInfo) :-
+inst_matches_binding(InstA, InstB, Type, ModuleInfo) :-
set__init(Expansions),
- inst_matches_binding_2(InstA, InstB, ModuleInfo, Expansions).
+ inst_matches_binding_2(InstA, InstB, yes(Type), ModuleInfo, Expansions).
-:- pred inst_matches_binding_2(inst, inst, module_info, expansions).
-:- mode inst_matches_binding_2(in, in, in, in) is semidet.
+:- pred inst_matches_binding_2(inst, inst, maybe(type), module_info,
+ expansions).
+:- mode inst_matches_binding_2(in, in, in, in, in) is semidet.
-inst_matches_binding_2(InstA, InstB, ModuleInfo, Expansions) :-
+inst_matches_binding_2(InstA, InstB, MaybeType, ModuleInfo, Expansions) :-
ThisExpansion = InstA - InstB,
( set__member(ThisExpansion, Expansions) ->
true
@@ -883,60 +936,73 @@
inst_expand(ModuleInfo, InstA, InstA2),
inst_expand(ModuleInfo, InstB, InstB2),
set__insert(Expansions, ThisExpansion, Expansions2),
- inst_matches_binding_3(InstA2, InstB2, ModuleInfo,
+ inst_matches_binding_3(InstA2, InstB2, MaybeType, ModuleInfo,
Expansions2)
).
-:- pred inst_matches_binding_3(inst, inst, module_info, expansions).
-:- mode inst_matches_binding_3(in, in, in, in) is semidet.
+:- pred inst_matches_binding_3(inst, inst, maybe(type), module_info,
+ expansions).
+:- mode inst_matches_binding_3(in, in, in, in, in) is semidet.
% Note that `any' is *not* considered to match `any'.
-inst_matches_binding_3(free, free, _, _).
-inst_matches_binding_3(bound(_UniqA, ListA), bound(_UniqB, ListB), ModuleInfo,
- Expansions) :-
- bound_inst_list_matches_binding(ListA, ListB, ModuleInfo, Expansions).
-inst_matches_binding_3(bound(_UniqA, ListA), ground(_UniqB, none), ModuleInfo,
- _Exps) :-
+inst_matches_binding_3(free, free, _, _, _).
+inst_matches_binding_3(bound(_UniqA, ListA), bound(_UniqB, ListB), MaybeType,
+ ModuleInfo, Expansions) :-
+ bound_inst_list_matches_binding(ListA, ListB, MaybeType, ModuleInfo,
+ Expansions).
+inst_matches_binding_3(bound(_UniqA, ListA), ground(_UniqB, none), _,
+ ModuleInfo, _Exps) :-
bound_inst_list_is_ground(ListA, ModuleInfo).
inst_matches_binding_3(bound(_UniqA, ListA),
- ground(_UniqB, constrained_inst_var(_)), ModuleInfo, _Exps) :-
+ ground(_UniqB, constrained_inst_var(_)), _, ModuleInfo, _Exps)
+ :-
bound_inst_list_is_ground(ListA, ModuleInfo).
-inst_matches_binding_3(ground(_UniqA, _), bound(_UniqB, ListB), ModuleInfo,
- _Exps) :-
- bound_inst_list_is_ground(ListB, ModuleInfo).
- % XXX BUG! Should fail if there are not_reached
- % insts in ListB, or if ListB does not contain a complete list
- % of all the constructors for the type in question.
- %%% error("not implemented: `ground' matches_binding `bound(...)'").
+inst_matches_binding_3(ground(_UniqA, _), bound(_UniqB, ListB), MaybeType,
+ ModuleInfo, _Exps) :-
+ bound_inst_list_is_ground(ListB, ModuleInfo),
+ (
+ MaybeType = yes(Type),
+ % We can only do this check if the type is known.
+ bound_inst_list_is_complete_for_type(set__init, ModuleInfo,
+ ListB, Type)
+ ;
+ true
+ % XXX enabling this check makes the mode checker too
+ % conservative in the absence of alias tracking.
+ ).
inst_matches_binding_3(ground(_UniqA, GroundInstInfoA),
- ground(_UniqB, GroundInstInfoB), ModuleInfo, _) :-
+ ground(_UniqB, GroundInstInfoB), MaybeType, ModuleInfo, _) :-
ground_inst_info_matches_binding(GroundInstInfoA, GroundInstInfoB,
- ModuleInfo).
+ MaybeType, ModuleInfo).
inst_matches_binding_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
- ModuleInfo, Expansions) :-
- inst_list_matches_binding(ArgsA, ArgsB, ModuleInfo, Expansions).
-inst_matches_binding_3(not_reached, _, _, _).
+ _MaybeType, ModuleInfo, Expansions) :-
+ list__duplicate(length(ArgsA), no, MaybeTypes),
+ % XXX how do we get the argument types for an abstract inst?
+ inst_list_matches_binding(ArgsA, ArgsB, MaybeTypes, ModuleInfo,
+ Expansions).
+inst_matches_binding_3(not_reached, _, _, _, _).
:- pred ground_inst_info_matches_binding(ground_inst_info, ground_inst_info,
- module_info).
-:- mode ground_inst_info_matches_binding(in, in, in) is semidet.
+ maybe(type), module_info).
+:- mode ground_inst_info_matches_binding(in, in, in, in) is semidet.
-ground_inst_info_matches_binding(_, none, _).
+ground_inst_info_matches_binding(_, none, _, _).
ground_inst_info_matches_binding(higher_order(PredInstA),
- higher_order(PredInstB), ModuleInfo) :-
- pred_inst_matches(PredInstA, PredInstB, ModuleInfo).
-ground_inst_info_matches_binding(constrained_inst_var(_),
- constrained_inst_var(_), _). % AAA
-
-:- pred inst_list_matches_binding(list(inst), list(inst), module_info,
- expansions).
-:- mode inst_list_matches_binding(in, in, in, in) is semidet.
-
-inst_list_matches_binding([], [], _ModuleInfo, _).
-inst_list_matches_binding([ArgA | ArgsA], [ArgB | ArgsB], ModuleInfo,
- Expansions) :-
- inst_matches_binding_2(ArgA, ArgB, ModuleInfo, Expansions),
- inst_list_matches_binding(ArgsA, ArgsB, ModuleInfo, Expansions).
+ higher_order(PredInstB), MaybeType, ModuleInfo) :-
+ pred_inst_matches_1(PredInstA, PredInstB, MaybeType, ModuleInfo).
+ground_inst_info_matches_binding(constrained_inst_var(InstVar),
+ constrained_inst_var(InstVar), _, _).
+
+:- pred inst_list_matches_binding(list(inst), list(inst), list(maybe(type)),
+ module_info, expansions).
+:- mode inst_list_matches_binding(in, in, in, in, in) is semidet.
+
+inst_list_matches_binding([], [], _, _ModuleInfo, _).
+inst_list_matches_binding([ArgA | ArgsA], [ArgB | ArgsB],
+ [MaybeType | MaybeTypes], ModuleInfo, Expansions) :-
+ inst_matches_binding_2(ArgA, ArgB, MaybeType, ModuleInfo, Expansions),
+ inst_list_matches_binding(ArgsA, ArgsB, MaybeTypes, ModuleInfo,
+ Expansions).
% Here we check that the functors in the first list are a
% subset of the functors in the second list.
@@ -948,16 +1014,21 @@
% are sorted.
:- pred bound_inst_list_matches_binding(list(bound_inst), list(bound_inst),
- module_info, expansions).
-:- mode bound_inst_list_matches_binding(in, in, in, in) is semidet.
+ maybe(type), module_info, expansions).
+:- mode bound_inst_list_matches_binding(in, in, in, in, in) is semidet.
-bound_inst_list_matches_binding([], _, _, _).
-bound_inst_list_matches_binding([X|Xs], [Y|Ys], ModuleInfo, Expansions) :-
+bound_inst_list_matches_binding([], _, _, _, _).
+bound_inst_list_matches_binding([X|Xs], [Y|Ys], MaybeType, ModuleInfo,
+ Expansions) :-
X = functor(ConsIdX, ArgsX),
Y = functor(ConsIdY, ArgsY),
( ConsIdX = ConsIdY ->
- inst_list_matches_binding(ArgsX, ArgsY, ModuleInfo, Expansions),
- bound_inst_list_matches_binding(Xs, Ys, ModuleInfo, Expansions)
+ maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsIdX,
+ MaybeTypes),
+ inst_list_matches_binding(ArgsX, ArgsY, MaybeTypes, ModuleInfo,
+ Expansions),
+ bound_inst_list_matches_binding(Xs, Ys, MaybeType, ModuleInfo,
+ Expansions)
;
compare(>, ConsIdX, ConsIdY),
% ConsIdX does not occur in [X|Xs].
@@ -965,8 +1036,8 @@
% for the args of ConsIdY, and hence
% automatically matches_binding Y. We just need to
% check that [X|Xs] matches_binding Ys.
- bound_inst_list_matches_binding([X|Xs], Ys, ModuleInfo,
- Expansions)
+ bound_inst_list_matches_binding([X|Xs], Ys, MaybeType,
+ ModuleInfo, Expansions)
).
%-----------------------------------------------------------------------------%
--- ./mercury/compiler/inst_util.m Fri Feb 11 10:45:01 2000
+++ .././mercury/compiler/inst_util.m Wed Feb 16 14:36:39 2000
@@ -297,7 +297,9 @@
abstractly_unify_inst_3(live, ground(UniqX, constrained_inst_var(Var)),
any(UniqY), Real, M, ground(Uniq, constrained_inst_var(Var)),
semidet, M) :-
- Real = fake_unify, % AAA
+ Real = fake_unify,
+ % If Real \= fake_unify then we must fail because the inst vars
+ % may represent higher order insts.
unify_uniq(live, Real, det, UniqX, UniqY, Uniq).
abstractly_unify_inst_3(live, ground(Uniq0, constrained_inst_var(Var)), free,
@@ -413,7 +415,7 @@
abstractly_unify_inst_3(dead, ground(UniqX, constrained_inst_var(Var)),
any(UniqY), Real, M, ground(Uniq, constrained_inst_var(Var)),
semidet, M) :-
- allow_unify_bound_any(Real), % AAA
+ allow_unify_bound_any(Real),
unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq).
abstractly_unify_inst_3(dead, ground(Uniq, constrained_inst_var(Var)), free,
--- ./mercury/compiler/instmap.m Fri Feb 11 10:45:01 2000
+++ .././mercury/compiler/instmap.m Thu Feb 17 12:40:32 2000
@@ -20,7 +20,7 @@
:- interface.
:- import_module hlds_module, prog_data, mode_info, (inst), mode_errors.
-:- import_module hlds_data.
+:- import_module hlds_data, hlds_pred.
:- import_module map, bool, set, list, assoc_list, std_util.
@@ -120,8 +120,8 @@
% the one to take IMA to IMB. However this predicate should
% transform more easily to the alias branch.
%
-:- pred instmap_changed_vars(instmap::in, instmap::in, module_info::in,
- set(prog_var)::out) is det.
+:- pred instmap_changed_vars(instmap::in, instmap::in, vartypes::in,
+ module_info::in, set(prog_var)::out) is det.
%-----------------------------------------------------------------------------%
@@ -250,8 +250,8 @@
% is true if none of the vars in the set Vars could have become more
% instantiated when InstmapDelta is applied to Instmap.
:- pred instmap__no_output_vars(instmap, instmap_delta, set(prog_var),
- module_info).
-:- mode instmap__no_output_vars(in, in, in, in) is semidet.
+ vartypes, module_info).
+:- mode instmap__no_output_vars(in, in, in, in, in) is semidet.
% merge_instmap_delta(InitialInstMap, NonLocals,
% InstMapDeltaA, InstMapDeltaB, ModuleInfo0, ModuleInfo)
@@ -396,23 +396,27 @@
%-----------------------------------------------------------------------------%
-instmap_changed_vars(InstMapA, InstMapB, ModuleInfo, ChangedVars) :-
+instmap_changed_vars(InstMapA, InstMapB, VarTypes, ModuleInfo, ChangedVars) :-
instmap__vars_list(InstMapB, VarsB),
- changed_vars_2(VarsB, InstMapA, InstMapB, ModuleInfo, ChangedVars).
+ changed_vars_2(VarsB, InstMapA, InstMapB, VarTypes, ModuleInfo,
+ ChangedVars).
-:- pred changed_vars_2(prog_vars::in, instmap::in,
- instmap::in, module_info::in, set(prog_var)::out) is det.
+:- pred changed_vars_2(prog_vars::in, instmap::in, instmap::in, vartypes::in,
+ module_info::in, set(prog_var)::out) is det.
-changed_vars_2([], _InstMapA, _InstMapB, _ModuleInfo, ChangedVars) :-
+changed_vars_2([], _InstMapA, _InstMapB, _Types, _ModuleInfo, ChangedVars) :-
set__init(ChangedVars).
-changed_vars_2([VarB|VarBs], InstMapA, InstMapB, ModuleInfo, ChangedVars) :-
- changed_vars_2(VarBs, InstMapA, InstMapB, ModuleInfo, ChangedVars0),
+changed_vars_2([VarB|VarBs], InstMapA, InstMapB, VarTypes, ModuleInfo,
+ ChangedVars) :-
+ changed_vars_2(VarBs, InstMapA, InstMapB, VarTypes, ModuleInfo,
+ ChangedVars0),
instmap__lookup_var(InstMapA, VarB, InitialInst),
instmap__lookup_var(InstMapB, VarB, FinalInst),
+ map__lookup(VarTypes, VarB, Type),
(
- inst_matches_final(InitialInst, FinalInst, ModuleInfo)
+ inst_matches_final(InitialInst, FinalInst, Type, ModuleInfo)
->
ChangedVars = ChangedVars0
;
@@ -872,17 +876,18 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-instmap__no_output_vars(_, unreachable, _, _).
-instmap__no_output_vars(InstMap0, reachable(InstMapDelta), Vars, M) :-
+instmap__no_output_vars(_, unreachable, _, _, _).
+instmap__no_output_vars(InstMap0, reachable(InstMapDelta), Vars, VT, M) :-
set__to_sorted_list(Vars, VarList),
- instmap__no_output_vars_2(VarList, InstMap0, InstMapDelta, M).
+ instmap__no_output_vars_2(VarList, InstMap0, InstMapDelta, VT, M).
:- pred instmap__no_output_vars_2(list(prog_var), instmap, instmapping,
- module_info).
-:- mode instmap__no_output_vars_2(in, in, in, in) is semidet.
+ vartypes, module_info).
+:- mode instmap__no_output_vars_2(in, in, in, in, in) is semidet.
-instmap__no_output_vars_2([], _, _, _).
-instmap__no_output_vars_2([Var | Vars], InstMap0, InstMapDelta, ModuleInfo) :-
+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.
@@ -897,8 +902,10 @@
;
Inst = Inst0
),
- inst_matches_binding(Inst, Inst0, ModuleInfo),
- instmap__no_output_vars_2(Vars, InstMap0, InstMapDelta, ModuleInfo).
+ map__lookup(VarTypes, Var, Type),
+ inst_matches_binding(Inst, Inst0, Type, ModuleInfo),
+ instmap__no_output_vars_2(Vars, InstMap0, InstMapDelta, VarTypes,
+ ModuleInfo).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
--- ./mercury/compiler/make_hlds.m Fri Feb 11 10:45:09 2000
+++ .././mercury/compiler/make_hlds.m Fri Feb 18 16:04:06 2000
@@ -1699,7 +1699,7 @@
)
).
-:- pred mode_name_args(mode_defn, sym_name, list(inst_param), hlds_mode_body).
+:- pred mode_name_args(mode_defn, sym_name, list(inst_var), hlds_mode_body).
:- mode mode_name_args(in, out, out, out) is det.
mode_name_args(eqv_mode(Name, Args, Body), Name, Args, eqv_mode(Body)).
--- ./mercury/compiler/mercury_to_mercury.m Fri Feb 11 10:45:11 2000
+++ .././mercury/compiler/mercury_to_mercury.m Fri Feb 11 11:20:12 2000
@@ -688,7 +688,6 @@
mercury_output_tabs(Indent),
mercury_output_var(Var, VarSet, no),
io__write_string("\n")
- % AAA
;
{ GroundInstInfo = none},
mercury_output_uniqueness(Uniq, "ground"),
@@ -761,7 +760,6 @@
;
{ GroundInstInfo = constrained_inst_var(Var) },
mercury_output_var(Var, VarSet, no)
- % AAA
;
{ GroundInstInfo = none },
mercury_output_uniqueness(Uniq, "ground")
--- ./mercury/compiler/modes.m Fri Feb 11 10:45:20 2000
+++ .././mercury/compiler/modes.m Fri Feb 18 16:01:57 2000
@@ -614,9 +614,9 @@
ModuleInfo0),
{ NumErrors0 = 0 }
;
- { module_info_get_special_pred_map(ModuleInfo0,
- SpecialPredMap) },
- { map__member(SpecialPredMap, unify - _, PredId) }
+ { special_pred_name_arity(unify, _, PredName, Arity) },
+ { pred_info_name(PredInfo0, PredName) },
+ { pred_info_arity(PredInfo0, PredArity) }
->
% Don't check for indistinguishable modes in unification
% predicates. The default (in, in) mode must be
@@ -920,7 +920,10 @@
{ Changed = Changed0 }
; { Vars = [Var|Vars1], Insts = [Inst|Insts1],
VarInsts = [VarInst|VarInsts1] } ->
- ( { inst_matches_final(VarInst, Inst, ModuleInfo) } ->
+ =(ModeInfo),
+ { mode_info_get_var_types(ModeInfo, VarTypes) },
+ { map__lookup(VarTypes, Var, Type) },
+ ( { inst_matches_final(VarInst, Inst, Type, ModuleInfo) } ->
{ Changed1 = Changed0 }
;
{ Changed1 = yes },
@@ -932,9 +935,6 @@
;
% XXX this might need to be reconsidered now
% we have unique modes
- =(ModeInfo),
- { mode_info_get_var_types(ModeInfo, VarTypes) },
- { map__lookup(VarTypes, Var, Type) },
( { inst_matches_initial(VarInst, Inst,
Type, ModuleInfo) } ->
{ Reason = too_instantiated }
@@ -1965,7 +1965,9 @@
% lost some uniqueness, or bound part of the var.
% The call to inst_matches_binding will succeed
% only if we haven't bound any part of the var.
- inst_matches_binding(Inst, Inst0, ModuleInfo)
+ mode_info_get_var_types(ModeInfo1, VarTypes),
+ map__lookup(VarTypes, Var0, Type),
+ inst_matches_binding(Inst, Inst0, Type, ModuleInfo)
->
% We've just added some information
% or lost some uniqueness.
@@ -2024,12 +2026,15 @@
mode_info_get_module_info(ModeInfo0, ModuleInfo0),
inst_expand(ModuleInfo0, InitialInst0, InitialInst),
inst_expand(ModuleInfo0, VarInst0, VarInst1),
+
+ mode_info_get_var_types(ModeInfo0, VarTypes0),
+ map__lookup(VarTypes0, Var0, VarType),
(
% If the initial inst of the variable matches_final
% the initial inst specified in the pred's mode declaration,
% then it's not a call to an implied mode, it's an exact
% match with a genuine mode.
- inst_matches_final(VarInst1, InitialInst, ModuleInfo0)
+ inst_matches_final(VarInst1, InitialInst, VarType, ModuleInfo0)
->
Var = Var0,
ExtraGoals = ExtraGoals0,
@@ -2056,9 +2061,6 @@
% XXX We ought to use a more elegant method
% XXX than hard-coding the name `<foo>_init_any'.
- mode_info_get_var_types(ModeInfo0, VarTypes0),
- map__lookup(VarTypes0, Var, VarType),
-
mode_info_get_context(ModeInfo0, Context),
mode_info_get_mode_context(ModeInfo0, ModeContext),
mode_context_to_unify_context(ModeContext, ModeInfo0,
@@ -2117,9 +2119,7 @@
% Introduce a new variable
mode_info_get_varset(ModeInfo0, VarSet0),
- mode_info_get_var_types(ModeInfo0, VarTypes0),
varset__new_var(VarSet0, Var, VarSet),
- map__lookup(VarTypes0, Var0, VarType),
map__set(VarTypes0, Var, VarType, VarTypes),
mode_info_set_varset(VarSet, ModeInfo0, ModeInfo1),
mode_info_set_var_types(VarTypes, ModeInfo1, ModeInfo),
--- ./mercury/compiler/mode_util.m Fri Feb 11 10:45:18 2000
+++ .././mercury/compiler/mode_util.m Fri Feb 18 16:04:23 2000
@@ -681,7 +681,7 @@
).
propagate_ctor_info(ground(Uniq, constrained_inst_var(Var)), _, _, _,
- ground(Uniq, constrained_inst_var(Var))). % AAA
+ ground(Uniq, constrained_inst_var(Var))).
propagate_ctor_info(not_reached, _Type, _Constructors, _ModuleInfo,
not_reached).
propagate_ctor_info(inst_var(V), _, _, _, inst_var(V)).
@@ -749,7 +749,7 @@
Modes = Modes0
).
propagate_ctor_info_lazily(ground(Uniq, constrained_inst_var(Var)), _, _, _,
- ground(Uniq, constrained_inst_var(Var))). % AAA
+ ground(Uniq, constrained_inst_var(Var))).
propagate_ctor_info_lazily(not_reached, _Type, _, _ModuleInfo, not_reached).
propagate_ctor_info_lazily(inst_var(Var), _, _, _, inst_var(Var)).
propagate_ctor_info_lazily(abstract_inst(Name, Args), _, _, _,
@@ -893,7 +893,7 @@
%-----------------------------------------------------------------------------%
-:- pred inst_lookup_subst_args(hlds_inst_body, list(inst_param), sym_name,
+:- pred inst_lookup_subst_args(hlds_inst_body, list(inst_var), sym_name,
list(inst), inst).
:- mode inst_lookup_subst_args(in, in, in, in, out) is det.
@@ -934,7 +934,7 @@
% occurrences of Params in Mode0 with the corresponding
% value in Args.
-:- pred mode_substitute_arg_list(mode, list(inst_param), list(inst), mode).
+:- pred mode_substitute_arg_list(mode, list(inst_var), list(inst), mode).
:- mode mode_substitute_arg_list(in, in, in, out) is det.
mode_substitute_arg_list(Mode0, Params, Args, Mode) :-
@@ -950,7 +950,7 @@
% occurrences of Params in Inst0 with the corresponding
% value in Args.
-:- pred inst_substitute_arg_list(inst, list(inst_param), list(inst), inst).
+:- pred inst_substitute_arg_list(inst, list(inst_var), list(inst), inst).
:- mode inst_substitute_arg_list(in, in, in, out) is det.
inst_substitute_arg_list(Inst0, Params, Args, Inst) :-
@@ -992,10 +992,8 @@
inst_apply_substitution(any(Uniq), _, any(Uniq)).
inst_apply_substitution(free, _, free).
inst_apply_substitution(free(T), _, free(T)).
-inst_apply_substitution(ground(Uniq, GroundInstInfo0), Subst,
- ground(Uniq, GroundInstInfo)) :-
- ground_inst_info_apply_substitution(GroundInstInfo0, Subst, Uniq,
- GroundInstInfo).
+inst_apply_substitution(ground(Uniq, GroundInstInfo0), Subst, Inst) :-
+ ground_inst_info_apply_substitution(GroundInstInfo0, Subst, Uniq, Inst).
inst_apply_substitution(bound(Uniq, Alts0), Subst, bound(Uniq, Alts)) :-
alt_list_apply_substitution(Alts0, Subst, Alts).
inst_apply_substitution(not_reached, _, not_reached).
@@ -1018,6 +1016,10 @@
abstract_inst(Name, Args)) :-
inst_list_apply_substitution(Args0, Subst, Args).
+ % This predicate fails if the inst_name is not one of user_inst,
+ % typed_inst or typed_ground. The other types of inst_names are just
+ % used as keys in the inst_table so it does not make sense to apply
+ % substitutions to them.
:- pred inst_name_apply_substitution(inst_name, inst_var_sub, inst_name).
:- mode inst_name_apply_substitution(in, in, out) is semidet.
@@ -1041,27 +1043,22 @@
alt_list_apply_substitution(Alts0, Subst, Alts).
:- pred ground_inst_info_apply_substitution(ground_inst_info, inst_var_sub,
- uniqueness, ground_inst_info).
+ uniqueness, inst).
:- mode ground_inst_info_apply_substitution(in, in, in, out) is det.
-ground_inst_info_apply_substitution(none, _, _, none).
-ground_inst_info_apply_substitution(
- higher_order(pred_inst_info(PredOrFunc, Modes0, Det)), Subst,
- _, higher_order(pred_inst_info(PredOrFunc, Modes, Det))) :-
- mode_list_apply_substitution(Modes0, Subst, Modes).
+ground_inst_info_apply_substitution(none, _, Uniq, ground(Uniq, none)).
+ground_inst_info_apply_substitution(GII0, Subst, Uniq, ground(Uniq, GII)) :-
+ GII0 = higher_order(pred_inst_info(PredOrFunc, Modes0, Det)),
+ mode_list_apply_substitution(Modes0, Subst, Modes),
+ GII = higher_order(pred_inst_info(PredOrFunc, Modes, Det)).
ground_inst_info_apply_substitution(constrained_inst_var(Var), Subst, Uniq,
- Result) :-
+ Inst) :-
(
- map__search(Subst, Var, Replacement)
+ map__search(Subst, Var, Inst0)
->
- ( Replacement = ground(Uniq, GroundInstInfo) ->
- Result = GroundInstInfo
- ;
- error("ground_inst_info_apply_substitution")
- % AAA
- )
+ Inst = Inst0
;
- Result = constrained_inst_var(Var)
+ Inst = ground(Uniq, constrained_inst_var(Var))
).
% mode_list_apply_substitution(Modes0, Subst, Modes) is true
@@ -1221,6 +1218,9 @@
inst_varset :: inst_varset
).
+ % lift(P, R, RI0, RI) will call predicate P, passing it the
+ % module_info from RI0 and placing the output module_info in
+ % RI. The output of P's first argument is returned in R.
:- pred lift(pred(T, module_info, module_info), T, recompute_info,
recompute_info).
:- mode lift(pred(out, in, out) is det, out, in, out) is det.
@@ -1445,28 +1445,37 @@
ArgModes0, ArgModes1) },
{ mode_list_get_initial_insts(ArgModes1, ModuleInfo,
InitialInsts) },
+
+ % Compute the inst_var substitution from the initial insts
+ % of the called procedure and the insts of the argument
+ % variables.
{ map__init(InstVarSub0) },
- lift(recompute_instmap_delta_call_1(Args, VarTypes, InstMap,
+ lift(compute_inst_var_sub(Args, VarTypes, InstMap,
InitialInsts, InstVarSub0), InstVarSub),
+ % Apply the inst_var substitution to the argument modes.
{ mode_list_apply_substitution(ArgModes1, InstVarSub,
ArgModes2) },
+
+ % Calculate the final insts of the argument variables
+ % from their initial insts and the final insts of called
+ % procedure (with inst_var substitutions applied.
lift(recompute_instmap_delta_call_2(Args, InstMap,
ArgModes2), ArgModes),
{ instmap_delta_from_mode_list(Args, ArgModes,
ModuleInfo, InstMapDelta) }
).
-:- pred recompute_instmap_delta_call_1(list(prog_var), vartypes, instmap,
+:- pred compute_inst_var_sub(list(prog_var), vartypes, instmap,
list(inst), inst_var_sub, inst_var_sub, module_info, module_info).
-:- mode recompute_instmap_delta_call_1(in, in, in, in, in, out, in, out) is det.
+:- mode compute_inst_var_sub(in, in, in, in, in, out, in, out) is det.
-recompute_instmap_delta_call_1([], _, _, [], Sub, Sub, ModuleInfo, ModuleInfo).
-recompute_instmap_delta_call_1([_|_], _, _, [], _, _, _, _) :-
- error("recompute_instmap_delta_call_1").
-recompute_instmap_delta_call_1([], _, _, [_|_], _, _, _, _) :-
- error("recompute_instmap_delta_call_1").
-recompute_instmap_delta_call_1([Arg | Args], VarTypes, InstMap, [Inst | Insts],
+compute_inst_var_sub([], _, _, [], Sub, Sub, ModuleInfo, ModuleInfo).
+compute_inst_var_sub([_|_], _, _, [], _, _, _, _) :-
+ error("compute_inst_var_sub").
+compute_inst_var_sub([], _, _, [_|_], _, _, _, _) :-
+ error("compute_inst_var_sub").
+compute_inst_var_sub([Arg | Args], VarTypes, InstMap, [Inst | Insts],
Sub0, Sub, ModuleInfo0, ModuleInfo) :-
% This is similar to modecheck_var_has_inst.
( instmap__is_reachable(InstMap) ->
@@ -1479,15 +1488,13 @@
ModuleInfo2 = ModuleInfo1,
Sub2 = Sub1
;
- % AAA error("recompute_instmap_delta_call_1: inst_matches_initial failed")
- ModuleInfo2 = ModuleInfo0,
- Sub2 = Sub0
+ error("compute_inst_var_sub: inst_matches_initial failed")
)
;
ModuleInfo2 = ModuleInfo0,
Sub2 = Sub0
),
- recompute_instmap_delta_call_1(Args, VarTypes, InstMap, Insts, Sub2,
+ compute_inst_var_sub(Args, VarTypes, InstMap, Insts, Sub2,
Sub, ModuleInfo2, ModuleInfo).
:- pred recompute_instmap_delta_call_2(list(prog_var), instmap, list(mode),
--- ./mercury/compiler/modecheck_call.m Fri Feb 11 10:45:18 2000
+++ .././mercury/compiler/modecheck_call.m Fri Feb 18 15:23:40 2000
@@ -732,7 +732,7 @@
compare_inst_list_2([], [], _, [], same, _).
compare_inst_list_2([InstA | InstsA], [InstB | InstsB],
- std_util:no, [Type | Types], Result, ModuleInfo) :-
+ no, [Type | Types], Result, ModuleInfo) :-
compare_inst(InstA, InstB, no, Type, Result0, ModuleInfo),
compare_inst_list_2(InstsA, InstsB, no, Types, Result1, ModuleInfo),
combine_results(Result0, Result1, Result).
@@ -852,14 +852,16 @@
;
MaybeArgInst = yes(ArgInst),
(
- inst_matches_final(ArgInst, InstA, ModuleInfo)
+ inst_matches_final(ArgInst, InstA, Type,
+ ModuleInfo)
->
Arg_mf_A = yes
;
Arg_mf_A = no
),
(
- inst_matches_final(ArgInst, InstB, ModuleInfo)
+ inst_matches_final(ArgInst, InstB, Type,
+ ModuleInfo)
->
Arg_mf_B = yes
;
@@ -877,12 +879,12 @@
% or comparing with the arg inst doesn't help,
% then compare the two proc insts
%
- ( inst_matches_final(InstA, InstB, ModuleInfo) ->
+ ( inst_matches_final(InstA, InstB, Type, ModuleInfo) ->
A_mf_B = yes
;
A_mf_B = no
),
- ( inst_matches_final(InstB, InstA, ModuleInfo) ->
+ ( inst_matches_final(InstB, InstA, Type, ModuleInfo) ->
B_mf_A = yes
;
B_mf_A = no
--- ./mercury/compiler/pd_util.m Fri Feb 11 10:45:25 2000
+++ .././mercury/compiler/pd_util.m Thu Feb 17 15:05:52 2000
@@ -151,15 +151,15 @@
pd_info_get_module_info(ModuleInfo0),
{ module_info_globals(ModuleInfo0, Globals) },
pd_info_get_pred_proc_id(proc(PredId, ProcId)),
- { det_info_init(ModuleInfo0, PredId, ProcId,
+ { proc_info_vartypes(ProcInfo0, VarTypes0) },
+ { det_info_init(ModuleInfo0, VarTypes0, PredId, ProcId,
Globals, DetInfo0) },
pd_info_get_instmap(InstMap0),
pd_info_get_proc_info(ProcInfo0),
{ proc_info_varset(ProcInfo0, VarSet0) },
- { proc_info_vartypes(ProcInfo0, VarTypes0) },
{ proc_info_inst_varset(ProcInfo0, InstVarSet0) },
{ simplify_info_init(DetInfo0, Simplifications, InstMap0,
- VarSet0, VarTypes0, InstVarSet0, SimplifyInfo0) },
+ VarSet0, InstVarSet0, SimplifyInfo0) },
{ simplify__process_goal(Goal0, Goal, SimplifyInfo0, SimplifyInfo) },
--- ./mercury/compiler/prog_data.m Fri Feb 11 10:45:28 2000
+++ .././mercury/compiler/prog_data.m Fri Feb 18 16:04:26 2000
@@ -694,11 +694,8 @@
% inst_defn/3 defined above
:- type inst_defn
- ---> eqv_inst(sym_name, list(inst_param), inst)
- ; abstract_inst(sym_name, list(inst_param)).
-
- % probably inst parameters should be variables not terms
-:- type inst_param == inst_var.
+ ---> eqv_inst(sym_name, list(inst_var), inst)
+ ; abstract_inst(sym_name, list(inst_var)).
% An `inst_name' is used as a key for the inst_table.
% It is either a user-defined inst `user_inst(Name, Args)',
@@ -759,7 +756,7 @@
% mode_defn/3 defined above
:- type mode_defn
- ---> eqv_mode(sym_name, list(inst_param), mode).
+ ---> eqv_mode(sym_name, list(inst_var), mode).
:- type (mode)
---> ((inst) -> (inst))
--- ./mercury/compiler/simplify.m Fri Feb 11 10:45:37 2000
+++ .././mercury/compiler/simplify.m Thu Feb 17 15:17:51 2000
@@ -151,15 +151,16 @@
simplify__proc_2(Simplifications, PredId, ProcId, ModuleInfo0, ModuleInfo,
ProcInfo0, ProcInfo, Msgs) :-
module_info_globals(ModuleInfo0, Globals),
- det_info_init(ModuleInfo0, PredId, ProcId, Globals, DetInfo0),
+ proc_info_vartypes(ProcInfo0, VarTypes0),
+ det_info_init(ModuleInfo0, VarTypes0, PredId, ProcId, Globals,
+ DetInfo0),
proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap0),
proc_info_varset(ProcInfo0, VarSet0),
- proc_info_vartypes(ProcInfo0, VarTypes0),
proc_info_inst_varset(ProcInfo0, InstVarSet0),
proc_info_goal(ProcInfo0, Goal0),
simplify_info_init(DetInfo0, Simplifications, InstMap0,
- VarSet0, VarTypes0, InstVarSet0, Info0),
+ VarSet0, InstVarSet0, Info0),
simplify__process_goal(Goal0, Goal, Info0, Info),
simplify_info_get_varset(Info, VarSet),
@@ -1859,7 +1860,6 @@
% Info about common subexpressions.
instmap :: instmap,
varset :: prog_varset,
- var_types :: map(prog_var, type),
inst_varset :: inst_varset,
requantify :: bool,
% Does the goal need requantification.
@@ -1878,12 +1878,12 @@
).
simplify_info_init(DetInfo, Simplifications0, InstMap,
- VarSet, VarTypes, InstVarSet, Info) :-
+ VarSet, InstVarSet, Info) :-
common_info_init(CommonInfo),
set__init(Msgs),
set__list_to_set(Simplifications0, Simplifications),
Info = simplify_info(DetInfo, Msgs, Simplifications, CommonInfo,
- InstMap, VarSet, VarTypes, InstVarSet, no, no, no, 0, 0).
+ InstMap, VarSet, InstVarSet, no, no, no, 0, 0).
% Reinitialise the simplify_info before reprocessing a goal.
:- pred simplify_info_reinit(set(simplification)::in, instmap::in,
@@ -1906,8 +1906,8 @@
:- import_module set.
:- pred simplify_info_init(det_info, list(simplification), instmap,
- prog_varset, map(prog_var, type), inst_varset, simplify_info).
-:- mode simplify_info_init(in, in, in, in, in, in, out) is det.
+ prog_varset, inst_varset, simplify_info).
+:- mode simplify_info_init(in, in, in, in, in, out) is det.
:- pred simplify_info_get_det_info(simplify_info::in, det_info::out) is det.
:- pred simplify_info_get_msgs(simplify_info::in, set(det_msg)::out) is det.
@@ -1935,7 +1935,7 @@
simplify_info_get_common_info(Info, Info^common_info).
simplify_info_get_instmap(Info, Info^instmap).
simplify_info_get_varset(Info, Info^varset).
-simplify_info_get_var_types(Info, Info^var_types).
+simplify_info_get_var_types(Info, Info^det_info^vartypes).
simplify_info_requantify(Info) :- Info^requantify = yes.
simplify_info_recompute_atomic(Info) :- Info^recompute_atomic = yes.
simplify_info_rerun_det(Info) :- Info^rerun_det = yes.
@@ -1993,7 +1993,8 @@
simplify_info_set_instmap(Info, InstMap, Info^instmap := InstMap).
simplify_info_set_common_info(Info, Common, Info^common_info := Common).
simplify_info_set_varset(Info, VarSet, Info^varset := VarSet).
-simplify_info_set_var_types(Info, VarTypes, Info^var_types := VarTypes).
+simplify_info_set_var_types(Info, VarTypes,
+ Info^det_info^vartypes := VarTypes).
simplify_info_set_requantify(Info, Info^requantify := yes).
simplify_info_set_recompute_atomic(Info, Info^recompute_atomic := yes).
simplify_info_set_rerun_det(Info, Info^rerun_det := yes).
--- ./mercury/compiler/special_pred.m Fri Feb 11 10:45:37 2000
+++ .././mercury/compiler/special_pred.m Mon Feb 21 12:03:45 2000
@@ -27,6 +27,11 @@
; index
; compare.
+ % This predicate always returns determinism `semidet' for
+ % unification procedures. For types with only one value, the
+ % unification is actually `det', however we need to pretend it
+ % is `semidet' so that it can be called correctly from the
+ % polymorphic `unify' procedure.
:- pred special_pred_info(special_pred_id, type, string, list(type),
list(mode), determinism).
:- mode special_pred_info(in, in, out, out, out, out) is det.
@@ -67,11 +72,6 @@
% mode num for special procs is always 0 (the first mode)
special_pred_mode_num(_, 0).
- % XXX If the type has only one value, the determinism should be `det'.
- % However, this predicate is called by make_hlds before all the type
- % information is available, so we can't check that here.
- % There is a pass over the unify preds at the end of make_hlds to
- % fix up the determinism.
special_pred_info(unify, Type, "__Unify__", [Type, Type], [In, In], semidet) :-
in_mode(In).
--- ./mercury/compiler/type_util.m Fri Feb 11 10:45:45 2000
+++ .././mercury/compiler/type_util.m Mon Feb 21 16:23:25 2000
@@ -168,11 +168,13 @@
% Work out the types of the arguments of a functor.
% Aborts if the functor is existentially typed.
+ % The cons_id is expected to be un-module-qualified.
:- pred type_util__get_cons_id_arg_types(module_info::in, (type)::in,
cons_id::in, list(type)::out) is det.
% The same as type_util__get_cons_id_arg_types except that the
% cons_id is output non-deterministically.
+ % The cons_id is not module-qualified.
:- pred type_util__cons_id_arg_types(module_info::in, (type)::in,
cons_id::out, list(type)::out) is nondet.
@@ -669,13 +671,14 @@
ConsId, TypeDefn, ConsDefn),
ConsDefn = hlds_cons_defn(ExistQVars0, _Constraints0,
ArgTypes0, _, _),
- ArgTypes0 \= [],
-
- % XXX handle ExistQVars
- ExistQVars0 = []
+ ArgTypes0 \= []
->
hlds_data__get_type_defn_tparams(TypeDefn, TypeDefnParams),
term__term_list_to_var_list(TypeDefnParams, TypeDefnVars),
+
+ % XXX handle ExistQVars
+ require(unify(ExistQVars0, []),
+ "type_util__get_cons_id_arg_types: existentially typed cons_id"),
map__from_corresponding_lists(TypeDefnVars, TypeArgs, TSubst),
term__apply_substitution_to_list(ArgTypes0, TSubst, ArgTypes)
--- ./mercury/compiler/unique_modes.m Fri Feb 11 10:45:50 2000
+++ .././mercury/compiler/unique_modes.m Wed Feb 16 14:22:11 2000
@@ -196,10 +196,12 @@
mode_info_get_module_info(ModeInfo, ModuleInfo),
mode_info_get_instmap(ModeInfo, InstMap0),
instmap__lookup_var(InstMap0, Var, Inst0),
+ mode_info_get_var_types(ModeInfo, VarTypes),
+ map__lookup(VarTypes, Var, Type),
(
instmap_delta_is_reachable(DeltaInstMap),
instmap_delta_search_var(DeltaInstMap, Var, Inst),
- \+ inst_matches_final(Inst, Inst0, ModuleInfo)
+ \+ inst_matches_final(Inst, Inst0, Type, ModuleInfo)
->
ChangedVars = [Var | ChangedVars1],
select_changed_inst_vars(Vars, DeltaInstMap, ModeInfo,
--- ./mercury/compiler/unused_args.m Fri Feb 11 10:45:51 2000
+++ .././mercury/compiler/unused_args.m Wed Feb 16 16:40:51 2000
@@ -252,7 +252,7 @@
proc_info_vartypes(ProcInfo, VarTypes),
map__keys(VarTypes, Vars),
initialise_vardep(VarDep0, Vars, VarDep1),
- setup_output_args(ModuleInfo, HeadVars,
+ setup_output_args(VarTypes, ModuleInfo, HeadVars,
ArgModes, VarDep1, VarDep2),
module_info_globals(ModuleInfo, Globals),
@@ -275,7 +275,8 @@
),
proc_info_goal(ProcInfo, Goal - _),
- traverse_goal(ModuleInfo, Goal, VarDep3, VarDep),
+ Info = traverse_info(ModuleInfo, VarTypes),
+ traverse_goal(Info, Goal, VarDep3, VarDep),
map__set(VarUsage0, proc(PredId, ProcId), VarDep, VarUsage1),
PredProcs1 = [proc(PredId, ProcId) | PredProcs0],
OptProcs1 = OptProcs0
@@ -327,10 +328,10 @@
% Get output arguments for a procedure given the headvars and the
% argument modes, and set them as used.
-:- pred setup_output_args(module_info::in, list(prog_var)::in, list(mode)::in,
- var_dep::in, var_dep::out) is det.
+:- pred setup_output_args(vartypes::in, module_info::in, list(prog_var)::in,
+ list(mode)::in, var_dep::in, var_dep::out) is det.
-setup_output_args(ModuleInfo, HVars, ArgModes, VarDep0, VarDep) :-
+setup_output_args(VarTypes, ModuleInfo, HVars, ArgModes, VarDep0, VarDep) :-
(
HVars = [Var | Vars], ArgModes = [Mode | Modes]
->
@@ -338,13 +339,15 @@
% Any argument which has its instantiatedness
% changed by the predicate is used.
mode_get_insts(ModuleInfo, Mode, Inst1, Inst2),
- \+ inst_matches_binding(Inst1, Inst2, ModuleInfo)
+ map__lookup(VarTypes, Var, Type),
+ \+ inst_matches_binding(Inst1, Inst2, Type, ModuleInfo)
->
set_var_used(VarDep0, Var, VarDep1)
;
VarDep1 = VarDep0
),
- setup_output_args(ModuleInfo, Vars, Modes, VarDep1, VarDep)
+ setup_output_args(VarTypes, ModuleInfo, Vars, Modes, VarDep1,
+ VarDep)
;
HVars = [], ArgModes = []
->
@@ -407,49 +410,56 @@
% Traversal of goal structure, building up dependencies for all
% variables.
-:- pred traverse_goal(module_info::in, hlds_goal_expr::in,
+:- type traverse_info
+ ---> traverse_info(
+ module_info :: module_info,
+ vartypes :: vartypes
+ ).
+
+:- pred traverse_goal(traverse_info::in, hlds_goal_expr::in,
var_dep::in, var_dep::out) is det.
% handle conjunction
-traverse_goal(ModuleInfo, conj(Goals), UseInf0, UseInf) :-
- traverse_list_of_goals(ModuleInfo, Goals, UseInf0, UseInf).
+traverse_goal(Info, conj(Goals), UseInf0, UseInf) :-
+ traverse_list_of_goals(Info, Goals, UseInf0, UseInf).
% handle parallel conjunction
-traverse_goal(ModuleInfo, par_conj(Goals, _SM), UseInf0, UseInf) :-
- traverse_list_of_goals(ModuleInfo, Goals, UseInf0, UseInf).
+traverse_goal(Info, par_conj(Goals, _SM), UseInf0, UseInf) :-
+ traverse_list_of_goals(Info, Goals, UseInf0, UseInf).
% handle disjunction
-traverse_goal(ModuleInfo, disj(Goals, _), UseInf0, UseInf) :-
- traverse_list_of_goals(ModuleInfo, Goals, UseInf0, UseInf).
+traverse_goal(Info, disj(Goals, _), UseInf0, UseInf) :-
+ traverse_list_of_goals(Info, Goals, UseInf0, UseInf).
% handle switch
-traverse_goal(ModuleInfo, switch(Var, _, Cases, _), UseInf0, UseInf) :-
+traverse_goal(Info, switch(Var, _, Cases, _), UseInf0, UseInf) :-
set_var_used(UseInf0, Var, UseInf1),
list_case_to_list_goal(Cases, Goals),
- traverse_list_of_goals(ModuleInfo, Goals, UseInf1, UseInf).
+ traverse_list_of_goals(Info, Goals, UseInf1, UseInf).
% handle predicate call
-traverse_goal(ModuleInfo, call(PredId, ProcId, Args, _, _, _),
+traverse_goal(Info, call(PredId, ProcId, Args, _, _, _),
UseInf0, UseInf) :-
- module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _Pred, Proc),
+ module_info_pred_proc_info(Info^module_info, PredId, ProcId, _Pred,
+ Proc),
proc_info_headvars(Proc, HeadVars),
add_pred_call_arg_dep(proc(PredId, ProcId), Args, HeadVars,
UseInf0, UseInf).
% handle if then else
-traverse_goal(ModuleInfo, if_then_else(_, Cond - _, Then - _, Else - _, _),
+traverse_goal(Info, if_then_else(_, Cond - _, Then - _, Else - _, _),
UseInf0, UseInf) :-
- traverse_goal(ModuleInfo, Cond, UseInf0, UseInf1),
- traverse_goal(ModuleInfo, Then, UseInf1, UseInf2),
- traverse_goal(ModuleInfo, Else, UseInf2, UseInf).
+ traverse_goal(Info, Cond, UseInf0, UseInf1),
+ traverse_goal(Info, Then, UseInf1, UseInf2),
+ traverse_goal(Info, Else, UseInf2, UseInf).
% handle negation
-traverse_goal(ModuleInfo, not(Goal - _), UseInf0, UseInf) :-
- traverse_goal(ModuleInfo, Goal, UseInf0, UseInf).
+traverse_goal(Info, not(Goal - _), UseInf0, UseInf) :-
+ traverse_goal(Info, Goal, UseInf0, UseInf).
% handle quantification
-traverse_goal(ModuleInfo, some(_, _, Goal - _), UseInf0, UseInf) :-
- traverse_goal(ModuleInfo, Goal, UseInf0, UseInf).
+traverse_goal(Info, some(_, _, Goal - _), UseInf0, UseInf) :-
+ traverse_goal(Info, Goal, UseInf0, UseInf).
% we assume that higher-order predicate calls use all variables involved
traverse_goal(_, generic_call(GenericCall, Args, _, _), UseInf0, UseInf) :-
@@ -482,10 +492,10 @@
add_aliases(UseInf0, Var2, [Var1], UseInf)
).
-traverse_goal(ModuleInfo,
+traverse_goal(Info,
unify(Var1, _, _, deconstruct(_, _, Args, Modes, CanFail), _),
UseInf0, UseInf) :-
- partition_deconstruct_args(ModuleInfo, Args,
+ partition_deconstruct_args(Info, Args,
Modes, InputVars, OutputVars),
% The deconstructed variable is used if any of the
% variables, that the deconstruction binds are used.
@@ -564,23 +574,27 @@
% Partition the arguments to a deconstruction into inputs
% and outputs.
-:- pred partition_deconstruct_args(module_info::in, list(prog_var)::in,
+:- pred partition_deconstruct_args(traverse_info::in, list(prog_var)::in,
list(uni_mode)::in, list(prog_var)::out,
list(prog_var)::out) is det.
-partition_deconstruct_args(ModuleInfo, ArgVars, ArgModes,
- InputVars, OutputVars) :-
+partition_deconstruct_args(Info, ArgVars, ArgModes, InputVars, OutputVars) :-
(
ArgVars = [Var | Vars], ArgModes = [Mode | Modes]
->
- partition_deconstruct_args(ModuleInfo,
- Vars, Modes, InputVars1, OutputVars1),
+ partition_deconstruct_args(Info, Vars, Modes, InputVars1,
+ OutputVars1),
Mode = ((InitialInst1 - InitialInst2) ->
(FinalInst1 - FinalInst2)),
+ map__lookup(Info^vartypes, Var, Type),
+
% If the inst of the argument of the LHS is changed,
% the argument is input.
- ( inst_matches_binding(InitialInst1, FinalInst1, ModuleInfo) ->
+ (
+ inst_matches_binding(InitialInst1, FinalInst1,
+ Type, Info^module_info)
+ ->
InputVars = InputVars1
;
InputVars = [Var | InputVars1]
@@ -588,7 +602,10 @@
% If the inst of the argument of the RHS is changed,
% the argument is output.
- ( inst_matches_binding(InitialInst2, FinalInst2, ModuleInfo) ->
+ (
+ inst_matches_binding(InitialInst2, FinalInst2,
+ Type, Info^module_info)
+ ->
OutputVars = OutputVars1
;
OutputVars = [Var | OutputVars1]
@@ -627,13 +644,13 @@
list_case_to_list_goal(Cases, Goals).
-:- pred traverse_list_of_goals(module_info::in, list(hlds_goal)::in,
+:- pred traverse_list_of_goals(traverse_info::in, list(hlds_goal)::in,
var_dep::in, var_dep::out) is det.
traverse_list_of_goals(_, [], UseInf, UseInf).
-traverse_list_of_goals(ModuleInfo, [Goal - _ | Goals], UseInf0, UseInf) :-
- traverse_goal(ModuleInfo, Goal, UseInf0, UseInf1),
- traverse_list_of_goals(ModuleInfo, Goals, UseInf1, UseInf).
+traverse_list_of_goals(Info, [Goal - _ | Goals], UseInf0, UseInf) :-
+ traverse_goal(Info, Goal, UseInf0, UseInf1),
+ traverse_list_of_goals(Info, Goals, UseInf1, UseInf).
%-------------------------------------------------------------------------------
--- ./mercury/library/array.m Fri Feb 11 10:44:06 2000
+++ .././mercury/library/array.m Mon Feb 21 13:12:43 2000
@@ -93,30 +93,30 @@
% Note: in this implementation, the lower bound is always zero.
:- pred array__min(array(_T), int).
:- mode array__min(array_ui, out) is det.
-%:- mode array__min(in, out) is det.
+:- mode array__min(in, out) is det.
% array__max returns the upper bound of the array.
:- pred array__max(array(_T), int).
:- mode array__max(array_ui, out) is det.
-%:- mode array__max(in, out) is det.
+:- mode array__max(in, out) is det.
% array__size returns the length of the array,
% i.e. upper bound - lower bound + 1.
:- pred array__size(array(_T), int).
:- mode array__size(array_ui, out) is det.
-%:- mode array__size(in, out) is det.
+:- mode array__size(in, out) is det.
% array__bounds returns the upper and lower bounds of an array.
% Note: in this implementation, the lower bound is always zero.
:- pred array__bounds(array(_T), int, int).
:- mode array__bounds(array_ui, out, out) is det.
-%:- mode array__bounds(in, out, out) is det.
+:- mode array__bounds(in, out, out) is det.
% array__in_bounds checks whether an index is in the bounds
% of an array.
:- pred array__in_bounds(array(_T), int).
:- mode array__in_bounds(array_ui, in) is semidet.
-%:- mode array__in_bounds(in, in) is semidet.
+:- mode array__in_bounds(in, in) is semidet.
%-----------------------------------------------------------------------------%
@@ -124,13 +124,13 @@
% It is an error if the index is out of bounds.
:- pred array__lookup(array(T), int, T).
:- mode array__lookup(array_ui, in, out) is det.
-%:- mode array__lookup(in, in, out) is det.
+:- mode array__lookup(in, in, out) is det.
% array__semidet_lookup returns the Nth element of an array.
% It fails if the index is out of bounds.
:- pred array__semidet_lookup(array(T), int, T).
:- mode array__semidet_lookup(array_ui, in, out) is semidet.
-%:- mode array__semidet_lookup(in, in, out) is semidet.
+:- mode array__semidet_lookup(in, in, out) is semidet.
% array__set sets the nth element of an array, and returns the
% resulting array (good opportunity for destructive update ;-).
@@ -152,7 +152,7 @@
% It is an error if the index is out of bounds.
:- pred array__slow_set(array(T), int, T, array(T)).
:- mode array__slow_set(array_ui, in, in, array_uo) is det.
-%:- mode array__slow_set(in, in, in, array_uo) is det.
+:- mode array__slow_set(in, in, in, array_uo) is det.
% array__semidet_slow_set sets the nth element of an array,
% and returns the resulting array. The initial array is not
@@ -161,13 +161,13 @@
% It fails if the index is out of bounds.
:- pred array__semidet_slow_set(array(T), int, T, array(T)).
:- mode array__semidet_slow_set(array_ui, in, in, array_uo) is semidet.
-%:- mode array__semidet_slow_set(in, in, in, array_uo) is semidet.
+:- mode array__semidet_slow_set(in, in, in, array_uo) is semidet.
% array__copy(Array0, Array):
% Makes a new unique copy of an array.
:- pred array__copy(array(T), array(T)).
:- mode array__copy(array_ui, array_uo) is det.
-%:- mode array__copy(in, array_uo) is det.
+:- mode array__copy(in, array_uo) is det.
% array__resize(Array0, Size, Init, Array):
% The array is expanded or shrunk to make it fit
@@ -194,7 +194,7 @@
% occurred in the array.
:- pred array__to_list(array(T), list(T)).
:- mode array__to_list(array_ui, out) is det.
-%:- mode array__to_list(in, out) is det.
+:- mode array__to_list(in, out) is det.
% array__fetch_items takes an array and a lower and upper
% index, and places those items in the array between these
@@ -213,7 +213,7 @@
:- pred array__bsearch(array(T), T, pred(T, T, comparison_result),
maybe(int)).
:- mode array__bsearch(array_ui, in, pred(in, in, out) is det, out) is det.
-%:- mode array__bsearch(in, in, pred(in, in, out) is det, out) is det.
+:- mode array__bsearch(in, in, pred(in, in, out) is det, out) is det.
% array__map(Closure, OldArray, NewArray) applys `Closure' to
% each of the elements of `OldArray' to create `NewArray'.
@@ -321,8 +321,8 @@
% unify/2 for arrays
array_equal(Array1, Array2) :-
- array__size(inst_cast(Array1), Size),
- array__size(inst_cast(Array2), Size),
+ array__size(Array1, Size),
+ array__size(Array2, Size),
array__equal_elements(0, Size, Array1, Array2).
:- pred array__equal_elements(int, int, array(T), array(T)).
@@ -332,8 +332,8 @@
( N = Size ->
true
;
- array__lookup(inst_cast(Array1), N, Elem),
- array__lookup(inst_cast(Array2), N, Elem),
+ array__lookup(Array1, N, Elem),
+ array__lookup(Array2, N, Elem),
N1 is N + 1,
array__equal_elements(N1, Size, Array1, Array2)
).
@@ -341,8 +341,8 @@
% compare/3 for arrays
array_compare(Result, Array1, Array2) :-
- array__size(inst_cast(Array1), Size1),
- array__size(inst_cast(Array2), Size2),
+ array__size(Array1, Size1),
+ array__size(Array2, Size2),
compare(SizeResult, Size1, Size2),
( SizeResult = (=) ->
array__compare_elements(0, Size1, Array1, Array2, Result)
@@ -358,8 +358,8 @@
( N = Size ->
Result = (=)
;
- array__lookup(inst_cast(Array1), N, Elem1),
- array__lookup(inst_cast(Array2), N, Elem2),
+ array__lookup(Array1, N, Elem1),
+ array__lookup(Array2, N, Elem2),
compare(ElemResult, Elem1, Elem2),
( ElemResult = (=) ->
N1 is N + 1,
@@ -409,23 +409,20 @@
/* Array not used */
Min = 0;
").
-/*
:- pragma c_code(array__min(Array::in, Min::out),
[will_not_call_mercury, thread_safe], "
+ /* Array not used */
Min = 0;
").
-*/
:- pragma c_code(array__max(Array::array_ui, Max::out),
[will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size - 1;
").
-/*
:- pragma c_code(array__max(Array::in, Max::out),
[will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size - 1;
").
-*/
array__bounds(Array, Min, Max) :-
array__min(Array, Min),
@@ -437,12 +434,10 @@
[will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size;
").
-/*
:- pragma c_code(array__size(Array::in, Max::out),
[will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size;
").
-*/
%-----------------------------------------------------------------------------%
@@ -478,7 +473,6 @@
#endif
Item = array->elements[Index];
}").
-/*
:- pragma c_code(array__lookup(Array::in, Index::in, Item::out),
[will_not_call_mercury, thread_safe], "{
MR_ArrayType *array = (MR_ArrayType *)Array;
@@ -489,7 +483,6 @@
#endif
Item = array->elements[Index];
}").
-*/
%-----------------------------------------------------------------------------%
@@ -630,12 +623,10 @@
Array = (Word) ML_copy_array((MR_ArrayType *) Array0);
").
-/*
:- pragma c_code(array__copy(Array0::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "
Array = (Word) ML_copy_array((MR_ArrayType *) Array0);
").
-*/
%-----------------------------------------------------------------------------%
@@ -677,7 +668,7 @@
;
Low1 is Low + 1,
array__fetch_items(Array, Low1, High, List0),
- array__lookup(inst_cast(Array), Low, Item),
+ array__lookup(Array, Low, Item),
List = [Item|List0]
).
@@ -701,7 +692,7 @@
% If Width == 0, we may just have found our element.
% Do a Compare to check.
( Width = 0 ->
- array__lookup(inst_cast(Array), Lo, X),
+ array__lookup(Array, Lo, X),
( call(Compare, El, X, (=)) ->
Result = yes(Lo)
;
@@ -711,7 +702,7 @@
% Otherwise find the middle element of the range
% and check against that.
Mid is (Lo + Hi) >> 1, % `>> 1' is hand-optimized `div 2'.
- array__lookup(inst_cast(Array), Mid, XMid),
+ array__lookup(Array, Mid, XMid),
call(Compare, XMid, El, Comp),
( Comp = (<),
Mid1 is Mid + 1,
@@ -746,31 +737,14 @@
( N >= Size ->
NewArray = NewArray0
;
- array__lookup(inst_cast(OldArray), N, OldElem),
+ array__lookup(OldArray, N, OldElem),
Closure(OldElem, NewElem),
- array__set(inst_cast(NewArray0), N, NewElem, NewArray1),
+ array__set(NewArray0, N, NewElem, NewArray1),
array__map_2(N + 1, Size, Closure, OldArray,
NewArray1, NewArray)
).
%-----------------------------------------------------------------------------%
-
-:- interface.
-
-% XXX this function is necessary for bootstrapping. It, and all calls to
-% it, should be removed after the change to allow
-% inst_matches_initial(ground, bound) has bootstrapped.
-
-:- func inst_cast(array(T)) = array(T).
-:- mode inst_cast(in) = array_uo is det.
-
-:- implementation.
-
-:- pragma c_code(inst_cast(A0::in) = (A::array_uo),
- [will_not_call_mercury, thread_safe],
- "A = A0;").
-
-%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% Ralph Becket <rwab1 at cam.sri.com> 24/04/99
% Function forms added.
@@ -800,7 +774,7 @@
:- func array__slow_set(array(T), int, T) = array(T).
:- mode array__slow_set(array_ui, in, in) = array_uo is det.
-%:- mode array__slow_set(in, in, in) = array_uo is det.
+:- mode array__slow_set(in, in, in) = array_uo is det.
:- func array__copy(array(T)) = array(T).
:- mode array__copy(array_ui) = array_uo is det.
--- ./mercury/library/io.m Fri Feb 11 10:44:17 2000
+++ .././mercury/library/io.m Mon Feb 21 13:14:52 2000
@@ -2153,7 +2153,7 @@
io__write_array(Array) -->
io__write_string("array("),
- { array__to_list(array__inst_cast(Array), List) },
+ { array__to_list(Array, List) },
io__write(List),
io__write_string(")").
--- ./mercury/library/term.m Fri Feb 11 10:44:33 2000
+++ .././mercury/library/term.m Mon Feb 21 13:14:53 2000
@@ -632,7 +632,7 @@
has_type(Elem, ElemType),
same_type(List, [Elem]),
det_univ_to_type(Univ, Array),
- array__to_list(array__inst_cast(Array), List),
+ array__to_list(Array, List),
term__type_to_term(List, ArgsTerm).
:- pred same_type(T::unused, T::unused) is det.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list