diff: Reorganisation of inst types and operations
Andrew Bromage
bromage at cs.mu.oz.au
Tue Jul 15 17:39:09 AEST 1997
G'day.
Fergus, could you please review this one?
Cheers,
Andrew Bromage
Estimated hours taken: 15
Reorganisation of modules to do with the inst data type.
This is actually the first installment of the alias tracking mode
checker in disguise. A very good disguise. The rationale for
this reorganisation is to reduce coupling in the part of the mode
checker which is _not_ in this change (ie most of it).
Also included are the removal of some NU-Prologisms since the
NU-Prolog version of the compiler is no longer supported. Two
changes here:
- Removal of some when declarations.
- A gross hack in inst_is_*_2, where two copies of
the same inst were passed into the predicate so that
one could be switched on. Thank NU-Prolog's lack of
common subexpression elimination.
compiler/inst.m:
New module which contains the data types inst, uniqueness,
pred_inst_info, bound_inst.
compiler/inst_util.m:
New module which contains predicates which perform mode
checking-like operations on insts.
Moved in:
abstractly_unify_inst, abstractly_unify_inst_functor
(from inst_match.m)
inst_merge, make_mostly_uniq_inst (from inst_util.m)
compiler/inst_match.m:
Moved out:
inst_merge (to inst_util.m)
make_mostly_uniq_inst (to inst_util.m)
abstractly_unify_inst, abstractly_unify_inst_functor
(to inst_util.m)
Moved in:
inst_is_*, inst_list_is_*, bound_inst_list_is_*
(from mode_util.m)
Now exported:
unique_matches_initial/2, unique_matches_final/2
inst_contains_instname/3
pred_inst_matches/3
compiler/instmap.m:
instmap_delta_lookup_var/3 reincarnated as
instmap_delta_search_var/3. The reason for this change is
that previously, instmap_delta_lookup_var simply returned
`free' if the searched-for var did not occur in the
instmap_delta. This is somewhat non-obvious behaviour.
compiler/mode_util.m:
Moved out:
inst_is_*, inst_list_is_*, bound_inst_list_is_*
(to inst_match.m)
compiler/modecheck_call.m:
Moved in modecheck_higher_order_func_call/5, from modecheck_unify.m
compiler/modecheck_unify.m:
Moved out modecheck_higher_order_func_call/5, to modecheck_call.m
where it should have been all along.
compiler/prog_data.m:
Moved out the types inst, uniqueness, pred_inst_info,
bound_inst (to inst.m).
compiler/common.m:
compiler/cse_detection.m:
compiler/fact_table.m:
compiler/higher_order.m:
compiler/hlds_data.m:
compiler/hlds_goal.m:
compiler/hlds_out.m:
compiler/intermod.m:
compiler/liveness.m:
compiler/llds.m:
compiler/make_hlds.m:
compiler/mercury_to_mercury.m:
compiler/mode_debug.m:
compiler/mode_errors.m:
compiler/mode_info.m:
compiler/modes.m:
compiler/module_qual.m:
compiler/polymorphism.m:
compiler/prog_io.m:
compiler/prog_io_util.m:
compiler/prog_util.m:
compiler/simplify.m:
compiler/switch_detection.m:
compiler/unify_proc.m:
compiler/unique_modes.m:
Miscellaneous minor changes to cope with the above changes.
Index: common.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/common.m,v
retrieving revision 1.41
diff -u -r1.41 common.m
--- common.m 1997/05/23 07:27:51 1.41
+++ common.m 1997/06/24 00:52:15
@@ -80,7 +80,7 @@
:- import_module hlds_goal, hlds_data, quantification, mode_util, type_util.
:- import_module det_util, det_report, globals, options, inst_match, instmap.
-:- import_module prog_data, hlds_module.
+:- import_module prog_data, hlds_module, (inst).
:- import_module bool, term, map, set, list, eqvclass, require, std_util.
:- type structure ---> structure(var, type, cons_id, list(var)).
Index: cse_detection.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/cse_detection.m,v
retrieving revision 1.45
diff -u -r1.45 cse_detection.m
--- cse_detection.m 1997/07/12 15:53:03 1.45
+++ cse_detection.m 1997/07/14 01:38:04
@@ -35,7 +35,7 @@
:- import_module hlds_goal, hlds_data, options, globals, goal_util, hlds_out.
:- import_module modes, mode_util, make_hlds, quantification, instmap.
-:- import_module prog_data, switch_detection, det_util.
+:- import_module prog_data, switch_detection, det_util, inst_match.
:- import_module int, bool, list, map, set, std_util, require, term, varset.
Index: fact_table.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/fact_table.m,v
retrieving revision 1.8
diff -u -r1.8 fact_table.m
--- fact_table.m 1997/05/29 23:45:17 1.8
+++ fact_table.m 1997/07/09 05:15:35
@@ -90,7 +90,7 @@
:- import_module float, math, getopt, term, string.
:- import_module parser, prog_out, term_io, llds_out, hlds_out, hlds_data.
:- import_module globals, options, passes_aux, arg_info, llds, mode_util.
-:- import_module code_util, export.
+:- import_module code_util, export, inst_match.
:- type fact_result
---> ok ; error.
Index: higher_order.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/higher_order.m,v
retrieving revision 1.28
diff -u -r1.28 higher_order.m
--- higher_order.m 1997/06/27 04:01:23 1.28
+++ higher_order.m 1997/06/27 08:07:05
@@ -30,7 +30,7 @@
:- implementation.
-:- import_module hlds_pred, hlds_goal, hlds_data, instmap.
+:- import_module hlds_pred, hlds_goal, hlds_data, instmap, (inst).
:- import_module code_util, globals, make_hlds, mode_util, goal_util.
:- import_module type_util, options, prog_data, quantification.
:- import_module mercury_to_mercury.
Index: hlds_data.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_data.m,v
retrieving revision 1.13
diff -u -r1.13 hlds_data.m
--- hlds_data.m 1997/05/20 01:51:49 1.13
+++ hlds_data.m 1997/06/23 07:35:42
@@ -13,7 +13,7 @@
:- interface.
-:- import_module hlds_pred, llds, prog_data.
+:- import_module hlds_pred, llds, prog_data, (inst).
:- import_module bool, list, map, varset.
%-----------------------------------------------------------------------------%
Index: hlds_goal.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_goal.m,v
retrieving revision 1.35
diff -u -r1.35 hlds_goal.m
--- hlds_goal.m 1997/07/11 11:45:48 1.35
+++ hlds_goal.m 1997/07/14 01:38:08
@@ -12,7 +12,7 @@
:- interface.
-:- import_module hlds_data, hlds_pred, llds, prog_data, instmap.
+:- import_module hlds_data, hlds_pred, llds, prog_data, (inst), instmap.
:- import_module list, assoc_list, set, map, std_util.
% Here is how goals are represented
Index: hlds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_out.m,v
retrieving revision 1.167
diff -u -r1.167 hlds_out.m
--- hlds_out.m 1997/07/09 06:16:33 1.167
+++ hlds_out.m 1997/07/14 01:38:09
@@ -166,7 +166,7 @@
:- implementation.
:- import_module mercury_to_mercury, globals, options.
-:- import_module llds_out, prog_out, prog_util, instmap.
+:- import_module llds_out, prog_out, prog_util, (inst), instmap.
:- import_module bool, int, string, list, set, map, std_util, assoc_list.
:- import_module term, term_io, varset, require, getopt.
Index: inst_match.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inst_match.m,v
retrieving revision 1.30
diff -u -r1.30 inst_match.m
--- inst_match.m 1997/06/16 08:43:10 1.30
+++ inst_match.m 1997/07/15 07:19:45
@@ -11,15 +11,13 @@
% that are used by modes.m and det_analysis.m.
/*
-The handling of `any' insts is not complete.
+The handling of `any' insts is not complete. (See also inst_util.m)
It would be nice to allow `free', `bound' and `ground' to
-match `any', but right now we don't. Also currently we
-don't allow any unifications with variables of mode `any'.
+match `any', but right now we don't.
The reason is that although the mode analysis would be pretty
straight-forward, generating the correct code is quite a bit trickier.
In fact, much of the mode analysis code in this file is already
done, just commented out with the remark "not yet".
-The exception is abstract unification, which hasn't been done.
In addition, modes.m would have to be changed to handle the implicit
conversions from `free'/`bound'/`ground' to `any' at
@@ -37,7 +35,7 @@
:- interface.
-:- import_module hlds_module, prog_data.
+:- import_module hlds_module, (inst).
%-----------------------------------------------------------------------------%
@@ -93,6 +91,18 @@
% inst_matches_final into a single predicate inst_matches(When, ...)
% where When is either `initial' or `final'.
+:- pred unique_matches_initial(uniqueness, uniqueness).
+:- mode unique_matches_initial(in, in) is semidet.
+
+ % unique_matches_initial(A, B) succeeds if A >= B in the ordering
+ % clobbered < mostly_clobbered < shared < mostly_unique < unique
+
+:- pred unique_matches_final(uniqueness, uniqueness).
+:- mode unique_matches_final(in, in) is semidet.
+
+ % unique_matches_final(A, B) succeeds if A >= B in the ordering
+ % clobbered < mostly_clobbered < shared < mostly_unique < unique
+
:- pred inst_matches_binding(inst, inst, module_info).
:- mode inst_matches_binding(in, in, in) is semidet.
@@ -105,56 +115,136 @@
%-----------------------------------------------------------------------------%
-:- pred inst_merge(inst, inst, module_info, inst, module_info).
-:- mode inst_merge(in, in, in, out, out) is semidet.
-
- % inst_merge(InstA, InstB, InstC):
- % Combine the insts found in different arms of a
- % disjunction (or if-then-else).
- % The information in InstC is the minimum of the
- % information in InstA and InstB. Where InstA and
- % InstB specify a binding (free or bound), it must be
- % the same in both.
+ % pred_inst_matches(PredInstA, PredInstB, ModuleInfo)
+ % Succeeds if PredInstA specifies a pred that can
+ % be used wherever and whenever PredInstB could be used.
+ % This is true if they both have the same PredOrFunc indicator
+ % and the same determinism, and if the arguments match
+ % using pred_inst_argmodes_match.
+ %
+:- pred pred_inst_matches(pred_inst_info, pred_inst_info, module_info).
+:- mode pred_inst_matches(in, in, in) is semidet.
%-----------------------------------------------------------------------------%
-:- pred abstractly_unify_inst(is_live, inst, inst, unify_is_real, module_info,
- inst, determinism, module_info).
-:- mode abstractly_unify_inst(in, in, in, in, in, out, out, out) is semidet.
+/*
+** Predicates to test various properties of insts.
+** Note that `not_reached' insts are considered to satisfy
+** all of these predicates except inst_is_clobbered.
+*/
+
+ % succeed if the inst is fully ground (i.e. contains only
+ % `ground', `bound', and `not_reached' insts, with no `free'
+ % or `any' insts).
+:- pred inst_is_ground(module_info, inst).
+:- mode inst_is_ground(in, in) is semidet.
+
+ % succeed if the inst is not partly free (i.e. contains only
+ % `any', `ground', `bound', and `not_reached' insts, with no
+ % `free' insts).
+:- pred inst_is_ground_or_any(module_info, inst).
+:- mode inst_is_ground_or_any(in, in) is semidet.
+
+ % succeed if the inst is `mostly_unique' or `unique'
+:- pred inst_is_mostly_unique(module_info, inst).
+:- mode inst_is_mostly_unique(in, in) is semidet.
+
+ % succeed if the inst is `unique'
+:- pred inst_is_unique(module_info, inst).
+:- mode inst_is_unique(in, in) is semidet.
+
+ % succeed if the inst is not `mostly_unique' or `unique'
+:- pred inst_is_not_partly_unique(module_info, inst).
+:- mode inst_is_not_partly_unique(in, in) is semidet.
+
+ % succeed if the inst is not `unique'
+:- pred inst_is_not_fully_unique(module_info, inst).
+:- mode inst_is_not_fully_unique(in, in) is semidet.
+
+:- pred inst_is_clobbered(module_info, inst).
+:- mode inst_is_clobbered(in, in) is semidet.
+
+:- pred inst_list_is_ground(list(inst), module_info).
+:- mode inst_list_is_ground(in, in) is semidet.
- % Compute the inst that results from abstractly unifying two variables.
+:- pred inst_list_is_ground_or_any(list(inst), module_info).
+:- mode inst_list_is_ground_or_any(in, in) is semidet.
-:- pred abstractly_unify_inst_functor(is_live, inst, cons_id, list(inst),
- list(is_live), unify_is_real, module_info,
- inst, module_info).
-:- mode abstractly_unify_inst_functor(in, in, in, in, in, in, in, out, out)
- is semidet.
+:- pred inst_list_is_unique(list(inst), module_info).
+:- mode inst_list_is_unique(in, in) is semidet.
- % Compute the inst that results from abstractly unifying
- % a variable with a functor.
+:- pred inst_list_is_mostly_unique(list(inst), module_info).
+:- mode inst_list_is_mostly_unique(in, in) is semidet.
- % Mode checking is like abstract interpretation.
- % The above predicates define the abstract unification operation
- % which unifies two instantiatednesses. If the unification
- % would be illegal, then abstract unification fails.
- % If the unification would fail, then the abstract unification
- % will succeed, and the resulting instantiatedness will be
- % `not_reached'.
+:- pred inst_list_is_not_partly_unique(list(inst), module_info).
+:- mode inst_list_is_not_partly_unique(in, in) is semidet.
+
+:- pred inst_list_is_not_fully_unique(list(inst), module_info).
+:- mode inst_list_is_not_fully_unique(in, in) is semidet.
+
+:- pred bound_inst_list_is_ground(list(bound_inst), module_info).
+:- mode bound_inst_list_is_ground(in, in) is semidet.
+
+:- pred bound_inst_list_is_ground_or_any(list(bound_inst), module_info).
+:- mode bound_inst_list_is_ground_or_any(in, in) is semidet.
+
+:- pred bound_inst_list_is_unique(list(bound_inst), module_info).
+:- mode bound_inst_list_is_unique(in, in) is semidet.
+
+:- pred bound_inst_list_is_mostly_unique(list(bound_inst), module_info).
+:- mode bound_inst_list_is_mostly_unique(in, in) is semidet.
+
+:- pred bound_inst_list_is_not_partly_unique(list(bound_inst), module_info).
+:- mode bound_inst_list_is_not_partly_unique(in, in) is semidet.
+
+:- pred bound_inst_list_is_not_fully_unique(list(bound_inst), module_info).
+:- mode bound_inst_list_is_not_fully_unique(in, in) is semidet.
+
+:- pred inst_is_free(module_info, inst).
+:- mode inst_is_free(in, in) is semidet.
+
+:- pred inst_list_is_free(list(inst), module_info).
+:- mode inst_list_is_free(in, in) is semidet.
+
+:- pred bound_inst_list_is_free(list(bound_inst), module_info).
+:- mode bound_inst_list_is_free(in, in) is semidet.
+
+:- pred inst_is_bound(module_info, inst).
+:- mode inst_is_bound(in, in) is semidet.
+
+:- pred inst_is_bound_to_functors(module_info, inst, list(bound_inst)).
+:- mode inst_is_bound_to_functors(in, in, out) is semidet.
%-----------------------------------------------------------------------------%
-:- pred make_mostly_uniq_inst(inst, module_info, inst, module_info).
-:- mode make_mostly_uniq_inst(in, in, out, out) is det.
+ % Succeed iff the specified inst contains (directly or indirectly)
+ % the specified inst_name.
- % Given an inst, return a new inst which is the same as the
- % original inst but with all occurrences of `unique' replaced
- % with `mostly_unique'.
+:- pred inst_contains_instname(inst, module_info, inst_name).
+:- mode inst_contains_instname(in, in, in) is semidet.
+
+ % Given a list of insts, and a corresponding list of livenesses,
+ % return true iff for every element in the list of insts, either
+ % the elemement is ground or the corresponding element in the liveness
+ % list is dead.
+
+:- pred inst_list_is_ground_or_dead(list(inst), list(is_live), module_info).
+:- mode inst_list_is_ground_or_dead(in, in, in) is semidet.
+
+ % Given a list of insts, and a corresponding list of livenesses,
+ % return true iff for every element in the list of insts, either
+ % the elemement is ground or any, or the corresponding element
+ % in the liveness list is dead.
+
+:- pred inst_list_is_ground_or_any_or_dead(list(inst), list(is_live),
+ module_info).
+:- mode inst_list_is_ground_or_any_or_dead(in, in, in) is semidet.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module hlds_data, mode_util.
+:- import_module hlds_data, mode_util, prog_data, inst_util.
:- import_module list, set, map, std_util, require.
inst_matches_initial(InstA, InstB, ModuleInfo) :-
@@ -185,8 +275,6 @@
:- pred inst_matches_initial_3(inst, inst, module_info, expansions).
:- mode inst_matches_initial_3(in, in, in, in) is semidet.
-:- inst_matches_initial_3(InstA, InstB, _, _) when InstA and InstB. % Indexing.
-
% To avoid infinite regress, we assume that
% inst_matches_initial is true for any pairs of insts which
% occur in `Expansions'.
@@ -250,6 +338,8 @@
inst_list_matches_initial(ArgsA, ArgsB, ModuleInfo, Expansions).
inst_matches_initial_3(not_reached, _, _, _).
+%-----------------------------------------------------------------------------%
+
:- pred maybe_pred_inst_matches_initial(maybe(pred_inst_info),
maybe(pred_inst_info), module_info).
:- mode maybe_pred_inst_matches_initial(in, in, in) is semidet.
@@ -259,25 +349,16 @@
maybe_pred_inst_matches_initial(yes(PredInstA), yes(PredInstB), ModuleInfo) :-
pred_inst_matches(PredInstA, PredInstB, ModuleInfo).
- % pred_inst_matches(PredInstA, PredInstB, ModuleInfo)
- % Succeeds if PredInstA specifies a pred that can
- % be used wherever and whenever PredInstB could be used.
- % This is true if they both have the same PredOrFunc indicator
- % and the same determinism, and if the arguments match
- % using pred_inst_argmodes_match.
+pred_inst_matches(PredInstA, PredInstB, ModuleInfo) :-
+ set__init(Expansions),
+ pred_inst_matches_2(PredInstA, PredInstB, ModuleInfo, Expansions).
+
% pred_inst_matches_2(PredInstA, PredInstB, ModuleInfo, Expansions)
% Same as pred_inst_matches/3, except that inst pairs in
% Expansions are assumed to match_final each other.
% (This avoids infinite loops when calling inst_matches_final
% on higher-order recursive insts.)
%
-:- pred pred_inst_matches(pred_inst_info, pred_inst_info, module_info).
-:- mode pred_inst_matches(in, in, in) is semidet.
-
-pred_inst_matches(PredInstA, PredInstB, ModuleInfo) :-
- set__init(Expansions),
- pred_inst_matches_2(PredInstA, PredInstB, ModuleInfo, Expansions).
-
:- pred pred_inst_matches_2(pred_inst_info, pred_inst_info, module_info,
expansions).
:- mode pred_inst_matches_2(in, in, in, in) is semidet.
@@ -308,11 +389,7 @@
inst_matches_final_2(FinalA, FinalB, ModuleInfo, Expansions),
pred_inst_argmodes_matches(ModeAs, ModeBs, ModuleInfo, Expansions).
-:- pred unique_matches_initial(uniqueness, uniqueness).
-:- mode unique_matches_initial(in, in) is semidet.
-
- % unique_matches_initial(A, B) succeeds if A >= B in the ordering
- % clobbered < mostly_clobbered < shared < mostly_unique < unique
+%-----------------------------------------------------------------------------%
unique_matches_initial(unique, _).
unique_matches_initial(mostly_unique, mostly_unique).
@@ -326,12 +403,11 @@
unique_matches_initial(mostly_clobbered, clobbered).
unique_matches_initial(clobbered, clobbered).
-:- pred unique_matches_final(uniqueness, uniqueness).
-:- mode unique_matches_final(in, in) is semidet.
-
unique_matches_final(A, B) :-
unique_matches_initial(A, B).
+%-----------------------------------------------------------------------------%
+
:- pred bound_inst_list_matches_uniq(list(bound_inst), uniqueness,
module_info).
:- mode bound_inst_list_matches_uniq(in, in, in) is semidet.
@@ -358,6 +434,8 @@
true
).
+%-----------------------------------------------------------------------------%
+
% Here we check that the functors in the first list are a
% subset of the functors in the second list.
% (If a bound(...) inst only specifies the insts for some of
@@ -434,8 +512,6 @@
:- pred inst_matches_final_3(inst, inst, module_info, expansions).
:- mode inst_matches_final_3(in, in, in, in) is semidet.
-:- inst_matches_final_3(A, B, _, _) when A and B.
-
inst_matches_final_3(any(UniqA), any(UniqB), _, _) :-
unique_matches_final(UniqA, UniqB).
/***
@@ -557,8 +633,6 @@
:- pred inst_matches_binding_3(inst, inst, module_info, expansions).
:- mode inst_matches_binding_3(in, in, in, in) is semidet.
-:- inst_matches_binding_3(A, B, _, _) when A and B.
-
% Note that `any' is *not* considered to match `any'.
inst_matches_binding_3(free, free, _, _).
inst_matches_binding_3(bound(_UniqA, ListA), bound(_UniqB, ListB), ModuleInfo,
@@ -634,1093 +708,456 @@
%-----------------------------------------------------------------------------%
- % inst_merge(InstA, InstB, InstC):
- % Combine the insts found in different arms of a
- % disjunction (or if-then-else).
- % The information in InstC is the minimum of the
- % information in InstA and InstB. Where InstA and
- % InstB specify a binding (free or bound), it must be
- % the same in both.
-
-inst_merge(InstA, InstB, ModuleInfo0, Inst, ModuleInfo) :-
- % check whether this pair of insts is already in
- % the merge_insts table
- module_info_insts(ModuleInfo0, InstTable0),
- inst_table_get_merge_insts(InstTable0, MergeInstTable0),
- ThisInstPair = InstA - InstB,
- ( map__search(MergeInstTable0, ThisInstPair, Result) ->
- ModuleInfo = ModuleInfo0,
- ( Result = known(MergedInst) ->
- Inst0 = MergedInst
- ;
- Inst0 = defined_inst(merge_inst(InstA, InstB))
- )
- ;
- % insert ThisInstPair into the table with value
- %`unknown'
- map__insert(MergeInstTable0, ThisInstPair, unknown,
- MergeInstTable1),
- inst_table_set_merge_insts(InstTable0, MergeInstTable1,
- InstTable1),
- module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
-
- % merge the insts
- inst_merge_2(InstA, InstB, ModuleInfo1, Inst0, ModuleInfo2),
-
- % now update the value associated with ThisInstPair
- module_info_insts(ModuleInfo2, InstTable2),
- inst_table_get_merge_insts(InstTable2, MergeInstTable2),
- map__set(MergeInstTable2, ThisInstPair, known(Inst0),
- MergeInstTable3),
- inst_table_set_merge_insts(InstTable2, MergeInstTable3,
- InstTable3),
- module_info_set_insts(ModuleInfo2, InstTable3, ModuleInfo)
- ),
- % avoid expanding recursive insts
- ( inst_contains_instname(Inst0, ModuleInfo, merge_inst(InstA, InstB)) ->
- Inst = defined_inst(merge_inst(InstA, InstB))
- ;
- Inst = Inst0
- ).
-
-:- pred inst_merge_2(inst, inst, module_info, inst, module_info).
-:- mode inst_merge_2(in, in, in, out, out) is semidet.
-
-inst_merge_2(InstA, InstB, ModuleInfo0, Inst, ModuleInfo) :-
-/*********
- % would this test improve efficiency??
- ( InstA = InstB ->
- Inst = InstA,
- ModuleInfo = ModuleInfo0
- ;
-*********/
- inst_expand(ModuleInfo0, InstA, InstA2),
- inst_expand(ModuleInfo0, InstB, InstB2),
- ( InstB2 = not_reached ->
- Inst = InstA2,
- ModuleInfo = ModuleInfo0
- ;
- inst_merge_3(InstA2, InstB2, ModuleInfo0, Inst, ModuleInfo)
- ).
-
-:- pred inst_merge_3(inst, inst, module_info, inst, module_info).
-:- mode inst_merge_3(in, in, in, out, out) is semidet.
-
-:- inst_merge_3(A, B, _, _, _) when A and B.
-
-inst_merge_3(any(UniqA), any(UniqB), M, any(Uniq), M) :-
- merge_uniq(UniqA, UniqB, Uniq).
-/* not yet:
-inst_merge_3(any(Uniq), free, M, any(Uniq), M).
-inst_merge_3(any(UniqA), bound(UniqB, ListB), M, any(Uniq), M) :-
- merge_uniq_bound(UniqA, UniqB, ListB, ModuleInfo, Uniq),
-inst_merge_3(any(UniqA), ground(UniqB, _), M, any(Uniq), M) :-
- merge_uniq(UniqA, UniqB, Uniq).
-inst_merge_3(any(UniqA), abstract_inst(_, _), M, any(Uniq), M) :-
- merge_uniq(UniqA, shared, Uniq).
-inst_merge_3(free, any(Uniq), M, any(Uniq), M).
-inst_merge_3(bound(UniqA, ListA), any(UniqB), M, any(Uniq), M) :-
- merge_uniq_bound(UniqB, UniqA, ListA, ModuleInfo, Uniq),
-inst_merge_3(ground(UniqA, _), any(UniqB), M, any(Uniq), M) :-
- merge_uniq(UniqA, UniqB).
-inst_merge_3(abstract_inst(_, _), any(UniqB), M, any(Uniq), M) :-
- merge_uniq(shared, UniqB, Uniq).
-*/
-inst_merge_3(free, free, M, free, M).
-inst_merge_3(bound(UniqA, ListA), bound(UniqB, ListB), ModuleInfo0,
- bound(Uniq, List), ModuleInfo) :-
- merge_uniq(UniqA, UniqB, Uniq),
- bound_inst_list_merge(ListA, ListB, ModuleInfo0, List, ModuleInfo).
-inst_merge_3(bound(UniqA, ListA), ground(UniqB, _), ModuleInfo,
- ground(Uniq, no), ModuleInfo) :-
- merge_uniq_bound(UniqB, UniqA, ListA, ModuleInfo, Uniq),
- bound_inst_list_is_ground(ListA, ModuleInfo).
-inst_merge_3(ground(UniqA, _), bound(UniqB, ListB), ModuleInfo,
- ground(Uniq, no), ModuleInfo) :-
- merge_uniq_bound(UniqA, UniqB, ListB, ModuleInfo, Uniq),
- bound_inst_list_is_ground(ListB, ModuleInfo).
-inst_merge_3(ground(UniqA, MaybePredA), ground(UniqB, MaybePredB), ModuleInfo,
- ground(Uniq, MaybePred), ModuleInfo) :-
- (
- MaybePredA = yes(PredA),
- MaybePredB = yes(PredB)
- ->
- % if they specify matching pred insts, but one is more
- % precise (specifies more info) than the other,
- % then we want to choose the least precise one
- ( pred_inst_matches(PredA, PredB, ModuleInfo) ->
- MaybePred = yes(PredB)
- ; pred_inst_matches(PredB, PredA, ModuleInfo) ->
- MaybePred = yes(PredA)
- ;
- MaybePred = no
- )
- ;
- MaybePred = no
- ),
- merge_uniq(UniqA, UniqB, Uniq).
-inst_merge_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
- ModuleInfo0, abstract_inst(Name, Args), ModuleInfo) :-
- inst_list_merge(ArgsA, ArgsB, ModuleInfo0, Args, ModuleInfo).
-inst_merge_3(not_reached, Inst, M, Inst, M).
-
-:- pred merge_uniq(uniqueness, uniqueness, uniqueness).
-:- mode merge_uniq(in, in, out) is det.
-
- % merge_uniq(A, B, C) succeeds if C is minimum of A and B in
- % the ordering
- % clobbered < mostly_clobbered < shared < mostly_unique < unique
-
-merge_uniq(UniqA, UniqB, Merged) :-
- ( unique_matches_initial(UniqA, UniqB) -> % A >= B
- Merged = UniqB
- ;
- Merged = UniqA
- ).
-
- % merge_uniq_bound(UniqA, UniqB, ListB, ModuleInfo, Uniq) succeeds iff
- % Uniq is the result of merging
-
-:- pred merge_uniq_bound(uniqueness, uniqueness, list(bound_inst), module_info,
- uniqueness).
-:- mode merge_uniq_bound(in, in, in, in, out) is det.
-
-merge_uniq_bound(UniqA, UniqB, ListB, ModuleInfo, Uniq) :-
- merge_uniq(UniqA, UniqB, Uniq0),
- set__init(Expansions),
- merge_bound_inst_list_uniq(ListB, Uniq0, ModuleInfo, Expansions, Uniq).
-
-:- pred merge_bound_inst_list_uniq(list(bound_inst), uniqueness, module_info,
- set(inst_name), uniqueness).
-:- mode merge_bound_inst_list_uniq(in, in, in, in, out) is det.
-
-merge_bound_inst_list_uniq([], Uniq, _, _, Uniq).
-merge_bound_inst_list_uniq([BoundInst | BoundInsts], Uniq0,
- ModuleInfo, Expansions, Uniq) :-
- BoundInst = functor(_ConsId, ArgInsts),
- merge_inst_list_uniq(ArgInsts, Uniq0, ModuleInfo, Expansions, Uniq1),
- merge_bound_inst_list_uniq(BoundInsts, Uniq1, ModuleInfo, Expansions,
- Uniq).
-
-:- pred merge_inst_list_uniq(list(inst), uniqueness, module_info,
- set(inst_name), uniqueness).
-:- mode merge_inst_list_uniq(in, in, in, in, out) is det.
-
-merge_inst_list_uniq([], Uniq, _, _, Uniq).
-merge_inst_list_uniq([Inst | Insts], Uniq0, ModuleInfo, Expansions, Uniq) :-
- merge_inst_uniq(Inst, Uniq0, ModuleInfo, Expansions, Uniq1),
- merge_inst_list_uniq(Insts, Uniq1, ModuleInfo, Expansions, Uniq).
-
-:- pred merge_inst_uniq(inst, uniqueness, module_info, set(inst_name),
- uniqueness).
-:- mode merge_inst_uniq(in, in, in, in, out) is det.
-
-merge_inst_uniq(any(UniqA), UniqB, _, _, Uniq) :-
- merge_uniq(UniqA, UniqB, Uniq).
-merge_inst_uniq(free, Uniq, _, _, Uniq).
-merge_inst_uniq(free(_), Uniq, _, _, Uniq).
-merge_inst_uniq(bound(UniqA, ListA), UniqB, ModuleInfo, Expansions, Uniq) :-
- merge_uniq(UniqA, UniqB, Uniq0),
- merge_bound_inst_list_uniq(ListA, Uniq0, ModuleInfo, Expansions, Uniq).
-merge_inst_uniq(ground(UniqA, _), UniqB, _, _, Uniq) :-
- merge_uniq(UniqA, UniqB, Uniq).
-merge_inst_uniq(abstract_inst(_,_), UniqB, _, _, Uniq) :-
- merge_uniq(shared, UniqB, Uniq).
-merge_inst_uniq(defined_inst(InstName), UniqB, ModuleInfo, Expansions,
- Uniq) :-
- ( set__member(InstName, Expansions) ->
- Uniq = UniqB
- ;
- set__insert(Expansions, InstName, Expansions1),
- inst_lookup(ModuleInfo, InstName, Inst),
- merge_inst_uniq(Inst, UniqB, ModuleInfo, Expansions1, Uniq)
- ).
-merge_inst_uniq(not_reached, Uniq, _, _, Uniq).
-merge_inst_uniq(inst_var(_), _, _, _, _) :-
- error("merge_inst_uniq: unexpected inst_var").
-
-%-----------------------------------------------------------------------------%
-
-:- pred inst_list_merge(list(inst), list(inst), module_info, list(inst),
- module_info).
-:- mode inst_list_merge(in, in, in, out, out) is semidet.
-
-inst_list_merge([], [], ModuleInfo, [], ModuleInfo).
-inst_list_merge([ArgA | ArgsA], [ArgB | ArgsB], ModuleInfo0,
- [Arg | Args], ModuleInfo) :-
- inst_merge(ArgA, ArgB, ModuleInfo0, Arg, ModuleInfo1),
- inst_list_merge(ArgsA, ArgsB, ModuleInfo1, Args, ModuleInfo).
-
- % bound_inst_list_merge(Xs, Ys, ModuleInfo0, Zs, ModuleInfo):
- % The two input lists Xs and Ys must already be sorted.
- % Here we perform a sorted merge operation,
- % so that the functors of the output list Zs are the union
- % of the functors of the input lists Xs and Ys.
-
-:- pred bound_inst_list_merge(list(bound_inst), list(bound_inst),
- module_info, list(bound_inst), module_info).
-:- mode bound_inst_list_merge(in, in, in, out, out) is semidet.
-
-bound_inst_list_merge(Xs, Ys, ModuleInfo0, Zs, ModuleInfo) :-
- ( Xs = [] ->
- Zs = Ys,
- ModuleInfo = ModuleInfo0
- ; Ys = [] ->
- Zs = Xs,
- ModuleInfo = ModuleInfo0
- ;
- Xs = [X | Xs1],
- Ys = [Y | Ys1],
- X = functor(ConsIdX, ArgsX),
- Y = functor(ConsIdY, ArgsY),
- ( ConsIdX = ConsIdY ->
- inst_list_merge(ArgsX, ArgsY, ModuleInfo0,
- Args, ModuleInfo1),
- Z = functor(ConsIdX, Args),
- Zs = [Z | Zs1],
- bound_inst_list_merge(Xs1, Ys1, ModuleInfo1,
- Zs1, ModuleInfo)
- ; compare(<, ConsIdX, ConsIdY) ->
- Zs = [X | Zs1],
- bound_inst_list_merge(Xs1, Ys, ModuleInfo0,
- Zs1, ModuleInfo)
- ;
- Zs = [Y | Zs1],
- bound_inst_list_merge(Xs, Ys1, ModuleInfo0,
- Zs1, ModuleInfo)
- )
- ).
-
-%-----------------------------------------------------------------------------%
-
- % Abstractly unify two insts.
-
-abstractly_unify_inst(Live, InstA, InstB, UnifyIsReal, ModuleInfo0,
- Inst, Det, ModuleInfo) :-
- % check whether this pair of insts is already in
- % the unify_insts table
- ThisInstPair = unify_inst(Live, InstA, InstB, UnifyIsReal),
- module_info_insts(ModuleInfo0, InstTable0),
- inst_table_get_unify_insts(InstTable0, UnifyInsts0),
- ( map__search(UnifyInsts0, ThisInstPair, Result) ->
- ( Result = known(UnifyInst, UnifyDet) ->
- Inst0 = UnifyInst,
- Det = UnifyDet
- ;
- Inst0 = defined_inst(ThisInstPair),
- % It's ok to assume that the unification is
- % deterministic here, because the only time that
- % this will happen is when we get to the
- % recursive case for a recursively defined inst.
- % If the unification as a whole is semidet then
- % it must be semidet somewhere else too.
- Det = det
- ),
- ModuleInfo = ModuleInfo0
- ;
- % insert ThisInstPair into the table with value
- % `unknown'
- map__set(UnifyInsts0, ThisInstPair, unknown, UnifyInsts1),
- inst_table_set_unify_insts(InstTable0, UnifyInsts1, InstTable1),
- module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
- % unify the insts
- inst_expand(ModuleInfo0, InstA, InstA2),
- inst_expand(ModuleInfo0, InstB, InstB2),
- abstractly_unify_inst_2(Live, InstA2, InstB2, UnifyIsReal,
- ModuleInfo1, Inst0, Det, ModuleInfo2),
- % now update the value associated with ThisInstPair
- module_info_insts(ModuleInfo2, InstTable2),
- inst_table_get_unify_insts(InstTable2, UnifyInsts2),
- map__set(UnifyInsts2, ThisInstPair, known(Inst0, Det),
- UnifyInsts),
- inst_table_set_unify_insts(InstTable2, UnifyInsts, InstTable),
- module_info_set_insts(ModuleInfo2, InstTable, ModuleInfo)
- ),
- % avoid expanding recursive insts
- ( inst_contains_instname(Inst0, ModuleInfo, ThisInstPair) ->
- Inst = defined_inst(ThisInstPair)
- ;
- Inst = Inst0
- ).
-
-:- pred abstractly_unify_inst_2(is_live, inst, inst, unify_is_real, module_info,
- inst, determinism, module_info).
-:- mode abstractly_unify_inst_2(in, in, in, in, in, out, out, out) is semidet.
-
-abstractly_unify_inst_2(IsLive, InstA, InstB, UnifyIsReal, ModuleInfo0,
- Inst, Det, ModuleInfo) :-
- ( InstB = not_reached ->
- Inst = not_reached,
- Det = det,
- ModuleInfo = ModuleInfo0
- ;
- abstractly_unify_inst_3(IsLive, InstA, InstB, UnifyIsReal,
- ModuleInfo0, Inst, Det, ModuleInfo)
- ).
-
- % Abstractly unify two expanded insts.
- % The is_live parameter is `live' iff *both* insts are live.
- % Given the two insts to be unified, this produces
- % a resulting inst and a determinism for the unification.
-
-:- pred abstractly_unify_inst_3(is_live, inst, inst, unify_is_real, module_info,
- inst, determinism, module_info).
-:- mode abstractly_unify_inst_3(in, in, in, in, in, out, out, out) is semidet.
-
-:- abstractly_unify_inst_3(A, B, C, _, _, _, _, _) when A and B and C.
-
-% XXX could be extended to handle `any' insts better
-
-abstractly_unify_inst_3(live, not_reached, _, _, M, not_reached, det, M).
-
-abstractly_unify_inst_3(live, any(UniqX), any(UniqY), Real, M,
- any(Uniq), semidet, M) :-
- Real = fake_unify,
- unify_uniq(live, Real, semidet, UniqX, UniqY, Uniq).
-
-abstractly_unify_inst_3(live, any(UniqX), free, Real, M,
- any(Uniq), det, M) :-
- unify_uniq(live, Real, det, UniqX, unique, Uniq).
-
-abstractly_unify_inst_3(live, free, any(UniqY), Real, M,
- any(Uniq), det, M) :-
- unify_uniq(live, Real, det, unique, UniqY, Uniq).
-
-% abstractly_unify_inst_3(live, free, free, _, _, _, _, _) :- fail.
-
-abstractly_unify_inst_3(live, free, bound(UniqY, List0), Real, M0,
- bound(Uniq, List), det, M) :-
- unify_uniq(live, Real, det, unique, UniqY, Uniq),
- % since both are live, we must disallow free-free unifications
- bound_inst_list_is_ground_or_any(List0, M0),
- % since both are live, we must make the result shared
- % (unless it was already shared)
- ( ( UniqY = unique ; UniqY = mostly_unique ) ->
- make_shared_bound_inst_list(List0, M0, List, M)
- ;
- List = List0, M = M0
- ).
-
-abstractly_unify_inst_3(live, free, ground(UniqY, PredInst), Real, M,
- ground(Uniq, PredInst), det, M) :-
- unify_uniq(live, Real, det, unique, UniqY, Uniq).
-
-% abstractly_unify_inst_3(live, free, abstract_inst(_,_), _, _, _, _) :- fail.
-
-abstractly_unify_inst_3(live, bound(UniqY, List0), free, Real, M0,
- bound(Uniq, List), det, M) :-
- unify_uniq(live, Real, det, unique, UniqY, Uniq),
- % since both are live, we must disallow free-free unifications
- bound_inst_list_is_ground_or_any(List0, M0),
- make_shared_bound_inst_list(List0, M0, List, M).
-
-abstractly_unify_inst_3(live, bound(UniqX, ListX), bound(UniqY, ListY), Real,
- M0, bound(Uniq, List), Det, M) :-
- abstractly_unify_bound_inst_list(live, ListX, ListY, Real, M0,
- List, Det, M),
- unify_uniq(dead, Real, Det, UniqX, UniqY, Uniq).
-
-abstractly_unify_inst_3(live, bound(UniqX, BoundInsts0), ground(UniqY, _),
- Real, M0, bound(Uniq, BoundInsts), semidet, M) :-
- unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq),
- make_ground_bound_inst_list(BoundInsts0, live, UniqY, Real, M0,
- BoundInsts, M).
-
-/*** abstract insts not supported
-abstractly_unify_inst_3(live, bound(Uniq, List), abstract_inst(_,_), Real, M,
- ground(shared), semidet, M) :-
- unify_uniq(live, Real, semidet, unique, UniqY, Uniq),
- bound_inst_list_is_ground(List, M).
-***/
-
-abstractly_unify_inst_3(live, ground(Uniq0, yes(PredInst)), free, Real, M,
- ground(Uniq, yes(PredInst)), det, M) :-
- unify_uniq(live, Real, det, unique, Uniq0, Uniq).
-
-abstractly_unify_inst_3(live, ground(UniqX, yes(_)), bound(UniqY, BoundInsts0),
- Real, M0, bound(Uniq, BoundInsts), semidet, M) :-
- unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq),
- make_ground_bound_inst_list(BoundInsts0, live, UniqX, Real, M0,
- BoundInsts, M).
-
-abstractly_unify_inst_3(live, ground(UniqA, yes(PredInstA)),
- ground(UniqB, _MaybePredInstB), Real, M,
- ground(Uniq, PredInst), semidet, M) :-
- % It is an error to unify higher-order preds,
- % so if Real \= fake_unify, then we must fail.
- Real = fake_unify,
- % In theory we should choose take the union of the
- % information specified by PredInstA and _MaybePredInstB.
- % However, since our data representation provides no
- % way of doing that, and since this will only happen
- % for fake_unifys, for which it shouldn't make any difference,
- % we just choose the information specified by PredInstA.
- PredInst = yes(PredInstA),
- unify_uniq(live, Real, semidet, UniqA, UniqB, Uniq).
-
-abstractly_unify_inst_3(live, ground(Uniq, no), Inst0, Real, M0,
- Inst, Det, M) :-
- ( inst_is_free(M0, Inst0) ->
- Det = det
- ;
- Det = semidet
- ),
- make_ground_inst(Inst0, live, Uniq, Real, M0, Inst, M).
-
-% abstractly_unify_inst_3(live, abstract_inst(_,_), free, _, _, _, _, _)
-% :- fail.
-
-/*** abstract insts not supported
-abstractly_unify_inst_3(live, abstract_inst(_,_), bound(Uniq, List), Real,
- ModuleInfo, ground(shared, no), semidet, ModuleInfo) :-
- check_not_clobbered(Real, Uniq),
- bound_inst_list_is_ground(List, ModuleInfo).
-
-abstractly_unify_inst_3(live, abstract_inst(_,_), ground(Uniq, no), Real, M,
- ground(shared, no), semidet, M) :-
- check_not_clobbered(Real, Uniq).
-
-abstractly_unify_inst_3(live, abstract_inst(Name, ArgsA),
- abstract_inst(Name, ArgsB), Real, ModuleInfo0,
- abstract_inst(Name, Args), Det, ModuleInfo) :-
- abstractly_unify_inst_list(ArgsA, ArgsB, live, Real, ModuleInfo0,
- Args, Det, ModuleInfo).
-***/
-
-abstractly_unify_inst_3(dead, not_reached, _, _, M, not_reached, det, M).
-
-abstractly_unify_inst_3(dead, any(UniqX), any(UniqY), Real, M,
- any(Uniq), semidet, M) :-
- Real = fake_unify,
- unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq).
-
-abstractly_unify_inst_3(dead, any(UniqX), free, _Real, M,
- any(UniqX), det, M).
-
-abstractly_unify_inst_3(dead, free, Inst, _, M, Inst, det, M).
-
-abstractly_unify_inst_3(dead, bound(UniqX, List), free, Real, ModuleInfo,
- bound(Uniq, List), det, ModuleInfo) :-
- unify_uniq(dead, Real, det, UniqX, unique, Uniq).
-
-abstractly_unify_inst_3(dead, bound(UniqX, ListX), bound(UniqY, ListY),
- Real, M0, bound(Uniq, List), Det, M) :-
- abstractly_unify_bound_inst_list(dead, ListX, ListY, Real, M0,
- List, Det, M),
- unify_uniq(dead, Real, Det, UniqX, UniqY, Uniq).
-
-abstractly_unify_inst_3(dead, bound(UniqX, BoundInsts0), ground(UniqY, _),
- Real, M0, bound(Uniq, BoundInsts), semidet, M) :-
- unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq),
- make_ground_bound_inst_list(BoundInsts0, dead, UniqY, Real, M0,
- BoundInsts, M).
-
-/***** abstract insts aren't really supported
-abstractly_unify_inst_3(dead, bound(Uniq, List), abstract_inst(N,As),
- ModuleInfo, Result, Det, ModuleInfo) :-
- ( bound_inst_list_is_ground(List, ModuleInfo) ->
- Result = bound(Uniq, List),
- Det = semidet
- ; bound_inst_list_is_free(List, ModuleInfo) ->
- Result = abstract_inst(N,As),
- Det = det
- ;
- fail
- ).
-*****/
-
-abstractly_unify_inst_3(dead, ground(Uniq, yes(PredInst)), free, _Real, M,
- ground(Uniq, yes(PredInst)), det, M).
-
-abstractly_unify_inst_3(dead, ground(UniqA, yes(_)), bound(UniqB, BoundInsts0),
- Real, M0, bound(Uniq, BoundInsts), semidet, M) :-
- unify_uniq(dead, Real, semidet, UniqA, UniqB, Uniq),
- make_ground_bound_inst_list(BoundInsts0, dead, UniqA, Real, M0,
- BoundInsts, M).
-
-abstractly_unify_inst_3(dead, ground(UniqA, yes(PredInstA)),
- ground(UniqB, _MaybePredInstB), Real, M,
- ground(Uniq, PredInst), det, M) :-
- Real = fake_unify,
- PredInst = yes(PredInstA),
- unify_uniq(dead, Real, det, UniqA, UniqB, Uniq).
-
-abstractly_unify_inst_3(dead, ground(Uniq, no), Inst0, Real, M0,
- Inst, Det, M) :-
- ( inst_is_free(M0, Inst0) ->
- Det = det
- ;
- Det = semidet
- ),
- make_ground_inst(Inst0, dead, Uniq, Real, M0, Inst, M).
-
-/***** abstract insts aren't really supported
-abstractly_unify_inst_3(dead, abstract_inst(N,As), bound(List), Real,
- ModuleInfo, Result, Det, ModuleInfo) :-
- ( bound_inst_list_is_ground(List, ModuleInfo) ->
- Result = bound(List),
- Det = semidet
- ; bound_inst_list_is_free(List, ModuleInfo) ->
- Result = abstract_inst(N,As),
- Det = det
- ;
- fail
- ).
-
-abstractly_unify_inst_3(dead, abstract_inst(_,_), ground, _Real, ModuleInfo,
- ground, semidet, ModuleInfo).
-
-abstractly_unify_inst_3(dead, abstract_inst(Name, ArgsA),
- abstract_inst(Name, ArgsB), Real, ModuleInfo0,
- abstract_inst(Name, Args), Det, ModuleInfo) :-
- abstractly_unify_inst_list(ArgsA, ArgsB, dead, Real, ModuleInfo0,
- Args, Det, ModuleInfo).
-
-*****/
-
-%-----------------------------------------------------------------------------%
-
-:- pred unify_uniq(is_live, unify_is_real, determinism, uniqueness, uniqueness,
- uniqueness).
-:- mode unify_uniq(in, in, in, in, in, out) is semidet.
-
- % Unifying shared with either shared or unique gives shared.
- % Unifying unique with unique gives shared if live, unique if
- % dead. Unifying clobbered with anything gives clobbered,
- % except that if live then it is an internal error (a clobbered
- % value should not be live, right?), and except that unifying
- % with clobbered is not allowed for semidet unifications,
- % unless they are "fake".
- %
- % The only way this predicate can abort is if a clobbered value
- % is live.
- % The only way this predicate can fail (indicating a unique mode error)
- % is if we are attempting to unify with a clobbered value, and
- % this was a "real" unification, not a "fake" one,
- % and the determinism of the unification is semidet.
- % (See comment in prog_data.m for more info on "real" v.s. "fake".)
- % Note that if a unification or sub-unification is det, then it is
- % OK to unify with a clobbered value. This can occur e.g. with
- % unifications between free and clobbered, or with free and
- % bound(..., clobbered, ...). Such det unifications are OK because
- % the clobbered value will not be examined, instead all that will
- % happen is that a variable or a field of a variable will become
- % bound to the clobbered value; and since the final inst will also
- % be clobbered, the variable or field's value can never be examined
- % later either. Only semidet unifications would test the value
- % of a clobbered variable, so those are the only ones we need to
- % disallow.
-
-unify_uniq(_, _, _, shared, shared, shared).
-unify_uniq(_, _, _, shared, unique, shared).
-unify_uniq(_, _, _, shared, mostly_unique, shared).
-unify_uniq(Live, Real, Det, shared, clobbered, clobbered) :-
- allow_unify_with_clobbered(Live, Real, Det).
-unify_uniq(Live, Real, Det, shared, mostly_clobbered, mostly_clobbered) :-
- allow_unify_with_clobbered(Live, Real, Det).
-
-unify_uniq(_, _, _, unique, shared, shared).
-unify_uniq(live, _, _, unique, unique, shared).
-unify_uniq(live, _, _, unique, mostly_unique, shared).
-unify_uniq(dead, _, _, unique, unique, unique).
-unify_uniq(dead, _, _, unique, mostly_unique, mostly_unique).
- % XXX the above line is a conservative approximation
- % sometimes it should return unique not mostly_unique
-unify_uniq(Live, Real, Det, unique, clobbered, clobbered) :-
- allow_unify_with_clobbered(Live, Real, Det).
-unify_uniq(Live, Real, Det, unique, mostly_clobbered, mostly_clobbered) :-
- allow_unify_with_clobbered(Live, Real, Det).
-
-unify_uniq(_, _, _, mostly_unique, shared, shared).
-unify_uniq(live, _, _, mostly_unique, unique, shared).
-unify_uniq(live, _, _, mostly_unique, mostly_unique, shared).
-unify_uniq(dead, _, _, mostly_unique, unique, mostly_unique).
- % XXX the above line is a conservative approximation
- % sometimes it should return unique not mostly_unique
-unify_uniq(dead, _, _, mostly_unique, mostly_unique, mostly_unique).
-unify_uniq(Live, Real, Det, mostly_unique, clobbered, clobbered) :-
- allow_unify_with_clobbered(Live, Real, Det).
-unify_uniq(Live, Real, Det, mostly_unique, mostly_clobbered,
- mostly_clobbered) :-
- allow_unify_with_clobbered(Live, Real, Det).
-
-unify_uniq(Live, Real, Det, clobbered, _, clobbered) :-
- allow_unify_with_clobbered(Live, Real, Det).
-
-unify_uniq(Live, Real, Det, mostly_clobbered, Uniq0, Uniq) :-
- ( Uniq0 = clobbered -> Uniq = clobbered ; Uniq = mostly_clobbered ),
- allow_unify_with_clobbered(Live, Real, Det).
-
-:- pred allow_unify_with_clobbered(is_live, unify_is_real, determinism).
-:- mode allow_unify_with_clobbered(in, in, in) is semidet.
-
-allow_unify_with_clobbered(live, _, _) :-
- error("allow_unify_with_clobbered: clobbered value is live?").
-allow_unify_with_clobbered(dead, fake_unify, _).
-allow_unify_with_clobbered(dead, _, det).
-
-%-----------------------------------------------------------------------------%
-
-:- pred check_not_clobbered(uniqueness, unify_is_real).
-:- mode check_not_clobbered(in, in) is det.
-
- % sanity check
-check_not_clobbered(Uniq, Real) :-
- ( Real = real_unify, Uniq = clobbered ->
- error("abstractly_unify_inst_3: clobbered inst")
- ; Real = real_unify, Uniq = mostly_clobbered ->
- error("abstractly_unify_inst_3: mostly_clobbered inst")
- ;
- true
- ).
-
-%-----------------------------------------------------------------------------%
-
- % Abstractly unify two inst lists.
-
-:- pred abstractly_unify_inst_list(list(inst), list(inst), is_live,
- unify_is_real, module_info,
- list(inst), determinism, module_info).
-:- mode abstractly_unify_inst_list(in, in, in, in, in, out, out, out)
- is semidet.
-
-abstractly_unify_inst_list([], [], _, _, M, [], det, M).
-abstractly_unify_inst_list([X|Xs], [Y|Ys], Live, Real, ModuleInfo0,
- [Z|Zs], Det, ModuleInfo) :-
- abstractly_unify_inst(Live, X, Y, Real, ModuleInfo0,
- Z, Det1, ModuleInfo1),
- abstractly_unify_inst_list(Xs, Ys, Live, Real, ModuleInfo1,
- Zs, Det2, ModuleInfo),
- ( Det1 = semidet ->
- Det = semidet
- ;
- Det = Det2
- ).
-
-%-----------------------------------------------------------------------------%
-
- % This is the abstract unification operation which
- % unifies a variable (or rather, it's instantiatedness)
- % with a functor.
-
-abstractly_unify_inst_functor(Live, InstA, ConsId, ArgInsts, ArgLives,
- Real, ModuleInfo0, Inst, ModuleInfo) :-
- inst_expand(ModuleInfo0, InstA, InstA2),
- abstractly_unify_inst_functor_2(Live, InstA2, ConsId, ArgInsts,
- ArgLives, Real, ModuleInfo0, Inst, ModuleInfo).
-
-:- pred abstractly_unify_inst_functor_2(is_live, inst, cons_id, list(inst),
- list(is_live), unify_is_real, module_info,
- inst, module_info).
-:- mode abstractly_unify_inst_functor_2(in, in, in, in, in, in, in, out, out)
- is semidet.
-
- % XXX need to handle `any' insts
-
-abstractly_unify_inst_functor_2(live, not_reached, _, _, _, _, M,
- not_reached, M).
-
-abstractly_unify_inst_functor_2(live, free, ConsId, Args0, ArgLives, _Real,
- ModuleInfo0,
- bound(unique, [functor(ConsId, Args)]), ModuleInfo) :-
- inst_list_is_ground_or_any_or_dead(Args0, ArgLives, ModuleInfo0),
- maybe_make_shared_inst_list(Args0, ArgLives, ModuleInfo0,
- Args, ModuleInfo).
-
-abstractly_unify_inst_functor_2(live, bound(Uniq, ListX), ConsId, Args,
- ArgLives, Real, M0, bound(Uniq, List), M) :-
- abstractly_unify_bound_inst_list_lives(ListX, ConsId, Args, ArgLives,
- Real, M0, List, M).
-
-abstractly_unify_inst_functor_2(live, ground(Uniq, _), ConsId, ArgInsts,
- ArgLives, Real, M0, Inst, M) :-
- make_ground_inst_list_lives(ArgInsts, live, ArgLives, Uniq, Real, M0,
- GroundArgInsts, M),
- Inst = bound(Uniq, [functor(ConsId, GroundArgInsts)]).
-
-% abstractly_unify_inst_functor_2(live, abstract_inst(_,_), _, _, _, _, _, _) :-
-% fail.
-
-abstractly_unify_inst_functor_2(dead, not_reached, _, _, _, _, M,
- not_reached, M).
-
-abstractly_unify_inst_functor_2(dead, free, ConsId, Args, _ArgLives, _Real, M,
- bound(unique, [functor(ConsId, Args)]), M).
-
-abstractly_unify_inst_functor_2(dead, bound(Uniq, ListX), ConsId, Args,
- _ArgLives, Real, M0, bound(Uniq, List), M) :-
- ListY = [functor(ConsId, Args)],
- abstractly_unify_bound_inst_list(dead, ListX, ListY, Real, M0,
- List, _, M).
-
-abstractly_unify_inst_functor_2(dead, ground(Uniq, _), ConsId, ArgInsts,
- _ArgLives, Real, M0, Inst, M) :-
- make_ground_inst_list(ArgInsts, dead, Uniq, Real, M0,
- GroundArgInsts, M),
- Inst = bound(Uniq, [functor(ConsId, GroundArgInsts)]).
-
-% abstractly_unify_inst_functor_2(dead, abstract_inst(_,_), _, _, _, _, _, _) :-
-% fail.
-
-%-----------------------------------------------------------------------------%
-
-:- pred make_ground_inst_list_lives(list(inst), is_live, list(is_live),
- uniqueness, unify_is_real,
- module_info, list(inst), module_info).
-:- mode make_ground_inst_list_lives(in, in, in, in, in, in, out, out)
- is semidet.
-
-make_ground_inst_list_lives([], _, _, _, _, ModuleInfo, [], ModuleInfo).
-make_ground_inst_list_lives([Inst0 | Insts0], Live, [ArgLive | ArgLives],
- Uniq, Real, ModuleInfo0, [Inst | Insts], ModuleInfo) :-
- ( Live = live, ArgLive = live ->
- BothLive = live
- ;
- BothLive = dead
- ),
- make_ground_inst(Inst0, BothLive, Uniq, Real, ModuleInfo0,
- Inst, ModuleInfo1),
- make_ground_inst_list_lives(Insts0, Live, ArgLives, Uniq, Real,
- ModuleInfo1, Insts, ModuleInfo).
-
-:- pred make_ground_inst_list(list(inst), is_live, uniqueness, unify_is_real,
- module_info, list(inst), module_info).
-:- mode make_ground_inst_list(in, in, in, in, in, out, out) is semidet.
-
-make_ground_inst_list([], _, _, _, ModuleInfo, [], ModuleInfo).
-make_ground_inst_list([Inst0 | Insts0], Live, Uniq, Real, ModuleInfo0,
- [Inst | Insts], ModuleInfo) :-
- make_ground_inst(Inst0, Live, Uniq, Real, ModuleInfo0,
- Inst, ModuleInfo1),
- make_ground_inst_list(Insts0, Live, Uniq, Real, ModuleInfo1,
- Insts, ModuleInfo).
-
-% abstractly unify an inst with `ground' and calculate the new inst
-% and the determinism of the unification.
-
-:- pred make_ground_inst(inst, is_live, uniqueness, unify_is_real, module_info,
- inst, module_info).
-:- mode make_ground_inst(in, in, in, in, in, out, out) is semidet.
-
-make_ground_inst(not_reached, _, _, _, M, not_reached, M).
-make_ground_inst(any(Uniq0), IsLive, Uniq1, Real, M, ground(Uniq, no), M) :-
- unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq).
-make_ground_inst(free, IsLive, Uniq0, Real, M, ground(Uniq, no), M) :-
- unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq).
-make_ground_inst(free(T), IsLive, Uniq0, Real, M,
- defined_inst(typed_ground(Uniq, T)), M) :-
- unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq).
-make_ground_inst(bound(Uniq0, BoundInsts0), IsLive, Uniq1, Real, M0,
- bound(Uniq, BoundInsts), M) :-
- unify_uniq(dead, Real, semidet, Uniq0, Uniq1, Uniq),
- make_ground_bound_inst_list(BoundInsts0, IsLive, Uniq1, Real, M0,
- BoundInsts, M).
-make_ground_inst(ground(Uniq0, _PredInst), _IsLive, Uniq1, Real, M,
- ground(Uniq, no), M) :-
- unify_uniq(dead, Real, semidet, Uniq0, Uniq1, Uniq).
-make_ground_inst(inst_var(_), _, _, _, _, _, _) :-
- error("free inst var").
-make_ground_inst(abstract_inst(_,_), _, _, _, M, ground(shared, no), M).
-make_ground_inst(defined_inst(InstName), IsLive, Uniq, Real, ModuleInfo0,
- Inst, ModuleInfo) :-
- % check whether the inst name is already in the
- % ground_inst table
- module_info_insts(ModuleInfo0, InstTable0),
- inst_table_get_ground_insts(InstTable0, GroundInsts0),
- GroundInstKey = ground_inst(InstName, IsLive, Uniq, Real),
- (
- map__search(GroundInsts0, GroundInstKey, Result)
- ->
- ( Result = known(GroundInst0) ->
- GroundInst = GroundInst0
- ;
- GroundInst = defined_inst(GroundInstKey)
- ),
- ModuleInfo = ModuleInfo0
- ;
- % insert the inst name in the ground_inst table, with
- % value `unknown' for the moment
- map__set(GroundInsts0, GroundInstKey, unknown, GroundInsts1),
- inst_table_set_ground_insts(InstTable0, GroundInsts1,
- InstTable1),
- module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
-
- % expand the inst name, and invoke ourself recursively on
- % it's expansion
- inst_lookup(ModuleInfo1, InstName, Inst0),
- inst_expand(ModuleInfo1, Inst0, Inst1),
- make_ground_inst(Inst1, IsLive, Uniq, Real, ModuleInfo1,
- GroundInst, ModuleInfo2),
-
- % now that we have determined the resulting Inst, store
- % the appropriate value `known(GroundInst)' in the ground_inst
- % table
- module_info_insts(ModuleInfo2, InstTable2),
- inst_table_get_ground_insts(InstTable2, GroundInsts2),
- map__set(GroundInsts2, GroundInstKey, known(GroundInst),
- GroundInsts),
- inst_table_set_ground_insts(InstTable2, GroundInsts,
- InstTable),
- module_info_set_insts(ModuleInfo2, InstTable, ModuleInfo)
- ),
- % avoid expanding recursive insts
- ( inst_contains_instname(GroundInst, ModuleInfo, GroundInstKey) ->
- Inst = defined_inst(GroundInstKey)
- ;
- Inst = GroundInst
- ).
-
-:- pred make_ground_bound_inst_list(list(bound_inst), is_live, uniqueness,
- unify_is_real, module_info, list(bound_inst), module_info).
-:- mode make_ground_bound_inst_list(in, in, in, in, in, out, out) is semidet.
-
-make_ground_bound_inst_list([], _, _, _, ModuleInfo, [], ModuleInfo).
-make_ground_bound_inst_list([Bound0 | Bounds0], IsLive, Uniq, Real, ModuleInfo0,
- [Bound | Bounds], ModuleInfo) :-
- Bound0 = functor(ConsId, ArgInsts0),
- make_ground_inst_list(ArgInsts0, IsLive, Uniq, Real, ModuleInfo0,
- ArgInsts, ModuleInfo1),
- Bound = functor(ConsId, ArgInsts),
- make_ground_bound_inst_list(Bounds0, IsLive, Uniq, Real, ModuleInfo1,
- Bounds, ModuleInfo).
+ % inst_is_clobbered succeeds iff the inst passed is `clobbered'
+ % or `mostly_clobbered' or if it is a user-defined inst which
+ % is defined as one of those.
+
+inst_is_clobbered(_, not_reached) :- fail.
+inst_is_clobbered(_, any(mostly_clobbered)).
+inst_is_clobbered(_, any(clobbered)).
+inst_is_clobbered(_, ground(clobbered, _)).
+inst_is_clobbered(_, ground(mostly_clobbered, _)).
+inst_is_clobbered(_, bound(clobbered, _)).
+inst_is_clobbered(_, bound(mostly_clobbered, _)).
+inst_is_clobbered(_, inst_var(_)) :-
+ error("internal error: uninstantiated inst parameter").
+inst_is_clobbered(ModuleInfo, defined_inst(InstName)) :-
+ inst_lookup(ModuleInfo, InstName, Inst),
+ inst_is_clobbered(ModuleInfo, Inst).
+
+ % inst_is_free succeeds iff the inst passed is `free'
+ % 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(_, inst_var(_)) :-
+ error("internal error: uninstantiated inst parameter").
+inst_is_free(ModuleInfo, defined_inst(InstName)) :-
+ inst_lookup(ModuleInfo, InstName, Inst),
+ inst_is_free(ModuleInfo, Inst).
+
+ % 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.
+
+inst_is_bound(_, any(_)).
+inst_is_bound(_, ground(_, _)).
+inst_is_bound(_, bound(_, _)).
+inst_is_bound(_, inst_var(_)) :-
+ error("internal error: uninstantiated inst parameter").
+inst_is_bound(ModuleInfo, defined_inst(InstName)) :-
+ inst_lookup(ModuleInfo, InstName, Inst),
+ inst_is_bound(ModuleInfo, Inst).
+inst_is_bound(_, abstract_inst(_, _)).
+
+ % inst_is_bound_to_functors succeeds iff the inst passed is
+ % `bound(_Uniq, Functors)' or is a user-defined inst which expands to
+ % `bound(_Uniq, Functors)'.
+
+inst_is_bound_to_functors(_, bound(_Uniq, Functors), Functors).
+inst_is_bound_to_functors(_, inst_var(_), _) :-
+ error("internal error: uninstantiated inst parameter").
+inst_is_bound_to_functors(ModuleInfo, defined_inst(InstName), Functors) :-
+ inst_lookup(ModuleInfo, InstName, Inst),
+ inst_is_bound_to_functors(ModuleInfo, Inst, Functors).
+
+%-----------------------------------------------------------------------------%
+
+ % inst_is_ground succeeds iff the inst passed is `ground'
+ % or the equivalent. Abstract insts are not considered ground.
+
+inst_is_ground(ModuleInfo, Inst) :-
+ set__init(Expansions),
+ inst_is_ground_2(ModuleInfo, Inst, Expansions).
+
+ % The third arg is the set of insts which have already
+ % been expanded - we use this to avoid going into an
+ % infinite loop.
+
+:- pred inst_is_ground_2(module_info, inst, set(inst)).
+:- mode inst_is_ground_2(in, in, in) is semidet.
+
+inst_is_ground_2(_, not_reached, _).
+inst_is_ground_2(ModuleInfo, bound(_, List), Expansions) :-
+ bound_inst_list_is_ground_2(List, ModuleInfo, Expansions).
+inst_is_ground_2(_, ground(_, _), _).
+inst_is_ground_2(_, inst_var(_), _) :-
+ error("internal error: uninstantiated inst parameter").
+inst_is_ground_2(ModuleInfo, Inst, Expansions) :-
+ Inst = defined_inst(InstName),
+ ( set__member(Inst, Expansions) ->
+ true
+ ;
+ set__insert(Expansions, Inst, Expansions2),
+ inst_lookup(ModuleInfo, InstName, Inst2),
+ inst_is_ground_2(ModuleInfo, Inst2, Expansions2)
+ ).
+
+ % inst_is_ground_or_any succeeds iff the inst passed is `ground',
+ % `any', or the equivalent. Fails for abstract insts.
+
+inst_is_ground_or_any(ModuleInfo, Inst) :-
+ set__init(Expansions),
+ inst_is_ground_or_any_2(ModuleInfo, Inst, Expansions).
+
+ % The third arg is the set of insts which have already
+ % been expanded - we use this to avoid going into an
+ % infinite loop.
+
+:- pred inst_is_ground_or_any_2(module_info, inst, set(inst)).
+:- mode inst_is_ground_or_any_2(in, in, in) is semidet.
+
+inst_is_ground_or_any_2(_, not_reached, _).
+inst_is_ground_or_any_2(ModuleInfo, bound(_, List), Expansions) :-
+ bound_inst_list_is_ground_or_any_2(List, ModuleInfo, Expansions).
+inst_is_ground_or_any_2(_, ground(_, _), _).
+inst_is_ground_or_any_2(_, any(_), _).
+inst_is_ground_or_any_2(_, inst_var(_), _) :-
+ error("internal error: uninstantiated inst parameter").
+inst_is_ground_or_any_2(ModuleInfo, Inst, Expansions) :-
+ Inst = defined_inst(InstName),
+ ( set__member(Inst, Expansions) ->
+ true
+ ;
+ set__insert(Expansions, Inst, Expansions2),
+ inst_lookup(ModuleInfo, InstName, Inst2),
+ inst_is_ground_or_any_2(ModuleInfo, Inst2, Expansions2)
+ ).
+
+ % inst_is_unique succeeds iff the inst passed is unique
+ % or free. Abstract insts are not considered unique.
+
+inst_is_unique(ModuleInfo, Inst) :-
+ set__init(Expansions),
+ inst_is_unique_2(ModuleInfo, Inst, Expansions).
+
+ % The third arg is the set of insts which have already
+ % been expanded - we use this to avoid going into an
+ % infinite loop.
+
+:- pred inst_is_unique_2(module_info, inst, set(inst)).
+:- mode inst_is_unique_2(in, in, in) is semidet.
+
+inst_is_unique_2(_, not_reached, _).
+inst_is_unique_2(ModuleInfo, bound(unique, List), Expansions) :-
+ bound_inst_list_is_unique_2(List, ModuleInfo, Expansions).
+inst_is_unique_2(_, any(unique), _).
+inst_is_unique_2(_, free, _).
+inst_is_unique_2(_, ground(unique, _), _).
+inst_is_unique_2(_, inst_var(_), _) :-
+ error("internal error: uninstantiated inst parameter").
+inst_is_unique_2(ModuleInfo, Inst, Expansions) :-
+ Inst = defined_inst(InstName),
+ ( set__member(Inst, Expansions) ->
+ true
+ ;
+ set__insert(Expansions, Inst, Expansions2),
+ inst_lookup(ModuleInfo, InstName, Inst2),
+ inst_is_unique_2(ModuleInfo, Inst2, Expansions2)
+ ).
+
+ % inst_is_mostly_unique succeeds iff the inst passed is unique,
+ % mostly_unique, or free. Abstract insts are not considered unique.
+
+inst_is_mostly_unique(ModuleInfo, Inst) :-
+ set__init(Expansions),
+ inst_is_mostly_unique_2(ModuleInfo, Inst, Expansions).
+
+ % The third arg is the set of insts which have already
+ % been expanded - we use this to avoid going into an
+ % infinite loop.
+
+:- pred inst_is_mostly_unique_2(module_info, inst, set(inst)).
+:- mode inst_is_mostly_unique_2(in, in, in) is semidet.
+
+inst_is_mostly_unique_2(_, not_reached, _).
+inst_is_mostly_unique_2(ModuleInfo, bound(mostly_unique, List), Expansions) :-
+ bound_inst_list_is_mostly_unique_2(List, ModuleInfo, Expansions).
+inst_is_mostly_unique_2(ModuleInfo, bound(mostly_unique, List), Expansions) :-
+ bound_inst_list_is_mostly_unique_2(List, 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(_, ground(unique, _), _).
+inst_is_mostly_unique_2(_, ground(mostly_unique, _), _).
+inst_is_mostly_unique_2(_, inst_var(_), _) :-
+ error("internal error: uninstantiated inst parameter").
+inst_is_mostly_unique_2(ModuleInfo, Inst, Expansions) :-
+ Inst = defined_inst(InstName),
+ ( set__member(Inst, Expansions) ->
+ true
+ ;
+ set__insert(Expansions, Inst, Expansions2),
+ inst_lookup(ModuleInfo, InstName, Inst2),
+ inst_is_mostly_unique_2(ModuleInfo, Inst2, Expansions2)
+ ).
+
+ % inst_is_not_partly_unique succeeds iff the inst passed is
+ % not unique or mostly_unique, i.e. if it is shared
+ % or free. It fails for abstract insts.
+
+inst_is_not_partly_unique(ModuleInfo, Inst) :-
+ set__init(Expansions),
+ inst_is_not_partly_unique_2(ModuleInfo, Inst, Expansions).
+
+ % The third arg is the set of insts which have already
+ % been expanded - we use this to avoid going into an
+ % infinite loop.
+
+:- pred inst_is_not_partly_unique_2(module_info, inst, set(inst)).
+:- mode inst_is_not_partly_unique_2(in, in, in) is semidet.
+
+inst_is_not_partly_unique_2(_, not_reached, _).
+inst_is_not_partly_unique_2(ModuleInfo, bound(shared, List), Expansions) :-
+ bound_inst_list_is_not_partly_unique_2(List, ModuleInfo, Expansions).
+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(_), _) :-
+ error("internal error: uninstantiated inst parameter").
+inst_is_not_partly_unique_2(ModuleInfo, Inst, Expansions) :-
+ Inst = defined_inst(InstName),
+ ( set__member(Inst, Expansions) ->
+ true
+ ;
+ set__insert(Expansions, Inst, Expansions2),
+ inst_lookup(ModuleInfo, InstName, Inst2),
+ inst_is_not_partly_unique_2(ModuleInfo, Inst2, Expansions2)
+ ).
+
+ % inst_is_not_fully_unique succeeds iff the inst passed is
+ % not unique, i.e. if it is mostly_unique, shared,
+ % or free. It fails for abstract insts.
+
+inst_is_not_fully_unique(ModuleInfo, Inst) :-
+ set__init(Expansions),
+ inst_is_not_fully_unique_2(ModuleInfo, Inst, Expansions).
+
+ % The third arg is the set of insts which have already
+ % been expanded - we use this to avoid going into an
+ % infinite loop.
+
+:- pred inst_is_not_fully_unique_2(module_info, inst, set(inst)).
+:- mode inst_is_not_fully_unique_2(in, in, in) is semidet.
+
+inst_is_not_fully_unique_2(_, not_reached, _).
+inst_is_not_fully_unique_2(ModuleInfo, bound(shared, List), Expansions) :-
+ bound_inst_list_is_not_fully_unique_2(List, ModuleInfo, Expansions).
+inst_is_not_fully_unique_2(ModuleInfo, bound(mostly_unique, List),
+ Expansions) :-
+ bound_inst_list_is_not_fully_unique_2(List, 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(_, ground(shared, _), _).
+inst_is_not_fully_unique_2(_, ground(mostly_unique, _), _).
+inst_is_not_fully_unique_2(_, inst_var(_), _) :-
+ error("internal error: uninstantiated inst parameter").
+inst_is_not_fully_unique_2(ModuleInfo, Inst, Expansions) :-
+ Inst = defined_inst(InstName),
+ ( set__member(Inst, Expansions) ->
+ true
+ ;
+ set__insert(Expansions, Inst, Expansions2),
+ inst_lookup(ModuleInfo, InstName, Inst2),
+ inst_is_not_fully_unique_2(ModuleInfo, Inst2, Expansions2)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+bound_inst_list_is_ground([], _).
+bound_inst_list_is_ground([functor(_Name, Args)|BoundInsts], ModuleInfo) :-
+ inst_list_is_ground(Args, ModuleInfo),
+ bound_inst_list_is_ground(BoundInsts, ModuleInfo).
+
+bound_inst_list_is_ground_or_any([], _).
+bound_inst_list_is_ground_or_any([functor(_Name, Args)|BoundInsts],
+ ModuleInfo) :-
+ inst_list_is_ground_or_any(Args, ModuleInfo),
+ bound_inst_list_is_ground_or_any(BoundInsts, ModuleInfo).
+
+bound_inst_list_is_unique([], _).
+bound_inst_list_is_unique([functor(_Name, Args)|BoundInsts], ModuleInfo) :-
+ inst_list_is_unique(Args, ModuleInfo),
+ bound_inst_list_is_unique(BoundInsts, ModuleInfo).
+
+bound_inst_list_is_mostly_unique([], _).
+bound_inst_list_is_mostly_unique([functor(_Name, Args)|BoundInsts],
+ ModuleInfo) :-
+ inst_list_is_mostly_unique(Args, ModuleInfo),
+ bound_inst_list_is_mostly_unique(BoundInsts, ModuleInfo).
+
+bound_inst_list_is_not_partly_unique([], _).
+bound_inst_list_is_not_partly_unique([functor(_Name, Args)|BoundInsts],
+ ModuleInfo) :-
+ inst_list_is_not_partly_unique(Args, ModuleInfo),
+ bound_inst_list_is_not_partly_unique(BoundInsts, ModuleInfo).
+
+bound_inst_list_is_not_fully_unique([], _).
+bound_inst_list_is_not_fully_unique([functor(_Name, Args)|BoundInsts],
+ ModuleInfo) :-
+ inst_list_is_not_fully_unique(Args, ModuleInfo),
+ bound_inst_list_is_not_fully_unique(BoundInsts, ModuleInfo).
+
+%-----------------------------------------------------------------------------%
+
+:- pred bound_inst_list_is_ground_2(list(bound_inst), module_info, set(inst)).
+:- mode bound_inst_list_is_ground_2(in, in, in) is semidet.
+
+bound_inst_list_is_ground_2([], _, _).
+bound_inst_list_is_ground_2([functor(_Name, Args)|BoundInsts], ModuleInfo,
+ Expansions) :-
+ inst_list_is_ground_2(Args, ModuleInfo, Expansions),
+ bound_inst_list_is_ground_2(BoundInsts, ModuleInfo, Expansions).
+
+:- pred bound_inst_list_is_ground_or_any_2(list(bound_inst), module_info,
+ set(inst)).
+:- mode bound_inst_list_is_ground_or_any_2(in, in, in) is semidet.
+
+bound_inst_list_is_ground_or_any_2([], _, _).
+bound_inst_list_is_ground_or_any_2([functor(_Name, Args)|BoundInsts],
+ ModuleInfo, Expansions) :-
+ inst_list_is_ground_or_any_2(Args, ModuleInfo, Expansions),
+ bound_inst_list_is_ground_or_any_2(BoundInsts, ModuleInfo, Expansions).
+
+:- pred bound_inst_list_is_unique_2(list(bound_inst), module_info, set(inst)).
+:- mode bound_inst_list_is_unique_2(in, in, in) is semidet.
+
+bound_inst_list_is_unique_2([], _, _).
+bound_inst_list_is_unique_2([functor(_Name, Args)|BoundInsts], ModuleInfo,
+ Expansions) :-
+ inst_list_is_unique_2(Args, ModuleInfo, Expansions),
+ bound_inst_list_is_unique_2(BoundInsts, ModuleInfo, Expansions).
+
+:- pred bound_inst_list_is_mostly_unique_2(list(bound_inst), module_info,
+ set(inst)).
+:- mode bound_inst_list_is_mostly_unique_2(in, in, in) is semidet.
+
+bound_inst_list_is_mostly_unique_2([], _, _).
+bound_inst_list_is_mostly_unique_2([functor(_Name, Args)|BoundInsts],
+ ModuleInfo, Expansions) :-
+ inst_list_is_mostly_unique_2(Args, ModuleInfo, Expansions),
+ bound_inst_list_is_mostly_unique_2(BoundInsts, ModuleInfo, Expansions).
+
+:- pred bound_inst_list_is_not_partly_unique_2(list(bound_inst), module_info,
+ set(inst)).
+:- mode bound_inst_list_is_not_partly_unique_2(in, in, in) is semidet.
+
+bound_inst_list_is_not_partly_unique_2([], _, _).
+bound_inst_list_is_not_partly_unique_2([functor(_Name, Args)|BoundInsts],
+ ModuleInfo, Expansions) :-
+ inst_list_is_not_partly_unique_2(Args, ModuleInfo, Expansions),
+ bound_inst_list_is_not_partly_unique_2(BoundInsts, ModuleInfo,
+ Expansions).
+
+:- pred bound_inst_list_is_not_fully_unique_2(list(bound_inst), module_info,
+ set(inst)).
+:- mode bound_inst_list_is_not_fully_unique_2(in, in, in) is semidet.
+
+bound_inst_list_is_not_fully_unique_2([], _, _).
+bound_inst_list_is_not_fully_unique_2([functor(_Name, Args)|BoundInsts],
+ ModuleInfo, Expansions) :-
+ inst_list_is_not_fully_unique_2(Args, ModuleInfo, Expansions),
+ bound_inst_list_is_not_fully_unique_2(BoundInsts, ModuleInfo,
+ Expansions).
+
+%-----------------------------------------------------------------------------%
+
+inst_list_is_ground([], _).
+inst_list_is_ground([Inst | Insts], ModuleInfo) :-
+ inst_is_ground(ModuleInfo, Inst),
+ inst_list_is_ground(Insts, ModuleInfo).
+
+inst_list_is_ground_or_any([], _).
+inst_list_is_ground_or_any([Inst | Insts], ModuleInfo) :-
+ inst_is_ground_or_any(ModuleInfo, Inst),
+ inst_list_is_ground_or_any(Insts, ModuleInfo).
+
+inst_list_is_unique([], _).
+inst_list_is_unique([Inst | Insts], ModuleInfo) :-
+ inst_is_unique(ModuleInfo, Inst),
+ inst_list_is_unique(Insts, ModuleInfo).
+
+inst_list_is_mostly_unique([], _).
+inst_list_is_mostly_unique([Inst | Insts], ModuleInfo) :-
+ inst_is_mostly_unique(ModuleInfo, Inst),
+ inst_list_is_mostly_unique(Insts, ModuleInfo).
+
+inst_list_is_not_partly_unique([], _).
+inst_list_is_not_partly_unique([Inst | Insts], ModuleInfo) :-
+ inst_is_not_partly_unique(ModuleInfo, Inst),
+ inst_list_is_not_partly_unique(Insts, ModuleInfo).
+
+inst_list_is_not_fully_unique([], _).
+inst_list_is_not_fully_unique([Inst | Insts], ModuleInfo) :-
+ inst_is_not_fully_unique(ModuleInfo, Inst),
+ inst_list_is_not_fully_unique(Insts, ModuleInfo).
+
+%-----------------------------------------------------------------------------%
+
+:- pred inst_list_is_ground_2(list(inst), module_info, set(inst)).
+:- mode inst_list_is_ground_2(in, in, in) is semidet.
+
+inst_list_is_ground_2([], _, _).
+inst_list_is_ground_2([Inst | Insts], ModuleInfo, Expansions) :-
+ inst_is_ground_2(ModuleInfo, Inst, Expansions),
+ inst_list_is_ground_2(Insts, ModuleInfo, Expansions).
+
+:- pred inst_list_is_ground_or_any_2(list(inst), module_info, set(inst)).
+:- mode inst_list_is_ground_or_any_2(in, in, in) is semidet.
+
+inst_list_is_ground_or_any_2([], _, _).
+inst_list_is_ground_or_any_2([Inst | Insts], ModuleInfo, Expansions) :-
+ inst_is_ground_or_any_2(ModuleInfo, Inst, Expansions),
+ inst_list_is_ground_or_any_2(Insts, ModuleInfo, Expansions).
+
+:- pred inst_list_is_unique_2(list(inst), module_info, set(inst)).
+:- mode inst_list_is_unique_2(in, in, in) is semidet.
+
+inst_list_is_unique_2([], _, _).
+inst_list_is_unique_2([Inst | Insts], ModuleInfo, Expansions) :-
+ inst_is_unique_2(ModuleInfo, Inst, Expansions),
+ inst_list_is_unique_2(Insts, ModuleInfo, Expansions).
+
+:- pred inst_list_is_mostly_unique_2(list(inst), module_info, set(inst)).
+:- mode inst_list_is_mostly_unique_2(in, in, in) is semidet.
+
+inst_list_is_mostly_unique_2([], _, _).
+inst_list_is_mostly_unique_2([Inst | Insts], ModuleInfo, Expansions) :-
+ inst_is_mostly_unique_2(ModuleInfo, Inst, Expansions),
+ inst_list_is_mostly_unique_2(Insts, ModuleInfo, Expansions).
+
+:- pred inst_list_is_not_partly_unique_2(list(inst), module_info, set(inst)).
+:- mode inst_list_is_not_partly_unique_2(in, in, in) is semidet.
+
+inst_list_is_not_partly_unique_2([], _, _).
+inst_list_is_not_partly_unique_2([Inst | Insts], ModuleInfo, Expansions) :-
+ inst_is_not_partly_unique_2(ModuleInfo, Inst, Expansions),
+ inst_list_is_not_partly_unique_2(Insts, ModuleInfo, Expansions).
+
+:- pred inst_list_is_not_fully_unique_2(list(inst), module_info, set(inst)).
+:- mode inst_list_is_not_fully_unique_2(in, in, in) is semidet.
+
+inst_list_is_not_fully_unique_2([], _, _).
+inst_list_is_not_fully_unique_2([Inst | Insts], ModuleInfo, Expansions) :-
+ inst_is_not_fully_unique_2(ModuleInfo, Inst, Expansions),
+ inst_list_is_not_fully_unique_2(Insts, ModuleInfo, Expansions).
+
+%-----------------------------------------------------------------------------%
+
+bound_inst_list_is_free([], _).
+bound_inst_list_is_free([functor(_Name, Args)|BoundInsts], ModuleInfo) :-
+ inst_list_is_free(Args, ModuleInfo),
+ bound_inst_list_is_free(BoundInsts, ModuleInfo).
+
+inst_list_is_free([], _).
+inst_list_is_free([Inst | Insts], ModuleInfo) :-
+ inst_is_free(ModuleInfo, Inst),
+ inst_list_is_free(Insts, ModuleInfo).
%-----------------------------------------------------------------------------%
-:- pred maybe_make_shared_inst_list(list(inst), list(is_live), module_info,
- list(inst), module_info).
-:- mode maybe_make_shared_inst_list(in, in, in, out, out) is det.
-
-maybe_make_shared_inst_list([], [], ModuleInfo, [], ModuleInfo).
-maybe_make_shared_inst_list([Inst0 | Insts0], [IsLive | IsLives], ModuleInfo0,
- [Inst | Insts], ModuleInfo) :-
- ( IsLive = live ->
- make_shared_inst(Inst0, ModuleInfo0, Inst, ModuleInfo1)
- ;
- Inst = Inst0,
- ModuleInfo1 = ModuleInfo0
- ),
- maybe_make_shared_inst_list(Insts0, IsLives, ModuleInfo1,
- Insts, ModuleInfo).
-maybe_make_shared_inst_list([], [_|_], _, _, _) :-
- error("maybe_make_shared_inst_list: length mismatch").
-maybe_make_shared_inst_list([_|_], [], _, _, _) :-
- error("maybe_make_shared_inst_list: length mismatch").
-
-:- pred make_shared_inst_list(list(inst), module_info,
- list(inst), module_info).
-:- mode make_shared_inst_list(in, in, out, out) is det.
-
-make_shared_inst_list([], ModuleInfo, [], ModuleInfo).
-make_shared_inst_list([Inst0 | Insts0], ModuleInfo0,
- [Inst | Insts], ModuleInfo) :-
- make_shared_inst(Inst0, ModuleInfo0, Inst, ModuleInfo1),
- make_shared_inst_list(Insts0, ModuleInfo1, Insts, ModuleInfo).
-
-% make an inst shared; replace all occurrences of `unique' or `mostly_unique'
-% in the inst with `shared'.
-
-:- pred make_shared_inst(inst, module_info, inst, module_info).
-:- mode make_shared_inst(in, in, out, out) is det.
-
-make_shared_inst(not_reached, M, not_reached, M).
-make_shared_inst(any(Uniq0), M, any(Uniq), M) :-
- make_shared(Uniq0, Uniq).
-make_shared_inst(free, M, free, M) :-
- % the caller should ensure that this never happens
- error("make_shared_inst: cannot make shared version of `free'").
-make_shared_inst(free(T), M, free(T), M) :-
- % 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), M0, bound(Uniq, BoundInsts), M) :-
- make_shared(Uniq0, Uniq),
- make_shared_bound_inst_list(BoundInsts0, M0, BoundInsts, M).
-make_shared_inst(ground(Uniq0, PredInst), M, ground(Uniq, PredInst), M) :-
- make_shared(Uniq0, Uniq).
-make_shared_inst(inst_var(_), _, _, _) :-
- error("free inst var").
-make_shared_inst(abstract_inst(_,_), M, _, M) :-
- error("make_shared_inst(abstract_inst)").
-make_shared_inst(defined_inst(InstName), ModuleInfo0, Inst, ModuleInfo) :-
- % check whether the inst name is already in the
- % shared_inst table
- module_info_insts(ModuleInfo0, InstTable0),
- inst_table_get_shared_insts(InstTable0, SharedInsts0),
- (
- map__search(SharedInsts0, InstName, Result)
- ->
- ( Result = known(SharedInst0) ->
- SharedInst = SharedInst0
- ;
- SharedInst = defined_inst(InstName)
- ),
- ModuleInfo = ModuleInfo0
- ;
- % insert the inst name in the shared_inst table, with
- % value `unknown' for the moment
- map__set(SharedInsts0, InstName, unknown, SharedInsts1),
- inst_table_set_shared_insts(InstTable0, SharedInsts1,
- InstTable1),
- module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
-
- % expand the inst name, and invoke ourself recursively on
- % it's expansion
- inst_lookup(ModuleInfo1, InstName, Inst0),
- inst_expand(ModuleInfo1, Inst0, Inst1),
- make_shared_inst(Inst1, ModuleInfo1, SharedInst, ModuleInfo2),
-
- % now that we have determined the resulting Inst, store
- % the appropriate value `known(SharedInst)' in the shared_inst
- % table
- module_info_insts(ModuleInfo2, InstTable2),
- inst_table_get_shared_insts(InstTable2, SharedInsts2),
- map__set(SharedInsts2, InstName, known(SharedInst),
- SharedInsts),
- inst_table_set_shared_insts(InstTable2, SharedInsts,
- InstTable),
- module_info_set_insts(ModuleInfo2, InstTable, ModuleInfo)
- ),
- % avoid expanding recursive insts
- ( inst_contains_instname(SharedInst, ModuleInfo, InstName) ->
- Inst = defined_inst(InstName)
- ;
- Inst = SharedInst
- ).
-
-:- pred make_shared(uniqueness, uniqueness).
-:- mode make_shared(in, out) is det.
-
-make_shared(unique, shared).
-make_shared(mostly_unique, shared).
-make_shared(shared, shared).
-make_shared(mostly_clobbered, mostly_clobbered).
-make_shared(clobbered, clobbered).
-
-:- pred make_shared_bound_inst_list(list(bound_inst), module_info,
- list(bound_inst), module_info).
-:- mode make_shared_bound_inst_list(in, in, out, out) is det.
-
-make_shared_bound_inst_list([], ModuleInfo, [], ModuleInfo).
-make_shared_bound_inst_list([Bound0 | Bounds0], ModuleInfo0,
- [Bound | Bounds], ModuleInfo) :-
- Bound0 = functor(ConsId, ArgInsts0),
- make_shared_inst_list(ArgInsts0, ModuleInfo0,
- ArgInsts, ModuleInfo1),
- Bound = functor(ConsId, ArgInsts),
- make_shared_bound_inst_list(Bounds0, ModuleInfo1,
- Bounds, ModuleInfo).
-
-%-----------------------------------------------------------------------------%
-
-% make an inst mostly-uniq: replace all occurrences of `unique'
-% in the inst with `mostly_unique'. (Used by unique_modes.m to
-% change the insts of semidet-live or nondet-live insts.)
-
-make_mostly_uniq_inst(not_reached, M, not_reached, M).
-make_mostly_uniq_inst(any(Uniq0), M, any(Uniq), M) :-
- make_mostly_uniq(Uniq0, Uniq).
-make_mostly_uniq_inst(free, M, free, M).
-make_mostly_uniq_inst(free(T), M, free(T), M).
-make_mostly_uniq_inst(bound(Uniq0, BoundInsts0), M0, bound(Uniq, BoundInsts),
- M) :-
- % XXX could improve efficiency by avoiding recursion here
- make_mostly_uniq(Uniq0, Uniq),
- make_mostly_uniq_bound_inst_list(BoundInsts0, M0, BoundInsts, M).
-make_mostly_uniq_inst(ground(Uniq0, PredInst), M, ground(Uniq, PredInst), M) :-
- make_mostly_uniq(Uniq0, Uniq).
-make_mostly_uniq_inst(inst_var(_), _, _, _) :-
- error("free inst var").
-make_mostly_uniq_inst(abstract_inst(_,_), M, _, M) :-
- error("make_mostly_uniq_inst(abstract_inst)").
-make_mostly_uniq_inst(defined_inst(InstName), ModuleInfo0, Inst, ModuleInfo) :-
- % check whether the inst name is already in the
- % mostly_uniq_inst table
- module_info_insts(ModuleInfo0, InstTable0),
- inst_table_get_mostly_uniq_insts(InstTable0, NondetLiveInsts0),
- (
- map__search(NondetLiveInsts0, InstName, Result)
- ->
- ( Result = known(NondetLiveInst0) ->
- NondetLiveInst = NondetLiveInst0
- ;
- NondetLiveInst = defined_inst(InstName)
- ),
- ModuleInfo = ModuleInfo0
- ;
- % insert the inst name in the mostly_uniq_inst table, with
- % value `unknown' for the moment
- map__set(NondetLiveInsts0, InstName, unknown, NondetLiveInsts1),
- inst_table_set_mostly_uniq_insts(InstTable0, NondetLiveInsts1,
- InstTable1),
- module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
-
- % expand the inst name, and invoke ourself recursively on
- % it's expansion
- inst_lookup(ModuleInfo1, InstName, Inst0),
- inst_expand(ModuleInfo1, Inst0, Inst1),
- make_mostly_uniq_inst(Inst1, ModuleInfo1, NondetLiveInst,
- ModuleInfo2),
-
- % now that we have determined the resulting Inst, store
- % the appropriate value `known(NondetLiveInst)' in the
- % mostly_uniq_inst table
- module_info_insts(ModuleInfo2, InstTable2),
- inst_table_get_mostly_uniq_insts(InstTable2, NondetLiveInsts2),
- map__set(NondetLiveInsts2, InstName, known(NondetLiveInst),
- NondetLiveInsts),
- inst_table_set_mostly_uniq_insts(InstTable2, NondetLiveInsts,
- InstTable),
- module_info_set_insts(ModuleInfo2, InstTable, ModuleInfo)
- ),
- % avoid expanding recursive insts
- ( inst_contains_instname(NondetLiveInst, ModuleInfo, InstName) ->
- Inst = defined_inst(InstName)
- ;
- Inst = NondetLiveInst
- ).
-
-:- pred make_mostly_uniq(uniqueness, uniqueness).
-:- mode make_mostly_uniq(in, out) is det.
-
-make_mostly_uniq(unique, mostly_unique).
-make_mostly_uniq(mostly_unique, mostly_unique).
-make_mostly_uniq(shared, shared).
-make_mostly_uniq(mostly_clobbered, mostly_clobbered).
-make_mostly_uniq(clobbered, clobbered).
-
-:- pred make_mostly_uniq_bound_inst_list(list(bound_inst), module_info,
- list(bound_inst), module_info).
-:- mode make_mostly_uniq_bound_inst_list(in, in, out, out) is det.
-
-make_mostly_uniq_bound_inst_list([], ModuleInfo, [], ModuleInfo).
-make_mostly_uniq_bound_inst_list([Bound0 | Bounds0], ModuleInfo0,
- [Bound | Bounds], ModuleInfo) :-
- Bound0 = functor(ConsId, ArgInsts0),
- make_mostly_uniq_inst_list(ArgInsts0, ModuleInfo0,
- ArgInsts, ModuleInfo1),
- Bound = functor(ConsId, ArgInsts),
- make_mostly_uniq_bound_inst_list(Bounds0, ModuleInfo1,
- Bounds, ModuleInfo).
-
-:- pred make_mostly_uniq_inst_list(list(inst), module_info,
- list(inst), module_info).
-:- mode make_mostly_uniq_inst_list(in, in, out, out) is det.
-
-make_mostly_uniq_inst_list([], ModuleInfo, [], ModuleInfo).
-make_mostly_uniq_inst_list([Inst0 | Insts0], ModuleInfo0,
- [Inst | Insts], ModuleInfo) :-
- make_mostly_uniq_inst(Inst0, ModuleInfo0, Inst, ModuleInfo1),
- make_mostly_uniq_inst_list(Insts0, ModuleInfo1, Insts, ModuleInfo).
-
-%-----------------------------------------------------------------------------%
-
- % Given a list of insts, and a corresponding list of livenesses,
- % return true iff for every element in the list of insts, either
- % the elemement is ground or the corresponding element in the liveness
- % list is dead.
-
-:- pred inst_list_is_ground_or_dead(list(inst), list(is_live), module_info).
-:- mode inst_list_is_ground_or_dead(in, in, in) is semidet.
-
inst_list_is_ground_or_dead([], [], _).
inst_list_is_ground_or_dead([Inst | Insts], [Live | Lives], ModuleInfo) :-
( Live = live ->
@@ -1730,15 +1167,6 @@
),
inst_list_is_ground_or_dead(Insts, Lives, ModuleInfo).
- % Given a list of insts, and a corresponding list of livenesses,
- % return true iff for every element in the list of insts, either
- % the elemement is ground or any, or the corresponding element
- % in the liveness list is dead.
-
-:- pred inst_list_is_ground_or_any_or_dead(list(inst), list(is_live),
- module_info).
-:- mode inst_list_is_ground_or_any_or_dead(in, in, in) is semidet.
-
inst_list_is_ground_or_any_or_dead([], [], _).
inst_list_is_ground_or_any_or_dead([Inst | Insts], [Live | Lives],
ModuleInfo) :-
@@ -1750,99 +1178,8 @@
inst_list_is_ground_or_any_or_dead(Insts, Lives, ModuleInfo).
%-----------------------------------------------------------------------------%
-
- % This code performs abstract unification of two bound(...) insts.
- % like a sorted merge operation. If two elements have the
- % The lists of bound_inst are guaranteed to be sorted.
- % Abstract unification of two bound(...) insts proceeds
- % like a sorted merge operation. If two elements have the
- % same functor name, they are inserted in the output list,
- % assuming their argument inst list can be abstractly unified.
- % (If it can't, the whole thing fails). If a functor name
- % occurs in only one of the two input lists, it is not inserted
- % in the output list.
-
-:- pred abstractly_unify_bound_inst_list(is_live, list(bound_inst),
- list(bound_inst), unify_is_real, module_info,
- list(bound_inst), determinism, module_info).
-:- mode abstractly_unify_bound_inst_list(in, in, in, in, in,
- out, out, out) is semidet.
-
-:- abstractly_unify_bound_inst_list(_, Xs, Ys, _, _, _, _, _)
- when Xs and Ys. % Index
-
-abstractly_unify_bound_inst_list(_, [], [], _, ModuleInfo, [], det, ModuleInfo).
-abstractly_unify_bound_inst_list(_, [], [_|_], _, M, [], semidet, M).
-abstractly_unify_bound_inst_list(_, [_|_], [], _, M, [], semidet, M).
-abstractly_unify_bound_inst_list(Live, [X|Xs], [Y|Ys], Real, ModuleInfo0,
- L, Det, ModuleInfo) :-
- X = functor(ConsIdX, ArgsX),
- Y = functor(ConsIdY, ArgsY),
- ( ConsIdX = ConsIdY ->
- abstractly_unify_inst_list(ArgsX, ArgsY, Live, Real,
- ModuleInfo0, Args, Det1, ModuleInfo1),
- L = [functor(ConsIdX, Args) | L1],
- abstractly_unify_bound_inst_list(Live, Xs, Ys, Real,
- ModuleInfo1, L1, Det2, ModuleInfo),
- ( Det1 = semidet ->
- Det = semidet
- ;
- Det = Det2
- )
- ;
- Det = semidet,
- ( compare(<, ConsIdX, ConsIdY) ->
- abstractly_unify_bound_inst_list(Live, Xs, [Y|Ys],
- Real, ModuleInfo0, L, _, ModuleInfo)
- ;
- abstractly_unify_bound_inst_list(Live, [X|Xs], Ys,
- Real, ModuleInfo0, L, _, ModuleInfo)
- )
- ).
-
-:- pred abstractly_unify_bound_inst_list_lives(list(bound_inst), cons_id,
- list(inst), list(is_live), unify_is_real, module_info,
- list(bound_inst), module_info).
-:- mode abstractly_unify_bound_inst_list_lives(in, in, in, in, in, in, out, out)
- is semidet.
-
-abstractly_unify_bound_inst_list_lives([], _, _, _, _, ModuleInfo,
- [], ModuleInfo).
-abstractly_unify_bound_inst_list_lives([X|Xs], ConsIdY, ArgsY, LivesY, Real,
- ModuleInfo0, L, ModuleInfo) :-
- X = functor(ConsIdX, ArgsX),
- (
- ConsIdX = ConsIdY
- ->
- abstractly_unify_inst_list_lives(ArgsX, ArgsY, LivesY, Real,
- ModuleInfo0, Args, ModuleInfo),
- L = [functor(ConsIdX, Args)]
- ;
- abstractly_unify_bound_inst_list_lives(Xs, ConsIdY, ArgsY,
- LivesY, Real, ModuleInfo0, L, ModuleInfo)
- ).
-
-:- pred abstractly_unify_inst_list_lives(list(inst), list(inst), list(is_live),
- unify_is_real, module_info, list(inst), module_info).
-:- mode abstractly_unify_inst_list_lives(in, in, in, in, in, out, out)
- is semidet.
-
-abstractly_unify_inst_list_lives([], [], [], _, ModuleInfo, [], ModuleInfo).
-abstractly_unify_inst_list_lives([X|Xs], [Y|Ys], [Live|Lives], Real,
- ModuleInfo0, [Z|Zs], ModuleInfo) :-
- abstractly_unify_inst(Live, X, Y, Real, ModuleInfo0,
- Z, _Det, ModuleInfo1),
- abstractly_unify_inst_list_lives(Xs, Ys, Lives, Real, ModuleInfo1,
- Zs, ModuleInfo).
-
%-----------------------------------------------------------------------------%
- % Succeed iff the specified inst contains (directly or indirectly)
- % the specified inst_name.
-
-:- pred inst_contains_instname(inst, module_info, inst_name).
-:- mode inst_contains_instname(in, in, in) is semidet.
-
inst_contains_instname(Inst, ModuleInfo, InstName) :-
set__init(Expansions),
inst_contains_instname_2(Inst, ModuleInfo, Expansions, InstName).
@@ -1893,4 +1230,5 @@
InstName)
).
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: instmap.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/instmap.m,v
retrieving revision 1.11
diff -u -r1.11 instmap.m
--- instmap.m 1997/06/29 23:10:47 1.11
+++ instmap.m 1997/07/09 04:54:10
@@ -18,7 +18,7 @@
:- module instmap.
:- interface.
-:- import_module hlds_module, prog_data, mode_info.
+:- import_module hlds_module, prog_data, mode_info, (inst).
:- import_module set, term.
:- type instmap.
@@ -112,8 +112,8 @@
% Given an instmap_delta and a variable, determine the inst
% of that variable.
%
-:- pred instmap_delta_lookup_var(instmap_delta, var, inst).
-:- mode instmap_delta_lookup_var(in, in, out) is det.
+:- pred instmap_delta_search_var(instmap_delta, var, inst).
+:- mode instmap_delta_search_var(in, in, out) is semidet.
% Given an instmap and a list of variables, return a list
% containing the insts of those variable.
@@ -249,7 +249,7 @@
:- implementation.
:- import_module mode_util, inst_match, prog_data, mode_errors, goal_util.
-:- import_module hlds_data.
+:- import_module hlds_data, inst_util.
:- import_module list, std_util, bool, map, set, assoc_list, require.
:- type instmap_delta == instmap.
@@ -344,9 +344,6 @@
instmap__lookup_var(reachable(InstMap), Var, Inst) :-
instmapping_lookup_var(InstMap, Var, Inst).
-instmap_delta_lookup_var(InstmapDelta, Var, Inst) :-
- instmap__lookup_var(InstmapDelta, Var, Inst).
-
:- pred instmapping_lookup_var(instmapping, var, inst).
:- mode instmapping_lookup_var(in, in, out) is det.
@@ -356,6 +353,9 @@
;
Inst = free
).
+
+instmap_delta_search_var(reachable(InstMap), Var, Inst) :-
+ map__search(InstMap, Var, Inst).
instmap__lookup_vars([], _InstMap, []).
instmap__lookup_vars([Arg|Args], InstMap, [Inst|Insts]) :-
Index: intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.27
diff -u -r1.27 intermod.m
--- intermod.m 1997/06/29 23:10:49 1.27
+++ intermod.m 1997/07/08 02:43:40
@@ -67,7 +67,7 @@
:- import_module hlds_data, hlds_goal, hlds_pred, hlds_out, inlining, llds.
:- import_module mercury_to_mercury, mode_util, modules.
:- import_module options, passes_aux, prog_data, prog_io, prog_out, prog_util.
-:- import_module special_pred, typecheck, type_util.
+:- import_module special_pred, typecheck, type_util, instmap, (inst).
%-----------------------------------------------------------------------------%
Index: liveness.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/liveness.m,v
retrieving revision 1.76
diff -u -r1.76 liveness.m
--- liveness.m 1997/07/03 07:17:53 1.76
+++ liveness.m 1997/07/08 02:43:41
@@ -113,7 +113,7 @@
:- implementation.
-:- import_module hlds_goal, hlds_data, llds, quantification, instmap.
+:- import_module hlds_goal, hlds_data, llds, quantification, (inst), instmap.
:- import_module hlds_out, mode_util, code_util.
:- import_module prog_data, globals, passes_aux.
:- import_module bool, list, map, set, std_util, term, assoc_list, require.
@@ -973,8 +973,10 @@
live_info_get_var_types(LiveInfo, VarTypes),
live_info_get_module_info(LiveInfo, ModuleInfo),
map__lookup(VarTypes, Var, Type),
- instmap_delta_lookup_var(InstMapDelta, Var, Inst),
- ( mode_to_arg_mode(ModuleInfo, (free -> Inst), Type, top_out) ->
+ (
+ instmap_delta_search_var(InstMapDelta, Var, Inst),
+ mode_to_arg_mode(ModuleInfo, (free -> Inst), Type, top_out)
+ ->
set__insert(ValueVars0, Var, ValueVars1)
;
ValueVars1 = ValueVars0
Index: llds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds.m,v
retrieving revision 1.206
diff -u -r1.206 llds.m
--- llds.m 1997/06/29 23:10:51 1.206
+++ llds.m 1997/07/09 02:42:01
@@ -16,7 +16,7 @@
:- interface.
-:- import_module hlds_pred, tree, prog_data.
+:- import_module hlds_pred, tree, prog_data, (inst).
:- import_module assoc_list, bool, list, set, term, std_util.
%-----------------------------------------------------------------------------%
Index: make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.234
diff -u -r1.234 make_hlds.m
--- make_hlds.m 1997/06/29 23:10:57 1.234
+++ make_hlds.m 1997/07/08 02:43:44
@@ -58,7 +58,7 @@
:- import_module prog_io, prog_io_goal, prog_io_util, prog_out, hlds_out.
:- import_module module_qual, prog_util, globals, options.
-:- import_module make_tags, quantification.
+:- import_module make_tags, quantification, (inst).
:- import_module code_util, unify_proc, special_pred, type_util, mode_util.
:- import_module mercury_to_mercury, passes_aux, clause_to_proc, inst_match.
:- import_module fact_table.
Index: mercury_to_mercury.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.108
diff -u -r1.108 mercury_to_mercury.m
--- mercury_to_mercury.m 1997/06/29 23:11:01 1.108
+++ mercury_to_mercury.m 1997/07/08 02:43:45
@@ -14,7 +14,7 @@
:- module mercury_to_mercury.
:- interface.
-:- import_module hlds_goal, hlds_data, hlds_pred, prog_data.
+:- import_module hlds_goal, hlds_data, hlds_pred, prog_data, (inst).
:- import_module list, io, varset, term.
% convert_to_mercury(ProgName, OutputFileName, Items)
@@ -155,7 +155,7 @@
:- implementation.
-:- import_module prog_out, prog_util, hlds_pred, hlds_out.
+:- import_module prog_out, prog_util, hlds_pred, hlds_out, instmap.
:- import_module globals, options.
:- import_module bool, int, string, set, term_io, lexer, std_util, require.
Index: mode_debug.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_debug.m,v
retrieving revision 1.7
diff -u -r1.7 mode_debug.m
--- mode_debug.m 1997/06/29 23:11:03 1.7
+++ mode_debug.m 1997/07/09 02:42:13
@@ -36,7 +36,7 @@
:- import_module globals, std_util, list, assoc_list, io, bool, map.
:- import_module term, varset.
:- import_module modes, options, mercury_to_mercury, passes_aux.
-:- import_module hlds_goal, instmap, prog_data.
+:- import_module hlds_goal, instmap, prog_data, (inst).
%-----------------------------------------------------------------------------%
Index: mode_errors.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_errors.m,v
retrieving revision 1.45
diff -u -r1.45 mode_errors.m
--- mode_errors.m 1997/06/29 23:11:05 1.45
+++ mode_errors.m 1997/07/09 02:43:32
@@ -17,7 +17,7 @@
:- interface.
-:- import_module hlds_data, prog_data, mode_info.
+:- import_module hlds_data, prog_data, mode_info, (inst).
:- import_module set, assoc_list.
%-----------------------------------------------------------------------------%
Index: mode_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_info.m,v
retrieving revision 1.37
diff -u -r1.37 mode_info.m
--- mode_info.m 1997/06/29 23:11:06 1.37
+++ mode_info.m 1997/07/09 02:43:47
@@ -17,7 +17,7 @@
:- interface.
:- import_module hlds_module, hlds_pred, hlds_goal, hlds_data, instmap.
-:- import_module mode_errors, delay_info.
+:- import_module mode_errors, delay_info, (inst).
:- import_module map, list, varset, set, bool, term, assoc_list.
:- interface.
Index: mode_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_util.m,v
retrieving revision 1.94
diff -u -r1.94 mode_util.m
--- mode_util.m 1997/06/16 08:58:01 1.94
+++ mode_util.m 1997/07/09 04:54:12
@@ -15,7 +15,7 @@
:- interface.
:- import_module hlds_module, hlds_pred, hlds_goal, hlds_data, prog_data.
-:- import_module instmap.
+:- import_module (inst), instmap.
:- import_module bool, list.
% mode_get_insts returns the initial instantiatedness and
@@ -63,100 +63,12 @@
:- pred mode_to_arg_mode(module_info, mode, type, arg_mode).
:- mode mode_to_arg_mode(in, in, in, out) is det.
-/*
-** Predicates to test various properties of insts.
-** Note that `not_reached' insts are considered to satisfy
-** all of these predicates except inst_is_clobbered.
-*/
-
- % succeed if the inst is fully ground (i.e. contains only
- % `ground', `bound', and `not_reached' insts, with no `free'
- % or `any' insts).
-:- pred inst_is_ground(module_info, inst).
-:- mode inst_is_ground(in, in) is semidet.
-
- % succeed if the inst is not partly free (i.e. contains only
- % `any', `ground', `bound', and `not_reached' insts, with no
- % `free' insts).
-:- pred inst_is_ground_or_any(module_info, inst).
-:- mode inst_is_ground_or_any(in, in) is semidet.
-
- % succeed if the inst is `mostly_unique' or `unique'
-:- pred inst_is_mostly_unique(module_info, inst).
-:- mode inst_is_mostly_unique(in, in) is semidet.
-
- % succeed if the inst is `unique'
-:- pred inst_is_unique(module_info, inst).
-:- mode inst_is_unique(in, in) is semidet.
-
- % succeed if the inst is not `mostly_unique' or `unique'
-:- pred inst_is_not_partly_unique(module_info, inst).
-:- mode inst_is_not_partly_unique(in, in) is semidet.
-
- % succeed if the inst is not `unique'
-:- pred inst_is_not_fully_unique(module_info, inst).
-:- mode inst_is_not_fully_unique(in, in) is semidet.
-
-:- pred inst_is_clobbered(module_info, inst).
-:- mode inst_is_clobbered(in, in) is semidet.
-
-:- pred inst_list_is_ground(list(inst), module_info).
-:- mode inst_list_is_ground(in, in) is semidet.
-
-:- pred inst_list_is_ground_or_any(list(inst), module_info).
-:- mode inst_list_is_ground_or_any(in, in) is semidet.
-
-:- pred inst_list_is_unique(list(inst), module_info).
-:- mode inst_list_is_unique(in, in) is semidet.
-
-:- pred inst_list_is_mostly_unique(list(inst), module_info).
-:- mode inst_list_is_mostly_unique(in, in) is semidet.
-
-:- pred inst_list_is_not_partly_unique(list(inst), module_info).
-:- mode inst_list_is_not_partly_unique(in, in) is semidet.
-
-:- pred inst_list_is_not_fully_unique(list(inst), module_info).
-:- mode inst_list_is_not_fully_unique(in, in) is semidet.
-
-:- pred bound_inst_list_is_ground(list(bound_inst), module_info).
-:- mode bound_inst_list_is_ground(in, in) is semidet.
-
-:- pred bound_inst_list_is_ground_or_any(list(bound_inst), module_info).
-:- mode bound_inst_list_is_ground_or_any(in, in) is semidet.
-
-:- pred bound_inst_list_is_unique(list(bound_inst), module_info).
-:- mode bound_inst_list_is_unique(in, in) is semidet.
-
-:- pred bound_inst_list_is_mostly_unique(list(bound_inst), module_info).
-:- mode bound_inst_list_is_mostly_unique(in, in) is semidet.
-
-:- pred bound_inst_list_is_not_partly_unique(list(bound_inst), module_info).
-:- mode bound_inst_list_is_not_partly_unique(in, in) is semidet.
-
-:- pred bound_inst_list_is_not_fully_unique(list(bound_inst), module_info).
-:- mode bound_inst_list_is_not_fully_unique(in, in) is semidet.
-
% Given an expanded inst and a cons_id and its arity, return the
% insts of the arguments of the top level functor, failing if the
% inst could not be bound to the functor.
:- pred get_arg_insts(inst, cons_id, arity, list(inst)).
:- mode get_arg_insts(in, in, in, out) is semidet.
-:- pred inst_is_free(module_info, inst).
-:- mode inst_is_free(in, in) is semidet.
-
-:- pred inst_list_is_free(list(inst), module_info).
-:- mode inst_list_is_free(in, in) is semidet.
-
-:- pred bound_inst_list_is_free(list(bound_inst), module_info).
-:- mode bound_inst_list_is_free(in, in) is semidet.
-
-:- pred inst_is_bound(module_info, inst).
-:- mode inst_is_bound(in, in) is semidet.
-
-:- pred inst_is_bound_to_functors(module_info, inst, list(bound_inst)).
-:- mode inst_is_bound_to_functors(in, in, out) is semidet.
-
% Given a list of bound_insts, get the corresponding list of cons_ids
%
:- pred functors_to_cons_ids(list(bound_inst), list(cons_id)).
@@ -257,7 +169,7 @@
:- implementation.
:- import_module require, int, map, set, term, std_util, assoc_list.
:- import_module prog_util, type_util.
-:- import_module inst_match.
+:- import_module inst_match, inst_util.
%-----------------------------------------------------------------------------%
@@ -456,71 +368,6 @@
%-----------------------------------------------------------------------------%
- % inst_is_clobbered succeeds iff the inst passed is `clobbered'
- % or `mostly_clobbered' or if it is a user-defined inst which
- % is defined as one of those.
-
-:- inst_is_clobbered(_, X) when X. % NU-Prolog indexing.
-
-inst_is_clobbered(_, not_reached) :- fail.
-inst_is_clobbered(_, any(mostly_clobbered)).
-inst_is_clobbered(_, any(clobbered)).
-inst_is_clobbered(_, ground(clobbered, _)).
-inst_is_clobbered(_, ground(mostly_clobbered, _)).
-inst_is_clobbered(_, bound(clobbered, _)).
-inst_is_clobbered(_, bound(mostly_clobbered, _)).
-inst_is_clobbered(_, inst_var(_)) :-
- error("internal error: uninstantiated inst parameter").
-inst_is_clobbered(ModuleInfo, defined_inst(InstName)) :-
- inst_lookup(ModuleInfo, InstName, Inst),
- inst_is_clobbered(ModuleInfo, Inst).
-
- % inst_is_free succeeds iff the inst passed is `free'
- % or is a user-defined inst which is defined as `free'.
- % Abstract insts must not be free.
-
-:- inst_is_free(_, X) when X. % NU-Prolog indexing.
-
-inst_is_free(_, free).
-inst_is_free(_, free(_Type)).
-inst_is_free(_, inst_var(_)) :-
- error("internal error: uninstantiated inst parameter").
-inst_is_free(ModuleInfo, defined_inst(InstName)) :-
- inst_lookup(ModuleInfo, InstName, Inst),
- inst_is_free(ModuleInfo, Inst).
-
- % 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.
-
-:- inst_is_bound(_, X) when X. % NU-Prolog indexing.
-
-inst_is_bound(_, any(_)).
-inst_is_bound(_, ground(_, _)).
-inst_is_bound(_, bound(_, _)).
-inst_is_bound(_, inst_var(_)) :-
- error("internal error: uninstantiated inst parameter").
-inst_is_bound(ModuleInfo, defined_inst(InstName)) :-
- inst_lookup(ModuleInfo, InstName, Inst),
- inst_is_bound(ModuleInfo, Inst).
-inst_is_bound(_, abstract_inst(_, _)).
-
- % inst_is_bound_to_functors succeeds iff the inst passed is
- % `bound(_Uniq, Functors)' or is a user-defined inst which expands to
- % `bound(_Uniq, Functors)'.
-
-:- inst_is_bound_to_functors(_, X, _) when X. % NU-Prolog indexing.
-
-inst_is_bound_to_functors(_, bound(_Uniq, Functors), Functors).
-inst_is_bound_to_functors(_, inst_var(_), _) :-
- error("internal error: uninstantiated inst parameter").
-inst_is_bound_to_functors(ModuleInfo, defined_inst(InstName), Functors)
- :-
- inst_lookup(ModuleInfo, InstName, Inst),
- inst_is_bound_to_functors(ModuleInfo, Inst, Functors).
-
-%-----------------------------------------------------------------------------%
-
functors_to_cons_ids([], []).
functors_to_cons_ids([Functor | Functors], [ConsId | ConsIds]) :-
Functor = functor(ConsId, _ArgInsts),
@@ -560,417 +407,6 @@
%-----------------------------------------------------------------------------%
- % inst_is_ground succeeds iff the inst passed is `ground'
- % or the equivalent. Abstract insts are not considered ground.
-
-inst_is_ground(ModuleInfo, Inst) :-
- set__init(Expansions),
- inst_is_ground_2(ModuleInfo, Inst, Inst, Expansions).
-
- % The third argument must be the same as the second.
- % The fourth arg is the set of insts which have already
- % been expanded - we use this to avoid going into an
- % infinite loop.
-
-:- pred inst_is_ground_2(module_info, inst, inst, set(inst)).
-:- mode inst_is_ground_2(in, in, in, in) is semidet.
-
-:- inst_is_ground_2(_, X, _, _) when X. % NU-Prolog indexing.
-
-inst_is_ground_2(_, not_reached, _, _).
-inst_is_ground_2(ModuleInfo, bound(_, List), _, Expansions) :-
- bound_inst_list_is_ground_2(List, ModuleInfo, Expansions).
-inst_is_ground_2(_, ground(_, _), _, _).
-inst_is_ground_2(_, inst_var(_), _, _) :-
- error("internal error: uninstantiated inst parameter").
-inst_is_ground_2(ModuleInfo, defined_inst(InstName), Inst, Expansions) :-
- ( set__member(Inst, Expansions) ->
- true
- ;
- set__insert(Expansions, Inst, Expansions2),
- inst_lookup(ModuleInfo, InstName, Inst2),
- inst_is_ground_2(ModuleInfo, Inst2, Inst2, Expansions2)
- ).
-
- % inst_is_ground_or_any succeeds iff the inst passed is `ground',
- % `any', or the equivalent. Fails for abstract insts.
-
-inst_is_ground_or_any(ModuleInfo, Inst) :-
- set__init(Expansions),
- inst_is_ground_or_any_2(ModuleInfo, Inst, Inst, Expansions).
-
- % The third argument must be the same as the second.
- % The fourth arg is the set of insts which have already
- % been expanded - we use this to avoid going into an
- % infinite loop.
-
-:- pred inst_is_ground_or_any_2(module_info, inst, inst, set(inst)).
-:- mode inst_is_ground_or_any_2(in, in, in, in) is semidet.
-
-:- inst_is_ground_or_any_2(_, X, _, _) when X. % NU-Prolog indexing.
-
-inst_is_ground_or_any_2(_, not_reached, _, _).
-inst_is_ground_or_any_2(ModuleInfo, bound(_, List), _, Expansions) :-
- bound_inst_list_is_ground_or_any_2(List, ModuleInfo, Expansions).
-inst_is_ground_or_any_2(_, ground(_, _), _, _).
-inst_is_ground_or_any_2(_, any(_), _, _).
-inst_is_ground_or_any_2(_, inst_var(_), _, _) :-
- error("internal error: uninstantiated inst parameter").
-inst_is_ground_or_any_2(ModuleInfo, defined_inst(InstName), Inst, Expansions) :-
- ( set__member(Inst, Expansions) ->
- true
- ;
- set__insert(Expansions, Inst, Expansions2),
- inst_lookup(ModuleInfo, InstName, Inst2),
- inst_is_ground_or_any_2(ModuleInfo, Inst2, Inst2, Expansions2)
- ).
-
- % inst_is_unique succeeds iff the inst passed is unique
- % or free. Abstract insts are not considered unique.
-
-inst_is_unique(ModuleInfo, Inst) :-
- set__init(Expansions),
- inst_is_unique_2(ModuleInfo, Inst, Inst, Expansions).
-
- % The third argument must be the same as the second.
- % The fourth arg is the set of insts which have already
- % been expanded - we use this to avoid going into an
- % infinite loop.
-
-:- pred inst_is_unique_2(module_info, inst, inst, set(inst)).
-:- mode inst_is_unique_2(in, in, in, in) is semidet.
-
-:- inst_is_unique_2(_, X, _, _) when X. % NU-Prolog indexing.
-
-inst_is_unique_2(_, not_reached, _, _).
-inst_is_unique_2(ModuleInfo, bound(unique, List), _, Expansions) :-
- bound_inst_list_is_unique_2(List, ModuleInfo, Expansions).
-inst_is_unique_2(_, any(unique), _, _).
-inst_is_unique_2(_, free, _, _).
-inst_is_unique_2(_, ground(unique, _), _, _).
-inst_is_unique_2(_, inst_var(_), _, _) :-
- error("internal error: uninstantiated inst parameter").
-inst_is_unique_2(ModuleInfo, defined_inst(InstName), Inst, Expansions) :-
- ( set__member(Inst, Expansions) ->
- true
- ;
- set__insert(Expansions, Inst, Expansions2),
- inst_lookup(ModuleInfo, InstName, Inst2),
- inst_is_unique_2(ModuleInfo, Inst2, Inst2, Expansions2)
- ).
-
- % inst_is_mostly_unique succeeds iff the inst passed is unique,
- % mostly_unique, or free. Abstract insts are not considered unique.
-
-inst_is_mostly_unique(ModuleInfo, Inst) :-
- set__init(Expansions),
- inst_is_mostly_unique_2(ModuleInfo, Inst, Inst, Expansions).
-
- % The third argument must be the same as the second.
- % The fourth arg is the set of insts which have already
- % been expanded - we use this to avoid going into an
- % infinite loop.
-
-:- pred inst_is_mostly_unique_2(module_info, inst, inst, set(inst)).
-:- mode inst_is_mostly_unique_2(in, in, in, in) is semidet.
-
-:- inst_is_mostly_unique_2(_, X, _, _) when X. % NU-Prolog indexing.
-
-inst_is_mostly_unique_2(_, not_reached, _, _).
-inst_is_mostly_unique_2(ModuleInfo, bound(mostly_unique, List), _, Expansions)
- :-
- bound_inst_list_is_mostly_unique_2(List, ModuleInfo, Expansions).
-inst_is_mostly_unique_2(ModuleInfo, bound(mostly_unique, List), _, Expansions)
- :-
- bound_inst_list_is_mostly_unique_2(List, 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(_, ground(unique, _), _, _).
-inst_is_mostly_unique_2(_, ground(mostly_unique, _), _, _).
-inst_is_mostly_unique_2(_, inst_var(_), _, _) :-
- error("internal error: uninstantiated inst parameter").
-inst_is_mostly_unique_2(ModuleInfo, defined_inst(InstName), Inst, Expansions) :-
- ( set__member(Inst, Expansions) ->
- true
- ;
- set__insert(Expansions, Inst, Expansions2),
- inst_lookup(ModuleInfo, InstName, Inst2),
- inst_is_mostly_unique_2(ModuleInfo, Inst2, Inst2, Expansions2)
- ).
-
- % inst_is_not_partly_unique succeeds iff the inst passed is
- % not unique or mostly_unique, i.e. if it is shared
- % or free. It fails for abstract insts.
-
-inst_is_not_partly_unique(ModuleInfo, Inst) :-
- set__init(Expansions),
- inst_is_not_partly_unique_2(ModuleInfo, Inst, Inst, Expansions).
-
- % The third argument must be the same as the second.
- % The fourth arg is the set of insts which have already
- % been expanded - we use this to avoid going into an
- % infinite loop.
-
-:- pred inst_is_not_partly_unique_2(module_info, inst, inst, set(inst)).
-:- mode inst_is_not_partly_unique_2(in, in, in, in) is semidet.
-
-:- inst_is_not_partly_unique_2(_, X, _, _) when X. % NU-Prolog indexing.
-
-inst_is_not_partly_unique_2(_, not_reached, _, _).
-inst_is_not_partly_unique_2(ModuleInfo, bound(shared, List), _, Expansions) :-
- bound_inst_list_is_not_partly_unique_2(List, ModuleInfo, Expansions).
-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(_), _, _) :-
- error("internal error: uninstantiated inst parameter").
-inst_is_not_partly_unique_2(ModuleInfo, defined_inst(InstName), Inst,
- Expansions) :-
- ( set__member(Inst, Expansions) ->
- true
- ;
- set__insert(Expansions, Inst, Expansions2),
- inst_lookup(ModuleInfo, InstName, Inst2),
- inst_is_not_partly_unique_2(ModuleInfo, Inst2, Inst2,
- Expansions2)
- ).
-
- % inst_is_not_fully_unique succeeds iff the inst passed is
- % not unique, i.e. if it is mostly_unique, shared,
- % or free. It fails for abstract insts.
-
-inst_is_not_fully_unique(ModuleInfo, Inst) :-
- set__init(Expansions),
- inst_is_not_fully_unique_2(ModuleInfo, Inst, Inst, Expansions).
-
- % The third argument must be the same as the second.
- % The fourth arg is the set of insts which have already
- % been expanded - we use this to avoid going into an
- % infinite loop.
-
-:- pred inst_is_not_fully_unique_2(module_info, inst, inst, set(inst)).
-:- mode inst_is_not_fully_unique_2(in, in, in, in) is semidet.
-
-:- inst_is_not_fully_unique_2(_, X, _, _) when X. % NU-Prolog indexing.
-
-inst_is_not_fully_unique_2(_, not_reached, _, _).
-inst_is_not_fully_unique_2(ModuleInfo, bound(shared, List), _, Expansions) :-
- bound_inst_list_is_not_fully_unique_2(List, ModuleInfo, Expansions).
-inst_is_not_fully_unique_2(ModuleInfo, bound(mostly_unique, List), _,
- Expansions) :-
- bound_inst_list_is_not_fully_unique_2(List, 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(_, ground(shared, _), _, _).
-inst_is_not_fully_unique_2(_, ground(mostly_unique, _), _, _).
-inst_is_not_fully_unique_2(_, inst_var(_), _, _) :-
- error("internal error: uninstantiated inst parameter").
-inst_is_not_fully_unique_2(ModuleInfo, defined_inst(InstName), Inst,
- Expansions) :-
- ( set__member(Inst, Expansions) ->
- true
- ;
- set__insert(Expansions, Inst, Expansions2),
- inst_lookup(ModuleInfo, InstName, Inst2),
- inst_is_not_fully_unique_2(ModuleInfo, Inst2, Inst2,
- Expansions2)
- ).
-
-%-----------------------------------------------------------------------------%
-
-bound_inst_list_is_ground([], _).
-bound_inst_list_is_ground([functor(_Name, Args)|BoundInsts], ModuleInfo) :-
- inst_list_is_ground(Args, ModuleInfo),
- bound_inst_list_is_ground(BoundInsts, ModuleInfo).
-
-bound_inst_list_is_ground_or_any([], _).
-bound_inst_list_is_ground_or_any([functor(_Name, Args)|BoundInsts],
- ModuleInfo) :-
- inst_list_is_ground_or_any(Args, ModuleInfo),
- bound_inst_list_is_ground_or_any(BoundInsts, ModuleInfo).
-
-bound_inst_list_is_unique([], _).
-bound_inst_list_is_unique([functor(_Name, Args)|BoundInsts], ModuleInfo) :-
- inst_list_is_unique(Args, ModuleInfo),
- bound_inst_list_is_unique(BoundInsts, ModuleInfo).
-
-bound_inst_list_is_mostly_unique([], _).
-bound_inst_list_is_mostly_unique([functor(_Name, Args)|BoundInsts],
- ModuleInfo) :-
- inst_list_is_mostly_unique(Args, ModuleInfo),
- bound_inst_list_is_mostly_unique(BoundInsts, ModuleInfo).
-
-bound_inst_list_is_not_partly_unique([], _).
-bound_inst_list_is_not_partly_unique([functor(_Name, Args)|BoundInsts],
- ModuleInfo) :-
- inst_list_is_not_partly_unique(Args, ModuleInfo),
- bound_inst_list_is_not_partly_unique(BoundInsts, ModuleInfo).
-
-bound_inst_list_is_not_fully_unique([], _).
-bound_inst_list_is_not_fully_unique([functor(_Name, Args)|BoundInsts],
- ModuleInfo) :-
- inst_list_is_not_fully_unique(Args, ModuleInfo),
- bound_inst_list_is_not_fully_unique(BoundInsts, ModuleInfo).
-
-%-----------------------------------------------------------------------------%
-
-:- pred bound_inst_list_is_ground_2(list(bound_inst), module_info, set(inst)).
-:- mode bound_inst_list_is_ground_2(in, in, in) is semidet.
-
-bound_inst_list_is_ground_2([], _, _).
-bound_inst_list_is_ground_2([functor(_Name, Args)|BoundInsts], ModuleInfo,
- Expansions) :-
- inst_list_is_ground_2(Args, ModuleInfo, Expansions),
- bound_inst_list_is_ground_2(BoundInsts, ModuleInfo, Expansions).
-
-:- pred bound_inst_list_is_ground_or_any_2(list(bound_inst), module_info, set(inst)).
-:- mode bound_inst_list_is_ground_or_any_2(in, in, in) is semidet.
-
-bound_inst_list_is_ground_or_any_2([], _, _).
-bound_inst_list_is_ground_or_any_2([functor(_Name, Args)|BoundInsts],
- ModuleInfo, Expansions) :-
- inst_list_is_ground_or_any_2(Args, ModuleInfo, Expansions),
- bound_inst_list_is_ground_or_any_2(BoundInsts, ModuleInfo, Expansions).
-
-:- pred bound_inst_list_is_unique_2(list(bound_inst), module_info, set(inst)).
-:- mode bound_inst_list_is_unique_2(in, in, in) is semidet.
-
-bound_inst_list_is_unique_2([], _, _).
-bound_inst_list_is_unique_2([functor(_Name, Args)|BoundInsts], ModuleInfo,
- Expansions) :-
- inst_list_is_unique_2(Args, ModuleInfo, Expansions),
- bound_inst_list_is_unique_2(BoundInsts, ModuleInfo, Expansions).
-
-:- pred bound_inst_list_is_mostly_unique_2(list(bound_inst), module_info,
- set(inst)).
-:- mode bound_inst_list_is_mostly_unique_2(in, in, in) is semidet.
-
-bound_inst_list_is_mostly_unique_2([], _, _).
-bound_inst_list_is_mostly_unique_2([functor(_Name, Args)|BoundInsts],
- ModuleInfo, Expansions) :-
- inst_list_is_mostly_unique_2(Args, ModuleInfo, Expansions),
- bound_inst_list_is_mostly_unique_2(BoundInsts, ModuleInfo, Expansions).
-
-:- pred bound_inst_list_is_not_partly_unique_2(list(bound_inst), module_info,
- set(inst)).
-:- mode bound_inst_list_is_not_partly_unique_2(in, in, in) is semidet.
-
-bound_inst_list_is_not_partly_unique_2([], _, _).
-bound_inst_list_is_not_partly_unique_2([functor(_Name, Args)|BoundInsts],
- ModuleInfo, Expansions) :-
- inst_list_is_not_partly_unique_2(Args, ModuleInfo, Expansions),
- bound_inst_list_is_not_partly_unique_2(BoundInsts, ModuleInfo,
- Expansions).
-
-:- pred bound_inst_list_is_not_fully_unique_2(list(bound_inst), module_info,
- set(inst)).
-:- mode bound_inst_list_is_not_fully_unique_2(in, in, in) is semidet.
-
-bound_inst_list_is_not_fully_unique_2([], _, _).
-bound_inst_list_is_not_fully_unique_2([functor(_Name, Args)|BoundInsts],
- ModuleInfo, Expansions) :-
- inst_list_is_not_fully_unique_2(Args, ModuleInfo, Expansions),
- bound_inst_list_is_not_fully_unique_2(BoundInsts, ModuleInfo,
- Expansions).
-
-%-----------------------------------------------------------------------------%
-
-inst_list_is_ground([], _).
-inst_list_is_ground([Inst | Insts], ModuleInfo) :-
- inst_is_ground(ModuleInfo, Inst),
- inst_list_is_ground(Insts, ModuleInfo).
-
-inst_list_is_ground_or_any([], _).
-inst_list_is_ground_or_any([Inst | Insts], ModuleInfo) :-
- inst_is_ground_or_any(ModuleInfo, Inst),
- inst_list_is_ground_or_any(Insts, ModuleInfo).
-
-inst_list_is_unique([], _).
-inst_list_is_unique([Inst | Insts], ModuleInfo) :-
- inst_is_unique(ModuleInfo, Inst),
- inst_list_is_unique(Insts, ModuleInfo).
-
-inst_list_is_mostly_unique([], _).
-inst_list_is_mostly_unique([Inst | Insts], ModuleInfo) :-
- inst_is_mostly_unique(ModuleInfo, Inst),
- inst_list_is_mostly_unique(Insts, ModuleInfo).
-
-inst_list_is_not_partly_unique([], _).
-inst_list_is_not_partly_unique([Inst | Insts], ModuleInfo) :-
- inst_is_not_partly_unique(ModuleInfo, Inst),
- inst_list_is_not_partly_unique(Insts, ModuleInfo).
-
-inst_list_is_not_fully_unique([], _).
-inst_list_is_not_fully_unique([Inst | Insts], ModuleInfo) :-
- inst_is_not_fully_unique(ModuleInfo, Inst),
- inst_list_is_not_fully_unique(Insts, ModuleInfo).
-
-%-----------------------------------------------------------------------------%
-
-:- pred inst_list_is_ground_2(list(inst), module_info, set(inst)).
-:- mode inst_list_is_ground_2(in, in, in) is semidet.
-
-inst_list_is_ground_2([], _, _).
-inst_list_is_ground_2([Inst | Insts], ModuleInfo, Expansions) :-
- inst_is_ground_2(ModuleInfo, Inst, Inst, Expansions),
- inst_list_is_ground_2(Insts, ModuleInfo, Expansions).
-
-:- pred inst_list_is_ground_or_any_2(list(inst), module_info, set(inst)).
-:- mode inst_list_is_ground_or_any_2(in, in, in) is semidet.
-
-inst_list_is_ground_or_any_2([], _, _).
-inst_list_is_ground_or_any_2([Inst | Insts], ModuleInfo, Expansions) :-
- inst_is_ground_or_any_2(ModuleInfo, Inst, Inst, Expansions),
- inst_list_is_ground_or_any_2(Insts, ModuleInfo, Expansions).
-
-:- pred inst_list_is_unique_2(list(inst), module_info, set(inst)).
-:- mode inst_list_is_unique_2(in, in, in) is semidet.
-
-inst_list_is_unique_2([], _, _).
-inst_list_is_unique_2([Inst | Insts], ModuleInfo, Expansions) :-
- inst_is_unique_2(ModuleInfo, Inst, Inst, Expansions),
- inst_list_is_unique_2(Insts, ModuleInfo, Expansions).
-
-:- pred inst_list_is_mostly_unique_2(list(inst), module_info, set(inst)).
-:- mode inst_list_is_mostly_unique_2(in, in, in) is semidet.
-
-inst_list_is_mostly_unique_2([], _, _).
-inst_list_is_mostly_unique_2([Inst | Insts], ModuleInfo, Expansions) :-
- inst_is_mostly_unique_2(ModuleInfo, Inst, Inst, Expansions),
- inst_list_is_mostly_unique_2(Insts, ModuleInfo, Expansions).
-
-:- pred inst_list_is_not_partly_unique_2(list(inst), module_info, set(inst)).
-:- mode inst_list_is_not_partly_unique_2(in, in, in) is semidet.
-
-inst_list_is_not_partly_unique_2([], _, _).
-inst_list_is_not_partly_unique_2([Inst | Insts], ModuleInfo, Expansions) :-
- inst_is_not_partly_unique_2(ModuleInfo, Inst, Inst, Expansions),
- inst_list_is_not_partly_unique_2(Insts, ModuleInfo, Expansions).
-
-:- pred inst_list_is_not_fully_unique_2(list(inst), module_info, set(inst)).
-:- mode inst_list_is_not_fully_unique_2(in, in, in) is semidet.
-
-inst_list_is_not_fully_unique_2([], _, _).
-inst_list_is_not_fully_unique_2([Inst | Insts], ModuleInfo, Expansions) :-
- inst_is_not_fully_unique_2(ModuleInfo, Inst, Inst, Expansions),
- inst_list_is_not_fully_unique_2(Insts, ModuleInfo, Expansions).
-
-%-----------------------------------------------------------------------------%
-
-bound_inst_list_is_free([], _).
-bound_inst_list_is_free([functor(_Name, Args)|BoundInsts], ModuleInfo) :-
- inst_list_is_free(Args, ModuleInfo),
- bound_inst_list_is_free(BoundInsts, ModuleInfo).
-
-inst_list_is_free([], _).
-inst_list_is_free([Inst | Insts], ModuleInfo) :-
- inst_is_free(ModuleInfo, Inst),
- inst_list_is_free(Insts, ModuleInfo).
-
-%-----------------------------------------------------------------------------%
-
inst_lookup(ModuleInfo, InstName, Inst) :-
inst_lookup_2(InstName, ModuleInfo, Inst).
@@ -1827,14 +1263,13 @@
% Get the final inst of the deconstructed var, which
% will be the same as in the old instmap.
goal_info_get_instmap_delta(GoalInfo, OldInstMapDelta),
- instmap_delta_lookup_var(OldInstMapDelta, Var, FinalInst1),
instmap__lookup_var(InstMap, Var, InitialInst),
- ( inst_is_free(ModuleInfo, FinalInst1) ->
+ ( instmap_delta_search_var(OldInstMapDelta, Var, FinalInst1) ->
+ FinalInst = FinalInst1
+ ;
% it wasn't in the instmap_delta, so the inst didn't
% change.
FinalInst = InitialInst
- ;
- FinalInst = FinalInst1
),
UniModeToRhsMode =
lambda([UMode::in, Mode::out] is det, (
Index: modecheck_call.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_call.m,v
retrieving revision 1.12
diff -u -r1.12 modecheck_call.m
--- modecheck_call.m 1997/07/02 08:04:08 1.12
+++ modecheck_call.m 1997/07/08 02:46:39
@@ -40,11 +40,16 @@
:- mode modecheck_higher_order_pred_call(in, in, in, out,
mode_info_di, mode_info_uo) is det.
+:- pred modecheck_higher_order_func_call(var, list(var), var, hlds_goal_info,
+ hlds_goal_expr, mode_info, mode_info).
+:- mode modecheck_higher_order_func_call(in, in, in, in, out,
+ mode_info_di, mode_info_uo) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module prog_data, hlds_pred, hlds_data, hlds_module, instmap.
+:- import_module prog_data, hlds_pred, hlds_data, hlds_module, instmap, (inst).
:- import_module mode_info, mode_debug, modes, mode_util, mode_errors.
:- import_module clause_to_proc, inst_match, make_hlds.
:- import_module map, list, bool, std_util, set.
@@ -65,6 +70,26 @@
InstMap0, ModeInfo, Goal) },
mode_info_unset_call_context,
mode_checkpoint(exit, "higher-order predicate call").
+
+modecheck_higher_order_func_call(FuncVar, Args0, RetVar, GoalInfo0, Goal) -->
+ mode_checkpoint(enter, "higher-order function call"),
+ mode_info_set_call_context(higher_order_call(function)),
+
+ =(ModeInfo0),
+ { mode_info_get_instmap(ModeInfo0, InstMap0) },
+
+ { list__append(Args0, [RetVar], Args1) },
+ modecheck_higher_order_call(function, FuncVar, Args1,
+ Types, Modes, Det, Args, ExtraGoals),
+
+ =(ModeInfo),
+ { Call = higher_order_call(FuncVar, Args, Types, Modes, Det) },
+ { handle_extra_goals(Call, ExtraGoals, GoalInfo0,
+ [FuncVar | Args1], [FuncVar | Args],
+ InstMap0, ModeInfo, Goal) },
+
+ mode_info_unset_call_context,
+ mode_checkpoint(exit, "higher-order function call").
modecheck_higher_order_call(PredOrFunc, PredVar, Args0, Types, Modes, Det, Args,
ExtraGoals, ModeInfo0, ModeInfo) :-
Index: modecheck_unify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.17
diff -u -r1.17 modecheck_unify.m
--- modecheck_unify.m 1997/07/02 08:06:17 1.17
+++ modecheck_unify.m 1997/07/09 04:54:13
@@ -44,8 +44,8 @@
:- import_module llds, prog_data, prog_util, type_util, module_qual, instmap.
:- import_module hlds_module, hlds_goal, hlds_pred, hlds_data, hlds_out.
:- import_module mode_debug, mode_util, mode_info, modes, mode_errors.
-:- import_module inst_match, unify_proc, code_util, unique_modes.
-:- import_module typecheck, modecheck_call.
+:- import_module inst_match, inst_util, unify_proc, code_util, unique_modes.
+:- import_module typecheck, modecheck_call, (inst).
:- import_module bool, list, std_util, int, map, set, require, varset.
:- import_module string, assoc_list.
@@ -614,33 +614,6 @@
ArgVars = ArgVars0,
ExtraGoals = [] - []
).
-
-%-----------------------------------------------------------------------------%
-
-:- pred modecheck_higher_order_func_call(var, list(var), var, hlds_goal_info,
- hlds_goal_expr, mode_info, mode_info).
-:- mode modecheck_higher_order_func_call(in, in, in, in, out,
- mode_info_di, mode_info_uo) is det.
-
-modecheck_higher_order_func_call(FuncVar, Args0, RetVar, GoalInfo0, Goal) -->
- mode_checkpoint(enter, "higher-order function call"),
- mode_info_set_call_context(higher_order_call(function)),
-
- =(ModeInfo0),
- { mode_info_get_instmap(ModeInfo0, InstMap0) },
-
- { list__append(Args0, [RetVar], Args1) },
- modecheck_higher_order_call(function, FuncVar, Args1,
- Types, Modes, Det, Args, ExtraGoals),
-
- =(ModeInfo),
- { Call = higher_order_call(FuncVar, Args, Types, Modes, Det) },
- { handle_extra_goals(Call, ExtraGoals, GoalInfo0,
- [FuncVar | Args1], [FuncVar | Args],
- InstMap0, ModeInfo, Goal) },
-
- mode_info_unset_call_context,
- mode_checkpoint(exit, "higher-order function call").
%-----------------------------------------------------------------------------%
Index: modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modes.m,v
retrieving revision 1.200
diff -u -r1.200 modes.m
--- modes.m 1997/05/21 02:13:39 1.200
+++ modes.m 1997/07/09 04:54:14
@@ -131,7 +131,7 @@
:- interface.
-:- import_module hlds_module, hlds_pred, instmap.
+:- import_module hlds_module, hlds_pred, (inst), instmap.
:- import_module bool, io.
% modecheck(HLDS0, HLDS, UnsafeToContinue):
@@ -261,7 +261,7 @@
:- import_module type_util, mode_util, code_util, prog_data, unify_proc.
:- import_module globals, options, mercury_to_mercury, hlds_out, int, set.
:- import_module passes_aux, typecheck, module_qual, clause_to_proc.
-:- import_module modecheck_unify, modecheck_call.
+:- import_module modecheck_unify, modecheck_call, inst_util.
:- import_module list, map, varset, term, prog_out, string, require, std_util.
:- import_module assoc_list.
Index: module_qual.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/module_qual.m,v
retrieving revision 1.19
diff -u -r1.19 module_qual.m
--- module_qual.m 1997/06/29 23:11:11 1.19
+++ module_qual.m 1997/07/08 02:43:49
@@ -65,6 +65,7 @@
:- import_module hlds_data, hlds_module, hlds_pred, type_util, prog_out.
:- import_module prog_util, mercury_to_mercury, globals, options.
+:- import_module (inst), instmap.
:- import_module int, list, map, require, set, std_util, string, term, varset.
module_qual__module_qualify_items(Items0, Items, ModuleName, ReportErrors,
Index: polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.106
diff -u -r1.106 polymorphism.m
--- polymorphism.m 1997/06/02 06:36:09 1.106
+++ polymorphism.m 1997/06/24 01:05:58
@@ -163,6 +163,7 @@
:- import_module hlds_pred, hlds_goal, hlds_data, llds, (lambda), globals.
:- import_module prog_data, type_util, mode_util, quantification, instmap.
:- import_module code_util, unify_proc, special_pred, prog_util, make_hlds.
+:- import_module (inst).
:- import_module bool, int, string, list, set, map.
:- import_module term, varset, std_util, require.
Index: prog_data.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_data.m,v
retrieving revision 1.21
diff -u -r1.21 prog_data.m
--- prog_data.m 1997/07/07 12:01:36 1.21
+++ prog_data.m 1997/07/08 02:47:10
@@ -18,7 +18,7 @@
:- interface.
-:- import_module hlds_data, hlds_pred.
+:- import_module hlds_data, hlds_pred, (inst).
:- import_module list, map, varset, term, std_util.
%-----------------------------------------------------------------------------%
@@ -230,66 +230,6 @@
% probably inst parameters should be variables not terms
:- type inst_param == term.
-
-:- type (inst) ---> any(uniqueness)
- ; free
- ; free(type)
- ; bound(uniqueness, list(bound_inst))
- % The list(bound_inst) must be sorted
- ; ground(uniqueness, maybe(pred_inst_info))
- % The pred_inst_info is used for
- % higher-order pred modes
- ; not_reached
- ; inst_var(var)
- % A defined_inst is possibly recursive
- % inst whose value is stored in the
- % inst_table. This is used both for
- % user-defined insts and for
- % compiler-generated insts.
- ; defined_inst(inst_name)
- % An abstract inst is a defined inst which
- % has been declared but not actually been
- % defined (yet).
- ; abstract_inst(sym_name, list(inst)).
-
-:- type uniqueness
- ---> shared % there might be other references
- ; unique % there is only one reference
- ; mostly_unique % there is only one reference
- % but there might be more on
- % backtracking
- ; clobbered % this was the only reference, but
- % the data has already been reused
- ; mostly_clobbered.
- % this was the only reference, but
- % the data has already been reused;
- % however, there may be more references
- % on backtracking, so we will need to
- % restore the old value on backtracking
-
- % higher-order predicate terms are given the inst
- % `ground(shared, yes(PredInstInfo))'
- % where the PredInstInfo contains the extra modes and the determinism
- % for the predicate. Note that the higher-order predicate term
- % itself must be ground.
-
-:- type pred_inst_info
- ---> pred_inst_info(
- pred_or_func, % is this a higher-order func
- % mode or a higher-order pred
- % mode?
- list(mode), % the modes of the additional
- % (i.e. not-yet-supplied)
- % arguments of the pred;
- % for a function, this includes
- % the mode of the return value
- % as the last element of the
- % list.
- determinism % the determinism of the
- % predicate or function
- ).
-
-:- type bound_inst ---> functor(cons_id, list(inst)).
% An `inst_name' is used as a key for the inst_table.
% It is either a user-defined inst `user_inst(Name, Args)',
Index: prog_io.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_io.m,v
retrieving revision 1.157
diff -u -r1.157 prog_io.m
--- prog_io.m 1997/07/08 05:49:44 1.157
+++ prog_io.m 1997/07/09 02:02:31
@@ -99,7 +99,7 @@
:- implementation.
:- import_module prog_io_goal, prog_io_dcg, prog_io_pragma, prog_io_util.
-:- import_module hlds_data, hlds_pred, prog_util, globals, options.
+:- import_module hlds_data, hlds_pred, prog_util, globals, options, (inst).
:- import_module bool, int, string, std_util, parser, term_io, dir, require.
:- import_module varset, term.
Index: prog_io_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_io_util.m,v
retrieving revision 1.3
diff -u -r1.3 prog_io_util.m
--- prog_io_util.m 1997/07/08 05:49:46 1.3
+++ prog_io_util.m 1997/07/09 02:02:32
@@ -25,7 +25,7 @@
:- interface.
-:- import_module prog_data.
+:- import_module prog_data, (inst).
:- import_module list, term, io.
:- type maybe2(T1, T2) ---> error(string, term)
Index: prog_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_util.m,v
retrieving revision 1.33
diff -u -r1.33 prog_util.m
--- prog_util.m 1996/08/03 12:06:23 1.33
+++ prog_util.m 1997/06/24 01:08:33
@@ -67,6 +67,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module (inst).
:- import_module bool, std_util, map.
%-----------------------------------------------------------------------------%
Index: simplify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/simplify.m,v
retrieving revision 1.39
diff -u -r1.39 simplify.m
--- simplify.m 1997/07/14 06:03:20 1.39
+++ simplify.m 1997/07/15 01:19:05
@@ -27,7 +27,7 @@
:- interface.
-:- import_module common, hlds_pred, det_report, det_util.
+:- import_module common, hlds_pred, det_report, det_util, instmap.
:- import_module io.
:- pred simplify__proc(simplify, pred_id, proc_id, module_info, module_info,
@@ -62,7 +62,7 @@
:- import_module hlds_out.
:- import_module code_aux, det_analysis, follow_code, goal_util.
-:- import_module hlds_module, hlds_goal, hlds_data, instmap, inst_match.
+:- import_module hlds_module, hlds_goal, hlds_data, (inst), inst_match.
:- import_module globals, options, passes_aux, prog_data, mode_util, type_util.
:- import_module code_util, quantification, modes.
:- import_module bool, list, set, map, require, std_util, term, varset.
@@ -884,7 +884,11 @@
simplify__check_branches_for_extra_info(Var, InstMap,
[BranchInstMap | BranchInstMaps], Cases, CaseList0, CaseList) :-
instmap__lookup_var(InstMap, Var, InstMapInst),
- instmap_delta_lookup_var(BranchInstMap, Var, BranchInstMapInst),
+ ( instmap_delta_search_var(BranchInstMap, Var, BranchInstMapInst0) ->
+ BranchInstMapInst = BranchInstMapInst0
+ ;
+ BranchInstMapInst = InstMapInst
+ ),
simplify__inst_contains_more_information(BranchInstMapInst,
InstMapInst, Cases, ThisCase),
simplify__check_branches_for_extra_info(Var, InstMap,
Index: switch_detection.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/switch_detection.m,v
retrieving revision 1.72
diff -u -r1.72 switch_detection.m
--- switch_detection.m 1997/07/08 05:46:01 1.72
+++ switch_detection.m 1997/07/09 05:15:48
@@ -29,7 +29,7 @@
:- implementation.
-:- import_module hlds_goal, hlds_data, prog_data, instmap.
+:- import_module hlds_goal, hlds_data, prog_data, instmap, inst_match.
:- import_module modes, mode_util, type_util, det_util.
:- import_module passes_aux.
:- import_module char, int, list, assoc_list, map, set, std_util, term, require.
Index: unify_proc.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unify_proc.m,v
retrieving revision 1.58
diff -u -r1.58 unify_proc.m
--- unify_proc.m 1997/05/21 02:13:54 1.58
+++ unify_proc.m 1997/07/09 05:16:22
@@ -92,9 +92,9 @@
:- import_module list, tree, map, queue, int, string, require, bool.
:- import_module code_util, code_info, type_util, varset.
:- import_module mercury_to_mercury, hlds_out.
-:- import_module make_hlds, term, prog_util.
+:- import_module make_hlds, term, prog_util, inst_match.
:- import_module quantification, clause_to_proc.
-:- import_module globals, options, mode_util.
+:- import_module globals, options, mode_util, (inst).
:- import_module switch_detection, cse_detection, det_analysis, unique_modes.
% We keep track of all the complicated unification procs we need
Index: unique_modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unique_modes.m,v
retrieving revision 1.36
diff -u -r1.36 unique_modes.m
--- unique_modes.m 1997/05/05 11:17:39 1.36
+++ unique_modes.m 1997/07/09 04:54:17
@@ -49,9 +49,10 @@
:- implementation.
-:- import_module hlds_data, mode_debug, modecheck_unify, instmap.
+:- import_module hlds_data, mode_debug, modecheck_unify.
:- import_module mode_util, prog_out, hlds_out, mercury_to_mercury, passes_aux.
-:- import_module modes, inst_match, prog_data, mode_errors, llds, unify_proc.
+:- import_module modes, prog_data, mode_errors, llds, unify_proc.
+:- import_module (inst), instmap, inst_match, inst_util.
:- import_module bool, int, list, map, set, std_util, require, term, varset.
:- import_module assoc_list.
@@ -315,7 +316,7 @@
instmap__lookup_var(InstMap0, Var, Inst0),
(
instmap_delta_is_reachable(DeltaInstMap),
- instmap_delta_lookup_var(DeltaInstMap, Var, Inst),
+ instmap_delta_search_var(DeltaInstMap, Var, Inst),
\+ inst_matches_final(Inst, Inst0, ModuleInfo)
->
ChangedVars = [Var | ChangedVars1],
New File: inst.m
===================================================================
%-----------------------------------------------------------------------------%
% Copyright (C) 1997 University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% inst.m - Contains the (inst) data type.
% Main author: bromage
%
%-----------------------------------------------------------------------------%
:- module (inst).
:- interface.
:- import_module prog_data, hlds_data, hlds_pred.
:- import_module list, std_util, term.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- type (inst)
---> any(uniqueness)
; free
; free(type)
; bound(uniqueness, list(bound_inst))
% The list(bound_inst) must be sorted
; ground(uniqueness, maybe(pred_inst_info))
% The pred_inst_info is used for
% higher-order pred modes
; not_reached
; inst_var(var)
% A defined_inst is possibly recursive
% inst whose value is stored in the
% inst_table. This is used both for
% user-defined insts and for
% compiler-generated insts.
; defined_inst(inst_name)
% An abstract inst is a defined inst which
% has been declared but not actually been
% defined (yet).
; abstract_inst(sym_name, list(inst)).
:- type uniqueness
---> shared % there might be other references
; unique % there is only one reference
; mostly_unique % there is only one reference
% but there might be more on
% backtracking
; clobbered % this was the only reference, but
% the data has already been reused
; mostly_clobbered.
% this was the only reference, but
% the data has already been reused;
% however, there may be more references
% on backtracking, so we will need to
% restore the old value on backtracking
% higher-order predicate terms are given the inst
% `ground(shared, yes(PredInstInfo))'
% where the PredInstInfo contains the extra modes and the determinism
% for the predicate. Note that the higher-order predicate term
% itself must be ground.
:- type pred_inst_info
---> pred_inst_info(
pred_or_func, % is this a higher-order func
% mode or a higher-order pred
% mode?
list(mode), % the modes of the additional
% (i.e. not-yet-supplied)
% arguments of the pred;
% for a function, this includes
% the mode of the return value
% as the last element of the
% list.
determinism % the determinism of the
% predicate or function
).
:- type bound_inst ---> functor(cons_id, list(inst)).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
% Empty for now.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
New File: inst_util.m
===================================================================
%-----------------------------------------------------------------------------%
% Copyright (C) 1997 University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% file: inst_util.m
% author: fjh
%
% This module defines some utility routines for manipulating insts.
%
/*
The handling of `any' insts is not complete. (See also inst_match.m)
Currently we don't allow any unifications with variables of mode `any'.
The reason is that although the mode analysis would be pretty
straight-forward, generating the correct code is quite a bit trickier.
In fact, much of the mode analysis code in this file is already
done, just commented out with the remark "not yet".
The exception is abstract unification, which hasn't been done.
In addition, modes.m would have to be changed to handle the implicit
conversions from `free'/`bound'/`ground' to `any' at
(1) procedure calls (this is just an extension of implied modes)
(2) the end of branched goals
(3) the end of predicates.
Since that is not yet done, we currently require the user to
insert explicit calls to initialize constraint variables.
*/
%-----------------------------------------------------------------------------%
:- module inst_util.
:- interface.
:- import_module hlds_module, prog_data, (inst).
:- pred abstractly_unify_inst(is_live, inst, inst, unify_is_real, module_info,
inst, determinism, module_info).
:- mode abstractly_unify_inst(in, in, in, in, in, out, out, out) is semidet.
% Compute the inst that results from abstractly unifying two variables.
:- pred abstractly_unify_inst_functor(is_live, inst, cons_id, list(inst),
list(is_live), unify_is_real, module_info,
inst, module_info).
:- mode abstractly_unify_inst_functor(in, in, in, in, in, in, in, out, out)
is semidet.
% Compute the inst that results from abstractly unifying
% a variable with a functor.
% Mode checking is like abstract interpretation.
% The above predicates define the abstract unification operation
% which unifies two instantiatednesses. If the unification
% would be illegal, then abstract unification fails.
% If the unification would fail, then the abstract unification
% will succeed, and the resulting instantiatedness will be
% `not_reached'.
%-----------------------------------------------------------------------------%
:- pred make_mostly_uniq_inst(inst, module_info, inst, module_info).
:- mode make_mostly_uniq_inst(in, in, out, out) is det.
% Given an inst, return a new inst which is the same as the
% original inst but with all occurrences of `unique' replaced
% with `mostly_unique'.
%-----------------------------------------------------------------------------%
:- pred inst_merge(inst, inst, module_info, inst, module_info).
:- mode inst_merge(in, in, in, out, out) is semidet.
% inst_merge(InstA, InstB, InstC):
% Combine the insts found in different arms of a
% disjunction (or if-then-else).
% The information in InstC is the minimum of the
% information in InstA and InstB. Where InstA and
% InstB specify a binding (free or bound), it must be
% the same in both.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module hlds_data, inst_match, mode_util.
:- import_module bool, std_util, require, map, list, set.
% Abstractly unify two insts.
abstractly_unify_inst(Live, InstA, InstB, UnifyIsReal, ModuleInfo0,
Inst, Det, ModuleInfo) :-
% check whether this pair of insts is already in
% the unify_insts table
ThisInstPair = unify_inst(Live, InstA, InstB, UnifyIsReal),
module_info_insts(ModuleInfo0, InstTable0),
inst_table_get_unify_insts(InstTable0, UnifyInsts0),
( map__search(UnifyInsts0, ThisInstPair, Result) ->
( Result = known(UnifyInst, UnifyDet) ->
Inst0 = UnifyInst,
Det = UnifyDet
;
Inst0 = defined_inst(ThisInstPair),
% It's ok to assume that the unification is
% deterministic here, because the only time that
% this will happen is when we get to the
% recursive case for a recursively defined inst.
% If the unification as a whole is semidet then
% it must be semidet somewhere else too.
Det = det
),
ModuleInfo = ModuleInfo0
;
% insert ThisInstPair into the table with value
% `unknown'
map__set(UnifyInsts0, ThisInstPair, unknown, UnifyInsts1),
inst_table_set_unify_insts(InstTable0, UnifyInsts1, InstTable1),
module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
% unify the insts
inst_expand(ModuleInfo0, InstA, InstA2),
inst_expand(ModuleInfo0, InstB, InstB2),
abstractly_unify_inst_2(Live, InstA2, InstB2, UnifyIsReal,
ModuleInfo1, Inst0, Det, ModuleInfo2),
% now update the value associated with ThisInstPair
module_info_insts(ModuleInfo2, InstTable2),
inst_table_get_unify_insts(InstTable2, UnifyInsts2),
map__set(UnifyInsts2, ThisInstPair, known(Inst0, Det),
UnifyInsts),
inst_table_set_unify_insts(InstTable2, UnifyInsts, InstTable),
module_info_set_insts(ModuleInfo2, InstTable, ModuleInfo)
),
% avoid expanding recursive insts
( inst_contains_instname(Inst0, ModuleInfo, ThisInstPair) ->
Inst = defined_inst(ThisInstPair)
;
Inst = Inst0
).
:- pred abstractly_unify_inst_2(is_live, inst, inst, unify_is_real, module_info,
inst, determinism, module_info).
:- mode abstractly_unify_inst_2(in, in, in, in, in, out, out, out) is semidet.
abstractly_unify_inst_2(IsLive, InstA, InstB, UnifyIsReal, ModuleInfo0,
Inst, Det, ModuleInfo) :-
( InstB = not_reached ->
Inst = not_reached,
Det = det,
ModuleInfo = ModuleInfo0
;
abstractly_unify_inst_3(IsLive, InstA, InstB, UnifyIsReal,
ModuleInfo0, Inst, Det, ModuleInfo)
).
% Abstractly unify two expanded insts.
% The is_live parameter is `live' iff *both* insts are live.
% Given the two insts to be unified, this produces
% a resulting inst and a determinism for the unification.
:- pred abstractly_unify_inst_3(is_live, inst, inst, unify_is_real, module_info,
inst, determinism, module_info).
:- mode abstractly_unify_inst_3(in, in, in, in, in, out, out, out) is semidet.
% XXX could be extended to handle `any' insts better
abstractly_unify_inst_3(live, not_reached, _, _, M, not_reached, det, M).
abstractly_unify_inst_3(live, any(UniqX), any(UniqY), Real, M,
any(Uniq), semidet, M) :-
Real = fake_unify,
unify_uniq(live, Real, semidet, UniqX, UniqY, Uniq).
abstractly_unify_inst_3(live, any(UniqX), free, Real, M,
any(Uniq), det, M) :-
unify_uniq(live, Real, det, UniqX, unique, Uniq).
abstractly_unify_inst_3(live, free, any(UniqY), Real, M,
any(Uniq), det, M) :-
unify_uniq(live, Real, det, unique, UniqY, Uniq).
% abstractly_unify_inst_3(live, free, free, _, _, _, _, _) :- fail.
abstractly_unify_inst_3(live, free, bound(UniqY, List0), Real, M0,
bound(Uniq, List), det, M) :-
unify_uniq(live, Real, det, unique, UniqY, Uniq),
% since both are live, we must disallow free-free unifications
bound_inst_list_is_ground_or_any(List0, M0),
% since both are live, we must make the result shared
% (unless it was already shared)
( ( UniqY = unique ; UniqY = mostly_unique ) ->
make_shared_bound_inst_list(List0, M0, List, M)
;
List = List0, M = M0
).
abstractly_unify_inst_3(live, free, ground(UniqY, PredInst), Real, M,
ground(Uniq, PredInst), det, M) :-
unify_uniq(live, Real, det, unique, UniqY, Uniq).
% abstractly_unify_inst_3(live, free, abstract_inst(_,_), _, _, _, _) :- fail.
abstractly_unify_inst_3(live, bound(UniqY, List0), free, Real, M0,
bound(Uniq, List), det, M) :-
unify_uniq(live, Real, det, unique, UniqY, Uniq),
% since both are live, we must disallow free-free unifications
bound_inst_list_is_ground_or_any(List0, M0),
make_shared_bound_inst_list(List0, M0, List, M).
abstractly_unify_inst_3(live, bound(UniqX, ListX), bound(UniqY, ListY), Real,
M0, bound(Uniq, List), Det, M) :-
abstractly_unify_bound_inst_list(live, ListX, ListY, Real, M0,
List, Det, M),
unify_uniq(dead, Real, Det, UniqX, UniqY, Uniq).
abstractly_unify_inst_3(live, bound(UniqX, BoundInsts0), ground(UniqY, _),
Real, M0, bound(Uniq, BoundInsts), semidet, M) :-
unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq),
make_ground_bound_inst_list(BoundInsts0, live, UniqY, Real, M0,
BoundInsts, M).
/*** abstract insts not supported
abstractly_unify_inst_3(live, bound(Uniq, List), abstract_inst(_,_), Real, M,
ground(shared), semidet, M) :-
unify_uniq(live, Real, semidet, unique, UniqY, Uniq),
bound_inst_list_is_ground(List, M).
***/
abstractly_unify_inst_3(live, ground(Uniq0, yes(PredInst)), free, Real, M,
ground(Uniq, yes(PredInst)), det, M) :-
unify_uniq(live, Real, det, unique, Uniq0, Uniq).
abstractly_unify_inst_3(live, ground(UniqX, yes(_)), bound(UniqY, BoundInsts0),
Real, M0, bound(Uniq, BoundInsts), semidet, M) :-
unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq),
make_ground_bound_inst_list(BoundInsts0, live, UniqX, Real, M0,
BoundInsts, M).
abstractly_unify_inst_3(live, ground(UniqA, yes(PredInstA)),
ground(UniqB, _MaybePredInstB), Real, M,
ground(Uniq, PredInst), semidet, M) :-
% It is an error to unify higher-order preds,
% so if Real \= fake_unify, then we must fail.
Real = fake_unify,
% In theory we should choose take the union of the
% information specified by PredInstA and _MaybePredInstB.
% However, since our data representation provides no
% way of doing that, and since this will only happen
% for fake_unifys, for which it shouldn't make any difference,
% we just choose the information specified by PredInstA.
PredInst = yes(PredInstA),
unify_uniq(live, Real, semidet, UniqA, UniqB, Uniq).
abstractly_unify_inst_3(live, ground(Uniq, no), Inst0, Real, M0,
Inst, Det, M) :-
( inst_is_free(M0, Inst0) ->
Det = det
;
Det = semidet
),
make_ground_inst(Inst0, live, Uniq, Real, M0, Inst, M).
% abstractly_unify_inst_3(live, abstract_inst(_,_), free, _, _, _, _, _)
% :- fail.
/*** abstract insts not supported
abstractly_unify_inst_3(live, abstract_inst(_,_), bound(Uniq, List), Real,
ModuleInfo, ground(shared, no), semidet, ModuleInfo) :-
check_not_clobbered(Real, Uniq),
bound_inst_list_is_ground(List, ModuleInfo).
abstractly_unify_inst_3(live, abstract_inst(_,_), ground(Uniq, no), Real, M,
ground(shared, no), semidet, M) :-
check_not_clobbered(Real, Uniq).
abstractly_unify_inst_3(live, abstract_inst(Name, ArgsA),
abstract_inst(Name, ArgsB), Real, ModuleInfo0,
abstract_inst(Name, Args), Det, ModuleInfo) :-
abstractly_unify_inst_list(ArgsA, ArgsB, live, Real, ModuleInfo0,
Args, Det, ModuleInfo).
***/
abstractly_unify_inst_3(dead, not_reached, _, _, M, not_reached, det, M).
abstractly_unify_inst_3(dead, any(UniqX), any(UniqY), Real, M,
any(Uniq), semidet, M) :-
Real = fake_unify,
unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq).
abstractly_unify_inst_3(dead, any(UniqX), free, _Real, M,
any(UniqX), det, M).
abstractly_unify_inst_3(dead, free, Inst, _, M, Inst, det, M).
abstractly_unify_inst_3(dead, bound(UniqX, List), free, Real, ModuleInfo,
bound(Uniq, List), det, ModuleInfo) :-
unify_uniq(dead, Real, det, UniqX, unique, Uniq).
abstractly_unify_inst_3(dead, bound(UniqX, ListX), bound(UniqY, ListY),
Real, M0, bound(Uniq, List), Det, M) :-
abstractly_unify_bound_inst_list(dead, ListX, ListY, Real, M0,
List, Det, M),
unify_uniq(dead, Real, Det, UniqX, UniqY, Uniq).
abstractly_unify_inst_3(dead, bound(UniqX, BoundInsts0), ground(UniqY, _),
Real, M0, bound(Uniq, BoundInsts), semidet, M) :-
unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq),
make_ground_bound_inst_list(BoundInsts0, dead, UniqY, Real, M0,
BoundInsts, M).
/***** abstract insts aren't really supported
abstractly_unify_inst_3(dead, bound(Uniq, List), abstract_inst(N,As),
ModuleInfo, Result, Det, ModuleInfo) :-
( bound_inst_list_is_ground(List, ModuleInfo) ->
Result = bound(Uniq, List),
Det = semidet
; bound_inst_list_is_free(List, ModuleInfo) ->
Result = abstract_inst(N,As),
Det = det
;
fail
).
*****/
abstractly_unify_inst_3(dead, ground(Uniq, yes(PredInst)), free, _Real, M,
ground(Uniq, yes(PredInst)), det, M).
abstractly_unify_inst_3(dead, ground(UniqA, yes(_)), bound(UniqB, BoundInsts0),
Real, M0, bound(Uniq, BoundInsts), semidet, M) :-
unify_uniq(dead, Real, semidet, UniqA, UniqB, Uniq),
make_ground_bound_inst_list(BoundInsts0, dead, UniqA, Real, M0,
BoundInsts, M).
abstractly_unify_inst_3(dead, ground(UniqA, yes(PredInstA)),
ground(UniqB, _MaybePredInstB), Real, M,
ground(Uniq, PredInst), det, M) :-
Real = fake_unify,
PredInst = yes(PredInstA),
unify_uniq(dead, Real, det, UniqA, UniqB, Uniq).
abstractly_unify_inst_3(dead, ground(Uniq, no), Inst0, Real, M0,
Inst, Det, M) :-
( inst_is_free(M0, Inst0) ->
Det = det
;
Det = semidet
),
make_ground_inst(Inst0, dead, Uniq, Real, M0, Inst, M).
/***** abstract insts aren't really supported
abstractly_unify_inst_3(dead, abstract_inst(N,As), bound(List), Real,
ModuleInfo, Result, Det, ModuleInfo) :-
( bound_inst_list_is_ground(List, ModuleInfo) ->
Result = bound(List),
Det = semidet
; bound_inst_list_is_free(List, ModuleInfo) ->
Result = abstract_inst(N,As),
Det = det
;
fail
).
abstractly_unify_inst_3(dead, abstract_inst(_,_), ground, _Real, ModuleInfo,
ground, semidet, ModuleInfo).
abstractly_unify_inst_3(dead, abstract_inst(Name, ArgsA),
abstract_inst(Name, ArgsB), Real, ModuleInfo0,
abstract_inst(Name, Args), Det, ModuleInfo) :-
abstractly_unify_inst_list(ArgsA, ArgsB, dead, Real, ModuleInfo0,
Args, Det, ModuleInfo).
*****/
%-----------------------------------------------------------------------------%
% Abstractly unify two inst lists.
:- pred abstractly_unify_inst_list(list(inst), list(inst), is_live,
unify_is_real, module_info,
list(inst), determinism, module_info).
:- mode abstractly_unify_inst_list(in, in, in, in, in, out, out, out)
is semidet.
abstractly_unify_inst_list([], [], _, _, M, [], det, M).
abstractly_unify_inst_list([X|Xs], [Y|Ys], Live, Real, ModuleInfo0,
[Z|Zs], Det, ModuleInfo) :-
abstractly_unify_inst(Live, X, Y, Real, ModuleInfo0,
Z, Det1, ModuleInfo1),
abstractly_unify_inst_list(Xs, Ys, Live, Real, ModuleInfo1,
Zs, Det2, ModuleInfo),
( Det1 = semidet ->
Det = semidet
;
Det = Det2
).
%-----------------------------------------------------------------------------%
% This is the abstract unification operation which
% unifies a variable (or rather, it's instantiatedness)
% with a functor.
abstractly_unify_inst_functor(Live, InstA, ConsId, ArgInsts, ArgLives,
Real, ModuleInfo0, Inst, ModuleInfo) :-
inst_expand(ModuleInfo0, InstA, InstA2),
abstractly_unify_inst_functor_2(Live, InstA2, ConsId, ArgInsts,
ArgLives, Real, ModuleInfo0, Inst, ModuleInfo).
:- pred abstractly_unify_inst_functor_2(is_live, inst, cons_id, list(inst),
list(is_live), unify_is_real, module_info,
inst, module_info).
:- mode abstractly_unify_inst_functor_2(in, in, in, in, in, in, in, out, out)
is semidet.
% XXX need to handle `any' insts
abstractly_unify_inst_functor_2(live, not_reached, _, _, _, _, M,
not_reached, M).
abstractly_unify_inst_functor_2(live, free, ConsId, Args0, ArgLives, _Real,
ModuleInfo0,
bound(unique, [functor(ConsId, Args)]), ModuleInfo) :-
inst_list_is_ground_or_any_or_dead(Args0, ArgLives, ModuleInfo0),
maybe_make_shared_inst_list(Args0, ArgLives, ModuleInfo0,
Args, ModuleInfo).
abstractly_unify_inst_functor_2(live, bound(Uniq, ListX), ConsId, Args,
ArgLives, Real, M0, bound(Uniq, List), M) :-
abstractly_unify_bound_inst_list_lives(ListX, ConsId, Args, ArgLives,
Real, M0, List, M).
abstractly_unify_inst_functor_2(live, ground(Uniq, _), ConsId, ArgInsts,
ArgLives, Real, M0, Inst, M) :-
make_ground_inst_list_lives(ArgInsts, live, ArgLives, Uniq, Real, M0,
GroundArgInsts, M),
Inst = bound(Uniq, [functor(ConsId, GroundArgInsts)]).
% abstractly_unify_inst_functor_2(live, abstract_inst(_,_), _, _, _, _, _, _) :-
% fail.
abstractly_unify_inst_functor_2(dead, not_reached, _, _, _, _, M,
not_reached, M).
abstractly_unify_inst_functor_2(dead, free, ConsId, Args, _ArgLives, _Real, M,
bound(unique, [functor(ConsId, Args)]), M).
abstractly_unify_inst_functor_2(dead, bound(Uniq, ListX), ConsId, Args,
_ArgLives, Real, M0, bound(Uniq, List), M) :-
ListY = [functor(ConsId, Args)],
abstractly_unify_bound_inst_list(dead, ListX, ListY, Real, M0,
List, _, M).
abstractly_unify_inst_functor_2(dead, ground(Uniq, _), ConsId, ArgInsts,
_ArgLives, Real, M0, Inst, M) :-
make_ground_inst_list(ArgInsts, dead, Uniq, Real, M0,
GroundArgInsts, M),
Inst = bound(Uniq, [functor(ConsId, GroundArgInsts)]).
% abstractly_unify_inst_functor_2(dead, abstract_inst(_,_), _, _, _, _, _, _) :-
% fail.
%-----------------------------------------------------------------------------%
% This code performs abstract unification of two bound(...) insts.
% like a sorted merge operation. If two elements have the
% The lists of bound_inst are guaranteed to be sorted.
% Abstract unification of two bound(...) insts proceeds
% like a sorted merge operation. If two elements have the
% same functor name, they are inserted in the output list,
% assuming their argument inst list can be abstractly unified.
% (If it can't, the whole thing fails). If a functor name
% occurs in only one of the two input lists, it is not inserted
% in the output list.
:- pred abstractly_unify_bound_inst_list(is_live, list(bound_inst),
list(bound_inst), unify_is_real, module_info,
list(bound_inst), determinism, module_info).
:- mode abstractly_unify_bound_inst_list(in, in, in, in, in,
out, out, out) is semidet.
abstractly_unify_bound_inst_list(_, [], [], _, ModuleInfo, [], det, ModuleInfo).
abstractly_unify_bound_inst_list(_, [], [_|_], _, M, [], semidet, M).
abstractly_unify_bound_inst_list(_, [_|_], [], _, M, [], semidet, M).
abstractly_unify_bound_inst_list(Live, [X|Xs], [Y|Ys], Real, ModuleInfo0,
L, Det, ModuleInfo) :-
X = functor(ConsIdX, ArgsX),
Y = functor(ConsIdY, ArgsY),
( ConsIdX = ConsIdY ->
abstractly_unify_inst_list(ArgsX, ArgsY, Live, Real,
ModuleInfo0, Args, Det1, ModuleInfo1),
L = [functor(ConsIdX, Args) | L1],
abstractly_unify_bound_inst_list(Live, Xs, Ys, Real,
ModuleInfo1, L1, Det2, ModuleInfo),
( Det1 = semidet ->
Det = semidet
;
Det = Det2
)
;
Det = semidet,
( compare(<, ConsIdX, ConsIdY) ->
abstractly_unify_bound_inst_list(Live, Xs, [Y|Ys],
Real, ModuleInfo0, L, _, ModuleInfo)
;
abstractly_unify_bound_inst_list(Live, [X|Xs], Ys,
Real, ModuleInfo0, L, _, ModuleInfo)
)
).
:- pred abstractly_unify_bound_inst_list_lives(list(bound_inst), cons_id,
list(inst), list(is_live), unify_is_real, module_info,
list(bound_inst), module_info).
:- mode abstractly_unify_bound_inst_list_lives(in, in, in, in, in, in, out, out)
is semidet.
abstractly_unify_bound_inst_list_lives([], _, _, _, _, ModuleInfo,
[], ModuleInfo).
abstractly_unify_bound_inst_list_lives([X|Xs], ConsIdY, ArgsY, LivesY, Real,
ModuleInfo0, L, ModuleInfo) :-
X = functor(ConsIdX, ArgsX),
(
ConsIdX = ConsIdY
->
abstractly_unify_inst_list_lives(ArgsX, ArgsY, LivesY, Real,
ModuleInfo0, Args, ModuleInfo),
L = [functor(ConsIdX, Args)]
;
abstractly_unify_bound_inst_list_lives(Xs, ConsIdY, ArgsY,
LivesY, Real, ModuleInfo0, L, ModuleInfo)
).
:- pred abstractly_unify_inst_list_lives(list(inst), list(inst), list(is_live),
unify_is_real, module_info, list(inst), module_info).
:- mode abstractly_unify_inst_list_lives(in, in, in, in, in, out, out)
is semidet.
abstractly_unify_inst_list_lives([], [], [], _, ModuleInfo, [], ModuleInfo).
abstractly_unify_inst_list_lives([X|Xs], [Y|Ys], [Live|Lives], Real,
ModuleInfo0, [Z|Zs], ModuleInfo) :-
abstractly_unify_inst(Live, X, Y, Real, ModuleInfo0,
Z, _Det, ModuleInfo1),
abstractly_unify_inst_list_lives(Xs, Ys, Lives, Real, ModuleInfo1,
Zs, ModuleInfo).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred unify_uniq(is_live, unify_is_real, determinism, uniqueness, uniqueness,
uniqueness).
:- mode unify_uniq(in, in, in, in, in, out) is semidet.
% Unifying shared with either shared or unique gives shared.
% Unifying unique with unique gives shared if live, unique if
% dead. Unifying clobbered with anything gives clobbered,
% except that if live then it is an internal error (a clobbered
% value should not be live, right?), and except that unifying
% with clobbered is not allowed for semidet unifications,
% unless they are "fake".
%
% The only way this predicate can abort is if a clobbered value
% is live.
% The only way this predicate can fail (indicating a unique mode error)
% is if we are attempting to unify with a clobbered value, and
% this was a "real" unification, not a "fake" one,
% and the determinism of the unification is semidet.
% (See comment in prog_data.m for more info on "real" v.s. "fake".)
% Note that if a unification or sub-unification is det, then it is
% OK to unify with a clobbered value. This can occur e.g. with
% unifications between free and clobbered, or with free and
% bound(..., clobbered, ...). Such det unifications are OK because
% the clobbered value will not be examined, instead all that will
% happen is that a variable or a field of a variable will become
% bound to the clobbered value; and since the final inst will also
% be clobbered, the variable or field's value can never be examined
% later either. Only semidet unifications would test the value
% of a clobbered variable, so those are the only ones we need to
% disallow.
unify_uniq(_, _, _, shared, shared, shared).
unify_uniq(_, _, _, shared, unique, shared).
unify_uniq(_, _, _, shared, mostly_unique, shared).
unify_uniq(Live, Real, Det, shared, clobbered, clobbered) :-
allow_unify_with_clobbered(Live, Real, Det).
unify_uniq(Live, Real, Det, shared, mostly_clobbered, mostly_clobbered) :-
allow_unify_with_clobbered(Live, Real, Det).
unify_uniq(_, _, _, unique, shared, shared).
unify_uniq(live, _, _, unique, unique, shared).
unify_uniq(live, _, _, unique, mostly_unique, shared).
unify_uniq(dead, _, _, unique, unique, unique).
unify_uniq(dead, _, _, unique, mostly_unique, mostly_unique).
% XXX the above line is a conservative approximation
% sometimes it should return unique not mostly_unique
unify_uniq(Live, Real, Det, unique, clobbered, clobbered) :-
allow_unify_with_clobbered(Live, Real, Det).
unify_uniq(Live, Real, Det, unique, mostly_clobbered, mostly_clobbered) :-
allow_unify_with_clobbered(Live, Real, Det).
unify_uniq(_, _, _, mostly_unique, shared, shared).
unify_uniq(live, _, _, mostly_unique, unique, shared).
unify_uniq(live, _, _, mostly_unique, mostly_unique, shared).
unify_uniq(dead, _, _, mostly_unique, unique, mostly_unique).
% XXX the above line is a conservative approximation
% sometimes it should return unique not mostly_unique
unify_uniq(dead, _, _, mostly_unique, mostly_unique, mostly_unique).
unify_uniq(Live, Real, Det, mostly_unique, clobbered, clobbered) :-
allow_unify_with_clobbered(Live, Real, Det).
unify_uniq(Live, Real, Det, mostly_unique, mostly_clobbered,
mostly_clobbered) :-
allow_unify_with_clobbered(Live, Real, Det).
unify_uniq(Live, Real, Det, clobbered, _, clobbered) :-
allow_unify_with_clobbered(Live, Real, Det).
unify_uniq(Live, Real, Det, mostly_clobbered, Uniq0, Uniq) :-
( Uniq0 = clobbered -> Uniq = clobbered ; Uniq = mostly_clobbered ),
allow_unify_with_clobbered(Live, Real, Det).
:- pred allow_unify_with_clobbered(is_live, unify_is_real, determinism).
:- mode allow_unify_with_clobbered(in, in, in) is semidet.
allow_unify_with_clobbered(live, _, _) :-
error("allow_unify_with_clobbered: clobbered value is live?").
allow_unify_with_clobbered(dead, fake_unify, _).
allow_unify_with_clobbered(dead, _, det).
%-----------------------------------------------------------------------------%
:- pred check_not_clobbered(uniqueness, unify_is_real).
:- mode check_not_clobbered(in, in) is det.
% sanity check
check_not_clobbered(Uniq, Real) :-
( Real = real_unify, Uniq = clobbered ->
error("abstractly_unify_inst_3: clobbered inst")
; Real = real_unify, Uniq = mostly_clobbered ->
error("abstractly_unify_inst_3: mostly_clobbered inst")
;
true
).
%-----------------------------------------------------------------------------%
:- pred make_ground_inst_list_lives(list(inst), is_live, list(is_live),
uniqueness, unify_is_real,
module_info, list(inst), module_info).
:- mode make_ground_inst_list_lives(in, in, in, in, in, in, out, out)
is semidet.
make_ground_inst_list_lives([], _, _, _, _, ModuleInfo, [], ModuleInfo).
make_ground_inst_list_lives([Inst0 | Insts0], Live, [ArgLive | ArgLives],
Uniq, Real, ModuleInfo0, [Inst | Insts], ModuleInfo) :-
( Live = live, ArgLive = live ->
BothLive = live
;
BothLive = dead
),
make_ground_inst(Inst0, BothLive, Uniq, Real, ModuleInfo0,
Inst, ModuleInfo1),
make_ground_inst_list_lives(Insts0, Live, ArgLives, Uniq, Real,
ModuleInfo1, Insts, ModuleInfo).
:- pred make_ground_inst_list(list(inst), is_live, uniqueness, unify_is_real,
module_info, list(inst), module_info).
:- mode make_ground_inst_list(in, in, in, in, in, out, out) is semidet.
make_ground_inst_list([], _, _, _, ModuleInfo, [], ModuleInfo).
make_ground_inst_list([Inst0 | Insts0], Live, Uniq, Real, ModuleInfo0,
[Inst | Insts], ModuleInfo) :-
make_ground_inst(Inst0, Live, Uniq, Real, ModuleInfo0,
Inst, ModuleInfo1),
make_ground_inst_list(Insts0, Live, Uniq, Real, ModuleInfo1,
Insts, ModuleInfo).
% abstractly unify an inst with `ground' and calculate the new inst
% and the determinism of the unification.
:- pred make_ground_inst(inst, is_live, uniqueness, unify_is_real, module_info,
inst, module_info).
:- mode make_ground_inst(in, in, in, in, in, out, out) is semidet.
make_ground_inst(not_reached, _, _, _, M, not_reached, M).
make_ground_inst(any(Uniq0), IsLive, Uniq1, Real, M, ground(Uniq, no), M) :-
unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq).
make_ground_inst(free, IsLive, Uniq0, Real, M, ground(Uniq, no), M) :-
unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq).
make_ground_inst(free(T), IsLive, Uniq0, Real, M,
defined_inst(typed_ground(Uniq, T)), M) :-
unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq).
make_ground_inst(bound(Uniq0, BoundInsts0), IsLive, Uniq1, Real, M0,
bound(Uniq, BoundInsts), M) :-
unify_uniq(dead, Real, semidet, Uniq0, Uniq1, Uniq),
make_ground_bound_inst_list(BoundInsts0, IsLive, Uniq1, Real, M0,
BoundInsts, M).
make_ground_inst(ground(Uniq0, _PredInst), _IsLive, Uniq1, Real, M,
ground(Uniq, no), M) :-
unify_uniq(dead, Real, semidet, Uniq0, Uniq1, Uniq).
make_ground_inst(inst_var(_), _, _, _, _, _, _) :-
error("free inst var").
make_ground_inst(abstract_inst(_,_), _, _, _, M, ground(shared, no), M).
make_ground_inst(defined_inst(InstName), IsLive, Uniq, Real, ModuleInfo0,
Inst, ModuleInfo) :-
% check whether the inst name is already in the
% ground_inst table
module_info_insts(ModuleInfo0, InstTable0),
inst_table_get_ground_insts(InstTable0, GroundInsts0),
GroundInstKey = ground_inst(InstName, IsLive, Uniq, Real),
(
map__search(GroundInsts0, GroundInstKey, Result)
->
( Result = known(GroundInst0) ->
GroundInst = GroundInst0
;
GroundInst = defined_inst(GroundInstKey)
),
ModuleInfo = ModuleInfo0
;
% insert the inst name in the ground_inst table, with
% value `unknown' for the moment
map__set(GroundInsts0, GroundInstKey, unknown, GroundInsts1),
inst_table_set_ground_insts(InstTable0, GroundInsts1,
InstTable1),
module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
% expand the inst name, and invoke ourself recursively on
% it's expansion
inst_lookup(ModuleInfo1, InstName, Inst0),
inst_expand(ModuleInfo1, Inst0, Inst1),
make_ground_inst(Inst1, IsLive, Uniq, Real, ModuleInfo1,
GroundInst, ModuleInfo2),
% now that we have determined the resulting Inst, store
% the appropriate value `known(GroundInst)' in the ground_inst
% table
module_info_insts(ModuleInfo2, InstTable2),
inst_table_get_ground_insts(InstTable2, GroundInsts2),
map__set(GroundInsts2, GroundInstKey, known(GroundInst),
GroundInsts),
inst_table_set_ground_insts(InstTable2, GroundInsts,
InstTable),
module_info_set_insts(ModuleInfo2, InstTable, ModuleInfo)
),
% avoid expanding recursive insts
( inst_contains_instname(GroundInst, ModuleInfo, GroundInstKey) ->
Inst = defined_inst(GroundInstKey)
;
Inst = GroundInst
).
:- pred make_ground_bound_inst_list(list(bound_inst), is_live, uniqueness,
unify_is_real, module_info, list(bound_inst), module_info).
:- mode make_ground_bound_inst_list(in, in, in, in, in, out, out) is semidet.
make_ground_bound_inst_list([], _, _, _, ModuleInfo, [], ModuleInfo).
make_ground_bound_inst_list([Bound0 | Bounds0], IsLive, Uniq, Real, ModuleInfo0,
[Bound | Bounds], ModuleInfo) :-
Bound0 = functor(ConsId, ArgInsts0),
make_ground_inst_list(ArgInsts0, IsLive, Uniq, Real, ModuleInfo0,
ArgInsts, ModuleInfo1),
Bound = functor(ConsId, ArgInsts),
make_ground_bound_inst_list(Bounds0, IsLive, Uniq, Real, ModuleInfo1,
Bounds, ModuleInfo).
%-----------------------------------------------------------------------------%
:- pred maybe_make_shared_inst_list(list(inst), list(is_live), module_info,
list(inst), module_info).
:- mode maybe_make_shared_inst_list(in, in, in, out, out) is det.
maybe_make_shared_inst_list([], [], ModuleInfo, [], ModuleInfo).
maybe_make_shared_inst_list([Inst0 | Insts0], [IsLive | IsLives], ModuleInfo0,
[Inst | Insts], ModuleInfo) :-
( IsLive = live ->
make_shared_inst(Inst0, ModuleInfo0, Inst, ModuleInfo1)
;
Inst = Inst0,
ModuleInfo1 = ModuleInfo0
),
maybe_make_shared_inst_list(Insts0, IsLives, ModuleInfo1,
Insts, ModuleInfo).
maybe_make_shared_inst_list([], [_|_], _, _, _) :-
error("maybe_make_shared_inst_list: length mismatch").
maybe_make_shared_inst_list([_|_], [], _, _, _) :-
error("maybe_make_shared_inst_list: length mismatch").
:- pred make_shared_inst_list(list(inst), module_info,
list(inst), module_info).
:- mode make_shared_inst_list(in, in, out, out) is det.
make_shared_inst_list([], ModuleInfo, [], ModuleInfo).
make_shared_inst_list([Inst0 | Insts0], ModuleInfo0,
[Inst | Insts], ModuleInfo) :-
make_shared_inst(Inst0, ModuleInfo0, Inst, ModuleInfo1),
make_shared_inst_list(Insts0, ModuleInfo1, Insts, ModuleInfo).
% make an inst shared; replace all occurrences of `unique' or `mostly_unique'
% in the inst with `shared'.
:- pred make_shared_inst(inst, module_info, inst, module_info).
:- mode make_shared_inst(in, in, out, out) is det.
make_shared_inst(not_reached, M, not_reached, M).
make_shared_inst(any(Uniq0), M, any(Uniq), M) :-
make_shared(Uniq0, Uniq).
make_shared_inst(free, M, free, M) :-
% the caller should ensure that this never happens
error("make_shared_inst: cannot make shared version of `free'").
make_shared_inst(free(T), M, free(T), M) :-
% 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), M0, bound(Uniq, BoundInsts), M) :-
make_shared(Uniq0, Uniq),
make_shared_bound_inst_list(BoundInsts0, M0, BoundInsts, M).
make_shared_inst(ground(Uniq0, PredInst), M, ground(Uniq, PredInst), M) :-
make_shared(Uniq0, Uniq).
make_shared_inst(inst_var(_), _, _, _) :-
error("free inst var").
make_shared_inst(abstract_inst(_,_), M, _, M) :-
error("make_shared_inst(abstract_inst)").
make_shared_inst(defined_inst(InstName), ModuleInfo0, Inst, ModuleInfo) :-
% check whether the inst name is already in the
% shared_inst table
module_info_insts(ModuleInfo0, InstTable0),
inst_table_get_shared_insts(InstTable0, SharedInsts0),
(
map__search(SharedInsts0, InstName, Result)
->
( Result = known(SharedInst0) ->
SharedInst = SharedInst0
;
SharedInst = defined_inst(InstName)
),
ModuleInfo = ModuleInfo0
;
% insert the inst name in the shared_inst table, with
% value `unknown' for the moment
map__set(SharedInsts0, InstName, unknown, SharedInsts1),
inst_table_set_shared_insts(InstTable0, SharedInsts1,
InstTable1),
module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
% expand the inst name, and invoke ourself recursively on
% it's expansion
inst_lookup(ModuleInfo1, InstName, Inst0),
inst_expand(ModuleInfo1, Inst0, Inst1),
make_shared_inst(Inst1, ModuleInfo1, SharedInst, ModuleInfo2),
% now that we have determined the resulting Inst, store
% the appropriate value `known(SharedInst)' in the shared_inst
% table
module_info_insts(ModuleInfo2, InstTable2),
inst_table_get_shared_insts(InstTable2, SharedInsts2),
map__set(SharedInsts2, InstName, known(SharedInst),
SharedInsts),
inst_table_set_shared_insts(InstTable2, SharedInsts,
InstTable),
module_info_set_insts(ModuleInfo2, InstTable, ModuleInfo)
),
% avoid expanding recursive insts
( inst_contains_instname(SharedInst, ModuleInfo, InstName) ->
Inst = defined_inst(InstName)
;
Inst = SharedInst
).
:- pred make_shared(uniqueness, uniqueness).
:- mode make_shared(in, out) is det.
make_shared(unique, shared).
make_shared(mostly_unique, shared).
make_shared(shared, shared).
make_shared(mostly_clobbered, mostly_clobbered).
make_shared(clobbered, clobbered).
:- pred make_shared_bound_inst_list(list(bound_inst), module_info,
list(bound_inst), module_info).
:- mode make_shared_bound_inst_list(in, in, out, out) is det.
make_shared_bound_inst_list([], ModuleInfo, [], ModuleInfo).
make_shared_bound_inst_list([Bound0 | Bounds0], ModuleInfo0,
[Bound | Bounds], ModuleInfo) :-
Bound0 = functor(ConsId, ArgInsts0),
make_shared_inst_list(ArgInsts0, ModuleInfo0,
ArgInsts, ModuleInfo1),
Bound = functor(ConsId, ArgInsts),
make_shared_bound_inst_list(Bounds0, ModuleInfo1,
Bounds, ModuleInfo).
%-----------------------------------------------------------------------------%
% make an inst mostly-uniq: replace all occurrences of `unique'
% in the inst with `mostly_unique'. (Used by unique_modes.m to
% change the insts of semidet-live or nondet-live insts.)
make_mostly_uniq_inst(not_reached, M, not_reached, M).
make_mostly_uniq_inst(any(Uniq0), M, any(Uniq), M) :-
make_mostly_uniq(Uniq0, Uniq).
make_mostly_uniq_inst(free, M, free, M).
make_mostly_uniq_inst(free(T), M, free(T), M).
make_mostly_uniq_inst(bound(Uniq0, BoundInsts0), M0, bound(Uniq, BoundInsts),
M) :-
% XXX could improve efficiency by avoiding recursion here
make_mostly_uniq(Uniq0, Uniq),
make_mostly_uniq_bound_inst_list(BoundInsts0, M0, BoundInsts, M).
make_mostly_uniq_inst(ground(Uniq0, PredInst), M, ground(Uniq, PredInst), M) :-
make_mostly_uniq(Uniq0, Uniq).
make_mostly_uniq_inst(inst_var(_), _, _, _) :-
error("free inst var").
make_mostly_uniq_inst(abstract_inst(_,_), M, _, M) :-
error("make_mostly_uniq_inst(abstract_inst)").
make_mostly_uniq_inst(defined_inst(InstName), ModuleInfo0, Inst, ModuleInfo) :-
% check whether the inst name is already in the
% mostly_uniq_inst table
module_info_insts(ModuleInfo0, InstTable0),
inst_table_get_mostly_uniq_insts(InstTable0, NondetLiveInsts0),
(
map__search(NondetLiveInsts0, InstName, Result)
->
( Result = known(NondetLiveInst0) ->
NondetLiveInst = NondetLiveInst0
;
NondetLiveInst = defined_inst(InstName)
),
ModuleInfo = ModuleInfo0
;
% insert the inst name in the mostly_uniq_inst table, with
% value `unknown' for the moment
map__set(NondetLiveInsts0, InstName, unknown, NondetLiveInsts1),
inst_table_set_mostly_uniq_insts(InstTable0, NondetLiveInsts1,
InstTable1),
module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
% expand the inst name, and invoke ourself recursively on
% it's expansion
inst_lookup(ModuleInfo1, InstName, Inst0),
inst_expand(ModuleInfo1, Inst0, Inst1),
make_mostly_uniq_inst(Inst1, ModuleInfo1, NondetLiveInst,
ModuleInfo2),
% now that we have determined the resulting Inst, store
% the appropriate value `known(NondetLiveInst)' in the
% mostly_uniq_inst table
module_info_insts(ModuleInfo2, InstTable2),
inst_table_get_mostly_uniq_insts(InstTable2, NondetLiveInsts2),
map__set(NondetLiveInsts2, InstName, known(NondetLiveInst),
NondetLiveInsts),
inst_table_set_mostly_uniq_insts(InstTable2, NondetLiveInsts,
InstTable),
module_info_set_insts(ModuleInfo2, InstTable, ModuleInfo)
),
% avoid expanding recursive insts
( inst_contains_instname(NondetLiveInst, ModuleInfo, InstName) ->
Inst = defined_inst(InstName)
;
Inst = NondetLiveInst
).
:- pred make_mostly_uniq(uniqueness, uniqueness).
:- mode make_mostly_uniq(in, out) is det.
make_mostly_uniq(unique, mostly_unique).
make_mostly_uniq(mostly_unique, mostly_unique).
make_mostly_uniq(shared, shared).
make_mostly_uniq(mostly_clobbered, mostly_clobbered).
make_mostly_uniq(clobbered, clobbered).
:- pred make_mostly_uniq_bound_inst_list(list(bound_inst), module_info,
list(bound_inst), module_info).
:- mode make_mostly_uniq_bound_inst_list(in, in, out, out) is det.
make_mostly_uniq_bound_inst_list([], ModuleInfo, [], ModuleInfo).
make_mostly_uniq_bound_inst_list([Bound0 | Bounds0], ModuleInfo0,
[Bound | Bounds], ModuleInfo) :-
Bound0 = functor(ConsId, ArgInsts0),
make_mostly_uniq_inst_list(ArgInsts0, ModuleInfo0,
ArgInsts, ModuleInfo1),
Bound = functor(ConsId, ArgInsts),
make_mostly_uniq_bound_inst_list(Bounds0, ModuleInfo1,
Bounds, ModuleInfo).
:- pred make_mostly_uniq_inst_list(list(inst), module_info,
list(inst), module_info).
:- mode make_mostly_uniq_inst_list(in, in, out, out) is det.
make_mostly_uniq_inst_list([], ModuleInfo, [], ModuleInfo).
make_mostly_uniq_inst_list([Inst0 | Insts0], ModuleInfo0,
[Inst | Insts], ModuleInfo) :-
make_mostly_uniq_inst(Inst0, ModuleInfo0, Inst, ModuleInfo1),
make_mostly_uniq_inst_list(Insts0, ModuleInfo1, Insts, ModuleInfo).
%-----------------------------------------------------------------------------%
% inst_merge(InstA, InstB, InstC):
% Combine the insts found in different arms of a
% disjunction (or if-then-else).
% The information in InstC is the minimum of the
% information in InstA and InstB. Where InstA and
% InstB specify a binding (free or bound), it must be
% the same in both.
inst_merge(InstA, InstB, ModuleInfo0, Inst, ModuleInfo) :-
% check whether this pair of insts is already in
% the merge_insts table
module_info_insts(ModuleInfo0, InstTable0),
inst_table_get_merge_insts(InstTable0, MergeInstTable0),
ThisInstPair = InstA - InstB,
( map__search(MergeInstTable0, ThisInstPair, Result) ->
ModuleInfo = ModuleInfo0,
( Result = known(MergedInst) ->
Inst0 = MergedInst
;
Inst0 = defined_inst(merge_inst(InstA, InstB))
)
;
% insert ThisInstPair into the table with value
%`unknown'
map__insert(MergeInstTable0, ThisInstPair, unknown,
MergeInstTable1),
inst_table_set_merge_insts(InstTable0, MergeInstTable1,
InstTable1),
module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
% merge the insts
inst_merge_2(InstA, InstB, ModuleInfo1, Inst0, ModuleInfo2),
% now update the value associated with ThisInstPair
module_info_insts(ModuleInfo2, InstTable2),
inst_table_get_merge_insts(InstTable2, MergeInstTable2),
map__set(MergeInstTable2, ThisInstPair, known(Inst0),
MergeInstTable3),
inst_table_set_merge_insts(InstTable2, MergeInstTable3,
InstTable3),
module_info_set_insts(ModuleInfo2, InstTable3, ModuleInfo)
),
% avoid expanding recursive insts
( inst_contains_instname(Inst0, ModuleInfo, merge_inst(InstA, InstB)) ->
Inst = defined_inst(merge_inst(InstA, InstB))
;
Inst = Inst0
).
:- pred inst_merge_2(inst, inst, module_info, inst, module_info).
:- mode inst_merge_2(in, in, in, out, out) is semidet.
inst_merge_2(InstA, InstB, ModuleInfo0, Inst, ModuleInfo) :-
/*********
% would this test improve efficiency??
( InstA = InstB ->
Inst = InstA,
ModuleInfo = ModuleInfo0
;
*********/
inst_expand(ModuleInfo0, InstA, InstA2),
inst_expand(ModuleInfo0, InstB, InstB2),
( InstB2 = not_reached ->
Inst = InstA2,
ModuleInfo = ModuleInfo0
;
inst_merge_3(InstA2, InstB2, ModuleInfo0, Inst, ModuleInfo)
).
:- pred inst_merge_3(inst, inst, module_info, inst, module_info).
:- mode inst_merge_3(in, in, in, out, out) is semidet.
inst_merge_3(any(UniqA), any(UniqB), M, any(Uniq), M) :-
merge_uniq(UniqA, UniqB, Uniq).
/* not yet:
inst_merge_3(any(Uniq), free, M, any(Uniq), M).
inst_merge_3(any(UniqA), bound(UniqB, ListB), M, any(Uniq), M) :-
merge_uniq_bound(UniqA, UniqB, ListB, ModuleInfo, Uniq),
inst_merge_3(any(UniqA), ground(UniqB, _), M, any(Uniq), M) :-
merge_uniq(UniqA, UniqB, Uniq).
inst_merge_3(any(UniqA), abstract_inst(_, _), M, any(Uniq), M) :-
merge_uniq(UniqA, shared, Uniq).
inst_merge_3(free, any(Uniq), M, any(Uniq), M).
inst_merge_3(bound(UniqA, ListA), any(UniqB), M, any(Uniq), M) :-
merge_uniq_bound(UniqB, UniqA, ListA, ModuleInfo, Uniq),
inst_merge_3(ground(UniqA, _), any(UniqB), M, any(Uniq), M) :-
merge_uniq(UniqA, UniqB).
inst_merge_3(abstract_inst(_, _), any(UniqB), M, any(Uniq), M) :-
merge_uniq(shared, UniqB, Uniq).
*/
inst_merge_3(free, free, M, free, M).
inst_merge_3(bound(UniqA, ListA), bound(UniqB, ListB), ModuleInfo0,
bound(Uniq, List), ModuleInfo) :-
merge_uniq(UniqA, UniqB, Uniq),
bound_inst_list_merge(ListA, ListB, ModuleInfo0, List, ModuleInfo).
inst_merge_3(bound(UniqA, ListA), ground(UniqB, _), ModuleInfo,
ground(Uniq, no), ModuleInfo) :-
merge_uniq_bound(UniqB, UniqA, ListA, ModuleInfo, Uniq),
bound_inst_list_is_ground(ListA, ModuleInfo).
inst_merge_3(ground(UniqA, _), bound(UniqB, ListB), ModuleInfo,
ground(Uniq, no), ModuleInfo) :-
merge_uniq_bound(UniqA, UniqB, ListB, ModuleInfo, Uniq),
bound_inst_list_is_ground(ListB, ModuleInfo).
inst_merge_3(ground(UniqA, MaybePredA), ground(UniqB, MaybePredB), ModuleInfo,
ground(Uniq, MaybePred), ModuleInfo) :-
(
MaybePredA = yes(PredA),
MaybePredB = yes(PredB)
->
% if they specify matching pred insts, but one is more
% precise (specifies more info) than the other,
% then we want to choose the least precise one
( pred_inst_matches(PredA, PredB, ModuleInfo) ->
MaybePred = yes(PredB)
; pred_inst_matches(PredB, PredA, ModuleInfo) ->
MaybePred = yes(PredA)
;
MaybePred = no
)
;
MaybePred = no
),
merge_uniq(UniqA, UniqB, Uniq).
inst_merge_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
ModuleInfo0, abstract_inst(Name, Args), ModuleInfo) :-
inst_list_merge(ArgsA, ArgsB, ModuleInfo0, Args, ModuleInfo).
inst_merge_3(not_reached, Inst, M, Inst, M).
:- pred merge_uniq(uniqueness, uniqueness, uniqueness).
:- mode merge_uniq(in, in, out) is det.
% merge_uniq(A, B, C) succeeds if C is minimum of A and B in
% the ordering
% clobbered < mostly_clobbered < shared < mostly_unique < unique
merge_uniq(UniqA, UniqB, Merged) :-
( unique_matches_initial(UniqA, UniqB) -> % A >= B
Merged = UniqB
;
Merged = UniqA
).
% merge_uniq_bound(UniqA, UniqB, ListB, ModuleInfo, Uniq) succeeds iff
% Uniq is the result of merging
:- pred merge_uniq_bound(uniqueness, uniqueness, list(bound_inst), module_info,
uniqueness).
:- mode merge_uniq_bound(in, in, in, in, out) is det.
merge_uniq_bound(UniqA, UniqB, ListB, ModuleInfo, Uniq) :-
merge_uniq(UniqA, UniqB, Uniq0),
set__init(Expansions),
merge_bound_inst_list_uniq(ListB, Uniq0, ModuleInfo, Expansions, Uniq).
:- pred merge_bound_inst_list_uniq(list(bound_inst), uniqueness, module_info,
set(inst_name), uniqueness).
:- mode merge_bound_inst_list_uniq(in, in, in, in, out) is det.
merge_bound_inst_list_uniq([], Uniq, _, _, Uniq).
merge_bound_inst_list_uniq([BoundInst | BoundInsts], Uniq0,
ModuleInfo, Expansions, Uniq) :-
BoundInst = functor(_ConsId, ArgInsts),
merge_inst_list_uniq(ArgInsts, Uniq0, ModuleInfo, Expansions, Uniq1),
merge_bound_inst_list_uniq(BoundInsts, Uniq1, ModuleInfo, Expansions,
Uniq).
:- pred merge_inst_list_uniq(list(inst), uniqueness, module_info,
set(inst_name), uniqueness).
:- mode merge_inst_list_uniq(in, in, in, in, out) is det.
merge_inst_list_uniq([], Uniq, _, _, Uniq).
merge_inst_list_uniq([Inst | Insts], Uniq0, ModuleInfo, Expansions, Uniq) :-
merge_inst_uniq(Inst, Uniq0, ModuleInfo, Expansions, Uniq1),
merge_inst_list_uniq(Insts, Uniq1, ModuleInfo, Expansions, Uniq).
:- pred merge_inst_uniq(inst, uniqueness, module_info, set(inst_name),
uniqueness).
:- mode merge_inst_uniq(in, in, in, in, out) is det.
merge_inst_uniq(any(UniqA), UniqB, _, _, Uniq) :-
merge_uniq(UniqA, UniqB, Uniq).
merge_inst_uniq(free, Uniq, _, _, Uniq).
merge_inst_uniq(free(_), Uniq, _, _, Uniq).
merge_inst_uniq(bound(UniqA, ListA), UniqB, ModuleInfo, Expansions, Uniq) :-
merge_uniq(UniqA, UniqB, Uniq0),
merge_bound_inst_list_uniq(ListA, Uniq0, ModuleInfo, Expansions, Uniq).
merge_inst_uniq(ground(UniqA, _), UniqB, _, _, Uniq) :-
merge_uniq(UniqA, UniqB, Uniq).
merge_inst_uniq(abstract_inst(_,_), UniqB, _, _, Uniq) :-
merge_uniq(shared, UniqB, Uniq).
merge_inst_uniq(defined_inst(InstName), UniqB, ModuleInfo, Expansions,
Uniq) :-
( set__member(InstName, Expansions) ->
Uniq = UniqB
;
set__insert(Expansions, InstName, Expansions1),
inst_lookup(ModuleInfo, InstName, Inst),
merge_inst_uniq(Inst, UniqB, ModuleInfo, Expansions1, Uniq)
).
merge_inst_uniq(not_reached, Uniq, _, _, Uniq).
merge_inst_uniq(inst_var(_), _, _, _, _) :-
error("merge_inst_uniq: unexpected inst_var").
%-----------------------------------------------------------------------------%
:- pred inst_list_merge(list(inst), list(inst), module_info, list(inst),
module_info).
:- mode inst_list_merge(in, in, in, out, out) is semidet.
inst_list_merge([], [], ModuleInfo, [], ModuleInfo).
inst_list_merge([ArgA | ArgsA], [ArgB | ArgsB], ModuleInfo0,
[Arg | Args], ModuleInfo) :-
inst_merge(ArgA, ArgB, ModuleInfo0, Arg, ModuleInfo1),
inst_list_merge(ArgsA, ArgsB, ModuleInfo1, Args, ModuleInfo).
% bound_inst_list_merge(Xs, Ys, ModuleInfo0, Zs, ModuleInfo):
% The two input lists Xs and Ys must already be sorted.
% Here we perform a sorted merge operation,
% so that the functors of the output list Zs are the union
% of the functors of the input lists Xs and Ys.
:- pred bound_inst_list_merge(list(bound_inst), list(bound_inst),
module_info, list(bound_inst), module_info).
:- mode bound_inst_list_merge(in, in, in, out, out) is semidet.
bound_inst_list_merge(Xs, Ys, ModuleInfo0, Zs, ModuleInfo) :-
( Xs = [] ->
Zs = Ys,
ModuleInfo = ModuleInfo0
; Ys = [] ->
Zs = Xs,
ModuleInfo = ModuleInfo0
;
Xs = [X | Xs1],
Ys = [Y | Ys1],
X = functor(ConsIdX, ArgsX),
Y = functor(ConsIdY, ArgsY),
( ConsIdX = ConsIdY ->
inst_list_merge(ArgsX, ArgsY, ModuleInfo0,
Args, ModuleInfo1),
Z = functor(ConsIdX, Args),
Zs = [Z | Zs1],
bound_inst_list_merge(Xs1, Ys1, ModuleInfo1,
Zs1, ModuleInfo)
; compare(<, ConsIdX, ConsIdY) ->
Zs = [X | Zs1],
bound_inst_list_merge(Xs1, Ys, ModuleInfo0,
Zs1, ModuleInfo)
;
Zs = [Y | Zs1],
bound_inst_list_merge(Xs, Ys1, ModuleInfo0,
Zs1, ModuleInfo)
)
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
More information about the developers
mailing list