for review: last call modulo constructors [2/3]
David Matthew Overton
dmo at students.cs.mu.OZ.AU
Mon Jun 22 16:32:14 AEST 1998
Index: compiler/inst_match.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inst_match.m,v
retrieving revision 1.34.2.10
diff -u -r1.34.2.10 inst_match.m
--- 1.34.2.10 1998/03/26 00:36:09
+++ inst_match.m 1998/06/22 01:02:56
@@ -158,6 +158,11 @@
:- pred inst_is_ground_or_any(inst, inst_table, module_info).
:- mode inst_is_ground_or_any(in, in, in) is semidet.
+ % succeed if the inst is fully ground and higher order
+ % (i.e. contains a pred_inst_info.
+:- pred inst_is_higher_order_ground(inst, inst_table, module_info).
+:- mode inst_is_higher_order_ground(in, in, in) is semidet.
+
% succeed if the inst is `mostly_unique' or `unique'
:- pred inst_is_mostly_unique(inst, inst_table, module_info).
:- mode inst_is_mostly_unique(in, in, in) is semidet.
@@ -220,6 +225,12 @@
:- pred inst_is_free(inst, inst_table, module_info).
:- mode inst_is_free(in, in, in) is semidet.
+:- pred inst_is_free_alias(inst, inst_table, module_info).
+:- mode inst_is_free_alias(in, in, in) is semidet.
+
+:- pred inst_contains_free_alias(inst, inst_table, module_info).
+:- mode inst_contains_free_alias(in, in, in) is semidet.
+
:- pred inst_list_is_free(list(inst), inst_table, module_info).
:- mode inst_list_is_free(in, in, in) is semidet.
@@ -310,14 +321,15 @@
inst_matches_initial_3(any(UniqA), any(UniqB), _, _, _) :-
unique_matches_initial(UniqA, UniqB).
-inst_matches_initial_3(any(_), free, _, _, _).
-inst_matches_initial_3(free, any(_), _, _, _).
-inst_matches_initial_3(free, free, _, _, _).
+inst_matches_initial_3(any(_), free(unique), _, _, _).
+inst_matches_initial_3(free(unique), any(_), _, _, _).
+inst_matches_initial_3(free(alias), free(alias), _, _, _). % AAA
+inst_matches_initial_3(free(unique), free(unique), _, _, _). % AAA
inst_matches_initial_3(bound(UniqA, ListA), any(UniqB), InstTable, ModuleInfo,
_) :-
unique_matches_initial(UniqA, UniqB),
bound_inst_list_matches_uniq(ListA, UniqB, InstTable, ModuleInfo).
-inst_matches_initial_3(bound(_Uniq, _List), free, _, _, _).
+inst_matches_initial_3(bound(_Uniq, _List), free(_), _, _, _).
inst_matches_initial_3(bound(UniqA, ListA), bound(UniqB, ListB),
InstTable, ModuleInfo, Expansions) :-
unique_matches_initial(UniqA, UniqB),
@@ -340,7 +352,7 @@
bound_inst_list_is_mostly_unique(List, InstTable, ModuleInfo).
inst_matches_initial_3(ground(UniqA, _PredInst), any(UniqB), _, _, _) :-
unique_matches_initial(UniqA, UniqB).
-inst_matches_initial_3(ground(_Uniq, _PredInst), free, _, _, _).
+inst_matches_initial_3(ground(_Uniq, _PredInst), free(_), _, _, _).
inst_matches_initial_3(ground(UniqA, _), bound(UniqB, List), InstTable,
ModuleInfo, _) :-
unique_matches_initial(UniqA, UniqB),
@@ -359,7 +371,7 @@
% Abstract insts aren't really supported.
error("inst_matches_initial(ground, abstract_inst) == ??").
inst_matches_initial_3(abstract_inst(_,_), any(shared), _, _, _).
-inst_matches_initial_3(abstract_inst(_,_), free, _, _, _).
+inst_matches_initial_3(abstract_inst(_,_), free(_), _, _, _).
inst_matches_initial_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
InstTable, ModuleInfo, Expansions) :-
inst_list_matches_initial(ArgsA, ArgsB, InstTable, ModuleInfo,
@@ -400,6 +412,14 @@
% aliasing in their argument_modes.
pred_inst_argmodes_matches(ModesA, ModesB, InstTable, ModuleInfo, Expansions).
+pred_inst_matches_2(pred_inst_info(PredOrFunc, ArgModesA, Det),
+ pred_inst_info(PredOrFunc, ArgModesB, Det),
+ InstTable, ModuleInfo, Expansions) :-
+ ArgModesA = argument_modes(_, ModesA),
+ ArgModesB = argument_modes(_, ModesB),
+ pred_inst_argmodes_matches(ModesA, ModesB, InstTable, ModuleInfo,
+ Expansions).
+
% pred_inst_matches_argmodes(ModesA, ModesB, ModuleInfo, Expansions):
% succeeds if the initial insts of ModesB specify at least as
% much information as, and the same binding as, the initial
@@ -562,13 +582,13 @@
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(unique), 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(free(Aliasing), free(Aliasing), _, _, _).
inst_matches_final_3(bound(UniqA, ListA), any(UniqB), InstTable, ModuleInfo,
_) :-
unique_matches_final(UniqA, UniqB),
@@ -687,7 +707,7 @@
:- 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(free(Aliasing), free(Aliasing), _, _, _).
inst_matches_binding_3(bound(_UniqA, ListA), bound(_UniqB, ListB), InstTable,
ModuleInfo, Expansions) :-
bound_inst_list_matches_binding(ListA, ListB, InstTable, ModuleInfo,
@@ -793,8 +813,8 @@
% or is a user-defined inst which is defined as `free'.
% Abstract insts must not be free.
-inst_is_free(free, _, _).
-inst_is_free(free(_Type), _, _).
+inst_is_free(free(_), _, _).
+inst_is_free(free(_, _), _, _).
inst_is_free(inst_var(_), _, _) :-
error("internal error: uninstantiated inst parameter").
inst_is_free(defined_inst(InstName), InstTable, ModuleInfo) :-
@@ -805,6 +825,51 @@
inst_key_table_lookup(IKT, Key, Inst),
inst_is_free(Inst, InstTable, ModuleInfo).
+ % inst_is_free_alias succeeds iff the inst passed is `free(alias)'
+ % or a user-defined inst which is defined as `free(alias)' or
+ % `alias(IK)' where `IK' points to a `free(alias)' inst in the IKT.
+
+inst_is_free_alias(free(alias), _, _).
+inst_is_free_alias(free(alias, _), _, _).
+inst_is_free_alias(inst_var(_), _, _) :-
+ error("internal error: uninstantiated inst parameter").
+inst_is_free_alias(defined_inst(InstName), InstTable, ModuleInfo) :-
+ inst_lookup(InstTable, ModuleInfo, InstName, Inst),
+ inst_is_free_alias(Inst, InstTable, ModuleInfo).
+inst_is_free_alias(alias(Key), InstTable, ModuleInfo) :-
+ inst_table_get_inst_key_table(InstTable, IKT),
+ inst_key_table_lookup(IKT, Key, Inst),
+ inst_is_free_alias(Inst, InstTable, ModuleInfo).
+
+ % inst_contains_free_alias succeeds iff the inst passed is free(alias)
+ % or is bound to a functor with an argument containing a free(alias).
+inst_contains_free_alias(Inst, InstTable, ModuleInfo) :-
+ set__init(Seen0),
+ inst_contains_free_alias_2(Inst, InstTable, ModuleInfo, Seen0).
+
+:- pred inst_contains_free_alias_2(inst, inst_table, module_info,
+ set(inst_name)).
+:- mode inst_contains_free_alias_2(in, in, in, in) is semidet.
+
+inst_contains_free_alias_2(free(alias), _, _, _).
+inst_contains_free_alias_2(free(alias, _), _, _, _).
+inst_contains_free_alias_2(inst_var(_), _, _, _) :-
+ error("internal error: uninstantiated inst parameter").
+inst_contains_free_alias_2(defined_inst(InstName), InstTable, ModuleInfo,
+ Seen0) :-
+ \+ set__member(InstName, Seen0),
+ inst_lookup(InstTable, ModuleInfo, InstName, Inst),
+ set__insert(Seen0, InstName, Seen1),
+ inst_contains_free_alias_2(Inst, InstTable, ModuleInfo, Seen1).
+inst_contains_free_alias_2(alias(Key), InstTable, ModuleInfo, Seen) :-
+ inst_table_get_inst_key_table(InstTable, IKT),
+ inst_key_table_lookup(IKT, Key, Inst),
+ inst_contains_free_alias_2(Inst, InstTable, ModuleInfo, Seen).
+inst_contains_free_alias_2(bound(_, BoundInsts), InstTable, ModuleInfo, Seen) :-
+ list__member(functor(_, ArgInsts), BoundInsts),
+ list__member(Inst, ArgInsts),
+ inst_contains_free_alias_2(Inst, InstTable, ModuleInfo, Seen).
+
% inst_is_bound succeeds iff the inst passed is not `free'
% or is a user-defined inst which is not defined as `free'.
% Abstract insts must be bound.
@@ -914,6 +979,21 @@
inst_key_table_lookup(IKT, Key, Inst),
inst_is_ground_or_any_2(Inst, InstTable, ModuleInfo, Expansions).
+ % inst_is_higher_order_ground succeeds iff the inst passed is `ground'
+ % or equivalent and has a pred_inst_info.
+
+inst_is_higher_order_ground(ground(_, yes(_PredInstInfo)), _, _).
+inst_is_higher_order_ground(inst_var(_), _, _) :-
+ error("internal error: uninstantiated inst parameter").
+inst_is_higher_order_ground(Inst, InstTable, ModuleInfo) :-
+ Inst = defined_inst(InstName),
+ inst_lookup(InstTable, ModuleInfo, InstName, Inst2),
+ inst_is_higher_order_ground(Inst2, InstTable, ModuleInfo).
+inst_is_higher_order_ground(alias(Key), InstTable, ModuleInfo) :-
+ inst_table_get_inst_key_table(InstTable, IKT),
+ inst_key_table_lookup(IKT, Key, Inst),
+ inst_is_higher_order_ground(Inst, InstTable, ModuleInfo).
+
% inst_is_unique succeeds iff the inst passed is unique
% or free. Abstract insts are not considered unique.
@@ -933,7 +1013,7 @@
bound_inst_list_has_property(inst_is_unique_2, List, InstTable,
ModuleInfo, Expansions).
inst_is_unique_2(any(unique), _, _, _).
-inst_is_unique_2(free, _, _, _).
+inst_is_unique_2(free(unique), _, _, _).
inst_is_unique_2(ground(unique, _), _, _, _).
inst_is_unique_2(inst_var(_), _, _, _) :-
error("internal error: uninstantiated inst parameter").
@@ -972,7 +1052,7 @@
ModuleInfo, Expansions).
inst_is_mostly_unique_2(any(unique), _, _, _).
inst_is_mostly_unique_2(any(mostly_unique), _, _, _).
-inst_is_mostly_unique_2(free, _, _, _).
+inst_is_mostly_unique_2(free(unique), _, _, _).
inst_is_mostly_unique_2(ground(unique, _), _, _, _).
inst_is_mostly_unique_2(ground(mostly_unique, _), _, _, _).
inst_is_mostly_unique_2(inst_var(_), _, _, _) :-
@@ -1013,7 +1093,7 @@
Expansions) :-
bound_inst_list_has_property(inst_is_not_partly_unique_2, List,
InstTable, ModuleInfo, Expansions).
-inst_is_not_partly_unique_2(free, _, _, _).
+inst_is_not_partly_unique_2(free(_), _, _, _).
inst_is_not_partly_unique_2(any(shared), _, _, _).
inst_is_not_partly_unique_2(ground(shared, _), _, _, _).
inst_is_not_partly_unique_2(inst_var(_), _, _, _) :-
@@ -1060,7 +1140,7 @@
InstTable, ModuleInfo, Expansions).
inst_is_not_fully_unique_2(any(shared), _, _, _).
inst_is_not_fully_unique_2(any(mostly_unique), _, _, _).
-inst_is_not_fully_unique_2(free, _, _, _).
+inst_is_not_fully_unique_2(free(_), _, _, _).
inst_is_not_fully_unique_2(ground(shared, _), _, _, _).
inst_is_not_fully_unique_2(ground(mostly_unique, _), _, _, _).
inst_is_not_fully_unique_2(inst_var(_), _, _, _) :-
@@ -1321,6 +1401,16 @@
Expansions, InstVar) :-
inst_list_contains_inst_var(ArgInsts, InstTable, ModuleInfo, Expansions,
InstVar).
+inst_contains_inst_var_2(ground(_Uniq, PredInstInfo), InstTable,
+ ModuleInfo, Expansions, InstVar) :-
+ PredInstInfo = yes(pred_inst_info(_PredOrFunc, ArgModes, _Det)),
+ ArgModes = argument_modes(_, Modes),
+ mode_list_contains_inst_var_2(Modes, InstTable, ModuleInfo, Expansions,
+ InstVar).
+inst_contains_inst_var_2(abstract_inst(_Name, ArgInsts), InstTable, ModuleInfo,
+ Expansions, InstVar) :-
+ inst_list_contains_inst_var(ArgInsts, InstTable, ModuleInfo, Expansions,
+ InstVar).
:- pred bound_inst_list_contains_inst_var(list(bound_inst), inst_table,
module_info, set(inst_name), inst_var).
Index: compiler/inst_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inst_util.m,v
retrieving revision 1.3.2.12
diff -u -r1.3.2.12 inst_util.m
--- 1.3.2.12 1998/03/26 00:36:23
+++ inst_util.m 1998/06/22 01:02:56
@@ -273,7 +273,7 @@
(
% free = alias(K) where alias(K) is ground
- InstA2 = free,
+ InstA2 = free(_),
inst_is_ground(InstB2, InstTable0, ModuleInfo0)
->
UI = UI0,
@@ -281,7 +281,7 @@
;
% alias(K) = free where alias(K) is ground
- InstB2 = free,
+ InstB2 = free(_),
inst_is_ground(InstA2, InstTable0, ModuleInfo0)
->
UI = UI0,
@@ -388,13 +388,13 @@
abstractly_unify_inst_3(live, Real, any(Uniq), Inst0, UI0, Inst, Det, UI) :-
make_any_inst(Inst0, live, Uniq, Real, UI0, Inst, Det, UI).
-abstractly_unify_inst_3(live, Real, free, any(UniqY), UI,
+abstractly_unify_inst_3(live, Real, free(_), any(UniqY), UI,
any(Uniq), det, UI) :-
unify_uniq(live, Real, det, unique, UniqY, Uniq).
% abstractly_unify_inst_3(live, _, free, free, _, _, _, _, _) :- fail.
-abstractly_unify_inst_3(live, Real, free, bound(UniqY, List0), UI0,
+abstractly_unify_inst_3(live, Real, free(_), bound(UniqY, List0), UI0,
bound(Uniq, List), det, UI) :-
unify_uniq(live, Real, det, unique, UniqY, Uniq),
@@ -411,7 +411,7 @@
List = List0, UI = UI0
).
-abstractly_unify_inst_3(live, Real, free, ground(UniqY, PredInst), UI,
+abstractly_unify_inst_3(live, Real, free(_), ground(UniqY, PredInst), UI,
ground(Uniq, PredInst), det, UI) :-
unify_uniq(live, Real, det, unique, UniqY, Uniq).
@@ -425,7 +425,7 @@
List, Det1, UI),
det_par_conjunction_detism(Det1, semidet, Det).
-abstractly_unify_inst_3(live, Real, bound(UniqY, List0), free, UI0,
+abstractly_unify_inst_3(live, Real, bound(UniqY, List0), free(_), UI0,
bound(Uniq, List), det, UI) :-
unify_uniq(live, Real, det, unique, UniqY, Uniq),
% since both are live, we must disallow free-free unifications
@@ -461,7 +461,7 @@
Real = fake_unify,
unify_uniq(live, Real, det, UniqX, UniqY, Uniq).
-abstractly_unify_inst_3(live, Real, ground(Uniq0, yes(PredInst)), free, UI,
+abstractly_unify_inst_3(live, Real, ground(Uniq0, yes(PredInst)), free(_), UI,
ground(Uniq, yes(PredInst)), det, UI) :-
unify_uniq(live, Real, det, unique, Uniq0, Uniq).
@@ -528,7 +528,7 @@
make_any_inst(Inst0, dead, Uniq, Real, UI0, Inst, Det, UI).
% YYY This looks right, but it wasn't on the main branch. Hmmm
-abstractly_unify_inst_3(dead, _Real, free, Inst, UI, Inst, det, UI).
+abstractly_unify_inst_3(dead, _Real, free(_), Inst, UI, Inst, det, UI).
abstractly_unify_inst_3(dead, Real, bound(UniqX, List0), any(UniqY), UI0,
bound(Uniq, List), Det, UI) :-
@@ -538,7 +538,7 @@
List, Det1, UI),
det_par_conjunction_detism(Det1, semidet, Det).
-abstractly_unify_inst_3(dead, Real, bound(UniqX, List), free, UI,
+abstractly_unify_inst_3(dead, Real, bound(UniqX, List), free(_), UI,
bound(Uniq, List), det, UI) :-
unify_uniq(dead, Real, det, UniqX, unique, Uniq).
@@ -576,7 +576,7 @@
allow_unify_bound_any(Real),
unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq).
-abstractly_unify_inst_3(dead, _Real, ground(Uniq, yes(PredInst)), free, UI,
+abstractly_unify_inst_3(dead, _Real, ground(Uniq, yes(PredInst)), free(_), UI,
ground(Uniq, yes(PredInst)), det, UI).
abstractly_unify_inst_3(dead, Real, ground(UniqA, yes(_)),
@@ -696,11 +696,14 @@
abstractly_unify_inst_functor_2(live, _, not_reached, _, _, _, UI,
not_reached, erroneous, UI).
-abstractly_unify_inst_functor_2(live, _Real, free, ConsId, Args, ArgLives, UI,
- bound(unique, [functor(ConsId, Args)]), det, UI) :-
- unify_inst_info_get_module_info(UI, M),
- unify_inst_info_get_inst_table(UI, InstTable),
- inst_list_is_ground_or_any_or_dead(Args, ArgLives, InstTable, M).
+abstractly_unify_inst_functor_2(live, _Real, free(_), ConsId, Args0, ArgLives,
+ UI0, bound(unique, [functor(ConsId, Args)]), det, UI) :-
+ unify_inst_info_get_module_info(UI0, M),
+ unify_inst_info_get_inst_table(UI0, InstTable0),
+ assoc_list__from_corresponding_lists(Args0, ArgLives, ArgsAndLives),
+ list__map_foldl(abstractly_unify_bound_inst_arg_with_free(M),
+ ArgsAndLives, Args, InstTable0, InstTable),
+ unify_inst_info_set_inst_table(UI0, InstTable, UI).
abstractly_unify_inst_functor_2(live, Real, bound(Uniq, ListX), ConsId, Args,
ArgLives, UI0, bound(Uniq, List), Det, UI) :-
@@ -732,8 +735,8 @@
abstractly_unify_inst_functor_2(dead, _, not_reached, _, _, _, UI,
not_reached, erroneous, UI).
-abstractly_unify_inst_functor_2(dead, _Real, free, ConsId, Args, _ArgLives, UI,
- bound(unique, [functor(ConsId, Args)]), det, UI).
+abstractly_unify_inst_functor_2(dead, _Real, free(_), ConsId, Args, _ArgLives,
+ UI, bound(unique, [functor(ConsId, Args)]), det, UI).
abstractly_unify_inst_functor_2(dead, Real, bound(Uniq, ListX), ConsId, Args,
_ArgLives, UI0, bound(Uniq, List), Det, UI) :-
@@ -863,6 +866,40 @@
det_par_conjunction_detism(Det1, Det2, Det).
%-----------------------------------------------------------------------------%
+
+:- pred abstractly_unify_bound_inst_arg_with_free(module_info,
+ pair(inst, is_live), inst, inst_table, inst_table).
+:- mode abstractly_unify_bound_inst_arg_with_free(in, in, out, in, out) is det.
+
+abstractly_unify_bound_inst_arg_with_free(_ModuleInfo, Inst - dead, Inst,
+ InstTable, InstTable).
+
+abstractly_unify_bound_inst_arg_with_free(ModuleInfo, Inst0 - live, Inst,
+ InstTable0, InstTable) :-
+ inst_expand_defined_inst(InstTable0, ModuleInfo, Inst0, Inst1),
+ ( inst_is_ground_or_any(Inst1, InstTable0, ModuleInfo) ->
+ Inst = Inst1,
+ InstTable = InstTable0
+ ; inst_is_free(Inst1, InstTable0, ModuleInfo) ->
+ (
+ Inst0 = alias(_),
+ inst_is_free_alias(Inst0, InstTable0, ModuleInfo)
+ ->
+ Inst = Inst1,
+ InstTable = InstTable0
+ ;
+ inst_table_get_inst_key_table(InstTable0, IKT0),
+ inst_key_table_add(IKT0, free(alias), IK, IKT),
+ inst_table_set_inst_key_table(InstTable0, IKT,
+ InstTable),
+ Inst = alias(IK)
+ )
+ ;
+ Inst = Inst0,
+ InstTable = InstTable0
+ ).
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred unify_uniq(is_live, unify_is_real, determinism, uniqueness, uniqueness,
@@ -1002,9 +1039,9 @@
make_ground_inst(any(Uniq0), IsLive, Uniq1, Real, UI, ground(Uniq, no),
semidet, UI) :-
unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq).
-make_ground_inst(free, IsLive, Uniq0, Real, UI, ground(Uniq, no), det, UI) :-
+make_ground_inst(free(_), IsLive, Uniq0, Real, UI, ground(Uniq, no), det, UI) :-
unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq).
-make_ground_inst(free(T), IsLive, Uniq0, Real, UI,
+make_ground_inst(free(_, T), IsLive, Uniq0, Real, UI,
defined_inst(typed_ground(Uniq, T)), det, UI) :-
unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq).
make_ground_inst(bound(Uniq0, BoundInsts0), IsLive, Uniq1, Real, UI0,
@@ -1134,15 +1171,16 @@
semidet, UI) :-
allow_unify_bound_any(Real),
unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq).
-make_any_inst(free, IsLive, Uniq0, Real, UI, any(Uniq), det, UI) :-
+make_any_inst(free(unique), IsLive, Uniq0, Real, UI, any(Uniq), det, UI) :-
unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq).
-make_any_inst(free(T), IsLive, Uniq, Real, UI,
+make_any_inst(free(unique, T), IsLive, Uniq, Real, UI,
defined_inst(Any), det, UI) :-
% The following is a round-about way of doing this
% unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq),
% Any = typed_any(Uniq, T).
% without the need for a `typed_any' inst.
- Any = typed_inst(T, unify_inst(IsLive, free, any(Uniq), Real)).
+ Any = typed_inst(T, unify_inst(IsLive, free(unique), any(Uniq),
+ Real)).
make_any_inst(bound(Uniq0, BoundInsts0), IsLive, Uniq1, Real, UI0,
bound(Uniq, BoundInsts), Det, UI) :-
allow_unify_bound_any(Real),
@@ -1313,10 +1351,10 @@
).
make_shared_inst(any(Uniq0), UI, any(Uniq), UI) :-
make_shared(Uniq0, Uniq).
-make_shared_inst(free, UI, free, UI) :-
+make_shared_inst(free(_), UI, free(_), UI) :-
% the caller should ensure that this never happens
error("make_shared_inst: cannot make shared version of `free'").
-make_shared_inst(free(T), UI, free(T), UI) :-
+make_shared_inst(free(_, T), UI, free(_, T), UI) :-
% 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), UI0, bound(Uniq, BoundInsts), UI) :-
@@ -1416,8 +1454,8 @@
make_mostly_uniq_inst_2(not_reached, UI, not_reached, UI).
make_mostly_uniq_inst_2(any(Uniq0), UI, any(Uniq), UI) :-
make_mostly_uniq(Uniq0, Uniq).
-make_mostly_uniq_inst_2(free, UI, free, UI).
-make_mostly_uniq_inst_2(free(T), UI, free(T), UI).
+make_mostly_uniq_inst_2(free(A), UI, free(A), UI).
+make_mostly_uniq_inst_2(free(A, T), UI, free(A, T), UI).
make_mostly_uniq_inst_2(bound(Uniq0, BoundInsts0), UI0,
bound(Uniq, BoundInsts), UI) :-
% XXX could improve efficiency by avoiding recursion here
@@ -1656,7 +1694,7 @@
inst_merge_3(any(UniqA), any(UniqB), InstTable, M, any(Uniq), InstTable, M) :-
merge_uniq(UniqA, UniqB, Uniq).
-inst_merge_3(any(Uniq), free, InstTable, M, any(Uniq), InstTable, M) :-
+inst_merge_3(any(Uniq), free(_), InstTable, M, any(Uniq), InstTable, M) :-
% we do not yet allow merge of any with free, except for clobbered anys
( Uniq = clobbered ; Uniq = mostly_clobbered ).
inst_merge_3(any(UniqA), bound(UniqB, ListB), InstTable, M, any(Uniq),
@@ -1676,7 +1714,7 @@
merge_uniq(UniqA, shared, Uniq),
% we do not yet allow merge of any with free, except for clobbered anys
( Uniq = clobbered ; Uniq = mostly_clobbered ).
-inst_merge_3(free, any(Uniq), InstTable, M, any(Uniq), InstTable, M) :-
+inst_merge_3(free(_), any(Uniq), InstTable, M, any(Uniq), InstTable, M) :-
% we do not yet allow merge of any with free, except for clobbered anys
( Uniq = clobbered ; Uniq = mostly_clobbered ).
inst_merge_3(bound(UniqA, ListA), any(UniqB), InstTable, M, any(Uniq),
@@ -1696,7 +1734,8 @@
merge_uniq(shared, UniqB, Uniq),
% we do not yet allow merge of any with free, except for clobbered anys
( Uniq = clobbered ; Uniq = mostly_clobbered ).
-inst_merge_3(free, free, InstTable, M, free, InstTable, M).
+inst_merge_3(free(Aliasing), free(Aliasing), InstTable, M, free(Aliasing),
+ InstTable, M).
inst_merge_3(bound(UniqA, ListA), bound(UniqB, ListB), InstTable0, ModuleInfo0,
bound(Uniq, List), InstTable, ModuleInfo) :-
merge_uniq(UniqA, UniqB, Uniq),
@@ -1798,8 +1837,8 @@
inst_table_get_inst_key_table(InstTable, IKT),
inst_key_table_lookup(IKT, InstKey, Inst),
merge_inst_uniq(Inst, UniqB, InstTable, ModuleInfo, Expansions, Uniq).
-merge_inst_uniq(free, Uniq, _, _, _, Uniq).
merge_inst_uniq(free(_), Uniq, _, _, _, Uniq).
+merge_inst_uniq(free(_, _), Uniq, _, _, _, Uniq).
merge_inst_uniq(bound(UniqA, ListA), UniqB, InstTable, ModuleInfo, Expansions,
Uniq) :-
merge_uniq(UniqA, UniqB, Uniq0),
Index: compiler/instmap.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/instmap.m,v
retrieving revision 1.15.2.13
diff -u -r1.15.2.13 instmap.m
--- 1.15.2.13 1998/06/17 04:12:51
+++ instmap.m 1998/06/22 01:02:56
@@ -414,7 +414,7 @@
( map__search(InstMap, Var, VarInst) ->
Inst = VarInst
;
- Inst = free
+ Inst = free(unique)
).
instmap_delta_search_var(unreachable, _, not_reached).
@@ -663,8 +663,8 @@
),
instmap__get_relevant_inst_keys_in_inst(Inst, Recursive, ModuleInfo,
InstTable, S1, S, D1, D).
-instmap__get_relevant_inst_keys_in_inst(free, _, _, _, S, S, D, D).
instmap__get_relevant_inst_keys_in_inst(free(_), _, _, _, S, S, D, D).
+instmap__get_relevant_inst_keys_in_inst(free(_, _), _, _, _, S, S, D, D).
instmap__get_relevant_inst_keys_in_inst(bound(_, BoundInsts), Rec, ModuleInfo,
InstTable, S0, S, D0, D) :-
list__foldl2(lambda([BoundInst :: in, AS0 :: in, AS :: out,
@@ -931,7 +931,7 @@
Sub2 = Sub0
)
;
- VarInst = free,
+ VarInst = free(unique),
Inst2 = Inst0,
Error1 = Error0,
ModuleInfo2 = ModuleInfo0,
Index: compiler/lco.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/lco.m,v
retrieving revision 1.7.2.3
diff -u -r1.7.2.3 lco.m
--- 1.7.2.3 1998/06/17 04:12:58
+++ lco.m 1998/06/22 04:32:22
@@ -4,7 +4,7 @@
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-% Main author: zs
+% Main authors: zs, dmo
% This module looks for opportunities to apply the "last call modulo
% constructor application" optimization.
@@ -18,9 +18,9 @@
:- import_module hlds_module, hlds_pred.
:- import_module io.
-:- pred lco_modulo_constructors(pred_id, proc_id, module_info,
- proc_info, proc_info, io__state, io__state).
-:- mode lco_modulo_constructors(in, in, in, in, out, di, uo) is det.
+:- pred lco_modulo_constructors(pred_id, proc_id, proc_info, proc_info,
+ module_info, module_info, io__state, io__state).
+:- mode lco_modulo_constructors(in, in, in, out, in, out, di, uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -27,110 +27,154 @@
:- implementation.
-:- import_module hlds_goal, passes_aux, hlds_out.
-:- import_module list, require, std_util.
+:- import_module hlds_goal, passes_aux, hlds_out, (inst), instmap, inst_match.
+:- import_module mode_util, hlds_data, prog_data, type_util, globals, options.
+:- import_module list, std_util, map, assoc_list, term, varset, require.
+:- import_module bool, set, int.
%-----------------------------------------------------------------------------%
-lco_modulo_constructors(PredId, ProcId, ModuleInfo, ProcInfo0, ProcInfo) -->
+lco_modulo_constructors(PredId, ProcId, ProcInfo0, ProcInfo, ModuleInfo0,
+ ModuleInfo) -->
+ write_proc_progress_message("% Trying to introduce LCO in ",
+ PredId, ProcId, ModuleInfo0),
{ proc_info_goal(ProcInfo0, Goal0) },
- { lco_in_goal(Goal0, ModuleInfo, Goal) },
- ( { Goal = Goal0 } ->
- { ProcInfo = ProcInfo0 }
+ { lco_in_goal(Goal0, Goal, ModuleInfo0, ModuleInfo1,
+ ProcInfo0, ProcInfo1, Changed) },
+ ( { Changed = yes } ->
+ { proc_info_set_goal(ProcInfo1, Goal, ProcInfo) },
+ { ModuleInfo = ModuleInfo1 },
+ write_proc_progress_message("% Can introduce LCO in ",
+ PredId, ProcId, ModuleInfo)
;
- { ProcInfo = ProcInfo0 }, % for now
- % { proc_info_set_goal(ProcInfo0, Goal, ProcInfo) },
- io__write_string("% Can introduce LCO in "),
- hlds_out__write_pred_proc_id(ModuleInfo, PredId, ProcId),
- io__write_string("\n")
+ { ProcInfo = ProcInfo0 },
+ { ModuleInfo = ModuleInfo0 }
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred lco_in_goal(hlds_goal, module_info, hlds_goal).
-:- mode lco_in_goal(in, in, out) is det.
+% Do the LCO optimisation and recompute the instmap deltas.
+:- pred lco_in_goal(hlds_goal, hlds_goal, module_info, module_info,
+ proc_info, proc_info, bool).
+:- mode lco_in_goal(in, out, in, out, in, out, out) is det.
+
+lco_in_goal(Goal0, Goal, Module0, Module, ProcInfo0, ProcInfo, Changed):-
+ lco_in_sub_goal(Goal0, Goal1, Module0, Module1, ProcInfo0, ProcInfo1,
+ Changed),
+ (
+ Changed = yes,
+ proc_info_inst_table(ProcInfo1, InstTable0),
+ proc_info_get_initial_instmap(ProcInfo1, Module1, InstMap),
+ proc_info_vartypes(ProcInfo1, VarTypes),
+ proc_info_headvars(ProcInfo1, ArgVars),
+ proc_info_arglives(ProcInfo1, Module1, ArgLives),
+ recompute_instmap_delta(ArgVars, ArgLives, VarTypes,
+ Goal1, Goal, InstMap, InstTable0, InstTable,
+ _GoalChanged, Module1, Module),
+ proc_info_set_inst_table(ProcInfo1, InstTable, ProcInfo)
+ ;
+ Changed = no,
+ Goal = Goal0,
+ Module = Module0,
+ ProcInfo = ProcInfo0
+ ).
-lco_in_goal(Goal0 - GoalInfo, ModuleInfo, Goal - GoalInfo) :-
- lco_in_goal_2(Goal0, ModuleInfo, Goal).
+% Do the LCO optimisation without recomputing instmap deltas.
+:- pred lco_in_sub_goal(hlds_goal, hlds_goal, module_info, module_info,
+ proc_info, proc_info, bool).
+:- mode lco_in_sub_goal(in, out, in, out, in, out, out) is det.
+lco_in_sub_goal(Goal0 - GoalInfo, Goal - GoalInfo, Module0, Module,
+ Proc0, Proc, Changed) :-
+ lco_in_goal_2(Goal0, Goal, Module0, Module, Proc0, Proc, Changed).
+
%-----------------------------------------------------------------------------%
-:- pred lco_in_goal_2(hlds_goal_expr, module_info, hlds_goal_expr).
-:- mode lco_in_goal_2(in, in, out) is det.
+:- pred lco_in_goal_2(hlds_goal_expr, hlds_goal_expr, module_info,
+ module_info, proc_info, proc_info, bool).
+:- mode lco_in_goal_2(in, out, in, out, in, out, out) is det.
-lco_in_goal_2(conj(Goals0), ModuleInfo, conj(Goals)) :-
+lco_in_goal_2(conj(Goals0), conj(Goals), Module0, Module, Proc0, Proc, Changed)
+ :-
list__reverse(Goals0, RevGoals0),
- lco_in_conj(RevGoals0, [], ModuleInfo, Goals).
+ lco_in_conj(RevGoals0, [], Goals, Module0, Module, Proc0, Proc,
+ Changed).
% XXX Some execution algorithm issues here.
-lco_in_goal_2(par_conj(_Goals0, SM), _ModuleInfo, par_conj(_Goals, SM)) :-
- error("sorry: lco of parallel conjunction not implemented").
+lco_in_goal_2(par_conj(Goals, SM), par_conj(Goals, SM), Module, Module,
+ Proc, Proc, no).
-lco_in_goal_2(disj(Goals0, SM), ModuleInfo, disj(Goals, SM)) :-
- lco_in_disj(Goals0, ModuleInfo, Goals).
+lco_in_goal_2(disj(Goals0, SM), disj(Goals, SM), Module0, Module, Proc0, Proc,
+ Changed) :-
+ lco_in_disj(Goals0, Goals, Module0, Module, Proc0, Proc, Changed).
-lco_in_goal_2(switch(Var, Det, Cases0, SM), ModuleInfo,
- switch(Var, Det, Cases, SM)) :-
- lco_in_cases(Cases0, ModuleInfo, Cases).
+lco_in_goal_2(switch(Var, Det, Cases0, SM), switch(Var, Det, Cases, SM),
+ Module0, Module, Proc0, Proc, Changed) :-
+ lco_in_cases(Cases0, Cases, Module0, Module, Proc0, Proc, Changed).
-lco_in_goal_2(if_then_else(Vars, Cond, Then0, Else0, SM), ModuleInfo,
- if_then_else(Vars, Cond, Then, Else, SM)) :-
- lco_in_goal(Then0, ModuleInfo, Then),
- lco_in_goal(Else0, ModuleInfo, Else).
+lco_in_goal_2(if_then_else(Vars, Cond, Then0, Else0, SM),
+ if_then_else(Vars, Cond, Then, Else, SM), Module0, Module,
+ Proc0, Proc, Changed) :-
+ lco_in_sub_goal(Then0, Then, Module0, Module1, Proc0, Proc1, Changed0),
+ lco_in_sub_goal(Else0, Else, Module1, Module, Proc1, Proc, Changed1),
+ bool__or(Changed0, Changed1, Changed).
-lco_in_goal_2(some(Vars, Goal0), ModuleInfo, some(Vars, Goal)) :-
- lco_in_goal(Goal0, ModuleInfo, Goal).
+lco_in_goal_2(some(Vars, Goal0), some(Vars, Goal), Module0, Module,
+ Proc0, Proc, Changed) :-
+ lco_in_sub_goal(Goal0, Goal, Module0, Module, Proc0, Proc, Changed).
-lco_in_goal_2(not(Goal), _ModuleInfo, not(Goal)).
+lco_in_goal_2(not(Goal), not(Goal), Module, Module, Proc, Proc, no).
-lco_in_goal_2(higher_order_call(A,B,C,D,E,F), _ModuleInfo,
- higher_order_call(A,B,C,D,E,F)).
+lco_in_goal_2(higher_order_call(A,B,C,D,E,F), higher_order_call(A,B,C,D,E,F),
+ Module, Module, Proc, Proc, no).
-lco_in_goal_2(class_method_call(A,B,C,D,E,F), _ModuleInfo,
- class_method_call(A,B,C,D,E,F)).
+lco_in_goal_2(class_method_call(A,B,C,D,E,F), class_method_call(A,B,C,D,E,F),
+ Module, Module, Proc, Proc, no).
-lco_in_goal_2(call(A,B,C,D,E,F), _ModuleInfo, call(A,B,C,D,E,F)).
+lco_in_goal_2(call(A,B,C,D,E,F), call(A,B,C,D,E,F), Module, Module,
+ Proc, Proc, no).
-lco_in_goal_2(unify(A,B,C,D,E), _ModuleInfo, unify(A,B,C,D,E)).
+lco_in_goal_2(unify(A,B,C,D,E), unify(A,B,C,D,E), Module, Module, Proc, Proc,
+ no).
-lco_in_goal_2(pragma_c_code(A,B,C,D,E,F,G), _,
- pragma_c_code(A,B,C,D,E,F,G)).
+lco_in_goal_2(pragma_c_code(A,B,C,D,E,F,G), pragma_c_code(A,B,C,D,E,F,G),
+ Module, Module, Proc, Proc, no).
%-----------------------------------------------------------------------------%
-:- pred lco_in_disj(list(hlds_goal), module_info, list(hlds_goal)).
-:- mode lco_in_disj(in, in, out) is det.
+:- pred lco_in_disj(list(hlds_goal), list(hlds_goal), module_info,
+ module_info, proc_info, proc_info, bool).
+:- mode lco_in_disj(in, out, in, out, in, out, out) is det.
-lco_in_disj([], __ModuleInfo, []).
-lco_in_disj([Goal0 | Goals0], ModuleInfo, [Goal | Goals]) :-
- lco_in_goal(Goal0, ModuleInfo, Goal),
- lco_in_disj(Goals0, ModuleInfo, Goals).
+lco_in_disj([], [], Module, Module, Proc, Proc, no).
+lco_in_disj([Goal0 | Goals0], [Goal | Goals], Module0, Module, Proc0, Proc,
+ Changed) :-
+ lco_in_sub_goal(Goal0, Goal, Module0, Module1, Proc0, Proc1, Changed0),
+ lco_in_disj(Goals0, Goals, Module1, Module, Proc1, Proc, Changed1),
+ bool__or(Changed0, Changed1, Changed).
%-----------------------------------------------------------------------------%
-:- pred lco_in_cases(list(case), module_info, list(case)).
-:- mode lco_in_cases(in, in, out) is det.
+:- pred lco_in_cases(list(case), list(case), module_info, module_info,
+ proc_info, proc_info, bool).
+:- mode lco_in_cases(in, out, in, out, in, out, out) is det.
-lco_in_cases([], __ModuleInfo, []).
-lco_in_cases([case(Cons, IMDelta, Goal0) | Cases0], ModuleInfo,
- [case(Cons, IMDelta, Goal) | Cases]) :-
- lco_in_goal(Goal0, ModuleInfo, Goal),
- lco_in_cases(Cases0, ModuleInfo, Cases).
+lco_in_cases([], [], Module, Module, Proc, Proc, no).
+lco_in_cases([case(Cons, IMD, Goal0) | Cases0], [case(Cons, IMD, Goal) | Cases],
+ Module0, Module, Proc0, Proc, Changed) :-
+ lco_in_sub_goal(Goal0, Goal, Module0, Module1, Proc0, Proc1, Changed0),
+ lco_in_cases(Cases0, Cases, Module1, Module, Proc1, Proc, Changed1),
+ bool__or(Changed0, Changed1, Changed).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-% lco_in_conj(RevGoals, Unifies, ModuleInfo, Goals)
+% lco_in_conj(RevGoals, Unifies, Goals, Module0, Module, Proc0, Proc, Changed)
%
% Given a conjunction whose structure is: "goals*,call,construct*",
% move the construction unifications before the call.
%
-% For now the transformation results are usable by humans only.
-% XXX Later we will have to modify the instantiation states
-% recorded for the variables involved in the constructions.
-% The ModuleInfo will be probably be needed by this code.
-%
% We traverse the conjunction backwards (the caller has reversed the list).
% RevGoals is the list of remaining goals in the reversed conjunction list.
% RevUnifies is the list of assignments and constructions delayed by any
@@ -138,23 +182,80 @@
%
% invariant: append(reverse(RevGoals), Unifies) = original conjunction
-:- pred lco_in_conj(list(hlds_goal), list(hlds_goal), module_info,
- list(hlds_goal)).
-:- mode lco_in_conj(in, in, in, out) is det.
-
-lco_in_conj([], Unifies, __ModuleInfo, Unifies).
-lco_in_conj([Goal0 | Goals0], Unifies0, ModuleInfo, Goals) :-
+:- pred lco_in_conj(list(hlds_goal), list(hlds_goal), list(hlds_goal),
+ module_info, module_info, proc_info, proc_info, bool).
+:- mode lco_in_conj(in, in, out, in, out, in, out, out) is det.
+
+lco_in_conj([], Unifies, Unifies, Module, Module, Proc, Proc, no).
+lco_in_conj([Goal0 | Goals0], Unifies0, Goals, Module0, Module, Proc0, Proc,
+ Changed) :-
Goal0 = GoalExpr0 - _,
(
- GoalExpr0 = unify(_, _, _, Unif, _),
- Unif = construct(_, _, _, _)
+ GoalExpr0 = unify(_, _, LHSMode - RHSMode, Unif, _),
+ Unif = construct(_, _, _, _),
+
+ % XXX For now, don't allow LCO on constructions of
+ % higher-order terms. This is because we currently
+ % can't express non-ground higher-order terms.
+ proc_info_inst_table(Proc0, InstTable),
+ mode_get_insts(Module0, LHSMode, _, LFinalInst),
+ \+ inst_is_higher_order_ground(LFinalInst, InstTable, Module0),
+ mode_get_insts(Module0, RHSMode, _, RFinalInst),
+ \+ inst_is_higher_order_ground(RFinalInst, InstTable, Module0)
->
Unifies1 = [Goal0 | Unifies0],
- lco_in_conj(Goals0, Unifies1, ModuleInfo, Goals)
+ lco_in_conj(Goals0, Unifies1, Goals, Module0, Module, Proc0,
+ Proc, Changed)
;
- GoalExpr0 = call(_, _, _, _, _, _)
+ GoalExpr0 = call(CalledPredId, ProcId, Vars, _, _, _),
+
+ % Make sure there were actually some constructions of tagged
+ % types after the call. Otherwise there's no point in doing the
+ % optimisation.
+ list__filter(goal_is_no_tag_construction(Module0, Proc0),
+ Unifies0, NoTagUnifies, Unifies1),
+ Unifies1 \= [],
+
+ % AAA for now, don't allow any constructions of no_tag types.
+ NoTagUnifies = [],
+
+ % XXX - For now, only allow calls to preds within this module.
+ % This is because a new proc will need to be created for the
+ % pred that is called.
+ module_info_pred_info(Module0, CalledPredId, PredInfo),
+ \+ pred_info_is_imported(PredInfo),
+
+ % XXX - Also, we currently only allow one reference per
+ % variable, so make sure there is no more than one reference
+ % to each output variable in the call.
+ pred_info_procedures(PredInfo, ProcTable),
+ map__lookup(ProcTable, ProcId, CalledProcInfo),
+ check_only_one_ref_per_var(Unifies1, Vars, Module0,
+ CalledProcInfo, Proc0),
+
+ % The conservative GC version of solutions does not deep
+ % copy the solutions, so we need to disallow LCO if both the
+ % calling proc and called proc are multi-solution.
+ \+ (
+ module_info_globals(Module0, Globals),
+ globals__get_gc_method(Globals, conservative),
+ proc_info_interface_determinism(Proc0, CallingDet),
+ proc_info_interface_determinism(CalledProcInfo,
+ CalledDet),
+ determinism_components(CallingDet, _, at_most_many),
+ determinism_components(CalledDet, _, at_most_many)
+ )
->
- list__append(Unifies0, [Goal0], LaterGoals),
+ set__init(ChangedVarsSet0),
+ modify_instantiations(Unifies1, Unifies, Goal0, Goal1,
+ NoTagUnifies, Module0, ChangedVarsSet0, ChangedVarsSet,
+ Proc0, Proc),
+ Changed = yes,
+
+ maybe_create_new_proc(ChangedVarsSet, Module0, Module,
+ Goal1, Goal),
+
+ list__append(Unifies, [Goal | NoTagUnifies], LaterGoals),
list__reverse(Goals0, FrontGoals),
list__append(FrontGoals, LaterGoals, Goals)
;
@@ -161,8 +262,745 @@
% The conjunction does not follow the pattern "unify*, goal"
% so we cannot optimize it; reconstruct the original goal list
list__reverse([Goal0 | Goals0], FrontGoals),
- list__append(FrontGoals, Unifies0, Goals)
+ list__append(FrontGoals, Unifies0, Goals1),
+
+ % We may, however, be able to optimise the last conjuct, so
+ % give that a go.
+ list__reverse(Goals1, RevGoals0),
+ ( RevGoals0 = [Last0 | RevGoals1] ->
+ lco_in_sub_goal(Last0, Last, Module0, Module,
+ Proc0, Proc, Changed),
+ list__reverse([Last | RevGoals1], Goals)
+ ;
+ Goals = Goals1,
+ Module = Module0,
+ Proc = Proc0,
+ Changed = no
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred goal_is_no_tag_construction(module_info, proc_info, hlds_goal).
+:- mode goal_is_no_tag_construction(in, in, in) is semidet.
+
+goal_is_no_tag_construction(Module, Proc, Goal) :-
+ Goal = unify(_, _, _, Unif, _) - _,
+ Unif = construct(Var, _, _, _),
+ proc_info_vartypes(Proc, VarTypes),
+ map__search(VarTypes, Var, Type),
+ type_constructors(Type, Module, Constructors),
+ type_is_no_tag_type(Constructors, _FunctorName, _ArgType).
+
+%-----------------------------------------------------------------------------%
+
+:- pred check_only_one_ref_per_var(list(hlds_goal), list(var),
+ module_info, proc_info, proc_info).
+:- mode check_only_one_ref_per_var(in, in, in, in, in) is semidet.
+
+check_only_one_ref_per_var(Unifies, CallVars, Module, CalledProcInfo,
+ CallingProcInfo) :-
+ Lambda = lambda([Goal::in, Vars::out, N0::in, N::out] is det,
+ (
+ Goal = unify(_, _, _, Unif, _) - _,
+ Unif = construct(_, _, Vars0, _)
+ ->
+ Vars = N0 - Vars0,
+ N is N0 + 1
+ ;
+ error("lco:check_only_one_ref_per_var incorrect goal")
+ )),
+ list__map_foldl(Lambda, Unifies, UnifVars, 0, _),
+
+ proc_info_argmodes(CalledProcInfo,
+ argument_modes(CalledInstTable, CalledModes)),
+ assoc_list__from_corresponding_lists(CallVars, CalledModes,
+ CalledVarModes),
+
+ proc_info_headvars(CallingProcInfo, CallingHeadVars),
+ proc_info_argmodes(CallingProcInfo,
+ argument_modes(CallingInstTable, CallingHeadModes)),
+ assoc_list__from_corresponding_lists(CallingHeadVars, CallingHeadModes,
+ CallingHeadVarModes),
+
+ proc_info_vartypes(CallingProcInfo, Types),
+
+ check_only_one_ref_per_var_2(CalledVarModes, UnifVars, CalledInstTable,
+ Module, Types, CallingHeadVarModes, CallingInstTable).
+
+:- pred check_only_one_ref_per_var_2(assoc_list(var, mode),
+ list(pair(int, list(var))), inst_table, module_info, map(var, type),
+ assoc_list(var, mode), inst_table).
+:- mode check_only_one_ref_per_var_2(in, in, in, in, in, in, in) is semidet.
+
+check_only_one_ref_per_var_2([], _, _, _, _, _, _).
+check_only_one_ref_per_var_2([Var - Mode | VarModes], UnifVars, InstTable,
+ Module, Types, CallingHeadVarModes, CallingInstTable) :-
+ (
+ map__search(Types, Var, Type),
+ mode_to_arg_mode(InstTable, Module, Mode, Type, top_out)
+ ->
+ % Ensure that there is at most one construction
+ % that has this variable on its RHS.
+ \+ (
+ list__member(N1 - Vars1, UnifVars),
+ list__member(N2 - Vars2, UnifVars),
+ N1 < N2,
+ list__member(Var, Vars1),
+ list__member(Var, Vars2)
+ ),
+
+ % Ensure that, if this variable occurs on the RHS
+ % of a construction, then it is not also an output
+ % from the calling procedure.
+ \+ (
+ list__member(_ - Vars, UnifVars),
+ list__member(Var, Vars),
+ list__member(Var - HMode, CallingHeadVarModes),
+ mode_to_arg_mode(CallingInstTable, Module,
+ HMode, Type, ArgMode),
+ ( ArgMode = top_out
+ ; ArgMode = ref_in
+ )
+ )
+ ;
+ true
+ ),
+ check_only_one_ref_per_var_2(VarModes, UnifVars, InstTable, Module,
+ Types, CallingHeadVarModes, CallingInstTable).
+
+%-----------------------------------------------------------------------------%
+
+% We need a proc that is the same as the called proc, but with aliasing on
+% some of the output variables. See if the required proc already exists
+% and if it doesn't, create it.
+
+:- pred maybe_create_new_proc(set(var), module_info, module_info,
+ hlds_goal, hlds_goal).
+:- mode maybe_create_new_proc(in, in, out, in, out) is det.
+
+maybe_create_new_proc(ChangedVars, Module0, Module, Goal0, Goal) :-
+ (
+ Goal0 = call(PredId, ProcId0, Vars, A,B,C) - GoalInfo
+ ->
+ module_info_pred_info(Module0, PredId, PredInfo0),
+ pred_info_procedures(PredInfo0, ProcTable0),
+ map__lookup(ProcTable0, ProcId0, ProcInfo0),
+ proc_info_argmodes(ProcInfo0, ArgModes0),
+ ArgModes0 = argument_modes(ArgInstTable, Modes0),
+ proc_info_inst_table(ProcInfo0, InstTable0),
+ assoc_list__from_corresponding_lists(Vars, Modes0, VarModes0),
+ list__map(change_arg_mode(ChangedVars, Module0, InstTable0),
+ VarModes0, Modes),
+ ArgModes = argument_modes(ArgInstTable, Modes),
+
+ % See if a procedure with these modes already exists
+ ( find_matching_proc(ProcTable0, ArgModes, Module0, ProcId1) ->
+ Goal = call(PredId, ProcId1, Vars, A,B,C) - GoalInfo,
+ Module = Module0
+ ;
+ create_new_proc(ProcTable0, ProcId0, ArgModes, InstTable0,
+ ProcTable1, ProcId),
+ Goal = call(PredId, ProcId, Vars, A,B,C) - GoalInfo,
+ pred_info_set_procedures(PredInfo0, ProcTable1, PredInfo1),
+ module_info_set_pred_info(Module0, PredId, PredInfo1, Module1),
+
+ % Run lco on the new proc.
+ map__lookup(ProcTable1, ProcId, ProcInfo1),
+ proc_info_goal(ProcInfo1, ProcGoal0),
+ lco_in_goal(ProcGoal0, ProcGoal1, Module1, Module2, ProcInfo1,
+ ProcInfo2, _),
+
+ % Fix modes of unifications and calls in the new proc
+ % that bind aliased output arguments.
+ proc_info_headvars(ProcInfo2, HeadVars),
+ proc_info_vartypes(ProcInfo2, Types0),
+ proc_info_inst_table(ProcInfo2, ProcInstTable0),
+ assoc_list__from_corresponding_lists(HeadVars, Modes, VarModes),
+ Filter = lambda([VarMode::in, Var::out] is semidet,
+ (
+ VarMode = Var - Mode,
+ map__lookup(Types0, Var, Type),
+ mode_to_arg_mode(ProcInstTable0, Module2, Mode, Type,
+ ref_in)
+ )),
+ list__filter_map(Filter, VarModes, AliasedVars),
+
+ proc_info_varset(ProcInfo2, VarSet0),
+ proc_info_get_initial_instmap(ProcInfo2, Module2, InstMap),
+
+ FMI0 = fix_modes_info(VarSet0, Types0, ProcInstTable0, InstMap),
+ set__list_to_set(AliasedVars, AliasedVarSet),
+ list__foldl2(
+ lambda([V::in, G0::in, G::out, F0::in, F::out] is det,(
+ fix_modes_of_binding_goal(Module2, AliasedVarSet, V,
+ G0, G, F0, F1),
+ fix_modes_info_set_instmap(F1, InstMap, F)
+ )), AliasedVars, ProcGoal1, ProcGoal, FMI0, FMI),
+
+ proc_info_set_goal(ProcInfo2, ProcGoal, ProcInfo3),
+ FMI = fix_modes_info(VarSet, Types, ProcInstTable, _),
+ proc_info_set_varset(ProcInfo3, VarSet, ProcInfo4),
+ proc_info_set_vartypes(ProcInfo4, Types, ProcInfo5),
+ proc_info_set_inst_table(ProcInfo5, ProcInstTable, ProcInfo),
+ map__set(ProcTable1, ProcId, ProcInfo, ProcTable),
+ pred_info_set_procedures(PredInfo1, ProcTable, PredInfo),
+ module_info_set_pred_info(Module2, PredId, PredInfo, Module)
+ )
+ ;
+ error("lco:maybe_create_new_proc: internal error")
+ ).
+
+:- pred get_unused_proc_id(proc_id, proc_table, proc_id).
+:- mode get_unused_proc_id(in, in, out) is det.
+
+get_unused_proc_id(ProcId0, ProcTable, ProcId) :-
+ ( map__contains(ProcTable, ProcId0) ->
+ hlds_pred__next_proc_id(ProcId0, ProcId1),
+ get_unused_proc_id(ProcId1, ProcTable, ProcId)
+ ;
+ ProcId = ProcId0
+ ).
+
+
+% If Var is in the set of variables that need their modes changed and mode
+% is (free(unique) -> I), then change mode to (free(alias) -> I).
+:- pred change_arg_mode(set(var), module_info, inst_table, pair(var, mode),
+ mode).
+:- mode change_arg_mode(in, in, in, in, out) is det.
+
+change_arg_mode(VarSet, Module, InstTable, Var - Mode0, Mode) :-
+ (
+ set__member(Var, VarSet),
+ mode_is_output(InstTable, Module, Mode0)
+ ->
+ mode_get_insts(Module, Mode0, _, FinalInst),
+ Mode = (free(alias) -> FinalInst)
+ ;
+ Mode = Mode0
).
+% Find a procedure in the ProcTable that has argmodes equivalent to those
+% given.
+:- pred find_matching_proc(proc_table, argument_modes, module_info, proc_id).
+:- mode find_matching_proc(in, in, in, out) is semidet.
+
+find_matching_proc(ProcTable, ArgModesA, Module, ProcId) :-
+ ArgModesA = argument_modes(InstTableA, ModesA),
+ Lambda = lambda([ProcInfo::in] is semidet,
+ (
+ proc_info_argmodes(ProcInfo, ArgModesB),
+ ArgModesB = argument_modes(InstTableB, ModesB),
+ assoc_list__from_corresponding_lists(ModesA, ModesB,
+ ModesAB),
+ \+ ( list__member(A - B, ModesAB),
+ \+ (
+ mode_get_insts(Module, A, IA, FA),
+ mode_get_insts(Module, B, IB, FB),
+ inst_expand(InstTableA, Module, IA, I),
+ inst_expand(InstTableB, Module, IB, I),
+ inst_expand(InstTableA, Module, FA, F),
+ inst_expand(InstTableB, Module, FB, F),
+ alias_iff_alias(IA, IB),
+ alias_iff_alias(FA, FB)
+ )
+ )
+ )),
+ get_first_from_map(Lambda, ProcTable, ProcId).
+
+% XXX InstA = alias(_) <=> InstB = alias(_).
+% Get around a bug which currently does not allow this goal as written above.
+:- pred alias_iff_alias((inst)::in, (inst)::in) is semidet.
+
+alias_iff_alias(alias(_), alias(_)).
+alias_iff_alias(IA, IB) :-
+ IA \= alias(_),
+ IB \= alias(_).
+
+:- pred create_new_proc(proc_table, proc_id, argument_modes, inst_table,
+ proc_table, proc_id).
+:- mode create_new_proc(in, in, in, in, out, out) is det.
+
+create_new_proc(ProcTable0, OldProcId, ArgModes, InstTable, ProcTable,
+ NewProcId) :-
+ get_unused_proc_id(OldProcId, ProcTable0, NewProcId),
+ map__lookup(ProcTable0, OldProcId, ProcInfo0),
+ proc_info_set_argmodes(ProcInfo0, ArgModes, ProcInfo1),
+ proc_info_set_inst_table(ProcInfo1, InstTable, ProcInfo),
+ map__det_insert(ProcTable0, NewProcId, ProcInfo, ProcTable).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+:- pred modify_instantiations(list(hlds_goal), list(hlds_goal), hlds_goal,
+ hlds_goal, list(hlds_goal), module_info, set(var), set(var),
+ proc_info, proc_info).
+:- mode modify_instantiations(in, out, in, out, in, in, in, out, in, out)
+ is det.
+
+modify_instantiations([], [], Call, Call, _NoTagUnifies, _Module,
+ VarSet, VarSet, ProcInfo, ProcInfo).
+modify_instantiations([Unify0 | Unifies0], [Unify | Unifies], Call0, Call,
+ NoTagUnifies, Module, VarSet0, VarSet, ProcInfo0, ProcInfo) :-
+ (
+ Unify0 = UnifyExpr0 - UnifyInfo0,
+ UnifyExpr0 = unify(Var, RHS, Mode, Unification0, Context),
+ Unification0 = construct(UnifVar, ConsId, UnifVars, UniModes0),
+ Call0 = CallExpr - CallInfo0,
+ CallExpr = call(_, _, _CallVars, _, _, _)
+ ->
+ goal_info_get_instmap_delta(UnifyInfo0, UnifIMD0),
+ goal_info_get_instmap_delta(CallInfo0, CallIMD0),
+ assoc_list__from_corresponding_lists(UnifVars, UniModes0,
+ UnifVarModes0),
+ proc_info_inst_table(ProcInfo0, InstTable0),
+
+ modify_instmap_deltas(UnifVarModes0, UniModes, NoTagUnifies,
+ InstTable0, InstTable, Module, UnifIMD0, UnifIMD,
+ CallIMD0, CallIMD, VarSet0, VarSet1),
+
+ proc_info_set_inst_table(ProcInfo0, InstTable, ProcInfo1),
+ Unification = construct(UnifVar, ConsId, UnifVars, UniModes),
+ UnifyExpr = unify(Var, RHS, Mode, Unification, Context),
+ goal_info_set_instmap_delta(UnifyInfo0, UnifIMD, UnifyInfo),
+ Unify = UnifyExpr - UnifyInfo,
+ goal_info_set_instmap_delta(CallInfo0, CallIMD, CallInfo),
+ Call1 = CallExpr - CallInfo,
+ modify_instantiations(Unifies0, Unifies, Call1, Call,
+ NoTagUnifies, Module, VarSet1, VarSet,
+ ProcInfo1, ProcInfo)
+ ;
+ error("modify_instantiations: goal not of correct type")
+ ).
+
+:- pred modify_instmap_deltas(assoc_list(var, uni_mode), list(uni_mode),
+ list(hlds_goal), inst_table, inst_table, module_info,
+ instmap_delta, instmap_delta, instmap_delta, instmap_delta,
+ set(var), set(var)).
+:- mode modify_instmap_deltas(in, out, in, in, out, in, in, out, in, out,
+ in, out) is det.
+
+modify_instmap_deltas([], [], _, InstTable, InstTable, _, UnifIMD, UnifIMD,
+ CallIMD, CallIMD, VarSet, VarSet).
+modify_instmap_deltas([UnifVar - UniMode0 | VarModes], [UniMode | UniModes],
+ NoTagUnifies, InstTable0, InstTable, Module, UnifIMD0, UnifIMD,
+ CallIMD0, CallIMD, VarSet0, VarSet) :-
+ ( bound_in_imds(UnifVar, CallIMD0, NoTagUnifies, InstTable0, Module) ->
+ % We don't actually need to modify CallIMD here because it is
+ % done by `recompute_instmap_delta'.
+ CallIMD1 = CallIMD0,
+ inst_table_get_inst_key_table(InstTable0, IKT0),
+ inst_key_table_add(IKT0, free(alias), IK, IKT),
+ inst_table_set_inst_key_table(InstTable0, IKT,
+ InstTable1),
+ NewInst = alias(IK),
+ UniMode = ((free(unique) - free(unique)) ->
+ (NewInst - NewInst)),
+ (
+ instmap_delta_search_var(UnifIMD0, UnifVar, Inst0),
+ Inst0 = alias(IK0)
+ ->
+ instmap_delta_to_assoc_list(UnifIMD0, AL0),
+ assoc_list__values(AL0, Insts0),
+ map__init(Sub0),
+ map__set(Sub0, IK0, IK, Sub),
+ list__map(inst_apply_sub(Sub), Insts0, Insts),
+ assoc_list__keys(AL0, Vars),
+ assoc_list__from_corresponding_lists(Vars,
+ Insts, AL),
+ instmap_delta_from_assoc_list(AL, UnifIMD1)
+ ;
+ UnifIMD1 = UnifIMD0
+ ),
+ set__insert(VarSet0, UnifVar, VarSet1)
+ ;
+ UniMode = UniMode0,
+ UnifIMD1 = UnifIMD0,
+ CallIMD1 = CallIMD0,
+ InstTable1 = InstTable0,
+ VarSet1 = VarSet0
+ ),
+ modify_instmap_deltas(VarModes, UniModes, NoTagUnifies,
+ InstTable1, InstTable, Module, UnifIMD1, UnifIMD,
+ CallIMD1, CallIMD, VarSet1, VarSet).
+
+% bound_in_imds(Var, IMD, Goals, InstTable, Module)
+% succeeds if variable is bound in IMD or any of the IMD's in Goals..
+:- pred bound_in_imds(var::in, instmap_delta::in, list(hlds_goal)::in,
+ inst_table::in, module_info::in) is semidet.
+
+bound_in_imds(Var, IMD, _Goals, InstTable, Module) :-
+ bound_in_imd(Var, IMD, InstTable, Module).
+bound_in_imds(Var, _IMD, Goals, InstTable, Module) :-
+ list__member(_ - GoalInfo, Goals),
+ goal_info_get_instmap_delta(GoalInfo, GoalIMD),
+ bound_in_imd(Var, GoalIMD, InstTable, Module).
+
+:- pred bound_in_imd(var::in, instmap_delta::in, inst_table::in,
+ module_info::in) is semidet.
+
+bound_in_imd(Var, IMD, InstTable, Module) :-
+ instmap_delta_search_var(IMD, Var, Inst),
+ inst_is_bound(Inst, InstTable, Module).
+
+%---------------------------------------------------------------------------%
+
+:- type fix_modes_info
+ ---> fix_modes_info(varset, map(var, type), inst_table, instmap).
+
+:- pred fix_modes_info_apply_instmap_delta(fix_modes_info, instmap_delta,
+ fix_modes_info).
+:- mode fix_modes_info_apply_instmap_delta(in, in, out) is det.
+
+fix_modes_info_apply_instmap_delta(FMI0, IMD, FMI) :-
+ FMI0 = fix_modes_info(A, B, C, IM0),
+ instmap__apply_instmap_delta(IM0, IMD, IM),
+ FMI = fix_modes_info(A, B, C, IM).
+
+:- pred fix_modes_info_get_instmap(fix_modes_info, instmap).
+:- mode fix_modes_info_get_instmap(in, out) is det.
+
+fix_modes_info_get_instmap(fix_modes_info(_, _, _, InstMap), InstMap).
+
+:- pred fix_modes_info_set_instmap(fix_modes_info, instmap, fix_modes_info).
+:- mode fix_modes_info_set_instmap(in, in, out) is det.
+
+fix_modes_info_set_instmap(fix_modes_info(A, B, C, _), InstMap,
+ fix_modes_info(A, B, C, InstMap)).
+
+% After creating a new proc with aliased output arguments, it is necessary
+% to alter the modes of any unifications within the proc goal that bind those
+% arguments. If the arguments are bound in a call then an assignment
+% may need to be added after the call.
+
+:- pred fix_modes_of_binding_goal(module_info, set(var), var,
+ hlds_goal, hlds_goal, fix_modes_info, fix_modes_info).
+:- mode fix_modes_of_binding_goal(in, in, in, in, out, in, out) is det.
+
+fix_modes_of_binding_goal(Module, AliasedVars, Var, GoalExpr0 - GoalInfo,
+ GoalExpr - GoalInfo, FMI0, FMI) :-
+ goal_info_get_instmap_delta(GoalInfo, IMD),
+ FMI0 = fix_modes_info(_, VarTypes, InstTable, InstMap0),
+ instmap__lookup_var(InstMap0, Var, InitialInst),
+ map__lookup(VarTypes, Var, Type),
+ (
+ % Does the goal bind Var?
+ instmap_delta_search_var(IMD, Var, FinalInst),
+ mode_to_arg_mode(InstTable, Module, (InitialInst -> FinalInst),
+ Type, ref_in)
+ ->
+ fix_modes_of_binding_goal_2(GoalExpr0, FMI0, GoalInfo,
+ Module, AliasedVars, Var, GoalExpr, FMI1)
+ ;
+ GoalExpr = GoalExpr0,
+ FMI1 = FMI0
+ ),
+ fix_modes_info_apply_instmap_delta(FMI1, IMD, FMI).
+
+:- pred fix_modes_of_binding_goal_2(hlds_goal_expr, fix_modes_info,
+ hlds_goal_info, module_info, set(var), var, hlds_goal_expr,
+ fix_modes_info).
+:- mode fix_modes_of_binding_goal_2(in, in, in, in, in, in, out, out) is det.
+
+fix_modes_of_binding_goal_2(conj(Goals0), FMI0, _, Module, AliasedVars, Var,
+ conj(Goals), FMI) :-
+ list__map_foldl(fix_modes_of_binding_goal(Module, AliasedVars, Var),
+ Goals0, Goals, FMI0, FMI).
+
+fix_modes_of_binding_goal_2(par_conj(Goals0, SM), FMI0, _, Module,
+ AliasedVars, Var, par_conj(Goals, SM), FMI) :-
+ Lambda = lambda([Goal0::in, Goal::out, F0::in, F::out] is det,
+ (
+ fix_modes_info_get_instmap(F0, InstMap),
+ fix_modes_of_binding_goal(Module, AliasedVars, Var,
+ Goal0, Goal, F0, F1),
+ fix_modes_info_set_instmap(F1, InstMap, F)
+ )),
+ list__map_foldl(Lambda, Goals0, Goals, FMI0, FMI).
+
+fix_modes_of_binding_goal_2(call(PredId, ProcId0, Vars0, D, E, F), FMI0,
+ GoalInfo0, Module, AliasedVars, Var, Goal, FMI) :-
+ (
+ replace_call_proc_with_aliased_version(PredId, ProcId0, FMI0,
+ Module, Var, AliasedVars, Vars0, ProcId)
+ ->
+ FMI = FMI0,
+ Goal = call(PredId, ProcId, Vars0, D, E, F)
+ ;
+ add_unification_to_goal(Vars0, FMI0, GoalInfo0, Module, Var,
+ Vars, FMI, GoalInfo, Assign),
+ ( Vars = Vars0 ->
+ Goal = call(PredId, ProcId0, Vars0, D, E, F)
+ ;
+ Call = call(PredId, ProcId0, Vars, D, E, F) - GoalInfo,
+ Goal = conj([Call, Assign])
+ )
+ ).
+
+fix_modes_of_binding_goal_2(higher_order_call(A, Vars0, C, D, E, F), FMI0,
+ GoalInfo0, Module, _AliasedVars, Var, Goal, FMI) :-
+ add_unification_to_goal(Vars0, FMI0, GoalInfo0, Module, Var,
+ Vars, FMI, GoalInfo, Assign),
+ HigherOrder = higher_order_call(A, Vars, C, D, E, F) - GoalInfo,
+ Goal = conj([HigherOrder, Assign]).
+
+fix_modes_of_binding_goal_2(switch(SVar, Det, Cases0, SM), FMI0, _,
+ Module, AliasedVars, Var, switch(SVar, Det, Cases, SM), FMI) :-
+ Lambda = lambda([Case0::in, Case::out, F0::in, F::out] is det,
+ (
+ Case0 = case(ConsId, CaseIMD, Goal0),
+ fix_modes_info_get_instmap(F0, InstMap),
+ fix_modes_of_binding_goal(Module, AliasedVars, Var,
+ Goal0, Goal, F0, F1),
+ Case = case(ConsId, CaseIMD, Goal),
+ fix_modes_info_set_instmap(F1, InstMap, F)
+ )),
+ list__map_foldl(Lambda, Cases0, Cases, FMI0, FMI).
+
+fix_modes_of_binding_goal_2(unify(LHS, RHS0, Modes0, Unif0, Cont), FMI0,
+ GoalInfo0, Module, _AliasedVars, Var, Goal, FMI) :-
+ fix_modes_of_unify(Unif0, RHS0, Modes0, FMI0, GoalInfo0, Module, Var,
+ Unif, RHS, Modes, FMI, GoalInfo, MaybeAssign),
+ UnifyGoal = unify(LHS, RHS, Modes, Unif, Cont),
+ (
+ MaybeAssign = no,
+ Goal = UnifyGoal
+ ;
+ MaybeAssign = yes(Assign),
+ Goal = conj([UnifyGoal - GoalInfo, Assign])
+ ).
+
+fix_modes_of_binding_goal_2(disj(Goals0, SM), FMI0, _, Module, AliasedVars,
+ Var, disj(Goals, SM), FMI) :-
+ Lambda = lambda([Goal0::in, Goal::out, F0::in, F::out] is det,
+ (
+ fix_modes_info_get_instmap(F0, InstMap),
+ fix_modes_of_binding_goal(Module, AliasedVars, Var,
+ Goal0, Goal, F0, F1),
+ fix_modes_info_set_instmap(F1, InstMap, F)
+ )),
+ list__map_foldl(Lambda, Goals0, Goals, FMI0, FMI).
+
+fix_modes_of_binding_goal_2(not(Goal), FMI, _, _, _, _, not(Goal),
+ FMI).
+
+fix_modes_of_binding_goal_2(some(Vars, Goal0), FMI0, _, Module, AliasedVars,
+ Var, some(Vars, Goal), FMI) :-
+ fix_modes_of_binding_goal(Module, AliasedVars, Var, Goal0, Goal, FMI0,
+ FMI).
+
+fix_modes_of_binding_goal_2(if_then_else(Vars, Cond, Then0, Else0, SM),
+ FMI0, _, Module, AliasedVars, Var,
+ if_then_else(Vars, Cond, Then, Else, SM), FMI) :-
+ fix_modes_info_get_instmap(FMI0, InstMap0),
+ Cond = _ - CondGoalInfo,
+ goal_info_get_instmap_delta(CondGoalInfo, IMD),
+ fix_modes_info_apply_instmap_delta(FMI0, IMD, FMI1),
+ fix_modes_of_binding_goal(Module, AliasedVars, Var, Then0, Then, FMI1,
+ FMI2),
+ fix_modes_info_set_instmap(FMI2, InstMap0, FMI3),
+ fix_modes_of_binding_goal(Module, AliasedVars, Var, Else0, Else, FMI3,
+ FMI).
+
+fix_modes_of_binding_goal_2(pragma_c_code(A, B, C, Vars0, E, F, G),
+ FMI0, GoalInfo0, Module, _AliasedVars, Var, Goal, FMI) :-
+ add_unification_to_goal(Vars0, FMI0, GoalInfo0, Module, Var,
+ Vars, FMI, GoalInfo, Assign),
+ PragmaC = pragma_c_code(A, B, C, Vars, E, F, G) - GoalInfo,
+ Goal = conj([PragmaC, Assign]).
+
+fix_modes_of_binding_goal_2(class_method_call(A, B, Vars0, D, E, F), FMI0,
+ GoalInfo0, Module, _AliasedVars, Var, Goal, FMI) :-
+ add_unification_to_goal(Vars0, FMI0, GoalInfo0, Module, Var, Vars, FMI,
+ GoalInfo, Assign),
+ ClassMethodCall = class_method_call(A, B, Vars, D, E, F) - GoalInfo,
+ Goal = conj([ClassMethodCall, Assign]).
+
+:- pred add_unification_to_goal(list(var), fix_modes_info, hlds_goal_info,
+ module_info, var, list(var), fix_modes_info, hlds_goal_info,
+ hlds_goal).
+:- mode add_unification_to_goal(in, in, in, in, in, out, out, out, out) is det.
+
+add_unification_to_goal(Vars0, FMI0, GoalInfo0, Module, Var,
+ Vars, FMI, CallGoalInfo, Assign):-
+ FMI0 = fix_modes_info(VarSet0, VarTypes0, InstTable, InstMap),
+ varset__new_var(VarSet0, NewVar, VarSet),
+ map__lookup(VarTypes0, Var, Type),
+ map__det_insert(VarTypes0, NewVar, Type, VarTypes),
+
+ FMI1 = fix_modes_info(VarSet, VarTypes, InstTable, InstMap),
+
+ goal_info_get_instmap_delta(GoalInfo0, IMD0),
+ ( instmap_delta_search_var(IMD0, Var, Inst0) ->
+ Inst = Inst0
+ ;
+ error("lco:fix_modes_of_binding_goal: internal error")
+ ),
+ map__init(Sub0),
+ map__det_insert(Sub0, Var, NewVar, Sub),
+ instmap_delta_apply_sub(IMD0, no, Sub, IMD),
+ goal_info_set_instmap_delta(GoalInfo0, IMD, CallGoalInfo1),
+ goal_info_get_nonlocals(CallGoalInfo1, CallNonLocals0),
+ set__delete(CallNonLocals0, Var, CallNonLocals1),
+ set__insert(CallNonLocals1, NewVar, CallNonLocals),
+ goal_info_set_nonlocals(CallGoalInfo1, CallNonLocals, CallGoalInfo),
+
+ list__replace_all(Vars0, Var, NewVar, Vars),
+ Modes = (free(alias) -> Inst) - (Inst -> Inst),
+ goal_info_init(AssignGoalInfo0),
+ instmap_delta_init_reachable(AssignIMD0),
+ instmap_delta_set(AssignIMD0, Var, Inst, AssignIMD),
+ goal_info_set_instmap_delta(AssignGoalInfo0, AssignIMD,
+ AssignGoalInfo1),
+ goal_info_set_determinism(AssignGoalInfo1, det, AssignGoalInfo2),
+ set__list_to_set([Var, NewVar], NonLocals),
+ goal_info_set_nonlocals(AssignGoalInfo2, NonLocals, AssignGoalInfo),
+ Assign0 = unify(Var, var(NewVar), Modes, assign(Var, NewVar),
+ unify_context(explicit, [])) - AssignGoalInfo,
+
+ set__init(DummyVars),
+ fix_modes_of_binding_goal(Module, DummyVars, Var, Assign0, Assign,
+ FMI1, FMI).
+
+:- pred fix_modes_of_unify(unification, unify_rhs, unify_mode, fix_modes_info,
+ hlds_goal_info, module_info, var, unification, unify_rhs,
+ unify_mode, fix_modes_info, hlds_goal_info, maybe(hlds_goal)).
+:- mode fix_modes_of_unify(in, in, in, in, in, in, in, out, out, out, out,
+ out, out) is det.
+
+fix_modes_of_unify(construct(LHSVar, ConsId, Vars, UniModes0), RHS, Modes,
+ FMI0, GoalInfo, Module, Var,
+ construct(LHSVar, ConsId, Vars, UniModes), RHS, Modes, FMI,
+ GoalInfo, no) :-
+ ( LHSVar = Var ->
+ FMI0 = fix_modes_info(VarSet, VarTypes, InstTable0, InstMap),
+ list__map_foldl(fix_uni_mode(Module),
+ UniModes0, UniModes, InstTable0, InstTable),
+ FMI = fix_modes_info(VarSet, VarTypes, InstTable, InstMap)
+ ;
+ error("lco:fix_mode_of_unify: LHSVar \\= Var")
+ ).
+
+fix_modes_of_unify(deconstruct(LHSVar, ConsId, Vars0, UniModes, CanFail),
+ RHS0, Modes, FMI0, GoalInfo0, Module, Var,
+ deconstruct(LHSVar, ConsId, Vars, UniModes, CanFail), RHS,
+ Modes, FMI, GoalInfo, yes(Assign)) :-
+ add_unification_to_goal(Vars0, FMI0, GoalInfo0, Module, Var, Vars,
+ FMI, GoalInfo, Assign),
+ ( RHS0 = functor(ConsId, _) ->
+ RHS = functor(ConsId, Vars)
+ ;
+ RHS = RHS0
+ ).
+
+fix_modes_of_unify(assign(L, R), RHS, Modes0, FMI, GoalInfo, _, _,
+ assign(L, R), RHS, Modes, FMI, GoalInfo, no) :-
+ Modes = Modes0.
+
+% Shouldn't get simple_test binding a variable.
+fix_modes_of_unify(simple_test(_, _),_,_,_,_,_,_,_,_,_,_,_,_) :-
+ error("lco:fix_modes_of_unify: simple_test in unify").
+
+% Should already have been transformed into calls by polymorphism.m.
+fix_modes_of_unify(complicated_unify(_, _),_,_,_,_,_,_,_,_,_,_,_,_) :-
+ error("lco:fix_modes_of_unify: complicated_unify").
+
+:- pred fix_uni_mode(module_info, uni_mode, uni_mode, inst_table,
+ inst_table).
+:- mode fix_uni_mode(in, in, out, in, out) is det.
+
+fix_uni_mode(Module, UniMode0, UniMode, InstTable0, InstTable) :-
+ UniMode0 = ((LI0 - RI) -> (LF - RF)),
+ ( inst_is_free(LI0, InstTable0, Module) ->
+ ( LI0 = alias(_) ->
+ LI = LI0,
+ InstTable = InstTable0
+ ;
+ inst_table_get_inst_key_table(InstTable0, IKT0),
+ inst_key_table_add(IKT0, free(alias), IK, IKT),
+ inst_table_set_inst_key_table(InstTable0, IKT,
+ InstTable),
+ LI = alias(IK)
+ ),
+ UniMode = ((LI - RI) -> (LF - RF))
+ ;
+ error("lco:fix_uni_mode: unexpected inst")
+ ).
+
+
+% Try to find a mode of the predicate that is the same as the input ProcId0
+% except that Var is ref_in intead of top_out. Any varibles in AliasedVars
+% that are top_out in ProcId0 may be either top_out or ref_in in ProcId
+% (it is better if they are ref_in). All other args must have the same
+% mode in both procedures.
+
+:- pred replace_call_proc_with_aliased_version(pred_id, proc_id,
+ fix_modes_info, module_info, var, set(var), list(var), proc_id).
+:- mode replace_call_proc_with_aliased_version(in, in, in, in, in, in, in, out)
+ is semidet.
+
+replace_call_proc_with_aliased_version(PredId, ProcId0, FMI, Module, Var,
+ AliasedVars, CallVars, ProcId) :-
+ module_info_pred_info(Module, PredId, PredInfo),
+ pred_info_procedures(PredInfo, ProcTable),
+ map__lookup(ProcTable, ProcId0, ProcInfo0),
+ proc_info_argmodes(ProcInfo0, argument_modes(InstTableA, ModesA)),
+ FMI = fix_modes_info(_, _, InstTable, InstMap),
+
+ Lambda = lambda([ProcInfo::in] is semidet,
+ (
+ proc_info_argmodes(ProcInfo, ArgModesB),
+ ArgModesB = argument_modes(InstTableB, ModesB),
+ assoc_list__from_corresponding_lists(ModesA, ModesB, ModesAB),
+ assoc_list__from_corresponding_lists(ModesAB, CallVars,
+ ModeVars),
+ \+ ( list__member(A - B - V, ModeVars),
+ \+ (
+ mode_get_insts(Module, A, IA, FA),
+ mode_get_insts(Module, B, IB, FB),
+ inst_expand(InstTableA, Module, FA, F),
+ inst_expand(InstTableB, Module, FB, F),
+ ( V = Var ->
+ inst_is_free_alias(IB, InstTableB, Module)
+ ; set__member(V, AliasedVars) ->
+ % Make sure mode is no worse than what we already
+ % have.
+ inst_is_free_alias(IA, InstTableA, Module)
+ => inst_is_free_alias(IB, InstTableB, Module),
+
+ % If V is free(alias) then either free(alias) or
+ % free(unique) will do for the initial inst here.
+ % If the new proc has free(unique) and there is
+ % another proc that is free(alias) both for
+ % V and Var, then that proc will be found when
+ % fix_modes_of_binding_goal is called for V.
+ instmap__lookup_var(InstMap, V, InstV),
+ inst_is_free_alias(InstV, InstTable, Module)
+ => inst_is_free(IB, InstTableB, Module)
+ ;
+ inst_expand(InstTableA, Module, IA, I),
+ inst_expand(InstTableB, Module, IB, I)
+ )
+ )
+ )
+ )),
+ get_first_from_map(Lambda, ProcTable, ProcId).
+
+
+% Perhaps these two preds should be in the library?
+
+:- pred get_first_from_map(pred(V), map(K, V), K).
+:- mode get_first_from_map(pred(in) is semidet, in, out) is semidet.
+
+get_first_from_map(P, M, K) :-
+ map__to_assoc_list(M, AL),
+ get_first_from_assoc_list(P, AL, K).
+
+:- pred get_first_from_assoc_list(pred(V), assoc_list(K, V), K).
+:- mode get_first_from_assoc_list(pred(in) is semidet, in, out) is semidet.
+
+get_first_from_assoc_list(P, [K0 - V0 | Rest], K) :-
+ ( call(P, V0) ->
+ K = K0
+ ;
+ get_first_from_assoc_list(P, Rest, K)
+ ).
Index: compiler/live_vars.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/live_vars.m,v
retrieving revision 1.67.2.6
diff -u -r1.67.2.6 live_vars.m
--- 1.67.2.6 1998/06/17 04:12:59
+++ live_vars.m 1998/06/22 01:02:57
@@ -46,7 +46,7 @@
proc_info_goal(ProcInfo0, Goal0),
proc_info_interface_code_model(ProcInfo0, CodeModel),
- initial_liveness(ProcInfo0, PredId, ModuleInfo, Liveness0),
+ initial_liveness(ProcInfo0, PredId, ModuleInfo, Liveness0, _Refs),
set__init(LiveSets0),
module_info_globals(ModuleInfo, Globals),
globals__get_trace_level(Globals, TraceLevel),
Index: compiler/liveness.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/liveness.m,v
retrieving revision 1.81.2.9
diff -u -r1.81.2.9 liveness.m
--- 1.81.2.9 1998/06/17 04:13:04
+++ liveness.m 1998/06/22 01:02:57
@@ -135,8 +135,8 @@
% Return the set of variables live at the start of the procedure.
-:- pred initial_liveness(proc_info, pred_id, module_info, set(var)).
-:- mode initial_liveness(in, in, in, out) is det.
+:- pred initial_liveness(proc_info, pred_id, module_info, set(var), set(var)).
+:- mode initial_liveness(in, in, in, out, out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -174,9 +174,9 @@
live_info_init(ModuleInfo, ProcInfo1, TypeInfoLiveness,
VarTypes, Varset, LiveInfo),
- initial_liveness(ProcInfo1, PredId, ModuleInfo, Liveness0),
- detect_liveness_in_goal(Goal0, Liveness0, LiveInfo,
- _, Goal1),
+ initial_liveness(ProcInfo1, PredId, ModuleInfo, Liveness0, Refs0),
+ detect_liveness_in_goal(Goal0, Liveness0, Refs0, LiveInfo,
+ _, _, Goal1),
initial_deadness(ProcInfo1, LiveInfo, ModuleInfo, Deadness0),
detect_deadness_in_goal(Goal1, Deadness0, LiveInfo, _, Goal2),
@@ -196,12 +196,12 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred detect_liveness_in_goal(hlds_goal, set(var), live_info,
- set(var), hlds_goal).
-:- mode detect_liveness_in_goal(in, in, in, out, out) is det.
+:- pred detect_liveness_in_goal(hlds_goal, set(var), set(var), live_info,
+ set(var), set(var), hlds_goal).
+:- mode detect_liveness_in_goal(in, in, in, in, out, out, out) is det.
-detect_liveness_in_goal(Goal0 - GoalInfo0, Liveness0, LiveInfo,
- Liveness, Goal - GoalInfo) :-
+detect_liveness_in_goal(Goal0 - GoalInfo0, Liveness0, Refs0, LiveInfo,
+ Liveness, Refs, Goal - GoalInfo) :-
% work out which variables get born in this goal
liveness__get_nonlocals_and_typeinfos(LiveInfo, GoalInfo0, NonLocals),
@@ -210,13 +210,16 @@
goal_info_get_instmap_delta(GoalInfo0, InstMapDelta),
set__init(Empty),
( instmap_delta_is_unreachable(InstMapDelta) ->
- Births = Empty
+ Births = Empty,
+ RefBirths = Empty
;
set__init(Births0),
+ set__init(RefBirths0),
find_value_giving_occurrences(NewVarsList, LiveInfo,
- InstMapDelta, Births0, Births)
+ InstMapDelta, Births0, Births, RefBirths0, RefBirths)
),
set__union(Liveness0, Births, Liveness),
+ set__union(Refs0, RefBirths, Refs),
(
goal_is_atomic(Goal0)
->
@@ -228,7 +231,7 @@
;
PreDeaths = Empty,
PreBirths = Empty,
- detect_liveness_in_goal_2(Goal0, Liveness0, NonLocals,
+ detect_liveness_in_goal_2(Goal0, Liveness0, Refs0, NonLocals,
LiveInfo, ActualLiveness, Goal),
set__intersect(NonLocals, ActualLiveness, NonLocalLiveness),
set__union(NonLocalLiveness, Liveness0, FinalLiveness),
@@ -241,47 +244,51 @@
goal_info_set_pre_births(GoalInfo1, PreBirths, GoalInfo2),
goal_info_set_post_deaths(GoalInfo2, PostDeaths, GoalInfo3),
goal_info_set_post_births(GoalInfo3, PostBirths, GoalInfo4),
- goal_info_set_resume_point(GoalInfo4, no_resume_point, GoalInfo).
+ goal_info_set_refs(GoalInfo4, Refs, GoalInfo5),
+ goal_info_set_resume_point(GoalInfo5, no_resume_point, GoalInfo).
%-----------------------------------------------------------------------------%
% Here we process each of the different sorts of goals.
-:- pred detect_liveness_in_goal_2(hlds_goal_expr, set(var), set(var),
+:- pred detect_liveness_in_goal_2(hlds_goal_expr, set(var), set(var), set(var),
live_info, set(var), hlds_goal_expr).
-:- mode detect_liveness_in_goal_2(in, in, in, in, out, out) is det.
+:- mode detect_liveness_in_goal_2(in, in, in, in, in, out, out) is det.
-detect_liveness_in_goal_2(conj(Goals0), Liveness0, _, LiveInfo,
+detect_liveness_in_goal_2(conj(Goals0), Liveness0, Refs0, _, LiveInfo,
Liveness, conj(Goals)) :-
- detect_liveness_in_conj(Goals0, Liveness0, LiveInfo, Liveness, Goals).
+ detect_liveness_in_conj(Goals0, Liveness0, Refs0, LiveInfo, Liveness,
+ Goals).
-detect_liveness_in_goal_2(par_conj(Goals0, SM), Liveness0, NonLocals, LiveInfo,
- Liveness, par_conj(Goals, SM)) :-
+detect_liveness_in_goal_2(par_conj(Goals0, SM), Liveness0, Refs0, NonLocals,
+ LiveInfo, Liveness, par_conj(Goals, SM)) :-
set__init(Union0),
detect_liveness_in_par_conj(Goals0, Liveness0, NonLocals, LiveInfo,
- Union0, Union, Goals),
+ Union0, Union, Refs0, _Refs, Goals),
set__union(Liveness0, Union, Liveness).
-detect_liveness_in_goal_2(disj(Goals0, SM), Liveness0, NonLocals, LiveInfo,
- Liveness, disj(Goals, SM)) :-
+detect_liveness_in_goal_2(disj(Goals0, SM), Liveness0, Refs0, NonLocals,
+ LiveInfo, Liveness, disj(Goals, SM)) :-
set__init(Union0),
detect_liveness_in_disj(Goals0, Liveness0, NonLocals, LiveInfo,
- Union0, Union, Goals),
+ Union0, Union, Refs0, _Refs, Goals),
set__union(Liveness0, Union, Liveness).
-detect_liveness_in_goal_2(switch(Var, Det, Cases0, SM), Liveness0, NonLocals,
- LiveInfo, Liveness, switch(Var, Det, Cases, SM)) :-
+detect_liveness_in_goal_2(switch(Var, Det, Cases0, SM), Liveness0, Refs0,
+ NonLocals, LiveInfo, Liveness, switch(Var, Det, Cases, SM)) :-
detect_liveness_in_cases(Cases0, Liveness0, NonLocals, LiveInfo,
- Liveness0, Liveness, Cases).
+ Liveness0, Liveness, Refs0, _Refs, Cases).
-detect_liveness_in_goal_2(not(Goal0), Liveness0, _, LiveInfo,
+detect_liveness_in_goal_2(not(Goal0), Liveness0, Refs0, _, LiveInfo,
Liveness, not(Goal)) :-
- detect_liveness_in_goal(Goal0, Liveness0, LiveInfo, Liveness, Goal).
+ detect_liveness_in_goal(Goal0, Liveness0, Refs0, LiveInfo, Liveness,
+ _, Goal).
detect_liveness_in_goal_2(if_then_else(Vars, Cond0, Then0, Else0, SM),
- Liveness0, NonLocals, LiveInfo, Liveness,
+ Liveness0, Refs0, NonLocals, LiveInfo, Liveness,
if_then_else(Vars, Cond, Then, Else, SM)) :-
- detect_liveness_in_goal(Cond0, Liveness0, LiveInfo, LivenessCond, Cond),
+ detect_liveness_in_goal(Cond0, Liveness0, Refs0, LiveInfo, LivenessCond,
+ RefsCond, Cond),
%
% If the condition cannot succeed, any variables which become live
@@ -292,14 +299,15 @@
goal_info_get_instmap_delta(CondInfo, CondDelta),
( instmap_delta_is_unreachable(CondDelta) ->
LivenessThen = LivenessCond,
- Then1 = Then0
+ Then1 = Then0,
+ RefsThen = RefsCond
;
- detect_liveness_in_goal(Then0, LivenessCond, LiveInfo,
- LivenessThen, Then1)
+ detect_liveness_in_goal(Then0, LivenessCond, RefsCond, LiveInfo,
+ LivenessThen, RefsThen, Then1)
),
- detect_liveness_in_goal(Else0, Liveness0, LiveInfo, LivenessElse,
- Else1),
+ detect_liveness_in_goal(Else0, Liveness0, Refs0, LiveInfo, LivenessElse,
+ RefsElse, Else1),
set__union(LivenessThen, LivenessElse, Liveness),
set__intersect(Liveness, NonLocals, NonLocalLiveness),
@@ -307,38 +315,42 @@
set__difference(NonLocalLiveness, LivenessThen, ResidueThen),
set__difference(NonLocalLiveness, LivenessElse, ResidueElse),
- add_liveness_after_goal(Then1, ResidueThen, Then),
- add_liveness_after_goal(Else1, ResidueElse, Else).
+ set__union(RefsThen, RefsElse, Refs),
+
+ add_liveness_after_goal(Then1, ResidueThen, Refs, Then),
+ add_liveness_after_goal(Else1, ResidueElse, Refs, Else).
-detect_liveness_in_goal_2(some(Vars, Goal0), Liveness0, _, LiveInfo,
+detect_liveness_in_goal_2(some(Vars, Goal0), Liveness0, Refs0, _, LiveInfo,
Liveness, some(Vars, Goal)) :-
- detect_liveness_in_goal(Goal0, Liveness0, LiveInfo, Liveness, Goal).
+ detect_liveness_in_goal(Goal0, Liveness0, Refs0, LiveInfo, Liveness, _,
+ Goal).
-detect_liveness_in_goal_2(higher_order_call(_,_,_,_,_,_), _, _, _, _, _) :-
+detect_liveness_in_goal_2(higher_order_call(_,_,_,_,_,_), _, _, _, _, _, _) :-
error("higher-order-call in detect_liveness_in_goal_2").
-detect_liveness_in_goal_2(class_method_call(_,_,_,_,_,_), _, _, _, _, _) :-
+detect_liveness_in_goal_2(class_method_call(_,_,_,_,_,_), _, _, _, _, _, _) :-
error("class method call in detect_liveness_in_goal_2").
-detect_liveness_in_goal_2(call(_,_,_,_,_,_), _, _, _, _, _) :-
+detect_liveness_in_goal_2(call(_,_,_,_,_,_), _, _, _, _, _, _) :-
error("call in detect_liveness_in_goal_2").
-detect_liveness_in_goal_2(unify(_,_,_,_,_), _, _, _, _, _) :-
+detect_liveness_in_goal_2(unify(_,_,_,_,_), _, _, _, _, _, _) :-
error("unify in detect_liveness_in_goal_2").
-detect_liveness_in_goal_2(pragma_c_code(_,_,_,_,_,_,_), _, _, _, _, _) :-
+detect_liveness_in_goal_2(pragma_c_code(_,_,_,_,_,_,_), _, _, _, _, _, _) :-
error("pragma_c_code in detect_liveness_in_goal_2").
%-----------------------------------------------------------------------------%
-:- pred detect_liveness_in_conj(list(hlds_goal), set(var), live_info,
+:- pred detect_liveness_in_conj(list(hlds_goal), set(var), set(var), live_info,
set(var), list(hlds_goal)).
-:- mode detect_liveness_in_conj(in, in, in, out, out) is det.
+:- mode detect_liveness_in_conj(in, in, in, in, out, out) is det.
-detect_liveness_in_conj([], Liveness, _LiveInfo, Liveness, []).
-detect_liveness_in_conj([Goal0 | Goals0], Liveness0, LiveInfo, Liveness,
+detect_liveness_in_conj([], Liveness, _Refs0, _LiveInfo, Liveness, []).
+detect_liveness_in_conj([Goal0 | Goals0], Liveness0, Refs0, LiveInfo, Liveness,
[Goal | Goals]) :-
- detect_liveness_in_goal(Goal0, Liveness0, LiveInfo, Liveness1, Goal),
+ detect_liveness_in_goal(Goal0, Liveness0, Refs0, LiveInfo, Liveness1,
+ Refs1, Goal),
(
Goal0 = _ - GoalInfo,
goal_info_get_instmap_delta(GoalInfo, InstmapDelta),
@@ -347,7 +359,7 @@
Goals = Goals0,
Liveness = Liveness1
;
- detect_liveness_in_conj(Goals0, Liveness1, LiveInfo,
+ detect_liveness_in_conj(Goals0, Liveness1, Refs1, LiveInfo,
Liveness, Goals)
).
@@ -354,57 +366,61 @@
%-----------------------------------------------------------------------------%
:- pred detect_liveness_in_disj(list(hlds_goal), set(var), set(var),
- live_info, set(var), set(var), list(hlds_goal)).
-:- mode detect_liveness_in_disj(in, in, in, in, in, out, out) is det.
+ live_info, set(var), set(var), set(var), set(var), list(hlds_goal)).
+:- mode detect_liveness_in_disj(in, in, in, in, in, out, in, out, out) is det.
detect_liveness_in_disj([], _Liveness, _NonLocals, _LiveInfo,
- Union, Union, []).
+ Union, Union, Refs, Refs, []).
detect_liveness_in_disj([Goal0 | Goals0], Liveness, NonLocals, LiveInfo,
- Union0, Union, [Goal | Goals]) :-
- detect_liveness_in_goal(Goal0, Liveness, LiveInfo, Liveness1, Goal1),
+ Union0, Union, Refs0, Refs, [Goal | Goals]) :-
+ detect_liveness_in_goal(Goal0, Liveness, Refs0, LiveInfo, Liveness1,
+ Refs1, Goal1),
set__union(Union0, Liveness1, Union1),
detect_liveness_in_disj(Goals0, Liveness, NonLocals, LiveInfo,
- Union1, Union, Goals),
+ Union1, Union, Refs1, Refs, Goals),
set__intersect(Union, NonLocals, NonLocalUnion),
set__difference(NonLocalUnion, Liveness1, Residue),
- add_liveness_after_goal(Goal1, Residue, Goal).
+ add_liveness_after_goal(Goal1, Residue, Refs, Goal).
%-----------------------------------------------------------------------------%
:- pred detect_liveness_in_cases(list(case), set(var), set(var),
- live_info, set(var), set(var), list(case)).
-:- mode detect_liveness_in_cases(in, in, in, in, in, out, out) is det.
+ live_info, set(var), set(var), set(var), set(var), list(case)).
+:- mode detect_liveness_in_cases(in, in, in, in, in, out, in, out, out) is det.
detect_liveness_in_cases([], _Liveness, _NonLocals, _LiveInfo,
- Union, Union, []).
+ Union, Union, Refs, Refs, []).
detect_liveness_in_cases([case(Cons, IMDelta, Goal0) | Goals0], Liveness,
- NonLocals, LiveInfo, Union0, Union,
+ NonLocals, LiveInfo, Union0, Union, Refs0, Refs,
[case(Cons, IMDelta, Goal) | Goals]) :-
- detect_liveness_in_goal(Goal0, Liveness, LiveInfo, Liveness1, Goal1),
+ detect_liveness_in_goal(Goal0, Liveness, Refs0, LiveInfo, Liveness1,
+ Refs1, Goal1),
set__union(Union0, Liveness1, Union1),
detect_liveness_in_cases(Goals0, Liveness, NonLocals, LiveInfo,
- Union1, Union, Goals),
+ Union1, Union, Refs1, Refs, Goals),
set__intersect(Union, NonLocals, NonLocalUnion),
set__difference(NonLocalUnion, Liveness1, Residue),
- add_liveness_after_goal(Goal1, Residue, Goal).
+ add_liveness_after_goal(Goal1, Residue, Refs, Goal).
%-----------------------------------------------------------------------------%
:- pred detect_liveness_in_par_conj(list(hlds_goal), set(var), set(var),
- live_info, set(var), set(var), list(hlds_goal)).
-:- mode detect_liveness_in_par_conj(in, in, in, in, in, out, out) is det.
+ live_info, set(var), set(var), set(var), set(var), list(hlds_goal)).
+:- mode detect_liveness_in_par_conj(in, in, in, in, in, out, in, out, out)
+ is det.
detect_liveness_in_par_conj([], _Liveness, _NonLocals, _LiveInfo,
- Union, Union, []).
+ Union, Union, Refs, Refs, []).
detect_liveness_in_par_conj([Goal0 | Goals0], Liveness0, NonLocals, LiveInfo,
- Union0, Union, [Goal | Goals]) :-
- detect_liveness_in_goal(Goal0, Liveness0, LiveInfo, Liveness1, Goal1),
+ Union0, Union, Refs0, Refs, [Goal | Goals]) :-
+ detect_liveness_in_goal(Goal0, Liveness0, Refs0, LiveInfo, Liveness1,
+ Refs1, Goal1),
set__union(Union0, Liveness1, Union1),
detect_liveness_in_par_conj(Goals0, Liveness0, NonLocals, LiveInfo,
- Union1, Union, Goals),
+ Union1, Union, Refs1, Refs, Goals),
set__intersect(Union, NonLocals, NonLocalUnion),
set__difference(NonLocalUnion, Liveness1, Residue),
- add_liveness_after_goal(Goal1, Residue, Goal).
+ add_liveness_after_goal(Goal1, Residue, Refs, Goal).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -454,11 +470,15 @@
LiveInfo, Deadness3, Goal)
),
set__union(PostDeaths0, NewPostDeaths, PostDeaths),
- goal_info_set_post_deaths(GoalInfo0, PostDeaths, GoalInfo),
+ goal_info_set_post_deaths(GoalInfo0, PostDeaths, GoalInfo1),
set__difference(Deadness3, PreBirths0, Deadness4),
- set__union(Deadness4, PreDeaths0, Deadness).
+ set__union(Deadness4, PreDeaths0, Deadness),
+ goal_info_get_refs(GoalInfo1, Refs0),
+ set__intersect(Refs0, Deadness0, Refs),
+ goal_info_set_refs(GoalInfo1, Refs, GoalInfo).
+
% Here we process each of the different sorts of goals.
:- pred detect_deadness_in_goal_2(hlds_goal_expr, hlds_goal_info,
@@ -951,17 +971,19 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-initial_liveness(ProcInfo, PredId, ModuleInfo, Liveness) :-
+initial_liveness(ProcInfo, PredId, ModuleInfo, Liveness, Refs) :-
proc_info_headvars(ProcInfo, Vars),
proc_info_argmodes(ProcInfo, argument_modes(InstTable, Modes)),
proc_info_vartypes(ProcInfo, VarTypes),
map__apply_to_list(Vars, VarTypes, Types),
set__init(Liveness0),
+ set__init(Refs0),
(
initial_liveness_2(Vars, Modes, Types, InstTable, ModuleInfo,
- Liveness0, Liveness1)
+ Liveness0, Liveness1, Refs0, Refs1)
->
- Liveness2 = Liveness1
+ Liveness2 = Liveness1,
+ Refs2 = Refs1
;
error("initial_liveness: list length mismatch")
),
@@ -993,24 +1015,33 @@
;
NonLocals = NonLocals0
),
- set__intersect(Liveness2, NonLocals, Liveness).
+ set__intersect(Liveness2, NonLocals, Liveness),
+ set__intersect(Refs2, NonLocals, Refs).
:- pred initial_liveness_2(list(var), list(mode), list(type), inst_table,
- module_info, set(var), set(var)).
-:- mode initial_liveness_2(in, in, in, in, in, in, out) is semidet.
+ module_info, set(var), set(var), set(var), set(var)).
+:- mode initial_liveness_2(in, in, in, in, in, in, out, in, out) is semidet.
-initial_liveness_2([], [], [], _InstTable, _ModuleInfo, Liveness, Liveness).
+initial_liveness_2([], [], [], _InstTable, _ModuleInfo, Liveness, Liveness,
+ Refs, Refs).
initial_liveness_2([V | Vs], [M | Ms], [T | Ts], InstTable, ModuleInfo,
- Liveness0, Liveness) :-
+ Liveness0, Liveness, Refs0, Refs) :-
+ mode_to_arg_mode(InstTable, ModuleInfo, M, T, ArgMode),
(
- mode_to_arg_mode(InstTable, ModuleInfo, M, T, top_in)
+ ( ArgMode = top_in ; ArgMode = ref_in )
->
set__insert(Liveness0, V, Liveness1)
;
Liveness1 = Liveness0
),
- initial_liveness_2(Vs, Ms, Ts, InstTable, ModuleInfo, Liveness1, Liveness).
+ ( ArgMode = ref_in ->
+ set__insert(Refs0, V, Refs1)
+ ;
+ Refs1 = Refs0
+ ),
+ initial_liveness_2(Vs, Ms, Ts, InstTable, ModuleInfo, Liveness1,
+ Liveness, Refs1, Refs).
%-----------------------------------------------------------------------------%
@@ -1053,8 +1084,9 @@
initial_deadness_2([], [], [], _InstTable, _ModuleInfo, Deadness, Deadness).
initial_deadness_2([V | Vs], [M | Ms], [T | Ts], InstTable, ModuleInfo,
Deadness0, Deadness) :-
+ mode_to_arg_mode(InstTable, ModuleInfo, M, T, ArgMode),
(
- mode_to_arg_mode(InstTable, ModuleInfo, M, T, top_out)
+ ( ArgMode = top_out ; ArgMode = ref_out )
->
set__insert(Deadness0, V, Deadness1)
;
@@ -1065,13 +1097,14 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred add_liveness_after_goal(hlds_goal, set(var), hlds_goal).
-:- mode add_liveness_after_goal(in, in, out) is det.
+:- pred add_liveness_after_goal(hlds_goal, set(var), set(var), hlds_goal).
+:- mode add_liveness_after_goal(in, in, in, out) is det.
-add_liveness_after_goal(Goal - GoalInfo0, Residue, Goal - GoalInfo) :-
+add_liveness_after_goal(Goal - GoalInfo0, Residue, Refs, Goal - GoalInfo) :-
goal_info_get_post_births(GoalInfo0, PostBirths0),
set__union(PostBirths0, Residue, PostBirths),
- goal_info_set_post_births(GoalInfo0, PostBirths, GoalInfo).
+ goal_info_set_post_births(GoalInfo0, PostBirths, GoalInfo1),
+ goal_info_set_refs(GoalInfo1, Refs, GoalInfo).
:- pred add_deadness_before_goal(hlds_goal, set(var), hlds_goal).
:- mode add_deadness_before_goal(in, in, out) is det.
@@ -1089,16 +1122,14 @@
% or aliased; in the latter case the "value" is the location they
% should be stored in), and insert them into the accumulated set
% of value-given vars.
- %
- % We don't handle the aliasing part yet.
:- pred find_value_giving_occurrences(list(var), live_info,
- instmap_delta, set(var), set(var)).
-:- mode find_value_giving_occurrences(in, in, in, in, out) is det.
+ instmap_delta, set(var), set(var), set(var), set(var)).
+:- mode find_value_giving_occurrences(in, in, in, in, out, in, out) is det.
-find_value_giving_occurrences([], _, _, ValueVars, ValueVars).
+find_value_giving_occurrences([], _, _, ValueVars, ValueVars, RefVars, RefVars).
find_value_giving_occurrences([Var | Vars], LiveInfo, InstMapDelta,
- ValueVars0, ValueVars) :-
+ ValueVars0, ValueVars, RefVars0, RefVars) :-
live_info_get_var_types(LiveInfo, VarTypes),
live_info_get_module_info(LiveInfo, ModuleInfo),
live_info_get_inst_table(LiveInfo, InstTable),
@@ -1105,15 +1136,22 @@
map__lookup(VarTypes, Var, Type),
(
instmap_delta_search_var(InstMapDelta, Var, Inst),
- mode_to_arg_mode(InstTable, ModuleInfo, (free -> Inst), Type,
- top_out)
+ mode_to_arg_mode(InstTable, ModuleInfo,
+ (free(unique) -> Inst), Type, Mode),
+ ( Mode = top_out ; Mode = ref_out )
->
- set__insert(ValueVars0, Var, ValueVars1)
+ set__insert(ValueVars0, Var, ValueVars1),
+ ( Mode = ref_out ->
+ set__insert(RefVars0, Var, RefVars1)
+ ;
+ RefVars1 = RefVars0
+ )
;
- ValueVars1 = ValueVars0
+ ValueVars1 = ValueVars0,
+ RefVars1 = RefVars0
),
find_value_giving_occurrences(Vars, LiveInfo, InstMapDelta,
- ValueVars1, ValueVars).
+ ValueVars1, ValueVars, RefVars1, RefVars).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/llds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds.m,v
retrieving revision 1.210.2.7
diff -u -r1.210.2.7 llds.m
--- 1.210.2.7 1998/06/17 04:13:07
+++ llds.m 1998/06/22 01:28:00
@@ -581,7 +581,7 @@
:- type mem_ref
---> stackvar_ref(int) % stack slot number
; framevar_ref(int) % stack slot number
- ; heap_ref(rval, int, int). % the cell pointer,
+ ; heap_ref(rval, tag, int). % the cell pointer,
% the tag to subtract,
% and the field number
@@ -743,6 +743,13 @@
% signed or unsigned
% (used for registers, stack slots, etc.)
+ % Arguments to procedures may be either pass-by-value or
+ % pass-by-reference.
+:- type val_or_ref
+ ---> value(rval) % rval is the value of the variable.
+ ; reference(lval). % lval points to the location of the variable.
+
+
% given a non-var rval, figure out its type
:- pred llds__rval_type(rval::in, llds_type::out) is det.
Index: compiler/llds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds_out.m,v
retrieving revision 1.55.2.9
diff -u -r1.55.2.9 llds_out.m
--- 1.55.2.9 1998/06/17 04:13:11
+++ llds_out.m 1998/06/22 01:02:57
@@ -3069,9 +3069,9 @@
io__write_int(Num)
).
output_lval(mem_ref(Rval)) -->
- io__write_string("XXX("),
+ io__write_string("(*(Word *)("),
output_rval(Rval),
- io__write_string(")").
+ io__write_string("))").
%-----------------------------------------------------------------------------%
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.239.2.9
diff -u -r1.239.2.9 make_hlds.m
--- 1.239.2.9 1998/06/17 04:13:15
+++ make_hlds.m 1998/06/22 01:02:57
@@ -4070,7 +4070,6 @@
HLDS_Goal0, VarSet3, HLDS_Goal, VarSet, Info2, Info),
{ instmap_delta_init_reachable(InstMapDelta) },
{ inst_table_init(InstTable) },
-
% quantification will reduce this down to
% the proper set of nonlocal arguments.
{ goal_util__goal_vars(HLDS_Goal, LambdaGoalVars0) },
@@ -4187,8 +4186,10 @@
create_atomic_unification(A, B, Context, UnifyMainContext, UnifySubContext,
Goal) :-
- UMode = ((free - free) -> (free - free)),
- Mode = ((free -> free) - (free -> free)),
+ UMode = ((free(unique) - free(unique)) ->
+ (free(unique) - free(unique))),
+ Mode = ((free(unique) -> free(unique)) -
+ (free(unique) -> free(unique))),
UnifyInfo = complicated_unify(UMode, can_fail),
UnifyC = unify_context(UnifyMainContext, UnifySubContext),
goal_info_init(GoalInfo0),
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.53.2.6
diff -u -r1.53.2.6 mercury_compile.m
--- 1.53.2.6 1998/06/17 04:13:19
+++ mercury_compile.m 1998/06/22 03:56:30
@@ -925,16 +925,16 @@
mercury_compile__maybe_unused_args(HLDS40, Verbose, Stats, HLDS43), !,
mercury_compile__maybe_dump_hlds(HLDS43, "43", "unused_args"), !,
- mercury_compile__maybe_dead_procs(HLDS43, Verbose, Stats, HLDS46), !,
- mercury_compile__maybe_dump_hlds(HLDS46, "46", "dead_procs"), !,
+ mercury_compile__maybe_lco(HLDS43, Verbose, Stats, HLDS45), !,
+ mercury_compile__maybe_dump_hlds(HLDS45, "45", "lco"), !,
- mercury_compile__maybe_lco(HLDS46, Verbose, Stats, HLDS47), !,
- mercury_compile__maybe_dump_hlds(HLDS47, "47", "lco"), !,
+ mercury_compile__maybe_dead_procs(HLDS45, Verbose, Stats, HLDS46), !,
+ mercury_compile__maybe_dump_hlds(HLDS46, "46", "dead_procs"), !,
% map_args_to_regs affects the interface to a predicate,
% so it must be done in one phase immediately before code generation
- mercury_compile__map_args_to_regs(HLDS47, Verbose, Stats, HLDS49), !,
+ mercury_compile__map_args_to_regs(HLDS46, Verbose, Stats, HLDS49), !,
mercury_compile__maybe_dump_hlds(HLDS49, "49", "args_to_regs"), !,
{ HLDS50 = HLDS49 },
@@ -1646,7 +1646,7 @@
maybe_write_string(Verbose, "% Looking for LCO modulo constructor application ...\n"),
maybe_flush_output(Verbose),
process_all_nonimported_procs(
- update_proc_io(lco_modulo_constructors), HLDS0, HLDS),
+ update_module_io(lco_modulo_constructors), HLDS0, HLDS),
maybe_write_string(Verbose, "% done.\n"),
maybe_report_stats(Stats)
;
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.115.2.11
diff -u -r1.115.2.11 mercury_to_mercury.m
--- 1.115.2.11 1998/06/17 04:13:24
+++ mercury_to_mercury.m 1998/06/22 01:02:58
@@ -185,7 +185,7 @@
:- implementation.
-:- import_module prog_out, prog_util, hlds_pred, hlds_out, (inst), instmap.
+:- import_module prog_out, prog_util, hlds_pred, hlds_out, instmap.
:- import_module globals, options, termination.
:- import_module int, string, set, term_io, lexer, require.
:- import_module char.
@@ -648,12 +648,18 @@
{ inst_key_table_lookup(IKT, Key, Inst) },
mercury_output_inst(Expand, Inst, VarSet, InstTable)
).
-mercury_output_structured_inst(_, free, Indent, _, _) -->
+mercury_output_structured_inst(_, free(unique), Indent, _, _) -->
mercury_output_tabs(Indent),
io__write_string("free\n").
-mercury_output_structured_inst(_, free(_T), Indent, _, _) -->
+mercury_output_structured_inst(_, free(alias), Indent, _, _) -->
mercury_output_tabs(Indent),
+ io__write_string("free_alias\n").
+mercury_output_structured_inst(_, free(unique, _T), Indent, _, _) -->
+ mercury_output_tabs(Indent),
io__write_string("free(with some type)\n").
+mercury_output_structured_inst(_, free(alias, _T), Indent, _, _) -->
+ mercury_output_tabs(Indent),
+ io__write_string("free_alias(with some type)\n").
mercury_output_structured_inst(Expand, bound(Uniq, BoundInsts), Indent,
VarSet, InstTable) -->
mercury_output_tabs(Indent),
@@ -748,10 +754,14 @@
{ inst_key_table_lookup(IKT, Key, Inst) },
mercury_output_inst(Expand, Inst, VarSet, InstTable)
).
-mercury_output_inst(_, free, _, _) -->
+mercury_output_inst(_, free(unique), _, _) -->
io__write_string("free").
-mercury_output_inst(_, free(_T), _, _) -->
+mercury_output_inst(_, free(alias), _, _) -->
+ io__write_string("free_alias").
+mercury_output_inst(_, free(unique, _T), _, _) -->
io__write_string("free(with some type)").
+mercury_output_inst(_, free(alias, _T), _, _) -->
+ io__write_string("free_alias(with some type)").
mercury_output_inst(Expand, bound(Uniq, BoundInsts), VarSet, InstTable) -->
mercury_output_uniqueness(Uniq, "bound"),
io__write_string("("),
More information about the developers
mailing list