for review: retain aliasing information when merging instmaps of branched goals
David Overton
dmo at cs.mu.OZ.AU
Wed Dec 16 14:55:17 AEDT 1998
Hi Andrew,
Do you have time to review this at the moment? If not, would someone
else mind looking at it?
David
Estimated hours taken: 30 (+ unknown time by bromage)
Modify `instmap__merge' and `inst_merge' to preserve as much definite
aliasing information as possible rather than just throwing it all away
at the end of branched goals.
compiler/instmap.m:
Modify `instmap__merge' to retain aliasing information.
Algorithm:
For each pair of final instmaps in a branched goal,
- Remove singleton inst_keys from each instmap.
- Expand any inst_key substitutions that appear in one
instmap but not the other (done by `instmap__merge_subs').
XXX I'm hoping this doesn't increase the size of the
inst_table too much.
- Call inst_merge for each non-local variable.
- Work out which inst_keys need to become shared
and make them shared (uses information collected
by calls to `inst_merge').
- Recursively merge the resultant instmap with the
final instmap of the next branch.
compiler/inst_util.m:
Modify `inst_merge' to retain aliasing information and to return
information about inst_keys which may need to be made shared.
Modify make_shared_inst to fail rather than abort when called
with a free or partially-instantiated inst.
Modify `abstractly_unify_inst_functor' to return the list of argument
insts of the unification (used by `modecheck_unify_functor').
Add a higher order predicate `inst_fold' which traverses an inst
data structure with an accumulator.
compiler/modecheck_unify.m:
Modify `mode_info_make_aliased_insts' to only make aliases for
insts of live variables. This should significantly reduce the
number of aliases that we need to keep track of.
compiler/hlds_data.m: compiler/prog_data.m:
Create a new table, the substitution_inst_table, within the
inst_table, for insts created when expanding inst_key
substitutions.
compiler/mercury_to_mercury.m:
compiler/mode_util.m:
compiler/module_qual.m:
Changes related to addition of the substitution_inst_table.
compiler/mode_info.m:
Change a couple of mode declarations to allow them to compile
with both the old and new mode-checkers. Once the new
mode-checker is installed, the modes for mode_info should be
made more accurate so we can ensure the uniqueness of the
io__state within the mode_info.
compiler/simplify.m:
Re-order a conjuction in predicate simplify__goal_2. (Andrew did
this and I'm not sure why).
Index: hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.17.2.12
diff -u -w -r1.17.2.12 hlds_data.m
--- 1.17.2.12 1998/11/24 06:28:35
+++ hlds_data.m 1998/12/15 01:24:11
@@ -14,7 +14,7 @@
:- interface.
:- import_module hlds_pred, llds, prog_data, (inst), term.
-:- import_module bool, list, map, std_util.
+:- import_module bool, list, map, std_util, set_bbbtree.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -367,6 +367,12 @@
:- type mostly_uniq_inst_table == map(inst_name, maybe_inst).
+:- type substitution_inst_table == map(substitution_inst, maybe_inst).
+
+:- type substitution_inst
+ ---> substitution_inst(inst_name, set_bbbtree(inst_key),
+ inst_key_sub).
+
:- type maybe_inst ---> unknown
; known(inst).
@@ -408,17 +414,22 @@
:- pred inst_table_init(inst_table).
:- mode inst_table_init(out) is det.
-:- pred inst_table_get_all_tables(inst_table, unify_inst_table,
- merge_inst_table, ground_inst_table, any_inst_table,
+:- pred inst_table_get_all_tables(inst_table, substitution_inst_table,
+ unify_inst_table, merge_inst_table, ground_inst_table, any_inst_table,
shared_inst_table, mostly_uniq_inst_table, inst_key_table).
-:- mode inst_table_get_all_tables(in, out, out, out, out, out, out, out) is det.
+:- mode inst_table_get_all_tables(in, out, out, out, out, out, out, out, out)
+ is det.
-:- pred inst_table_set_all_tables(inst_table, unify_inst_table,
- merge_inst_table, ground_inst_table, any_inst_table,
+:- pred inst_table_set_all_tables(inst_table, substitution_inst_table,
+ unify_inst_table, merge_inst_table, ground_inst_table, any_inst_table,
shared_inst_table, mostly_uniq_inst_table, inst_key_table,
inst_table).
-:- mode inst_table_set_all_tables(in, in, in, in, in, in, in, in, out) is det.
+:- mode inst_table_set_all_tables(in, in, in, in, in, in, in, in, in, out)
+ is det.
+:- pred inst_table_get_substitution_insts(inst_table, substitution_inst_table).
+:- mode inst_table_get_substitution_insts(in, out) is det.
+
:- pred inst_table_get_unify_insts(inst_table, unify_inst_table).
:- mode inst_table_get_unify_insts(in, out) is det.
@@ -440,6 +451,10 @@
:- pred inst_table_get_inst_key_table(inst_table, inst_key_table).
:- mode inst_table_get_inst_key_table(in, out) is det.
+:- pred inst_table_set_substitution_insts(inst_table, substitution_inst_table,
+ inst_table).
+:- mode inst_table_set_substitution_insts(in, in, out) is det.
+
:- pred inst_table_set_unify_insts(inst_table, unify_inst_table, inst_table).
:- mode inst_table_set_unify_insts(in, in, out) is det.
@@ -484,7 +499,7 @@
:- type inst_table
---> inst_table(
- unit,
+ substitution_inst_table,
unify_inst_table,
merge_inst_table,
ground_inst_table,
@@ -503,8 +518,9 @@
% qualifying the modes of lambda expressions.
).
-inst_table_init(inst_table(unit, UnifyInsts, MergeInsts, GroundInsts,
+inst_table_init(inst_table(SubInsts, UnifyInsts, MergeInsts, GroundInsts,
AnyInsts, SharedInsts, NondetLiveInsts, InstKeys)) :-
+ map__init(SubInsts),
map__init(UnifyInsts),
map__init(MergeInsts),
map__init(GroundInsts),
@@ -513,17 +529,21 @@
map__init(NondetLiveInsts),
inst_key_table_init(InstKeys).
-inst_table_get_all_tables(InstTable, UnifyInsts, MergeInsts, GroundInsts,
- AnyInsts, SharedInsts, NondetLiveInsts, InstKeys) :-
- InstTable = inst_table(unit, UnifyInsts, MergeInsts, GroundInsts,
+inst_table_get_all_tables(InstTable, SubInsts, UnifyInsts, MergeInsts,
+ GroundInsts, AnyInsts, SharedInsts, NondetLiveInsts,
+ InstKeys) :-
+ InstTable = inst_table(SubInsts, UnifyInsts, MergeInsts, GroundInsts,
AnyInsts, SharedInsts, NondetLiveInsts, InstKeys).
-inst_table_set_all_tables(InstTable0, UnifyInsts, MergeInsts, GroundInsts,
- AnyInsts, SharedInsts, NondetLiveInsts, InstKeys, InstTable) :-
- InstTable0 = inst_table(A, _, _, _, _, _, _, _),
- InstTable = inst_table(A, UnifyInsts, MergeInsts, GroundInsts,
+inst_table_set_all_tables(_InstTable0, SubInsts, UnifyInsts, MergeInsts,
+ GroundInsts, AnyInsts, SharedInsts, NondetLiveInsts, InstKeys,
+ InstTable) :-
+ InstTable = inst_table(SubInsts, UnifyInsts, MergeInsts, GroundInsts,
AnyInsts, SharedInsts, NondetLiveInsts, InstKeys).
+inst_table_get_substitution_insts(inst_table(SubInsts, _, _, _, _, _, _, _),
+ SubInsts).
+
inst_table_get_unify_insts(inst_table(_, UnifyInsts, _, _, _, _, _, _),
UnifyInsts).
@@ -545,6 +565,9 @@
inst_table_get_inst_key_table(inst_table(_, _, _, _, _, _, _, InstKeyTable),
InstKeyTable).
+inst_table_set_substitution_insts(inst_table(_, B, C, D, E, F, G, H), SubInsts,
+ inst_table(SubInsts, B, C, D, E, F, G, H)).
+
inst_table_set_unify_insts(inst_table(A, _, C, D, E, F, G, H), UnifyInsts,
inst_table(A, UnifyInsts, C, D, E, F, G, H)).
Index: inst_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inst_util.m,v
retrieving revision 1.3.2.16
diff -u -w -r1.3.2.16 inst_util.m
--- 1.3.2.16 1998/09/25 01:07:45
+++ inst_util.m 1998/12/16 03:34:55
@@ -42,7 +42,7 @@
:- interface.
:- import_module hlds_module, hlds_data, prog_data, (inst), instmap.
-:- import_module list.
+:- import_module list, map, std_util, set.
:- pred abstractly_unify_inst(is_live, inst, inst, unify_is_real,
inst_table, module_info, instmap, inst, determinism,
@@ -54,10 +54,10 @@
:- pred abstractly_unify_inst_functor(is_live, inst, cons_id, list(inst),
list(is_live), unify_is_real, inst_table,
- module_info, instmap, inst, determinism,
+ module_info, instmap, inst, list(inst), determinism,
inst_table, module_info, instmap).
:- mode abstractly_unify_inst_functor(in, in, in, in, in, in, in, in, in,
- out, out, out, out, out) is semidet.
+ out, out, out, out, out, out) is semidet.
% Compute the inst that results from abstractly unifying
% a variable with a functor.
@@ -91,9 +91,11 @@
%-----------------------------------------------------------------------------%
-:- pred inst_merge(inst, inst, instmap, inst_table, module_info, inst,
- instmap, inst_table, module_info).
-:- mode inst_merge(in, in, in, in, in, out, out, out, out) is semidet.
+:- type merge_subs == map(pair(inst_key), inst_key).
+
+:- pred inst_merge(inst, inst, instmap, inst_table, module_info, merge_subs,
+ inst, instmap, inst_table, module_info, merge_subs).
+:- mode inst_merge(in, in, in, in, in, in, out, out, out, out, out) is semidet.
% inst_merge(InstA, InstB, InstC):
% Combine the insts found in different arms of a
@@ -120,6 +122,27 @@
:- mode inst_table_create_sub(in, in, out, out) is det.
%-----------------------------------------------------------------------------%
+
+:- type inst_fold_pred(T) == pred(inst, set(inst_name), T, T).
+:- mode inst_fold_pred :: (pred(in, in, in, out) is semidet).
+
+% inst_fold(InstMap, InstTable, ModuleInfo, Before, After, Inst, T0, T)
+% Recursively traverse Inst calling Before before recursive
+% calls and After after recursive calls. Traverses sub insts
+% of `bound' and `abstract_inst' and expands and traverses
+% `alias' and `defined_inst'. Before and After are passed
+% the current sub inst, the set of previously seen inst_names
+% and the current state of the accumulator; they return the
+% new state of the accumulator.
+% If a call to Before or After fails, the state of the accumulator
+% is passed on unchanged.
+
+:- pred inst_fold(instmap, inst_table, module_info, inst_fold_pred(T),
+ inst_fold_pred(T), inst, T, T).
+:- mode inst_fold(in, in, in, inst_fold_pred, inst_fold_pred, in, in, out)
+ is det.
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
@@ -660,9 +683,9 @@
% unifies a variable (or rather, it's instantiatedness)
% with a functor.
-abstractly_unify_inst_functor(Live, InstA, ConsId, ArgInsts, ArgLives, Real,
- InstTable0, ModuleInfo0, InstMap0, Inst, Det, InstTable,
- ModuleInfo, InstMap) :-
+abstractly_unify_inst_functor(Live, InstA, ConsId, ArgInsts0, ArgLives, Real,
+ InstTable0, ModuleInfo0, InstMap0, Inst, ArgInsts, Det,
+ InstTable, ModuleInfo, InstMap) :-
inst_expand_defined_inst(InstTable0, ModuleInfo0, InstA, InstA2),
( InstA2 = alias(KeyA) ->
@@ -669,12 +692,14 @@
inst_table_get_inst_key_table(InstTable0, IKT0),
instmap__inst_key_table_lookup(InstMap0, IKT0, KeyA, InstA3),
- abstractly_unify_inst_functor(Live, InstA3, ConsId, ArgInsts,
+ abstractly_unify_inst_functor(Live, InstA3, ConsId, ArgInsts0,
ArgLives, Real, InstTable0, ModuleInfo0, InstMap0,
- Inst0, Det, InstTable1, ModuleInfo, InstMap1),
+ Inst0, ArgInsts1, Det, InstTable1, ModuleInfo,
+ InstMap1),
( determinism_components(Det, _, at_most_zero) ->
Inst = not_reached,
+ ArgInsts = ArgInsts0,
InstMap = InstMap1,
InstTable = InstTable1
;
@@ -683,41 +708,44 @@
inst_table_set_inst_key_table(InstTable1, IKT,
InstTable),
Inst = alias(NewKey),
+ ArgInsts = ArgInsts1,
instmap__add_alias(InstMap1, KeyA, NewKey, InstMap)
)
;
UI0 = unify_inst_info(ModuleInfo0, InstTable0, InstMap0),
abstractly_unify_inst_functor_2(Live, Real, InstA2, ConsId,
- ArgInsts, ArgLives, UI0, Inst0, Det, UI),
+ ArgInsts0, ArgLives, UI0, Inst0, ArgInsts1, Det, UI),
UI = unify_inst_info(ModuleInfo, InstTable, InstMap),
( determinism_components(Det, _, at_most_zero) ->
- Inst = not_reached
+ Inst = not_reached,
+ ArgInsts = ArgInsts0
;
- Inst = Inst0
+ Inst = Inst0,
+ ArgInsts = ArgInsts1
)
).
:- pred abstractly_unify_inst_functor_2(is_live, unify_is_real, inst, cons_id,
list(inst), list(is_live), unify_inst_info,
- inst, determinism, unify_inst_info).
+ inst, list(inst), determinism, unify_inst_info).
:- mode abstractly_unify_inst_functor_2(in, in, in, in, in, in, in,
- out, out, out) is semidet.
+ out, out, out, out) is semidet.
% XXX need to handle `any' insts
-abstractly_unify_inst_functor_2(live, _, not_reached, _, _, _, UI,
- not_reached, erroneous, UI).
+abstractly_unify_inst_functor_2(live, _, not_reached, _, ArgInsts, _, UI,
+ not_reached, ArgInsts, erroneous, UI).
abstractly_unify_inst_functor_2(live, Real, free(_), ConsId, Args0, ArgLives,
- UI0, bound(unique, [functor(ConsId, Args)]), det, UI) :-
+ UI0, bound(unique, [functor(ConsId, Args)]), Args, det, UI) :-
assoc_list__from_corresponding_lists(Args0, ArgLives, ArgsAndLives),
abstractly_unify_bound_inst_list_with_free(Real, ArgsAndLives, Args,
UI0, UI).
-abstractly_unify_inst_functor_2(live, Real, bound(Uniq, ListX), ConsId, Args,
- ArgLives, UI0, bound(Uniq, List), Det, UI) :-
- abstractly_unify_bound_inst_list_lives(ListX, ConsId, Args, ArgLives,
- Real, UI0, List, Det0, UI),
+abstractly_unify_inst_functor_2(live, Real, bound(Uniq, ListX), ConsId, Args0,
+ ArgLives, UI0, bound(Uniq, List), Args, Det, UI) :-
+ abstractly_unify_bound_inst_list_lives(ListX, ConsId, Args0, ArgLives,
+ Real, UI0, List, Args, Det0, UI),
% Determine if there is a tag test required to factor
% into the determinism.
( ListX = [_, _ | _] ->
@@ -727,7 +755,7 @@
).
abstractly_unify_inst_functor_2(live, Real, ground(Uniq, _), ConsId, ArgInsts,
- ArgLives, UI0, Inst, Det, UI) :-
+ ArgLives, UI0, Inst, GroundArgInsts, Det, UI) :-
make_ground_inst_list_lives(ArgInsts, live, ArgLives, Uniq, Real, UI0,
GroundArgInsts, Det0, UI),
Inst = bound(Uniq, [functor(ConsId, GroundArgInsts)]),
@@ -741,20 +769,27 @@
% _, _, _) :-
% fail.
-abstractly_unify_inst_functor_2(dead, _, not_reached, _, _, _, UI,
- not_reached, erroneous, UI).
+abstractly_unify_inst_functor_2(dead, _, not_reached, _, Args, _, UI,
+ not_reached, Args, erroneous, UI).
abstractly_unify_inst_functor_2(dead, _Real, free(_), ConsId, Args, _ArgLives,
- UI, bound(unique, [functor(ConsId, Args)]), det, UI).
+ UI, bound(unique, [functor(ConsId, Args)]), Args, det, UI).
-abstractly_unify_inst_functor_2(dead, Real, bound(Uniq, ListX), ConsId, Args,
- _ArgLives, UI0, bound(Uniq, List), Det, UI) :-
- ListY = [functor(ConsId, Args)],
+abstractly_unify_inst_functor_2(dead, Real, bound(Uniq, ListX), ConsId, Args0,
+ _ArgLives, UI0, bound(Uniq, List), Args, Det, UI) :-
+ ListY = [functor(ConsId, Args0)],
abstractly_unify_bound_inst_list(dead, ListX, ListY, Real, UI0,
- List, Det, UI).
+ List, Det, UI),
+ ( List = [functor(_, Args1)] ->
+ Args = Args1
+ ; List = [] ->
+ Args = Args0
+ ;
+ error("abstractly_unify_inst_functor_2: something went wrong")
+ ).
abstractly_unify_inst_functor_2(dead, Real, ground(Uniq, _), ConsId, ArgInsts,
- _ArgLives, UI0, Inst, Det, UI) :-
+ _ArgLives, UI0, Inst, GroundArgInsts, Det, UI) :-
make_ground_inst_list(ArgInsts, dead, Uniq, Real, UI0, GroundArgInsts,
Det0, UI),
Inst = bound(Uniq, [functor(ConsId, GroundArgInsts)]),
@@ -840,14 +875,14 @@
:- pred abstractly_unify_bound_inst_list_lives(list(bound_inst), cons_id,
list(inst), list(is_live), unify_is_real, unify_inst_info,
- list(bound_inst), determinism, unify_inst_info).
+ list(bound_inst), list(inst), determinism, unify_inst_info).
:- mode abstractly_unify_bound_inst_list_lives(in, in, in, in, in, in,
- out, out, out) is semidet.
+ out, out, out, out) is semidet.
-abstractly_unify_bound_inst_list_lives([], _, _, _, _, UI,
- [], failure, UI).
+abstractly_unify_bound_inst_list_lives([], _, Args, _, _, UI,
+ [], Args, failure, UI).
abstractly_unify_bound_inst_list_lives([X|Xs], ConsIdY, ArgsY, LivesY, Real,
- UI0, L, Det, UI) :-
+ UI0, L, Args, Det, UI) :-
X = functor(ConsIdX, ArgsX),
(
ConsIdX = ConsIdY
@@ -857,7 +892,7 @@
L = [functor(ConsIdX, Args)]
;
abstractly_unify_bound_inst_list_lives(Xs, ConsIdY, ArgsY,
- LivesY, Real, UI0, L, Det, UI)
+ LivesY, Real, UI0, L, Args, Det, UI)
).
:- pred abstractly_unify_inst_list_lives(list(inst), list(inst), list(is_live),
@@ -1321,7 +1356,7 @@
:- pred maybe_make_shared_inst_list(list(inst), list(is_live), unify_inst_info,
list(inst), unify_inst_info).
-:- mode maybe_make_shared_inst_list(in, in, in, out, out) is det.
+:- mode maybe_make_shared_inst_list(in, in, in, out, out) is semidet.
maybe_make_shared_inst_list([], [], UI, [], UI).
maybe_make_shared_inst_list([Inst0 | Insts0], [IsLive | IsLives], UI0,
@@ -1340,7 +1375,7 @@
:- pred make_shared_inst_list(list(inst), unify_inst_info,
list(inst), unify_inst_info).
-:- mode make_shared_inst_list(in, in, out, out) is det.
+:- mode make_shared_inst_list(in, in, out, out) is semidet.
make_shared_inst_list([], UI, [], UI).
make_shared_inst_list([Inst0 | Insts0], UI0, [Inst | Insts], UI) :-
@@ -1352,14 +1387,20 @@
make_shared_inst_list(Insts0, InstTable0, ModuleInfo0, Sub0,
Insts, InstTable, ModuleInfo, Sub) :-
UI0 = unify_inst_info(ModuleInfo0, InstTable0, Sub0),
- make_shared_inst_list(Insts0, UI0, Insts, UI),
+ ( make_shared_inst_list(Insts0, UI0, Insts1, UI1) ->
+ Insts = Insts1,
+ UI = UI1
+ ;
+ % The caller should ensure that this case never happens.
+ error("make_shared_inst_list: inst is partially instantiated")
+ ),
UI = unify_inst_info(ModuleInfo, InstTable, Sub).
% make an inst shared; replace all occurrences of `unique' or `mostly_unique'
-% in the inst with `shared'.
+% in the inst with `shared'. Fails if the inst is only partially instantiated.
:- pred make_shared_inst(inst, unify_inst_info, inst, unify_inst_info).
-:- mode make_shared_inst(in, in, out, out) is det.
+:- mode make_shared_inst(in, in, out, out) is semidet.
make_shared_inst(not_reached, UI, not_reached, UI).
make_shared_inst(alias(Key), UI0, Inst, UI) :-
@@ -1384,12 +1425,8 @@
).
make_shared_inst(any(Uniq0), UI, any(Uniq), UI) :-
make_shared(Uniq0, Uniq).
-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) :-
- % the caller should ensure that this never happens
- error("make_shared_inst: cannot make shared version of `free(T)'").
+make_shared_inst(free(_), UI, free(_), UI) :- fail.
+make_shared_inst(free(_, T), UI, free(_, T), UI) :- fail.
make_shared_inst(bound(Uniq0, BoundInsts0), UI0, bound(Uniq, BoundInsts), UI) :-
make_shared(Uniq0, Uniq),
make_shared_bound_inst_list(BoundInsts0, UI0, BoundInsts, UI).
@@ -1396,7 +1433,7 @@
make_shared_inst(ground(Uniq0, PredInst), UI, ground(Uniq, PredInst), UI) :-
make_shared(Uniq0, Uniq).
make_shared_inst(inst_var(_), _, _, _) :-
- error("free inst var").
+ error("make_shared_inst: free inst var").
make_shared_inst(abstract_inst(_,_), UI, _, UI) :-
error("make_shared_inst(abstract_inst)").
make_shared_inst(defined_inst(InstName), UI0, Inst, UI) :-
@@ -1424,9 +1461,8 @@
% expand the inst name, and invoke ourself recursively on
% it's expansion
unify_inst_info_get_module_info(UI1, ModuleInfo1),
- unify_inst_info_get_instmap(UI1, InstMap1),
inst_lookup(InstTable1, ModuleInfo1, InstName, Inst0),
- inst_expand(InstMap1, InstTable1, ModuleInfo1, Inst0, Inst1),
+ inst_expand_defined_inst(InstTable1, ModuleInfo1, Inst0, Inst1),
make_shared_inst(Inst1, UI1, SharedInst, UI2),
% now that we have determined the resulting Inst, store
@@ -1463,7 +1499,7 @@
:- pred make_shared_bound_inst_list(list(bound_inst), unify_inst_info,
list(bound_inst), unify_inst_info).
-:- mode make_shared_bound_inst_list(in, in, out, out) is det.
+:- mode make_shared_bound_inst_list(in, in, out, out) is semidet.
make_shared_bound_inst_list([], UI, [], UI).
make_shared_bound_inst_list([Bound0 | Bounds0], UI0, [Bound | Bounds], UI) :-
@@ -1529,9 +1565,8 @@
% expand the inst name, and invoke ourself recursively on
% it's expansion
unify_inst_info_get_module_info(UI1, ModuleInfo1),
- unify_inst_info_get_instmap(UI1, InstMap1),
inst_lookup(InstTable1, ModuleInfo1, InstName, Inst0),
- inst_expand(InstMap1, InstTable1, ModuleInfo1, Inst0, Inst1),
+ inst_expand_defined_inst(InstTable1, ModuleInfo1, Inst0, Inst1),
make_mostly_uniq_inst_2(Inst1, UI1, NondetLiveInst, UI2),
% now that we have determined the resulting Inst, store
@@ -1619,6 +1654,7 @@
allow_unify_bound_any(_) :- true.
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
% inst_merge(InstA, InstB, InstC):
% Combine the insts found in different arms of a
@@ -1628,8 +1664,9 @@
% InstB specify a binding (free or bound), it must be
% the same in both.
-inst_merge(InstA, InstB, InstMap0, InstTable0, ModuleInfo0, Inst, InstMap,
- InstTable, ModuleInfo) :-
+ % YYY The InstMap returned from this may be bogus.
+inst_merge(InstA, InstB, InstMap0, InstTable0, ModuleInfo0, MergeSubs0, Inst,
+ InstMap, InstTable, ModuleInfo, MergeSubs) :-
% check whether this pair of insts is already in
% the merge_insts table
inst_table_get_merge_insts(InstTable0, MergeInstTable0),
@@ -1642,7 +1679,8 @@
Inst0 = defined_inst(merge_inst(InstA, InstB))
),
InstTable = InstTable0,
- InstMap = InstMap0
+ InstMap = InstMap0,
+ MergeSubs = MergeSubs0
;
% insert ThisInstPair into the table with value
%`unknown'
@@ -1652,10 +1690,12 @@
InstTable1),
% merge the insts
- inst_merge_2(InstA, InstB, InstMap0, InstTable1, ModuleInfo0,
- Inst0, InstMap, InstTable2, ModuleInfo),
+ inst_merge_2(InstA, InstB, InstMap0, InstTable1,
+ ModuleInfo0, MergeSubs0, Inst0, InstMap, InstTable2,
+ ModuleInfo, MergeSubs),
- % now update the value associated with ThisInstPair
+ % now update the value associated with
+ % ThisInstPair
inst_table_get_merge_insts(InstTable2, MergeInstTable2),
map__det_update(MergeInstTable2, ThisInstPair,
known(Inst0), MergeInstTable3),
@@ -1663,7 +1703,7 @@
InstTable)
),
% avoid expanding recursive insts
- ( inst_contains_instname(Inst0, InstMap0, InstTable, ModuleInfo,
+ ( inst_contains_instname(Inst0, InstMap, InstTable, ModuleInfo,
merge_inst(InstA, InstB)) ->
Inst = defined_inst(merge_inst(InstA, InstB))
;
@@ -1670,12 +1710,13 @@
Inst = Inst0
).
-:- pred inst_merge_2(inst, inst, instmap, inst_table, module_info,
- inst, instmap, inst_table, module_info).
-:- mode inst_merge_2(in, in, in, in, in, out, out, out, out) is semidet.
+:- pred inst_merge_2(inst, inst, instmap, inst_table, module_info, merge_subs,
+ inst, instmap, inst_table, module_info, merge_subs).
+:- mode inst_merge_2(in, in, in, in, in, in, out, out, out, out, out)
+ is semidet.
-inst_merge_2(InstA, InstB, InstMap0, InstTable0, ModuleInfo0, Inst,
- InstMap, InstTable, ModuleInfo) :-
+inst_merge_2(InstA, InstB, InstMap0, InstTable0, ModuleInfo0, MergeSubs0, Inst,
+ InstMap, InstTable, ModuleInfo, MergeSubs) :-
/*********
% would this test improve efficiency??
( InstA = InstB ->
@@ -1682,8 +1723,7 @@
Inst = InstA,
ModuleInfo = ModuleInfo0
;
-*********/
- % fixed!
+ ************/
inst_expand_defined_inst(InstTable0, ModuleInfo0, InstA, InstA2),
inst_expand_defined_inst(InstTable0, ModuleInfo0, InstB, InstB2),
(
@@ -1692,29 +1732,105 @@
Inst = InstA2,
ModuleInfo = ModuleInfo0,
InstTable = InstTable0,
- InstMap = InstMap0
+ InstMap = InstMap0,
+ MergeSubs = MergeSubs0
;
- InstA2 = alias(IKA)
+ InstA2 = not_reached
->
- inst_table_get_inst_key_table(InstTable0, IKT0),
- instmap__inst_key_table_lookup(InstMap0, IKT0, IKA, InstA3),
- inst_merge_3(InstA3, InstB2, InstMap0, InstTable0, ModuleInfo0,
- Inst, InstMap, InstTable, ModuleInfo)
+ Inst = InstB2,
+ ModuleInfo = ModuleInfo0,
+ InstTable = InstTable0,
+ InstMap = InstMap0,
+ MergeSubs = MergeSubs0
;
+ InstA2 = alias(IKA0),
+ InstB2 \= alias(_)
+ ->
+ UI0 = unify_inst_info(ModuleInfo0, InstTable0, InstMap0),
+ make_shared_inst(InstA2, UI0, InstA3, UI1),
+ solutions(lambda([I::out] is nondet, (
+ map__member(MergeSubs0, IKA0 - _, MergeIK),
+ I = alias(MergeIK))), Insts),
+ make_shared_inst_list(Insts, UI1, _, UI),
+ UI = unify_inst_info(ModuleInfo1, InstTable1, InstMap1),
+ InstA3 = alias(IKA),
+ inst_table_get_inst_key_table(InstTable1, IKT0),
+ instmap__inst_key_table_lookup(InstMap1, IKT0, IKA, InstA4),
+ inst_merge_3(InstA4, InstB2, InstMap1, InstTable1, ModuleInfo1,
+ MergeSubs0, Inst, InstMap, InstTable, ModuleInfo,
+ MergeSubs)
+ ;
+ InstB2 = alias(IKB0),
+ InstA2 \= alias(_)
+ ->
+ UI0 = unify_inst_info(ModuleInfo0, InstTable0, InstMap0),
+ make_shared_inst(InstB2, UI0, InstB3, UI1),
+ solutions(lambda([I::out] is nondet, (
+ map__member(MergeSubs0, _ - IKB0, MergeIK),
+ I = alias(MergeIK))), Insts),
+ make_shared_inst_list(Insts, UI1, _, UI),
+ UI = unify_inst_info(ModuleInfo1, InstTable1, InstMap1),
+ InstB3 = alias(IKB),
+ inst_table_get_inst_key_table(InstTable1, IKT0),
+ instmap__inst_key_table_lookup(InstMap1, IKT0, IKB, InstB4),
+ inst_merge_3(InstA2, InstB4, InstMap1, InstTable1, ModuleInfo1,
+ MergeSubs0, Inst, InstMap, InstTable, ModuleInfo,
+ MergeSubs)
+ ;
+ InstA2 = alias(IKA),
InstB2 = alias(IKB)
->
+ (
+ instmap__inst_keys_are_equivalent(IKA, InstMap0,
+ IKB, InstMap0)
+ ->
+ Inst = alias(IKA),
+ InstTable = InstTable0,
+ ModuleInfo = ModuleInfo0,
+ InstMap = InstMap0,
+ map__set(MergeSubs0, IKA - IKB, IKA, MergeSubs)
+ ;
+ ( map__search(MergeSubs0, IKA - IKB, IK0) ->
+ IK = IK0,
+ InstTable = InstTable0,
+ ModuleInfo = ModuleInfo0,
+ InstMap = InstMap0,
+ MergeSubs = MergeSubs0
+ ;
inst_table_get_inst_key_table(InstTable0, IKT0),
- instmap__inst_key_table_lookup(InstMap0, IKT0, IKB, InstB3),
- inst_merge_3(InstA2, InstB3, InstMap0, InstTable0, ModuleInfo0,
- Inst, InstMap, InstTable, ModuleInfo)
+ instmap__inst_key_table_lookup(InstMap0, IKT0, IKA,
+ InstA3),
+ instmap__inst_key_table_lookup(InstMap0, IKT0, IKB,
+ InstB3),
+ inst_merge_3(InstA3, InstB3, InstMap0, InstTable0,
+ ModuleInfo0, MergeSubs0, Inst0, InstMap, InstTable1,
+ ModuleInfo, MergeSubs1),
+ ( map__search(MergeSubs1, IKA - IKB, IK1) ->
+ IK = IK1,
+ MergeSubs = MergeSubs1,
+ InstTable = InstTable1
+ ;
+ % Create a new inst key for the merged inst.
+ inst_table_get_inst_key_table(InstTable1, IKT1),
+ inst_key_table_add(IKT1, Inst0, IK, IKT),
+ inst_table_set_inst_key_table(InstTable1, IKT,
+ InstTable),
+ map__det_insert(MergeSubs1, IKA - IKB, IK,
+ MergeSubs)
+ )
+ ),
+ Inst = alias(IK)
+ )
;
inst_merge_3(InstA2, InstB2, InstMap0, InstTable0, ModuleInfo0,
- Inst, InstMap, InstTable, ModuleInfo)
+ MergeSubs0, Inst, InstMap, InstTable, ModuleInfo,
+ MergeSubs)
).
-:- pred inst_merge_3(inst, inst, instmap, inst_table, module_info, inst,
- instmap, inst_table, module_info).
-:- mode inst_merge_3(in, in, in, in, in, out, out, out, out) is semidet.
+:- pred inst_merge_3(inst, inst, instmap, inst_table, module_info, merge_subs,
+ inst, instmap, inst_table, module_info, merge_subs).
+:- mode inst_merge_3(in, in, in, in, in, in, out, out, out, out, out)
+ is semidet.
% We do not yet allow merging of `free' and `any',
% except in the case where the any is `mostly_clobbered_any'
@@ -1732,15 +1848,17 @@
% too weak -- it might not be able to detect bugs as well
% as it can currently.
-inst_merge_3(any(UniqA), any(UniqB), InstMap, InstTable, M, any(Uniq),
- InstMap, InstTable, M) :-
+ % YYY Returned instmaps are completely bogus here.
+
+inst_merge_3(any(UniqA), any(UniqB), InstMap, InstTable, M, MS, any(Uniq),
+ InstMap, InstTable, M, MS) :-
merge_uniq(UniqA, UniqB, Uniq).
-inst_merge_3(any(Uniq), free(_), InstMap, InstTable, M, any(Uniq), InstMap,
- InstTable, M) :-
+inst_merge_3(any(Uniq), free(_), InstMap, InstTable, M, MS, any(Uniq),
+ InstMap, InstTable, M, MS) :-
% 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), InstMap, InstTable, M,
- any(Uniq), InstMap, InstTable, M) :-
+inst_merge_3(any(UniqA), bound(UniqB, ListB), InstMap, InstTable, M, MS,
+ any(Uniq), InstMap, InstTable, M, MS) :-
merge_uniq_bound(UniqA, UniqB, ListB, InstMap, InstTable, M, Uniq),
% we do not yet allow merge of any with free, except for clobbered anys
( ( Uniq = clobbered ; Uniq = mostly_clobbered ) ->
@@ -1748,20 +1866,20 @@
;
bound_inst_list_is_ground_or_any(ListB, InstMap, InstTable, M)
).
-inst_merge_3(any(UniqA), ground(UniqB, _), InstMap, InstTable, M, any(Uniq),
- InstMap, InstTable, M) :-
+inst_merge_3(any(UniqA), ground(UniqB, _), InstMap, InstTable, M, MS,
+ any(Uniq), InstMap, InstTable, M, MS) :-
merge_uniq(UniqA, UniqB, Uniq).
-inst_merge_3(any(UniqA), abstract_inst(_, _), InstMap, InstTable, M,
- any(Uniq), InstMap, InstTable, M) :-
+inst_merge_3(any(UniqA), abstract_inst(_, _), InstMap, InstTable, M, MS,
+ any(Uniq), InstMap, InstTable, M, MS) :-
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), InstMap, InstTable, M, any(Uniq),
- InstMap, InstTable, M) :-
+inst_merge_3(free(_), any(Uniq), InstMap, InstTable, M, MS, any(Uniq),
+ InstMap, InstTable, M, MS) :-
% 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), InstMap, InstTable, M,
- any(Uniq), InstMap, InstTable, M) :-
+inst_merge_3(bound(UniqA, ListA), any(UniqB), InstMap, InstTable, M, MS,
+ any(Uniq), InstMap, InstTable, M, MS) :-
merge_uniq_bound(UniqB, UniqA, ListA, InstMap, InstTable, M, Uniq),
% we do not yet allow merge of any with free, except for clobbered anys
( ( Uniq = clobbered ; Uniq = mostly_clobbered ) ->
@@ -1769,35 +1887,37 @@
;
bound_inst_list_is_ground_or_any(ListA, InstMap, InstTable, M)
).
-inst_merge_3(ground(UniqA, _), any(UniqB), InstMap, InstTable, M, any(Uniq),
- InstMap, InstTable, M) :-
+inst_merge_3(ground(UniqA, _), any(UniqB), InstMap, InstTable, M, MS,
+ any(Uniq), InstMap, InstTable, M, MS) :-
merge_uniq(UniqA, UniqB, Uniq).
-inst_merge_3(abstract_inst(_, _), any(UniqB), InstMap, InstTable, M,
- any(Uniq), InstMap, InstTable, M) :-
+inst_merge_3(abstract_inst(_, _), any(UniqB), InstMap, InstTable, M, MS,
+ any(Uniq), InstMap, InstTable, M, MS) :-
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(A), free(A), InstMap, InstTable, M, free(A), InstMap,
- InstTable, M).
+inst_merge_3(free(A), free(A), InstMap, InstTable, M, MS, free(A), InstMap,
+ InstTable, M, MS).
inst_merge_3(bound(UniqA, ListA), bound(UniqB, ListB), InstMap0, InstTable0,
- ModuleInfo0, bound(Uniq, List), InstMap, InstTable,
- ModuleInfo) :-
+ ModuleInfo0, MergeSubs0, bound(Uniq, List), InstMap, InstTable,
+ ModuleInfo, MergeSubs) :-
merge_uniq(UniqA, UniqB, Uniq),
bound_inst_list_merge(ListA, ListB, InstMap0, InstTable0, ModuleInfo0,
- List, InstMap, InstTable, ModuleInfo).
-inst_merge_3(bound(UniqA, ListA), ground(UniqB, _), InstMap, InstTable,
- ModuleInfo, ground(Uniq, no), InstMap, InstTable, ModuleInfo) :-
+ MergeSubs0, List, InstMap, InstTable, ModuleInfo, MergeSubs).
+inst_merge_3(bound(UniqA, ListA), ground(UniqB, _), InstMap,
+ InstTable, ModuleInfo, MS, ground(Uniq, no), InstMap, InstTable,
+ ModuleInfo, MS) :-
merge_uniq_bound(UniqB, UniqA, ListA, InstMap, InstTable, ModuleInfo,
Uniq),
bound_inst_list_is_ground(ListA, InstMap, InstTable, ModuleInfo).
-inst_merge_3(ground(UniqA, _), bound(UniqB, ListB), InstMap, InstTable,
- ModuleInfo, ground(Uniq, no), InstMap, InstTable, ModuleInfo) :-
+inst_merge_3(ground(UniqA, _), bound(UniqB, ListB), InstMap,
+ InstTable, ModuleInfo, MS, ground(Uniq, no), InstMap, InstTable,
+ ModuleInfo, MS) :-
merge_uniq_bound(UniqA, UniqB, ListB, InstMap, InstTable,
ModuleInfo, Uniq),
bound_inst_list_is_ground(ListB, InstMap, InstTable, ModuleInfo).
-inst_merge_3(ground(UniqA, MaybePredA), ground(UniqB, MaybePredB), InstMap,
- InstTable, ModuleInfo, ground(Uniq, MaybePred), InstMap,
- InstTable, ModuleInfo) :-
+inst_merge_3(ground(UniqA, MaybePredA), ground(UniqB, MaybePredB),
+ InstMap, InstTable, ModuleInfo, MS, ground(Uniq, MaybePred),
+ InstMap, InstTable, ModuleInfo, MS) :-
(
MaybePredA = yes(PredA),
MaybePredB = yes(PredB)
@@ -1823,13 +1943,13 @@
),
merge_uniq(UniqA, UniqB, Uniq).
inst_merge_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
- InstMap0, InstTable0, ModuleInfo0,
- abstract_inst(Name, Args), InstMap, InstTable,
- ModuleInfo) :-
- inst_list_merge(ArgsA, ArgsB, InstMap0, InstTable0, ModuleInfo0, Args,
- InstMap, InstTable, ModuleInfo).
-inst_merge_3(not_reached, Inst, InstMap, InstTable, M, Inst, InstMap,
- InstTable, M).
+ InstMap0, InstTable0, ModuleInfo0, MergeSubs0,
+ abstract_inst(Name, Args), InstMap, InstTable, ModuleInfo,
+ MergeSubs) :-
+ inst_list_merge(ArgsA, ArgsB, InstMap0, InstTable0, ModuleInfo0,
+ MergeSubs0, Args, InstMap, InstTable, ModuleInfo, MergeSubs).
+inst_merge_3(not_reached, Inst, InstMap, InstTable, M, MS, Inst, InstMap,
+ InstTable, M, MS).
:- pred merge_uniq(uniqueness, uniqueness, uniqueness).
:- mode merge_uniq(in, in, out) is det.
@@ -1923,18 +2043,20 @@
%-----------------------------------------------------------------------------%
:- pred inst_list_merge(list(inst), list(inst), instmap, inst_table,
- module_info, list(inst), instmap, inst_table, module_info).
-:- mode inst_list_merge(in, in, in, in, in, out, out, out, out) is semidet.
+ module_info, merge_subs, list(inst), instmap, inst_table,
+ module_info, merge_subs).
+:- mode inst_list_merge(in, in, in, in, in, in, out, out, out, out, out)
+ is semidet.
-inst_list_merge([], [], InstMap, InstTable, ModuleInfo, [], InstMap,
- InstTable, ModuleInfo).
+inst_list_merge([], [], InstMap, InstTable, ModuleInfo, MergeSubs, [], InstMap,
+ InstTable, ModuleInfo, MergeSubs).
inst_list_merge([ArgA | ArgsA], [ArgB | ArgsB], InstMap0, InstTable0,
- ModuleInfo0,
- [Arg | Args], InstMap, InstTable, ModuleInfo) :-
- inst_merge(ArgA, ArgB, InstMap0, InstTable0, ModuleInfo0,
- Arg, InstMap1, InstTable1, ModuleInfo1),
+ ModuleInfo0, MergeSubs0, [Arg | Args], InstMap, InstTable,
+ ModuleInfo, MergeSubs) :-
+ inst_merge(ArgA, ArgB, InstMap0, InstTable0, ModuleInfo0, MergeSubs0,
+ Arg, InstMap1, InstTable1, ModuleInfo1, MergeSubs1),
inst_list_merge(ArgsA, ArgsB, InstMap1, InstTable1, ModuleInfo1,
- Args, InstMap, InstTable, ModuleInfo).
+ MergeSubs1, Args, InstMap, InstTable, ModuleInfo, MergeSubs).
% bound_inst_list_merge(Xs, Ys, InstTable0, ModuleInfo0, Zs, InstTable,
% ModuleInfo):
@@ -1943,24 +2065,26 @@
% so that the functors of the output list Zs are the union
% of the functors of the input lists Xs and Ys.
-:- pred bound_inst_list_merge(list(bound_inst), list(bound_inst),
- instmap, inst_table, module_info,
- list(bound_inst), instmap, inst_table, module_info).
-:- mode bound_inst_list_merge(in, in, in, in, in, out, out, out, out)
+:- pred bound_inst_list_merge(list(bound_inst), list(bound_inst), instmap,
+ inst_table, module_info, merge_subs, list(bound_inst), instmap,
+ inst_table, module_info, merge_subs).
+:- mode bound_inst_list_merge(in, in, in, in, in, in, out, out, out, out, out)
is semidet.
-bound_inst_list_merge(Xs, Ys, InstMap0, InstTable0, ModuleInfo0,
- Zs, InstMap, InstTable, ModuleInfo) :-
+bound_inst_list_merge(Xs, Ys, InstMap0, InstTable0, ModuleInfo0, MergeSubs0,
+ Zs, InstMap, InstTable, ModuleInfo, MergeSubs) :-
( Xs = [] ->
- Zs = Ys,
+ MergeSubs = MergeSubs0,
ModuleInfo = ModuleInfo0,
InstTable = InstTable0,
- InstMap = InstMap0
+ InstMap = InstMap0,
+ Zs = Ys
; Ys = [] ->
- Zs = Xs,
+ MergeSubs = MergeSubs0,
ModuleInfo = ModuleInfo0,
InstTable = InstTable0,
- InstMap = InstMap0
+ InstMap = InstMap0,
+ Zs = Xs
;
Xs = [X | Xs1],
Ys = [Y | Ys1],
@@ -1968,23 +2092,23 @@
Y = functor(ConsIdY, ArgsY),
( ConsIdX = ConsIdY ->
inst_list_merge(ArgsX, ArgsY, InstMap0, InstTable0,
- ModuleInfo0, Args, InstMap1,
- InstTable1, ModuleInfo1),
+ ModuleInfo0, MergeSubs0, Args, InstMap1,
+ InstTable1, ModuleInfo1, MergeSubs1),
Z = functor(ConsIdX, Args),
Zs = [Z | Zs1],
bound_inst_list_merge(Xs1, Ys1, InstMap1, InstTable1,
- ModuleInfo1, Zs1, InstMap, InstTable,
- ModuleInfo)
+ ModuleInfo1, MergeSubs1, Zs1, InstMap,
+ InstTable, ModuleInfo, MergeSubs)
; compare(<, ConsIdX, ConsIdY) ->
Zs = [X | Zs1],
bound_inst_list_merge(Xs1, Ys, InstMap0, InstTable0,
- ModuleInfo0, Zs1, InstMap, InstTable,
- ModuleInfo)
+ ModuleInfo0, MergeSubs0, Zs1, InstMap,
+ InstTable, ModuleInfo, MergeSubs)
;
Zs = [Y | Zs1],
- bound_inst_list_merge(Xs, Ys1, InstMap0, InstTable0,
- ModuleInfo0, Zs1, InstMap, InstTable,
- ModuleInfo)
+ bound_inst_list_merge(Xs, Ys1, InstMap0,
+ InstTable0, ModuleInfo0, MergeSubs0, Zs1,
+ InstMap, InstTable, ModuleInfo, MergeSubs)
)
).
@@ -2035,12 +2159,13 @@
%-----------------------------------------------------------------------------%
inst_table_create_sub(InstTable0, NewInstTable, Sub, InstTable) :-
- inst_table_get_all_tables(InstTable0, UnifyInstTable0,
+ inst_table_get_all_tables(InstTable0, SubInstTable0, UnifyInstTable0,
MergeInstTable0, GroundInstTable0, AnyInstTable0,
SharedInstTable0, MostlyUniqInstTable0, IKT0),
- inst_table_get_all_tables(NewInstTable, NewUnifyInstTable,
- NewMergeInstTable, NewGroundInstTable, NewAnyInstTable,
- NewSharedInstTable, NewMostlyUniqInstTable, NewIKT),
+ inst_table_get_all_tables(NewInstTable, NewSubInstTable,
+ NewUnifyInstTable, NewMergeInstTable, NewGroundInstTable,
+ NewAnyInstTable, NewSharedInstTable, NewMostlyUniqInstTable,
+ NewIKT),
inst_key_table_create_sub(IKT0, NewIKT, Sub, IKT),
maybe_inst_det_table_apply_sub(UnifyInstTable0, NewUnifyInstTable,
@@ -2049,6 +2174,9 @@
merge_inst_table_apply_sub(MergeInstTable0, NewMergeInstTable,
MergeInstTable, Sub),
+ substitution_inst_table_apply_sub(SubInstTable0, NewSubInstTable,
+ SubInstTable, Sub),
+
maybe_inst_det_table_apply_sub(GroundInstTable0, NewGroundInstTable,
GroundInstTable, Sub),
@@ -2067,7 +2195,7 @@
;
error("NYI: inst_table_create_sub (mostly_uniq_inst_table)")
),
- inst_table_set_all_tables(InstTable0, UnifyInstTable,
+ inst_table_set_all_tables(InstTable0, SubInstTable, UnifyInstTable,
MergeInstTable, GroundInstTable, AnyInstTable,
SharedInstTable, MostlyUniqInstTable, IKT, InstTable).
@@ -2166,6 +2294,39 @@
map__set(Table0, IA - IB, Inst, Table1),
merge_inst_table_apply_sub_2(Rest, Table1, Table, Sub).
+:- pred substitution_inst_table_apply_sub(substitution_inst_table,
+ substitution_inst_table, substitution_inst_table, inst_key_sub).
+:- mode substitution_inst_table_apply_sub(in, in, out, in) is det.
+
+substitution_inst_table_apply_sub(Table0, NewTable, Table, Sub) :-
+ ( map__is_empty(Table0) ->
+ % Optimise common case
+ Table = Table0
+ ;
+ map__to_assoc_list(NewTable, NewTableAL),
+ substitution_inst_table_apply_sub_2(NewTableAL, Table0, Table,
+ Sub)
+ ).
+
+:- pred substitution_inst_table_apply_sub_2(assoc_list(substitution_inst,
+ maybe_inst), substitution_inst_table, substitution_inst_table,
+ inst_key_sub).
+:- mode substitution_inst_table_apply_sub_2(in, in, out, in) is det.
+
+substitution_inst_table_apply_sub_2([], Table, Table, _).
+substitution_inst_table_apply_sub_2(
+ [substitution_inst(InstName0, K, S) - Inst0 | Rest],
+ Table0, Table, Sub) :-
+ inst_name_apply_sub(Sub, InstName0, InstName),
+ ( Inst0 = unknown,
+ Inst = unknown
+ ; Inst0 = known(I0),
+ inst_apply_sub(Sub, I0, I),
+ Inst = known(I)
+ ),
+ map__set(Table0, substitution_inst(InstName, K, S), Inst, Table1),
+ substitution_inst_table_apply_sub_2(Rest, Table1, Table, Sub).
+
:- pred inst_name_apply_sub(inst_key_sub, inst_name, inst_name).
:- mode inst_name_apply_sub(in, in, out) is det.
@@ -2192,7 +2353,66 @@
inst_name_apply_sub(_Sub, typed_ground(Uniq, Type), typed_ground(Uniq, Type)).
inst_name_apply_sub(Sub, typed_inst(Type, Name0), typed_inst(Type, Name)) :-
inst_name_apply_sub(Sub, Name0, Name).
+inst_name_apply_sub(Sub, substitution_inst(Name0, K, S),
+ substitution_inst(Name, K, S)) :-
+ inst_name_apply_sub(Sub, Name0, Name).
+%-----------------------------------------------------------------------------%
+
+inst_fold(InstMap, InstTable, ModuleInfo, Before, After, Inst) -->
+ { set__init(Recursive) },
+ inst_fold_2(InstMap, InstTable, ModuleInfo, Recursive, Before, After,
+ Inst).
+
+:- pred inst_fold_2(instmap, inst_table, module_info, set(inst_name),
+ inst_fold_pred(T), inst_fold_pred(T), inst, T, T).
+:- mode inst_fold_2(in, in, in, in, inst_fold_pred, inst_fold_pred,
+ in, in, out) is det.
+
+inst_fold_2(InstMap, InstTable, ModuleInfo, Recursive, Before, After, Inst)
+ -->
+ ( call(Before, Inst, Recursive) -> [] ; [] ),
+ inst_fold_3(InstMap, InstTable, ModuleInfo, Recursive, Before, After,
+ Inst),
+ ( call(After, Inst, Recursive) -> [] ; [] ).
+
+:- pred inst_fold_3(instmap, inst_table, module_info, set(inst_name),
+ inst_fold_pred(T), inst_fold_pred(T), inst, T, T).
+:- mode inst_fold_3(in, in, in, in, inst_fold_pred, inst_fold_pred,
+ in, in, out) is det.
+
+inst_fold_3(_, _, _, _, _, _, any(_)) --> [].
+inst_fold_3(InstMap, InstTable, ModuleInfo, Recursive, Before, After,
+ alias(Key)) -->
+ { inst_table_get_inst_key_table(InstTable, IKT) },
+ { instmap__inst_key_table_lookup(InstMap, IKT, Key, Inst) },
+ inst_fold_2(InstMap, InstTable, ModuleInfo, Recursive, Before, After,
+ Inst).
+inst_fold_3(_, _, _, _, _, _, free(_)) --> [].
+inst_fold_3(_, _, _, _, _, _, free(_, _)) --> [].
+inst_fold_3(InstMap, InstTable, ModuleInfo, Recursive, Before, After,
+ bound(_, BoundInsts)) -->
+ list__foldl((pred(functor(_, Insts)::in, in, out) is det -->
+ list__foldl(inst_fold_2(InstMap, InstTable, ModuleInfo,
+ Recursive, Before, After), Insts)
+ ), BoundInsts).
+inst_fold_3(_, _, _, _, _, _, ground(_, _)) --> [].
+inst_fold_3(_, _, _, _, _, _, not_reached) --> [].
+inst_fold_3(_, _, _, _, _, _, inst_var(_)) --> [].
+inst_fold_3(InstMap, InstTable, ModuleInfo, Recursive0, Before, After,
+ defined_inst(InstName)) -->
+ ( { set__member(InstName, Recursive0) } ->
+ []
+ ;
+ { set__insert(Recursive0, InstName, Recursive) },
+ { inst_lookup(InstTable, ModuleInfo, InstName, Inst) },
+ inst_fold_2(InstMap, InstTable, ModuleInfo, Recursive, Before,
+ After, Inst)
+ ).
+inst_fold_3(InstMap, InstTable, ModuleInfo, Recursive, Before, After,
+ abstract_inst(_, Insts)) -->
+ list__foldl(inst_fold_2(InstMap, InstTable, ModuleInfo, Recursive,
+ Before, After), Insts).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: instmap.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/instmap.m,v
retrieving revision 1.15.2.19
diff -u -w -r1.15.2.19 instmap.m
--- 1.15.2.19 1998/11/24 06:28:56
+++ instmap.m 1998/12/16 02:06:25
@@ -267,6 +267,11 @@
%-----------------------------------------------------------------------------%
+:- pred instmap__inst_keys_are_equivalent(inst_key, instmap, inst_key, instmap).
+:- mode instmap__inst_keys_are_equivalent(in, in, in, in) is semidet.
+
+%-----------------------------------------------------------------------------%
+
:- pred instmap__get_inst_key_sub(instmap, inst_key_sub).
:- mode instmap__get_inst_key_sub(in, out) is det.
@@ -516,12 +521,12 @@
mode_info_set_instmap(InstMapAfter, ModeInfo2, ModeInfo3),
mode_info_set_inst_table(InstTable, ModeInfo3, ModeInfo).
-instmap__merge(NonLocals, InstMapList, InstMap0,
+instmap__merge(NonLocals, InstMapList0, InstMap0,
InstMap, ModuleInfo0, InstTable0, ModuleInfo, InstTable,
ErrorList) :-
- get_reachable_instmaps(InstMapList, InstMappingList),
+ get_reachable_instmaps(InstMapList0, InstMapList1),
(
- InstMappingList = []
+ InstMapList1 = []
->
InstMap = unreachable,
ModuleInfo = ModuleInfo0,
@@ -529,22 +534,19 @@
ErrorList = []
;
InstMap0 = reachable(_, _),
- InstMappingList = [InstMapping - AliasMap]
+ InstMapList1 = [InstMap1]
->
- instmap__restrict(reachable(InstMapping, AliasMap), NonLocals,
- InstMap),
+ InstMap = InstMap1,
ModuleInfo = ModuleInfo0,
InstTable = InstTable0,
ErrorList = []
;
- InstMap0 = reachable(InstMapping0, _AliasMap0)
+ InstMap0 = reachable(_, _)
->
set__to_sorted_list(NonLocals, NonLocalsList),
- instmap__merge_2(NonLocalsList, InstMapList, InstTable0,
- ModuleInfo0, InstMapping0, InstTable, ModuleInfo,
- InstMapping, ErrorList),
- map__init(AliasMap),
- InstMap = reachable(InstMapping, AliasMap)
+ instmap__merge_2(NonLocalsList, InstMapList1,
+ InstTable0, ModuleInfo0, InstMap0, InstTable,
+ ModuleInfo, InstMap, ErrorList)
;
InstMap = unreachable,
ModuleInfo = ModuleInfo0,
@@ -552,123 +554,131 @@
ErrorList = []
).
-:- pred get_reachable_instmaps(list(instmap),
- list(pair(map(prog_var, inst), inst_key_sub))).
+:- pred get_reachable_instmaps(list(instmap), list(instmap)).
:- mode get_reachable_instmaps(in, out) is det.
-get_reachable_instmaps([], []).
-get_reachable_instmaps([InstMap | InstMaps], Reachables) :-
- ( InstMap = reachable(InstMapping, AliasMap) ->
- Reachables = [InstMapping - AliasMap | Reachables1],
- get_reachable_instmaps(InstMaps, Reachables1)
+get_reachable_instmaps -->
+ list__filter(pred(reachable(_, _)::in) is semidet).
+
+%-----------------------------------------------------------------------------%
+
+:- type uniq_count
+ ---> zero
+ ; one
+ ; many.
+
+:- type uniq_counts(T) == map(T, uniq_count).
+
+:- pred inc_uniq_count(T, uniq_counts(T), uniq_counts(T)).
+:- mode inc_uniq_count(in, in, out) is det.
+
+inc_uniq_count(Item, Map0, Map) :-
+ ( map__search(Map0, Item, C0) ->
+ ( C0 = zero,
+ map__det_update(Map0, Item, one, Map)
+ ; C0 = one,
+ map__det_update(Map0, Item, many, Map)
+ ; C0 = many,
+ Map = Map0
+ )
;
- get_reachable_instmaps(InstMaps, Reachables)
+ map__det_insert(Map0, Item, one, Map)
).
+:- pred set_uniq_count_many(T, uniq_counts(T), uniq_counts(T)).
+:- mode set_uniq_count_many(in, in, out) is det.
+
+set_uniq_count_many(Item, Map0, Map) :-
+ map__set(Map0, Item, many, Map).
+
+:- pred has_count_zero(uniq_counts(T), T).
+:- mode has_count_zero(in, in) is semidet.
+
+has_count_zero(Map, Item) :-
+ % map__search(Map, Item, Count) => Count = zero.
+ \+ ( map__search(Map, Item, Count), \+ Count = zero ).
+
+:- pred has_count_one(uniq_counts(T), T).
+:- mode has_count_one(in, in) is semidet.
+
+has_count_one(Map, Item) :-
+ map__search(Map, Item, one).
+
+:- pred has_count_many(uniq_counts(T), T).
+:- mode has_count_many(in, in) is semidet.
+
+has_count_many(Map, Item) :-
+ map__search(Map, Item, many).
+
%-----------------------------------------------------------------------------%
- % instmap__get_relevant_inst_keys(Vars, InstMaps, InstTable, SeenKeys,
+ % instmap__count_inst_keys(Vars, InstMaps, InstTable, SeenKeys,
% DuplicateKeys, InstKeys):
% Return a set of all inst_keys which appear more than
% once in the instmaps.
-:- pred instmap__get_relevant_inst_keys(list(prog_var), list(instmap),
- module_info, inst_table, set_bbbtree(inst_key)).
-:- mode instmap__get_relevant_inst_keys(in, in, in, in, out) is det.
-
-instmap__get_relevant_inst_keys(Vars, InstMaps, ModuleInfo, InstTable,
- RelevantIKs) :-
- set_bbbtree__init(Seen0),
- set_bbbtree__init(Duplicate0),
- list__foldl2(instmap__get_relevant_inst_keys_2(Vars, ModuleInfo,
- InstTable),
- InstMaps, Seen0, _Seen, Duplicate0, Duplicate),
- RelevantIKs = Duplicate.
-
-:- pred instmap__get_relevant_inst_keys_2(list(prog_var), module_info,
- inst_table, instmap, set_bbbtree(inst_key),
- set_bbbtree(inst_key), set_bbbtree(inst_key),
- set_bbbtree(inst_key)).
-:- mode instmap__get_relevant_inst_keys_2(in, in, in, in,
- in, out, in, out) is det.
-
-instmap__get_relevant_inst_keys_2([], _InstTable, _ModuleInfo, _InstMap,
- Seen, Seen, Duplicate, Duplicate).
-instmap__get_relevant_inst_keys_2([V | Vs], ModuleInfo, InstTable, InstMap,
- Seen0, Seen, Duplicate0, Duplicate) :-
- instmap__lookup_var(InstMap, V, Inst),
- set_bbbtree__init(Recursive),
- instmap__get_relevant_inst_keys_in_inst(Inst, Recursive, ModuleInfo,
- InstTable, Seen0, Seen1, Duplicate0, Duplicate1),
- instmap__get_relevant_inst_keys_2(Vs, ModuleInfo, InstTable, InstMap,
- Seen1, Seen, Duplicate1, Duplicate).
-
-:- pred instmap__get_relevant_inst_keys_in_inst(inst, set_bbbtree(inst_name),
- module_info, inst_table, set_bbbtree(inst_key),
- set_bbbtree(inst_key), set_bbbtree(inst_key),
- set_bbbtree(inst_key)).
-:- mode instmap__get_relevant_inst_keys_in_inst(in, in, in, in,
- in, out, in, out) is det.
-
-instmap__get_relevant_inst_keys_in_inst(any(_), _, _, _, S, S, D, D).
-instmap__get_relevant_inst_keys_in_inst(alias(Key), Recursive, ModuleInfo,
- InstTable, S0, S, D0, D) :-
- inst_table_get_inst_key_table(InstTable, IKT),
- inst_key_table_lookup(IKT, Key, Inst),
- ( set_bbbtree__member(Key, S0) ->
- set_bbbtree__insert(D0, Key, D1),
- S1 = S0
- ;
- set_bbbtree__insert(S0, Key, S1),
- D1 = D0
- ),
- 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(bound(_, BoundInsts), Rec, ModuleInfo,
- InstTable, S0, S, D0, D) :-
- list__foldl2(lambda([BoundInst :: in, AS0 :: in, AS :: out,
- AD0 :: in, AD :: out] is det,
- ( BoundInst = functor(_, Insts),
- list__foldl2(lambda([Inst :: in, BS0 :: in, BS :: out,
- BD0 :: in, BD :: out] is det,
- instmap__get_relevant_inst_keys_in_inst(Inst,
- Rec, ModuleInfo, InstTable,
- BS0, BS, BD0, BD)),
- Insts, AS0, AS, AD0, AD)
- )
- ), BoundInsts, S0, S, D0, D).
-instmap__get_relevant_inst_keys_in_inst(ground(_, _), _, _, _, S, S, D, D).
-instmap__get_relevant_inst_keys_in_inst(not_reached, _, _, _, _, _, _, _) :-
- error("instmap__get_relevant_inst_keys_in_inst: not_reached").
-instmap__get_relevant_inst_keys_in_inst(inst_var(_), _, _, _, _, _, _, _) :-
- error("instmap__get_relevant_inst_keys_in_inst: inst_var").
-instmap__get_relevant_inst_keys_in_inst(defined_inst(InstName), Recursive0,
- ModuleInfo, InstTable, S0, S, D0, D) :-
- % This is tricky, because an inst_key is "relevant" if it
- % appears only once in an inst which is recursive. (If we
- % were to unfold the inst, it would appear multiple times.)
- ( set_bbbtree__member(InstName, Recursive0) ->
- set_bbbtree__union(S0, D0, D),
- S = S0
- ;
- set_bbbtree__insert(Recursive0, InstName, Recursive),
- set_bbbtree__init(NewS0),
- inst_lookup(InstTable, ModuleInfo, InstName, Inst),
- instmap__get_relevant_inst_keys_in_inst(Inst, Recursive,
- ModuleInfo, InstTable, NewS0, NewS, D0, D1),
- set_bbbtree__intersect(NewS, S0, NewD),
- set_bbbtree__union(NewD, D1, D),
- set_bbbtree__union(NewS, S0, S)
- ).
-instmap__get_relevant_inst_keys_in_inst(abstract_inst(_, Insts), Rec,
- ModuleInfo, InstTable, S0, S, D0, D) :-
- list__foldl2(lambda([Inst :: in, AS0 :: in, AS :: out,
- AD0 :: in, AD :: out] is det,
- instmap__get_relevant_inst_keys_in_inst(Inst,
- Rec, ModuleInfo, InstTable, AS0, AS, AD0, AD)),
- Insts, S0, S, D0, D).
+:- pred instmap__count_inst_keys_in_instmaps(list(prog_var), list(instmap),
+ module_info, inst_table, uniq_counts(inst_key)).
+:- mode instmap__count_inst_keys_in_instmaps(in, in, in, in, out) is det.
+
+instmap__count_inst_keys_in_instmaps(Vars, InstMaps, ModuleInfo, InstTable,
+ IKCounts) :-
+ map__init(IKCounts0),
+ list__foldl(instmap__count_inst_keys_2(Vars, ModuleInfo, InstTable),
+ InstMaps, IKCounts0, IKCounts).
+
+:- pred instmap__count_inst_keys(list(prog_var), module_info, inst_table,
+ instmap, uniq_counts(inst_key)).
+:- mode instmap__count_inst_keys(in, in, in, in, out) is det.
+
+instmap__count_inst_keys(Vars, ModuleInfo, InstTable, InstMap, IKCounts) :-
+ map__init(IKCounts0),
+ instmap__count_inst_keys_2(Vars, ModuleInfo, InstTable, InstMap,
+ IKCounts0, IKCounts).
+
+:- pred instmap__count_inst_keys_2(list(prog_var), module_info,
+ inst_table, instmap, uniq_counts(inst_key), uniq_counts(inst_key)).
+:- mode instmap__count_inst_keys_2(in, in, in, in, in, out) is det.
+
+instmap__count_inst_keys_2([], _InstTable, _ModuleInfo, _InstMap) --> [].
+instmap__count_inst_keys_2([V | Vs], ModuleInfo, InstTable, InstMap) -->
+ { instmap__lookup_var(InstMap, V, Inst) },
+ { set__init(SeenTwice) },
+ instmap__count_inst_keys_in_inst(InstMap, InstTable, ModuleInfo,
+ SeenTwice, Inst),
+ instmap__count_inst_keys_2(Vs, ModuleInfo, InstTable, InstMap).
+
+:- pred instmap__count_inst_keys_in_inst(instmap, inst_table, module_info,
+ set(inst_name), inst, uniq_counts(inst_key), uniq_counts(inst_key)).
+:- mode instmap__count_inst_keys_in_inst(in, in, in, in, in, in, out) is det.
+
+instmap__count_inst_keys_in_inst(InstMap, InstTable, ModuleInfo, SeenTwice,
+ Inst) -->
+ inst_fold(InstMap, InstTable, ModuleInfo, count_inst_keys_before,
+ count_inst_keys_after(InstMap, InstTable, ModuleInfo, SeenTwice),
+ Inst).
+
+:- pred count_inst_keys_before((inst)::in, set(inst_name)::in,
+ uniq_counts(inst_key)::in, uniq_counts(inst_key)::out) is semidet.
+
+count_inst_keys_before(alias(Key), _) -->
+ inc_uniq_count(Key).
+
+:- pred count_inst_keys_after(instmap::in, inst_table::in, module_info::in,
+ set(inst_name)::in, (inst)::in, set(inst_name)::in,
+ uniq_counts(inst_key)::in, uniq_counts(inst_key)::out) is semidet.
+
+count_inst_keys_after(InstMap, InstTable, ModuleInfo, SeenTwice0,
+ defined_inst(InstName), SeenOnce) -->
+ { set__member(InstName, SeenOnce) },
+ { \+ set__member(InstName, SeenTwice0) },
+ { set__insert(SeenTwice0, InstName, SeenTwice) },
+
+ % We need to count the inst_keys in a recursive inst twice
+ % because the inst may be unfolded an arbitrary number of
+ % times.
+ instmap__count_inst_keys_in_inst(InstMap, InstTable, ModuleInfo,
+ SeenTwice, defined_inst(InstName)).
%-----------------------------------------------------------------------------%
@@ -677,62 +687,380 @@
% there are two instmaps in `InstMaps' for which the inst
% the variable is incompatible.
-:- pred instmap__merge_2(list(prog_var), list(instmap), inst_table, module_info,
- map(prog_var, inst), inst_table, module_info,
- map(prog_var, inst), merge_errors).
+:- pred instmap__merge_2(list(prog_var), list(instmap), inst_table,
+ module_info, instmap, inst_table, module_info, instmap,
+ merge_errors).
:- mode instmap__merge_2(in, in, in, in, in, out, out, out, out) is det.
-instmap__merge_2([], _, InstTable, ModuleInfo, InstMap, InstTable, ModuleInfo,
+instmap__merge_2(_, [], InstTable, ModuleInfo, InstMap, InstTable, ModuleInfo,
InstMap, []).
-instmap__merge_2([Var|Vars], InstMapList, InstTable0, ModuleInfo0, InstMap0,
- InstTable, ModuleInfo, InstMap, ErrorList) :-
- instmap__merge_2(Vars, InstMapList, InstTable0, ModuleInfo0, InstMap0,
- InstTable1, ModuleInfo1, InstMap1, ErrorList1),
- instmap__merge_var(InstMapList, Var, InstTable1, ModuleInfo1,
- Insts, Inst, InstTable, ModuleInfo, Error),
- ( Error = yes ->
- ErrorList = [Var - Insts | ErrorList1],
- map__set(InstMap1, Var, not_reached, InstMap)
+instmap__merge_2(Vars, [InstMapA | InstMaps], InstTable0, ModuleInfo0,
+ InstMap0, InstTable, ModuleInfo, InstMap, ErrorList) :-
+ instmap__merge_3(Vars, InstMapA, InstMaps, InstTable0, ModuleInfo0,
+ InstMap0, InstTable, ModuleInfo, InstMap1, ErrorList),
+ instmap__remove_singleton_inst_keys(Vars, ModuleInfo, InstTable,
+ InstMap1, InstMap).
+
+:- pred instmap__merge_3(list(prog_var), instmap, list(instmap), inst_table,
+ module_info, instmap, inst_table, module_info, instmap,
+ merge_errors).
+:- mode instmap__merge_3(in, in, in, in, in, in, out, out, out, out) is det.
+
+instmap__merge_3(_, InstMap, [], InstTable, ModuleInfo, _InstMap0, InstTable,
+ ModuleInfo, InstMap, []).
+instmap__merge_3(Vars, InstMapA0, [InstMapB0 | InstMaps], InstTable0,
+ ModuleInfo0, InstMap00, InstTable, ModuleInfo, InstMap,
+ ErrorList) :-
+ instmap__remove_singleton_inst_keys(Vars, ModuleInfo0, InstTable0,
+ InstMapA0, InstMapA1),
+ instmap__remove_singleton_inst_keys(Vars, ModuleInfo0, InstTable0,
+ InstMapB0, InstMapB1),
+
+ instmap__merge_subs(InstMapA1, InstMapB1, InstMap00, InstTable0,
+ ModuleInfo0, InstMapA, InstMapB, InstMap0, InstTable1),
+
+ map__init(MergeSubs0),
+ instmap__merge_4(Vars, InstMapA, InstMapB, InstTable1, ModuleInfo0,
+ InstMap0, MergeSubs0, InstTable2, ModuleInfo1, InstMapAB0,
+ MergeSubs, ErrorList0),
+
+ % Work out which inst keys need to be made shared.
+ solutions(lambda([I::out] is nondet, (
+ map__member(MergeSubs, IKA0 - IKB0, IK),
+ map__member(MergeSubs, IKA1 - IKB1, _),
+ \+ (
+ instmap__inst_keys_are_equivalent(IKA0, InstMapAB0,
+ IKA1, InstMapAB0)
+ <=>
+ instmap__inst_keys_are_equivalent(IKB0, InstMapAB0,
+ IKB1, InstMapAB0)
+ ),
+ I = alias(IK) )), Insts),
+ make_shared_inst_list(Insts, InstTable2, ModuleInfo1, InstMapAB0,
+ _, InstTable3, ModuleInfo2, InstMapAB),
+
+ instmap__merge_3(Vars, InstMapAB, InstMaps, InstTable3, ModuleInfo2,
+ InstMap0, InstTable, ModuleInfo, InstMap, ErrorList1),
+ list__append(ErrorList0, ErrorList1, ErrorList).
+
+:- pred instmap__merge_4(list(prog_var), instmap, instmap, inst_table,
+ module_info, instmap, merge_subs, inst_table, module_info, instmap,
+ merge_subs, merge_errors).
+:- mode instmap__merge_4(in, in, in, in, in, in, in, out, out, out, out, out)
+ is det.
+
+instmap__merge_4([], _, _, InstTable, ModuleInfo, InstMap, MergeSubs,
+ InstTable, ModuleInfo, InstMap, MergeSubs, []).
+instmap__merge_4([Var | Vars], InstMapA, InstMapB, InstTable0, ModuleInfo0,
+ InstMap0, MergeSubs0, InstTable, ModuleInfo, InstMap, MergeSubs,
+ Errors) :-
+ instmap__merge_4(Vars, InstMapA, InstMapB, InstTable0, ModuleInfo0,
+ InstMap0, MergeSubs0, InstTable1, ModuleInfo1, InstMap1,
+ MergeSubs1, Errors1),
+ instmap__lookup_var(InstMapA, Var, InstA),
+ instmap__lookup_var(InstMapB, Var, InstB),
+ (
+ inst_merge(InstA, InstB, InstMap1, InstTable1, ModuleInfo1,
+ MergeSubs1, Inst, InstMap2, InstTable2, ModuleInfo2,
+ MergeSubs2)
+ ->
+ instmap__set(InstMap2, Var, Inst, InstMap),
+ Errors = Errors1,
+ ModuleInfo = ModuleInfo2,
+ InstTable = InstTable2,
+ MergeSubs = MergeSubs2
;
- ErrorList = ErrorList1,
- map__set(InstMap1, Var, Inst, InstMap)
+ instmap__set(InstMap1, Var, not_reached, InstMap),
+ Errors = [Var - [InstA, InstB] | Errors1],
+ ModuleInfo = ModuleInfo1,
+ InstTable = InstTable1,
+ MergeSubs = MergeSubs1
).
- % instmap_merge_var(InstMaps, Var, ModuleInfo, Insts, Error):
- % Let `Insts' be the list of the inst of `Var' in the
- % corresponding `InstMaps'. Let `Error' be yes iff
- % there are two instmaps for which the inst of `Var'
- % is incompatible.
-
-:- pred instmap__merge_var(list(instmap), prog_var, inst_table, module_info,
- list(inst), inst, inst_table, module_info, bool).
-:- mode instmap__merge_var(in, in, in, in, out, out, out, out, out) is det.
-
-instmap__merge_var([], _, InstTable, ModuleInfo, [],
- not_reached, InstTable, ModuleInfo, no).
-instmap__merge_var([InstMap | InstMaps], Var, InstTable0, ModuleInfo0,
- InstList, Inst, InstTable, ModuleInfo, Error) :-
- instmap__merge_var(InstMaps, Var, InstTable0, ModuleInfo0,
- InstList0, Inst0, InstTable1, ModuleInfo1, Error0),
- instmap__lookup_var(InstMap, Var, VarInst0),
- inst_table_get_inst_key_table(InstTable1, IKT1),
- inst_expand_fully(IKT1, InstMap, VarInst0, VarInst),
- InstList = [VarInst | InstList0],
+:- pred instmap__merge_subs(instmap, instmap, instmap, inst_table, module_info,
+ instmap, instmap, instmap, inst_table).
+:- mode instmap__merge_subs(in, in, in, in, in, out, out, out, out) is det.
+
+instmap__merge_subs(InstMapA0, InstMapB0, InstMap00, InstTable0, ModuleInfo,
+ InstMapA, InstMapB, InstMap0, InstTable) :-
+ (
+ InstMapA0 = reachable(InstMappingA0, SubA0),
+ InstMapB0 = reachable(InstMappingB0, SubB0)
+ ->
+ solutions(lambda([K::out] is nondet,
+ (
+ map__member(SubA0, K, V),
+ \+ map__search(SubB0, K, V)
+ ;
+ map__member(SubB0, K, V),
+ \+ map__search(SubA0, K, V)
+ )), KeysList),
+ set_bbbtree__sorted_list_to_set(KeysList, Keys),
+ instmap__expand_subs(Keys, ModuleInfo, SubA0, InstMappingA0,
+ InstMappingA, InstTable0, InstTable1),
+ instmap__expand_subs(Keys, ModuleInfo, SubB0, InstMappingB0,
+ InstMappingB, InstTable1, InstTable),
+ map__delete_list(SubA0, KeysList, Sub),
+ InstMapA = reachable(InstMappingA, Sub),
+ InstMapB = reachable(InstMappingB, Sub),
+ ( InstMap00 = reachable(InstMapping0, _) ->
+ InstMap0 = reachable(InstMapping0, Sub)
+ ;
+ error("instmap__merge_subs: initial instmap unreachable")
+ )
+ ;
+ error("instmap__merge_subs: unreachable instmap(s)")
+ ).
+
+:- pred instmap__expand_subs(set_bbbtree(inst_key), module_info, inst_key_sub,
+ instmapping, instmapping, inst_table, inst_table).
+:- mode instmap__expand_subs(in, in, in, in, out, in, out) is det.
+
+instmap__expand_subs(Keys, ModuleInfo, Sub, InstMapping0, InstMapping,
+ InstTable0, InstTable) :-
+ map__to_assoc_list(InstMapping0, AL0),
+ map__init(SeenIKs),
+ instmap__expand_subs_2(Keys, ModuleInfo, Sub, SeenIKs, AL0, AL,
+ InstTable0, InstTable),
+ map__from_assoc_list(AL, InstMapping).
+
+:- pred instmap__expand_subs_2(set_bbbtree(inst_key), module_info, inst_key_sub,
+ inst_key_sub, assoc_list(prog_var, inst),
+ assoc_list(prog_var, inst), inst_table, inst_table).
+:- mode instmap__expand_subs_2(in, in, in, in, in, out, in, out) is det.
+
+instmap__expand_subs_2(_, _, _, _, [], [], InstTable, InstTable).
+instmap__expand_subs_2(Keys, ModuleInfo, Sub, SeenIKs0,
+ [Var - Inst0 | VarInsts0], [Var - Inst | VarInsts],
+ InstTable0, InstTable) :-
+ instmap__expand_inst_sub(Keys, ModuleInfo, Sub, SeenIKs0, SeenIKs,
+ Inst0, Inst, InstTable0, InstTable1),
+ instmap__expand_subs_2(Keys, ModuleInfo, Sub, SeenIKs,
+ VarInsts0, VarInsts, InstTable1, InstTable).
+
+:- pred instmap__expand_inst_sub(set_bbbtree(inst_key), module_info,
+ inst_key_sub, inst_key_sub, inst_key_sub, inst, inst,
+ inst_table, inst_table).
+:- mode instmap__expand_inst_sub(in, in, in, in, out, in, out, in, out) is det.
+
+instmap__expand_inst_sub(Keys, ModuleInfo, Sub, SeenIKs0, SeenIKs,
+ alias(IK0), Inst, InstTable0, InstTable) :-
+ ( map__search(SeenIKs0, IK0, IK1) ->
+ % We have seen IK0 before and replaced it with IK1.
+ Inst = alias(IK1),
+ SeenIKs = SeenIKs0,
+ InstTable = InstTable0
+ ; map__search(Sub, IK0, IK1) ->
+ % IK0 has a substitution so recursively expand it.
+ instmap__expand_inst_sub(Keys, ModuleInfo, Sub, SeenIKs0,
+ SeenIKs1, alias(IK1), Inst1, InstTable0, InstTable),
(
- % YYY Not sure about the returned InstMap here.
- inst_merge(Inst0, VarInst, InstMap, InstTable1, ModuleInfo1,
- Inst1, _, InstTable2, ModuleInfo2)
+ Inst1 = alias(IK1),
+ \+ set_bbbtree__member(IK0, Keys)
->
+ Inst = alias(IK0),
+ map__det_insert(SeenIKs1, IK0, IK0, SeenIKs)
+ ;
Inst = Inst1,
- ModuleInfo = ModuleInfo2,
- Error = Error0,
- InstTable = InstTable2
+ ( Inst = alias(IK2) ->
+ map__det_insert(SeenIKs1, IK0, IK2, SeenIKs)
;
- Error = yes,
- ModuleInfo = ModuleInfo1,
- Inst = not_reached,
- InstTable = InstTable1
+ error("instmap__expand_inst_sub")
+ )
+ )
+ ;
+ inst_table_get_inst_key_table(InstTable0, IKT0),
+ inst_key_table_lookup(IKT0, IK0, Inst0),
+ instmap__expand_inst_sub(Keys, ModuleInfo, Sub, SeenIKs0,
+ SeenIKs1, Inst0, Inst1, InstTable0, InstTable1),
+ ( Inst0 = Inst1 ->
+ Inst = alias(IK0),
+ InstTable = InstTable1,
+ map__det_insert(SeenIKs1, IK0, IK0, SeenIKs)
+ ;
+ % Inst has changed so we need to create a new inst_key.
+ inst_table_get_inst_key_table(InstTable1, IKT1),
+ inst_key_table_add(IKT1, Inst1, IK1, IKT),
+ inst_table_set_inst_key_table(InstTable1, IKT,
+ InstTable),
+ map__det_insert(SeenIKs1, IK0, IK1, SeenIKs),
+ Inst = alias(IK1)
+ )
+ ).
+instmap__expand_inst_sub(_, _, _, SeenIKs, SeenIKs, any(U), any(U),
+ InstTable, InstTable).
+instmap__expand_inst_sub(_, _, _, SeenIKs, SeenIKs, free(A), free(A),
+ InstTable, InstTable).
+instmap__expand_inst_sub(_, _, _, SeenIKs, SeenIKs, free(A, T),
+ free(A, T), InstTable, InstTable).
+instmap__expand_inst_sub(_, _, _, SeenIKs, SeenIKs, ground(U, P),
+ ground(U, P), InstTable, InstTable).
+instmap__expand_inst_sub(_, _, _, SeenIKs, SeenIKs, not_reached,
+ not_reached, InstTable, InstTable).
+instmap__expand_inst_sub(_, _, _, _, _, inst_var(_), _, _, _) :-
+ error("instmap__expand_inst_sub: inst_var(_)").
+instmap__expand_inst_sub(Keys, ModuleInfo, Sub, SeenIKs0, SeenIKs,
+ bound(U, BoundInsts0), bound(U, BoundInsts),
+ InstTable0, InstTable) :-
+ instmap__expand_bound_insts_sub(Keys, ModuleInfo, Sub, SeenIKs0,
+ SeenIKs, BoundInsts0, BoundInsts, InstTable0, InstTable).
+instmap__expand_inst_sub(Keys, ModuleInfo, Sub, SeenIKs0, SeenIKs,
+ abstract_inst(N, Insts0), abstract_inst(N, Insts),
+ InstTable0, InstTable) :-
+ instmap__expand_inst_list_sub(Keys, ModuleInfo, Sub, SeenIKs0, SeenIKs,
+ Insts0, Insts, InstTable0, InstTable).
+instmap__expand_inst_sub(Keys, ModuleInfo, Sub, SeenIKs0, SeenIKs,
+ defined_inst(InstName), Inst, InstTable0, InstTable) :-
+ inst_table_get_substitution_insts(InstTable0, SubInsts0),
+ SubInst = substitution_inst(InstName, Keys, Sub),
+ SubInstName = substitution_inst(InstName, Keys, Sub),
+ (
+ map__search(SubInsts0, SubInst, Result)
+ ->
+ ( Result = known(Inst0) ->
+ Inst2 = Inst0
+ ;
+ Inst2 = defined_inst(SubInstName)
+ ),
+ SeenIKs = SeenIKs0,
+ InstTable = InstTable0
+ ;
+ % Insert the inst_name in the substitution_inst_table with
+ % value `unknown' for the moment.
+ map__det_insert(SubInsts0, SubInst, unknown, SubInsts1),
+ inst_table_set_substitution_insts(InstTable0, SubInsts1,
+ InstTable1),
+
+ % Recursively expand the inst.
+ inst_lookup(InstTable1, ModuleInfo, InstName, Inst0),
+ inst_expand_defined_inst(InstTable1, ModuleInfo, Inst0, Inst1),
+ instmap__expand_inst_sub(Keys, ModuleInfo, Sub, SeenIKs0,
+ SeenIKs, Inst1, Inst2, InstTable1, InstTable2),
+
+ % Update the substitution_inst_table with the known value.
+ inst_table_get_substitution_insts(InstTable2, SubInsts2),
+ map__det_update(SubInsts2, SubInst, known(Inst2), SubInsts),
+ inst_table_set_substitution_insts(InstTable2, SubInsts,
+ InstTable)
+ ),
+ % Avoid expanding recursive insts.
+ map__init(InstMapping),
+ (
+ % InstMapping is not used by inst_contains_instname.
+ inst_contains_instname(Inst2, reachable(InstMapping, Sub),
+ InstTable, ModuleInfo, InstName)
+ ->
+ Inst = defined_inst(InstName)
+ ;
+ % InstMapping is not used by inst_contains_instname.
+ inst_contains_instname(Inst2, reachable(InstMapping, Sub),
+ InstTable, ModuleInfo, SubInstName)
+ ->
+ Inst = defined_inst(SubInstName)
+ ;
+ Inst = Inst2
+ ).
+
+:- pred instmap__expand_bound_insts_sub(set_bbbtree(inst_key), module_info,
+ inst_key_sub, inst_key_sub, inst_key_sub, list(bound_inst),
+ list(bound_inst), inst_table, inst_table).
+:- mode instmap__expand_bound_insts_sub(in, in, in, in, out, in, out, in, out)
+ is det.
+
+instmap__expand_bound_insts_sub(_, _, _, SeenIKs, SeenIKs, [], [],
+ InstTable, InstTable).
+instmap__expand_bound_insts_sub(Keys, ModuleInfo, Sub, SeenIKs0, SeenIKs,
+ [functor(ConsId, Insts0) | BoundInsts0],
+ [functor(ConsId, Insts) | BoundInsts], InstTable0, InstTable) :-
+ instmap__expand_inst_list_sub(Keys, ModuleInfo, Sub,
+ SeenIKs0, SeenIKs1, Insts0, Insts, InstTable0, InstTable1),
+ instmap__expand_bound_insts_sub(Keys, ModuleInfo, Sub,
+ SeenIKs1, SeenIKs, BoundInsts0, BoundInsts,
+ InstTable1, InstTable).
+
+:- pred instmap__expand_inst_list_sub(set_bbbtree(inst_key), module_info,
+ inst_key_sub, inst_key_sub, inst_key_sub, list(inst), list(inst),
+ inst_table, inst_table).
+:- mode instmap__expand_inst_list_sub(in, in, in, in, out, in, out, in, out)
+ is det.
+
+instmap__expand_inst_list_sub(_, _, _, SeenIKs, SeenIKs, [], [],
+ InstTable, InstTable).
+instmap__expand_inst_list_sub(Keys, ModuleInfo, Sub,
+ SeenIKs0, SeenIKs, [Inst0 | Insts0], [Inst | Insts],
+ InstTable0, InstTable) :-
+ instmap__expand_inst_sub(Keys, ModuleInfo, Sub, SeenIKs0,
+ SeenIKs1, Inst0, Inst, InstTable0, InstTable1),
+ instmap__expand_inst_list_sub(Keys, ModuleInfo, Sub,
+ SeenIKs1, SeenIKs, Insts0, Insts, InstTable1, InstTable).
+
+%-----------------------------------------------------------------------------%
+
+:- pred instmap__remove_singleton_inst_keys(list(prog_var), module_info,
+ inst_table, instmap, instmap).
+:- mode instmap__remove_singleton_inst_keys(in, in, in, in, out) is det.
+
+instmap__remove_singleton_inst_keys(Vars, ModuleInfo, InstTable, InstMap0,
+ InstMap) :-
+ instmap__count_inst_keys(Vars, ModuleInfo, InstTable, InstMap0,
+ IKCounts),
+ list__foldl(instmap__remove_singleton_inst_keys_2(IKCounts, ModuleInfo,
+ InstTable), Vars, InstMap0, InstMap).
+
+:- pred instmap__remove_singleton_inst_keys_2(uniq_counts(inst_key),
+ module_info, inst_table, prog_var, instmap, instmap).
+:- mode instmap__remove_singleton_inst_keys_2(in, in, in, in, in, out) is det.
+
+instmap__remove_singleton_inst_keys_2(IKCounts, ModuleInfo, InstTable, Var,
+ InstMap0, InstMap) :-
+ instmap__lookup_var(InstMap0, Var, Inst0),
+ instmap__remove_singleton_inst_key_from_inst(IKCounts, ModuleInfo,
+ InstTable, InstMap0, Inst0, Inst),
+ instmap__set(InstMap0, Var, Inst, InstMap).
+
+:- pred instmap__remove_singleton_inst_key_from_inst(uniq_counts(inst_key),
+ module_info, inst_table, instmap, inst, inst).
+:- mode instmap__remove_singleton_inst_key_from_inst(in, in, in, in, in, out)
+ is det.
+
+instmap__remove_singleton_inst_key_from_inst(IKCounts, ModuleInfo, InstTable,
+ InstMap, alias(IK), Inst) :-
+ ( has_count_one(IKCounts, IK) ->
+ inst_table_get_inst_key_table(InstTable, IKT),
+ instmap__inst_key_table_lookup(InstMap, IKT, IK, Inst1),
+ instmap__remove_singleton_inst_key_from_inst(IKCounts,
+ ModuleInfo, InstTable, InstMap, Inst1, Inst)
+ ;
+ Inst = alias(IK)
).
+instmap__remove_singleton_inst_key_from_inst(_, _, _, _, any(U), any(U)).
+instmap__remove_singleton_inst_key_from_inst(_, _, _, _, free(A), free(A)).
+instmap__remove_singleton_inst_key_from_inst(_, _, _, _,
+ free(A, T), free(A, T)).
+instmap__remove_singleton_inst_key_from_inst(_, _, _, _,
+ ground(U, P), ground(U, P)).
+instmap__remove_singleton_inst_key_from_inst(_, _, _, _,
+ not_reached, not_reached).
+instmap__remove_singleton_inst_key_from_inst(_, _, _, _,
+ defined_inst(N), defined_inst(N)).
+instmap__remove_singleton_inst_key_from_inst(_, _, _, _, inst_var(_), _) :-
+ error("instmap__remove_singleton_inst_key_from_inst: inst_var").
+instmap__remove_singleton_inst_key_from_inst(IKCounts, ModuleInfo, InstTable,
+ InstMap, bound(U, BoundInsts0), bound(U, BoundInsts)) :-
+ list__map(lambda([BI0::in, BI::out] is det, (
+ BI0 = functor(C, Insts0),
+ list__map(instmap__remove_singleton_inst_key_from_inst(IKCounts,
+ ModuleInfo, InstTable, InstMap),
+ Insts0, Insts),
+ BI = functor(C, Insts)
+ )), BoundInsts0, BoundInsts).
+instmap__remove_singleton_inst_key_from_inst(IKCounts, ModuleInfo, InstTable,
+ InstMap, abstract_inst(N, Insts0), abstract_inst(N, Insts)) :-
+ list__map(instmap__remove_singleton_inst_key_from_inst(IKCounts,
+ ModuleInfo, InstTable, InstMap),
+ Insts0, Insts).
+
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -951,66 +1279,6 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred merge_instmapping_delta(instmap, set(prog_var), instmapping,
- instmapping, instmapping, inst_table, inst_table,
- module_info, module_info).
-:- mode merge_instmapping_delta(in, in, in, in, out, in, out, in, out) is det.
-
-merge_instmapping_delta(InstMap, NonLocals, InstMappingA,
- InstMappingB, InstMapping, InstTable0, InstTable) -->
- { map__keys(InstMappingA, VarsInA) },
- { map__keys(InstMappingB, VarsInB) },
- { set__sorted_list_to_set(VarsInA, SetofVarsInA) },
- { set__insert_list(SetofVarsInA, VarsInB, SetofVars0) },
- { set__intersect(SetofVars0, NonLocals, SetofVars) },
- { map__init(InstMapping0) },
- { set__to_sorted_list(SetofVars, ListofVars) },
- merge_instmapping_delta_2(ListofVars, InstMap, InstMappingA,
- InstMappingB, InstMapping0, InstMapping, InstTable0, InstTable).
-
-:- pred merge_instmapping_delta_2(list(prog_var), instmap, instmapping,
- instmapping, instmapping, instmapping, inst_table, inst_table,
- module_info, module_info).
-:- mode merge_instmapping_delta_2(in, in, in, in, in, out, in, out, in, out)
- is det.
-
-merge_instmapping_delta_2([], _, _, _, InstMapping, InstMapping,
- InstTable, InstTable, ModInfo, ModInfo).
-merge_instmapping_delta_2([Var | Vars], InstMap, InstMappingA, InstMappingB,
- InstMapping0, InstMapping, InstTable0, InstTable,
- ModuleInfo0, ModuleInfo) :-
- ( map__search(InstMappingA, Var, InstInA) ->
- InstA = InstInA
- ;
- instmap__lookup_var(InstMap, Var, InstA)
- ),
- ( map__search(InstMappingB, Var, InstInB) ->
- InstB = InstInB
- ;
- instmap__lookup_var(InstMap, Var, InstB)
- ),
- (
- % YYY Not sure about the returned InstMap here.
- inst_merge(InstA, InstB, InstMap, InstTable0, ModuleInfo0,
- Inst, _, InstTable1, ModuleInfo1)
- ->
- ModuleInfo2 = ModuleInfo1,
- InstTable2 = InstTable1,
- map__det_insert(InstMapping0, Var, Inst, InstMapping1)
- ;
- term__var_to_int(Var, VarInt),
- string__format(
- "merge_instmapping_delta_2: error merging var %i",
- [i(VarInt)], Msg),
- error(Msg)
- ),
- merge_instmapping_delta_2(Vars, InstMap, InstMappingA, InstMappingB,
- InstMapping1, InstMapping, InstTable2, InstTable,
- ModuleInfo2, ModuleInfo).
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
instmap__bind_var_to_functor(Var, ConsId, InstMap0, InstMap,
InstTable0, InstTable, ModuleInfo0, ModuleInfo) :-
instmap__lookup_var(InstMap0, Var, Inst0),
@@ -1034,7 +1302,8 @@
(
abstractly_unify_inst_functor(dead, Inst0, ConsId,
ArgInsts, ArgLives, real_unify, InstTable0, ModuleInfo0,
- InstMap0, Inst1, _, InstTable1, ModuleInfo1, InstMap1)
+ InstMap0, Inst1, _, _, InstTable1, ModuleInfo1,
+ InstMap1)
->
ModuleInfo = ModuleInfo1,
InstTable = InstTable1,
@@ -1120,6 +1389,18 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+instmap__inst_keys_are_equivalent(KeyA, InstMapA, KeyB, InstMapB) :-
+ (
+ KeyA = KeyB
+ ;
+ InstMapA = reachable(_, AliasMapA),
+ InstMapB = reachable(_, AliasMapB),
+ find_latest_inst_key(AliasMapA, KeyA, Key),
+ find_latest_inst_key(AliasMapB, KeyB, Key)
+ ).
+
+%-----------------------------------------------------------------------------%
+
instmap__get_inst_key_sub(unreachable, Sub) :-
map__init(Sub).
instmap__get_inst_key_sub(reachable(_, Sub), Sub).
Index: mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.115.2.22
diff -u -w -r1.115.2.22 mercury_to_mercury.m
--- 1.115.2.22 1998/11/24 06:29:44
+++ mercury_to_mercury.m 1998/12/15 03:17:22
@@ -959,6 +959,15 @@
InstMap, InstTable),
mercury_output_tabs(Indent),
io__write_string(")\n").
+mercury_output_structured_inst_name(Expand, substitution_inst(InstName, _, _),
+ Indent, VarSet, InstMap, InstTable) -->
+ mercury_output_tabs(Indent),
+ io__write_string("$substitution_inst(\n"),
+ { Indent1 is Indent + 1 },
+ mercury_output_structured_inst_name(Expand, InstName, Indent1, VarSet,
+ InstMap, InstTable),
+ mercury_output_tabs(Indent),
+ io__write_string(")\n").
:- pred mercury_output_inst_name(inst_name, inst_varset, inst_table,
io__state, io__state).
@@ -1051,6 +1060,11 @@
io__write_string(", "),
mercury_output_inst_name(InstName, VarSet, InstTable),
io__write_string(")").
+mercury_output_inst_name(substitution_inst(InstName, _, _), VarSet,
+ InstTable) -->
+ io__write_string("$substitution_inst("),
+ mercury_output_inst_name(InstName, VarSet, InstTable),
+ io__write_string(")").
:- pred mercury_output_uniqueness(uniqueness, string, io__state, io__state).
:- mode mercury_output_uniqueness(in, in, di, uo) is det.
Index: mode_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_info.m,v
retrieving revision 1.39.4.13
diff -u -w -r1.39.4.13 mode_info.m
--- 1.39.4.13 1998/11/24 06:29:57
+++ mode_info.m 1998/12/07 00:00:32
@@ -285,10 +285,11 @@
).
*/
:- inst uniq_mode_info = ground.
+:- inst dead_mode_info = ground.
:- mode mode_info_uo :: free -> uniq_mode_info.
:- mode mode_info_ui :: uniq_mode_info -> uniq_mode_info.
-:- mode mode_info_di :: uniq_mode_info -> dead.
+:- mode mode_info_di :: uniq_mode_info -> dead_mode_info.
% Some fiddly modes used when we want to extract
% the io_state from a mode_info struct and then put it back again.
@@ -307,7 +308,7 @@
:- mode mode_info_get_io_state :: uniq_mode_info -> mode_info_no_io.
:- mode mode_info_no_io :: mode_info_no_io -> mode_info_no_io.
-:- mode mode_info_set_io_state :: mode_info_no_io -> dead.
+:- mode mode_info_set_io_state :: mode_info_no_io -> dead_mode_info.
%-----------------------------------------------------------------------------%
Index: mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.99.2.26
diff -u -w -r1.99.2.26 mode_util.m
--- 1.99.2.26 1998/11/24 06:30:01
+++ mode_util.m 1998/12/15 02:23:15
@@ -572,6 +572,15 @@
map__init(Subst),
propagate_type_into_inst(Type, Subst, InstTable, ModuleInfo,
Inst0, Inst)
+ ; InstName = substitution_inst(SubInstName, SubKeys, Sub),
+ inst_table_get_substitution_insts(InstTable, SubInsts),
+ map__lookup(SubInsts, substitution_inst(SubInstName, SubKeys,
+ Sub), MaybeInst),
+ ( MaybeInst = known(Inst0) ->
+ Inst = Inst0
+ ;
+ Inst = defined_inst(InstName)
+ )
),
!.
@@ -1209,6 +1218,9 @@
typed_inst(T, Inst)) :-
inst_name_apply_substitution(Inst0, Subst, Inst).
inst_name_apply_substitution(typed_ground(Uniq, T), _, typed_ground(Uniq, T)).
+inst_name_apply_substitution(substitution_inst(InstName0, K, S), Subst,
+ substitution_inst(InstName, K, S)) :-
+ inst_name_apply_substitution(InstName0, Subst, InstName).
:- pred alt_list_apply_substitution(list(bound_inst), inst_subst,
list(bound_inst)).
@@ -1836,7 +1848,7 @@
abstractly_unify_inst_functor(VarLive, InitialInst,
ConsId, ArgInsts, ArgLives, real_unify,
InstTable1, ModuleInfo0, InstMap1,
- UnifyInst0, Det0, InstTable2, ModuleInfo2, InstMap2)
+ UnifyInst0, _, Det0, InstTable2, ModuleInfo2, InstMap2)
->
ModuleInfo = ModuleInfo2,
InstTable = InstTable2,
Index: modecheck_unify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.22.2.16
diff -u -w -r1.22.2.16 modecheck_unify.m
--- 1.22.2.16 1998/11/24 06:30:11
+++ modecheck_unify.m 1998/12/04 02:52:01
@@ -72,15 +72,29 @@
inst_table_set_inst_key_table(InstTable0, IKT, InstTable),
mode_info_set_inst_table(InstTable, ModeInfo0, ModeInfo).
-:- pred mode_info_make_aliased_insts(list(prog_var), list(inst),
+:- pred mode_info_make_aliased_insts(list(prog_var), list(is_live), list(inst),
mode_info, mode_info).
-:- mode mode_info_make_aliased_insts(in, out,
- mode_info_di, mode_info_uo) is det.
+:- mode mode_info_make_aliased_insts(in, in, out, mode_info_di, mode_info_uo)
+ is det.
-mode_info_make_aliased_insts([], [], ModeInfo, ModeInfo).
-mode_info_make_aliased_insts([V | Vs], [I | Is], ModeInfo0, ModeInfo) :-
+mode_info_make_aliased_insts([], [], [], ModeInfo, ModeInfo).
+mode_info_make_aliased_insts([], [_|_], _, _, _) :-
+ error("mode_info_make_aliased_insts: list length mismatch").
+mode_info_make_aliased_insts([_|_], [], _, _, _) :-
+ error("mode_info_make_aliased_insts: list length mismatch").
+mode_info_make_aliased_insts([V | Vs], [L | Ls], [I | Is], ModeInfo0,
+ ModeInfo) :-
mode_info_get_instmap(ModeInfo0, IM0),
instmap__lookup_var(IM0, V, I0),
+ ( L = dead ->
+ % If V is dead and aliased we need to remove the alias.
+ mode_info_get_inst_table(ModeInfo0, InstTable),
+ mode_info_get_instmap(ModeInfo0, InstMap),
+ mode_info_get_module_info(ModeInfo0, ModuleInfo),
+ inst_expand(InstMap, InstTable, ModuleInfo, I0, I),
+ ModeInfo2 = ModeInfo0
+ ;
+ % If V is live and not aliased, we need to alias it.
( I0 = alias(_) ->
I = I0,
ModeInfo0 = ModeInfo2
@@ -89,8 +103,9 @@
I = alias(InstKey),
instmap__set(IM0, V, I, IM),
mode_info_set_instmap(IM, ModeInfo1, ModeInfo2)
+ )
),
- mode_info_make_aliased_insts(Vs, Is, ModeInfo2, ModeInfo).
+ mode_info_make_aliased_insts(Vs, Ls, Is, ModeInfo2, ModeInfo).
modecheck_unification(X, var(Y), _Unification0, UnifyContext, _GoalInfo,
Unify, ModeInfo0, ModeInfo) :-
@@ -97,10 +112,24 @@
mode_info_get_module_info(ModeInfo0, ModuleInfo0),
mode_info_get_instmap(ModeInfo0, InstMap0),
mode_info_get_inst_table(ModeInfo0, InstTable0),
- instmap__lookup_var(InstMap0, X, InstOfX),
- instmap__lookup_var(InstMap0, Y, InstOfY),
+ instmap__lookup_var(InstMap0, X, InstOfX0),
+ instmap__lookup_var(InstMap0, Y, InstOfY0),
mode_info_var_is_live(ModeInfo0, X, LiveX),
mode_info_var_is_live(ModeInfo0, Y, LiveY),
+
+ % If either var is dead and aliased, the alias should be removed.
+ ( LiveX = dead ->
+ inst_expand(InstMap0, InstTable0, ModuleInfo0, InstOfX0,
+ InstOfX)
+ ;
+ InstOfX = InstOfX0
+ ),
+ ( LiveY = dead ->
+ inst_expand(InstMap0, InstTable0, ModuleInfo0, InstOfY0,
+ InstOfY)
+ ;
+ InstOfY = InstOfY0
+ ),
(
( LiveX = live, LiveY = live ->
BothLive = live
@@ -117,7 +146,7 @@
mode_info_set_inst_table(InstTable1, ModeInfo1, ModeInfo2),
mode_info_set_instmap(InstMap1, ModeInfo2, ModeInfo3),
- ( Inst = alias(_) ->
+ ( ( Inst = alias(_) ; BothLive = dead ) ->
AliasedInst = Inst,
ModeInfo3 = ModeInfo4
;
@@ -670,13 +699,14 @@
),
mode_info_get_instmap(ModeInfo0, InstMap0),
instmap__lookup_var(InstMap0, X, InstOfX),
- mode_info_make_aliased_insts(ArgVars0, InstArgs, ModeInfo0, ModeInfo1),
+ mode_info_var_list_is_live(ArgVars0, ModeInfo0, LiveArgs),
+ mode_info_make_aliased_insts(ArgVars0, LiveArgs, InstArgs0, ModeInfo0,
+ ModeInfo1),
mode_info_get_module_info(ModeInfo1, ModuleInfo1),
mode_info_get_inst_table(ModeInfo1, InstTable1),
mode_info_get_instmap(ModeInfo1, InstMap1),
mode_info_var_is_live(ModeInfo1, X, LiveX),
- mode_info_var_list_is_live(ArgVars0, ModeInfo1, LiveArgs),
- InstOfY = bound(unique, [functor(ConsId, InstArgs)]),
+ InstOfY = bound(unique, [functor(ConsId, InstArgs0)]),
(
% The occur check: X = f(X) is considered a mode error
% unless X is ground. (Actually it wouldn't be that
@@ -690,7 +720,7 @@
set__list_to_set([X], WaitingVars),
mode_info_error(WaitingVars,
mode_error_unify_var_functor(X, ConsId, ArgVars0,
- InstOfX, InstArgs),
+ InstOfX, InstArgs0),
ModeInfo1, ModeInfo2
),
Inst = not_reached,
@@ -715,9 +745,9 @@
ExtraGoals = no_extra_goals
;
abstractly_unify_inst_functor(LiveX, InstOfX, ConsId,
- InstArgs, LiveArgs, real_unify, InstTable1,
- ModuleInfo1, InstMap1,
- UnifyInst, Det1, InstTable2, ModuleInfo2, InstMap2),
+ InstArgs0, LiveArgs, real_unify, InstTable1,
+ ModuleInfo1, InstMap1, UnifyInst, InstArgs,
+ Det1, InstTable2, ModuleInfo2, InstMap2),
\+ inst_contains_free_alias(UnifyInst, InstMap2,
InstTable2, ModuleInfo2)
@@ -742,8 +772,7 @@
ModeOfX = (InstOfX - Inst),
ModeOfY = (InstOfY - Inst),
Mode = ModeOfX - ModeOfY,
- instmap__lookup_vars(ArgVars0, InstMap2, FinalInstsY),
- assoc_list__from_corresponding_lists(InstArgs, FinalInstsY,
+ assoc_list__from_corresponding_lists(InstArgs0, InstArgs,
ModeArgs),
(
inst_expand(InstMap1, InstTable4, ModuleInfo4,
@@ -779,7 +808,7 @@
set__list_to_set([X | ArgVars0], WaitingVars), % conservative
mode_info_error(WaitingVars,
mode_error_unify_var_functor(X, ConsId, ArgVars0,
- InstOfX, InstArgs),
+ InstOfX, InstArgs0),
ModeInfo1, ModeInfo2
),
% If we get an error, set the inst to not_reached
@@ -934,8 +963,8 @@
mode_info_set_instmap(InstMapAfterMain, ModeInfo2, ModeInfo3),
% create code to do a unification between `Var' and `Var0'
- % ModeVar0 = (InitialInstY -> FinalInstY),
- % ModeVar = (InitialInstX -> FinalInstX),
+ % ModeVar0 = (InitialInstY - FinalInstY),
+ % ModeVar = (InitialInstX - FinalInstX),
mode_info_get_module_info(ModeInfo3, ModuleInfo0),
mode_info_get_inst_table(ModeInfo3, InstTable0),
@@ -1268,7 +1297,9 @@
),
mode_util__inst_pairs_to_uni_modes(ModeOfXArgs, ArgModes0, ArgModes),
(
- inst_is_free(IX, InstMapBefore, InstTable0, ModuleInfo),
+ ( inst_is_free(IX, InstMapBefore, InstTable0, ModuleInfo)
+ ; inst_is_free_alias(IX, InstMapBefore, InstTable0, ModuleInfo)
+ ),
inst_is_bound(FX, InstMapAfter, InstTable0, ModuleInfo)
->
Unification = construct(X, ConsId, ArgVars, ArgModes),
Index: module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.22.2.14
diff -u -w -r1.22.2.14 module_qual.m
--- 1.22.2.14 1998/11/24 06:30:22
+++ module_qual.m 1998/12/15 02:23:54
@@ -581,6 +581,8 @@
{ error("compiler generated inst unexpected") }.
qualify_inst_name(typed_inst(_, _), _, _, _) -->
{ error("compiler generated inst unexpected") }.
+qualify_inst_name(substitution_inst(_, _, _), _, _, _) -->
+ { error("compiler generated inst unexpected") }.
% Qualify an inst of the form bound(functor(...)).
:- pred qualify_bound_inst_list(list(bound_inst)::in, list(bound_inst)::out,
Index: prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.24.2.15
diff -u -w -r1.24.2.15 prog_data.m
--- 1.24.2.15 1998/11/24 06:31:07
+++ prog_data.m 1998/12/15 01:23:10
@@ -20,7 +20,7 @@
:- import_module hlds_data, hlds_pred, (inst), purity, term_util.
:- import_module varset, term.
-:- import_module list, map, term, std_util.
+:- import_module list, map, term, std_util, set_bbbtree.
%-----------------------------------------------------------------------------%
@@ -523,7 +523,9 @@
; shared_inst(inst_name)
; mostly_uniq_inst(inst_name)
; typed_ground(uniqueness, type)
- ; typed_inst(type, inst_name).
+ ; typed_inst(type, inst_name)
+ ; substitution_inst(inst_name, set_bbbtree(inst_key),
+ inst_key_sub).
% Note: `is_live' records liveness in the sense used by
% mode analysis. This is not the same thing as the notion of liveness
Index: simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.46.2.20
diff -u -w -r1.46.2.20 simplify.m
--- 1.46.2.20 1998/11/24 06:31:40
+++ simplify.m 1998/12/14 05:34:33
@@ -537,7 +537,6 @@
MsgsA, Msgs)
;
****/
- Goal = disj(Disjuncts, SM),
simplify_info_get_module_info(Info1, ModuleInfo1),
simplify_info_get_inst_table(Info1, InstTable1),
goal_info_get_nonlocals(GoalInfo0, NonLocals),
@@ -555,6 +554,7 @@
simplify_info_set_module_info(Info1, ModuleInfo2,
Info2),
simplify_info_set_inst_table(Info2, InstTable2, Info),
+ Goal = disj(Disjuncts, SM),
goal_info_set_instmap_delta(GoalInfo0, NewDelta,
GoalInfo)
)
--
David Overton Department of Computer Science & Software Engineering
MEngSc Student The University of Melbourne, Australia
+61 3 9344 9159 http://www.cs.mu.oz.au/~dmo
More information about the developers
mailing list