[m-rev.] for review: inst_results
Zoltan Somogyi
zs at unimelb.edu.au
Wed Apr 18 13:35:42 AEST 2012
For review by anyone. However, the best way to review this diff is
not to read it. The best way is to apply the patch in a workspace,
rename the bound/3 functor of mer_inst in prog_data.m to something else,
compile the compiler, and look at the sites of all the error messages,
since this will be all the places where the compiler deals with bound/3
insts.
Zoltan.
A large part of the cost of a large ground term is incurred not when the
term is constructed, but when it is used. The inst of the term will be huge,
and will typically have to be traversed many times. Some of those traversals
would be linear if not for the fact that, in order to avoid infinite loops
on recursive insts, the predicate doing the traversal has to keep a set
of the insts visited so far. When the traversal is in the middle of the ground
term's inst, it is looking up that inst in a set of the insts of its containing
terms all the way up to the root. When the ground term contains a list with
many repeated elements near the start, the cost of the traversal is cubic
in the length of the list: a linear number of set membership tests, each
of which tests the current inst against a linear number of large insts,
the test itself being linear.
This diff aims to totally sidestep all that. It extends the mer_inst type
to allow (but not require) the creator of an inst to record what the outcome
of some tests on the inst would be. Is it ground? Does it contain "any"?
What inst names and types may it contain? If the creator records this answer,
which the code that creates ground terms does, then many tests will now run
in CONSTANT time, not linear, quadratic or cubic.
We do this only for bound insts. While the concept can apply to all insts,
for small insts it can cost more to interpret the results term than to
do the test directly. Insts cannot be large without being composed mostly
of bound insts, so by recording this info only for bound insts, we can
speed up the handling of all large insts.
This also has the side benefit that in many cases, a traversal that operates
on an inst will often do so in order to compute an updated version of that
inst. In many cases, the updated version is the same as the original version,
but since the traversal has to be prepared for updates, it makes a copy
of the inst anyway. The result of the traversal is thus an inst that has
the same value as the original inst but not the same address. This makes
it useless to try to do equality checks of related insts in constant time
by looking at the pointers. With this diff, many such traversals can be
avoided, allowing the updated inst to keept the address as well as the value
of the corresponding original inst.
Without this diff, the compiler takes more than 10 seconds to compile
zm_rcpsp_cpx.m, with most of that time being spent in mode checking.
With this diff, it takes less than 5 seconds. Basically, mode checking
went from 6+ seconds to 1. The profile of the compiler is now flat on this
input; no single pass takes much more time than the others.
The speed of the compiler is unaffected on tools/speedtest. (Actually, it
gets a very slight speedup, but it is in the noise.)
compiler/prog_data.m:
Change the bound/2 functor of the mer_inst type to bound/3, adding
a field that gives the outcome of some common tests performed on insts.
When we attach insts to the variables representing parts of ground
terms, we mark the insts accordingly. This allows us to perform many
tests on insts in constant time, not in a time that is linear,
quadratic or worse in the size of the inst.
compiler/add_pragma.m:
compiler/const_prop.m:
compiler/distance_granularity.m:
compiler/equiv_type_hlds.m:
compiler/float_regs.m:
compiler/hlds_code_util.m:
compiler/hlds_goal.m:
compiler/inst_check.m:
compiler/inst_match.m:
compiler/inst_util.m:
compiler/lco.m:
compiler/mercury_to_mercury.m:
compiler/mode_constraints.m:
compiler/mode_debug.m:
compiler/mode_util.m:
compiler/modecheck_goal.m:
compiler/modecheck_unify.m:
compiler/modecheck_util.m:
compiler/module_qual.m:
compiler/pd_util.m:
compiler/polymorphism.m:
compiler/prog_io.m:
compiler/prog_io_util.m:
compiler/prog_mode.m:
compiler/prog_util.m:
compiler/recompilation.usage.m:
compiler/recompilation.version.m:
compiler/simplify.m:
compiler/try_expand.m:
compiler/unique_modes.m:
compiler/unused_imports.m:
compiler/xml_documentation.m:
Conform to the above change.
Obviously, this required the modification of most predicates dealing
with insts. Where the original predicates used multiple clauses,
inconsistent variable names and/or bad grouping or ordering of code,
this diff fixes that.
More to the point, while in many places, the new code ignores the new
field in input insts as either not relevant or not useful, in several
places, the new code
- pays attention to this field in input insts and executes less or
faster code if the result of some test it needs is already available
in it, or
- fills in the field in insts it generates as output.
Most, but not all, of changes in the first of those two categories
were in inst_util.m and inst_match.m.
compiler/hlds_out_mode.m:
When writing out insts, or converting them to term form as the first
step in printing them out, print the new field if we are generating
debug output (such as a HLDS dump), but do not do so if we are
generating actual Mercury code (such as a .opt file).
Reorder the arguments of many predicates to move the context argument
BEFORE the argument representing the object to be printed or converted
to a term, since this allows us to use list.map on lists of such
objects.
compiler/hlds_out_util.m:
Define a type that allows us to distinguish between the two.
compiler/hlds_out_goal.m:
compiler/hlds_out_module.m:
compiler/hlds_out_pred.m:
Thread values of this flag type through a bunch of predicates
as needed.
compiler/intermod.m:
Specify output_mercury when writing clauses for optimization files.
This is needed because mode-specific clauses can have insts in their
heads. (The mode declarations in .int* files are written out by
a separate set of predicates, in mercury_to_mercury.m, which ALWAYS
ignore the new field.)
compiler/prog_util.m:
There were two predicates named construct_qualified_term, with
different arities: one took a context, the other didn't. Rename
the former to avoid the ambiguity.
compiler/goal_expr_to_goal.m:
Conform to the change to prog_util.m.
compiler/prog_io.m:
There were two predicates named constrain_inst_vars_in_mode;
rename one.
Add an XXX about why they are here in the first place.
compiler/format_call.m:
Give some type and field names prefixes to avoid some ambiguities.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/extra
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/extra
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/doc
cvs diff: Diffing boehm_gc/libatomic_ops/src
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/armcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops/tests
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/m4
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.126
diff -u -b -r1.126 add_pragma.m
--- compiler/add_pragma.m 16 Apr 2012 10:49:05 -0000 1.126
+++ compiler/add_pragma.m 17 Apr 2012 01:42:53 -0000
@@ -3608,60 +3608,73 @@
map(inst_var, inst_var)::out) is semidet.
match_insts_with_renaming(ModuleInfo, InstA, InstB, Renaming) :-
+ (
+ InstA = not_reached,
+ InstB = not_reached,
+ map.init(Renaming)
+ ;
+ InstA = free,
+ InstB = free,
+ map.init(Renaming)
+ ;
+ InstA = free(Type),
+ InstB = free(Type),
+ map.init(Renaming)
+ ;
InstA = any(Uniq, HOInstInfoA),
InstB = any(Uniq, HOInstInfoB),
match_ho_inst_infos_with_renaming(ModuleInfo, HOInstInfoA, HOInstInfoB,
- Renaming).
-match_insts_with_renaming(_, free, free, map.init).
-match_insts_with_renaming(_, free(Type), free(Type), map.init).
-match_insts_with_renaming(ModuleInfo, InstA, InstB, Renaming) :-
- InstA = bound(Uniq, BoundInstsA),
- InstB = bound(Uniq, BoundInstsB),
- match_corresponding_bound_inst_lists_with_renaming(ModuleInfo,
- BoundInstsA, BoundInstsB, map.init, Renaming).
-match_insts_with_renaming(ModuleInfo, InstA, InstB, Renaming) :-
+ Renaming)
+ ;
InstA = ground(Uniq, HOInstInfoA),
InstB = ground(Uniq, HOInstInfoB),
match_ho_inst_infos_with_renaming(ModuleInfo, HOInstInfoA, HOInstInfoB,
- Renaming).
-match_insts_with_renaming(_, not_reached, not_reached, map.init).
-match_insts_with_renaming(_, inst_var(VarA), inst_var(VarB), Subst) :-
- map.insert(VarA, VarB, map.init, Subst).
-match_insts_with_renaming(ModuleInfo, InstA, InstB, Subst) :-
+ Renaming)
+ ;
+ InstA = bound(Uniq, _, BoundInstsA),
+ InstB = bound(Uniq, _, BoundInstsB),
+ match_corresponding_bound_inst_lists_with_renaming(ModuleInfo,
+ BoundInstsA, BoundInstsB, map.init, Renaming)
+ ;
+ InstA = inst_var(VarA),
+ InstB = inst_var(VarB),
+ Renaming = map.singleton(VarA, VarB)
+ ;
InstA = constrained_inst_vars(InstVarSetA, SpecInstA),
InstB = constrained_inst_vars(InstVarSetB, SpecInstB),
- %
- % We'll deal with the specified inst first.
- %
- match_insts_with_renaming(ModuleInfo, SpecInstA, SpecInstB,
- Subst0),
+
+ % We will deal with the specified inst first.
+ match_insts_with_renaming(ModuleInfo, SpecInstA, SpecInstB, Renaming0),
ListVarA = set.to_sorted_list(InstVarSetA),
ListVarB = set.to_sorted_list(InstVarSetB),
(
- ListVarA = [VarA0], ListVarB = [VarB0]
+ ListVarA = [VarA0],
+ ListVarB = [VarB0]
->
VarA = VarA0,
VarB = VarB0
;
unexpected($module, $pred, "non-singleton sets")
),
- ( map.search(Subst0, VarA, SpecVarB) ->
- % If VarA was already in the renaming then check that it's consistent
- % with the renaming from the set of inst vars.
+ ( map.search(Renaming0, VarA, SpecVarB) ->
+ % If VarA was already in the renaming then check that it is
+ % consistent with the renaming from the set of inst vars.
VarB = SpecVarB,
- Subst = Subst0
+ Renaming = Renaming0
+ ;
+ map.insert(VarA, VarB, Renaming0, Renaming)
+ )
;
- map.insert(VarA, VarB, Subst0, Subst)
- ).
-match_insts_with_renaming(ModuleInfo, InstA, InstB, Renaming) :-
InstA = defined_inst(InstNameA),
InstB = defined_inst(InstNameB),
- match_inst_names_with_renaming(ModuleInfo, InstNameA, InstNameB, Renaming).
-match_insts_with_renaming(ModuleInfo, InstA, InstB, Renaming) :-
+ match_inst_names_with_renaming(ModuleInfo, InstNameA, InstNameB,
+ Renaming)
+ ;
InstA = abstract_inst(Name, ArgsA),
InstB = abstract_inst(Name, ArgsB),
match_corresponding_inst_lists_with_renaming(ModuleInfo, ArgsA, ArgsB,
- map.init, Renaming).
+ map.init, Renaming)
+ ).
:- pred match_ho_inst_infos_with_renaming(module_info::in, ho_inst_info::in,
ho_inst_info::in, map(inst_var, inst_var)::out) is semidet.
Index: compiler/const_prop.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/const_prop.m,v
retrieving revision 1.49
diff -u -b -r1.49 const_prop.m
--- compiler/const_prop.m 25 Jul 2011 05:46:02 -0000 1.49
+++ compiler/const_prop.m 16 Apr 2012 11:55:29 -0000
@@ -199,47 +199,47 @@
(
ProcName = "+",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
OutputArg = Y,
OutputArgVal = XVal
;
ProcName = "-",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
OutputArg = Y,
OutputArgVal = -XVal
;
ProcName = "\\",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
OutputArg = Y,
OutputArgVal = \ XVal
;
ProcName = "floor_to_multiple_of_bits_per_int",
ModeNum = 0,
CrossCompiling = no,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
OutputArg = Y,
OutputArgVal = int.floor_to_multiple_of_bits_per_int(XVal)
;
ProcName = "quot_bits_per_int",
ModeNum = 0,
CrossCompiling = no,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
OutputArg = Y,
OutputArgVal = int.quot_bits_per_int(XVal)
;
ProcName = "times_bits_per_int",
ModeNum = 0,
CrossCompiling = no,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
OutputArg = Y,
OutputArgVal = int.times_bits_per_int(XVal)
;
ProcName = "rem_bits_per_int",
ModeNum = 0,
CrossCompiling = no,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
OutputArg = Y,
OutputArgVal = int.rem_bits_per_int(XVal)
).
@@ -253,13 +253,13 @@
(
ProcName = "+",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(float_const(XVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(float_const(XVal), [])]),
OutputArg = Y,
OutputArgVal = XVal
;
ProcName = "-",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(float_const(XVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(float_const(XVal), [])]),
OutputArg = Y,
OutputArgVal = -XVal
).
@@ -273,160 +273,160 @@
(
ProcName = "plus",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = XVal + YVal
;
ProcName = "+",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = XVal + YVal
;
ProcName = "+",
ModeNum = 1,
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
- Z ^ arg_inst = bound(_, [bound_functor(int_const(ZVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
+ Z ^ arg_inst = bound(_, _, [bound_functor(int_const(ZVal), [])]),
OutputArg = X,
OutputArgVal = ZVal - YVal
;
ProcName = "+",
ModeNum = 2,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Z ^ arg_inst = bound(_, [bound_functor(int_const(ZVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Z ^ arg_inst = bound(_, _, [bound_functor(int_const(ZVal), [])]),
OutputArg = Y,
OutputArgVal = ZVal - XVal
;
ProcName = "minus",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = XVal - YVal
;
ProcName = "-",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = XVal - YVal
;
ProcName = "-",
ModeNum = 1,
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
- Z ^ arg_inst = bound(_, [bound_functor(int_const(ZVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
+ Z ^ arg_inst = bound(_, _, [bound_functor(int_const(ZVal), [])]),
OutputArg = X,
OutputArgVal = YVal + ZVal
;
ProcName = "-",
ModeNum = 2,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Z ^ arg_inst = bound(_, [bound_functor(int_const(ZVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Z ^ arg_inst = bound(_, _, [bound_functor(int_const(ZVal), [])]),
OutputArg = Y,
OutputArgVal = XVal - ZVal
;
ProcName = "times",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = XVal * YVal
;
ProcName = "*",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = XVal * YVal
;
ProcName = "unchecked_quotient",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
YVal \= 0,
OutputArg = Z,
OutputArgVal = unchecked_quotient(XVal, YVal)
;
ProcName = "//",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
YVal \= 0,
OutputArg = Z,
OutputArgVal = XVal // YVal
;
ProcName = "mod",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
YVal \= 0,
OutputArg = Z,
OutputArgVal = XVal mod YVal
;
ProcName = "rem",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
YVal \= 0,
OutputArg = Z,
OutputArgVal = XVal rem YVal
;
ProcName = "unchecked_rem",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
YVal \= 0,
OutputArg = Z,
OutputArgVal = unchecked_rem(XVal, YVal)
;
ProcName = "unchecked_left_shift",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = unchecked_left_shift(XVal, YVal)
;
ProcName = "<<",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = XVal << YVal
;
ProcName = "unchecked_right_shift",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = unchecked_right_shift(XVal, YVal)
;
ProcName = ">>",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = XVal >> YVal
;
ProcName = "/\\",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = XVal /\ YVal
;
ProcName = "\\/",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = XVal \/ YVal
;
ProcName = "xor",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = xor(XVal, YVal)
).
@@ -440,37 +440,37 @@
(
ProcName = "+",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(float_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(float_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(float_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(float_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = XVal + YVal
;
ProcName = "-",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(float_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(float_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(float_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(float_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = XVal - YVal
;
ProcName = "*",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(float_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(float_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(float_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(float_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = XVal * YVal
;
ProcName = "/",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(float_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(float_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(float_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(float_const(YVal), [])]),
OutputArg = Z,
YVal \= 0.0,
OutputArgVal = XVal / YVal
;
ProcName = "unchecked_quotient",
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(float_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(float_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(float_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(float_const(YVal), [])]),
OutputArg = Z,
YVal \= 0.0,
OutputArgVal = unchecked_quotient(XVal, YVal)
@@ -490,8 +490,8 @@
% the mode number and pick up both the predicate and function versions
% of append).
ModeNum = 0,
- X ^ arg_inst = bound(_, [bound_functor(string_const(XVal), [])]),
- Y ^ arg_inst = bound(_, [bound_functor(string_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(string_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(string_const(YVal), [])]),
OutputArg = Z,
OutputArgVal = XVal ++ YVal
).
@@ -517,8 +517,8 @@
evaluate_test("int", "<", 0, Args, Result) :-
Args = [X, Y],
- X ^ arg_inst = bound(_XUniq, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_YUniq, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
( XVal < YVal ->
Result = yes
;
@@ -526,8 +526,8 @@
).
evaluate_test("int", "=<", 0, Args, Result) :-
Args = [X, Y],
- X ^ arg_inst = bound(_XUniq, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_YUniq, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
( XVal =< YVal ->
Result = yes
;
@@ -535,8 +535,8 @@
).
evaluate_test("int", ">", 0, Args, Result) :-
Args = [X, Y],
- X ^ arg_inst = bound(_XUniq, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_YUniq, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
( XVal > YVal ->
Result = yes
;
@@ -544,8 +544,8 @@
).
evaluate_test("int", ">=", 0, Args, Result) :-
Args = [X, Y],
- X ^ arg_inst = bound(_XUniq, [bound_functor(int_const(XVal), [])]),
- Y ^ arg_inst = bound(_YUniq, [bound_functor(int_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(int_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(int_const(YVal), [])]),
( XVal >= YVal ->
Result = yes
;
@@ -556,8 +556,8 @@
evaluate_test("float", "<", 0, Args, Result) :-
Args = [X, Y],
- X ^ arg_inst = bound(_XUniq, [bound_functor(float_const(XVal), [])]),
- Y ^ arg_inst = bound(_YUniq, [bound_functor(float_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(float_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(float_const(YVal), [])]),
( XVal < YVal ->
Result = yes
;
@@ -565,8 +565,8 @@
).
evaluate_test("float", "=<", 0, Args, Result) :-
Args = [X, Y],
- X ^ arg_inst = bound(_XUniq, [bound_functor(float_const(XVal), [])]),
- Y ^ arg_inst = bound(_YUniq, [bound_functor(float_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(float_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(float_const(YVal), [])]),
( XVal =< YVal ->
Result = yes
;
@@ -574,8 +574,8 @@
).
evaluate_test("float", ">", 0, Args, Result) :-
Args = [X, Y],
- X ^ arg_inst = bound(_XUniq, [bound_functor(float_const(XVal), [])]),
- Y ^ arg_inst = bound(_YUniq, [bound_functor(float_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(float_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(float_const(YVal), [])]),
( XVal > YVal ->
Result = yes
;
@@ -583,8 +583,8 @@
).
evaluate_test("float", ">=", 0, Args, Result) :-
Args = [X, Y],
- X ^ arg_inst = bound(_XUniq, [bound_functor(float_const(XVal), [])]),
- Y ^ arg_inst = bound(_YUniq, [bound_functor(float_const(YVal), [])]),
+ X ^ arg_inst = bound(_, _, [bound_functor(float_const(XVal), [])]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(float_const(YVal), [])]),
( XVal >= YVal ->
Result = yes
;
@@ -665,8 +665,8 @@
->
Result = yes
;
- X ^ arg_inst = bound(_, [bound_functor(XCtor, XArgVars)]),
- Y ^ arg_inst = bound(_, [bound_functor(YCtor, YArgVars)])
+ X ^ arg_inst = bound(_, _, [bound_functor(XCtor, XArgVars)]),
+ Y ^ arg_inst = bound(_, _, [bound_functor(YCtor, YArgVars)])
->
( XCtor = YCtor, XArgVars = YArgVars ->
Result = yes
@@ -702,8 +702,8 @@
make_construction_goal(OutputArg, Cons, Goal, !GoalInfo) :-
make_construction(OutputArg, Cons, Goal),
Delta0 = goal_info_get_instmap_delta(!.GoalInfo),
- instmap_delta_set_var(OutputArg ^ arg_var,
- bound(unique, [bound_functor(Cons, [])]), Delta0, Delta),
+ Inst = bound(unique, inst_test_results_fgtc, [bound_functor(Cons, [])]),
+ instmap_delta_set_var(OutputArg ^ arg_var, Inst, Delta0, Delta),
goal_info_set_instmap_delta(Delta, !GoalInfo),
goal_info_set_determinism(detism_det, !GoalInfo).
Index: compiler/distance_granularity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/distance_granularity.m,v
retrieving revision 1.18
diff -u -b -r1.18 distance_granularity.m
--- compiler/distance_granularity.m 13 Feb 2012 00:11:36 -0000 1.18
+++ compiler/distance_granularity.m 16 Apr 2012 16:57:23 -0000
@@ -585,7 +585,7 @@
% Var has instmap bound(Distance).
InstMapDelta0 = goal_info_get_instmap_delta(GoalInfo0),
- MerInst = bound(shared,
+ MerInst = bound(shared, inst_test_results_fgtc,
[bound_functor(int_const(Distance), [])]),
instmap_delta_insert_var(Var, MerInst,
InstMapDelta0, InstMapDelta),
@@ -705,8 +705,8 @@
set_of_var.list_to_set([GranularityVar, Var, VarResult],
NonLocals),
VarResultDelta = VarResult - ground(unique, none),
- VarDelta = Var - bound(shared, [bound_functor(int_const(1),
- [])]),
+ VarDelta = Var - bound(shared, inst_test_results_fgtc,
+ [bound_functor(int_const(1), [])]),
InstMapDeltaDecrement = instmap_delta_from_assoc_list(
[VarDelta, VarResultDelta]),
Detism = detism_det,
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.72
diff -u -b -r1.72 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m 27 Mar 2012 23:21:27 -0000 1.72
+++ compiler/equiv_type_hlds.m 16 Apr 2012 10:41:38 -0000
@@ -701,7 +701,28 @@
),
MayOccur = yes
;
- Inst = bound(_, BoundInsts),
+ Inst = bound(_, InstResults, BoundInsts),
+ (
+ InstResults = inst_test_results_fgtc,
+ MayOccur = no
+ ;
+ (
+ InstResults = inst_test_results(_, _, _, TypeResult)
+ ;
+ InstResults = inst_test_no_results,
+ TypeResult = inst_result_contains_types_unknown
+ ),
+ (
+ TypeResult = inst_result_contains_types_known(TypeCtors),
+ ( set.is_empty(TypeCtors) ->
+ MayOccur = no
+ ;
+ MayOccur = yes
+ )
+ ;
+ TypeResult = inst_result_contains_types_unknown,
+ % XXX Do we still need this cache, or are things now
+ % fast enough without it?
promise_pure (
semipure lookup_inst_may_occur(Inst, Found, OldMayOccur),
(
@@ -713,6 +734,8 @@
impure record_inst_may_occur(Inst, MayOccur)
)
)
+ )
+ )
;
Inst = abstract_inst(_, ArgInsts),
MayOccur = type_may_occur_in_insts(ArgInsts)
@@ -875,12 +898,47 @@
; Changed = no, Inst = Inst0
)
;
- Inst0 = bound(Uniq, BoundInsts0),
+ Inst0 = bound(Uniq, InstResults0, BoundInsts0),
+ (
+ InstResults0 = inst_test_results(GroundnessResult, AnyResult,
+ InstNamesResult, TypeResult),
+ (
+ TypeResult = inst_result_contains_types_unknown,
+ NeedReplace = yes(InstResults0)
+ ;
+ TypeResult = inst_result_contains_types_known(TypeCtors),
+ % XXX We could test the intersection of TypeCtors with
+ % the key set of EqvMap. That test would be more expensive,
+ % but could possibly avoid a costly traversal of BoundInsts0.
+ ( set.is_empty(TypeCtors) ->
+ NeedReplace = no
+ ;
+ NeedReplace = yes(inst_test_results(GroundnessResult,
+ AnyResult, InstNamesResult,
+ inst_result_contains_types_unknown))
+ )
+ )
+ ;
+ InstResults0 = inst_test_results_fgtc,
+ NeedReplace = no
+ ;
+ InstResults0 = inst_test_no_results,
+ NeedReplace = yes(InstResults0)
+ ),
+ (
+ NeedReplace = no,
+ Changed = no,
+ Inst = Inst0
+ ;
+ NeedReplace = yes(InstResults),
replace_in_bound_insts(EqvMap, BoundInsts0, BoundInsts, Changed,
!TVarSet, !Cache),
- ( Changed = yes, Inst = bound(Uniq, BoundInsts)
+ % We could try to figure out the set of type_ctors in BoundInsts,
+ % but that info may never be needed again.
+ ( Changed = yes, Inst = bound(Uniq, InstResults, BoundInsts)
; Changed = no, Inst = Inst0
)
+ )
;
Inst0 = ground(Uniq, higher_order(PredInstInfo0)),
PredInstInfo0 = pred_inst_info(PorF, Modes0, MaybeArgRegs, Det),
Index: compiler/float_regs.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/float_regs.m,v
retrieving revision 1.1
diff -u -b -r1.1 float_regs.m
--- compiler/float_regs.m 13 Feb 2012 00:11:37 -0000 1.1
+++ compiler/float_regs.m 16 Apr 2012 11:47:14 -0000
@@ -353,10 +353,10 @@
),
Inst = any(Uniq, higher_order(PredInstInfo))
;
- Inst0 = bound(Uniq, BoundInsts0),
+ Inst0 = bound(Uniq, InstResults, BoundInsts0),
list.map(add_arg_regs_in_bound_inst(ModuleInfo, Seen0, Type),
BoundInsts0, BoundInsts),
- Inst = bound(Uniq, BoundInsts)
+ Inst = bound(Uniq, InstResults, BoundInsts)
;
Inst0 = constrained_inst_vars(InstVarSet, SpecInst0),
add_arg_regs_in_inst(ModuleInfo, Seen0, Type, SpecInst0, SpecInst),
@@ -915,10 +915,10 @@
rebuild_cell_inst(ModuleInfo, InstMap, ConsId, Args, Inst0, Inst) :-
(
- Inst0 = bound(Uniq, BoundInsts0),
+ Inst0 = bound(Uniq, InstResults, BoundInsts0),
list.map(rebuild_cell_bound_inst(InstMap, ConsId, Args),
BoundInsts0, BoundInsts),
- Inst = bound(Uniq, BoundInsts)
+ Inst = bound(Uniq, InstResults, BoundInsts)
;
(
Inst0 = ground(Uniq, higher_order(PredInstInfo0))
Index: compiler/format_call.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/format_call.m,v
retrieving revision 1.30
diff -u -b -r1.30 format_call.m
--- compiler/format_call.m 16 Apr 2012 08:13:18 -0000 1.30
+++ compiler/format_call.m 16 Apr 2012 10:24:01 -0000
@@ -211,17 +211,17 @@
% Maps each variable defined in terms of another variable to the variable
% it is assigned from.
-:- type eqv_map == map(prog_var, prog_var).
+:- type fc_eqv_map == map(prog_var, prog_var).
% The knowledge we have recorded from assign and construct unifications in
% a given conjunction.
%
:- type conj_map
---> conj_map(
- string_map :: string_map,
- list_skeleton_map :: list_skeleton_map,
- list_element_map :: list_element_map,
- eqv_map :: eqv_map
+ cm_string_map :: string_map,
+ cm_list_skeleton_map :: list_skeleton_map,
+ cm_list_element_map :: list_element_map,
+ cm_eqv_map :: fc_eqv_map
).
:- type conj_id
Index: compiler/goal_expr_to_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_expr_to_goal.m,v
retrieving revision 1.6
diff -u -b -r1.6 goal_expr_to_goal.m
--- compiler/goal_expr_to_goal.m 16 Apr 2012 08:13:18 -0000 1.6
+++ compiler/goal_expr_to_goal.m 17 Apr 2012 07:28:45 -0000
@@ -1225,8 +1225,8 @@
:- func exception_functor(string, prog_term, term.context) = prog_term.
exception_functor(Atom, Arg, Context) = Term :-
- construct_qualified_term(qualified(mercury_exception_module, Atom),
- [Arg], Context, Term).
+ SymName = qualified(mercury_exception_module, Atom),
+ construct_qualified_term_with_context(SymName, [Arg], Context, Term).
%----------------------------------------------------------------------------%
Index: compiler/hlds_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_code_util.m,v
retrieving revision 1.44
diff -u -b -r1.44 hlds_code_util.m
--- compiler/hlds_code_util.m 16 Jun 2011 06:42:14 -0000 1.44
+++ compiler/hlds_code_util.m 16 Apr 2012 10:53:33 -0000
@@ -157,17 +157,28 @@
:- pred is_valid_mutable_inst_2(module_info::in, mer_inst::in,
set(inst_name)::in) is semidet.
-is_valid_mutable_inst_2(_, any(shared, _), _).
-is_valid_mutable_inst_2(ModuleInfo, bound(shared, BoundInsts), Expansions) :-
- list.member(bound_functor(_, Insts), BoundInsts),
- list.member(Inst, Insts),
- is_valid_mutable_inst_2(ModuleInfo, Inst, Expansions).
-is_valid_mutable_inst_2(_, ground(shared, _), _).
-is_valid_mutable_inst_2(ModuleInfo, defined_inst(InstName), Expansions0) :-
+is_valid_mutable_inst_2(ModuleInfo, Inst, Expansions0) :-
+ (
+ ( Inst = any(Uniq, _)
+ ; Inst = ground(Uniq, _)
+ ),
+ Uniq = shared
+ ;
+ Inst = bound(shared, _, BoundInsts),
+ % XXX This looks wrong to me. It says that Inst is a valid mutable inst
+ % if SOME ArgInst inside Inst is a valid mutable inst, whereas I think
+ % ALL arguments of ALL functors should be required to be valid mutable
+ % insts.
+ list.member(bound_functor(_, ArgInsts), BoundInsts),
+ list.member(ArgInst, ArgInsts),
+ is_valid_mutable_inst_2(ModuleInfo, ArgInst, Expansions0)
+ ;
+ Inst = defined_inst(InstName),
not set.member(InstName, Expansions0),
- Expansions = set.insert(Expansions0, InstName),
- inst_lookup(ModuleInfo, InstName, Inst),
- is_valid_mutable_inst_2(ModuleInfo, Inst, Expansions).
+ set.insert(InstName, Expansions0, Expansions),
+ inst_lookup(ModuleInfo, InstName, SubInst),
+ is_valid_mutable_inst_2(ModuleInfo, SubInst, Expansions)
+ ).
%----------------------------------------------------------------------------%
:- end_module hlds_code_util.
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.237
diff -u -b -r1.237 hlds_goal.m
--- compiler/hlds_goal.m 16 Apr 2012 08:13:18 -0000 1.237
+++ compiler/hlds_goal.m 16 Apr 2012 10:54:49 -0000
@@ -3618,7 +3618,7 @@
make_const_construction(Var, ConsId, hlds_goal(GoalExpr, GoalInfo)) :-
RHS = rhs_functor(ConsId, no, []),
- Inst = bound(unique, [bound_functor(ConsId, [])]),
+ Inst = bound(unique, inst_test_results_fgtc, [bound_functor(ConsId, [])]),
Mode = (free -> Inst) - (Inst -> Inst),
Unification = construct(Var, ConsId, [], [],
construct_dynamically, cell_is_unique, no_construct_sub_info),
Index: compiler/hlds_out_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out_goal.m,v
retrieving revision 1.17
diff -u -b -r1.17 hlds_out_goal.m
--- compiler/hlds_out_goal.m 13 Apr 2012 07:20:38 -0000 1.17
+++ compiler/hlds_out_goal.m 17 Apr 2012 12:27:53 -0000
@@ -1221,7 +1221,7 @@
write_indent(Indent, !IO),
io.write_string("% arg-modes\n", !IO),
mercury_output_structured_uni_mode_list(ArgModes, Indent,
- do_incl_addr, InstVarSet, !IO)
+ output_debug, do_incl_addr, InstVarSet, !IO)
;
write_indent(Indent, !IO),
io.write_string("% arg-modes ", !IO),
Index: compiler/hlds_out_mode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out_mode.m,v
retrieving revision 1.7
diff -u -b -r1.7 hlds_out_mode.m
--- compiler/hlds_out_mode.m 5 Apr 2012 05:57:42 -0000 1.7
+++ compiler/hlds_out_mode.m 17 Apr 2012 12:26:48 -0000
@@ -16,6 +16,7 @@
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_out.hlds_out_util.
:- import_module hlds.instmap.
:- import_module parse_tree.prog_data.
@@ -23,7 +24,6 @@
:- import_module bool.
:- import_module io.
:- import_module list.
-:- import_module term.
%-----------------------------------------------------------------------------%
@@ -37,10 +37,11 @@
% Convert a mode or inst to a term representation.
%
-:- func mode_to_term(mer_mode) = prog_term.
-:- func mode_to_term_with_context(term.context, mer_mode) = prog_term.
-:- func inst_to_term(mer_inst) = prog_term.
-:- func inst_name_to_term(inst_name) = prog_term.
+:- func mode_to_term(output_lang, mer_mode) = prog_term.
+:- func mode_to_term_with_context(output_lang, prog_context, mer_mode)
+ = prog_term.
+:- func inst_to_term(output_lang, mer_inst) = prog_term.
+:- func inst_name_to_term(output_lang, inst_name) = prog_term.
%-----------------------------------------------------------------------------%
@@ -52,9 +53,9 @@
% but may not be valid Mercury.
%
:- pred mercury_output_structured_inst_list(list(mer_inst)::in, int::in,
- incl_addr::in, inst_varset::in, io::di, io::uo) is det.
+ output_lang::in, incl_addr::in, inst_varset::in, io::di, io::uo) is det.
:- func mercury_structured_inst_list_to_string(list(mer_inst), int,
- incl_addr, inst_varset) = string.
+ output_lang, incl_addr, inst_varset) = string.
% Output an inst in a format that makes it easy to read
% but may not be valid Mercury.
@@ -62,21 +63,21 @@
% (These routines are used with `--debug-modes'.)
%
:- pred mercury_output_structured_inst(mer_inst::in, int::in,
- incl_addr::in, inst_varset::in, io::di, io::uo) is det.
+ output_lang::in, incl_addr::in, inst_varset::in, io::di, io::uo) is det.
:- func mercury_structured_inst_to_string(mer_inst, int,
- incl_addr, inst_varset) = string.
+ output_lang, incl_addr, inst_varset) = string.
%-----------------------------------------------------------------------------%
:- pred mercury_output_structured_uni_mode(uni_mode::in, int::in,
- incl_addr::in, inst_varset::in, io::di, io::uo) is det.
-:- func mercury_structured_uni_mode_to_string(uni_mode, int, incl_addr,
- inst_varset) = string.
+ output_lang::in, incl_addr::in, inst_varset::in, io::di, io::uo) is det.
+:- func mercury_structured_uni_mode_to_string(uni_mode, int,
+ output_lang, incl_addr, inst_varset) = string.
:- pred mercury_output_structured_uni_mode_list(list(uni_mode)::in, int::in,
- incl_addr::in, inst_varset::in, io::di, io::uo) is det.
+ output_lang::in, incl_addr::in, inst_varset::in, io::di, io::uo) is det.
:- func mercury_structured_uni_mode_list_to_string(list(uni_mode), int,
- incl_addr, inst_varset) = string.
+ output_lang, incl_addr, inst_varset) = string.
%-----------------------------------------------------------------------------%
@@ -123,6 +124,13 @@
%-----------------------------------------------------------------------------%
+:- func make_atom(prog_context, string) = prog_term.
+
+make_atom(Context, Name) =
+ term.functor(term.atom(Name), [], Context).
+
+%-----------------------------------------------------------------------------%
+
write_instmap(InstMap, VarSet, AppendVarNums, Indent, !IO) :-
( instmap_is_unreachable(InstMap) ->
io.write_string("unreachable", !IO)
@@ -148,9 +156,10 @@
%-----------------------------------------------------------------------------%
-mode_to_term(Mode) = mode_to_term_with_context(term.context_init, Mode).
+mode_to_term(Lang, Mode) =
+ mode_to_term_with_context(Lang, term.context_init, Mode).
-mode_to_term_with_context(Context, Mode) = Term :-
+mode_to_term_with_context(Lang, Context, Mode) = Term :-
(
Mode = (InstA -> InstB),
(
@@ -159,64 +168,68 @@
InstA = ground(_Uniq, higher_order(_)),
InstB = InstA
->
- Term = inst_to_term_with_context(InstA, Context)
+ Term = inst_to_term_with_context(Lang, Context, InstA)
;
- construct_qualified_term(unqualified(">>"),
- [inst_to_term_with_context(InstA, Context),
- inst_to_term_with_context(InstB, Context)],
+ construct_qualified_term_with_context(unqualified(">>"),
+ [inst_to_term_with_context(Lang, Context, InstA),
+ inst_to_term_with_context(Lang, Context, InstB)],
Context, Term)
)
;
Mode = user_defined_mode(Name, Args),
- construct_qualified_term(Name,
- list.map(map_inst_to_term(Context), Args),
+ construct_qualified_term_with_context(Name,
+ list.map(inst_to_term_with_context(Lang, Context), Args),
Context, Term)
).
-:- func make_atom(string, prog_context) = prog_term.
-
-make_atom(Name, Context) =
- term.functor(term.atom(Name), [], Context).
+inst_to_term(Lang, Inst) =
+ inst_to_term_with_context(Lang, term.context_init, Inst).
-:- func map_inst_to_term(prog_context, mer_inst) = prog_term.
-
-map_inst_to_term(Context, Inst) = inst_to_term_with_context(Inst, Context).
-
-inst_to_term(Inst) = inst_to_term_with_context(Inst, term.context_init).
-
-:- func inst_to_term_with_context(mer_inst, prog_context) = prog_term.
+:- func inst_to_term_with_context(output_lang, prog_context, mer_inst)
+ = prog_term.
-inst_to_term_with_context(Inst, Context) = Term :-
+inst_to_term_with_context(Lang, Context, Inst) = Term :-
(
Inst = any(Uniq, HOInstInfo),
(
HOInstInfo = higher_order(PredInstInfo),
- Term = any_pred_inst_info_to_term(Uniq, PredInstInfo, Context)
+ Term = any_pred_inst_info_to_term(Lang, Context, Uniq,
+ PredInstInfo)
;
HOInstInfo = none,
- Term = make_atom(any_inst_uniqueness(Uniq), Context)
+ Term = make_atom(Context, any_inst_uniqueness(Uniq))
)
;
Inst = free,
- Term = make_atom("free", Context)
+ Term = make_atom(Context, "free")
;
Inst = free(Type),
unparse_type(Type, Term0),
Term1 = term.coerce(Term0),
Term = term.functor(term.atom("free"), [Term1], Context)
;
- Inst = bound(Uniq, BoundInsts),
- construct_qualified_term(
+ Inst = bound(Uniq, InstResults, BoundInsts),
+ (
+ Lang = output_mercury,
+ ArgTerms = [bound_insts_to_term(Lang, Context, BoundInsts)]
+ ;
+ Lang = output_debug,
+ ArgTerms =
+ [inst_test_results_to_term(Context, InstResults),
+ bound_insts_to_term(Lang, Context, BoundInsts)]
+ ),
+ construct_qualified_term_with_context(
unqualified(inst_uniqueness(Uniq, "bound")),
- [bound_insts_to_term(BoundInsts, Context)], Context, Term)
+ ArgTerms, Context, Term)
;
Inst = ground(Uniq, HOInstInfo),
(
HOInstInfo = higher_order(PredInstInfo),
- Term = ground_pred_inst_info_to_term(Uniq, PredInstInfo, Context)
+ Term = ground_pred_inst_info_to_term(Lang, Context, Uniq,
+ PredInstInfo)
;
HOInstInfo = none,
- Term = make_atom(inst_uniqueness(Uniq, "ground"), Context)
+ Term = make_atom(Context, inst_uniqueness(Uniq, "ground"))
)
;
Inst = inst_var(Var),
@@ -227,128 +240,223 @@
term.functor(term.atom("=<"),
[term.coerce(term.variable(Var, context_init)), VarTerm],
Context),
- Vars, inst_to_term_with_context(SubInst, Context))
+ Vars, inst_to_term_with_context(Lang, Context, SubInst))
;
Inst = abstract_inst(Name, Args),
- Term = inst_name_to_term_with_context(Context, user_inst(Name, Args))
+ Term = inst_name_to_term_with_context(Lang, Context,
+ user_inst(Name, Args))
;
Inst = defined_inst(InstName),
- Term = inst_name_to_term_with_context(Context, InstName)
+ Term = inst_name_to_term_with_context(Lang, Context, InstName)
;
Inst = not_reached,
- Term = make_atom("not_reached", Context)
+ Term = make_atom(Context, "not_reached")
+ ).
+
+:- func inst_test_results_to_term(prog_context, inst_test_results) = prog_term.
+
+inst_test_results_to_term(Context, InstResults) = Term :-
+ (
+ InstResults = inst_test_results(GroundnessResult, AnyResult,
+ InstNameResult, TypeResult),
+ SubTerm1 = inst_result_groundness_to_term(Context, GroundnessResult),
+ SubTerm2 = inst_result_contains_any_to_term(Context, AnyResult),
+ SubTerm3 = inst_result_contains_instnames_to_term(Context,
+ InstNameResult),
+ SubTerm4 = inst_result_contains_types_to_term(Context, TypeResult),
+ Term = term.functor(term.atom("results"),
+ [SubTerm1, SubTerm2, SubTerm3, SubTerm4], Context)
+ ;
+ InstResults = inst_test_no_results,
+ Term = term.functor(term.atom("no_results"), [], Context)
+ ;
+ InstResults = inst_test_results_fgtc,
+ Term = term.functor(term.atom("fgtc"), [], Context)
).
-:- func ground_pred_inst_info_to_term(uniqueness, pred_inst_info, prog_context)
+:- func inst_result_groundness_to_term(prog_context, inst_result_groundness)
= prog_term.
-ground_pred_inst_info_to_term(_Uniq, PredInstInfo, Context) = Term :-
+inst_result_groundness_to_term(Context, Groundness) = Term :-
+ (
+ Groundness = inst_result_is_not_ground,
+ Term = term.functor(term.atom("is_not_ground"), [], Context)
+ ;
+ Groundness = inst_result_is_ground,
+ Term = term.functor(term.atom("is_ground"), [], Context)
+ ;
+ Groundness = inst_result_groundness_unknown,
+ Term = term.functor(term.atom("groundness_unknown"), [], Context)
+ ).
+
+:- func inst_result_contains_any_to_term(prog_context,
+ inst_result_contains_any) = prog_term.
+
+inst_result_contains_any_to_term(Context, ContainsAny) = Term :-
+ (
+ ContainsAny = inst_result_does_not_contain_any,
+ Term = term.functor(term.atom("does_not_contain_any"), [], Context)
+ ;
+ ContainsAny = inst_result_does_contain_any,
+ Term = term.functor(term.atom("does_contain_any"), [], Context)
+ ;
+ ContainsAny = inst_result_contains_any_unknown,
+ Term = term.functor(term.atom("contains_any_unknown"), [], Context)
+ ).
+
+:- func inst_result_contains_instnames_to_term(prog_context,
+ inst_result_contains_instnames) = prog_term.
+
+inst_result_contains_instnames_to_term(Context, ContainsInstNames) = Term :-
+ (
+ ContainsInstNames = inst_result_contains_instnames_unknown,
+ Term = term.functor(term.atom("contains_instnames_unknown"),
+ [], Context)
+ ;
+ ContainsInstNames = inst_result_contains_instnames_known(InstNameSet),
+ set.count(InstNameSet, NumInstNames),
+ % Inst names can be pretty big, so we print only a count.
+ % If necessary, we can later modify this code to actually print them.
+ CountTerm = term.functor(term.integer(NumInstNames), [], Context),
+ Term = term.functor(term.atom("contains_types_known"),
+ [CountTerm], Context)
+ ).
+
+:- func inst_result_contains_types_to_term(prog_context,
+ inst_result_contains_types) = prog_term.
+
+inst_result_contains_types_to_term(Context, ContainsTypes) = Term :-
+ (
+ ContainsTypes = inst_result_contains_types_unknown,
+ Term = term.functor(term.atom("contains_types_unknown"), [], Context)
+ ;
+ ContainsTypes = inst_result_contains_types_known(TypeCtorSet),
+ set.to_sorted_list(TypeCtorSet, TypeCtors),
+ TypeCtorTerms = list.map(type_ctor_to_term(Context), TypeCtors),
+ Term = term.functor(term.atom("contains_types_known"),
+ TypeCtorTerms, Context)
+ ).
+
+:- func type_ctor_to_term(prog_context, type_ctor) = prog_term.
+
+type_ctor_to_term(Context, TypeCtor) = Term :-
+ TypeCtor = type_ctor(SymName, Arity),
+ string.format("%s/%d", [s(sym_name_to_string(SymName)), i(Arity)],
+ ConsName),
+ Term = term.functor(term.atom(ConsName), [], Context).
+
+:- func ground_pred_inst_info_to_term(output_lang, prog_context, uniqueness,
+ pred_inst_info) = prog_term.
+
+ground_pred_inst_info_to_term(Lang, Context, _Uniq, PredInstInfo) = Term :-
% XXX we ignore Uniq
PredInstInfo = pred_inst_info(PredOrFunc, Modes, _, Det),
(
PredOrFunc = pf_predicate,
- construct_qualified_term(unqualified("pred"),
- list.map(mode_to_term_with_context(Context), Modes),
+ construct_qualified_term_with_context(unqualified("pred"),
+ list.map(mode_to_term_with_context(Lang, Context), Modes),
Context, ModesTerm)
;
PredOrFunc = pf_function,
pred_args_to_func_args(Modes, ArgModes, RetMode),
- construct_qualified_term(unqualified("func"),
- list.map(mode_to_term_with_context(Context), ArgModes),
+ construct_qualified_term_with_context(unqualified("func"),
+ list.map(mode_to_term_with_context(Lang, Context), ArgModes),
Context, ArgModesTerm),
- construct_qualified_term(unqualified("="),
- [ArgModesTerm, mode_to_term_with_context(Context, RetMode)],
+ construct_qualified_term_with_context(unqualified("="),
+ [ArgModesTerm, mode_to_term_with_context(Lang, Context, RetMode)],
Context, ModesTerm)
),
- construct_qualified_term(unqualified("is"),
- [ModesTerm, det_to_term(Det, Context)], Context, Term).
+ construct_qualified_term_with_context(unqualified("is"),
+ [ModesTerm, det_to_term(Context, Det)], Context, Term).
-:- func any_pred_inst_info_to_term(uniqueness, pred_inst_info, prog_context)
- = prog_term.
+:- func any_pred_inst_info_to_term(output_lang, prog_context, uniqueness,
+ pred_inst_info) = prog_term.
-any_pred_inst_info_to_term(_Uniq, PredInstInfo, Context) = Term :-
+any_pred_inst_info_to_term(Lang, Context, _Uniq, PredInstInfo) = Term :-
% XXX we ignore Uniq
PredInstInfo = pred_inst_info(PredOrFunc, Modes, _, Det),
(
PredOrFunc = pf_predicate,
- construct_qualified_term(unqualified("any_pred"),
- list.map(mode_to_term_with_context(Context), Modes),
+ construct_qualified_term_with_context(unqualified("any_pred"),
+ list.map(mode_to_term_with_context(Lang, Context), Modes),
Context, ModesTerm)
;
PredOrFunc = pf_function,
pred_args_to_func_args(Modes, ArgModes, RetMode),
- construct_qualified_term(unqualified("any_func"),
- list.map(mode_to_term_with_context(Context), ArgModes),
+ construct_qualified_term_with_context(unqualified("any_func"),
+ list.map(mode_to_term_with_context(Lang, Context), ArgModes),
Context, ArgModesTerm),
- construct_qualified_term(unqualified("="),
- [ArgModesTerm, mode_to_term_with_context(Context, RetMode)],
+ construct_qualified_term_with_context(unqualified("="),
+ [ArgModesTerm, mode_to_term_with_context(Lang, Context, RetMode)],
Context, ModesTerm)
),
- construct_qualified_term(unqualified("is"),
- [ModesTerm, det_to_term(Det, Context)], Context, Term).
+ construct_qualified_term_with_context(unqualified("is"),
+ [ModesTerm, det_to_term(Context, Det)], Context, Term).
-inst_name_to_term(InstName) =
- inst_name_to_term_with_context(term.context_init, InstName).
+inst_name_to_term(Lang, InstName) =
+ inst_name_to_term_with_context(Lang, term.context_init, InstName).
-:- func inst_name_to_term_with_context(prog_context, inst_name) = prog_term.
+:- func inst_name_to_term_with_context(output_lang, prog_context, inst_name)
+ = prog_term.
-inst_name_to_term_with_context(Context, InstName) = Term :-
+inst_name_to_term_with_context(Lang, Context, InstName) = Term :-
(
InstName = user_inst(Name, Args),
- construct_qualified_term(Name,
- list.map(map_inst_to_term(Context), Args),
+ construct_qualified_term_with_context(Name,
+ list.map(inst_to_term_with_context(Lang, Context), Args),
Context, Term)
;
InstName = merge_inst(InstA, InstB),
- construct_qualified_term(unqualified("$merge_inst"),
- list.map(map_inst_to_term(Context), [InstA, InstB]),
+ construct_qualified_term_with_context(unqualified("$merge_inst"),
+ list.map(inst_to_term_with_context(Lang, Context), [InstA, InstB]),
Context, Term)
;
InstName = shared_inst(SubInstName),
- construct_qualified_term(unqualified("$shared_inst"),
- [inst_name_to_term_with_context(Context, SubInstName)],
+ construct_qualified_term_with_context(unqualified("$shared_inst"),
+ [inst_name_to_term_with_context(Lang, Context, SubInstName)],
Context, Term)
;
InstName = mostly_uniq_inst(SubInstName),
- construct_qualified_term(unqualified("$mostly_uniq_inst"),
- [inst_name_to_term_with_context(Context, SubInstName)],
+ construct_qualified_term_with_context(unqualified("$mostly_uniq_inst"),
+ [inst_name_to_term_with_context(Lang, Context, SubInstName)],
Context, Term)
;
InstName = unify_inst(Liveness, InstA, InstB, Real),
- construct_qualified_term(unqualified("$unify"),
- [make_atom(is_live_to_str(Liveness), Context)] ++
- list.map(map_inst_to_term(Context), [InstA, InstB]) ++
- [make_atom(unify_is_real_to_str(Real), Context)],
+ construct_qualified_term_with_context(unqualified("$unify"),
+ [make_atom(Context, is_live_to_str(Liveness))] ++
+ list.map(inst_to_term_with_context(Lang, Context),
+ [InstA, InstB]) ++
+ [make_atom(Context, unify_is_real_to_str(Real))],
Context, Term)
;
InstName = ground_inst(SubInstName, IsLive, Uniq, Real),
- construct_qualified_term(unqualified("$ground"),
- [inst_name_to_term_with_context(Context, SubInstName),
- make_atom(is_live_to_str(IsLive), Context),
- make_atom(inst_uniqueness(Uniq, "shared"), Context),
- make_atom(unify_is_real_to_str(Real), Context)],
+ construct_qualified_term_with_context(unqualified("$ground"),
+ [inst_name_to_term_with_context(Lang, Context, SubInstName),
+ make_atom(Context, is_live_to_str(IsLive)),
+ make_atom(Context, inst_uniqueness(Uniq, "shared")),
+ make_atom(Context, unify_is_real_to_str(Real))],
Context, Term)
;
InstName = any_inst(SubInstName, IsLive, Uniq, Real),
- construct_qualified_term(unqualified("$any"),
- [inst_name_to_term_with_context(Context, SubInstName),
- make_atom(is_live_to_str(IsLive), Context),
- make_atom(inst_uniqueness(Uniq, "shared"), Context),
- make_atom(unify_is_real_to_str(Real), Context)],
+ construct_qualified_term_with_context(unqualified("$any"),
+ [inst_name_to_term_with_context(Lang, Context, SubInstName),
+ make_atom(Context, is_live_to_str(IsLive)),
+ make_atom(Context, inst_uniqueness(Uniq, "shared")),
+ make_atom(Context, unify_is_real_to_str(Real))],
Context, Term)
;
InstName = typed_ground(Uniq, Type),
unparse_type(Type, Term0),
- construct_qualified_term(unqualified("$typed_ground"),
- [make_atom(inst_uniqueness(Uniq, "shared"), Context),
+ construct_qualified_term_with_context(unqualified("$typed_ground"),
+ [make_atom(Context, inst_uniqueness(Uniq, "shared")),
term.coerce(Term0)],
Context, Term)
;
InstName = typed_inst(Type, SubInstName),
unparse_type(Type, Term0),
- construct_qualified_term(unqualified("$typed_inst"),
+ construct_qualified_term_with_context(unqualified("$typed_inst"),
[term.coerce(Term0),
- inst_name_to_term_with_context(Context, SubInstName)],
+ inst_name_to_term_with_context(Lang, Context, SubInstName)],
Context, Term)
).
@@ -378,21 +486,22 @@
inst_uniqueness(clobbered, _) = "clobbered".
inst_uniqueness(mostly_clobbered, _) = "mostly_clobbered".
-:- func bound_insts_to_term(list(bound_inst), prog_context) = prog_term.
+:- func bound_insts_to_term(output_lang, prog_context, list(bound_inst))
+ = prog_term.
-bound_insts_to_term([], _) = _ :-
+bound_insts_to_term(_, _, []) = _ :-
unexpected($module, $pred, "bound_insts_to_term([])").
-bound_insts_to_term([BoundInst | BoundInsts], Context) = Term :-
+bound_insts_to_term(Lang, Context, [BoundInst | BoundInsts]) = Term :-
BoundInst = bound_functor(ConsId, Args),
- ArgTerms = list.map(map_inst_to_term(Context), Args),
+ ArgTerms = list.map(inst_to_term_with_context(Lang, Context), Args),
cons_id_and_args_to_term_full(ConsId, ArgTerms, FirstTerm),
(
BoundInsts = [],
Term = FirstTerm
;
BoundInsts = [_ | _],
- construct_qualified_term(unqualified(";"),
- [FirstTerm, bound_insts_to_term(BoundInsts, Context)],
+ construct_qualified_term_with_context(unqualified(";"),
+ [FirstTerm, bound_insts_to_term(Lang, Context, BoundInsts)],
Context, Term)
).
@@ -474,9 +583,9 @@
Term = term.functor(term.string(FunctorName), [], Context)
).
-:- func det_to_term(determinism, prog_context) = prog_term.
+:- func det_to_term(prog_context, determinism) = prog_term.
-det_to_term(Det, Context) = make_atom(det_to_string(Det), Context).
+det_to_term(Context, Det) = make_atom(Context, det_to_string(Det)).
:- func det_to_string(determinism) = string.
@@ -491,48 +600,50 @@
%-----------------------------------------------------------------------------%
-mercury_output_structured_uni_mode_list(Insts, Indent, InclAddr, InstVarSet,
- !IO) :-
- mercury_format_structured_uni_mode_list(Insts, 1, Indent, InclAddr,
+mercury_output_structured_uni_mode_list(Insts, Indent, Lang, InclAddr,
+ InstVarSet, !IO) :-
+ mercury_format_structured_uni_mode_list(Insts, 1, Indent, Lang, InclAddr,
InstVarSet, !IO).
-mercury_structured_uni_mode_list_to_string(Insts, Indent, InclAddr, InstVarSet)
- = String :-
- mercury_format_structured_uni_mode_list(Insts, 1, Indent, InclAddr,
+mercury_structured_uni_mode_list_to_string(Insts, Indent, Lang, InclAddr,
+ InstVarSet) = String :-
+ mercury_format_structured_uni_mode_list(Insts, 1, Indent, Lang, InclAddr,
InstVarSet, "", String).
:- pred mercury_format_structured_uni_mode_list(list(uni_mode)::in, int::in,
- int::in, incl_addr::in, inst_varset::in, U::di, U::uo) is det <= output(U).
+ int::in, output_lang::in, incl_addr::in, inst_varset::in, U::di, U::uo)
+ is det <= output(U).
-mercury_format_structured_uni_mode_list([], _, _, _, _, !U).
+mercury_format_structured_uni_mode_list([], _, _, _, _, _, !U).
mercury_format_structured_uni_mode_list([UniMode | UniModes], ArgNum, Indent,
- InclAddr, InstVarSet, !U) :-
+ Lang, InclAddr, InstVarSet, !U) :-
mercury_format_tabs(Indent, !U),
add_string("argument ", !U),
add_int(ArgNum, !U),
add_string(":\n", !U),
mercury_format_structured_uni_mode(UniMode, Indent,
- InclAddr, InstVarSet, !U),
+ Lang, InclAddr, InstVarSet, !U),
mercury_format_structured_uni_mode_list(UniModes, ArgNum +1, Indent,
- InclAddr, InstVarSet, !U).
+ Lang, InclAddr, InstVarSet, !U).
%-----------------------------------------------------------------------------%
-mercury_output_structured_uni_mode(Inst, Indent, InclAddr, InstVarSet,
- !IO) :-
- mercury_format_structured_uni_mode(Inst, Indent, InclAddr, InstVarSet,
- !IO).
+mercury_output_structured_uni_mode(Inst, Indent, Lang, InclAddr,
+ InstVarSet, !IO) :-
+ mercury_format_structured_uni_mode(Inst, Indent, Lang, InclAddr,
+ InstVarSet, !IO).
-mercury_structured_uni_mode_to_string(Inst, Indent, InclAddr, InstVarSet)
- = String :-
- mercury_format_structured_uni_mode(Inst, Indent, InclAddr, InstVarSet,
- "", String).
+mercury_structured_uni_mode_to_string(Inst, Indent, Lang, InclAddr,
+ InstVarSet) = String :-
+ mercury_format_structured_uni_mode(Inst, Indent, Lang, InclAddr,
+ InstVarSet, "", String).
:- pred mercury_format_structured_uni_mode(uni_mode::in, int::in,
- incl_addr::in, inst_varset::in, U::di, U::uo) is det <= output(U).
+ output_lang::in, incl_addr::in, inst_varset::in, U::di, U::uo) is det
+ <= output(U).
-mercury_format_structured_uni_mode(UniMode, Indent, InclAddr, InstVarSet,
- !U) :-
+mercury_format_structured_uni_mode(UniMode, Indent, Lang, InclAddr,
+ InstVarSet, !U) :-
UniMode = (InstA1 - InstB1 -> InstA2 - InstB2),
get_inst_addr(InstA1, InstA1Addr),
get_inst_addr(InstA2, InstA2Addr),
@@ -541,7 +652,8 @@
mercury_format_tabs(Indent, !U),
add_string("old lhs inst:\n", !U),
- mercury_format_structured_inst(InstA1, Indent, InclAddr, InstVarSet, !U),
+ mercury_format_structured_inst(InstA1, Indent, Lang, InclAddr,
+ InstVarSet, !U),
mercury_format_tabs(Indent, !U),
( InstB1Addr = InstA1Addr ->
@@ -549,7 +661,7 @@
add_string("old rhs inst: same as old lhs inst\n", !U)
;
add_string("old rhs inst:\n", !U),
- mercury_format_structured_inst(InstB1, Indent, InclAddr,
+ mercury_format_structured_inst(InstB1, Indent, Lang, InclAddr,
InstVarSet, !U)
),
@@ -562,7 +674,7 @@
add_string("new lhs inst: changed to old rhs inst\n", !U)
;
add_string("new lhs inst:\n", !U),
- mercury_format_structured_inst(InstA2, Indent, InclAddr,
+ mercury_format_structured_inst(InstA2, Indent, Lang, InclAddr,
InstVarSet, !U)
),
@@ -575,45 +687,50 @@
add_string("new rhs inst: changed to new lhs inst\n", !U)
;
add_string("new rhs inst:\n", !U),
- mercury_format_structured_inst(InstB2, Indent, InclAddr,
+ mercury_format_structured_inst(InstB2, Indent, Lang, InclAddr,
InstVarSet, !U)
).
%-----------------------------------------------------------------------------%
-mercury_output_structured_inst_list(Insts, Indent, InclAddr, InstVarSet, !IO) :-
- mercury_format_structured_inst_list(Insts, Indent, InclAddr, InstVarSet,
- !IO).
+mercury_output_structured_inst_list(Insts, Indent, Lang, InclAddr,
+ InstVarSet, !IO) :-
+ mercury_format_structured_inst_list(Insts, Indent, Lang, InclAddr,
+ InstVarSet, !IO).
-mercury_structured_inst_list_to_string(Insts, Indent, InclAddr, InstVarSet)
- = String :-
- mercury_format_structured_inst_list(Insts, Indent, InclAddr, InstVarSet,
- "", String).
+mercury_structured_inst_list_to_string(Insts, Indent, Lang, InclAddr,
+ InstVarSet) = String :-
+ mercury_format_structured_inst_list(Insts, Indent, Lang, InclAddr,
+ InstVarSet, "", String).
:- pred mercury_format_structured_inst_list(list(mer_inst)::in, int::in,
- incl_addr::in, inst_varset::in, U::di, U::uo) is det <= output(U).
+ output_lang::in, incl_addr::in, inst_varset::in, U::di, U::uo) is det
+ <= output(U).
-mercury_format_structured_inst_list([], _, _, _, !U).
-mercury_format_structured_inst_list([Inst | Insts], Indent, InclAddr,
+mercury_format_structured_inst_list([], _, _, _, _, !U).
+mercury_format_structured_inst_list([Inst | Insts], Indent, Lang, InclAddr,
InstVarSet, !U) :-
- mercury_format_structured_inst(Inst, Indent, InclAddr, InstVarSet, !U),
- mercury_format_structured_inst_list(Insts, Indent, InclAddr,
+ mercury_format_structured_inst(Inst, Indent, Lang, InclAddr,
+ InstVarSet, !U),
+ mercury_format_structured_inst_list(Insts, Indent, Lang, InclAddr,
InstVarSet, !U).
%-----------------------------------------------------------------------------%
-mercury_output_structured_inst(Inst, Indent, InclAddr, InstVarSet, !U) :-
- mercury_format_structured_inst(Inst, Indent, InclAddr, InstVarSet, !U).
+mercury_output_structured_inst(Inst, Indent, Lang, InclAddr, InstVarSet, !U) :-
+ mercury_format_structured_inst(Inst, Indent, Lang, InclAddr, InstVarSet,
+ !U).
-mercury_structured_inst_to_string(Inst, Indent, InclAddr, InstVarSet)
+mercury_structured_inst_to_string(Inst, Indent, Lang, InclAddr, InstVarSet)
= String :-
- mercury_format_structured_inst(Inst, Indent, InclAddr, InstVarSet,
+ mercury_format_structured_inst(Inst, Indent, Lang, InclAddr, InstVarSet,
"", String).
-:- pred mercury_format_structured_inst(mer_inst::in, int::in, incl_addr::in,
- inst_varset::in, U::di, U::uo) is det <= output(U).
+:- pred mercury_format_structured_inst(mer_inst::in, int::in,
+ output_lang::in, incl_addr::in, inst_varset::in, U::di, U::uo) is det
+ <= output(U).
-mercury_format_structured_inst(Inst, Indent, InclAddr, InstVarSet, !U) :-
+mercury_format_structured_inst(Inst, Indent, Lang, InclAddr, InstVarSet, !U) :-
mercury_format_tabs(Indent, !U),
(
InclAddr = do_not_incl_addr
@@ -642,11 +759,23 @@
Inst = free(_T),
add_string("free(with some type)\n", !U)
;
- Inst = bound(Uniq, BoundInsts),
+ Inst = bound(Uniq, InstResults, BoundInsts),
mercury_format_uniqueness(Uniq, "bound", !U),
add_string("(\n", !U),
- mercury_format_structured_bound_insts(BoundInsts, Indent, InclAddr,
- InstVarSet, !U),
+ (
+ Lang = output_mercury
+ ;
+ Lang = output_debug,
+ InstResultsTerm =
+ inst_test_results_to_term(term.context_init, InstResults),
+ InstResultsStr =
+ mercury_term_to_string(varset.init, no, InstResultsTerm),
+ mercury_format_tabs(Indent, !U),
+ add_string(InstResultsStr, !U),
+ add_string(",\n", !U)
+ ),
+ mercury_format_structured_bound_insts(BoundInsts, Indent,
+ Lang, InclAddr, InstVarSet, !U),
mercury_format_tabs(Indent, !U),
add_string(")\n", !U)
;
@@ -672,22 +801,23 @@
;
Inst = abstract_inst(Name, Args),
mercury_format_structured_inst_name(user_inst(Name, Args), 0,
- InclAddr, InstVarSet, !U)
+ Lang, InclAddr, InstVarSet, !U)
;
Inst = defined_inst(InstName),
mercury_format_structured_inst_name(InstName, 0,
- InclAddr, InstVarSet, !U)
+ Lang, InclAddr, InstVarSet, !U)
;
Inst = not_reached,
add_string("not_reached\n", !U)
).
:- pred mercury_format_structured_bound_insts(list(bound_inst)::in, int::in,
- incl_addr::in, inst_varset::in, U::di, U::uo) is det <= output(U).
+ output_lang::in, incl_addr::in, inst_varset::in, U::di, U::uo) is det
+ <= output(U).
-mercury_format_structured_bound_insts([], _, _, _, !U).
+mercury_format_structured_bound_insts([], _, _, _, _, !U).
mercury_format_structured_bound_insts([BoundInst | BoundInsts],
- Indent0, InclAddr, InstVarSet, !U) :-
+ Indent0, Lang, InclAddr, InstVarSet, !U) :-
BoundInst = bound_functor(ConsId, Args),
Indent1 = Indent0 + 1,
Indent2 = Indent1 + 1,
@@ -701,8 +831,8 @@
mercury_format_tabs(Indent1, !U),
mercury_format_cons_id(ConsId, does_not_need_brackets, !U),
add_string("(\n", !U),
- mercury_format_structured_inst_list(Args, Indent2, InclAddr,
- InstVarSet, !U),
+ mercury_format_structured_inst_list(Args, Indent2,
+ Lang, InclAddr, InstVarSet, !U),
mercury_format_tabs(Indent1, !U),
add_string(")\n", !U)
),
@@ -713,7 +843,7 @@
mercury_format_tabs(Indent0, !U),
add_string(";\n", !U),
mercury_format_structured_bound_insts(BoundInsts, Indent0,
- InclAddr, InstVarSet, !U)
+ Lang, InclAddr, InstVarSet, !U)
).
:- pred get_inst_addr(mer_inst::in, int::out) is det.
@@ -728,10 +858,11 @@
%-----------------------------------------------------------------------------%
:- pred mercury_format_structured_inst_name(inst_name::in, int::in,
- incl_addr::in, inst_varset::in, U::di, U::uo) is det <= output(U).
+ output_lang::in, incl_addr::in, inst_varset::in, U::di, U::uo) is det
+ <= output(U).
-mercury_format_structured_inst_name(InstName, Indent, InclAddr, InstVarSet,
- !U) :-
+mercury_format_structured_inst_name(InstName, Indent, Lang, InclAddr,
+ InstVarSet, !U) :-
(
InstName = user_inst(Name, Args),
(
@@ -743,8 +874,8 @@
mercury_format_tabs(Indent, !U),
mercury_format_sym_name(Name, !U),
add_string("(\n", !U),
- mercury_format_structured_inst_list(Args, Indent + 1, InclAddr,
- InstVarSet, !U),
+ mercury_format_structured_inst_list(Args, Indent + 1,
+ Lang, InclAddr, InstVarSet, !U),
mercury_format_tabs(Indent, !U),
add_string(")\n", !U)
)
@@ -753,14 +884,14 @@
mercury_format_tabs(Indent, !U),
add_string("$merge_inst(\n", !U),
mercury_format_structured_inst_list([InstA, InstB], Indent + 1,
- InclAddr, InstVarSet, !U),
+ Lang, InclAddr, InstVarSet, !U),
mercury_format_tabs(Indent, !U),
add_string(")\n", !U)
;
InstName = shared_inst(SubInstName),
add_string("$shared_inst(\n", !U),
mercury_format_structured_inst_name(SubInstName, Indent + 1,
- InclAddr, InstVarSet, !U),
+ Lang, InclAddr, InstVarSet, !U),
mercury_format_tabs(Indent, !U),
add_string(")\n", !U)
;
@@ -768,7 +899,7 @@
mercury_format_tabs(Indent, !U),
add_string("$mostly_uniq_inst(\n", !U),
mercury_format_structured_inst_name(SubInstName, Indent + 1,
- InclAddr, InstVarSet, !U),
+ Lang, InclAddr, InstVarSet, !U),
mercury_format_tabs(Indent, !U),
add_string(")\n", !U)
;
@@ -779,7 +910,7 @@
mercury_format_real_comma(Real, !U),
add_string("\n", !U),
mercury_format_structured_inst_list([InstA, InstB], Indent + 1,
- InclAddr, InstVarSet, !U),
+ Lang, InclAddr, InstVarSet, !U),
mercury_format_tabs(Indent, !U),
add_string(")\n", !U)
;
@@ -791,7 +922,7 @@
mercury_format_uniqueness(Uniq, "shared", !U),
add_string(",\n", !U),
mercury_format_structured_inst_name(SubInstName, Indent + 1,
- InclAddr, InstVarSet, !U),
+ Lang, InclAddr, InstVarSet, !U),
mercury_format_tabs(Indent, !U),
add_string(")\n", !U)
;
@@ -803,7 +934,7 @@
mercury_format_uniqueness(Uniq, "shared", !U),
add_string(",\n", !U),
mercury_format_structured_inst_name(SubInstName, Indent + 1,
- InclAddr, InstVarSet, !U),
+ Lang, InclAddr, InstVarSet, !U),
mercury_format_tabs(Indent, !U),
add_string(")\n", !U)
;
@@ -823,7 +954,7 @@
mercury_format_type(TypeVarSet, no, Type, !U),
add_string(",\n", !U),
mercury_format_structured_inst_name(SubInstName, Indent + 1,
- InclAddr, InstVarSet, !U),
+ Lang, InclAddr, InstVarSet, !U),
mercury_format_tabs(Indent, !U),
add_string(")\n", !U)
).
Index: compiler/hlds_out_module.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out_module.m,v
retrieving revision 1.10
diff -u -b -r1.10 hlds_out_module.m
--- compiler/hlds_out_module.m 5 Apr 2012 05:57:42 -0000 1.10
+++ compiler/hlds_out_module.m 17 Apr 2012 12:38:33 -0000
@@ -84,6 +84,7 @@
DumpPredNames),
write_header(Indent, ModuleInfo, !IO),
Info = init_hlds_out_info(Globals),
+ Lang = output_debug,
DumpOptions = Info ^ hoi_dump_hlds_options,
(
% If the user specifically requested one or more predicates and/or
@@ -113,7 +114,7 @@
( string.contains_char(DumpOptions, 'M') ->
globals.lookup_int_option(Globals, dump_hlds_inst_limit,
InstLimit),
- write_inst_table(Indent, InstLimit, InstTable, !IO),
+ write_inst_table(Lang, Indent, InstLimit, InstTable, !IO),
io.write_string("\n", !IO),
write_mode_table(Indent, ModeTable, !IO),
io.write_string("\n", !IO)
@@ -128,7 +129,7 @@
)
),
( string.contains_char(DumpOptions, 'x') ->
- write_preds(Info, Indent, ModuleInfo, PredTable, !IO)
+ write_preds(Info, Lang, Indent, ModuleInfo, PredTable, !IO)
;
true
),
@@ -604,10 +605,10 @@
% Write out the inst table.
%
-:- pred write_inst_table(int::in, int::in, inst_table::in, io::di, io::uo)
- is det.
+:- pred write_inst_table(output_lang::in, int::in, int::in, inst_table::in,
+ io::di, io::uo) is det.
-write_inst_table(Indent, Limit, InstTable, !IO) :-
+write_inst_table(Lang, Indent, Limit, InstTable, !IO) :-
write_indent(Indent, !IO),
io.write_string("%-------- Insts --------\n", !IO),
@@ -619,37 +620,37 @@
io.write_string("%-------- Unify insts --------\n", !IO),
inst_table_get_unify_insts(InstTable, UnifyInstMap),
- map.foldl2(write_inst_name_maybe_inst_det(Limit), UnifyInstMap,
+ map.foldl2(write_inst_name_maybe_inst_det(Lang, Limit), UnifyInstMap,
0, NumUnifyInsts, !IO),
io.format("Total number of unify insts: %d\n", [i(NumUnifyInsts)], !IO),
io.write_string("%-------- Merge insts --------\n", !IO),
inst_table_get_merge_insts(InstTable, MergeInstMap),
- map.foldl2(write_inst_pair_maybe_inst(Limit), MergeInstMap,
+ map.foldl2(write_inst_pair_maybe_inst(Lang, Limit), MergeInstMap,
0, NumMergeInsts, !IO),
io.format("Total number of merge insts: %d\n", [i(NumMergeInsts)], !IO),
io.write_string("%-------- Ground insts --------\n", !IO),
inst_table_get_unify_insts(InstTable, GroundInstMap),
- map.foldl2(write_inst_name_maybe_inst_det(Limit), GroundInstMap,
+ map.foldl2(write_inst_name_maybe_inst_det(Lang, Limit), GroundInstMap,
0, NumGroundInsts, !IO),
io.format("Total number of ground insts: %d\n", [i(NumGroundInsts)], !IO),
io.write_string("%-------- Any insts --------\n", !IO),
inst_table_get_any_insts(InstTable, AnyInstMap),
- map.foldl2(write_inst_name_maybe_inst_det(Limit), AnyInstMap,
+ map.foldl2(write_inst_name_maybe_inst_det(Lang, Limit), AnyInstMap,
0, NumAnyInsts, !IO),
io.format("Total number of any insts: %d\n", [i(NumAnyInsts)], !IO),
io.write_string("%-------- Shared insts --------\n", !IO),
inst_table_get_shared_insts(InstTable, SharedInstMap),
- map.foldl2(write_inst_name_maybe_inst(Limit), SharedInstMap,
+ map.foldl2(write_inst_name_maybe_inst(Lang, Limit), SharedInstMap,
0, NumSharedInsts, !IO),
io.format("Total number of shared insts: %d\n", [i(NumSharedInsts)], !IO),
io.write_string("%-------- MostlyUniq insts --------\n", !IO),
inst_table_get_mostly_uniq_insts(InstTable, MostlyUniqInstMap),
- map.foldl2(write_inst_name_maybe_inst(Limit), MostlyUniqInstMap,
+ map.foldl2(write_inst_name_maybe_inst(Lang, Limit), MostlyUniqInstMap,
0, NumMostlyUniqInsts, !IO),
io.format("Total number of mostly uniq insts: %d\n",
[i(NumMostlyUniqInsts)], !IO).
@@ -696,15 +697,15 @@
write_inst_params(HeadInstVar, TailInstVars, InstVarSet, !IO)
).
-:- pred write_inst_name_maybe_inst(int::in,
+:- pred write_inst_name_maybe_inst(output_lang::in, int::in,
inst_name::in, maybe_inst::in, int::in, int::out, io::di, io::uo) is det.
-write_inst_name_maybe_inst(Limit, InstName, MaybeInst, !N, !IO) :-
+write_inst_name_maybe_inst(Lang, Limit, InstName, MaybeInst, !N, !IO) :-
!:N = !.N + 1,
( !.N =< Limit ->
io.nl(!IO),
io.format("Entry %d key\n", [i(!.N)], !IO),
- write_inst_name(InstName, !IO),
+ write_inst_name(Lang, InstName, !IO),
io.nl(!IO),
(
MaybeInst = inst_unknown,
@@ -712,23 +713,23 @@
;
MaybeInst = inst_known(Inst),
io.format("Entry %d value:\n", [i(!.N)], !IO),
- write_inst(Inst, !IO),
+ write_inst(Lang, Inst, !IO),
io.nl(!IO)
)
;
true
).
-:- pred write_inst_name_maybe_inst_det(int::in,
+:- pred write_inst_name_maybe_inst_det(output_lang::in, int::in,
inst_name::in, maybe_inst_det::in, int::in, int::out,
io::di, io::uo) is det.
-write_inst_name_maybe_inst_det(Limit, InstName, MaybeInstDet, !N, !IO) :-
+write_inst_name_maybe_inst_det(Lang, Limit, InstName, MaybeInstDet, !N, !IO) :-
!:N = !.N + 1,
( !.N =< Limit ->
io.nl(!IO),
io.format("Entry %d key\n", [i(!.N)], !IO),
- write_inst_name(InstName, !IO),
+ write_inst_name(Lang, InstName, !IO),
io.nl(!IO),
(
MaybeInstDet = inst_det_unknown,
@@ -737,26 +738,26 @@
MaybeInstDet = inst_det_known(Inst, Detism),
DetismStr = determinism_to_string(Detism),
io.format("Entry %d value (%s):\n", [i(!.N), s(DetismStr)], !IO),
- write_inst(Inst, !IO),
+ write_inst(Lang, Inst, !IO),
io.nl(!IO)
)
;
true
).
-:- pred write_inst_pair_maybe_inst(int::in,
+:- pred write_inst_pair_maybe_inst(output_lang::in, int::in,
pair(mer_inst)::in, maybe_inst::in, int::in, int::out,
io::di, io::uo) is det.
-write_inst_pair_maybe_inst(Limit, InstA - InstB, MaybeInst, !N, !IO) :-
+write_inst_pair_maybe_inst(Lang, Limit, InstA - InstB, MaybeInst, !N, !IO) :-
!:N = !.N + 1,
( !.N =< Limit ->
io.nl(!IO),
io.format("Entry %d left key\n", [i(!.N)], !IO),
- write_inst(InstA, !IO),
+ write_inst(Lang, InstA, !IO),
io.nl(!IO),
io.format("Entry %d right key\n", [i(!.N)], !IO),
- write_inst(InstB, !IO),
+ write_inst(Lang, InstB, !IO),
io.nl(!IO),
(
MaybeInst = inst_unknown,
@@ -764,24 +765,24 @@
;
MaybeInst = inst_known(Inst),
io.format("Entry %d value:\n", [i(!.N)], !IO),
- write_inst(Inst, !IO),
+ write_inst(Lang, Inst, !IO),
io.nl(!IO)
)
;
true
).
-:- pred write_inst_name(inst_name::in, io::di, io::uo) is det.
+:- pred write_inst_name(output_lang::in, inst_name::in, io::di, io::uo) is det.
-write_inst_name(InstName, !IO) :-
- InstNameTerm = inst_name_to_term(InstName),
+write_inst_name(Lang, InstName, !IO) :-
+ InstNameTerm = inst_name_to_term(Lang, InstName),
varset.init(VarSet),
mercury_output_term(VarSet, no, InstNameTerm, !IO).
-:- pred write_inst(mer_inst::in, io::di, io::uo) is det.
+:- pred write_inst(output_lang::in, mer_inst::in, io::di, io::uo) is det.
-write_inst(Inst, !IO) :-
- InstTerm = inst_to_term(Inst),
+write_inst(Lang, Inst, !IO) :-
+ InstTerm = inst_to_term(Lang, Inst),
varset.init(VarSet),
mercury_output_term(VarSet, no, InstTerm, !IO).
@@ -912,20 +913,20 @@
% Write out the predicate table.
%
-:- pred write_preds(hlds_out_info::in, int::in, module_info::in,
- pred_table::in, io::di, io::uo) is det.
+:- pred write_preds(hlds_out_info::in, output_lang::in, int::in,
+ module_info::in, pred_table::in, io::di, io::uo) is det.
-write_preds(Info, Indent, ModuleInfo, PredTable, !IO) :-
+write_preds(Info, Lang, Indent, ModuleInfo, PredTable, !IO) :-
io.write_string("%-------- Predicates --------\n\n", !IO),
write_indent(Indent, !IO),
map.keys(PredTable, PredIds),
- list.foldl(maybe_write_pred(Info, Indent, ModuleInfo, PredTable), PredIds,
- !IO).
+ list.foldl(maybe_write_pred(Info, Lang, Indent, ModuleInfo, PredTable),
+ PredIds, !IO).
-:- pred maybe_write_pred(hlds_out_info::in, int::in, module_info::in,
- pred_table::in, pred_id::in, io::di, io::uo) is det.
+:- pred maybe_write_pred(hlds_out_info::in, output_lang::in, int::in,
+ module_info::in, pred_table::in, pred_id::in, io::di, io::uo) is det.
-maybe_write_pred(Info, Indent, ModuleInfo, PredTable, PredId, !IO) :-
+maybe_write_pred(Info, Lang, Indent, ModuleInfo, PredTable, PredId, !IO) :-
DumpOptions = Info ^ hoi_dump_hlds_options,
DumpPredIdStrs = Info ^ hoi_dump_hlds_pred_ids,
DumpPredNames = Info ^ hoi_dump_hlds_pred_names,
@@ -951,7 +952,7 @@
list.member(PredName, DumpPredNames)
)
->
- write_pred(Info, Indent, ModuleInfo, PredId, PredInfo, !IO)
+ write_pred(Info, Lang, Indent, ModuleInfo, PredId, PredInfo, !IO)
;
true
)
@@ -979,7 +980,7 @@
->
true
;
- write_pred(Info, Indent, ModuleInfo, PredId, PredInfo, !IO)
+ write_pred(Info, Lang, Indent, ModuleInfo, PredId, PredInfo, !IO)
)
).
Index: compiler/hlds_out_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out_pred.m,v
retrieving revision 1.11
diff -u -b -r1.11 hlds_out_pred.m
--- compiler/hlds_out_pred.m 27 Mar 2012 23:21:27 -0000 1.11
+++ compiler/hlds_out_pred.m 17 Apr 2012 12:33:25 -0000
@@ -27,17 +27,17 @@
%-----------------------------------------------------------------------------%
-:- pred write_pred(hlds_out_info::in, int::in, module_info::in,
- pred_id::in, pred_info::in, io::di, io::uo) is det.
+:- pred write_pred(hlds_out_info::in, output_lang::in, int::in,
+ module_info::in, pred_id::in, pred_info::in, io::di, io::uo) is det.
- % write_clause(Info, Indent, ModuleInfo, PredId, VarSet,
+ % write_clause(Info, Lang, Indent, ModuleInfo, PredId, VarSet,
% AppendVarNums, HeadTerms, PredOrFunc, Clause, UseDeclaredModes,
% MaybeVarTypes, !IO).
%
-:- pred write_clause(hlds_out_info::in, int::in, module_info::in,
- pred_id::in, prog_varset::in, bool::in, list(prog_term)::in,
- pred_or_func::in, clause::in, bool::in, maybe_vartypes::in,
- io::di, io::uo) is det.
+:- pred write_clause(hlds_out_info::in, output_lang::in, int::in,
+ module_info::in, pred_id::in, prog_varset::in, bool::in,
+ list(prog_term)::in, pred_or_func::in, clause::in, bool::in,
+ maybe_vartypes::in, io::di, io::uo) is det.
% write_proc(Info, Indent, AppendVarNums, ModuleInfo, PredId, ProcId,
% ImportStatus, Proc, !IO).
@@ -101,7 +101,7 @@
% Write out predicates.
%
-write_pred(Info, Indent, ModuleInfo, PredId, PredInfo, !IO) :-
+write_pred(Info, Lang, Indent, ModuleInfo, PredId, PredInfo, !IO) :-
Module = pred_info_module(PredInfo),
PredName = pred_info_name(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
@@ -209,8 +209,8 @@
(
Clauses = [_ | _],
set_dump_opts_for_clauses(Info, InfoForClauses),
- write_clauses(InfoForClauses, Indent, ModuleInfo, PredId, VarSet,
- AppendVarNums, HeadVars, PredOrFunc, Clauses,
+ write_clauses(InfoForClauses, Lang, Indent, ModuleInfo,
+ PredId, VarSet, AppendVarNums, HeadVars, PredOrFunc, Clauses,
no_varset_vartypes, !IO)
;
Clauses = []
@@ -314,24 +314,25 @@
% write_clauses(Info, Indent, ModuleInfo, PredId, VarSet,
% AppendVarNums, HeadVars, PredOrFunc, Clauses, MaybeVarTypes, !IO).
%
-:- pred write_clauses(hlds_out_info::in, int::in, module_info::in,
- pred_id::in, prog_varset::in, bool::in, proc_arg_vector(prog_var)::in,
- pred_or_func::in, list(clause)::in, maybe_vartypes::in,
- io::di, io::uo) is det.
+:- pred write_clauses(hlds_out_info::in, output_lang::in, int::in,
+ module_info::in, pred_id::in, prog_varset::in, bool::in,
+ proc_arg_vector(prog_var)::in, pred_or_func::in, list(clause)::in,
+ maybe_vartypes::in, io::di, io::uo) is det.
-write_clauses(Info, Indent, ModuleInfo, PredId, VarSet, AppendVarNums,
+write_clauses(Info, Lang, Indent, ModuleInfo, PredId, VarSet, AppendVarNums,
HeadVars, PredOrFunc, Clauses0, TypeQual, !IO) :-
HeadVarList = proc_arg_vector_to_list(HeadVars),
- write_clauses_loop(Info, Indent, ModuleInfo, PredId, VarSet,
+ write_clauses_loop(Info, Lang, Indent, ModuleInfo, PredId, VarSet,
AppendVarNums, HeadVarList, PredOrFunc, Clauses0, TypeQual, 1, !IO).
-:- pred write_clauses_loop(hlds_out_info::in, int::in,
+:- pred write_clauses_loop(hlds_out_info::in, output_lang::in, int::in,
module_info::in, pred_id::in, prog_varset::in, bool::in,
list(prog_var)::in, pred_or_func::in, list(clause)::in, maybe_vartypes::in,
int::in, io::di, io::uo) is det.
-write_clauses_loop(Info, Indent, ModuleInfo, PredId, VarSet, AppendVarNums,
- HeadVars, PredOrFunc, Clauses0, TypeQual, ClauseNum, !IO) :-
+write_clauses_loop(Info, Lang, Indent, ModuleInfo, PredId,
+ VarSet, AppendVarNums, HeadVars, PredOrFunc, Clauses0,
+ TypeQual, ClauseNum, !IO) :-
(
Clauses0 = [Clause | Clauses],
term.var_list_to_term_list(HeadVars, HeadTerms),
@@ -339,19 +340,20 @@
io.write_string("% clause ", !IO),
io.write_int(ClauseNum, !IO),
io.write_string("\n", !IO),
- write_clause(Info, Indent, ModuleInfo, PredId, VarSet,
+ write_clause(Info, Lang, Indent, ModuleInfo, PredId, VarSet,
AppendVarNums, HeadTerms, PredOrFunc, Clause,
UseDeclaredModes, TypeQual, !IO),
- write_clauses_loop(Info, Indent, ModuleInfo, PredId, VarSet,
+ write_clauses_loop(Info, Lang, Indent, ModuleInfo, PredId, VarSet,
AppendVarNums, HeadVars, PredOrFunc, Clauses, TypeQual,
ClauseNum + 1, !IO)
;
Clauses0 = []
).
-write_clause(Info, Indent, ModuleInfo, PredId, VarSet, AppendVarNums,
+write_clause(Info, Lang, Indent, ModuleInfo, PredId, VarSet, AppendVarNums,
HeadTerms, PredOrFunc, Clause, UseDeclaredModes, TypeQual, !IO) :-
- Clause = clause(ApplicableModes, Goal, Lang, Context, _StateVarWarnings),
+ Clause = clause(ApplicableModes, Goal, ImplLang, Context,
+ _StateVarWarnings),
Indent1 = Indent + 1,
DumpOptions = Info ^ hoi_dump_hlds_options,
(
@@ -369,9 +371,9 @@
)
),
(
- Lang = impl_lang_mercury
+ ImplLang = impl_lang_mercury
;
- Lang = impl_lang_foreign(ForeignLang),
+ ImplLang = impl_lang_foreign(ForeignLang),
io.write_string("% Language of implementation: ", !IO),
io.write(ForeignLang, !IO),
io.nl(!IO)
@@ -386,7 +388,7 @@
% multiple clause heads. This won't be pretty and it won't be
% syntactically valid, but it is more useful for debugging
% than a compiler abort during the dumping process.
- write_annotated_clause_heads(ModuleInfo, Context, PredId,
+ write_annotated_clause_heads(ModuleInfo, Lang, Context, PredId,
SelectedProcIds, VarSet, AppendVarNums, HeadTerms, PredOrFunc,
UseDeclaredModes, !IO)
;
@@ -401,25 +403,27 @@
Indent1, ".\n", TypeQual, !IO)
).
-:- pred write_annotated_clause_heads(module_info::in, term.context::in,
- pred_id::in, list(proc_id)::in, prog_varset::in, bool::in,
- list(prog_term)::in, pred_or_func::in, bool::in, io::di, io::uo) is det.
+:- pred write_annotated_clause_heads(module_info::in, output_lang::in,
+ term.context::in, pred_id::in, list(proc_id)::in, prog_varset::in,
+ bool::in, list(prog_term)::in, pred_or_func::in, bool::in,
+ io::di, io::uo) is det.
-write_annotated_clause_heads(_, _, _, [], _, _, _, _, _, !IO).
-write_annotated_clause_heads(ModuleInfo, Context, PredId, [ProcId | ProcIds],
- VarSet, AppendVarNums, HeadTerms, PredOrFunc, UseDeclaredModes, !IO) :-
- write_annotated_clause_head(ModuleInfo, Context, PredId,
+write_annotated_clause_heads(_, _, _, _, [], _, _, _, _, _, !IO).
+write_annotated_clause_heads(ModuleInfo, Lang, Context, PredId,
+ [ProcId | ProcIds], VarSet, AppendVarNums, HeadTerms, PredOrFunc,
+ UseDeclaredModes, !IO) :-
+ write_annotated_clause_head(ModuleInfo, Lang, Context, PredId,
ProcId, VarSet, AppendVarNums, HeadTerms,
PredOrFunc, UseDeclaredModes, !IO),
- write_annotated_clause_heads(ModuleInfo, Context, PredId,
+ write_annotated_clause_heads(ModuleInfo, Lang, Context, PredId,
ProcIds, VarSet, AppendVarNums, HeadTerms,
PredOrFunc, UseDeclaredModes, !IO).
-:- pred write_annotated_clause_head(module_info::in, term.context::in,
- pred_id::in, proc_id::in, prog_varset::in, bool::in, list(prog_term)::in,
- pred_or_func::in, bool::in, io::di, io::uo) is det.
+:- pred write_annotated_clause_head(module_info::in, output_lang::in,
+ term.context::in, pred_id::in, proc_id::in, prog_varset::in, bool::in,
+ list(prog_term)::in, pred_or_func::in, bool::in, io::di, io::uo) is det.
-write_annotated_clause_head(ModuleInfo, Context, PredId, ProcId, VarSet,
+write_annotated_clause_head(ModuleInfo, Lang, Context, PredId, ProcId, VarSet,
AppendVarNums, HeadTerms, PredOrFunc, UseDeclaredModes, !IO) :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_procedures(PredInfo, Procedures),
@@ -444,7 +448,7 @@
),
assoc_list.from_corresponding_lists(HeadTerms, ArgModes,
AnnotatedPairs),
- AnnotatedHeadTerms = list.map(add_mode_qualifier(Context),
+ AnnotatedHeadTerms = list.map(add_mode_qualifier(Lang, Context),
AnnotatedPairs),
write_clause_head(ModuleInfo, PredId, VarSet, AppendVarNums,
AnnotatedHeadTerms, PredOrFunc, !IO)
@@ -454,12 +458,12 @@
true
).
-:- func add_mode_qualifier(prog_context, pair(prog_term, mer_mode))
- = prog_term.
+:- func add_mode_qualifier(output_lang, prog_context,
+ pair(prog_term, mer_mode)) = prog_term.
-add_mode_qualifier(Context, HeadTerm - Mode) = AnnotatedTerm :-
- construct_qualified_term(unqualified("::"),
- [HeadTerm, mode_to_term_with_context(Context, Mode)],
+add_mode_qualifier(Lang, Context, HeadTerm - Mode) = AnnotatedTerm :-
+ construct_qualified_term_with_context(unqualified("::"),
+ [HeadTerm, mode_to_term_with_context(Lang, Context, Mode)],
Context, AnnotatedTerm).
:- pred write_clause_head(module_info::in, pred_id::in,
Index: compiler/hlds_out_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out_util.m,v
retrieving revision 1.5
diff -u -b -r1.5 hlds_out_util.m
--- compiler/hlds_out_util.m 13 Apr 2012 07:20:38 -0000 1.5
+++ compiler/hlds_out_util.m 17 Apr 2012 11:47:58 -0000
@@ -56,6 +56,12 @@
%-----------------------------------------------------------------------------%
+:- type output_lang
+ ---> output_mercury
+ ; output_debug.
+
+%-----------------------------------------------------------------------------%
+
:- pred write_type_ctor(type_ctor::in, io::di, io::uo) is det.
:- func type_ctor_to_string(type_ctor) = string.
Index: compiler/inst_check.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_check.m,v
retrieving revision 1.16
diff -u -b -r1.16 inst_check.m
--- compiler/inst_check.m 16 Jun 2011 06:42:14 -0000 1.16
+++ compiler/inst_check.m 16 Apr 2012 11:03:55 -0000
@@ -148,7 +148,7 @@
(
InstBody = eqv_inst(Inst),
(
- Inst = bound(_, BoundInsts),
+ Inst = bound(_, _, BoundInsts),
(
list.map(bound_inst_to_functor, BoundInsts, Functors)
->
Index: compiler/inst_match.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_match.m,v
retrieving revision 1.98
diff -u -b -r1.98 inst_match.m
--- compiler/inst_match.m 11 Apr 2012 04:52:34 -0000 1.98
+++ compiler/inst_match.m 17 Apr 2012 03:18:30 -0000
@@ -612,6 +612,9 @@
inst_matches_initial_4(InstA, InstB, MaybeType, !Info) :-
% To avoid infinite regress, we assume that inst_matches_initial is true
% for any pairs of insts which occur in `Expansions'.
+ %
+ % XXX Maybe we could use the inst result field of bound/3 insts
+ % in some places.
(
InstA = any(UniqA, HOInstInfoA),
InstB = any(UniqB, HOInstInfoB),
@@ -630,7 +633,7 @@
inst_matches_initial_mt(NextInstA, InstB, MaybeType, !Info)
;
InstA = any(UniqA, HOInstInfoA),
- InstB = bound(_, _),
+ InstB = bound(_, _, _),
maybe_any_to_bound(MaybeType, !.Info ^ imi_module_info, UniqA,
HOInstInfoA, NextInstA),
inst_matches_initial_mt(NextInstA, InstB, MaybeType, !Info)
@@ -638,39 +641,49 @@
InstA = free,
InstB = free
;
- InstA = bound(UniqA, BoundInstsA),
+ InstA = bound(UniqA, _InstResultsA, BoundInstsA),
InstB = any(UniqB, none),
compare_uniqueness(!.Info ^ imi_uniqueness_comparison, UniqA, UniqB),
compare_bound_inst_list_uniq(!.Info ^ imi_uniqueness_comparison,
BoundInstsA, UniqB, !.Info ^ imi_module_info)
;
- InstA = bound(_Uniq, _BoundInstsA),
+ InstA = bound(_, _, _),
InstB = free
;
- InstA = bound(UniqA, BoundInstsA),
- InstB = bound(UniqB, BoundInstsB),
- compare_uniqueness(!.Info ^ imi_uniqueness_comparison, UniqA, UniqB),
- bound_inst_list_matches_initial_mt(BoundInstsA, BoundInstsB, MaybeType,
- !Info)
+ InstA = bound(UniqA, InstResultsA, BoundInstsA),
+ InstB = bound(UniqB, _InstResultsB, BoundInstsB),
+ (
+ same_addr_insts(InstA, InstB),
+ InstResultsA = inst_test_results_fgtc
+ ->
+ true
+ ;
+ compare_uniqueness(!.Info ^ imi_uniqueness_comparison,
+ UniqA, UniqB),
+ bound_inst_list_matches_initial_mt(BoundInstsA, BoundInstsB,
+ MaybeType, !Info)
+ )
;
- InstA = bound(UniqA, BoundInstsA),
+ InstA = bound(UniqA, InstResultsA, BoundInstsA),
InstB = ground(UniqB, none),
compare_uniqueness(!.Info ^ imi_uniqueness_comparison, UniqA, UniqB),
- bound_inst_list_is_ground(BoundInstsA, MaybeType,
- !.Info ^ imi_module_info),
+ inst_results_bound_inst_list_is_ground_mt(InstResultsA, BoundInstsA,
+ MaybeType, !.Info ^ imi_module_info),
compare_bound_inst_list_uniq(!.Info ^ imi_uniqueness_comparison,
BoundInstsA, UniqB, !.Info ^ imi_module_info)
;
- InstA = bound(Uniq, BoundInstsA),
+ InstA = bound(Uniq, InstResultsA, BoundInstsA),
InstB = abstract_inst(_,_),
Uniq = unique,
- bound_inst_list_is_ground(BoundInstsA, !.Info ^ imi_module_info),
+ inst_results_bound_inst_list_is_ground_mt(InstResultsA, BoundInstsA,
+ no, !.Info ^ imi_module_info),
bound_inst_list_is_unique(BoundInstsA, !.Info ^ imi_module_info)
;
- InstA = bound(Uniq, BoundInstsA),
+ InstA = bound(Uniq, InstResultsA, BoundInstsA),
InstB = abstract_inst(_,_),
Uniq = mostly_unique,
- bound_inst_list_is_ground(BoundInstsA, !.Info ^ imi_module_info),
+ inst_results_bound_inst_list_is_ground_mt(InstResultsA, BoundInstsA,
+ no, !.Info ^ imi_module_info),
bound_inst_list_is_mostly_unique(BoundInstsA, !.Info ^ imi_module_info)
;
InstA = ground(UniqA, HOInstInfoA),
@@ -683,7 +696,7 @@
InstB = free
;
InstA = ground(UniqA, _GII_A),
- InstB = bound(UniqB, BoundInstsB),
+ InstB = bound(UniqB, _InstResultsB, BoundInstsB),
MaybeType = yes(Type),
% We can only check this case properly if the type is known.
compare_uniqueness(!.Info ^ imi_uniqueness_comparison, UniqA, UniqB),
@@ -795,7 +808,7 @@
inst_is_complete_for_type(set.insert(Expansions, Name),
ModuleInfo, ExpandedInst, Type)
)
- ; Inst = bound(_, BoundInsts) ->
+ ; Inst = bound(_, _, BoundInsts) ->
bound_inst_list_is_complete_for_type(Expansions, ModuleInfo,
BoundInsts, Type)
;
@@ -1062,7 +1075,7 @@
inst_matches_final_mt(NextInstA, InstB, MaybeType, !Info)
;
InstA = any(UniqA, HOInstInfoA),
- InstB = bound(_, _),
+ InstB = bound(_, _, _),
maybe_any_to_bound(MaybeType, !.Info ^ imi_module_info, UniqA,
HOInstInfoA, NextInstA),
inst_matches_final_mt(NextInstA, InstB, MaybeType, !Info)
@@ -1078,7 +1091,7 @@
InstA = free,
InstB = free
;
- InstA = bound(UniqA, BoundInstsA),
+ InstA = bound(UniqA, InstResultsA, BoundInstsA),
InstB = any(UniqB, none),
unique_matches_final(UniqA, UniqB),
bound_inst_list_matches_uniq(BoundInstsA, UniqB,
@@ -1086,20 +1099,20 @@
% We do not yet allow `free' to match `any'.
% Among other things, changing this would break compare_inst
% in modecheck_call.m.
- bound_inst_list_is_ground_or_any(BoundInstsA,
+ inst_results_bound_inst_list_is_ground_or_any(InstResultsA, BoundInstsA,
!.Info ^ imi_module_info)
;
- InstA = bound(UniqA, BoundInstsA),
- InstB = bound(UniqB, BoundInstsB),
+ InstA = bound(UniqA, _InstResultsA, BoundInstsA),
+ InstB = bound(UniqB, _InstResultsB, BoundInstsB),
unique_matches_final(UniqA, UniqB),
bound_inst_list_matches_final(BoundInstsA, BoundInstsB, MaybeType,
!Info)
;
- InstA = bound(UniqA, BoundInstsA),
+ InstA = bound(UniqA, InstResultsA, BoundInstsA),
InstB = ground(UniqB, none),
unique_matches_final(UniqA, UniqB),
- bound_inst_list_is_ground(BoundInstsA, MaybeType,
- !.Info ^ imi_module_info),
+ inst_results_bound_inst_list_is_ground_mt(InstResultsA, BoundInstsA,
+ MaybeType, !.Info ^ imi_module_info),
bound_inst_list_matches_uniq(BoundInstsA, UniqB,
!.Info ^ imi_module_info)
;
@@ -1109,11 +1122,12 @@
unique_matches_final(UniqA, UniqB)
;
InstA = ground(UniqA, HOInstInfoA),
- InstB = bound(UniqB, BoundInstsB),
+ InstB = bound(UniqB, InstResultsB, BoundInstsB),
ModuleInfo = !.Info ^ imi_module_info,
\+ ho_inst_info_is_nonstandard_func_mode(ModuleInfo, HOInstInfoA),
unique_matches_final(UniqA, UniqB),
- bound_inst_list_is_ground(BoundInstsB, MaybeType, ModuleInfo),
+ inst_results_bound_inst_list_is_ground_mt(InstResultsB, BoundInstsB,
+ MaybeType, ModuleInfo),
uniq_matches_bound_inst_list(UniqA, BoundInstsB, ModuleInfo),
(
MaybeType = yes(Type),
@@ -1280,7 +1294,7 @@
inst_matches_binding_mt(NextInstA, InstB, MaybeType, !Info)
;
InstA = any(UniqA, HOInstInfoA),
- InstB = bound(_, _),
+ InstB = bound(_, _, _),
maybe_any_to_bound(MaybeType, !.Info ^ imi_module_info, UniqA,
HOInstInfoA, NextInstA),
inst_matches_binding_mt(NextInstA, InstB, MaybeType, !Info)
@@ -1291,26 +1305,26 @@
HOInstInfoB, NextInstB),
inst_matches_binding_mt(InstA, NextInstB, MaybeType, !Info)
;
- InstA = bound(_, _),
+ InstA = bound(_, _, _),
InstB = any(UniqB, HOInstInfoB),
maybe_any_to_bound(MaybeType, !.Info ^ imi_module_info, UniqB,
HOInstInfoB, NextInstB),
inst_matches_binding_mt(InstA, NextInstB, MaybeType, !Info)
;
- InstA = bound(_UniqA, BoundInstsA),
- InstB = bound(_UniqB, BoundInstsB),
+ InstA = bound(_UniqA, _InstResultA, BoundInstsA),
+ InstB = bound(_UniqB, _InstResultB, BoundInstsB),
bound_inst_list_matches_binding(BoundInstsA, BoundInstsB, MaybeType,
!Info)
;
- InstA = bound(_UniqA, BoundInstsA),
+ InstA = bound(_UniqA, InstResultsA, BoundInstsA),
InstB = ground(_UniqB, none),
- bound_inst_list_is_ground(BoundInstsA, MaybeType,
- !.Info ^ imi_module_info)
+ inst_results_bound_inst_list_is_ground_mt(InstResultsA, BoundInstsA,
+ MaybeType, !.Info ^ imi_module_info)
;
InstA = ground(_UniqA, _),
- InstB = bound(_UniqB, BoundInstsB),
- bound_inst_list_is_ground(BoundInstsB, MaybeType,
- !.Info ^ imi_module_info),
+ InstB = bound(_UniqB, InstResultsB, BoundInstsB),
+ inst_results_bound_inst_list_is_ground_mt(InstResultsB, BoundInstsB,
+ MaybeType, !.Info ^ imi_module_info),
(
MaybeType = yes(Type),
% We can only do this check if the type is known.
@@ -1413,8 +1427,8 @@
; Inst = any(clobbered, _)
; Inst = ground(clobbered, _)
; Inst = ground(mostly_clobbered, _)
- ; Inst = bound(clobbered, _)
- ; Inst = bound(mostly_clobbered, _)
+ ; Inst = bound(clobbered, _, _)
+ ; Inst = bound(mostly_clobbered, _, _)
)
;
Inst = inst_var(_),
@@ -1436,7 +1450,7 @@
)
;
( Inst = ground(_, _)
- ; Inst = bound(_, _)
+ ; Inst = bound(_, _, _)
; Inst = any(_, _)
; Inst = not_reached
; Inst = abstract_inst(_, _) % XXX is this right?
@@ -1462,7 +1476,7 @@
( Inst = free
; Inst = free(_)
; Inst = ground(_, _)
- ; Inst = bound(_, _)
+ ; Inst = bound(_, _, _)
; Inst = not_reached
; Inst = abstract_inst(_, _) % XXX is this right?
),
@@ -1483,7 +1497,7 @@
require_complete_switch [Inst]
(
( Inst = ground(_, _)
- ; Inst = bound(_, _)
+ ; Inst = bound(_, _, _)
; Inst = any(_, _)
; Inst = abstract_inst(_, _) % XXX is this right?
; Inst = not_reached
@@ -1512,7 +1526,7 @@
%
require_complete_switch [Inst]
(
- Inst = bound(_Uniq, Functors)
+ Inst = bound(_Uniq, _InstResult, Functors)
;
Inst = inst_var(_),
unexpected($module, $pred, "uninstantiated inst parameter")
@@ -1615,7 +1629,8 @@
** for filled-in entries.
*/
-static InstIsGroundCacheEntry inst_is_ground_cache[INST_IS_GROUND_CACHE_SIZE];
+static InstIsGroundCacheEntry
+ inst_is_ground_cache[INST_IS_GROUND_CACHE_SIZE];
").
% Look up Inst in the cache. If it is there, return Found = yes
@@ -1712,9 +1727,9 @@
; Inst = ground(_, _)
)
;
- Inst = bound(_, BoundInsts),
- bound_inst_list_is_ground_mt_2(BoundInsts, MaybeType, ModuleInfo,
- !Expansions)
+ Inst = bound(_, InstResults, BoundInsts),
+ inst_results_bound_inst_list_is_ground_mt_2(InstResults, BoundInsts,
+ MaybeType, ModuleInfo, !Expansions)
;
Inst = constrained_inst_vars(_, SubInst),
inst_is_ground_mt_1(ModuleInfo, MaybeType, SubInst, !Expansions)
@@ -1737,9 +1752,6 @@
fail
).
- % 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(Expansions0),
inst_is_ground_or_any_2(ModuleInfo, Inst, Expansions0, _Expansions).
@@ -1758,8 +1770,9 @@
; Inst = not_reached
)
;
- Inst = bound(_, BoundInsts),
- bound_inst_list_is_ground_or_any_2(BoundInsts, ModuleInfo, !Expansions)
+ Inst = bound(_, InstResults, BoundInsts),
+ inst_results_bound_inst_list_is_ground_or_any_2(InstResults,
+ BoundInsts, ModuleInfo, !Expansions)
;
( Inst = free
; Inst = free(_)
@@ -1805,13 +1818,21 @@
)
;
( Inst = ground(shared, _)
- ; Inst = bound(shared, _)
+ ; Inst = bound(shared, _, _)
; Inst = any(shared, _)
),
fail
;
- Inst = bound(unique, BoundInsts),
+ Inst = bound(unique, InstResults, BoundInsts),
+ (
+ InstResults = inst_test_results_fgtc,
+ fail
+ ;
+ ( InstResults = inst_test_no_results
+ ; InstResults = inst_test_results(_, _, _, _)
+ ),
bound_inst_list_is_unique_2(BoundInsts, ModuleInfo, !Expansions)
+ )
;
Inst = inst_var(_),
unexpected($module, $pred, "uninstantiated inst parameter")
@@ -1854,11 +1875,17 @@
; Inst = any(mostly_unique, _)
)
;
- Inst = bound(unique, BoundInsts),
- bound_inst_list_is_mostly_unique_2(BoundInsts, ModuleInfo, !Expansions)
+ Inst = bound(unique, InstResults, BoundInsts),
+ (
+ InstResults = inst_test_results_fgtc,
+ fail
;
- Inst = bound(mostly_unique, BoundInsts),
- bound_inst_list_is_mostly_unique_2(BoundInsts, ModuleInfo, !Expansions)
+ ( InstResults = inst_test_no_results
+ ; InstResults = inst_test_results(_, _, _, _)
+ ),
+ bound_inst_list_is_mostly_unique_2(BoundInsts, ModuleInfo,
+ !Expansions)
+ )
;
Inst = inst_var(_),
unexpected($module, $pred, "uninstantiated inst parameter")
@@ -1905,9 +1932,16 @@
; Inst = ground(shared, _)
)
;
- Inst = bound(shared, BoundInsts),
+ Inst = bound(shared, InstResult, BoundInsts),
+ (
+ InstResult = inst_test_results_fgtc
+ ;
+ ( InstResult = inst_test_no_results
+ ; InstResult = inst_test_results(_, _, _, _)
+ ),
bound_inst_list_is_not_partly_unique_2(BoundInsts, ModuleInfo,
!Expansions)
+ )
;
Inst = inst_var(_),
unexpected($module, $pred, "uninstantiated inst parameter")
@@ -1957,13 +1991,19 @@
; Inst = any(mostly_unique, _)
)
;
- Inst = bound(shared, BoundInsts),
- bound_inst_list_is_not_fully_unique_2(BoundInsts, ModuleInfo,
- !Expansions)
+ Inst = bound(Uniq, InstResult, BoundInsts),
+ ( Uniq = shared
+ ; Uniq = mostly_unique
+ ),
+ (
+ InstResult = inst_test_results_fgtc
;
- Inst = bound(mostly_unique, BoundInsts),
+ ( InstResult = inst_test_no_results
+ ; InstResult = inst_test_results(_, _, _, _)
+ ),
bound_inst_list_is_not_fully_unique_2(BoundInsts, ModuleInfo,
!Expansions)
+ )
;
Inst = inst_var(_),
unexpected($module, $pred, "uninstantiated inst parameter")
@@ -1990,18 +2030,69 @@
%-----------------------------------------------------------------------------%
bound_inst_list_is_ground(BoundInsts, ModuleInfo) :-
- bound_inst_list_is_ground(BoundInsts, no, ModuleInfo).
+ bound_inst_list_is_ground_mt(BoundInsts, no, ModuleInfo).
+
+:- pred inst_results_bound_inst_list_is_ground_mt(inst_test_results::in,
+ list(bound_inst)::in, maybe(mer_type)::in, module_info::in) is semidet.
+
+inst_results_bound_inst_list_is_ground_mt(InstResults, BoundInsts,
+ MaybeType, ModuleInfo) :-
+ require_complete_switch [InstResults]
+ (
+ InstResults = inst_test_results_fgtc
+ ;
+ InstResults = inst_test_results(GroundnessResult, _, _, _),
+ require_complete_switch [GroundnessResult]
+ (
+ GroundnessResult = inst_result_is_ground
+ ;
+ GroundnessResult = inst_result_is_not_ground,
+ fail
+ ;
+ GroundnessResult = inst_result_groundness_unknown,
+ bound_inst_list_is_ground_mt(BoundInsts, MaybeType, ModuleInfo)
+ )
+ ;
+ InstResults = inst_test_no_results,
+ bound_inst_list_is_ground_mt(BoundInsts, MaybeType, ModuleInfo)
+ ).
-:- pred bound_inst_list_is_ground(list(bound_inst)::in, maybe(mer_type)::in,
+:- pred bound_inst_list_is_ground_mt(list(bound_inst)::in, maybe(mer_type)::in,
module_info::in) is semidet.
-bound_inst_list_is_ground([], _, _).
-bound_inst_list_is_ground([BoundInst | BoundInsts], MaybeType, ModuleInfo) :-
+bound_inst_list_is_ground_mt([], _, _).
+bound_inst_list_is_ground_mt([BoundInst | BoundInsts], MaybeType,
+ ModuleInfo) :-
BoundInst = bound_functor(Name, Args),
maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, Name,
list.length(Args), MaybeTypes),
inst_list_is_ground_mt(Args, MaybeTypes, ModuleInfo),
- bound_inst_list_is_ground(BoundInsts, MaybeType, ModuleInfo).
+ bound_inst_list_is_ground_mt(BoundInsts, MaybeType, ModuleInfo).
+
+:- pred inst_results_bound_inst_list_is_ground_or_any(inst_test_results::in,
+ list(bound_inst)::in, module_info::in) is semidet.
+
+inst_results_bound_inst_list_is_ground_or_any(InstResults, BoundInsts,
+ ModuleInfo) :-
+ require_complete_switch [InstResults]
+ (
+ InstResults = inst_test_results_fgtc
+ ;
+ InstResults = inst_test_results(GroundnessResult, _, _, _),
+ require_complete_switch [GroundnessResult]
+ (
+ GroundnessResult = inst_result_is_ground
+ ;
+ GroundnessResult = inst_result_is_not_ground,
+ fail
+ ;
+ GroundnessResult = inst_result_groundness_unknown,
+ bound_inst_list_is_ground_or_any(BoundInsts, ModuleInfo)
+ )
+ ;
+ InstResults = inst_test_no_results,
+ bound_inst_list_is_ground_or_any(BoundInsts, ModuleInfo)
+ ).
bound_inst_list_is_ground_or_any([], _).
bound_inst_list_is_ground_or_any([BoundInst | BoundInsts], ModuleInfo) :-
@@ -2035,6 +2126,34 @@
%-----------------------------------------------------------------------------%
+:- pred inst_results_bound_inst_list_is_ground_mt_2(inst_test_results::in,
+ list(bound_inst)::in, maybe(mer_type)::in, module_info::in,
+ set_tree234(mer_inst)::in, set_tree234(mer_inst)::out) is semidet.
+
+inst_results_bound_inst_list_is_ground_mt_2(InstResults, BoundInsts,
+ MaybeType, ModuleInfo, !Expansions) :-
+ require_complete_switch [InstResults]
+ (
+ InstResults = inst_test_results_fgtc
+ ;
+ InstResults = inst_test_results(GroundnessResult, _, _, _),
+ require_complete_switch [GroundnessResult]
+ (
+ GroundnessResult = inst_result_is_ground
+ ;
+ GroundnessResult = inst_result_is_not_ground,
+ fail
+ ;
+ GroundnessResult = inst_result_groundness_unknown,
+ bound_inst_list_is_ground_mt_2(BoundInsts, MaybeType, ModuleInfo,
+ !Expansions)
+ )
+ ;
+ InstResults = inst_test_no_results,
+ bound_inst_list_is_ground_mt_2(BoundInsts, MaybeType, ModuleInfo,
+ !Expansions)
+ ).
+
:- pred bound_inst_list_is_ground_mt_2(list(bound_inst)::in,
maybe(mer_type)::in, module_info::in,
set_tree234(mer_inst)::in, set_tree234(mer_inst)::out) is semidet.
@@ -2049,6 +2168,33 @@
bound_inst_list_is_ground_mt_2(BoundInsts, MaybeType, ModuleInfo,
!Expansions).
+:- pred inst_results_bound_inst_list_is_ground_or_any_2(inst_test_results::in,
+ list(bound_inst)::in, module_info::in,
+ set(mer_inst)::in, set(mer_inst)::out) is semidet.
+
+inst_results_bound_inst_list_is_ground_or_any_2(InstResults, BoundInsts,
+ ModuleInfo, !Expansions) :-
+ require_complete_switch [InstResults]
+ (
+ InstResults = inst_test_results_fgtc
+ ;
+ InstResults = inst_test_results(GroundnessResult, _, _, _),
+ require_complete_switch [GroundnessResult]
+ (
+ GroundnessResult = inst_result_is_ground
+ ;
+ GroundnessResult = inst_result_is_not_ground,
+ fail
+ ;
+ GroundnessResult = inst_result_groundness_unknown,
+ bound_inst_list_is_ground_or_any_2(BoundInsts, ModuleInfo,
+ !Expansions)
+ )
+ ;
+ InstResults = inst_test_no_results,
+ bound_inst_list_is_ground_or_any_2(BoundInsts, ModuleInfo, !Expansions)
+ ).
+
:- pred bound_inst_list_is_ground_or_any_2(list(bound_inst)::in,
module_info::in, set(mer_inst)::in, set(mer_inst)::out) is semidet.
@@ -2276,7 +2422,7 @@
)
)
;
- Inst = bound(_Uniq, ArgInsts),
+ Inst = bound(_Uniq, InstResults, ArgInsts),
% XXX This code has a performance problem.
%
% The problem is that e.g. in a list of length N, you will have N
@@ -2294,8 +2440,32 @@
% We could try to solve this performance problem with a cache
% of the results of recent invocations of inst_contains_instname.
+ (
+ InstResults = inst_test_results_fgtc,
+ Contains = no
+ ;
+ InstResults = inst_test_results(_, _, InstNamesResult, _),
+ (
+ InstNamesResult =
+ inst_result_contains_instnames_known(InstNameSet),
+ ( set.contains(InstNameSet, InstName) ->
+ % The Inst may contain InstName, and probably does,
+ % but verify it.
bound_inst_list_contains_instname(ArgInsts, ModuleInfo,
InstName, Contains, !Expansions)
+ ;
+ Contains = no
+ )
+ ;
+ InstNamesResult = inst_result_contains_instnames_unknown,
+ bound_inst_list_contains_instname(ArgInsts, ModuleInfo,
+ InstName, Contains, !Expansions)
+ )
+ ;
+ InstResults = inst_test_no_results,
+ bound_inst_list_contains_instname(ArgInsts, ModuleInfo,
+ InstName, Contains, !Expansions)
+ )
).
:- pred bound_inst_list_contains_instname(list(bound_inst)::in,
@@ -2382,8 +2552,16 @@
Inst = defined_inst(InstName),
inst_name_contains_inst_var(InstName, InstVar)
;
- Inst = bound(_Uniq, ArgInsts),
- bound_inst_list_contains_inst_var(ArgInsts, InstVar)
+ Inst = bound(_Uniq, InstResults, BoundInsts),
+ (
+ InstResults = inst_test_results_fgtc,
+ fail
+ ;
+ ( InstResults = inst_test_no_results
+ ; InstResults = inst_test_results(_, _, _, _)
+ ),
+ bound_inst_list_contains_inst_var(BoundInsts, InstVar)
+ )
;
Inst = ground(_Uniq, HOInstInfo),
HOInstInfo = higher_order(pred_inst_info(_PredOrFunc, Modes, _, _Det)),
@@ -2460,7 +2638,15 @@
constructors_to_bound_any_insts(ModuleInfo, Uniq, TypeCtor,
Constructors, BoundInsts0),
list.sort_and_remove_dups(BoundInsts0, BoundInsts),
- Inst = bound(Uniq, BoundInsts)
+ % If all the constructors are constant, then Inst will be ground
+ % and will not contain any.
+ InstResult = inst_test_results(
+ inst_result_groundness_unknown,
+ inst_result_contains_any_unknown,
+ inst_result_contains_instnames_known(set.init),
+ inst_result_contains_types_known(set.init)
+ ),
+ Inst = bound(Uniq, InstResult, BoundInsts)
; type_may_contain_solver_type(ModuleInfo, Type) ->
% For a type for which constructors are not available (e.g. an
% abstract type) and which may contain solver types, we fail, meaning
@@ -2499,5 +2685,16 @@
).
%-----------------------------------------------------------------------------%
+
+:- pred same_addr_insts(mer_inst::in, mer_inst::in) is semidet.
+
+:- pragma foreign_proc("C",
+ same_addr_insts(InstA::in, InstB::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ SUCCESS_INDICATOR = ((void *) InstA == (void *) InstB);
+").
+
+%-----------------------------------------------------------------------------%
:- end_module check_hlds.inst_match.
%-----------------------------------------------------------------------------%
Index: compiler/inst_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_util.m,v
retrieving revision 1.69
diff -u -b -r1.69 inst_util.m
--- compiler/inst_util.m 11 Apr 2012 04:52:35 -0000 1.69
+++ compiler/inst_util.m 17 Apr 2012 05:06:23 -0000
@@ -264,7 +264,7 @@
InstB = free,
fail
;
- InstB = bound(UniqB, BoundInstsB),
+ InstB = bound(UniqB, InstResultsB, BoundInstsB),
unify_uniq(is_live, Real, detism_det, unique, UniqB, Uniq),
% Since both are live, we must disallow free-free unifications.
bound_inst_list_is_ground_or_any(BoundInstsB, !.ModuleInfo),
@@ -276,7 +276,7 @@
;
BoundInsts = BoundInstsB
),
- Inst = bound(Uniq, BoundInsts),
+ Inst = bound(Uniq, InstResultsB, BoundInsts),
Detism = detism_det
;
InstB = ground(UniqB, HOInstInfoB),
@@ -314,7 +314,7 @@
Detism = detism_det
)
;
- InstA = bound(UniqA, BoundInstsA),
+ InstA = bound(UniqA, InstResultsA, BoundInstsA),
require_complete_switch [InstB]
(
InstB = not_reached,
@@ -335,20 +335,42 @@
unify_uniq(Live, Real, detism_det, UniqA, unique, Uniq),
BoundInsts = BoundInstsA
),
- Inst = bound(Uniq, BoundInsts),
+ Inst = bound(Uniq, InstResultsA, BoundInsts),
Detism = detism_det
;
- InstB = bound(UniqB, BoundInstsB),
+ InstB = bound(UniqB, _InstResultsB, BoundInstsB),
abstractly_unify_bound_inst_list(Live, BoundInstsA, BoundInstsB,
Real, BoundInsts, Detism, !ModuleInfo),
unify_uniq(Live, Real, Detism, UniqA, UniqB, Uniq),
- Inst = bound(Uniq, BoundInsts)
+ % XXX A better approximation of InstResults is probably possible.
+ Inst = bound(Uniq, inst_test_no_results, BoundInsts)
;
InstB = ground(UniqB, _),
unify_uniq(Live, Real, detism_semi, UniqA, UniqB, Uniq),
+ (
+ InstResultsA = inst_test_results_fgtc,
+ Inst = InstA,
+ Detism1 = detism_semi
+ ;
+ InstResultsA = inst_test_results(GroundnessResultA, _, _, _),
+ (
+ GroundnessResultA = inst_result_is_ground,
+ Inst = InstA,
+ Detism1 = detism_semi
+ ;
+ ( GroundnessResultA = inst_result_is_not_ground
+ ; GroundnessResultA = inst_result_groundness_unknown
+ ),
make_ground_bound_inst_list(BoundInstsA, Live, UniqB, Real,
BoundInsts, Detism1, !ModuleInfo),
- Inst = bound(Uniq, BoundInsts),
+ Inst = bound(Uniq, InstResultsA, BoundInsts)
+ )
+ ;
+ InstResultsA = inst_test_no_results,
+ make_ground_bound_inst_list(BoundInstsA, Live, UniqB, Real,
+ BoundInsts, Detism1, !ModuleInfo),
+ Inst = bound(Uniq, InstResultsA, BoundInsts)
+ ),
det_par_conjunction_detism(Detism1, detism_semi, Detism)
;
InstB = any(UniqB, _),
@@ -357,7 +379,8 @@
% XXX Should this is_live be Live?
make_any_bound_inst_list(BoundInstsA, is_live, UniqB, Real,
BoundInsts, Detism1, !ModuleInfo),
- Inst = bound(Uniq, BoundInsts),
+ % XXX A better approximation of InstResults is probably possible.
+ Inst = bound(Uniq, inst_test_no_results, BoundInsts),
det_par_conjunction_detism(Detism1, detism_semi, Detism)
;
InstB = constrained_inst_vars(InstVarsB, SubInstB),
@@ -424,12 +447,12 @@
Inst = ground(Uniq, HOInstInfoA),
Detism = detism_det
;
- InstB = bound(UniqB, BoundInstsB),
+ InstB = bound(UniqB, InstResultsB, BoundInstsB),
% If Live = is_live, should we check `Real = fake_unify'?
unify_uniq(Live, Real, detism_semi, UniqA, UniqB, Uniq),
make_ground_bound_inst_list(BoundInstsB, Live, UniqA, Real,
BoundInsts, Detism1, !ModuleInfo),
- Inst = bound(Uniq, BoundInsts),
+ Inst = bound(Uniq, InstResultsB, BoundInsts),
det_par_conjunction_detism(Detism1, detism_semi, Detism)
;
InstB = ground(UniqB, _HOInstInfoB),
@@ -504,12 +527,14 @@
Inst = any(Uniq, HOInstInfoA),
Detism = detism_det
;
- InstB = bound(UniqB, BoundInstsB),
+ InstB = bound(UniqB, _InstResultsB, BoundInstsB),
% XXX If Live = is_live, should we test `Real = fake_unify'?
unify_uniq(Live, Real, detism_semi, UniqA, UniqB, Uniq),
make_any_bound_inst_list(BoundInstsB, Live, UniqA, Real,
BoundInsts, Detism1, !ModuleInfo),
- Inst = bound(Uniq, BoundInsts),
+ % XXX A better approximation of InstResults is probably
+ % possible.
+ Inst = bound(Uniq, inst_test_no_results, BoundInsts),
det_par_conjunction_detism(Detism1, detism_semi, Detism)
;
InstB = ground(UniqB, _HOInstInfoB),
@@ -678,7 +703,9 @@
Live = is_dead,
ArgInsts = ArgInstsB
),
- Inst = bound(unique, [bound_functor(ConsIdB, ArgInsts)]),
+ % XXX A better approximation of InstResults is probably possible.
+ Inst = bound(unique, inst_test_no_results,
+ [bound_functor(ConsIdB, ArgInsts)]),
Detism = detism_det
;
InstA = any(Uniq, _),
@@ -694,9 +721,11 @@
make_any_inst_list(ArgInstsB, Live, Uniq, Real,
ArgInsts, Detism, !ModuleInfo)
),
- Inst = bound(Uniq, [bound_functor(ConsIdB, ArgInsts)])
+ % XXX A better approximation of InstResults is probably possible.
+ Inst = bound(Uniq, inst_test_no_results,
+ [bound_functor(ConsIdB, ArgInsts)])
;
- InstA = bound(UniqA, BoundInstsA),
+ InstA = bound(UniqA, _InstResultsA, BoundInstsA),
(
Live = is_live,
abstractly_unify_bound_inst_list_lives(BoundInstsA, ConsIdB,
@@ -707,7 +736,8 @@
abstractly_unify_bound_inst_list(is_dead, BoundInstsA, BoundInstsB,
Real, BoundInsts, Detism, !ModuleInfo)
),
- Inst = bound(UniqA, BoundInsts)
+ % XXX A better approximation of InstResults is probably possible.
+ Inst = bound(UniqA, inst_test_no_results, BoundInsts)
;
InstA = ground(UniqA, _),
(
@@ -719,7 +749,9 @@
make_ground_inst_list(ArgInstsB, Live, UniqA, Real,
ArgInsts, Detism, !ModuleInfo)
),
- Inst = bound(UniqA, [bound_functor(ConsIdB, ArgInsts)])
+ % XXX A better approximation of InstResults is probably possible.
+ Inst = bound(UniqA, inst_test_no_results,
+ [bound_functor(ConsIdB, ArgInsts)])
;
InstA = constrained_inst_vars(InstVars, SubInstA),
abstractly_unify_inst_functor(Live, SubInstA, ConsIdB, ArgInstsB,
@@ -1110,11 +1142,11 @@
Inst = defined_inst(typed_ground(Uniq, T)),
Detism = detism_det
;
- Inst0 = bound(Uniq0, BoundInsts0),
+ Inst0 = bound(Uniq0, InstResults0, BoundInsts0),
unify_uniq(Live, Real, detism_semi, Uniq0, Uniq1, Uniq),
make_ground_bound_inst_list(BoundInsts0, Live, Uniq1, Real,
BoundInsts, Detism1, !ModuleInfo),
- Inst = bound(Uniq, BoundInsts),
+ Inst = bound(Uniq, InstResults0, BoundInsts),
det_par_conjunction_detism(Detism1, detism_semi, Detism)
;
Inst0 = ground(Uniq0, HOInstInfo),
@@ -1188,14 +1220,14 @@
module_info::in, module_info::out) is semidet.
make_ground_bound_inst_list([], _, _, _, [], detism_det, !ModuleInfo).
-make_ground_bound_inst_list([Bound0 | Bounds0], Live, Uniq, Real,
- [Bound | Bounds], Detism, !ModuleInfo) :-
- Bound0 = bound_functor(ConsId, ArgInsts0),
- make_ground_inst_list(ArgInsts0, Live, Uniq, Real, ArgInsts, Detism1,
- !ModuleInfo),
- Bound = bound_functor(ConsId, ArgInsts),
- make_ground_bound_inst_list(Bounds0, Live, Uniq, Real, Bounds, Detism2,
- !ModuleInfo),
+make_ground_bound_inst_list([BoundInst0 | BoundInsts0], Live, Uniq, Real,
+ [BoundInst | BoundInsts], Detism, !ModuleInfo) :-
+ BoundInst0 = bound_functor(ConsId, ArgInsts0),
+ make_ground_inst_list(ArgInsts0, Live, Uniq, Real, ArgInsts,
+ Detism1, !ModuleInfo),
+ BoundInst = bound_functor(ConsId, ArgInsts),
+ make_ground_bound_inst_list(BoundInsts0, Live, Uniq, Real, BoundInsts,
+ Detism2, !ModuleInfo),
det_par_conjunction_detism(Detism1, Detism2, Detism).
%-----------------------------------------------------------------------------%
@@ -1233,12 +1265,13 @@
Inst = defined_inst(Any),
Detism = detism_det
;
- Inst0 = bound(Uniq0, BoundInsts0),
+ Inst0 = bound(Uniq0, _InstResults0, BoundInsts0),
allow_unify_bound_any(Real),
unify_uniq(Live, Real, detism_semi, Uniq0, Uniq1, Uniq),
make_any_bound_inst_list(BoundInsts0, Live, Uniq1, Real, BoundInsts,
Detism1, !ModuleInfo),
- Inst = bound(Uniq, BoundInsts),
+ % XXX A better approximation of InstResults is probably possible.
+ Inst = bound(Uniq, inst_test_no_results, BoundInsts),
det_par_conjunction_detism(Detism1, detism_semi, Detism)
;
Inst0 = ground(Uniq0, PredInst),
@@ -1399,7 +1432,7 @@
make_shared(Uniq0, Uniq),
Inst = any(Uniq, HOInstInfo)
;
- Inst0 = bound(Uniq0, BoundInsts0),
+ Inst0 = bound(Uniq0, InstResults0, BoundInsts0),
% XXX This code has a performance problem.
%
% The problem is that e.g. in a list of length N, you will have
@@ -1426,7 +1459,7 @@
make_shared(Uniq0, Uniq),
make_shared_bound_inst_list(BoundInsts0, BoundInsts, !ModuleInfo),
- Inst = bound(Uniq, BoundInsts)
+ Inst = bound(Uniq, InstResults0, BoundInsts)
;
Inst0 = ground(Uniq0, PredInst),
make_shared(Uniq0, Uniq),
@@ -1519,11 +1552,12 @@
make_mostly_uniq(Uniq0, Uniq),
Inst = any(Uniq, HOInstInfo)
;
- Inst0 = bound(Uniq0, BoundInsts0),
+ Inst0 = bound(Uniq0, _InstResults0, BoundInsts0),
% XXX could improve efficiency by avoiding recursion here
make_mostly_uniq(Uniq0, Uniq),
make_mostly_uniq_bound_inst_list(BoundInsts0, BoundInsts, !ModuleInfo),
- Inst = bound(Uniq, BoundInsts)
+ % XXX A better approximation of InstResults is probably possible.
+ Inst = bound(Uniq, inst_test_no_results, BoundInsts)
;
Inst0 = ground(Uniq0, PredInst),
make_mostly_uniq(Uniq0, Uniq),
@@ -1736,7 +1770,7 @@
Inst = any(Uniq, HOInstInfo)
;
InstA = any(UniqA, _),
- InstB = bound(UniqB, BoundInstsB),
+ InstB = bound(UniqB, _InstResultsB, BoundInstsB),
merge_uniq_bound(UniqA, UniqB, BoundInstsB, !.ModuleInfo, Uniq),
% We do not yet allow merge of any with free, except for
% clobbered anys.
@@ -1768,7 +1802,7 @@
( Uniq = clobbered ; Uniq = mostly_clobbered ),
Inst = any(Uniq, HOInstInfo)
;
- InstA = bound(UniqA, BoundInstsA),
+ InstA = bound(UniqA, _InstResultsA, BoundInstsA),
InstB = any(UniqB, _),
merge_uniq_bound(UniqB, UniqA, BoundInstsA, !.ModuleInfo, Uniq),
% We do not yet allow merge of any with free, except
@@ -1798,22 +1832,23 @@
InstB = free,
Inst = free
;
- InstA = bound(UniqA, BoundInstsA),
- InstB = bound(UniqB, BoundInstsB),
+ InstA = bound(UniqA, _InstResultsA, BoundInstsA),
+ InstB = bound(UniqB, _InstResultsB, BoundInstsB),
merge_uniq(UniqA, UniqB, Uniq),
bound_inst_list_merge(BoundInstsA, BoundInstsB, MaybeType, BoundInsts,
!ModuleInfo),
- Inst = bound(Uniq, BoundInsts)
+ % XXX A better approximation of InstResults is probably possible.
+ Inst = bound(Uniq, inst_test_no_results, BoundInsts)
;
- InstA = bound(UniqA, BoundInstsA),
+ InstA = bound(UniqA, InstResultsA, BoundInstsA),
InstB = ground(UniqB, _),
- inst_merge_bound_ground(UniqA, BoundInstsA, UniqB, MaybeType, Inst,
- !ModuleInfo)
+ inst_merge_bound_ground(UniqA, InstResultsA, BoundInstsA, UniqB,
+ MaybeType, Inst, !ModuleInfo)
;
InstA = ground(UniqA, _),
- InstB = bound(UniqB, BoundInstsB),
- inst_merge_bound_ground(UniqB, BoundInstsB, UniqA, MaybeType, Inst,
- !ModuleInfo)
+ InstB = bound(UniqB, InstResultsB, BoundInstsB),
+ inst_merge_bound_ground(UniqB, InstResultsB, BoundInstsB, UniqA,
+ MaybeType, Inst, !ModuleInfo)
;
InstA = ground(UniqA, HOInstInfoA),
InstB = ground(UniqB, HOInstInfoB),
@@ -1924,7 +1959,7 @@
InstA = abstract_inst(_, _),
merge_uniq(shared, UniqB, Uniq)
;
- InstA = bound(UniqA, BoundInstsA),
+ InstA = bound(UniqA, _InstResultsA, BoundInstsA),
merge_uniq(UniqA, UniqB, Uniq0),
merge_bound_inst_list_uniq(BoundInstsA, Uniq0, ModuleInfo,
!Expansions, Uniq)
@@ -1947,12 +1982,12 @@
%-----------------------------------------------------------------------------%
-:- pred inst_merge_bound_ground(uniqueness::in, list(bound_inst)::in,
- uniqueness::in, maybe(mer_type)::in, mer_inst::out,
+:- pred inst_merge_bound_ground(uniqueness::in, inst_test_results::in,
+ list(bound_inst)::in, uniqueness::in, maybe(mer_type)::in, mer_inst::out,
module_info::in, module_info::out) is semidet.
-inst_merge_bound_ground(UniqA, BoundInstsA, UniqB, MaybeType, Result,
- !ModuleInfo) :-
+inst_merge_bound_ground(UniqA, InstResultsA, BoundInstsA, UniqB,
+ MaybeType, Result, !ModuleInfo) :-
( bound_inst_list_is_ground(BoundInstsA, !.ModuleInfo) ->
merge_uniq_bound(UniqB, UniqA, BoundInstsA, !.ModuleInfo, Uniq),
Result = ground(Uniq, none)
@@ -1967,8 +2002,15 @@
constructors_to_bound_insts(!.ModuleInfo, UniqB, TypeCtor,
Constructors, BoundInstsB0),
list.sort_and_remove_dups(BoundInstsB0, BoundInstsB),
- inst_merge_4(bound(UniqA, BoundInstsA), bound(UniqB, BoundInstsB),
- MaybeType, Result, !ModuleInfo)
+ InstResultsB = inst_test_results(
+ inst_result_is_ground,
+ inst_result_does_not_contain_any,
+ inst_result_contains_instnames_known(set.init),
+ inst_result_contains_types_known(set.init)
+ ),
+ InstA = bound(UniqA, InstResultsA, BoundInstsA),
+ InstB = bound(UniqB, InstResultsB, BoundInstsB),
+ inst_merge_4(InstA, InstB, MaybeType, Result, !ModuleInfo)
;
MaybeType = no,
merge_uniq_bound(UniqB, UniqA, BoundInstsA, !.ModuleInfo, Uniq),
@@ -2052,9 +2094,17 @@
ContainsNonstd = no
)
;
- Inst = bound(_, BoundInsts),
+ Inst = bound(_, InstResults, BoundInsts),
+ (
+ InstResults = inst_test_results_fgtc,
+ ContainsNonstd = no
+ ;
+ ( InstResults = inst_test_results(_, _, _, _)
+ ; InstResults = inst_test_no_results
+ ),
ContainsNonstd = bound_inst_list_contains_nonstandard_func_mode(
ModuleInfo, BoundInsts, !.Expansions)
+ )
;
Inst = inst_var(_),
unexpected($module, $pred, "uninstantiated inst parameter")
@@ -2156,9 +2206,28 @@
Inst = any(_, _),
ContainsAny = yes
;
- Inst = bound(_, BoundInsts),
+ Inst = bound(_, InstResults, BoundInsts),
+ (
+ InstResults = inst_test_results_fgtc,
+ ContainsAny = no
+ ;
+ InstResults = inst_test_results(_, AnyResults, _, _),
+ (
+ AnyResults = inst_result_does_not_contain_any,
+ ContainsAny = no
+ ;
+ AnyResults = inst_result_does_contain_any,
+ ContainsAny = yes
+ ;
+ AnyResults = inst_result_contains_any_unknown,
+ ContainsAny = bound_inst_list_contains_any(ModuleInfo,
+ BoundInsts, !.Expansions)
+ )
+ ;
+ InstResults = inst_test_no_results,
ContainsAny = bound_inst_list_contains_any(ModuleInfo, BoundInsts,
!.Expansions)
+ )
;
Inst = inst_var(_),
unexpected($module, $pred, "uninstantiated inst parameter")
@@ -2229,7 +2298,7 @@
inst_may_restrict_cons_ids(ModuleInfo, Inst) = MayRestrict :-
(
( Inst = any(_, _)
- ; Inst = bound(_, _)
+ ; Inst = bound(_, _, _)
; Inst = inst_var(_)
; Inst = constrained_inst_vars(_, _) % XXX is this right?
; Inst = abstract_inst(_, _)
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.269
diff -u -b -r1.269 intermod.m
--- compiler/intermod.m 27 Mar 2012 23:21:27 -0000 1.269
+++ compiler/intermod.m 17 Apr 2012 12:28:36 -0000
@@ -1789,7 +1789,7 @@
% are named the same as variables in the enclosing clause.
AppendVarNums = yes,
UseDeclaredModes = yes,
- write_clause(OutInfo, 1, ModuleInfo, PredId, VarSet,
+ write_clause(OutInfo, output_mercury, 1, ModuleInfo, PredId, VarSet,
AppendVarNums, ClauseHeadVars, PredOrFunc, Clause,
UseDeclaredModes, MaybeVarTypes, !IO)
;
Index: compiler/lco.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lco.m,v
retrieving revision 1.73
diff -u -b -r1.73 lco.m
--- compiler/lco.m 13 Feb 2012 00:11:41 -0000 1.73
+++ compiler/lco.m 16 Apr 2012 11:04:58 -0000
@@ -1087,7 +1087,7 @@
;
HighLevelData = yes,
BoundInst = bound_inst_with_free_arg(ConsId, ArgNum),
- FinalInst = bound(shared, [BoundInst]),
+ FinalInst = bound(shared, inst_test_no_results, [BoundInst]),
% We didn't do this when we initially created the variable.
map.det_insert(AddrVar, VarType, !VarTypes)
),
@@ -1212,7 +1212,7 @@
% argument left unfilled.
map.det_insert(AddrVar, AddrVarType, !VarTypes),
BoundInst = bound_inst_with_free_arg(ConsId, ArgNum),
- InitialInst = bound(shared, [BoundInst]),
+ InitialInst = bound(shared, inst_test_no_results, [BoundInst]),
Mode = (InitialInst -> ground_inst)
),
make_addr_vars(HeadVars0, Modes0, HeadVars, Modes,
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.355
diff -u -b -r1.355 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 27 Mar 2012 23:21:27 -0000 1.355
+++ compiler/mercury_to_mercury.m 17 Apr 2012 07:34:14 -0000
@@ -1220,13 +1220,13 @@
mercury_output_inst_defn(VarSet, Name, Args, abstract_inst, Context, !IO) :-
io.write_string(":- inst (", !IO),
ArgTerms = list.map(func(V) = variable(V, Context), Args),
- construct_qualified_term(Name, ArgTerms, Context, InstTerm),
+ construct_qualified_term_with_context(Name, ArgTerms, Context, InstTerm),
mercury_output_term(VarSet, no, InstTerm, !IO),
io.write_string(").\n", !IO).
mercury_output_inst_defn(VarSet, Name, Args, eqv_inst(Body), Context, !IO) :-
io.write_string(":- inst (", !IO),
ArgTerms = list.map(func(V) = variable(V, Context), Args),
- construct_qualified_term(Name, ArgTerms, Context, InstTerm),
+ construct_qualified_term_with_context(Name, ArgTerms, Context, InstTerm),
mercury_output_term(VarSet, no, InstTerm, !IO),
io.write_string(") == ", !IO),
mercury_output_inst(Body, VarSet, !IO),
@@ -1413,7 +1413,7 @@
Inst = free(_T),
add_string("free(with some type)", !U)
;
- Inst = bound(Uniq, BoundInsts),
+ Inst = bound(Uniq, _, BoundInsts),
mercury_format_uniqueness(Uniq, "bound", !U),
add_string("(", !U),
mercury_format_bound_insts(BoundInsts, InstInfo, !U),
@@ -1692,7 +1692,7 @@
mercury_format_mode_defn(VarSet, Name, Args, eqv_mode(Mode), Context, !U) :-
add_string(":- mode (", !U),
ArgTerms = list.map(func(V) = variable(V, Context), Args),
- construct_qualified_term(Name, ArgTerms, Context, ModeTerm),
+ construct_qualified_term_with_context(Name, ArgTerms, Context, ModeTerm),
mercury_format_term(VarSet, no, ModeTerm, !U),
add_string(") == ", !U),
mercury_format_mode(Mode, simple_inst_info(VarSet), !U),
@@ -1776,7 +1776,7 @@
),
mercury_output_begin_type_decl(IsSolverType, !IO),
Args = list.map((func(V) = term.variable(V, Context)), TParams),
- construct_qualified_term(Name, Args, Context, TypeTerm),
+ construct_qualified_term_with_context(Name, Args, Context, TypeTerm),
mercury_output_term_nq(TVarSet, no, next_to_graphic_token, TypeTerm,
!IO),
(
@@ -1792,7 +1792,7 @@
TypeDefn = parse_tree_eqv_type(Body),
mercury_output_begin_type_decl(non_solver_type, !IO),
Args = list.map((func(V) = term.variable(V, Context)), TParams),
- construct_qualified_term(Name, Args, Context, TypeTerm),
+ construct_qualified_term_with_context(Name, Args, Context, TypeTerm),
mercury_output_term(TVarSet, no, TypeTerm, !IO),
io.write_string(" == ", !IO),
mercury_output_type(TVarSet, no, Body, !IO),
@@ -1801,7 +1801,7 @@
TypeDefn = parse_tree_du_type(Ctors, MaybeUserEqComp, MaybeDirectArgs),
mercury_output_begin_type_decl(non_solver_type, !IO),
Args = list.map((func(V) = term.variable(V, Context)), TParams),
- construct_qualified_term(Name, Args, Context, TypeTerm),
+ construct_qualified_term_with_context(Name, Args, Context, TypeTerm),
mercury_output_term(TVarSet, no, TypeTerm, !IO),
io.write_string("\n\t--->\t", !IO),
mercury_output_ctors(Ctors, TVarSet, !IO),
@@ -1812,7 +1812,7 @@
TypeDefn = parse_tree_solver_type(SolverTypeDetails, MaybeUserEqComp),
mercury_output_begin_type_decl(solver_type, !IO),
Args = list.map((func(V) = term.variable(V, Context)), TParams),
- construct_qualified_term(Name, Args, Context, TypeTerm),
+ construct_qualified_term_with_context(Name, Args, Context, TypeTerm),
mercury_output_term(TVarSet, no, TypeTerm, !IO),
mercury_output_where_attributes(Info, TVarSet, yes(SolverTypeDetails),
MaybeUserEqComp, no, !IO),
Index: compiler/mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_constraints.m,v
retrieving revision 1.67
diff -u -b -r1.67 mode_constraints.m
--- compiler/mode_constraints.m 13 Feb 2012 00:11:42 -0000 1.67
+++ compiler/mode_constraints.m 16 Apr 2012 11:05:49 -0000
@@ -973,7 +973,7 @@
update_mc_info_t((pred(C::out, S0::in, S::out) is det :-
(
( Inst = any(_, _)
- ; Inst = bound(_, _)
+ ; Inst = bound(_, _, _)
; Inst = ground(_, _)
)
->
@@ -992,7 +992,7 @@
map.lookup(InstGraph, Var, node(Functors, _)),
map.foldl2(
(pred(ConsId::in, Vs::in, C0::in, C::out, S0::in, S::out) is det :-
- ( Inst = bound(_, BIs) ->
+ ( Inst = bound(_, _, BIs) ->
( cons_id_in_bound_insts(ConsId, BIs, Insts) ->
assoc_list.from_corresponding_lists(Vs, Insts, VarInsts),
list.foldl2((pred((V - I)::in, C1::in, C2::out,
Index: compiler/mode_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_debug.m,v
retrieving revision 1.34
diff -u -b -r1.34 mode_debug.m
--- compiler/mode_debug.m 27 Mar 2012 23:21:28 -0000 1.34
+++ compiler/mode_debug.m 17 Apr 2012 12:07:05 -0000
@@ -39,6 +39,7 @@
:- import_module hlds.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_out.hlds_out_mode.
+:- import_module hlds.hlds_out.hlds_out_util.
:- import_module hlds.instmap.
:- import_module parse_tree.
:- import_module parse_tree.mercury_to_mercury.
@@ -149,8 +150,8 @@
;
Minimal = no,
io.write_string("\n", !IO),
- mercury_output_structured_inst(Inst, 2, do_not_incl_addr,
- InstVarSet, !IO)
+ mercury_output_structured_inst(Inst, 2,
+ output_debug, do_not_incl_addr, InstVarSet, !IO)
)
),
write_var_insts(VarInsts, OldInstMap, VarSet, InstVarSet,
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.221
diff -u -b -r1.221 mode_util.m
--- compiler/mode_util.m 13 Feb 2012 00:11:42 -0000 1.221
+++ compiler/mode_util.m 16 Apr 2012 12:59:05 -0000
@@ -156,15 +156,13 @@
% Convert a list of constructors to a list of bound_insts where the
% arguments are `any'.
%
- % NOTE: the list(bound_inst) is not sorted and may contain
- % duplicates.
+ % NOTE: the list(bound_inst) is not sorted and may contain duplicates.
%
:- pred constructors_to_bound_any_insts(module_info::in, uniqueness::in,
type_ctor::in, list(constructor)::in, list(bound_inst)::out) is det.
% Given the mode of a predicate, work out which arguments are live
- % (might be used again by the caller of that predicate) and which
- % are dead.
+ % (might be used again by the caller of that predicate) and which are dead.
%
:- pred get_arg_lives(module_info::in, list(mer_mode)::in, list(is_live)::out)
is det.
@@ -374,6 +372,7 @@
mer_inst::out) is det.
get_single_arg_inst(ModuleInfo, Inst, ConsId, ArgInst) :-
+ % XXX This is very similar to get_arg_insts in prog_mode.
(
Inst = defined_inst(InstName),
inst_lookup(ModuleInfo, InstName, NamedInst),
@@ -385,7 +384,7 @@
Inst = ground(Uniq, _PredInst),
ArgInst = ground(Uniq, none)
;
- Inst = bound(_Uniq, List),
+ Inst = bound(_Uniq, _InstResult, List),
( get_single_arg_inst_2(List, ConsId, ArgInst0) ->
ArgInst = ArgInst0
;
@@ -628,6 +627,32 @@
propagate_ctor_info(ModuleInfo, Type, Constructors, Inst0, Inst) :-
(
+ Inst0 = free,
+ % Inst = free(Type)
+ Inst = free % XXX temporary hack
+ ;
+ Inst0 = free(_),
+ unexpected($module, $pred, "type info already present")
+ ;
+ Inst0 = ground(Uniq, none),
+ ( type_is_higher_order_details(Type, _, pf_function, _, ArgTypes) ->
+ default_higher_order_func_inst(ModuleInfo, ArgTypes,
+ HigherOrderInstInfo),
+ Inst = ground(Uniq, higher_order(HigherOrderInstInfo))
+ ;
+ type_to_ctor_det(Type, TypeCtor),
+ constructors_to_bound_insts(ModuleInfo, Uniq, TypeCtor,
+ Constructors, BoundInsts0),
+ list.sort_and_remove_dups(BoundInsts0, BoundInsts),
+ InstResults = inst_test_results(
+ inst_result_is_ground,
+ inst_result_does_not_contain_any,
+ inst_result_contains_instnames_known(set.init),
+ inst_result_contains_types_known(set.init)
+ ),
+ Inst = bound(Uniq, InstResults, BoundInsts)
+ )
+ ;
Inst0 = any(Uniq, none),
( type_is_higher_order_details(Type, _, pf_function, _, ArgTypes) ->
default_higher_order_func_inst(ModuleInfo, ArgTypes, PredInstInfo),
@@ -637,10 +662,19 @@
constructors_to_bound_any_insts(ModuleInfo, Uniq, TypeCtor,
Constructors, BoundInsts0),
list.sort_and_remove_dups(BoundInsts0, BoundInsts),
- Inst = bound(Uniq, BoundInsts)
+ % Normally, Inst is not ground, and contains any.
+ % But if all the Ctors are constants, it is ground,
+ % and does not contain any.
+ InstResults = inst_test_results(
+ inst_result_groundness_unknown,
+ inst_result_contains_any_unknown,
+ inst_result_contains_instnames_known(set.init),
+ inst_result_contains_types_known(set.init)
+ ),
+ Inst = bound(Uniq, InstResults, BoundInsts)
)
;
- Inst0 = any(Uniq, higher_order(PredInstInfo0)),
+ Inst0 = ground(Uniq, higher_order(PredInstInfo0)),
PredInstInfo0 = pred_inst_info(PredOrFunc, Modes0, MaybeArgRegs, Det),
(
type_is_higher_order_details(Type, _, PredOrFunc, _, ArgTypes),
@@ -655,40 +689,9 @@
Modes = Modes0
),
PredInstInfo = pred_inst_info(PredOrFunc, Modes, MaybeArgRegs, Det),
- Inst = any(Uniq, higher_order(PredInstInfo))
- ;
- Inst0 = free,
- % Inst = free(Type)
- Inst = free % XXX temporary hack
- ;
- Inst0 = free(_),
- unexpected($module, $pred, "type info already present")
- ;
- Inst0 = bound(Uniq, BoundInsts0),
- propagate_ctor_info_2(ModuleInfo, Type, BoundInsts0, BoundInsts),
- (
- BoundInsts = [],
- Inst = not_reached
- ;
- BoundInsts = [_ | _],
- % XXX do we need to sort the BoundInsts?
- Inst = bound(Uniq, BoundInsts)
- )
- ;
- Inst0 = ground(Uniq, none),
- ( type_is_higher_order_details(Type, _, pf_function, _, ArgTypes) ->
- default_higher_order_func_inst(ModuleInfo, ArgTypes,
- HigherOrderInstInfo),
- Inst = ground(Uniq, higher_order(HigherOrderInstInfo))
- ;
- type_to_ctor_det(Type, TypeCtor),
- constructors_to_bound_insts(ModuleInfo, Uniq, TypeCtor,
- Constructors, BoundInsts0),
- list.sort_and_remove_dups(BoundInsts0, BoundInsts),
- Inst = bound(Uniq, BoundInsts)
- )
+ Inst = ground(Uniq, higher_order(PredInstInfo))
;
- Inst0 = ground(Uniq, higher_order(PredInstInfo0)),
+ Inst0 = any(Uniq, higher_order(PredInstInfo0)),
PredInstInfo0 = pred_inst_info(PredOrFunc, Modes0, MaybeArgRegs, Det),
(
type_is_higher_order_details(Type, _, PredOrFunc, _, ArgTypes),
@@ -703,7 +706,21 @@
Modes = Modes0
),
PredInstInfo = pred_inst_info(PredOrFunc, Modes, MaybeArgRegs, Det),
- Inst = ground(Uniq, higher_order(PredInstInfo))
+ Inst = any(Uniq, higher_order(PredInstInfo))
+ ;
+ Inst0 = bound(Uniq, _InstResult, BoundInsts0),
+ propagate_ctor_info_2(ModuleInfo, Type, BoundInsts0, BoundInsts),
+ (
+ BoundInsts = [],
+ Inst = not_reached
+ ;
+ BoundInsts = [_ | _],
+ % XXX do we need to sort the BoundInsts?
+ % XXX I (zs) don't understand propagate_ctor_info_2 well enough
+ % to figure out under what circumstances we could keep (part of)
+ % _InstResult.
+ Inst = bound(Uniq, inst_test_no_results, BoundInsts)
+ )
;
Inst0 = not_reached,
Inst = Inst0
@@ -728,16 +745,36 @@
propagate_ctor_info_lazily(ModuleInfo, Subst, Type0, Inst0, Inst) :-
(
+ Inst0 = free,
+ % Inst = free(Type0)
+ Inst = free % XXX temporary hack
+ ;
+ Inst0 = free(_),
+ unexpected($module, $pred, "typeinfo already present")
+ ;
+ Inst0 = ground(Uniq, none),
+ apply_type_subst(Type0, Subst, Type),
+ ( type_is_higher_order_details(Type, _, pf_function, _, ArgTypes) ->
+ default_higher_order_func_inst(ModuleInfo, ArgTypes, HOInstInfo),
+ Inst = ground(Uniq, higher_order(HOInstInfo))
+ ;
+ % XXX The information added by this is not yet used, so
+ % it is disabled since it unnecessarily complicates the insts.
+ %
+ % Inst = defined_inst(typed_ground(Uniq, Type))
+ Inst = ground(Uniq, none)
+ )
+ ;
Inst0 = any(Uniq, none),
apply_type_subst(Type0, Subst, Type),
( type_is_higher_order_details(Type, _, pf_function, _, ArgTypes) ->
- default_higher_order_func_inst(ModuleInfo, ArgTypes, PredInstInfo),
- Inst = any(Uniq, higher_order(PredInstInfo))
+ default_higher_order_func_inst(ModuleInfo, ArgTypes, HOInstInfo),
+ Inst = any(Uniq, higher_order(HOInstInfo))
;
Inst = any(Uniq, none)
)
;
- Inst0 = any(Uniq, higher_order(PredInstInfo0)),
+ Inst0 = ground(Uniq, higher_order(PredInstInfo0)),
PredInstInfo0 = pred_inst_info(PredOrFunc, Modes0, MaybeArgRegs, Det),
apply_type_subst(Type0, Subst, Type),
(
@@ -753,42 +790,9 @@
Modes = Modes0
),
PredInstInfo = pred_inst_info(PredOrFunc, Modes, MaybeArgRegs, Det),
- Inst = any(Uniq, higher_order(PredInstInfo))
- ;
- Inst0 = free,
- % Inst = free(Type0)
- Inst = free % XXX temporary hack
- ;
- Inst0 = free(_),
- unexpected($module, $pred, "typeinfo already present")
- ;
- Inst0 = bound(Uniq, BoundInsts0),
- apply_type_subst(Type0, Subst, Type),
- propagate_ctor_info_2(ModuleInfo, Type, BoundInsts0, BoundInsts),
- (
- BoundInsts = [],
- Inst = not_reached
- ;
- BoundInsts = [_ | _],
- % XXX Do we need to sort the BoundInsts?
- Inst = bound(Uniq, BoundInsts)
- )
- ;
- Inst0 = ground(Uniq, none),
- apply_type_subst(Type0, Subst, Type),
- ( type_is_higher_order_details(Type, _, pf_function, _, ArgTypes) ->
- default_higher_order_func_inst(ModuleInfo, ArgTypes,
- HigherOrderInstInfo),
- Inst = ground(Uniq, higher_order(HigherOrderInstInfo))
- ;
- % XXX The information added by this is not yet used, so it's
- % disabled since it unnecessarily complicates the insts.
- %
- % Inst = defined_inst(typed_ground(Uniq, Type))
- Inst = ground(Uniq, none)
- )
+ Inst = ground(Uniq, higher_order(PredInstInfo))
;
- Inst0 = ground(Uniq, higher_order(PredInstInfo0)),
+ Inst0 = any(Uniq, higher_order(PredInstInfo0)),
PredInstInfo0 = pred_inst_info(PredOrFunc, Modes0, MaybeArgRegs, Det),
apply_type_subst(Type0, Subst, Type),
(
@@ -804,7 +808,22 @@
Modes = Modes0
),
PredInstInfo = pred_inst_info(PredOrFunc, Modes, MaybeArgRegs, Det),
- Inst = ground(Uniq, higher_order(PredInstInfo))
+ Inst = any(Uniq, higher_order(PredInstInfo))
+ ;
+ Inst0 = bound(Uniq, _InstResult, BoundInsts0),
+ apply_type_subst(Type0, Subst, Type),
+ propagate_ctor_info_2(ModuleInfo, Type, BoundInsts0, BoundInsts),
+ (
+ BoundInsts = [],
+ Inst = not_reached
+ ;
+ BoundInsts = [_ | _],
+ % XXX Do we need to sort the BoundInsts?
+ % XXX I (zs) don't understand propagate_ctor_info_2 well enough
+ % to figure out under what circumstances we could keep (part of)
+ % _InstResult.
+ Inst = bound(Uniq, inst_test_no_results, BoundInsts)
+ )
;
Inst0 = not_reached,
Inst = Inst0
@@ -983,7 +1002,7 @@
:- pred apply_type_subst(mer_type::in, tsubst::in, mer_type::out) is det.
apply_type_subst(Type0, Subst, Type) :-
- % optimize common case
+ % Optimize common case.
( map.is_empty(Subst) ->
Type = Type0
;
@@ -1608,7 +1627,8 @@
; ConsId = char_const(_)
; ConsId = string_const(_)
),
- MaybeInst = yes(bound(shared, [bound_functor(ConsId, [])]))
+ MaybeInst = yes(bound(shared, inst_test_results_fgtc,
+ [bound_functor(ConsId, [])]))
;
ConsId = impl_defined_const(_),
unexpected($module, $pred, "impl_defined_const")
@@ -1619,11 +1639,7 @@
PorF = pred_info_is_pred_or_func(PredInfo),
proc_info_interface_determinism(ProcInfo, Det),
proc_info_get_argmodes(ProcInfo, ProcArgModes),
- ( list.drop(NumArgs, ProcArgModes, ModesPrime) ->
- Modes = ModesPrime
- ;
- unexpected($module, $pred, "list.drop failed")
- ),
+ list.det_drop(NumArgs, ProcArgModes, Modes),
Inst = ground(shared, higher_order(pred_inst_info(PorF, Modes,
arg_reg_types_unset, Det))),
MaybeInst = yes(Inst)
@@ -1667,34 +1683,31 @@
normalise_inst(ModuleInfo, Type, Inst0, Inst),
normalise_insts(ModuleInfo, Types, Insts0, Insts).
+normalise_inst(ModuleInfo, Type, Inst0, NormalisedInst) :-
% This is a bit of a hack.
% The aim is to avoid non-termination due to the creation
% of ever-expanding insts.
% XXX should also normalise partially instantiated insts.
- %
-normalise_inst(ModuleInfo, Type, Inst0, NormalisedInst) :-
+
inst_expand(ModuleInfo, Inst0, Inst),
- ( Inst = bound(_, _) ->
+ ( Inst = bound(_, _, _) ->
(
- inst_is_ground(ModuleInfo, Inst),
- inst_is_unique(ModuleInfo, Inst),
- % don't infer unique modes for introduced type_infos
- % arguments, because that leads to an increase
- % in the number of inferred modes without any benefit
+ % Don't infer unique modes for introduced type_info arguments,
+ % because that leads to an increase in the number of inferred modes
+ % without any benefit.
\+ is_introduced_type_info_type(Type),
- \+ inst_contains_nonstandard_func_mode(ModuleInfo, Inst)
- ->
- NormalisedInst = ground(unique, none)
- ;
+
inst_is_ground(ModuleInfo, Inst),
- inst_is_mostly_unique(ModuleInfo, Inst),
- % don't infer unique modes for introduced type_infos
- % arguments, because that leads to an increase
- % in the number of inferred modes without any benefit
- \+ is_introduced_type_info_type(Type),
+ ( inst_is_unique(ModuleInfo, Inst) ->
+ Uniq = unique
+ ; inst_is_mostly_unique(ModuleInfo, Inst) ->
+ Uniq = mostly_unique
+ ;
+ fail
+ ),
\+ inst_contains_nonstandard_func_mode(ModuleInfo, Inst)
->
- NormalisedInst = ground(mostly_unique, none)
+ NormalisedInst = ground(Uniq, none)
;
inst_is_ground(ModuleInfo, Inst),
\+ inst_is_clobbered(ModuleInfo, Inst),
@@ -1702,9 +1715,8 @@
->
NormalisedInst = ground(shared, none)
;
- % XXX need to limit the potential size of insts
- % here in order to avoid infinite loops in
- % mode inference
+ % XXX We need to limit the potential size of insts here
+ % in order to avoid infinite loops in mode inference.
NormalisedInst = Inst
)
;
Index: compiler/modecheck_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_goal.m,v
retrieving revision 1.17
diff -u -b -r1.17 modecheck_goal.m
--- compiler/modecheck_goal.m 26 Mar 2012 00:43:32 -0000 1.17
+++ compiler/modecheck_goal.m 17 Apr 2012 03:41:04 -0000
@@ -204,8 +204,7 @@
GoalExpr0 = plain_call(PredId, ProcId0, Args0, _Builtin,
MaybeCallUnifyContext, PredName),
modecheck_goal_plain_call(PredId, ProcId0, Args0,
- MaybeCallUnifyContext, PredName, GoalInfo0, GoalExpr,
- !ModeInfo)
+ MaybeCallUnifyContext, PredName, GoalInfo0, GoalExpr, !ModeInfo)
;
GoalExpr0 = generic_call(GenericCall, Args0, Modes0, _MaybeArgRegs,
_Detism),
@@ -1131,13 +1130,13 @@
all_plain_construct_unifies([UnifyTermGoal | UnifyArgGoals])
->
( TermVarInst = free ->
- % UnifyTerm unifies TermVar with the arguments created
- % by UnifyArgs. Since TermVar is now free and the
+ % UnifyTerGoalm unifies TermVar with the arguments created
+ % by UnifyArgGoals. Since TermVar is now free and the
% argument variables haven't been encountered yet,
- % UnifyTerm cannot succeed until *after* the argument
+ % UnifyTermGoal cannot succeed until *after* the argument
% variables become ground.
%
- % Putting UnifyTerm after UnifyArgs here is MUCH more efficient
+ % Putting UnifyTerGoalm after UnifyArgGoals here is MUCH faster
% than letting the usual more ordering algorithm delay it
% repeatedly: it is linear instead of quadratic.
@@ -1212,7 +1211,7 @@
modecheck_ground_term_construct_arg_loop(RHSVars, ArgInsts, UniModes,
!LocalVarMap),
BoundInst = bound_functor(ConsId, ArgInsts),
- TermInst = bound(shared, [BoundInst]),
+ TermInst = bound(shared, inst_test_results_fgtc, [BoundInst]),
LHSMode = (free -> TermInst),
RHSMode = (TermInst -> TermInst),
UnifyMode = LHSMode - RHSMode,
@@ -1361,7 +1360,7 @@
Mode1 = in_mode,
Mode2 = out_mode,
instmap_lookup_var(InstMap, Arg1, Inst1),
- Inst1 = bound(Unique, [bound_functor(ConsId, [])]),
+ Inst1 = bound(Unique, _, [bound_functor(ConsId, [])]),
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
module_info_get_type_table(ModuleInfo, TypeTable),
mode_info_get_var_types(!.ModeInfo, VarTypes),
@@ -1374,7 +1373,8 @@
ConsTag = shared_local_tag(_, LocalTag)
->
BoundInst = bound_functor(int_const(LocalTag), []),
- NewMode2 = (free -> bound(Unique, [BoundInst])),
+ NewMode2 =
+ (free -> bound(Unique, inst_test_results_fgtc, [BoundInst])),
Modes = [Mode1, NewMode2]
;
Modes = Modes0
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.145
diff -u -b -r1.145 modecheck_unify.m
--- compiler/modecheck_unify.m 11 Apr 2012 04:52:35 -0000 1.145
+++ compiler/modecheck_unify.m 16 Apr 2012 16:56:46 -0000
@@ -646,7 +646,8 @@
mode_info_get_instmap(!.ModeInfo, InstMap1),
instmap_lookup_vars(InstMap1, ArgVars0, InstArgs),
mode_info_var_list_is_live(!.ModeInfo, ArgVars0, LiveArgs),
- InstOfY = bound(unique, [bound_functor(InstConsId, InstArgs)]),
+ InstOfY = bound(unique, inst_test_no_results,
+ [bound_functor(InstConsId, InstArgs)]),
(
% The occur check: X = f(X) is considered a mode error unless X is
% ground. (Actually it wouldn't be that hard to generate code for it
@@ -1434,8 +1435,8 @@
mode_get_insts(ModuleInfo, ModeOfX, InitialInst0, FinalInst0),
inst_expand(ModuleInfo, InitialInst0, InitialInst),
inst_expand(ModuleInfo, FinalInst0, FinalInst),
- InitialInst = bound(_, [_]),
- FinalInst = bound(_, [_])
+ InitialInst = bound(_, _, [_]),
+ FinalInst = bound(_, _, [_])
->
CanFail = cannot_fail
;
@@ -1584,25 +1585,29 @@
:- pred try_bind_args(mer_inst::in, list(prog_var)::in,
list(maybe(mer_inst))::in, mode_info::in, mode_info::out) is semidet.
-try_bind_args(not_reached, _, _, !ModeInfo) :-
+try_bind_args(Inst, ArgVars, UnifyArgInsts, !ModeInfo) :-
+ (
+ Inst = not_reached,
instmap.init_unreachable(InstMap),
- mode_info_set_instmap(InstMap, !ModeInfo).
-try_bind_args(ground(Uniq, none), Args, UnifyArgInsts, !ModeInfo) :-
- ground_args(Uniq, Args, UnifyArgInsts, !ModeInfo).
-try_bind_args(bound(_Uniq, List), Args, UnifyArgInsts, !ModeInfo) :-
+ mode_info_set_instmap(InstMap, !ModeInfo)
+ ;
+ Inst = ground(Uniq, none),
+ ground_args(Uniq, ArgVars, UnifyArgInsts, !ModeInfo)
+ ;
+ Inst = bound(_Uniq, _InstResults, BoundInsts),
(
- List = [],
+ BoundInsts = [],
% The code is unreachable.
instmap.init_unreachable(InstMap),
mode_info_set_instmap(InstMap, !ModeInfo)
;
- List = [_ | _],
- List = [bound_functor(_, InstList)],
- try_bind_args_2(Args, InstList, UnifyArgInsts, !ModeInfo)
+ BoundInsts = [bound_functor(_, ArgInsts)],
+ try_bind_args_2(ArgVars, ArgInsts, UnifyArgInsts, !ModeInfo)
+ )
+ ;
+ Inst = constrained_inst_vars(_, SubInst),
+ try_bind_args(SubInst, ArgVars, UnifyArgInsts, !ModeInfo)
).
-try_bind_args(constrained_inst_vars(_, Inst), Args, UnifyArgInsts,
- !ModeInfo) :-
- try_bind_args(Inst, Args, UnifyArgInsts, !ModeInfo).
:- pred try_bind_args_2(list(prog_var)::in, list(mer_inst)::in,
list(maybe(mer_inst))::in, mode_info::in, mode_info::out) is semidet.
@@ -1632,24 +1637,30 @@
:- pred get_mode_of_args(mer_inst::in, list(mer_inst)::in, list(mer_mode)::out)
is semidet.
-get_mode_of_args(not_reached, ArgInsts, ArgModes) :-
- mode_set_args(ArgInsts, not_reached, ArgModes).
-get_mode_of_args(any(Uniq, none), ArgInsts, ArgModes) :-
- mode_set_args(ArgInsts, any(Uniq, none), ArgModes).
-get_mode_of_args(ground(Uniq, none), ArgInsts, ArgModes) :-
- mode_set_args(ArgInsts, ground(Uniq, none), ArgModes).
-get_mode_of_args(bound(_Uniq, List), ArgInstsA, ArgModes) :-
+get_mode_of_args(Inst, ArgInsts, ArgModes) :-
+ (
+ Inst = not_reached,
+ mode_set_args(ArgInsts, not_reached, ArgModes)
+ ;
+ Inst = any(Uniq, none),
+ mode_set_args(ArgInsts, any(Uniq, none), ArgModes)
+ ;
+ Inst = ground(Uniq, none),
+ mode_set_args(ArgInsts, ground(Uniq, none), ArgModes)
+ ;
+ Inst = bound(_Uniq, _InstResults, BoundInsts),
(
- List = [],
+ BoundInsts = [],
% The code is unreachable.
- mode_set_args(ArgInstsA, not_reached, ArgModes)
+ mode_set_args(ArgInsts, not_reached, ArgModes)
+ ;
+ BoundInsts = [bound_functor(_Name, FunctorArgInsts)],
+ get_mode_of_args_2(ArgInsts, FunctorArgInsts, ArgModes)
+ )
;
- List = [_ | _],
- List = [bound_functor(_Name, ArgInstsB)],
- get_mode_of_args_2(ArgInstsA, ArgInstsB, ArgModes)
+ Inst = constrained_inst_vars(_, SubInst),
+ get_mode_of_args(SubInst, ArgInsts, ArgModes)
).
-get_mode_of_args(constrained_inst_vars(_, Inst), ArgInsts, ArgModes) :-
- get_mode_of_args(Inst, ArgInsts, ArgModes).
:- pred get_mode_of_args_2(list(mer_inst)::in, list(mer_inst)::in,
list(mer_mode)::out) is semidet.
Index: compiler/modecheck_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_util.m,v
retrieving revision 1.10
diff -u -b -r1.10 modecheck_util.m
--- compiler/modecheck_util.m 2 Apr 2012 03:58:55 -0000 1.10
+++ compiler/modecheck_util.m 16 Apr 2012 11:07:35 -0000
@@ -337,7 +337,8 @@
BoundInst = cons_id_to_bound_inst(ModuleInfo, Type, ConsId),
% Record the fact that Var was bound to ConsId.
- modecheck_set_var_inst(Var, bound(unique, [BoundInst]), no, !ModeInfo).
+ Inst = bound(unique, inst_test_no_results, [BoundInst]),
+ modecheck_set_var_inst(Var, Inst, no, !ModeInfo).
modecheck_functors_test(Var, MainConsId, OtherConsIds, !ModeInfo) :-
% Figure out the arity of this constructor, _including_ any type-infos
@@ -350,7 +351,8 @@
% Record the fact that Var was bound to MainConsId or one of the
% OtherConsIds.
- modecheck_set_var_inst(Var, bound(unique, BoundInsts), no, !ModeInfo).
+ Inst = bound(unique, inst_test_no_results, BoundInsts),
+ modecheck_set_var_inst(Var, Inst, no, !ModeInfo).
:- func cons_id_to_bound_inst(module_info, mer_type, cons_id) = bound_inst.
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.189
diff -u -b -r1.189 module_qual.m
--- compiler/module_qual.m 13 Feb 2012 00:11:43 -0000 1.189
+++ compiler/module_qual.m 16 Apr 2012 11:16:53 -0000
@@ -1141,27 +1141,49 @@
:- pred qualify_inst(mer_inst::in, mer_inst::out, mq_info::in, mq_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-qualify_inst(any(Uniq, HOInstInfo0), any(Uniq, HOInstInfo), !Info, !Specs) :-
- qualify_ho_inst_info(HOInstInfo0, HOInstInfo, !Info, !Specs).
-qualify_inst(free, free, !Info, !Specs).
-qualify_inst(not_reached, not_reached, !Info, !Specs).
-qualify_inst(free(_), _, !Info, !Specs) :-
- unexpected($module, $pred, "compiler generated inst not expected").
-qualify_inst(bound(Uniq, BoundInsts0), bound(Uniq, BoundInsts), !Info,
- !Specs) :-
- qualify_bound_inst_list(BoundInsts0, BoundInsts, !Info, !Specs).
-qualify_inst(ground(Uniq, HOInstInfo0), ground(Uniq, HOInstInfo),
- !Info, !Specs) :-
- qualify_ho_inst_info(HOInstInfo0, HOInstInfo, !Info, !Specs).
-qualify_inst(inst_var(Var), inst_var(Var), !Info, !Specs).
-qualify_inst(constrained_inst_vars(Vars, Inst0),
- constrained_inst_vars(Vars, Inst), !Info, !Specs) :-
- qualify_inst(Inst0, Inst, !Info, !Specs).
-qualify_inst(defined_inst(InstName0), defined_inst(InstName), !Info, !Specs) :-
- qualify_inst_name(InstName0, InstName, !Info, !Specs).
-qualify_inst(abstract_inst(Name, Args0), abstract_inst(Name, Args), !Info,
- !Specs) :-
- qualify_inst_list(Args0, Args, !Info, !Specs).
+qualify_inst(Inst0, Inst, !Info, !Specs) :-
+ (
+ Inst0 = any(Uniq, HOInstInfo0),
+ qualify_ho_inst_info(HOInstInfo0, HOInstInfo, !Info, !Specs),
+ Inst = any(Uniq, HOInstInfo)
+ ;
+ ( Inst0 = free
+ ; Inst0 = not_reached
+ ; Inst0 = inst_var(_)
+ ),
+ Inst = Inst0
+ ;
+ Inst0 = free(_),
+ unexpected($module, $pred, "compiler generated inst not expected")
+ ;
+ Inst0 = bound(Uniq, InstResults0, BoundInsts0),
+ (
+ ( InstResults0 = inst_test_results_fgtc
+ ; InstResults0 = inst_test_no_results
+ )
+ ;
+ InstResults0 = inst_test_results(_, _, _, _),
+ unexpected($module, $pred, "compiler generated inst not expected")
+ ),
+ qualify_bound_inst_list(BoundInsts0, BoundInsts, !Info, !Specs),
+ Inst = bound(Uniq, InstResults0, BoundInsts)
+ ;
+ Inst0 = ground(Uniq, HOInstInfo0),
+ qualify_ho_inst_info(HOInstInfo0, HOInstInfo, !Info, !Specs),
+ Inst = ground(Uniq, HOInstInfo)
+ ;
+ Inst0 = constrained_inst_vars(Vars, SubInst0),
+ qualify_inst(SubInst0, SubInst, !Info, !Specs),
+ Inst = constrained_inst_vars(Vars, SubInst)
+ ;
+ Inst0 = defined_inst(InstName0),
+ qualify_inst_name(InstName0, InstName, !Info, !Specs),
+ Inst = defined_inst(InstName)
+ ;
+ Inst0 = abstract_inst(Name, Args0),
+ qualify_inst_list(Args0, Args, !Info, !Specs),
+ Inst = abstract_inst(Name, Args)
+ ).
:- pred qualify_ho_inst_info(ho_inst_info::in, ho_inst_info::out,
mq_info::in, mq_info::out, list(error_spec)::in, list(error_spec)::out)
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.87
diff -u -b -r1.87 pd_util.m
--- compiler/pd_util.m 13 Feb 2012 00:11:44 -0000 1.87
+++ compiler/pd_util.m 16 Apr 2012 17:45:38 -0000
@@ -846,23 +846,47 @@
:- pred inst_MSG_2(mer_inst::in, mer_inst::in, expansions::in, module_info::in,
mer_inst::out) is semidet.
-inst_MSG_2(any(_, _), any(UniqB, InfoB), _, _, any(UniqB, InfoB)).
-inst_MSG_2(free, free, _M, _, free).
-
-inst_MSG_2(bound(_, ListA), bound(UniqB, ListB), Expansions,
- ModuleInfo, Inst) :-
- bound_inst_list_MSG(ListA, ListB, Expansions,
- ModuleInfo, UniqB, ListB, Inst).
-inst_MSG_2(bound(_, _), ground(UniqB, InfoB), _, _, ground(UniqB, InfoB)).
-
- % Fail here, since the increasing inst size could
- % cause termination problems for deforestation.
-inst_MSG_2(ground(_, _), bound(_UniqB, _ListB), _, _, _) :- fail.
-inst_MSG_2(ground(_, _), ground(UniqB, InfoB), _, _, ground(UniqB, InfoB)).
-inst_MSG_2(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
- Expansions, ModuleInfo, abstract_inst(Name, Args)) :-
- inst_list_MSG(ArgsA, ArgsB, Expansions, ModuleInfo, Args).
-inst_MSG_2(not_reached, Inst, _, _, Inst).
+inst_MSG_2(InstA, InstB, Expansions, ModuleInfo, Inst) :-
+ (
+ InstA = not_reached,
+ Inst = InstB
+ ;
+ InstA = free,
+ InstB = free,
+ Inst = free
+ ;
+ InstA = ground(_, _),
+ InstB = ground(_, _),
+ % XXX Not checking uniqueness seems wrong, and so is not recursing
+ % on the contents of any higher order inst.
+ Inst = InstB
+ ;
+ InstA = ground(_, _),
+ InstB = bound(_, _, _),
+ % Fail here, since the increasing inst size could cause
+ % termination problems for deforestation.
+ fail
+ ;
+ InstA = bound(_, _, _),
+ InstB = ground(_, _),
+ % XXX Not checking uniqueness seems wrong.
+ Inst = InstB
+ ;
+ InstA = bound(_, _, BoundInstsA),
+ InstB = bound(UniqB, _, BoundInstsB),
+ % XXX Ignoring UniqA seems wrong.
+ bound_inst_list_MSG(BoundInstsA, BoundInstsB, Expansions,
+ ModuleInfo, UniqB, BoundInstsB, Inst)
+ ;
+ InstA = any(_, _),
+ InstB = any(_, _),
+ Inst = InstB
+ ;
+ InstA = abstract_inst(Name, ArgsA),
+ InstB = abstract_inst(Name, ArgsB),
+ inst_list_MSG(ArgsA, ArgsB, Expansions, ModuleInfo, Args),
+ Inst = abstract_inst(Name, Args)
+ ).
:- pred inst_list_MSG(list(mer_inst)::in, list(mer_inst)::in, expansions::in,
module_info::in, list(mer_inst)::out) is semidet.
@@ -887,12 +911,12 @@
expansions::in, module_info::in, uniqueness::in,
list(bound_inst)::in, mer_inst::out) is semidet.
-bound_inst_list_MSG(Xs, Ys, Expansions, ModuleInfo, Uniq, List, Inst) :-
+bound_inst_list_MSG(Xs, Ys, Expansions, ModuleInfo, Uniq, BoundInsts, Inst) :-
(
Xs = [],
Ys = []
->
- Inst = bound(Uniq, [])
+ Inst = bound(Uniq, inst_test_no_results, [])
;
Xs = [X | Xs1],
Ys = [Y | Ys1],
@@ -902,9 +926,9 @@
inst_list_MSG(ArgsX, ArgsY, Expansions, ModuleInfo, Args),
Z = bound_functor(ConsId, Args),
bound_inst_list_MSG(Xs1, Ys1, Expansions,
- ModuleInfo, Uniq, List, Inst1),
- ( Inst1 = bound(Uniq, Zs) ->
- Inst = bound(Uniq, [Z | Zs])
+ ModuleInfo, Uniq, BoundInsts, Inst1),
+ ( Inst1 = bound(Uniq, _, Zs) ->
+ Inst = bound(Uniq, inst_test_no_results, [Z | Zs])
;
Inst = Inst1
)
@@ -912,14 +936,16 @@
% Check that it's OK to round off the uniqueness information.
(
Uniq = shared,
- inst_is_ground(ModuleInfo, bound(shared, List)),
- inst_is_not_partly_unique(ModuleInfo, bound(shared, List))
+ NewInst = bound(shared, inst_test_no_results, BoundInsts),
+ inst_is_ground(ModuleInfo, NewInst),
+ inst_is_not_partly_unique(ModuleInfo, NewInst)
;
Uniq = unique,
- inst_is_unique(ModuleInfo, bound(unique, List))
+ NewInst = bound(unique, inst_test_no_results, BoundInsts),
+ inst_is_unique(ModuleInfo, NewInst)
),
\+ inst_contains_nonstandard_func_mode(ModuleInfo,
- bound(shared, List)),
+ bound(shared, inst_test_no_results, BoundInsts)),
Inst = ground(Uniq, none)
).
@@ -932,36 +958,43 @@
:- pred inst_size_2(module_info::in, mer_inst::in,
set(inst_name)::in, int::out) is det.
-inst_size_2(_, not_reached, _, 0).
-inst_size_2(_, any(_, _), _, 0).
-inst_size_2(_, free, _, 0).
-inst_size_2(_, free(_), _, 0).
-inst_size_2(_, ground(_, _), _, 0).
-inst_size_2(_, inst_var(_), _, 0).
-inst_size_2(ModuleInfo, constrained_inst_vars(_, Inst), Expansions,
- Size) :-
- inst_size_2(ModuleInfo, Inst, Expansions, Size).
-inst_size_2(_, abstract_inst(_, _), _, 0).
-inst_size_2(ModuleInfo, defined_inst(InstName), !.Expansions, Size) :-
+inst_size_2(ModuleInfo, Inst, !.Expansions, Size) :-
+ (
+ ( Inst = not_reached
+ ; Inst = free
+ ; Inst = free(_)
+ ; Inst = ground(_, _)
+ ; Inst = any(_, _)
+ ; Inst = inst_var(_)
+ ; Inst = abstract_inst(_, _)
+ ),
+ Size = 0
+ ;
+ Inst = constrained_inst_vars(_, SubInst),
+ inst_size_2(ModuleInfo, SubInst, !.Expansions, Size)
+ ;
+ Inst = defined_inst(InstName),
( set.member(InstName, !.Expansions) ->
Size = 1
;
set.insert(InstName, !Expansions),
- inst_lookup(ModuleInfo, InstName, Inst),
- inst_size_2(ModuleInfo, Inst, !.Expansions, Size)
+ inst_lookup(ModuleInfo, InstName, SubInst),
+ inst_size_2(ModuleInfo, SubInst, !.Expansions, Size)
+ )
+ ;
+ Inst = bound(_, _, BoundInsts),
+ bound_inst_size(ModuleInfo, BoundInsts, !.Expansions, 1, Size)
).
-inst_size_2(ModuleInfo, bound(_, Functors), Expansions, Size) :-
- bound_inst_size(ModuleInfo, Functors, Expansions, 1, Size).
:- pred bound_inst_size(module_info::in, list(bound_inst)::in,
set(inst_name)::in, int::in, int::out) is det.
-bound_inst_size(_, [], _, Size, Size).
-bound_inst_size(ModuleInfo, [bound_functor(_, ArgInsts) | Insts],
- Expansions, Size0, Size) :-
- inst_list_size(ModuleInfo, ArgInsts, Expansions, Size0, Size1),
- Size2 = Size1 + 1,
- bound_inst_size(ModuleInfo, Insts, Expansions, Size2, Size).
+bound_inst_size(_, [], _, !Size).
+bound_inst_size(ModuleInfo, [BoundInst | BoundInsts], Expansions, !Size) :-
+ BoundInst = bound_functor(_, ArgInsts),
+ inst_list_size(ModuleInfo, ArgInsts, Expansions, !Size),
+ !:Size = !.Size + 1,
+ bound_inst_size(ModuleInfo, BoundInsts, Expansions, !Size).
inst_list_size(ModuleInfo, Insts, Size) :-
set.init(Expansions),
@@ -970,18 +1003,16 @@
:- pred inst_list_size(module_info::in, list(mer_inst)::in,
set(inst_name)::in, int::in, int::out) is det.
-inst_list_size(_, [], _, Size, Size).
-inst_list_size(ModuleInfo, [Inst | Insts],
- Expansions, Size0, Size) :-
- inst_size_2(ModuleInfo, Inst, Expansions, Size1),
- Size2 = Size0 + Size1,
- inst_list_size(ModuleInfo, Insts, Expansions, Size2, Size).
+inst_list_size(_, [], _, !Size).
+inst_list_size(ModuleInfo, [Inst | Insts], Expansions, !Size) :-
+ inst_size_2(ModuleInfo, Inst, Expansions, InstSize),
+ !:Size = !.Size + InstSize,
+ inst_list_size(ModuleInfo, Insts, Expansions, !Size).
%-----------------------------------------------------------------------------%
goals_match(_ModuleInfo, OldGoal, OldArgs, OldArgTypes,
NewGoal, NewVarTypes, OldNewRenaming, TypeSubn) :-
-
goal_to_conj_list(OldGoal, OldGoalList),
goal_to_conj_list(NewGoal, NewGoalList),
map.init(OldNewRenaming0),
@@ -1032,10 +1063,12 @@
goals_match_2([], [], !ONRenaming).
goals_match_2([OldGoal | OldGoals], [NewGoal | NewGoals], !ONRenaming) :-
+ OldGoal = hlds_goal(OldGoalExpr, _),
+ NewGoal = hlds_goal(NewGoalExpr, _),
(
(
- OldGoal = hlds_goal(unify(_, _, _, OldUnification, _), _),
- NewGoal = hlds_goal(unify(_, _, _, NewUnification, _), _),
+ OldGoalExpr = unify(_, _, _, OldUnification, _),
+ NewGoalExpr = unify(_, _, _, NewUnification, _),
(
OldUnification = simple_test(OldVar1, OldVar2),
NewUnification = simple_test(NewVar1, NewVar2),
@@ -1062,18 +1095,14 @@
NewArgs = [NewVar | NewArgs1]
)
;
- OldGoal = hlds_goal(plain_call(PredId, ProcId, OldArgs, _, _, _),
- _),
- NewGoal = hlds_goal(plain_call(PredId, ProcId, NewArgs, _, _, _),
- _)
+ OldGoalExpr = plain_call(PredId, ProcId, OldArgs, _, _, _),
+ NewGoalExpr = plain_call(PredId, ProcId, NewArgs, _, _, _)
;
% We don't need to check the modes here - if the goals match
% and the insts of the argument variables match, the modes
% of the call must be the same.
- OldGoal = hlds_goal(generic_call(OldGenericCall, OldArgs1, _, _, Det),
- _),
- NewGoal = hlds_goal(generic_call(NewGenericCall, NewArgs1, _, _, Det),
- _),
+ OldGoalExpr = generic_call(OldGenericCall, OldArgs1, _, _, Det),
+ NewGoalExpr = generic_call(NewGenericCall, NewArgs1, _, _, Det),
match_generic_call(OldGenericCall, NewGenericCall),
goal_util.generic_call_vars(OldGenericCall, OldArgs0),
goal_util.generic_call_vars(NewGenericCall, NewArgs0),
@@ -1095,11 +1124,11 @@
list.foldl(MapInsert, ONArgsList, !ONRenaming)
;
(
- OldGoal = hlds_goal(negation(OldSubGoal), _),
- NewGoal = hlds_goal(negation(NewSubGoal), _)
+ OldGoalExpr = negation(OldSubGoal),
+ NewGoalExpr = negation(NewSubGoal)
;
- OldGoal = hlds_goal(scope(_, OldSubGoal), _),
- NewGoal = hlds_goal(scope(_, NewSubGoal), _)
+ OldGoalExpr = scope(_, OldSubGoal),
+ NewGoalExpr = scope(_, NewSubGoal)
)
->
goal_to_conj_list(OldSubGoal, OldSubGoalList),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.377
diff -u -b -r1.377 polymorphism.m
--- compiler/polymorphism.m 16 Apr 2012 08:13:18 -0000 1.377
+++ compiler/polymorphism.m 16 Apr 2012 11:44:00 -0000
@@ -2614,7 +2614,12 @@
% Note that we could perhaps be more accurate than `ground(shared)',
% but it shouldn't make any difference.
InstConsId = cell_inst_cons_id(typeclass_info_cell, NumArgVars),
- TypeClassInfoInst = bound(unique, [bound_functor(InstConsId, ArgInsts)]),
+ InstResults = inst_test_results(inst_result_is_ground,
+ inst_result_does_not_contain_any,
+ inst_result_contains_instnames_known(set.init),
+ inst_result_contains_types_unknown),
+ TypeClassInfoInst = bound(unique, InstResults,
+ [bound_functor(InstConsId, ArgInsts)]),
InstMapDelta =
instmap_delta_from_assoc_list([TypeClassInfoVar - TypeClassInfoInst]),
goal_info_set_instmap_delta(InstMapDelta, GoalInfo1, GoalInfo2),
@@ -3148,11 +3153,17 @@
% Create a goal_info for the unification.
set_of_var.list_to_set([TypeInfoVar | ArgVars], NonLocals),
list.duplicate(NumArgVars, ground(shared, none), ArgInsts),
- % note that we could perhaps be more accurate than `ground(shared)',
+ % Note that we could perhaps be more accurate than `ground(shared)',
% but it shouldn't make any difference.
InstConsId = cell_inst_cons_id(Cell, NumArgVars),
+ InstResults = inst_test_results(inst_result_is_ground,
+ inst_result_does_not_contain_any,
+ inst_result_contains_instnames_known(set.init),
+ inst_result_contains_types_unknown),
+ TypeInfoVarInst = bound(unique, InstResults,
+ [bound_functor(InstConsId, ArgInsts)]),
InstMapDelta = instmap_delta_from_assoc_list(
- [TypeInfoVar - bound(unique, [bound_functor(InstConsId, ArgInsts)])]),
+ [TypeInfoVar - TypeInfoVarInst]),
goal_info_init(NonLocals, InstMapDelta, detism_det, purity_pure, GoalInfo),
TypeInfoGoal = hlds_goal(Unify, GoalInfo).
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.239
diff -u -b -r1.239 prog_data.m
--- compiler/prog_data.m 27 Mar 2012 23:21:28 -0000 1.239
+++ compiler/prog_data.m 18 Apr 2012 03:03:10 -0000
@@ -2026,7 +2026,7 @@
% The ho_inst_info holds extra information
% about higher-order values.
- ; bound(uniqueness, list(bound_inst))
+ ; bound(uniqueness, inst_test_results, list(bound_inst))
% The list(bound_inst) must be sorted.
; ground(uniqueness, ho_inst_info)
@@ -2050,6 +2050,83 @@
% An abstract inst is a defined inst which has been declared
% but not actually been defined (yet).
+ % Values of this type give the outcome of various tests on an inst,
+ % if that information is available when the inst is constructed.
+ % The purpose is to allow those tests to work in constant time,
+ % not time that is linear, quadratic or worse in the size of the inst.
+ %
+ % We attach this information to bound insts, since the only practical
+ % way to make an inst big is to use bound insts.
+ %
+ % We could extend the number of tests whose results we can record,
+ % but we should do so only when we have a demonstrated need, and I (zs)
+ % don't yet see the need for them. However, here is a list of the tests
+ % whose results we can consider adding, together with the names of the
+ % predicates that could use them.
+ %
+ % Does the inst contain any_instvars?
+ % inst_apply_substitution
+ % inst_contains_unconstrained_var
+ % constrain_inst_vars_in_inst
+ % inst_var_constraints_are_consistent_in_inst
+ % inst_contains_inst_var
+ %
+ % Does the inst contain a nonstandard func mode?
+ % inst_contains_nonstandard_func_mode
+ %
+ % Does the inst contain any part that is uniq or mostly_uniq?
+ % make_shared_inst
+ %
+:- type inst_test_results
+ ---> inst_test_results(
+ inst_result_groundness,
+ inst_result_contains_any,
+ inst_result_contains_instnames,
+ inst_result_contains_types
+ )
+ ; inst_test_no_results
+ % Implies
+ % inst_result_groundness_unknown
+ % inst_result_contains_any_unknown
+ % inst_result_contains_instnames_unknown
+ % inst_result_contains_types_unknown
+ ; inst_test_results_fgtc.
+ % Implies
+ % inst_result_is_ground
+ % inst_result_does_not_contain_any
+ % inst_result_contains_instnames_known(set.init)
+ % inst_result_contains_types_known(set.init)
+ % It also implies that the inst does not contain any inst_vars,
+ % typed insts, constrained insts or higher order type insts,
+ % and that no part of it is unique or mostly_unique.
+
+ % Does the inst represent a ground term?
+:- type inst_result_groundness
+ ---> inst_result_is_not_ground
+ ; inst_result_is_ground
+ ; inst_result_groundness_unknown.
+
+ % Does "any" appear anywhere inside the inst?
+:- type inst_result_contains_any
+ ---> inst_result_does_not_contain_any
+ ; inst_result_does_contain_any
+ ; inst_result_contains_any_unknown.
+
+:- type inst_result_contains_instnames
+ ---> inst_result_contains_instnames_known(set(inst_name))
+ % All the inst_names inside the inst are given in the set.
+ % This is not guarantee that all the inst_names in the set
+ % appear in the inst, but it is a guarantee that an inst_name
+ % that appears in the inst will appear in the set.
+ ; inst_result_contains_instnames_unknown.
+
+:- type inst_result_contains_types
+ ---> inst_result_contains_types_known(set(type_ctor))
+ % All the type_ctors inside typed_inst nodes of the the inst
+ % are given in the set. This gives a guarantee analogous to
+ % inst_result_contains_instnames_known.
+ ; inst_result_contains_types_unknown.
+
:- type uniqueness
---> shared % There might be other references.
; unique % There is only one reference.
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.307
diff -u -b -r1.307 prog_io.m
--- compiler/prog_io.m 13 Feb 2012 00:11:45 -0000 1.307
+++ compiler/prog_io.m 16 Apr 2012 13:13:23 -0000
@@ -158,17 +158,22 @@
maybe1(item)::out) is det.
%-----------------------------------------------------------------------------%
+%
+% XXX Why are these predicates in this module? Wouldn't e.g prog_mode.m
+% be more appropriate?
+%
- % Replace all occurrences of inst_var(I) with
- % constrained_inst_var(I, ground(shared, none)).
+ % Replace all occurrences of inst_var(InstVar) with
+ % constrained_inst_var(InstVar, ground(shared, none)).
%
:- pred constrain_inst_vars_in_mode(mer_mode::in, mer_mode::out) is det.
- % Replace all occurrences of inst_var(I) with
- % constrained_inst_var(I, Inst) where I -> Inst is in the inst_var_sub.
- % If I is not in the inst_var_sub, default to ground(shared, none).
+ % Replace all occurrences of inst_var(InstVar) with
+ % constrained_inst_var(InstVar, Inst) where InstVar -> Inst
+ % is in the inst_var_sub.
+ % If InstVar is not in the inst_var_sub, default to ground(shared, none).
%
-:- pred constrain_inst_vars_in_mode(inst_var_sub::in,
+:- pred constrain_inst_vars_in_mode_sub(inst_var_sub::in,
mer_mode::in, mer_mode::out) is det.
%-----------------------------------------------------------------------------%
@@ -1692,7 +1697,7 @@
( Term = term.functor(term.atom("::"), [TypeTerm, ModeTerm], _Context) ->
maybe_parse_type(TypeTerm, Type),
convert_mode(allow_constrained_inst_var, ModeTerm, Mode0),
- constrain_inst_vars_in_mode(InstConstraints, Mode0, Mode),
+ constrain_inst_vars_in_mode_sub(InstConstraints, Mode0, Mode),
MaybeTypeAndMode = type_and_mode(Type, Mode)
;
maybe_parse_type(Term, Type),
@@ -1815,7 +1820,7 @@
Attributes0, Attributes, MaybeConstraints),
(
MaybeConstraints = ok3(_, _, InstConstraints),
- list.map(constrain_inst_vars_in_mode(InstConstraints),
+ list.map(constrain_inst_vars_in_mode_sub(InstConstraints),
ArgModes0, ArgModes),
varset.coerce(VarSet, ProgVarSet),
( inst_var_constraints_are_self_consistent_in_modes(ArgModes) ->
@@ -1871,12 +1876,12 @@
Attributes0, Attributes, MaybeConstraints),
(
MaybeConstraints = ok3(_, _, InstConstraints),
- list.map(constrain_inst_vars_in_mode(InstConstraints),
+ list.map(constrain_inst_vars_in_mode_sub(InstConstraints),
ArgModes0, ArgModes),
(
convert_mode(allow_constrained_inst_var, RetModeTerm, RetMode0)
->
- constrain_inst_vars_in_mode(InstConstraints,
+ constrain_inst_vars_in_mode_sub(InstConstraints,
RetMode0, RetMode),
varset.coerce(VarSet, InstVarSet),
ArgReturnModes = ArgModes ++ [RetMode],
@@ -2223,9 +2228,9 @@
%-----------------------------------------------------------------------------%
constrain_inst_vars_in_mode(Mode0, Mode) :-
- constrain_inst_vars_in_mode(map.init, Mode0, Mode).
+ constrain_inst_vars_in_mode_sub(map.init, Mode0, Mode).
-constrain_inst_vars_in_mode(InstConstraints, Mode0, Mode) :-
+constrain_inst_vars_in_mode_sub(InstConstraints, Mode0, Mode) :-
(
Mode0 = (I0 -> F0),
constrain_inst_vars_in_inst(InstConstraints, I0, I),
@@ -2242,36 +2247,43 @@
constrain_inst_vars_in_inst(InstConstraints, Inst0, Inst) :-
(
- Inst0 = any(U, none),
- Inst = any(U, none)
+ ( Inst0 = not_reached
+ ; Inst0 = free
+ ; Inst0 = free(_)
+ ; Inst0 = ground(_Uniq, none)
+ ; Inst0 = any(_Uniq, none)
+ ),
+ Inst = Inst0
;
- Inst0 = any(U, higher_order(PredInstInfo0)),
+ Inst0 = ground(Uniq, higher_order(PredInstInfo0)),
constrain_inst_vars_in_pred_inst_info(InstConstraints,
PredInstInfo0, PredInstInfo),
- Inst = any(U, higher_order(PredInstInfo))
+ Inst = ground(Uniq, higher_order(PredInstInfo))
;
- Inst0 = free,
- Inst = free
+ Inst0 = any(Uniq, higher_order(PredInstInfo0)),
+ constrain_inst_vars_in_pred_inst_info(InstConstraints,
+ PredInstInfo0, PredInstInfo),
+ Inst = any(Uniq, higher_order(PredInstInfo))
;
- Inst0 = free(Type),
- Inst = free(Type)
+ Inst0 = bound(Uniq, InstResults0, BoundInsts0),
+ (
+ InstResults0 = inst_test_results_fgtc,
+ % There are no inst_vars to substitute.
+ Inst = Inst0
;
- Inst0 = bound(U, BIs0),
+ ( InstResults0 = inst_test_no_results
+ ; InstResults0 = inst_test_results(_, _, _, _)
+ ),
list.map(
(pred(bound_functor(C, Is0)::in, bound_functor(C, Is)::out)
is det :-
list.map(constrain_inst_vars_in_inst(InstConstraints),
Is0, Is)),
- BIs0, BIs),
- Inst = bound(U, BIs)
- ;
- Inst0 = ground(U, none),
- Inst = ground(U, none)
- ;
- Inst0 = ground(U, higher_order(PredInstInfo0)),
- constrain_inst_vars_in_pred_inst_info(InstConstraints,
- PredInstInfo0, PredInstInfo),
- Inst = ground(U, higher_order(PredInstInfo))
+ BoundInsts0, BoundInsts),
+ % The substitutions inside BoundInsts can invalidate
+ % any of the existing results.
+ Inst = bound(Uniq, inst_test_no_results, BoundInsts)
+ )
;
Inst0 = constrained_inst_vars(Vars0, SubInst0),
constrain_inst_vars_in_inst(InstConstraints, SubInst0, SubInst1),
@@ -2284,9 +2296,6 @@
),
Inst = constrained_inst_vars(Vars, SubInst)
;
- Inst0 = not_reached,
- Inst = not_reached
- ;
Inst0 = inst_var(Var),
( map.search(InstConstraints, Var, SubInstPrime) ->
SubInst = SubInstPrime
@@ -2310,7 +2319,7 @@
constrain_inst_vars_in_pred_inst_info(InstConstraints, PII0, PII) :-
PII0 = pred_inst_info(PredOrFunc, Modes0, MaybeArgRegs, Det),
- list.map(constrain_inst_vars_in_mode(InstConstraints), Modes0, Modes),
+ list.map(constrain_inst_vars_in_mode_sub(InstConstraints), Modes0, Modes),
PII = pred_inst_info(PredOrFunc, Modes, MaybeArgRegs, Det).
:- pred constrain_inst_vars_in_inst_name(inst_var_sub::in,
@@ -2382,11 +2391,19 @@
; Inst = not_reached
)
;
- Inst = bound(_, BoundInsts),
+ Inst = bound(_, InstResults, BoundInsts),
+ (
+ InstResults = inst_test_results_fgtc
+ ;
+ ( InstResults = inst_test_no_results
+ ; InstResults = inst_test_results(_, _, _, _)
+ ),
list.foldl(
(pred(bound_functor(_, Insts)::in, in, out) is semidet -->
- inst_var_constraints_are_consistent_in_insts(Insts)),
+ inst_var_constraints_are_consistent_in_insts(Insts)
+ ),
BoundInsts, !Sub)
+ )
;
( Inst = ground(_, HOInstInfo)
; Inst = any(_, HOInstInfo)
@@ -2402,14 +2419,14 @@
unexpected($module, $pred, "unconstrained inst_var")
;
Inst = defined_inst(InstName),
- ( InstName = user_inst(_, Insts) ->
- inst_var_constraints_are_consistent_in_insts(Insts, !Sub)
+ ( InstName = user_inst(_, ArgInsts) ->
+ inst_var_constraints_are_consistent_in_insts(ArgInsts, !Sub)
;
true
)
;
- Inst = abstract_inst(_, Insts),
- inst_var_constraints_are_consistent_in_insts(Insts, !Sub)
+ Inst = abstract_inst(_, ArgInsts),
+ inst_var_constraints_are_consistent_in_insts(ArgInsts, !Sub)
;
Inst = constrained_inst_vars(InstVars, SubInst),
set.fold(inst_var_constraints_are_consistent_in_inst_var(SubInst),
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.74
diff -u -b -r1.74 prog_io_util.m
--- compiler/prog_io_util.m 5 Apr 2012 09:20:43 -0000 1.74
+++ compiler/prog_io_util.m 16 Apr 2012 11:16:47 -0000
@@ -823,8 +823,7 @@
:- pred parse_bound_inst_list(allow_constrained_inst_var::in, term::in,
uniqueness::in, mer_inst::out) is semidet.
-parse_bound_inst_list(AllowConstrainedInstVar, Disj, Uniqueness,
- bound(Uniqueness, Functors)) :-
+parse_bound_inst_list(AllowConstrainedInstVar, Disj, Uniqueness, Inst) :-
disjunction_to_list(Disj, List),
convert_bound_inst_list(AllowConstrainedInstVar, List, Functors0),
list.sort(Functors0, Functors),
@@ -834,7 +833,8 @@
SubList = [F1, F2 | _],
F1 = bound_functor(ConsId, _),
F2 = bound_functor(ConsId, _)
- ).
+ ),
+ Inst = bound(Uniqueness, inst_test_no_results, Functors).
:- pred convert_bound_inst_list(allow_constrained_inst_var::in, list(term)::in,
list(bound_inst)::out) is semidet.
Index: compiler/prog_mode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_mode.m,v
retrieving revision 1.28
diff -u -b -r1.28 prog_mode.m
--- compiler/prog_mode.m 16 Apr 2012 10:49:05 -0000 1.28
+++ compiler/prog_mode.m 16 Apr 2012 12:39:28 -0000
@@ -278,47 +278,69 @@
:- pred inst_apply_substitution(inst_var_sub::in, mer_inst::in, mer_inst::out)
is det.
-inst_apply_substitution(Subst, any(Uniq, HOInstInfo0), Inst) :-
+inst_apply_substitution(Subst, Inst0, Inst) :-
+ (
+ ( Inst0 = not_reached
+ ; Inst0 = free
+ ; Inst0 = free(_)
+ ),
+ Inst = Inst0
+ ;
+ Inst0 = ground(Uniq, HOInstInfo0),
ho_inst_info_apply_substitution(Subst, HOInstInfo0, HOInstInfo),
- Inst = any(Uniq, HOInstInfo).
-inst_apply_substitution(_, free, free).
-inst_apply_substitution(_, free(T), free(T)).
-inst_apply_substitution(Subst, ground(Uniq, HOInstInfo0), Inst) :-
+ Inst = ground(Uniq, HOInstInfo)
+ ;
+ Inst0 = any(Uniq, HOInstInfo0),
ho_inst_info_apply_substitution(Subst, HOInstInfo0, HOInstInfo),
- Inst = ground(Uniq, HOInstInfo).
-inst_apply_substitution(Subst, bound(Uniq, Alts0), bound(Uniq, Alts)) :-
- alt_list_apply_substitution(Subst, Alts0, Alts).
-inst_apply_substitution(_, not_reached, not_reached).
-inst_apply_substitution(Subst, inst_var(Var), Result) :-
- ( map.search(Subst, Var, Replacement) ->
- Result = Replacement
+ Inst = any(Uniq, HOInstInfo)
;
- Result = inst_var(Var)
- ).
-inst_apply_substitution(Subst, constrained_inst_vars(Vars, Inst0), Result) :-
+ Inst0 = bound(Uniq0, InstResults0, BoundInsts0),
+ (
+ InstResults0 = inst_test_results_fgtc,
+ % There is nothing to substitute.
+ Inst = Inst0
+ ;
+ ( InstResults0 = inst_test_no_results
+ ; InstResults0 = inst_test_results(_, _, _, _)
+ ),
+ bound_insts_apply_substitution(Subst, BoundInsts0, BoundInsts),
+ % The substitution can invalidate all the existing test results.
+ Inst = bound(Uniq0, inst_test_no_results, BoundInsts)
+ )
+ ;
+ Inst0 = inst_var(Var),
+ ( map.search(Subst, Var, ReplacementInst) ->
+ Inst = ReplacementInst
+ ;
+ Inst = Inst0
+ )
+ ;
+ Inst0 = constrained_inst_vars(Vars, SubInst0),
( set.is_singleton(Vars, Var0) ->
Var = Var0
;
unexpected($module, $pred, "multiple inst_vars found")
),
- ( map.search(Subst, Var, Replacement) ->
- Result = Replacement
+ ( map.search(Subst, Var, ReplacementInst) ->
+ Inst = ReplacementInst
% XXX Should probably have a sanity check here that
- % Replacement =< Inst0
+ % ReplacementInst =< Inst0
;
- inst_apply_substitution(Subst, Inst0, Result0),
- Result = constrained_inst_vars(Vars, Result0)
- ).
-inst_apply_substitution(Subst, defined_inst(InstName0),
- defined_inst(InstName)) :-
- ( inst_name_apply_substitution(Subst, InstName0, InstName1) ->
- InstName = InstName1
+ inst_apply_substitution(Subst, SubInst0, SubInst),
+ Inst = constrained_inst_vars(Vars, SubInst)
+ )
;
- InstName = InstName0
+ Inst0 = defined_inst(InstName0),
+ ( inst_name_apply_substitution(Subst, InstName0, InstName) ->
+ Inst = defined_inst(InstName)
+ ;
+ Inst = Inst0
+ )
+ ;
+ Inst0 = abstract_inst(Name, ArgInsts0),
+ inst_list_apply_substitution_2(Subst, ArgInsts0, ArgInsts),
+ Inst = abstract_inst(Name, ArgInsts)
).
-inst_apply_substitution(Subst, abstract_inst(Name, Args0),
- abstract_inst(Name, Args)) :-
- inst_list_apply_substitution_2(Subst, Args0, Args).
% This predicate fails if the inst_name is not one of user_inst,
% typed_inst or typed_ground. The other types of inst_names are just used
@@ -328,23 +350,32 @@
:- pred inst_name_apply_substitution(inst_var_sub::in,
inst_name::in, inst_name::out) is semidet.
-inst_name_apply_substitution(Subst, user_inst(Name, Args0),
- user_inst(Name, Args)) :-
- inst_list_apply_substitution_2(Subst, Args0, Args).
-inst_name_apply_substitution(Subst, typed_inst(T, Inst0),
- typed_inst(T, Inst)) :-
- inst_name_apply_substitution(Subst, Inst0, Inst).
-inst_name_apply_substitution(_, typed_ground(Uniq, T), typed_ground(Uniq, T)).
+inst_name_apply_substitution(Subst, InstName0, InstName) :-
+ (
+ InstName0 = user_inst(Name, ArgInsts0),
+ inst_list_apply_substitution_2(Subst, ArgInsts0, ArgInsts),
+ InstName = user_inst(Name, ArgInsts)
+ ;
+ InstName0 = typed_inst(T, SubInst0),
+ inst_name_apply_substitution(Subst, SubInst0, SubInst),
+ InstName = typed_inst(T, SubInst)
+ ;
+ InstName0 = typed_ground(_Uniq, _T),
+ % XXX Why is this here? The caller would do the same thing
+ % if it wasn't here.
+ InstName = InstName0
+ ).
-:- pred alt_list_apply_substitution(inst_var_sub::in,
+:- pred bound_insts_apply_substitution(inst_var_sub::in,
list(bound_inst)::in, list(bound_inst)::out) is det.
-alt_list_apply_substitution(_, [], []).
-alt_list_apply_substitution(Subst, [Alt0 | Alts0], [Alt | Alts]) :-
- Alt0 = bound_functor(Name, Args0),
+bound_insts_apply_substitution(_, [], []).
+bound_insts_apply_substitution(Subst,
+ [BoundInst0 | BoundInsts0], [BoundInst | BoundInsts]) :-
+ BoundInst0 = bound_functor(Name, Args0),
inst_list_apply_substitution_2(Subst, Args0, Args),
- Alt = bound_functor(Name, Args),
- alt_list_apply_substitution(Subst, Alts0, Alts).
+ BoundInst = bound_functor(Name, Args),
+ bound_insts_apply_substitution(Subst, BoundInsts0, BoundInsts).
:- pred ho_inst_info_apply_substitution(inst_var_sub::in,
ho_inst_info::in, ho_inst_info::out) is det.
@@ -381,99 +412,140 @@
:- pred rename_apart_inst_vars_in_mode(substitution(inst_var_type)::in,
mer_mode::in, mer_mode::out) is det.
-rename_apart_inst_vars_in_mode(Sub, I0 -> F0, I -> F) :-
+rename_apart_inst_vars_in_mode(Sub, Mode0, Mode) :-
+ (
+ Mode0 = (I0 -> F0),
rename_apart_inst_vars_in_inst(Sub, I0, I),
- rename_apart_inst_vars_in_inst(Sub, F0, F).
-rename_apart_inst_vars_in_mode(Sub, user_defined_mode(Name, Insts0),
- user_defined_mode(Name, Insts)) :-
- list.map(rename_apart_inst_vars_in_inst(Sub), Insts0, Insts).
+ rename_apart_inst_vars_in_inst(Sub, F0, F),
+ Mode = (I -> F)
+ ;
+ Mode0 = user_defined_mode(Name, Insts0),
+ list.map(rename_apart_inst_vars_in_inst(Sub), Insts0, Insts),
+ Mode = user_defined_mode(Name, Insts)
+ ).
:- pred rename_apart_inst_vars_in_inst(substitution(inst_var_type)::in,
mer_inst::in, mer_inst::out) is det.
-rename_apart_inst_vars_in_inst(Sub, any(Uniq, HOInstInfo0),
- any(Uniq, HOInstInfo)) :-
+rename_apart_inst_vars_in_inst(Sub, Inst0, Inst) :-
(
- HOInstInfo0 = higher_order(pred_inst_info(PorF, Modes0, MaybeArgRegs,
- Det)),
+ ( Inst0 = not_reached
+ ; Inst0 = free
+ ; Inst0 = free(_)
+ ),
+ Inst = Inst0
+ ;
+ Inst0 = ground(Uniq, HOInstInfo0),
+ (
+ HOInstInfo0 = higher_order(pred_inst_info(PorF, Modes0,
+ MaybeArgRegs, Det)),
list.map(rename_apart_inst_vars_in_mode(Sub), Modes0, Modes),
- HOInstInfo = higher_order(pred_inst_info(PorF, Modes, MaybeArgRegs,
- Det))
+ HOInstInfo = higher_order(pred_inst_info(PorF, Modes,
+ MaybeArgRegs, Det))
;
HOInstInfo0 = none,
HOInstInfo = none
- ).
-rename_apart_inst_vars_in_inst(_, free, free).
-rename_apart_inst_vars_in_inst(_, free(T), free(T)).
-rename_apart_inst_vars_in_inst(Sub, bound(U, BIs0), bound(U, BIs)) :-
- list.map(
- (pred(bound_functor(C, Is0)::in, bound_functor(C, Is)::out) is det :-
- list.map(rename_apart_inst_vars_in_inst(Sub), Is0, Is)),
- BIs0, BIs).
-rename_apart_inst_vars_in_inst(Sub, ground(Uniq, HOInstInfo0),
- ground(Uniq, HOInstInfo)) :-
+ ),
+ Inst = ground(Uniq, HOInstInfo)
+ ;
+ Inst0 = any(Uniq, HOInstInfo0),
(
- HOInstInfo0 = higher_order(pred_inst_info(PorF, Modes0, ArgRegs, Det)),
+ HOInstInfo0 = higher_order(pred_inst_info(PorF, Modes0,
+ MaybeArgRegs, Det)),
list.map(rename_apart_inst_vars_in_mode(Sub), Modes0, Modes),
- HOInstInfo = higher_order(pred_inst_info(PorF, Modes, ArgRegs, Det))
+ HOInstInfo = higher_order(pred_inst_info(PorF, Modes,
+ MaybeArgRegs, Det))
;
HOInstInfo0 = none,
HOInstInfo = none
- ).
-rename_apart_inst_vars_in_inst(_, not_reached, not_reached).
-rename_apart_inst_vars_in_inst(Sub, inst_var(Var0), inst_var(Var)) :-
+ ),
+ Inst = any(Uniq, HOInstInfo)
+ ;
+ Inst0 = bound(Uniq0, InstResults0, BoundInsts0),
+ (
+ InstResults0 = inst_test_results_fgtc,
+ % There is nothing to substitute.
+ Inst = Inst0
+ ;
+ ( InstResults0 = inst_test_no_results
+ ; InstResults0 = inst_test_results(_, _, _, _)
+ ),
+ list.map(
+ (pred(bound_functor(C, Is0)::in, bound_functor(C, Is)::out)
+ is det :-
+ list.map(rename_apart_inst_vars_in_inst(Sub), Is0, Is)
+ ), BoundInsts0, BoundInsts),
+ % The substitution can invalidate all the existing test results.
+ Inst = bound(Uniq0, inst_test_no_results, BoundInsts)
+ )
+ ;
+ Inst0 = inst_var(Var0),
( map.search(Sub, Var0, term.variable(Var1, _)) ->
- Var = Var1
+ Inst = inst_var(Var1)
;
- Var = Var0
- ).
-rename_apart_inst_vars_in_inst(Sub, constrained_inst_vars(Vars0, Inst0),
- constrained_inst_vars(Vars, Inst)) :-
- rename_apart_inst_vars_in_inst(Sub, Inst0, Inst),
+ Inst = Inst0
+ )
+ ;
+ Inst0 = constrained_inst_vars(Vars0, SubInst0),
+ rename_apart_inst_vars_in_inst(Sub, SubInst0, SubInst),
Vars = set.map(func(Var0) =
( map.search(Sub, Var0, term.variable(Var, _)) ->
Var
;
Var0
- ), Vars0).
-rename_apart_inst_vars_in_inst(Sub, defined_inst(Name0), defined_inst(Name)) :-
+ ), Vars0),
+ Inst = constrained_inst_vars(Vars, SubInst)
+ ;
+ Inst0 = defined_inst(Name0),
( rename_apart_inst_vars_in_inst_name(Sub, Name0, Name1) ->
- Name = Name1
+ Inst = defined_inst(Name1)
+ ;
+ Inst = Inst0
+ )
;
- Name = Name0
+ Inst0 = abstract_inst(Sym, SubInsts0),
+ list.map(rename_apart_inst_vars_in_inst(Sub), SubInsts0, SubInsts),
+ Inst = abstract_inst(Sym, SubInsts)
).
-rename_apart_inst_vars_in_inst(Sub, abstract_inst(Sym, Insts0),
- abstract_inst(Sym, Insts)) :-
- list.map(rename_apart_inst_vars_in_inst(Sub), Insts0, Insts).
:- pred rename_apart_inst_vars_in_inst_name(substitution(inst_var_type)::in,
inst_name::in, inst_name::out) is semidet.
-rename_apart_inst_vars_in_inst_name(Sub, user_inst(Sym, Insts0),
- user_inst(Sym, Insts)) :-
- list.map(rename_apart_inst_vars_in_inst(Sub), Insts0, Insts).
-rename_apart_inst_vars_in_inst_name(Sub, typed_inst(Type, Name0),
- typed_inst(Type, Name)) :-
- rename_apart_inst_vars_in_inst_name(Sub, Name0, Name).
-rename_apart_inst_vars_in_inst_name(_, typed_ground(U, T), typed_ground(U, T)).
+rename_apart_inst_vars_in_inst_name(Sub, InstName0, InstName) :-
+ (
+ InstName0 = user_inst(Sym, Insts0),
+ list.map(rename_apart_inst_vars_in_inst(Sub), Insts0, Insts),
+ InstName = user_inst(Sym, Insts)
+ ;
+ InstName0 = typed_inst(Type, Name0),
+ rename_apart_inst_vars_in_inst_name(Sub, Name0, Name),
+ InstName = typed_inst(Type, Name)
+ ;
+ InstName0 = typed_ground(_U, _T),
+ % XXX Why is this here? The caller would do the same thing
+ % if it wasn't here.
+ InstName = InstName0
+ ).
%-----------------------------------------------------------------------------%
inst_contains_unconstrained_var(Inst) :-
require_complete_switch [Inst]
(
- Inst = bound(_Uniq, BoundInsts),
- list.member(BoundInst, BoundInsts),
- BoundInst = bound_functor(_ConsId, ArgInsts),
- list.member(ArgInst, ArgInsts),
- inst_contains_unconstrained_var(ArgInst)
+ ( Inst = not_reached
+ ; Inst = free
+ ; Inst = free(_)
+ ),
+ fail
+ ;
+ Inst = inst_var(_InstVar)
;
( Inst = ground(_Uniq, GroundInstInfo)
; Inst = any(_Uniq, GroundInstInfo)
),
GroundInstInfo = higher_order(PredInstInfo),
- PredInstInfo = pred_inst_info(_PredOrFunc, Modes, _MaybeArgRegs,
- _Detism),
+ PredInstInfo = pred_inst_info(_PredOrFunc, Modes,
+ _MaybeArgRegs, _Detism),
list.member(Mode, Modes),
(
Mode = (SubInst -> _)
@@ -485,9 +557,35 @@
),
inst_contains_unconstrained_var(SubInst)
;
- Inst = inst_var(_InstVar)
+ Inst = bound(_Uniq, InstResults, BoundInsts),
+ ( InstResults = inst_test_no_results
+ ; InstResults = inst_test_results(_, _, _, _)
+ ),
+ list.member(BoundInst, BoundInsts),
+ BoundInst = bound_functor(_ConsId, ArgInsts),
+ list.member(ArgInst, ArgInsts),
+ inst_contains_unconstrained_var(ArgInst)
;
Inst = defined_inst(InstName),
+ inst_name_contains_unconstrained_var(InstName)
+ ;
+ Inst = abstract_inst(_SymName, ArgInsts),
+ list.member(ArgInst, ArgInsts),
+ inst_contains_unconstrained_var(ArgInst)
+ ;
+ Inst = constrained_inst_vars(_, _),
+ % XXX Is this the right thing to do here? Just because Inst constrains
+ % SOME of the instvars in it, it does not necessarily constrain all.
+ % What we do here preserves the old behavior of this predicate.
+ fail
+ ).
+
+ % inst_name_contains_unconstrained_var(InstName) iff InstName includes
+ % an unconstrained inst variable.
+ %
+:- pred inst_name_contains_unconstrained_var(inst_name::in) is semidet.
+
+inst_name_contains_unconstrained_var(InstName) :-
(
InstName = user_inst(_, SubInsts),
list.member(SubInst, SubInsts),
@@ -499,44 +597,26 @@
InstName = merge_inst(_, SubInst),
inst_contains_unconstrained_var(SubInst)
;
- InstName = unify_inst(_, SubInstA, SubInstB, _),
- (
- inst_contains_unconstrained_var(SubInstA)
+ InstName = unify_inst(_, SubInst, _, _),
+ inst_contains_unconstrained_var(SubInst)
;
- inst_contains_unconstrained_var(SubInstB)
- )
+ InstName = unify_inst(_, _, SubInst, _),
+ inst_contains_unconstrained_var(SubInst)
;
InstName = ground_inst(SubInstName, _, _, _),
- inst_contains_unconstrained_var(defined_inst(SubInstName))
+ inst_name_contains_unconstrained_var(SubInstName)
;
InstName = any_inst(SubInstName, _, _, _),
- inst_contains_unconstrained_var(defined_inst(SubInstName))
+ inst_name_contains_unconstrained_var(SubInstName)
;
InstName = shared_inst(SubInstName),
- inst_contains_unconstrained_var(defined_inst(SubInstName))
+ inst_name_contains_unconstrained_var(SubInstName)
;
InstName = mostly_uniq_inst(SubInstName),
- inst_contains_unconstrained_var(defined_inst(SubInstName))
+ inst_name_contains_unconstrained_var(SubInstName)
;
InstName = typed_inst(_, SubInstName),
- inst_contains_unconstrained_var(defined_inst(SubInstName))
- )
- ;
- Inst = abstract_inst(_SymName, SubInsts),
- list.member(SubInst, SubInsts),
- inst_contains_unconstrained_var(SubInst)
- ;
- ( Inst = not_reached
- ; Inst = free
- ; Inst = free(_)
- ),
- fail
- ;
- Inst = constrained_inst_vars(_, _),
- % XXX Is this the right thing to do here? Just because Inst constrains
- % SOME of the instvars in it, it does not necessarily constrain all.
- % What we do here preserves the old behavior of this predicate.
- fail
+ inst_name_contains_unconstrained_var(SubInstName)
).
%-----------------------------------------------------------------------------%
@@ -558,6 +638,9 @@
%-----------------------------------------------------------------------------%
get_arg_insts(Inst, ConsId, Arity, ArgInsts) :-
+ % XXX This is very similar to get_single_arg_inst in mode_util.
+ % XXX Actually, it should be MORE similar; it does not handle
+ % some cases that get_single_arg_inst does.
(
Inst = not_reached,
list.duplicate(Arity, not_reached, ArgInsts)
@@ -565,7 +648,7 @@
Inst = ground(Uniq, _PredInst),
list.duplicate(Arity, ground(Uniq, none), ArgInsts)
;
- Inst = bound(_Uniq, List),
+ Inst = bound(_Uniq, _InstResults, List),
( get_arg_insts_2(List, ConsId, ArgInsts0) ->
ArgInsts = ArgInsts0
;
@@ -667,9 +750,9 @@
strip_builtin_qualifiers_from_ho_inst_info(HOInstInfo0, HOInstInfo),
Inst = ground(Uniq, HOInstInfo)
;
- Inst0 = bound(Uniq, BoundInsts0),
+ Inst0 = bound(Uniq, InstResults, BoundInsts0),
strip_builtin_qualifiers_from_bound_inst_list(BoundInsts0, BoundInsts),
- Inst = bound(Uniq, BoundInsts)
+ Inst = bound(Uniq, InstResults, BoundInsts)
;
Inst0 = defined_inst(InstName0),
strip_builtin_qualifiers_from_inst_name(InstName0, InstName),
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.115
diff -u -b -r1.115 prog_util.m
--- compiler/prog_util.m 27 Sep 2011 00:49:25 -0000 1.115
+++ compiler/prog_util.m 17 Apr 2012 07:25:54 -0000
@@ -35,7 +35,7 @@
:- pred construct_qualified_term(sym_name::in, list(term(T))::in,
term(T)::out) is det.
-:- pred construct_qualified_term(sym_name::in, list(term(T))::in,
+:- pred construct_qualified_term_with_context(sym_name::in, list(term(T))::in,
prog_context::in, term(T)::out) is det.
%-----------------------------------------------------------------------------%
@@ -205,17 +205,21 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-construct_qualified_term(qualified(Module, Name), Args, Context, Term) :-
- construct_qualified_term(Module, [], Context, ModuleTerm),
- UnqualifiedTerm = term.functor(term.atom(Name), Args, Context),
- Term = term.functor(term.atom("."),
- [ModuleTerm, UnqualifiedTerm], Context).
-construct_qualified_term(unqualified(Name), Args, Context, Term) :-
- Term = term.functor(term.atom(Name), Args, Context).
-
construct_qualified_term(SymName, Args, Term) :-
term.context_init(Context),
- construct_qualified_term(SymName, Args, Context, Term).
+ construct_qualified_term_with_context(SymName, Args, Context, Term).
+
+construct_qualified_term_with_context(SymName, Args, Context, Term) :-
+ (
+ SymName = qualified(Module, Name),
+ construct_qualified_term_with_context(Module, [], Context, ModuleTerm),
+ UnqualifiedTerm = term.functor(term.atom(Name), Args, Context),
+ Term = term.functor(term.atom("."),
+ [ModuleTerm, UnqualifiedTerm], Context)
+ ;
+ SymName = unqualified(Name),
+ Term = term.functor(term.atom(Name), Args, Context)
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/recompilation.usage.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.usage.m,v
retrieving revision 1.63
diff -u -b -r1.63 recompilation.usage.m
--- compiler/recompilation.usage.m 27 Mar 2012 23:21:28 -0000 1.63
+++ compiler/recompilation.usage.m 16 Apr 2012 11:23:09 -0000
@@ -1327,34 +1327,38 @@
:- pred find_items_used_by_inst(mer_inst::in,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
-find_items_used_by_inst(any(_, HOInstInfo), !Info) :-
+find_items_used_by_inst(Inst, !Info) :-
(
- HOInstInfo = higher_order(pred_inst_info(_, Modes, _, _)),
- find_items_used_by_modes(Modes, !Info)
+ ( Inst = not_reached
+ ; Inst = free
+ ; Inst = free(_)
+ ; Inst = inst_var(_)
+ )
;
- HOInstInfo = none
- ).
-find_items_used_by_inst(free, !Info).
-find_items_used_by_inst(free(_), !Info).
-find_items_used_by_inst(bound(_, BoundInsts), !Info) :-
- list.foldl(find_items_used_by_bound_inst, BoundInsts, !Info).
-find_items_used_by_inst(ground(_, HOInstInfo), !Info) :-
+ ( Inst = any(_, HOInstInfo)
+ ; Inst = ground(_, HOInstInfo)
+ ),
(
HOInstInfo = higher_order(pred_inst_info(_, Modes, _, _)),
find_items_used_by_modes(Modes, !Info)
;
HOInstInfo = none
- ).
-find_items_used_by_inst(not_reached, !Info).
-find_items_used_by_inst(inst_var(_), !Info).
-find_items_used_by_inst(constrained_inst_vars(_, Inst), !Info) :-
- find_items_used_by_inst(Inst, !Info).
-find_items_used_by_inst(defined_inst(InstName), !Info) :-
- find_items_used_by_inst_name(InstName, !Info).
-find_items_used_by_inst(abstract_inst(Name, ArgInsts), !Info) :-
+ )
+ ;
+ Inst = bound(_, _, BoundInsts),
+ list.foldl(find_items_used_by_bound_inst, BoundInsts, !Info)
+ ;
+ Inst = constrained_inst_vars(_, SubInst),
+ find_items_used_by_inst(SubInst, !Info)
+ ;
+ Inst = defined_inst(InstName),
+ find_items_used_by_inst_name(InstName, !Info)
+ ;
+ Inst = abstract_inst(Name, ArgInsts),
list.length(ArgInsts, Arity),
maybe_record_item_to_process(inst_item, item_name(Name, Arity), !Info),
- find_items_used_by_insts(ArgInsts, !Info).
+ find_items_used_by_insts(ArgInsts, !Info)
+ ).
:- pred find_items_used_by_bound_inst(bound_inst::in,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
@@ -1371,29 +1375,33 @@
:- pred find_items_used_by_inst_name(inst_name::in,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
-find_items_used_by_inst_name(user_inst(Name, ArgInsts), !Info) :-
+find_items_used_by_inst_name(InstName, !Info) :-
+ (
+ InstName = user_inst(Name, ArgInsts),
list.length(ArgInsts, Arity),
maybe_record_item_to_process(inst_item, item_name(Name, Arity), !Info),
- find_items_used_by_insts(ArgInsts, !Info).
-find_items_used_by_inst_name(merge_inst(Inst1, Inst2), !Info) :-
- find_items_used_by_inst(Inst1, !Info),
- find_items_used_by_inst(Inst2, !Info).
-find_items_used_by_inst_name(unify_inst(_, Inst1, Inst2, _), !Info) :-
+ find_items_used_by_insts(ArgInsts, !Info)
+ ;
+ ( InstName = merge_inst(Inst1, Inst2)
+ ; InstName = unify_inst(_, Inst1, Inst2, _)
+ ),
find_items_used_by_inst(Inst1, !Info),
- find_items_used_by_inst(Inst2, !Info).
-find_items_used_by_inst_name(ground_inst(InstName, _, _, _), !Info) :-
- find_items_used_by_inst_name(InstName, !Info).
-find_items_used_by_inst_name(any_inst(InstName, _, _, _), !Info) :-
- find_items_used_by_inst_name(InstName, !Info).
-find_items_used_by_inst_name(shared_inst(InstName), !Info) :-
- find_items_used_by_inst_name(InstName, !Info).
-find_items_used_by_inst_name(mostly_uniq_inst(InstName), !Info) :-
- find_items_used_by_inst_name(InstName, !Info).
-find_items_used_by_inst_name(typed_ground(_, Type), !Info) :-
- find_items_used_by_type(Type, !Info).
-find_items_used_by_inst_name(typed_inst(Type, InstName), !Info) :-
+ find_items_used_by_inst(Inst2, !Info)
+ ;
+ ( InstName = ground_inst(SubInstName, _, _, _)
+ ; InstName = any_inst(SubInstName, _, _, _)
+ ; InstName = shared_inst(SubInstName)
+ ; InstName = mostly_uniq_inst(SubInstName)
+ ),
+ find_items_used_by_inst_name(SubInstName, !Info)
+ ;
+ InstName = typed_ground(_, Type),
+ find_items_used_by_type(Type, !Info)
+ ;
+ InstName = typed_inst(Type, SubInstName),
find_items_used_by_type(Type, !Info),
- find_items_used_by_inst_name(InstName, !Info).
+ find_items_used_by_inst_name(SubInstName, !Info)
+ ).
:- pred find_items_used_by_class_context(prog_constraints::in,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.80
diff -u -b -r1.80 recompilation.version.m
--- compiler/recompilation.version.m 27 Mar 2012 23:21:28 -0000 1.80
+++ compiler/recompilation.version.m 17 Apr 2012 12:30:10 -0000
@@ -49,6 +49,7 @@
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_out.hlds_out_mode.
+:- import_module hlds.hlds_out.hlds_out_util.
:- import_module parse_tree.error_util.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_io_sym_name.
@@ -1100,13 +1101,13 @@
% Treat modes as terms here to use term.list_subsumes, which does just
% what we want here.
- ModeTerms1 = list.map(mode_to_term, Modes1),
- ModeTerms2 = list.map(mode_to_term, Modes2),
+ ModeTerms1 = list.map(mode_to_term(output_mercury), Modes1),
+ ModeTerms2 = list.map(mode_to_term(output_mercury), Modes2),
(
MaybeWithInst1 = yes(Inst1),
MaybeWithInst2 = yes(Inst2),
- WithInstTerm1 = mode_to_term(free -> Inst1),
- WithInstTerm2 = mode_to_term(free -> Inst2),
+ WithInstTerm1 = mode_to_term(output_mercury, free -> Inst1),
+ WithInstTerm2 = mode_to_term(output_mercury, free -> Inst2),
AllModeTerms1 = [WithInstTerm1 | ModeTerms1],
AllModeTerms2 = [WithInstTerm2 | ModeTerms2]
;
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.277
diff -u -b -r1.277 simplify.m
--- compiler/simplify.m 11 Apr 2012 04:52:35 -0000 1.277
+++ compiler/simplify.m 16 Apr 2012 11:23:54 -0000
@@ -2360,7 +2360,8 @@
TypeCtor = type_ctor(
qualified(mercury_public_builtin_module, "comparison_result"), 0),
ConsId = cons(qualified(BuiltinModule, Inequality), 0, TypeCtor),
- Bound = bound(shared, [bound_functor(ConsId, [])]),
+ Bound = bound(shared, inst_test_results_fgtc,
+ [bound_functor(ConsId, [])]),
UMode = ((Unique -> Bound) - (Bound -> Bound)),
RHS = rhs_functor(ConsId, no, []),
UKind = deconstruct(R, ConsId, [], [], can_fail, cannot_cgc),
Index: compiler/try_expand.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/try_expand.m,v
retrieving revision 1.22
diff -u -b -r1.22 try_expand.m
--- compiler/try_expand.m 13 Feb 2012 00:11:49 -0000 1.22
+++ compiler/try_expand.m 16 Apr 2012 11:24:31 -0000
@@ -927,7 +927,7 @@
ArgInst \= ground(_, none)
->
TupleArity = list.length(TupleArgInsts),
- TupleInst = bound(shared, [
+ TupleInst = bound(shared, inst_test_no_results, [
bound_functor(tuple_cons(TupleArity), TupleArgInsts)
]),
generate_cast_with_insts(unsafe_type_inst_cast, TmpTupleVar, TupleVar,
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.143
diff -u -b -r1.143 unique_modes.m
--- compiler/unique_modes.m 13 Feb 2012 00:11:50 -0000 1.143
+++ compiler/unique_modes.m 16 Apr 2012 11:24:42 -0000
@@ -242,7 +242,7 @@
instmap_lookup_var(InstMap0, Var, Inst0),
inst_expand(ModuleInfo0, Inst0, Inst1),
( Inst1 = ground(unique, _)
- ; Inst1 = bound(unique, _)
+ ; Inst1 = bound(unique, _, _)
; Inst1 = any(unique, _)
)
->
Index: compiler/unused_imports.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_imports.m,v
retrieving revision 1.30
diff -u -b -r1.30 unused_imports.m
--- compiler/unused_imports.m 18 Apr 2012 02:23:23 -0000 1.30
+++ compiler/unused_imports.m 18 Apr 2012 02:26:46 -0000
@@ -552,26 +552,36 @@
:- pred mer_inst_used_modules(item_visibility::in, mer_inst::in,
used_modules::in, used_modules::out) is det.
-mer_inst_used_modules(Visibility, any(_, HOInstInfo), !UsedModules) :-
- ho_inst_info_used_modules(Visibility, HOInstInfo, !UsedModules).
-mer_inst_used_modules(_, free, !UsedModules).
-mer_inst_used_modules(Visibility, free(Type), !UsedModules) :-
- mer_type_used_modules(Visibility, Type, !UsedModules).
-mer_inst_used_modules(Visibility, bound(_, BoundInsts), !UsedModules) :-
+mer_inst_used_modules(Visibility, Inst, !UsedModules) :-
+ (
+ ( Inst = not_reached
+ ; Inst = free
+ ; Inst = inst_var(_)
+ )
+ ;
+ ( Inst = ground(_, HOInstInfo)
+ ; Inst = any(_, HOInstInfo)
+ ),
+ ho_inst_info_used_modules(Visibility, HOInstInfo, !UsedModules)
+ ;
+ Inst = free(Type),
+ mer_type_used_modules(Visibility, Type, !UsedModules)
+ ;
+ Inst = bound(_, _InstResults, BoundInsts),
+ % Anything appearing in InstResults should also appear in BoundInsts.
list.foldl(bound_inst_info_used_modules(Visibility), BoundInsts,
- !UsedModules).
-mer_inst_used_modules(Visibility, ground(_, HOInstInfo), !UsedModules) :-
- ho_inst_info_used_modules(Visibility, HOInstInfo, !UsedModules).
-mer_inst_used_modules(_, not_reached, !UsedModules).
-mer_inst_used_modules(_, inst_var(_), !UsedModules).
-mer_inst_used_modules(Visibility, constrained_inst_vars(_InstVars, Inst),
- !UsedModules) :-
- mer_inst_used_modules(Visibility, Inst, !UsedModules).
-mer_inst_used_modules(Visibility, defined_inst(InstName), !UsedModules) :-
- inst_name_used_modules(Visibility, InstName, !UsedModules).
-mer_inst_used_modules(Visibility, abstract_inst(Name, Insts), !UsedModules) :-
+ !UsedModules)
+ ;
+ Inst = constrained_inst_vars(_InstVars, SubInst),
+ mer_inst_used_modules(Visibility, SubInst, !UsedModules)
+ ;
+ Inst = defined_inst(InstName),
+ inst_name_used_modules(Visibility, InstName, !UsedModules)
+ ;
+ Inst = abstract_inst(Name, ArgInsts),
add_sym_name_module(Visibility, Name, !UsedModules),
- list.foldl(mer_inst_used_modules(Visibility), Insts, !UsedModules).
+ list.foldl(mer_inst_used_modules(Visibility), ArgInsts, !UsedModules)
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/xml_documentation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/xml_documentation.m,v
retrieving revision 1.31
diff -u -b -r1.31 xml_documentation.m
--- compiler/xml_documentation.m 5 Jul 2011 03:34:34 -0000 1.31
+++ compiler/xml_documentation.m 16 Apr 2012 11:42:53 -0000
@@ -565,42 +565,65 @@
:- func mer_mode(inst_varset, mer_mode) = xml.
-mer_mode(IVarset, A -> B) = Xml :-
- XmlFrom = xml_list("from", mer_inst(IVarset), [A]),
- XmlTo = xml_list("to", mer_inst(IVarset), [B]),
- Xml = elem("inst_to_inst", [], [XmlFrom, XmlTo]).
-mer_mode(IVarset, user_defined_mode(Name, Args)) = Xml :-
+mer_mode(InstVarSet, Mode) = Xml :-
+ (
+ Mode = (A -> B),
+ XmlFrom = xml_list("from", mer_inst(InstVarSet), [A]),
+ XmlTo = xml_list("to", mer_inst(InstVarSet), [B]),
+ Xml = elem("inst_to_inst", [], [XmlFrom, XmlTo])
+ ;
+ Mode = user_defined_mode(Name, Args),
Ref = attr("ref", sym_name_and_arity_to_id("mode", Name, length(Args))),
- XmlArgs = xml_list("mode_args", mer_inst(IVarset), Args),
- Xml = elem("user_defined_mode", [Ref], [name(Name), XmlArgs]).
+ XmlArgs = xml_list("mode_args", mer_inst(InstVarSet), Args),
+ Xml = elem("user_defined_mode", [Ref], [name(Name), XmlArgs])
+ ).
:- func mer_inst(inst_varset, mer_inst) = xml.
-mer_inst(_, any(U, _)) = elem("any", [], [uniqueness(U)]).
-mer_inst(_, free) = elem("free", [], []).
-mer_inst(_, free(_)) = elem("free", [], []).
-mer_inst(IVarset, bound(U, BoundInsts)) = Xml :-
+mer_inst(InstVarSet, Inst) = Xml :-
+ (
+ Inst = free,
+ Xml = elem("free", [], [])
+ ;
+ Inst = free(_),
+ Xml = elem("free", [], [])
+ ;
+ Inst = bound(U, _, BoundInsts),
XmlUniq = uniqueness(U),
- XmlInsts = xml_list("bound_insts", bound_inst(IVarset), BoundInsts),
- Xml = elem("bound", [], [XmlUniq, XmlInsts]).
-mer_inst(_, ground(U, _)) = elem("ground", [], [uniqueness(U)]).
-mer_inst(_, not_reached) = elem("not_reached", [], []).
-mer_inst(IVarset, inst_var(IVar)) = Xml :-
- IVarName = varset.lookup_name(IVarset, IVar),
- Xml = tagged_string("inst_var", IVarName).
-mer_inst(IVarSet, constrained_inst_vars(_, Inst)) = mer_inst(IVarSet, Inst).
-mer_inst(IVarset, defined_inst(Name)) = Xml :-
- XmlName = inst_name(IVarset, Name),
- Xml = elem("defined_inst", [], [XmlName]).
-mer_inst(IVarset, abstract_inst(SymName, Insts)) =
- mer_inst(IVarset, defined_inst(user_inst(SymName, Insts))).
+ XmlInsts = xml_list("bound_insts", bound_inst(InstVarSet), BoundInsts),
+ Xml = elem("bound", [], [XmlUniq, XmlInsts])
+ ;
+ Inst = ground(U, _),
+ Xml = elem("ground", [], [uniqueness(U)])
+ ;
+ Inst = any(U, _),
+ Xml = elem("any", [], [uniqueness(U)])
+ ;
+ Inst = not_reached,
+ Xml = elem("not_reached", [], [])
+ ;
+ Inst = inst_var(InstVar),
+ InstVarName = varset.lookup_name(InstVarSet, InstVar),
+ Xml = tagged_string("inst_var", InstVarName)
+ ;
+ Inst = constrained_inst_vars(_, SubInst),
+ % XXX We do we ignore the constraint?
+ Xml = mer_inst(InstVarSet, SubInst)
+ ;
+ Inst = defined_inst(Name),
+ XmlName = inst_name(InstVarSet, Name),
+ Xml = elem("defined_inst", [], [XmlName])
+ ;
+ Inst = abstract_inst(SymName, ArgInsts),
+ Xml = mer_inst(InstVarSet, defined_inst(user_inst(SymName, ArgInsts)))
+ ).
:- func inst_name(inst_varset, inst_name) = xml.
-inst_name(IVarset, user_inst(Name, Insts)) = Xml :-
+inst_name(InstVarSet, user_inst(Name, Insts)) = Xml :-
Ref = attr("ref", sym_name_and_arity_to_id("inst", Name, length(Insts))),
XmlName = name(Name),
- XmlInsts = xml_list("inst_args", mer_inst(IVarset), Insts),
+ XmlInsts = xml_list("inst_args", mer_inst(InstVarSet), Insts),
Xml = elem("user_inst", [Ref], [XmlName, XmlInsts]).
inst_name(_, merge_inst(_, _)) = nyi("merge_inst").
inst_name(_, unify_inst(_, _, _, _)) = nyi("unify_inst").
@@ -617,9 +640,9 @@
:- func bound_inst(inst_varset, bound_inst) = xml.
-bound_inst(IVarset, bound_functor(ConsId, Insts)) = Xml :-
+bound_inst(InstVarSet, bound_functor(ConsId, Insts)) = Xml :-
XmlCons = cons_id(ConsId),
- XmlInsts = xml_list("insts", mer_inst(IVarset), Insts),
+ XmlInsts = xml_list("insts", mer_inst(InstVarSet), Insts),
Xml = elem("bound_functor", [], [XmlCons, XmlInsts]).
:- func cons_id(cons_id) = xml.
cvs diff: Diffing compiler/notes
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_cairo
cvs diff: Diffing extras/graphics/mercury_cairo/samples
cvs diff: Diffing extras/graphics/mercury_cairo/samples/data
cvs diff: Diffing extras/graphics/mercury_cairo/tutorial
cvs diff: Diffing extras/graphics/mercury_glfw
cvs diff: Diffing extras/graphics/mercury_glfw/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/monte
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing m4
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/appengine
cvs diff: Diffing samples/appengine/war
cvs diff: Diffing samples/appengine/war/WEB-INF
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/concurrency
cvs diff: Diffing samples/concurrency/dining_philosophers
cvs diff: Diffing samples/concurrency/midimon
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/java_interface
cvs diff: Diffing samples/java_interface/java_calls_mercury
cvs diff: Diffing samples/java_interface/mercury_calls_java
cvs diff: Diffing samples/lazy_list
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/feedback
cvs diff: Diffing tests/feedback/mandelbrot
cvs diff: Diffing tests/feedback/mmc
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list