[m-rev.] for review: don't allow nondefault mode functions in terms
Mark Brown
mark at mercurylang.org
Mon Nov 2 06:17:10 AEDT 2015
On Mon, Nov 2, 2015 at 2:08 AM, Zoltan Somogyi
<zoltan.somogyi at runbox.com> wrote:
> On Sun, 1 Nov 2015 14:36:03 +1100, Mark Brown <mark at mercurylang.org> wrote:
>> The ordering here is in part an information theoretic one, but the
>> instantiatedness tree, at least as described in the ref man, doesn't
>> include all the relevant information.
>
> Of course it doesn't. It can't, because if it did, noone would
> understand it.
>
> I have long said that the reason why the code that handles insts
> is so complex is because insts are complex. The inst of a variable
> at a given program point encodes *all* of the following information:
>
> - Is the program point reachable?
> - Which nodes of the type tree of the variable are bound?
> - Of the nodes which are bound, which are unique or clobbered?
> - Of the nodes which are bound, which are known to be bound to
> only a subset of the function symbols of the type of the affected
> type tree node?
> - Of the nodes which are bound, and which correspond to a higher
> order type, what is the determinism and what are the modes
> of the arguments of that higher order value?
>
> Each one of those can be handled reasonably easily. It is their
> combination that leads to the explosion of complexity.
>
> The term "ground" clearly* answers the second question: all nodes
> are bound. The different meanings of "ground" differ in what
> restrictions, if any, they impose on the answers to the third, fourth
> and fifth. Just by combining the answers to "do we care about each
> of those three kinds of distinctions or not", we have 2^3=8 possible
> meanings of "ground". And they are NOT quite independent; in code
> such as valid/ho_func_call.m, some function symbols of a type
> have higher order arguments while other function symbols do not,
> which couples the fourth and fifth questions together, in a way.
Not the mention the various things that "free" could mean.
But this is not the problem I am facing right now. There are not that
many predicates in total that are needed; we only have around a dozen,
and that is counting the meanings of all terms (like unique and any),
plus combinations of terms.
The problem I am facing is that the change in the rules for inst
matching mean that some occurrences of these predicates, but not all,
are now incorrect. I have to tease apart the call graph to make sure
the parts that need changing are changed, and the other parts are not.
As a step in this direction I have separated inst_match.m into two
modules. This significantly reduces its coupling with the rest of the
compiler, and should help in future changes to inst_match.m, whatever
happens. Diff is attached; I think only the log message needs review.
>> As I said, I
>> haven't reached my pain threshold yet.
>
> Has the above helped you reach it?
No, although the past 24 hours has convinced me to accept your patch
for the time being. ;-)
>
> I think that in the medium term, the best solution to this problem
> would be to take the answer to the fourth question out of insts
> and to put them into types instead. It would be an aspect of types
> that would have to checked during mode analysis, not type checking.
> This would complicate the relationship between the two analyses,
> which is why it wasn't done that way originally. However, if it was
> done correctly, it would guarantee that the information cannot
> get lost. With that system, if you took a higher order value out
> of a term, its type would tell you its signature, even if the term
> was (at some intermediate point in time) polymorphic.
Well, I agree with pushing such information from the type system to
the mode system, although I don't agree that it helps with the
terminological problem. You'll still have the same binary
relationships between insts to come up with a name for (matches, etc),
but you'll have an additional one for types, too.
Cheers,
Mark.
-------------- next part --------------
commit 375f18073d4ce3b7ea34ef410dee4cb3086131c1
Author: Mark Brown <mark at mercurylang.org>
Date: Mon Nov 2 01:51:35 2015 +1100
Split parts of inst_match.m into a new module, inst_test.m
Most modules that imported inst_match did so in order to use
predicates such as inst_is_ground to test properties of insts.
These predicates are split into a new module, leaving the more
complex parts of inst_match to be imported in fewer places.
This makes it easier to change inst_match (for example, to
address mantis bug 264) without unintentional changes to
the rest of the compiler.
compiler/inst_test.m:
New module containing code from inst_match.m.
compiler/check_hlds.m:
Include the new module.
compiler/inst_match.m:
Move code to the new module.
compiler/inst_util.m:
Move inst_expand and inst_expand_and_remove_constrained_inst_vars
here rather than the new module, since they make more sense here.
compiler/build_mode_constraints.m:
compiler/cse_detection.m:
compiler/deforest.m:
compiler/delay_construct.m:
compiler/delay_partial_inst.m:
compiler/dep_par_conj.m:
compiler/det_report.m:
compiler/fact_table.m:
compiler/float_regs.m:
compiler/goal_util.m:
compiler/interval.m:
compiler/loop_inv.m:
compiler/modecheck_goal.m:
compiler/pd_util.m:
compiler/prog_rep.m:
compiler/simplify_goal_call.m:
compiler/size_prof.m:
compiler/stm_expand.m:
compiler/structure_sharing.domain.m:
compiler/switch_detection.m:
compiler/term_util.m:
compiler/trace_gen.m:
compiler/unify_proc.m:
compiler/unneeded_code.m:
Only import inst_test.
compiler/common.m:
compiler/instmap.m:
compiler/mode_util.m:
compiler/modecheck_call.m:
compiler/modecheck_unify.m:
compiler/modecheck_util.m:
compiler/modes.m:
compiler/simplify_goal_disj.m:
Import inst_test in addition to inst_match.
compiler/lco.m:
compiler/simplify_goal_switch.m:
Import inst_test and inst_util, but not inst_match.
diff --git a/compiler/build_mode_constraints.m b/compiler/build_mode_constraints.m
index f540061..1d368c4 100644
--- a/compiler/build_mode_constraints.m
+++ b/compiler/build_mode_constraints.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2004-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -188,7 +189,7 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module hlds.hlds_args.
:- import_module hlds.hlds_clauses.
@@ -819,12 +820,12 @@ single_mode_constraints(ModuleInfo, MCVar, Mode) = Constraint :-
mode_util.mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
(
% Already produced?
- not inst_match.inst_is_free(ModuleInfo, InitialInst)
+ not inst_is_free(ModuleInfo, InitialInst)
->
IsProduced = no % Not produced here.
;
% free -> non-free
- not inst_match.inst_is_free(ModuleInfo, FinalInst)
+ not inst_is_free(ModuleInfo, FinalInst)
->
IsProduced = yes % Produced here.
;
diff --git a/compiler/check_hlds.m b/compiler/check_hlds.m
index bd3959d..c18ebb8 100644
--- a/compiler/check_hlds.m
+++ b/compiler/check_hlds.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2002-2006, 2009-2010 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -42,6 +43,7 @@
:- include_module delay_info.
:- include_module delay_partial_inst.
:- include_module inst_match.
+ :- include_module inst_test.
:- include_module inst_util.
:- include_module mode_constraint_robdd.
:- include_module mode_constraints.
diff --git a/compiler/common.m b/compiler/common.m
index 2707801..788dbae 100644
--- a/compiler/common.m
+++ b/compiler/common.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1995-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
@@ -161,6 +162,7 @@
:- import_module check_hlds.det_report.
:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_rtti.
diff --git a/compiler/cse_detection.m b/compiler/cse_detection.m
index 9c953eb..1547bb8 100644
--- a/compiler/cse_detection.m
+++ b/compiler/cse_detection.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1995-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -69,7 +70,7 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.modes.
:- import_module check_hlds.switch_detection.
:- import_module check_hlds.type_util.
diff --git a/compiler/deforest.m b/compiler/deforest.m
index fa26a59..c7c4440 100644
--- a/compiler/deforest.m
+++ b/compiler/deforest.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1999-2012 University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -46,7 +47,7 @@
:- import_module check_hlds.det_analysis.
:- import_module check_hlds.det_report.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.modecheck_util.
:- import_module check_hlds.simplify.
diff --git a/compiler/delay_construct.m b/compiler/delay_construct.m
index 5d64d28..721b997 100644
--- a/compiler/delay_construct.m
+++ b/compiler/delay_construct.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2001-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -40,7 +41,7 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_rtti.
:- import_module hlds.instmap.
diff --git a/compiler/delay_partial_inst.m b/compiler/delay_partial_inst.m
index 9b4408c..0e553d3 100644
--- a/compiler/delay_partial_inst.m
+++ b/compiler/delay_partial_inst.m
@@ -2,7 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2007-2012 The University of Melbourne.
-% Copyright (C) 2014 The Mercury team.
+% Copyright (C) 2014-2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -124,7 +124,7 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module hlds.
:- import_module hlds.goal_util.
diff --git a/compiler/dep_par_conj.m b/compiler/dep_par_conj.m
index d39ee68..d7633ad 100644
--- a/compiler/dep_par_conj.m
+++ b/compiler/dep_par_conj.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2006-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -140,7 +141,7 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.purity.
:- import_module hlds.goal_util.
diff --git a/compiler/det_report.m b/compiler/det_report.m
index e995e05..6ac44ed 100644
--- a/compiler/det_report.m
+++ b/compiler/det_report.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1995-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -122,7 +123,7 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_data.
diff --git a/compiler/fact_table.m b/compiler/fact_table.m
index daa7eee..c6a634e 100644
--- a/compiler/fact_table.m
+++ b/compiler/fact_table.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2001, 2003-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -97,7 +98,7 @@
:- import_module backend_libs.c_util.
:- import_module backend_libs.export.
:- import_module backend_libs.foreign.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module hlds.arg_info.
:- import_module hlds.code_model.
diff --git a/compiler/float_regs.m b/compiler/float_regs.m
index 1f44305..6a18dec 100644
--- a/compiler/float_regs.m
+++ b/compiler/float_regs.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -140,7 +141,7 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.polymorphism.
diff --git a/compiler/goal_util.m b/compiler/goal_util.m
index 9fc71d8..d8a63cf 100644
--- a/compiler/goal_util.m
+++ b/compiler/goal_util.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1995-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -442,7 +443,7 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_util.
:- import_module check_hlds.type_util.
:- import_module hlds.goal_form.
:- import_module parse_tree.prog_detism.
diff --git a/compiler/inst_match.m b/compiler/inst_match.m
index b7bef2f..e3330ef 100644
--- a/compiler/inst_match.m
+++ b/compiler/inst_match.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1995-1998, 2000-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -49,20 +50,6 @@
%-----------------------------------------------------------------------------%
- % inst_expand(ModuleInfo, Inst0, Inst) checks if the top-level part
- % of the inst is a defined inst, and if so replaces it with the definition.
- %
-:- pred inst_expand(module_info::in, mer_inst::in, mer_inst::out) is det.
-
- % inst_expand_and_remove_constrained_inst_vars is the same as inst_expand
- % except that it also removes constrained_inst_vars from the top level,
- % replacing them with the constraining inst.
- %
-:- pred inst_expand_and_remove_constrained_inst_vars(module_info::in,
- mer_inst::in, mer_inst::out) is det.
-
-%-----------------------------------------------------------------------------%
-
% inst_matches_initial(InstA, InstB, Type, ModuleInfo):
%
% Succeed iff `InstA' specifies at least as much information as `InstB',
@@ -193,123 +180,6 @@
module_info::in) is semidet.
%-----------------------------------------------------------------------------%
-%
-% Predicates to test various properties of insts.
-%
-% NOTE: `not_reached' insts are considered to satisfy all of these predicates
-% except inst_is_clobbered.
-%
-
- % Succeed if the inst is fully ground (i.e. contains only `ground',
- % `bound', and `not_reached' insts, with no `free' or `any' insts).
- % This predicate succeeds for non-standard function insts so some care
- % needs to be taken since these insts may not be replaced by a less
- % precise inst that uses the higher-order mode information.
- %
-:- pred inst_is_ground(module_info::in, mer_inst::in) is semidet.
-
- % Succeed if the inst is not partly free (i.e. contains only `any',
- % `ground', `bound', and `not_reached' insts, with no `free' insts).
- % This predicate succeeds for non-standard function insts so some care
- % needs to be taken since these insts may not be replaced by a less
- % precise inst that uses the higher-order mode information.
- %
-:- pred inst_is_ground_or_any(module_info::in, mer_inst::in) is semidet.
-
- % Succeed if the inst is `mostly_unique' or `unique'.
- %
- % XXX The documentation on the code used to say: " inst_is_mostly_unique
- % succeeds iff the inst passed is unique, mostly_unique, or free.
- % Abstract insts are not considered unique.". The part about free is
- % dubious.
- %
-:- pred inst_is_mostly_unique(module_info::in, mer_inst::in) is semidet.
-
- % Succeed if the inst is `unique'.
- %
- % XXX The documentation on the code used to say: "inst_is_unique succeeds
- % iff the inst passed is unique or free. Abstract insts are not considered
- % unique.". The part about free is dubious.
- %
-:- pred inst_is_unique(module_info::in, mer_inst::in) is semidet.
-
- % Succeed if the inst is not `mostly_unique' or `unique'.
- %
-:- pred inst_is_not_partly_unique(module_info::in, mer_inst::in) is semidet.
-
- % Succeed if the inst is not `unique'.
- %
-:- pred inst_is_not_fully_unique(module_info::in, mer_inst::in) is semidet.
-
- % inst_is_clobbered succeeds iff the inst passed is `clobbered'
- % or `mostly_clobbered' or if it is a user-defined inst which
- % is defined as one of those.
- %
-:- pred inst_is_clobbered(module_info::in, mer_inst::in) is semidet.
-
-:- pred inst_list_is_ground(list(mer_inst)::in, module_info::in) is semidet.
-
-:- pred inst_list_is_ground_or_any(list(mer_inst)::in, module_info::in)
- is semidet.
-
-:- pred inst_results_bound_inst_list_is_ground(inst_test_results::in,
- list(bound_inst)::in, module_info::in) is semidet.
-
-:- pred inst_results_bound_inst_list_is_ground_or_any(inst_test_results::in,
- list(bound_inst)::in, module_info::in) is semidet.
-
-:- pred inst_list_is_unique(list(mer_inst)::in, module_info::in) is semidet.
-
-:- pred inst_list_is_mostly_unique(list(mer_inst)::in, module_info::in)
- is semidet.
-
-:- pred inst_list_is_not_partly_unique(list(mer_inst)::in, module_info::in)
- is semidet.
-
-:- pred inst_list_is_not_fully_unique(list(mer_inst)::in, module_info::in)
- is semidet.
-
-:- pred bound_inst_list_is_unique(list(bound_inst)::in, module_info::in)
- is semidet.
-
-:- pred bound_inst_list_is_mostly_unique(list(bound_inst)::in, module_info::in)
- is semidet.
-
-:- pred bound_inst_list_is_not_partly_unique(list(bound_inst)::in,
- module_info::in) is semidet.
-
-:- pred bound_inst_list_is_not_fully_unique(list(bound_inst)::in,
- module_info::in) is semidet.
-
- % inst_is_free succeeds iff the inst passed is `free'
- % or is a user-defined inst which is defined as `free'.
- % Abstract insts must not be free.
- %
-:- pred inst_is_free(module_info::in, mer_inst::in) is semidet.
-
-:- pred inst_is_any(module_info::in, mer_inst::in) is semidet.
-
-:- pred inst_list_is_free(list(mer_inst)::in, module_info::in) is semidet.
-
-:- pred bound_inst_list_is_free(list(bound_inst)::in, module_info::in)
- is semidet.
-
- % inst_is_bound succeeds iff the inst passed is not `free'
- % or is a user-defined inst which is not defined as `free'.
- % Abstract insts must be bound.
- %
-:- pred inst_is_bound(module_info::in, mer_inst::in) is semidet.
-
-:- pred inst_is_bound_to_functors(module_info::in, mer_inst::in,
- list(bound_inst)::out) is semidet.
-
-%-----------------------------------------------------------------------------%
-
- % Succeed iff the specified inst contains (directly or indirectly) the
- % specified inst_name.
- %
-:- pred inst_contains_inst_name(mer_inst::in, module_info::in, inst_name::in)
- is semidet.
% Nondeterministically produce all the inst_vars contained in the
% specified list of modes.
@@ -317,26 +187,12 @@
:- pred mode_list_contains_inst_var(list(mer_mode)::in, module_info::in,
inst_var::out) is nondet.
- % Given a list of insts, and a corresponding list of livenesses, return
- % true iff for every element in the list of insts, either the elemement is
- % ground or the corresponding element in the liveness list is dead.
- %
-:- pred inst_list_is_ground_or_dead(list(mer_inst)::in, list(is_live)::in,
- module_info::in) is semidet.
-
- % Given a list of insts, and a corresponding list of livenesses, return
- % true iff for every element in the list of insts, either the elemement is
- % ground or any, or the corresponding element in the liveness list is
- % dead.
- %
-:- pred inst_list_is_ground_or_any_or_dead(list(mer_inst)::in,
- list(is_live)::in, module_info::in) is semidet.
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
@@ -381,26 +237,6 @@ expansion_insert_new(E, S0, S) :-
%-----------------------------------------------------------------------------%
-inst_expand(ModuleInfo, !Inst) :-
- ( if !.Inst = defined_inst(InstName) then
- inst_lookup(ModuleInfo, InstName, !:Inst),
- inst_expand(ModuleInfo, !Inst)
- else
- true
- ).
-
-inst_expand_and_remove_constrained_inst_vars(ModuleInfo, !Inst) :-
- ( if !.Inst = defined_inst(InstName) then
- inst_lookup(ModuleInfo, InstName, !:Inst),
- inst_expand(ModuleInfo, !Inst)
- else if !.Inst = constrained_inst_vars(_, !:Inst) then
- inst_expand(ModuleInfo, !Inst)
- else
- true
- ).
-
-%-----------------------------------------------------------------------------%
-
% The uniqueness_comparison type is used by the predicate
% compare_uniqueness to determine what order should be used for
% comparing two uniqueness annotations.
@@ -1465,1106 +1301,6 @@ bound_inst_list_matches_binding([X | Xs], [Y | Ys], MaybeType, !Info) :-
%-----------------------------------------------------------------------------%
-inst_is_clobbered(ModuleInfo, Inst) :-
- require_complete_switch [Inst]
- (
- ( Inst = free
- ; Inst = free(_)
- ; Inst = not_reached
- ; Inst = abstract_inst(_, _) % XXX is this right?
- ),
- fail
- ;
- ( Inst = any(mostly_clobbered, _)
- ; Inst = any(clobbered, _)
- ; Inst = ground(clobbered, _)
- ; Inst = ground(mostly_clobbered, _)
- ; Inst = bound(clobbered, _, _)
- ; Inst = bound(mostly_clobbered, _, _)
- )
- ;
- Inst = inst_var(_),
- unexpected($module, $pred, "uninstantiated inst parameter")
- ;
- Inst = constrained_inst_vars(_, SubInst),
- inst_is_clobbered(ModuleInfo, SubInst)
- ;
- Inst = defined_inst(InstName),
- inst_lookup(ModuleInfo, InstName, NextInst),
- inst_is_clobbered(ModuleInfo, NextInst)
- ).
-
-inst_is_free(ModuleInfo, Inst) :-
- require_complete_switch [Inst]
- (
- ( Inst = free
- ; Inst = free(_)
- )
- ;
- ( Inst = ground(_, _)
- ; Inst = bound(_, _, _)
- ; Inst = any(_, _)
- ; Inst = not_reached
- ; Inst = abstract_inst(_, _) % XXX is this right?
- ),
- fail
- ;
- Inst = inst_var(_),
- unexpected($module, $pred, "uninstantiated inst parameter")
- ;
- Inst = constrained_inst_vars(_, SubInst),
- inst_is_free(ModuleInfo, SubInst)
- ;
- Inst = defined_inst(InstName),
- inst_lookup(ModuleInfo, InstName, NextInst),
- inst_is_free(ModuleInfo, NextInst)
- ).
-
-inst_is_any(ModuleInfo, Inst) :-
- require_complete_switch [Inst]
- (
- Inst = any(_, _)
- ;
- ( Inst = free
- ; Inst = free(_)
- ; Inst = ground(_, _)
- ; Inst = bound(_, _, _)
- ; Inst = not_reached
- ; Inst = abstract_inst(_, _) % XXX is this right?
- ),
- fail
- ;
- Inst = inst_var(_),
- unexpected($module, $pred, "uninstantiated inst parameter")
- ;
- Inst = constrained_inst_vars(_, SubInst),
- inst_is_any(ModuleInfo, SubInst)
- ;
- Inst = defined_inst(InstName),
- inst_lookup(ModuleInfo, InstName, NextInst),
- inst_is_any(ModuleInfo, NextInst)
- ).
-
-inst_is_bound(ModuleInfo, Inst) :-
- require_complete_switch [Inst]
- (
- ( Inst = ground(_, _)
- ; Inst = bound(_, _, _)
- ; Inst = any(_, _)
- ; Inst = abstract_inst(_, _) % XXX is this right?
- ; Inst = not_reached
- )
- ;
- ( Inst = free
- ; Inst = free(_)
- ),
- fail
- ;
- Inst = inst_var(_),
- unexpected($module, $pred, "uninstantiated inst parameter")
- ;
- Inst = constrained_inst_vars(_, SubInst),
- inst_is_bound(ModuleInfo, SubInst)
- ;
- Inst = defined_inst(InstName),
- inst_lookup(ModuleInfo, InstName, NextInst),
- inst_is_bound(ModuleInfo, NextInst)
- ).
-
-inst_is_bound_to_functors(ModuleInfo, Inst, Functors) :-
- % inst_is_bound_to_functors succeeds iff the inst passed is
- % `bound(_Uniq, Functors)' or is a user-defined inst which expands to
- % `bound(_Uniq, Functors)'.
- %
- require_complete_switch [Inst]
- (
- Inst = bound(_Uniq, _InstResult, Functors)
- ;
- Inst = inst_var(_),
- unexpected($module, $pred, "uninstantiated inst parameter")
- ;
- Inst = constrained_inst_vars(_, SubInst),
- inst_is_bound_to_functors(ModuleInfo, SubInst, Functors)
- ;
- Inst = defined_inst(InstName),
- inst_lookup(ModuleInfo, InstName, NextInst),
- inst_is_bound_to_functors(ModuleInfo, NextInst, Functors)
- ;
- ( Inst = free
- ; Inst = free(_)
- ; Inst = any(_, _)
- ; Inst = ground(_, _)
- ; Inst = abstract_inst(_, _)
- ; Inst = not_reached
- ),
- fail
- ).
-
-%-----------------------------------------------------------------------------%
-
-inst_is_ground(ModuleInfo, Inst) :-
- % inst_is_ground succeeds iff the inst passed is `ground' or the
- % equivalent. Abstract insts are not considered ground.
- promise_pure (
- semipure lookup_inst_is_ground(Inst, Found, OldIsGround),
- (
- Found = yes,
- trace [compiletime(flag("inst-is-ground-perf")), io(!IO)] (
- io.write_string("inst_is_ground hit\n", !IO)
- ),
- % Succeed if OldIsGround = yes, fail if OldIsGround = no.
- OldIsGround = yes
- ;
- Found = no,
- trace [compiletime(flag("inst-is-ground-perf")), io(!IO)] (
- io.write_string("inst_is_ground miss\n", !IO)
- ),
- ( if inst_is_ground_mt(ModuleInfo, no, Inst) then
- impure record_inst_is_ground(Inst, yes)
- % Succeed.
- else
- impure record_inst_is_ground(Inst, no),
- fail
- )
- )
- ).
-
-%-----------------------------------------------------------------------------%
-%
-% The expansion of terms by the superhomogeneous transformation generates code
-% that looks like this:
-%
-% V1 = [],
-% V2 = e1,
-% V3 = [V2 | V1],
-% V4 = e2,
-% V5 = [V3 | V4]
-%
-% The insts on those unifications will contain insts from earlier unifications.
-% For example, the inst on the unification building V5 will give V5 an inst
-% that contains the insts of V3 and V4.
-%
-% If there are N elements in a list, testing the insts of the N variables
-% representing the N cons cells in the list would ordinarily take O(N^2) steps.
-% Since N could be very large, this is disastrous.
-%
-% We avoid quadratic performance by caching the results of recent calls
-% to inst_is_ground for insts that are susceptible to this problem.
-% This way, the test on the inst of e.g. V5 will find the results of the tests
-% on the insts of V3 and V4 already available. This reduces the overall
-% complexity of testing the insts of those N variables to O(n).
-%
-% The downsides of this cache include the costs of the lookups, and
-% the fact that it keeps the cached insts alive.
-%
-% Note that we do not need to record the ModuleInfo argument of inst_is_ground,
-% since it is needed only to interpret insts that need access to the mode
-% tables. If we get a result for an inst with one ModuleInfo, we should get
-% the exact same result with any later ModuleInfo. The conservative nature
-% of the Boehm collector means that an inst address recorded in the cache
-% will always point to the original inst; the address cannot be reused until
-% the cache entry is itself reused.
-
-:- pragma foreign_decl("C",
-"
-typedef struct {
- MR_Word iig_inst_addr;
- MR_Word iig_is_ground;
-} InstIsGroundCacheEntry;
-
-#define INST_IS_GROUND_CACHE_SIZE 1307
-
-/*
-** Every entry should be implicitly initialized to zeros. Since zero is
-** not a valid address for an inst, uninitialized entries cannot be mistaken
-** for filled-in entries.
-*/
-
-static InstIsGroundCacheEntry
- inst_is_ground_cache[INST_IS_GROUND_CACHE_SIZE];
-").
-
- % Look up Inst in the cache. If it is there, return Found = yes
- % and set MayOccur. Otherwise, return Found = no.
- %
-:- semipure pred lookup_inst_is_ground(mer_inst::in,
- bool::out, bool::out) is det.
-
-:- pragma foreign_proc("C",
- lookup_inst_is_ground(Inst::in, Found::out, IsGround::out),
- [will_not_call_mercury, promise_semipure],
-"
- MR_Unsigned hash;
-
- hash = (MR_Unsigned) Inst;
- hash = hash >> MR_LOW_TAG_BITS;
- hash = hash % INST_IS_GROUND_CACHE_SIZE;
-
- if (inst_is_ground_cache[hash].iig_inst_addr == Inst) {
- Found = MR_BOOL_YES;
- IsGround = inst_is_ground_cache[hash].iig_is_ground;
- } else {
- Found = MR_BOOL_NO;
- }
-").
-
-lookup_inst_is_ground(_, no, no) :-
- semipure semipure_true.
-
- % Record the result for Inst in the cache.
- %
-:- impure pred record_inst_is_ground(mer_inst::in, bool::in) is det.
-
-:- pragma foreign_proc("C",
- record_inst_is_ground(Inst::in, IsGround::in),
- [will_not_call_mercury],
-"
- MR_Unsigned hash;
-
- hash = (MR_Unsigned) Inst;
- hash = hash >> MR_LOW_TAG_BITS;
- hash = hash % INST_IS_GROUND_CACHE_SIZE;
- /* We overwrite any existing entry in the slot. */
- inst_is_ground_cache[hash].iig_inst_addr = Inst;
- inst_is_ground_cache[hash].iig_is_ground = IsGround;
-").
-
-record_inst_is_ground(_, _) :-
- impure impure_true.
-
-%-----------------------------------------------------------------------------%
-
-:- pred inst_is_ground_mt(module_info::in, maybe(mer_type)::in, mer_inst::in)
- is semidet.
-
-inst_is_ground_mt(ModuleInfo, MaybeType, Inst) :-
- Expansions0 = set_tree234.init,
- inst_is_ground_mt_1(ModuleInfo, MaybeType, Inst, Expansions0, _Expansions).
-
- % The third arg is the set of insts which have already been expanded;
- % we use this to avoid going into an infinite loop.
- %
-:- pred inst_is_ground_mt_1(module_info::in, maybe(mer_type)::in, mer_inst::in,
- set_tree234(mer_inst)::in, set_tree234(mer_inst)::out) is semidet.
-
-inst_is_ground_mt_1(ModuleInfo, MaybeType, Inst, !Expansions) :-
- % XXX This special casing of any/2 was introduced in version 1.65
- % of this file. The log message for that version gives a reason why
- % this special casing is required, but I (zs) don't believe it,
- % at least not without more explanation.
- ( if Inst = any(_, _) then
- ( if set_tree234.contains(!.Expansions, Inst) then
- true
- else
- inst_is_ground_mt_2(ModuleInfo, MaybeType, Inst, !Expansions)
- )
- else
- % ZZZ make this work on Inst's *address*.
- ( if set_tree234.insert_new(Inst, !Expansions) then
- % Inst was not yet in Expansions, but we have now inserted it.
- inst_is_ground_mt_2(ModuleInfo, MaybeType, Inst, !Expansions)
- else
- % Inst was already in !.Expansions.
- true
- )
- ).
-
-:- pred inst_is_ground_mt_2(module_info::in, maybe(mer_type)::in, mer_inst::in,
- set_tree234(mer_inst)::in, set_tree234(mer_inst)::out) is semidet.
-
-inst_is_ground_mt_2(ModuleInfo, MaybeType, Inst, !Expansions) :-
- require_complete_switch [Inst]
- (
- ( Inst = free
- ; Inst = free(_)
- ),
- fail
- ;
- ( Inst = not_reached
- ; Inst = ground(_, _)
- )
- ;
- 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)
- ;
- Inst = defined_inst(InstName),
- inst_lookup(ModuleInfo, InstName, NextInst),
- inst_is_ground_mt_1(ModuleInfo, MaybeType, NextInst, !Expansions)
- ;
- Inst = any(Uniq, HOInstInfo),
- maybe_any_to_bound(MaybeType, ModuleInfo, Uniq, HOInstInfo, NextInst),
- inst_is_ground_mt_1(ModuleInfo, MaybeType, NextInst, !Expansions)
- ;
- Inst = inst_var(_),
- unexpected($module, $pred, "uninstantiated inst parameter")
- ;
- Inst = abstract_inst(_, _),
- % XXX I (zs) am not sure this is the right thing to do here.
- % The original code of this predicate simply did not consider
- % this kind of Inst.
- fail
- ).
-
-inst_is_ground_or_any(ModuleInfo, Inst) :-
- set.init(Expansions0),
- inst_is_ground_or_any_2(ModuleInfo, Inst, Expansions0, _Expansions).
-
- % The third arg is the set of insts which have already been expanded;
- % we use this to avoid going into an infinite loop.
- %
-:- pred inst_is_ground_or_any_2(module_info::in, mer_inst::in,
- set(mer_inst)::in, set(mer_inst)::out) is semidet.
-
-inst_is_ground_or_any_2(ModuleInfo, Inst, !Expansions) :-
- require_complete_switch [Inst]
- (
- ( Inst = ground(_, _)
- ; Inst = any(_, _)
- ; Inst = not_reached
- )
- ;
- Inst = bound(_, InstResults, BoundInsts),
- inst_results_bound_inst_list_is_ground_or_any_2(InstResults,
- BoundInsts, ModuleInfo, !Expansions)
- ;
- ( Inst = free
- ; Inst = free(_)
- ; Inst = abstract_inst(_, _) % XXX is this right?
- ),
- fail
- ;
- Inst = inst_var(_),
- unexpected($module, $pred, "uninstantiated inst parameter")
- ;
- Inst = constrained_inst_vars(_, SubInst),
- inst_is_ground_or_any_2(ModuleInfo, SubInst, !Expansions)
- ;
- Inst = defined_inst(InstName),
- ( if set.insert_new(Inst, !Expansions) then
- inst_lookup(ModuleInfo, InstName, NextInst),
- inst_is_ground_or_any_2(ModuleInfo, NextInst, !Expansions)
- else
- true
- )
- ).
-
-inst_is_unique(ModuleInfo, Inst) :-
- set.init(Expansions0),
- inst_is_unique_2(ModuleInfo, Inst, Expansions0, _Expansions).
-
- % The third arg is the set of insts which have already been expanded;
- % we use this to avoid going into an infinite loop.
- %
-:- pred inst_is_unique_2(module_info::in, mer_inst::in,
- set(mer_inst)::in, set(mer_inst)::out) is semidet.
-
-inst_is_unique_2(ModuleInfo, Inst, !Expansions) :-
- (
- ( Inst = ground(unique, _)
- ; Inst = any(unique, _)
- ; Inst = not_reached
- ; Inst = free % XXX I don't think this is right [zs].
- )
- ;
- ( Inst = ground(shared, _)
- ; Inst = bound(shared, _, _)
- ; Inst = any(shared, _)
- ),
- fail
- ;
- 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")
- ;
- Inst = constrained_inst_vars(_, SubInst),
- inst_is_unique_2(ModuleInfo, SubInst, !Expansions)
- ;
- Inst = defined_inst(InstName),
- ( if set.insert_new(Inst, !Expansions) then
- inst_lookup(ModuleInfo, InstName, NextInst),
- inst_is_unique_2(ModuleInfo, NextInst, !Expansions)
- else
- true
- )
- ).
-
-inst_is_mostly_unique(ModuleInfo, Inst) :-
- set.init(Expansions0),
- inst_is_mostly_unique_2(ModuleInfo, Inst, Expansions0, _Expansions).
-
- % The third arg is the set of insts which have already been expanded;
- % we use this to avoid going into an infinite loop.
- %
-:- pred inst_is_mostly_unique_2(module_info::in, mer_inst::in,
- set(mer_inst)::in, set(mer_inst)::out) is semidet.
-
-inst_is_mostly_unique_2(ModuleInfo, Inst, !Expansions) :-
- require_complete_switch [Inst]
- (
- ( Inst = not_reached
- ; Inst = free
- ; Inst = free(_)
- ; Inst = ground(unique, _)
- ; Inst = ground(mostly_unique, _)
- ; Inst = any(unique, _)
- ; Inst = any(mostly_unique, _)
- )
- ;
- Inst = bound(unique, InstResults, BoundInsts),
- (
- InstResults = inst_test_results_fgtc,
- fail
- ;
- ( 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")
- ;
- Inst = constrained_inst_vars(_, SubInst),
- inst_is_mostly_unique_2(ModuleInfo, SubInst, !Expansions)
- ;
- Inst = defined_inst(InstName),
- ( if set.insert_new(Inst, !Expansions) then
- inst_lookup(ModuleInfo, InstName, NextInst),
- inst_is_mostly_unique_2(ModuleInfo, NextInst, !Expansions)
- else
- true
- )
- ;
- Inst = abstract_inst(_, _),
- % XXX I (zs) am not sure this is the right thing to do here.
- % The original code of this predicate simply did not consider
- % this kind of Inst.
- fail
- ).
-
- % inst_is_not_partly_unique succeeds iff the inst passed is not unique
- % or mostly_unique, i.e. if it is shared free. It fails for abstract insts.
- %
-inst_is_not_partly_unique(ModuleInfo, Inst) :-
- set.init(Expansions0),
- inst_is_not_partly_unique_2(ModuleInfo, Inst, Expansions0, _Expansions).
-
- % The third arg is the set of insts which have already been expanded;
- % we use this to avoid going into an infinite loop.
- %
-:- pred inst_is_not_partly_unique_2(module_info::in, mer_inst::in,
- set(mer_inst)::in, set(mer_inst)::out) is semidet.
-
-inst_is_not_partly_unique_2(ModuleInfo, Inst, !Expansions) :-
- require_complete_switch [Inst]
- (
- ( Inst = not_reached
- ; Inst = free
- ; Inst = free(_)
- ; Inst = any(shared, _)
- ; Inst = ground(shared, _)
- )
- ;
- 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")
- ;
- Inst = constrained_inst_vars(_, SubInst),
- inst_is_not_partly_unique_2(ModuleInfo, SubInst, !Expansions)
- ;
- Inst = defined_inst(InstName),
- ( if set.insert_new(Inst, !Expansions) then
- inst_lookup(ModuleInfo, InstName, NextInst),
- inst_is_not_partly_unique_2(ModuleInfo, NextInst, !Expansions)
- else
- true
- )
- ;
- Inst = abstract_inst(_, _),
- % XXX I (zs) am not sure this is the right thing to do here.
- % The original code of this predicate simply did not consider
- % this kind of Inst.
- fail
- ).
-
- % inst_is_not_fully_unique succeeds iff the inst passed is not unique,
- % i.e. if it is mostly_unique, shared, or free. It fails for abstract
- % insts.
- %
-inst_is_not_fully_unique(ModuleInfo, Inst) :-
- set.init(Expansions0),
- inst_is_not_fully_unique_2(ModuleInfo, Inst, Expansions0, _Expansions).
-
- % The third arg is the set of insts which have already been expanded - we
- % use this to avoid going into an infinite loop.
- %
-:- pred inst_is_not_fully_unique_2(module_info::in, mer_inst::in,
- set(mer_inst)::in, set(mer_inst)::out) is semidet.
-
-inst_is_not_fully_unique_2(ModuleInfo, Inst, !Expansions) :-
- require_complete_switch [Inst]
- (
- ( Inst = not_reached
- ; Inst = free
- ; Inst = free(_)
- ; Inst = ground(shared, _)
- ; Inst = ground(mostly_unique, _)
- ; Inst = any(shared, _)
- ; Inst = any(mostly_unique, _)
- )
- ;
- Inst = bound(Uniq, InstResult, BoundInsts),
- ( Uniq = shared
- ; Uniq = mostly_unique
- ),
- (
- InstResult = inst_test_results_fgtc
- ;
- ( 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")
- ;
- Inst = constrained_inst_vars(_, SubInst),
- inst_is_not_fully_unique_2(ModuleInfo, SubInst, !Expansions)
- ;
- Inst = defined_inst(InstName),
- ( if set.insert_new(Inst, !Expansions) then
- inst_lookup(ModuleInfo, InstName, NextInst),
- inst_is_not_fully_unique_2(ModuleInfo, NextInst, !Expansions)
- else
- true
- )
- ;
- Inst = abstract_inst(_, _),
- % XXX I (zs) am not sure this is the right thing to do here.
- % The original code of this predicate simply did not consider
- % this kind of Inst.
- fail
- ).
-
-%-----------------------------------------------------------------------------%
-
-inst_results_bound_inst_list_is_ground(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_mt(BoundInsts, no, ModuleInfo)
- )
- ;
- InstResults = inst_test_no_results,
- 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_mt(list(bound_inst)::in, maybe(mer_type)::in,
- module_info::in) is semidet.
-
-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_mt(BoundInsts, MaybeType, ModuleInfo).
-
-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
- ; 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)
- ).
-
-:- pred bound_inst_list_is_ground_or_any(list(bound_inst)::in, module_info::in)
- is semidet.
-
-bound_inst_list_is_ground_or_any([], _).
-bound_inst_list_is_ground_or_any([BoundInst | BoundInsts], ModuleInfo) :-
- BoundInst = bound_functor(_Name, Args),
- inst_list_is_ground_or_any(Args, ModuleInfo),
- bound_inst_list_is_ground_or_any(BoundInsts, ModuleInfo).
-
-bound_inst_list_is_unique([], _).
-bound_inst_list_is_unique([BoundInst | BoundInsts], ModuleInfo) :-
- BoundInst = bound_functor(_Name, Args),
- inst_list_is_unique(Args, ModuleInfo),
- bound_inst_list_is_unique(BoundInsts, ModuleInfo).
-
-bound_inst_list_is_mostly_unique([], _).
-bound_inst_list_is_mostly_unique([BoundInst | BoundInsts], ModuleInfo) :-
- BoundInst = bound_functor(_Name, Args),
- inst_list_is_mostly_unique(Args, ModuleInfo),
- bound_inst_list_is_mostly_unique(BoundInsts, ModuleInfo).
-
-bound_inst_list_is_not_partly_unique([], _).
-bound_inst_list_is_not_partly_unique([BoundInst | BoundInsts], ModuleInfo) :-
- BoundInst = bound_functor(_Name, Args),
- inst_list_is_not_partly_unique(Args, ModuleInfo),
- bound_inst_list_is_not_partly_unique(BoundInsts, ModuleInfo).
-
-bound_inst_list_is_not_fully_unique([], _).
-bound_inst_list_is_not_fully_unique([BoundInst | BoundInsts], ModuleInfo) :-
- BoundInst = bound_functor(_Name, Args),
- inst_list_is_not_fully_unique(Args, ModuleInfo),
- bound_inst_list_is_not_fully_unique(BoundInsts, ModuleInfo).
-
-%-----------------------------------------------------------------------------%
-
-:- 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.
-
-bound_inst_list_is_ground_mt_2([], _, _, !Expansions).
-bound_inst_list_is_ground_mt_2([BoundInst | BoundInsts], MaybeType, ModuleInfo,
- !Expansions) :-
- BoundInst = bound_functor(Name, Args),
- maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, Name,
- list.length(Args), MaybeTypes),
- inst_list_is_ground_mt_2(Args, MaybeTypes, ModuleInfo, !Expansions),
- 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.
-
-bound_inst_list_is_ground_or_any_2([], _, !Expansions).
-bound_inst_list_is_ground_or_any_2([BoundInst | BoundInsts], ModuleInfo,
- !Expansions) :-
- BoundInst = bound_functor(_Name, Args),
- inst_list_is_ground_or_any_2(Args, ModuleInfo, !Expansions),
- bound_inst_list_is_ground_or_any_2(BoundInsts, ModuleInfo, !Expansions).
-
-:- pred bound_inst_list_is_unique_2(list(bound_inst)::in, module_info::in,
- set(mer_inst)::in, set(mer_inst)::out) is semidet.
-
-bound_inst_list_is_unique_2([], _, !Expansions).
-bound_inst_list_is_unique_2([BoundInst | BoundInsts], ModuleInfo,
- !Expansions) :-
- BoundInst = bound_functor(_Name, Args),
- inst_list_is_unique_2(Args, ModuleInfo, !Expansions),
- bound_inst_list_is_unique_2(BoundInsts, ModuleInfo, !Expansions).
-
-:- pred bound_inst_list_is_mostly_unique_2(list(bound_inst)::in,
- module_info::in, set(mer_inst)::in, set(mer_inst)::out) is semidet.
-
-bound_inst_list_is_mostly_unique_2([], _, !Expansions).
-bound_inst_list_is_mostly_unique_2([BoundInst | BoundInsts], ModuleInfo,
- !Expansions) :-
- BoundInst = bound_functor(_Name, Args),
- inst_list_is_mostly_unique_2(Args, ModuleInfo, !Expansions),
- bound_inst_list_is_mostly_unique_2(BoundInsts, ModuleInfo, !Expansions).
-
-:- pred bound_inst_list_is_not_partly_unique_2(list(bound_inst)::in,
- module_info::in, set(mer_inst)::in, set(mer_inst)::out) is semidet.
-
-bound_inst_list_is_not_partly_unique_2([], _, !Expansions).
-bound_inst_list_is_not_partly_unique_2([BoundInst | BoundInsts], ModuleInfo,
- !Expansions) :-
- BoundInst = bound_functor(_Name, Args),
- inst_list_is_not_partly_unique_2(Args, ModuleInfo, !Expansions),
- bound_inst_list_is_not_partly_unique_2(BoundInsts, ModuleInfo,
- !Expansions).
-
-:- pred bound_inst_list_is_not_fully_unique_2(list(bound_inst)::in,
- module_info::in, set(mer_inst)::in, set(mer_inst)::out) is semidet.
-
-bound_inst_list_is_not_fully_unique_2([], _, !Expansions).
-bound_inst_list_is_not_fully_unique_2([BoundInst | BoundInsts], ModuleInfo,
- !Expansions) :-
- BoundInst = bound_functor(_Name, Args),
- inst_list_is_not_fully_unique_2(Args, ModuleInfo, !Expansions),
- bound_inst_list_is_not_fully_unique_2(BoundInsts, ModuleInfo,
- !Expansions).
-
-%-----------------------------------------------------------------------------%
-
-:- pred inst_list_is_ground_mt(list(mer_inst)::in, list(maybe(mer_type))::in,
- module_info::in) is semidet.
-
-inst_list_is_ground_mt([], [], _).
-inst_list_is_ground_mt([Inst | Insts], [MaybeType | MaybeTypes], ModuleInfo) :-
- inst_is_ground_mt(ModuleInfo, MaybeType, Inst),
- inst_list_is_ground_mt(Insts, MaybeTypes, ModuleInfo).
-
-inst_list_is_ground([], _).
-inst_list_is_ground([Inst | Insts], ModuleInfo) :-
- inst_is_ground(ModuleInfo, Inst),
- inst_list_is_ground(Insts, ModuleInfo).
-
-inst_list_is_ground_or_any([], _).
-inst_list_is_ground_or_any([Inst | Insts], ModuleInfo) :-
- inst_is_ground_or_any(ModuleInfo, Inst),
- inst_list_is_ground_or_any(Insts, ModuleInfo).
-
-inst_list_is_unique([], _).
-inst_list_is_unique([Inst | Insts], ModuleInfo) :-
- inst_is_unique(ModuleInfo, Inst),
- inst_list_is_unique(Insts, ModuleInfo).
-
-inst_list_is_mostly_unique([], _).
-inst_list_is_mostly_unique([Inst | Insts], ModuleInfo) :-
- inst_is_mostly_unique(ModuleInfo, Inst),
- inst_list_is_mostly_unique(Insts, ModuleInfo).
-
-inst_list_is_not_partly_unique([], _).
-inst_list_is_not_partly_unique([Inst | Insts], ModuleInfo) :-
- inst_is_not_partly_unique(ModuleInfo, Inst),
- inst_list_is_not_partly_unique(Insts, ModuleInfo).
-
-inst_list_is_not_fully_unique([], _).
-inst_list_is_not_fully_unique([Inst | Insts], ModuleInfo) :-
- inst_is_not_fully_unique(ModuleInfo, Inst),
- inst_list_is_not_fully_unique(Insts, ModuleInfo).
-
-%-----------------------------------------------------------------------------%
-
-:- pred inst_list_is_ground_mt_2(list(mer_inst)::in, list(maybe(mer_type))::in,
- module_info::in, set_tree234(mer_inst)::in, set_tree234(mer_inst)::out)
- is semidet.
-
-inst_list_is_ground_mt_2([], [], _, !Expansions).
-inst_list_is_ground_mt_2([], [_ | _], _, !Expansions) :-
- unexpected($module, $pred, "length mismatch").
-inst_list_is_ground_mt_2([_ | _], [], _, !Expansions) :-
- unexpected($module, $pred, "length mismatch").
-inst_list_is_ground_mt_2([Inst | Insts], [MaybeType | MaybeTypes], ModuleInfo,
- !Expansions) :-
- inst_is_ground_mt_1(ModuleInfo, MaybeType, Inst, !Expansions),
- inst_list_is_ground_mt_2(Insts, MaybeTypes, ModuleInfo, !Expansions).
-
-:- pred inst_list_is_ground_or_any_2(list(mer_inst)::in, module_info::in,
- set(mer_inst)::in, set(mer_inst)::out) is semidet.
-
-inst_list_is_ground_or_any_2([], _, !Expansions).
-inst_list_is_ground_or_any_2([Inst | Insts], ModuleInfo, !Expansions) :-
- inst_is_ground_or_any_2(ModuleInfo, Inst, !Expansions),
- inst_list_is_ground_or_any_2(Insts, ModuleInfo, !Expansions).
-
-:- pred inst_list_is_unique_2(list(mer_inst)::in, module_info::in,
- set(mer_inst)::in, set(mer_inst)::out) is semidet.
-
-inst_list_is_unique_2([], _, !Expansions).
-inst_list_is_unique_2([Inst | Insts], ModuleInfo, !Expansions) :-
- inst_is_unique_2(ModuleInfo, Inst, !Expansions),
- inst_list_is_unique_2(Insts, ModuleInfo, !Expansions).
-
-:- pred inst_list_is_mostly_unique_2(list(mer_inst)::in, module_info::in,
- set(mer_inst)::in, set(mer_inst)::out) is semidet.
-
-inst_list_is_mostly_unique_2([], _, !Expansions).
-inst_list_is_mostly_unique_2([Inst | Insts], ModuleInfo, !Expansions) :-
- inst_is_mostly_unique_2(ModuleInfo, Inst, !Expansions),
- inst_list_is_mostly_unique_2(Insts, ModuleInfo, !Expansions).
-
-:- pred inst_list_is_not_partly_unique_2(list(mer_inst)::in, module_info::in,
- set(mer_inst)::in, set(mer_inst)::out) is semidet.
-
-inst_list_is_not_partly_unique_2([], _, !Expansions).
-inst_list_is_not_partly_unique_2([Inst | Insts], ModuleInfo, !Expansions) :-
- inst_is_not_partly_unique_2(ModuleInfo, Inst, !Expansions),
- inst_list_is_not_partly_unique_2(Insts, ModuleInfo, !Expansions).
-
-:- pred inst_list_is_not_fully_unique_2(list(mer_inst)::in, module_info::in,
- set(mer_inst)::in, set(mer_inst)::out) is semidet.
-
-inst_list_is_not_fully_unique_2([], _, !Expansions).
-inst_list_is_not_fully_unique_2([Inst | Insts], ModuleInfo, !Expansions) :-
- inst_is_not_fully_unique_2(ModuleInfo, Inst, !Expansions),
- inst_list_is_not_fully_unique_2(Insts, ModuleInfo, !Expansions).
-
-%-----------------------------------------------------------------------------%
-
-bound_inst_list_is_free([], _).
-bound_inst_list_is_free([BoundInst | BoundInsts], ModuleInfo) :-
- BoundInst = bound_functor(_Name, Args),
- inst_list_is_free(Args, ModuleInfo),
- bound_inst_list_is_free(BoundInsts, ModuleInfo).
-
-inst_list_is_free([], _).
-inst_list_is_free([Inst | Insts], ModuleInfo) :-
- inst_is_free(ModuleInfo, Inst),
- inst_list_is_free(Insts, ModuleInfo).
-
-%-----------------------------------------------------------------------------%
-
-inst_list_is_ground_or_dead([], [], _).
-inst_list_is_ground_or_dead([Inst | Insts], [Live | Lives], ModuleInfo) :-
- (
- Live = is_live,
- inst_is_ground(ModuleInfo, Inst)
- ;
- Live = is_dead
- ),
- inst_list_is_ground_or_dead(Insts, Lives, ModuleInfo).
-
-inst_list_is_ground_or_any_or_dead([], [], _).
-inst_list_is_ground_or_any_or_dead([Inst | Insts], [Live | Lives],
- ModuleInfo) :-
- (
- Live = is_live,
- inst_is_ground_or_any(ModuleInfo, Inst)
- ;
- Live = is_dead
- ),
- inst_list_is_ground_or_any_or_dead(Insts, Lives, ModuleInfo).
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-inst_contains_inst_name(Inst, ModuleInfo, InstName) :-
- set.init(Expansions0),
- inst_contains_inst_name_2(Inst, ModuleInfo, InstName, yes,
- Expansions0, _Expansions).
-
-:- type inst_names == set(inst_name).
-
-:- pred inst_contains_inst_name_2(mer_inst::in, module_info::in, inst_name::in,
- bool::out, inst_names::in, inst_names::out) is det.
-
-inst_contains_inst_name_2(Inst, ModuleInfo, InstName, Contains, !Expansions) :-
- (
- ( Inst = abstract_inst(_, _)
- ; Inst = any(_, _)
- ; Inst = free
- ; Inst = free(_)
- ; Inst = ground(_, _)
- ; Inst = inst_var(_)
- ; Inst = not_reached
- ),
- Contains = no
- ;
- Inst = constrained_inst_vars(_, SubInst),
- inst_contains_inst_name_2(SubInst, ModuleInfo, InstName, Contains,
- !Expansions)
- ;
- Inst = defined_inst(ThisInstName),
- ( if InstName = ThisInstName then
- Contains = yes
- else
- ( if set.insert_new(ThisInstName, !Expansions) then
- inst_lookup(ModuleInfo, ThisInstName, ThisInst),
- set.insert(ThisInstName, !Expansions),
- inst_contains_inst_name_2(ThisInst, ModuleInfo, InstName,
- Contains, !Expansions)
- else
- Contains = no
- )
- )
- ;
- 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
- % variables for the skeletons whose insts contain an average of N/2
- % occurences of `bound' each, so the complexity of running
- % inst_contains_inst_name_2 on all their insts is quadratic in N.
- %
- % The inst_test result argument of bound/3 is an attempt at solving
- % this problem.
- %
- % We could also try to solve this performance problem with a cache
- % of the results of recent invocations of inst_contains_inst_name.
- (
- InstResults = inst_test_results_fgtc,
- Contains = no
- ;
- InstResults = inst_test_results(_, _, InstNamesResult, _, _, _),
- (
- InstNamesResult =
- inst_result_contains_inst_names_known(InstNameSet),
- ( if set.contains(InstNameSet, InstName) then
- % The Inst may contain InstName, and probably does,
- % but verify it.
- bound_inst_list_contains_inst_name(ArgInsts, ModuleInfo,
- InstName, Contains, !Expansions)
- else
- Contains = no
- )
- ;
- InstNamesResult = inst_result_contains_inst_names_unknown,
- bound_inst_list_contains_inst_name(ArgInsts, ModuleInfo,
- InstName, Contains, !Expansions)
- )
- ;
- InstResults = inst_test_no_results,
- bound_inst_list_contains_inst_name(ArgInsts, ModuleInfo,
- InstName, Contains, !Expansions)
- )
- ).
-
-:- pred bound_inst_list_contains_inst_name(list(bound_inst)::in,
- module_info::in, inst_name::in, bool::out,
- inst_names::in, inst_names::out) is det.
-
-bound_inst_list_contains_inst_name([], _ModuleInfo,
- _InstName, no, !Expansions).
-bound_inst_list_contains_inst_name([BoundInst | BoundInsts], ModuleInfo,
- InstName, Contains, !Expansions) :-
- BoundInst = bound_functor(_Functor, ArgInsts),
- inst_list_contains_inst_name(ArgInsts, ModuleInfo, InstName, Contains1,
- !Expansions),
- (
- Contains1 = yes,
- Contains = yes
- ;
- Contains1 = no,
- bound_inst_list_contains_inst_name(BoundInsts, ModuleInfo,
- InstName, Contains, !Expansions)
- ).
-
-:- pred inst_list_contains_inst_name(list(mer_inst)::in, module_info::in,
- inst_name::in, bool::out, inst_names::in, inst_names::out) is det.
-
-inst_list_contains_inst_name([], _ModuleInfo, _InstName, no, !Expansions).
-inst_list_contains_inst_name([Inst | Insts], ModuleInfo, InstName, Contains,
- !Expansions) :-
- inst_contains_inst_name_2(Inst, ModuleInfo, InstName, Contains1,
- !Expansions),
- (
- Contains1 = yes,
- Contains = yes
- ;
- Contains1 = no,
- inst_list_contains_inst_name(Insts, ModuleInfo, InstName, Contains,
- !Expansions)
- ).
-
-%-----------------------------------------------------------------------------%
-
:- pred inst_name_contains_inst_var(inst_name::in, inst_var::out) is nondet.
inst_name_contains_inst_var(InstName, InstVar) :-
@@ -2689,75 +1425,6 @@ mode_contains_inst_var(Mode, InstVar) :-
%-----------------------------------------------------------------------------%
- % For a non-solver type t (i.e. any type declared without using the
- % `solver' keyword), the inst `any' should be considered to be equivalent
- % to a bound inst i where i contains all the functors of the type t and
- % each argument has inst `any'.
- %
- % Note that pred and func types are considered solver types, since
- % higher-order terms that contain non-local solver variables are
- % themselves not ground -- they only become ground when all non-locals do.
- %
-:- pred maybe_any_to_bound(maybe(mer_type)::in, module_info::in,
- uniqueness::in, ho_inst_info::in, mer_inst::out) is semidet.
-
-maybe_any_to_bound(yes(Type), ModuleInfo, Uniq, none, Inst) :-
- not type_is_solver_type(ModuleInfo, Type),
- ( if type_constructors(ModuleInfo, Type, Constructors) then
- type_to_ctor_det(Type, TypeCtor),
- constructors_to_bound_any_insts(ModuleInfo, Uniq, TypeCtor,
- Constructors, BoundInsts0),
- list.sort_and_remove_dups(BoundInsts0, 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_inst_names_known(set.init),
- inst_result_contains_inst_vars_known(set.init),
- inst_result_contains_types_known(set.init),
- inst_result_type_ctor_propagated(TypeCtor)
- ),
- Inst = bound(Uniq, InstResult, BoundInsts)
- else if type_may_contain_solver_type(ModuleInfo, Type) then
- % For a type for which constructors are not available (e.g. an
- % abstract type) and which may contain solver types, we fail, meaning
- % that we will use `any' for this type.
- fail
- else
- Inst = ground(Uniq, none)
- ).
-
-:- pred type_may_contain_solver_type(module_info::in, mer_type::in) is semidet.
-
-type_may_contain_solver_type(ModuleInfo, Type) :-
- TypeCtorCat = classify_type(ModuleInfo, Type),
- type_may_contain_solver_type_2(TypeCtorCat) = yes.
-
-:- func type_may_contain_solver_type_2(type_ctor_category) = bool.
-
-type_may_contain_solver_type_2(CtorCat) = MayContainSolverType :-
- (
- ( CtorCat = ctor_cat_builtin(_)
- ; CtorCat = ctor_cat_enum(_)
- ; CtorCat = ctor_cat_higher_order
- ; CtorCat = ctor_cat_builtin_dummy
- ; CtorCat = ctor_cat_void
- ; CtorCat = ctor_cat_system(_)
- ; CtorCat = ctor_cat_user(cat_user_direct_dummy)
- ),
- MayContainSolverType = no
- ;
- ( CtorCat = ctor_cat_variable
- ; CtorCat = ctor_cat_tuple
- ; CtorCat = ctor_cat_user(cat_user_notag)
- ; CtorCat = ctor_cat_user(cat_user_general)
- ),
- MayContainSolverType = yes
- ).
-
-%-----------------------------------------------------------------------------%
-
:- pred same_addr_insts(mer_inst::in, mer_inst::in) is semidet.
:- pragma foreign_proc("C",
diff --git a/compiler/inst_test.m b/compiler/inst_test.m
new file mode 100644
index 0000000..6b32ea4
--- /dev/null
+++ b/compiler/inst_test.m
@@ -0,0 +1,1357 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 1995-1998, 2000-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: inst_test.m.
+% Author: fjh.
+%
+% Predicates to test various properties of insts.
+%
+% NOTE: `not_reached' insts are considered to satisfy all of these predicates
+% except inst_is_clobbered.
+%
+%-----------------------------------------------------------------------------%
+
+:- module check_hlds.inst_test.
+:- interface.
+
+:- import_module hlds.
+:- import_module hlds.hlds_module.
+:- import_module parse_tree.
+:- import_module parse_tree.prog_data.
+
+:- import_module list.
+:- import_module maybe.
+
+%-----------------------------------------------------------------------------%
+
+ % Succeed if the inst is fully ground (i.e. contains only `ground',
+ % `bound', and `not_reached' insts, with no `free' or `any' insts).
+ % This predicate succeeds for non-standard function insts so some care
+ % needs to be taken since these insts may not be replaced by a less
+ % precise inst that uses the higher-order mode information.
+ %
+:- pred inst_is_ground(module_info::in, mer_inst::in) is semidet.
+
+ % Succeed if the inst is not partly free (i.e. contains only `any',
+ % `ground', `bound', and `not_reached' insts, with no `free' insts).
+ % This predicate succeeds for non-standard function insts so some care
+ % needs to be taken since these insts may not be replaced by a less
+ % precise inst that uses the higher-order mode information.
+ %
+:- pred inst_is_ground_or_any(module_info::in, mer_inst::in) is semidet.
+
+ % Succeed if the inst is `unique'.
+ %
+ % XXX The documentation on the code used to say: "inst_is_unique succeeds
+ % iff the inst passed is unique or free. Abstract insts are not considered
+ % unique.". The part about free is dubious.
+ %
+:- pred inst_is_unique(module_info::in, mer_inst::in) is semidet.
+
+ % Succeed if the inst is `mostly_unique' or `unique'.
+ %
+ % XXX The documentation on the code used to say: " inst_is_mostly_unique
+ % succeeds iff the inst passed is unique, mostly_unique, or free.
+ % Abstract insts are not considered unique.". The part about free is
+ % dubious.
+ %
+:- pred inst_is_mostly_unique(module_info::in, mer_inst::in) is semidet.
+
+ % Succeed if the inst is not `mostly_unique' or `unique'.
+ %
+:- pred inst_is_not_partly_unique(module_info::in, mer_inst::in) is semidet.
+
+ % Succeed if the inst is not `unique'.
+ %
+:- pred inst_is_not_fully_unique(module_info::in, mer_inst::in) is semidet.
+
+ % inst_is_clobbered succeeds iff the inst passed is `clobbered'
+ % or `mostly_clobbered' or if it is a user-defined inst which
+ % is defined as one of those.
+ %
+:- pred inst_is_clobbered(module_info::in, mer_inst::in) is semidet.
+
+ % inst_is_free succeeds iff the inst passed is `free'
+ % or is a user-defined inst which is defined as `free'.
+ % Abstract insts must not be free.
+ %
+:- pred inst_is_free(module_info::in, mer_inst::in) is semidet.
+
+:- pred inst_is_any(module_info::in, mer_inst::in) is semidet.
+
+ % inst_is_bound succeeds iff the inst passed is not `free'
+ % or is a user-defined inst which is not defined as `free'.
+ % Abstract insts must be bound.
+ %
+:- pred inst_is_bound(module_info::in, mer_inst::in) is semidet.
+
+:- pred inst_is_bound_to_functors(module_info::in, mer_inst::in,
+ list(bound_inst)::out) is semidet.
+
+%-----------------------------------------------------------------------------%
+
+:- pred inst_results_bound_inst_list_is_ground(inst_test_results::in,
+ list(bound_inst)::in, module_info::in) is semidet.
+
+:- 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.
+
+:- pred inst_results_bound_inst_list_is_ground_or_any(inst_test_results::in,
+ list(bound_inst)::in, module_info::in) is semidet.
+
+:- pred bound_inst_list_is_unique(list(bound_inst)::in, module_info::in)
+ is semidet.
+
+:- pred bound_inst_list_is_mostly_unique(list(bound_inst)::in, module_info::in)
+ is semidet.
+
+:- pred bound_inst_list_is_not_partly_unique(list(bound_inst)::in,
+ module_info::in) is semidet.
+
+:- pred bound_inst_list_is_not_fully_unique(list(bound_inst)::in,
+ module_info::in) is semidet.
+
+:- pred bound_inst_list_is_free(list(bound_inst)::in, module_info::in)
+ is semidet.
+
+%-----------------------------------------------------------------------------%
+
+:- pred inst_list_is_ground(list(mer_inst)::in, module_info::in) is semidet.
+
+:- pred inst_list_is_ground_or_any(list(mer_inst)::in, module_info::in)
+ is semidet.
+
+:- pred inst_list_is_unique(list(mer_inst)::in, module_info::in) is semidet.
+
+:- pred inst_list_is_mostly_unique(list(mer_inst)::in, module_info::in)
+ is semidet.
+
+:- pred inst_list_is_not_partly_unique(list(mer_inst)::in, module_info::in)
+ is semidet.
+
+:- pred inst_list_is_not_fully_unique(list(mer_inst)::in, module_info::in)
+ is semidet.
+
+:- pred inst_list_is_free(list(mer_inst)::in, module_info::in) is semidet.
+
+ % Given a list of insts, and a corresponding list of livenesses, return
+ % true iff for every element in the list of insts, either the elemement is
+ % ground or the corresponding element in the liveness list is dead.
+ %
+:- pred inst_list_is_ground_or_dead(list(mer_inst)::in, list(is_live)::in,
+ module_info::in) is semidet.
+
+ % Given a list of insts, and a corresponding list of livenesses, return
+ % true iff for every element in the list of insts, either the elemement is
+ % ground or any, or the corresponding element in the liveness list is
+ % dead.
+ %
+:- pred inst_list_is_ground_or_any_or_dead(list(mer_inst)::in,
+ list(is_live)::in, module_info::in) is semidet.
+
+%-----------------------------------------------------------------------------%
+
+ % Succeed iff the specified inst contains (directly or indirectly) the
+ % specified inst_name.
+ %
+:- pred inst_contains_inst_name(mer_inst::in, module_info::in, inst_name::in)
+ is semidet.
+
+%-----------------------------------------------------------------------------%
+
+ % For a non-solver type t (i.e. any type declared without using the
+ % `solver' keyword), the inst `any' should be considered to be equivalent
+ % to a bound inst i where i contains all the functors of the type t and
+ % each argument has inst `any'.
+ %
+ % Note that pred and func types are considered solver types, since
+ % higher-order terms that contain non-local solver variables are
+ % themselves not ground -- they only become ground when all non-locals do.
+ %
+:- pred maybe_any_to_bound(maybe(mer_type)::in, module_info::in,
+ uniqueness::in, ho_inst_info::in, mer_inst::out) is semidet.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.mode_util.
+:- import_module check_hlds.type_util.
+:- import_module parse_tree.
+:- import_module parse_tree.prog_type.
+
+:- import_module bool.
+:- import_module io.
+:- import_module require.
+:- import_module set.
+:- import_module set_tree234.
+
+%-----------------------------------------------------------------------------%
+
+inst_is_ground(ModuleInfo, Inst) :-
+ % inst_is_ground succeeds iff the inst passed is `ground' or the
+ % equivalent. Abstract insts are not considered ground.
+ promise_pure (
+ semipure lookup_inst_is_ground(Inst, Found, OldIsGround),
+ (
+ Found = yes,
+ trace [compiletime(flag("inst-is-ground-perf")), io(!IO)] (
+ io.write_string("inst_is_ground hit\n", !IO)
+ ),
+ % Succeed if OldIsGround = yes, fail if OldIsGround = no.
+ OldIsGround = yes
+ ;
+ Found = no,
+ trace [compiletime(flag("inst-is-ground-perf")), io(!IO)] (
+ io.write_string("inst_is_ground miss\n", !IO)
+ ),
+ ( if inst_is_ground_mt(ModuleInfo, no, Inst) then
+ impure record_inst_is_ground(Inst, yes)
+ % Succeed.
+ else
+ impure record_inst_is_ground(Inst, no),
+ fail
+ )
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% The expansion of terms by the superhomogeneous transformation generates code
+% that looks like this:
+%
+% V1 = [],
+% V2 = e1,
+% V3 = [V2 | V1],
+% V4 = e2,
+% V5 = [V3 | V4]
+%
+% The insts on those unifications will contain insts from earlier unifications.
+% For example, the inst on the unification building V5 will give V5 an inst
+% that contains the insts of V3 and V4.
+%
+% If there are N elements in a list, testing the insts of the N variables
+% representing the N cons cells in the list would ordinarily take O(N^2) steps.
+% Since N could be very large, this is disastrous.
+%
+% We avoid quadratic performance by caching the results of recent calls
+% to inst_is_ground for insts that are susceptible to this problem.
+% This way, the test on the inst of e.g. V5 will find the results of the tests
+% on the insts of V3 and V4 already available. This reduces the overall
+% complexity of testing the insts of those N variables to O(n).
+%
+% The downsides of this cache include the costs of the lookups, and
+% the fact that it keeps the cached insts alive.
+%
+% Note that we do not need to record the ModuleInfo argument of inst_is_ground,
+% since it is needed only to interpret insts that need access to the mode
+% tables. If we get a result for an inst with one ModuleInfo, we should get
+% the exact same result with any later ModuleInfo. The conservative nature
+% of the Boehm collector means that an inst address recorded in the cache
+% will always point to the original inst; the address cannot be reused until
+% the cache entry is itself reused.
+
+:- pragma foreign_decl("C",
+"
+typedef struct {
+ MR_Word iig_inst_addr;
+ MR_Word iig_is_ground;
+} InstIsGroundCacheEntry;
+
+#define INST_IS_GROUND_CACHE_SIZE 1307
+
+/*
+** Every entry should be implicitly initialized to zeros. Since zero is
+** not a valid address for an inst, uninitialized entries cannot be mistaken
+** for filled-in entries.
+*/
+
+static InstIsGroundCacheEntry
+ inst_is_ground_cache[INST_IS_GROUND_CACHE_SIZE];
+").
+
+ % Look up Inst in the cache. If it is there, return Found = yes
+ % and set MayOccur. Otherwise, return Found = no.
+ %
+:- semipure pred lookup_inst_is_ground(mer_inst::in,
+ bool::out, bool::out) is det.
+
+:- pragma foreign_proc("C",
+ lookup_inst_is_ground(Inst::in, Found::out, IsGround::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ MR_Unsigned hash;
+
+ hash = (MR_Unsigned) Inst;
+ hash = hash >> MR_LOW_TAG_BITS;
+ hash = hash % INST_IS_GROUND_CACHE_SIZE;
+
+ if (inst_is_ground_cache[hash].iig_inst_addr == Inst) {
+ Found = MR_BOOL_YES;
+ IsGround = inst_is_ground_cache[hash].iig_is_ground;
+ } else {
+ Found = MR_BOOL_NO;
+ }
+").
+
+lookup_inst_is_ground(_, no, no) :-
+ semipure semipure_true.
+
+ % Record the result for Inst in the cache.
+ %
+:- impure pred record_inst_is_ground(mer_inst::in, bool::in) is det.
+
+:- pragma foreign_proc("C",
+ record_inst_is_ground(Inst::in, IsGround::in),
+ [will_not_call_mercury],
+"
+ MR_Unsigned hash;
+
+ hash = (MR_Unsigned) Inst;
+ hash = hash >> MR_LOW_TAG_BITS;
+ hash = hash % INST_IS_GROUND_CACHE_SIZE;
+ /* We overwrite any existing entry in the slot. */
+ inst_is_ground_cache[hash].iig_inst_addr = Inst;
+ inst_is_ground_cache[hash].iig_is_ground = IsGround;
+").
+
+record_inst_is_ground(_, _) :-
+ impure impure_true.
+
+%-----------------------------------------------------------------------------%
+
+:- pred inst_is_ground_mt(module_info::in, maybe(mer_type)::in, mer_inst::in)
+ is semidet.
+
+inst_is_ground_mt(ModuleInfo, MaybeType, Inst) :-
+ Expansions0 = set_tree234.init,
+ inst_is_ground_mt_1(ModuleInfo, MaybeType, Inst, Expansions0, _Expansions).
+
+ % The third arg is the set of insts which have already been expanded;
+ % we use this to avoid going into an infinite loop.
+ %
+:- pred inst_is_ground_mt_1(module_info::in, maybe(mer_type)::in, mer_inst::in,
+ set_tree234(mer_inst)::in, set_tree234(mer_inst)::out) is semidet.
+
+inst_is_ground_mt_1(ModuleInfo, MaybeType, Inst, !Expansions) :-
+ % XXX This special casing of any/2 was introduced in version 1.65
+ % of this file. The log message for that version gives a reason why
+ % this special casing is required, but I (zs) don't believe it,
+ % at least not without more explanation.
+ ( if Inst = any(_, _) then
+ ( if set_tree234.contains(!.Expansions, Inst) then
+ true
+ else
+ inst_is_ground_mt_2(ModuleInfo, MaybeType, Inst, !Expansions)
+ )
+ else
+ % ZZZ make this work on Inst's *address*.
+ ( if set_tree234.insert_new(Inst, !Expansions) then
+ % Inst was not yet in Expansions, but we have now inserted it.
+ inst_is_ground_mt_2(ModuleInfo, MaybeType, Inst, !Expansions)
+ else
+ % Inst was already in !.Expansions.
+ true
+ )
+ ).
+
+:- pred inst_is_ground_mt_2(module_info::in, maybe(mer_type)::in, mer_inst::in,
+ set_tree234(mer_inst)::in, set_tree234(mer_inst)::out) is semidet.
+
+inst_is_ground_mt_2(ModuleInfo, MaybeType, Inst, !Expansions) :-
+ require_complete_switch [Inst]
+ (
+ ( Inst = free
+ ; Inst = free(_)
+ ),
+ fail
+ ;
+ ( Inst = not_reached
+ ; Inst = ground(_, _)
+ )
+ ;
+ 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)
+ ;
+ Inst = defined_inst(InstName),
+ inst_lookup(ModuleInfo, InstName, NextInst),
+ inst_is_ground_mt_1(ModuleInfo, MaybeType, NextInst, !Expansions)
+ ;
+ Inst = any(Uniq, HOInstInfo),
+ maybe_any_to_bound(MaybeType, ModuleInfo, Uniq, HOInstInfo, NextInst),
+ inst_is_ground_mt_1(ModuleInfo, MaybeType, NextInst, !Expansions)
+ ;
+ Inst = inst_var(_),
+ unexpected($module, $pred, "uninstantiated inst parameter")
+ ;
+ Inst = abstract_inst(_, _),
+ % XXX I (zs) am not sure this is the right thing to do here.
+ % The original code of this predicate simply did not consider
+ % this kind of Inst.
+ fail
+ ).
+
+%-----------------------------------------------------------------------------%
+
+inst_is_ground_or_any(ModuleInfo, Inst) :-
+ set.init(Expansions0),
+ inst_is_ground_or_any_2(ModuleInfo, Inst, Expansions0, _Expansions).
+
+ % The third arg is the set of insts which have already been expanded;
+ % we use this to avoid going into an infinite loop.
+ %
+:- pred inst_is_ground_or_any_2(module_info::in, mer_inst::in,
+ set(mer_inst)::in, set(mer_inst)::out) is semidet.
+
+inst_is_ground_or_any_2(ModuleInfo, Inst, !Expansions) :-
+ require_complete_switch [Inst]
+ (
+ ( Inst = ground(_, _)
+ ; Inst = any(_, _)
+ ; Inst = not_reached
+ )
+ ;
+ Inst = bound(_, InstResults, BoundInsts),
+ inst_results_bound_inst_list_is_ground_or_any_2(InstResults,
+ BoundInsts, ModuleInfo, !Expansions)
+ ;
+ ( Inst = free
+ ; Inst = free(_)
+ ; Inst = abstract_inst(_, _) % XXX is this right?
+ ),
+ fail
+ ;
+ Inst = inst_var(_),
+ unexpected($module, $pred, "uninstantiated inst parameter")
+ ;
+ Inst = constrained_inst_vars(_, SubInst),
+ inst_is_ground_or_any_2(ModuleInfo, SubInst, !Expansions)
+ ;
+ Inst = defined_inst(InstName),
+ ( if set.insert_new(Inst, !Expansions) then
+ inst_lookup(ModuleInfo, InstName, NextInst),
+ inst_is_ground_or_any_2(ModuleInfo, NextInst, !Expansions)
+ else
+ true
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+inst_is_unique(ModuleInfo, Inst) :-
+ set.init(Expansions0),
+ inst_is_unique_2(ModuleInfo, Inst, Expansions0, _Expansions).
+
+ % The third arg is the set of insts which have already been expanded;
+ % we use this to avoid going into an infinite loop.
+ %
+:- pred inst_is_unique_2(module_info::in, mer_inst::in,
+ set(mer_inst)::in, set(mer_inst)::out) is semidet.
+
+inst_is_unique_2(ModuleInfo, Inst, !Expansions) :-
+ (
+ ( Inst = ground(unique, _)
+ ; Inst = any(unique, _)
+ ; Inst = not_reached
+ ; Inst = free % XXX I don't think this is right [zs].
+ )
+ ;
+ ( Inst = ground(shared, _)
+ ; Inst = bound(shared, _, _)
+ ; Inst = any(shared, _)
+ ),
+ fail
+ ;
+ 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")
+ ;
+ Inst = constrained_inst_vars(_, SubInst),
+ inst_is_unique_2(ModuleInfo, SubInst, !Expansions)
+ ;
+ Inst = defined_inst(InstName),
+ ( if set.insert_new(Inst, !Expansions) then
+ inst_lookup(ModuleInfo, InstName, NextInst),
+ inst_is_unique_2(ModuleInfo, NextInst, !Expansions)
+ else
+ true
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+inst_is_mostly_unique(ModuleInfo, Inst) :-
+ set.init(Expansions0),
+ inst_is_mostly_unique_2(ModuleInfo, Inst, Expansions0, _Expansions).
+
+ % The third arg is the set of insts which have already been expanded;
+ % we use this to avoid going into an infinite loop.
+ %
+:- pred inst_is_mostly_unique_2(module_info::in, mer_inst::in,
+ set(mer_inst)::in, set(mer_inst)::out) is semidet.
+
+inst_is_mostly_unique_2(ModuleInfo, Inst, !Expansions) :-
+ require_complete_switch [Inst]
+ (
+ ( Inst = not_reached
+ ; Inst = free
+ ; Inst = free(_)
+ ; Inst = ground(unique, _)
+ ; Inst = ground(mostly_unique, _)
+ ; Inst = any(unique, _)
+ ; Inst = any(mostly_unique, _)
+ )
+ ;
+ Inst = bound(unique, InstResults, BoundInsts),
+ (
+ InstResults = inst_test_results_fgtc,
+ fail
+ ;
+ ( 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")
+ ;
+ Inst = constrained_inst_vars(_, SubInst),
+ inst_is_mostly_unique_2(ModuleInfo, SubInst, !Expansions)
+ ;
+ Inst = defined_inst(InstName),
+ ( if set.insert_new(Inst, !Expansions) then
+ inst_lookup(ModuleInfo, InstName, NextInst),
+ inst_is_mostly_unique_2(ModuleInfo, NextInst, !Expansions)
+ else
+ true
+ )
+ ;
+ Inst = abstract_inst(_, _),
+ % XXX I (zs) am not sure this is the right thing to do here.
+ % The original code of this predicate simply did not consider
+ % this kind of Inst.
+ fail
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % inst_is_not_partly_unique succeeds iff the inst passed is not unique
+ % or mostly_unique, i.e. if it is shared free. It fails for abstract insts.
+ %
+inst_is_not_partly_unique(ModuleInfo, Inst) :-
+ set.init(Expansions0),
+ inst_is_not_partly_unique_2(ModuleInfo, Inst, Expansions0, _Expansions).
+
+ % The third arg is the set of insts which have already been expanded;
+ % we use this to avoid going into an infinite loop.
+ %
+:- pred inst_is_not_partly_unique_2(module_info::in, mer_inst::in,
+ set(mer_inst)::in, set(mer_inst)::out) is semidet.
+
+inst_is_not_partly_unique_2(ModuleInfo, Inst, !Expansions) :-
+ require_complete_switch [Inst]
+ (
+ ( Inst = not_reached
+ ; Inst = free
+ ; Inst = free(_)
+ ; Inst = any(shared, _)
+ ; Inst = ground(shared, _)
+ )
+ ;
+ 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")
+ ;
+ Inst = constrained_inst_vars(_, SubInst),
+ inst_is_not_partly_unique_2(ModuleInfo, SubInst, !Expansions)
+ ;
+ Inst = defined_inst(InstName),
+ ( if set.insert_new(Inst, !Expansions) then
+ inst_lookup(ModuleInfo, InstName, NextInst),
+ inst_is_not_partly_unique_2(ModuleInfo, NextInst, !Expansions)
+ else
+ true
+ )
+ ;
+ Inst = abstract_inst(_, _),
+ % XXX I (zs) am not sure this is the right thing to do here.
+ % The original code of this predicate simply did not consider
+ % this kind of Inst.
+ fail
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % inst_is_not_fully_unique succeeds iff the inst passed is not unique,
+ % i.e. if it is mostly_unique, shared, or free. It fails for abstract
+ % insts.
+ %
+inst_is_not_fully_unique(ModuleInfo, Inst) :-
+ set.init(Expansions0),
+ inst_is_not_fully_unique_2(ModuleInfo, Inst, Expansions0, _Expansions).
+
+ % The third arg is the set of insts which have already been expanded - we
+ % use this to avoid going into an infinite loop.
+ %
+:- pred inst_is_not_fully_unique_2(module_info::in, mer_inst::in,
+ set(mer_inst)::in, set(mer_inst)::out) is semidet.
+
+inst_is_not_fully_unique_2(ModuleInfo, Inst, !Expansions) :-
+ require_complete_switch [Inst]
+ (
+ ( Inst = not_reached
+ ; Inst = free
+ ; Inst = free(_)
+ ; Inst = ground(shared, _)
+ ; Inst = ground(mostly_unique, _)
+ ; Inst = any(shared, _)
+ ; Inst = any(mostly_unique, _)
+ )
+ ;
+ Inst = bound(Uniq, InstResult, BoundInsts),
+ ( Uniq = shared
+ ; Uniq = mostly_unique
+ ),
+ (
+ InstResult = inst_test_results_fgtc
+ ;
+ ( 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")
+ ;
+ Inst = constrained_inst_vars(_, SubInst),
+ inst_is_not_fully_unique_2(ModuleInfo, SubInst, !Expansions)
+ ;
+ Inst = defined_inst(InstName),
+ ( if set.insert_new(Inst, !Expansions) then
+ inst_lookup(ModuleInfo, InstName, NextInst),
+ inst_is_not_fully_unique_2(ModuleInfo, NextInst, !Expansions)
+ else
+ true
+ )
+ ;
+ Inst = abstract_inst(_, _),
+ % XXX I (zs) am not sure this is the right thing to do here.
+ % The original code of this predicate simply did not consider
+ % this kind of Inst.
+ fail
+ ).
+
+%-----------------------------------------------------------------------------%
+
+inst_is_clobbered(ModuleInfo, Inst) :-
+ require_complete_switch [Inst]
+ (
+ ( Inst = free
+ ; Inst = free(_)
+ ; Inst = not_reached
+ ; Inst = abstract_inst(_, _) % XXX is this right?
+ ),
+ fail
+ ;
+ ( Inst = any(mostly_clobbered, _)
+ ; Inst = any(clobbered, _)
+ ; Inst = ground(clobbered, _)
+ ; Inst = ground(mostly_clobbered, _)
+ ; Inst = bound(clobbered, _, _)
+ ; Inst = bound(mostly_clobbered, _, _)
+ )
+ ;
+ Inst = inst_var(_),
+ unexpected($module, $pred, "uninstantiated inst parameter")
+ ;
+ Inst = constrained_inst_vars(_, SubInst),
+ inst_is_clobbered(ModuleInfo, SubInst)
+ ;
+ Inst = defined_inst(InstName),
+ inst_lookup(ModuleInfo, InstName, NextInst),
+ inst_is_clobbered(ModuleInfo, NextInst)
+ ).
+
+inst_is_free(ModuleInfo, Inst) :-
+ require_complete_switch [Inst]
+ (
+ ( Inst = free
+ ; Inst = free(_)
+ )
+ ;
+ ( Inst = ground(_, _)
+ ; Inst = bound(_, _, _)
+ ; Inst = any(_, _)
+ ; Inst = not_reached
+ ; Inst = abstract_inst(_, _) % XXX is this right?
+ ),
+ fail
+ ;
+ Inst = inst_var(_),
+ unexpected($module, $pred, "uninstantiated inst parameter")
+ ;
+ Inst = constrained_inst_vars(_, SubInst),
+ inst_is_free(ModuleInfo, SubInst)
+ ;
+ Inst = defined_inst(InstName),
+ inst_lookup(ModuleInfo, InstName, NextInst),
+ inst_is_free(ModuleInfo, NextInst)
+ ).
+
+inst_is_any(ModuleInfo, Inst) :-
+ require_complete_switch [Inst]
+ (
+ Inst = any(_, _)
+ ;
+ ( Inst = free
+ ; Inst = free(_)
+ ; Inst = ground(_, _)
+ ; Inst = bound(_, _, _)
+ ; Inst = not_reached
+ ; Inst = abstract_inst(_, _) % XXX is this right?
+ ),
+ fail
+ ;
+ Inst = inst_var(_),
+ unexpected($module, $pred, "uninstantiated inst parameter")
+ ;
+ Inst = constrained_inst_vars(_, SubInst),
+ inst_is_any(ModuleInfo, SubInst)
+ ;
+ Inst = defined_inst(InstName),
+ inst_lookup(ModuleInfo, InstName, NextInst),
+ inst_is_any(ModuleInfo, NextInst)
+ ).
+
+inst_is_bound(ModuleInfo, Inst) :-
+ require_complete_switch [Inst]
+ (
+ ( Inst = ground(_, _)
+ ; Inst = bound(_, _, _)
+ ; Inst = any(_, _)
+ ; Inst = abstract_inst(_, _) % XXX is this right?
+ ; Inst = not_reached
+ )
+ ;
+ ( Inst = free
+ ; Inst = free(_)
+ ),
+ fail
+ ;
+ Inst = inst_var(_),
+ unexpected($module, $pred, "uninstantiated inst parameter")
+ ;
+ Inst = constrained_inst_vars(_, SubInst),
+ inst_is_bound(ModuleInfo, SubInst)
+ ;
+ Inst = defined_inst(InstName),
+ inst_lookup(ModuleInfo, InstName, NextInst),
+ inst_is_bound(ModuleInfo, NextInst)
+ ).
+
+inst_is_bound_to_functors(ModuleInfo, Inst, Functors) :-
+ % inst_is_bound_to_functors succeeds iff the inst passed is
+ % `bound(_Uniq, Functors)' or is a user-defined inst which expands to
+ % `bound(_Uniq, Functors)'.
+ %
+ require_complete_switch [Inst]
+ (
+ Inst = bound(_Uniq, _InstResult, Functors)
+ ;
+ Inst = inst_var(_),
+ unexpected($module, $pred, "uninstantiated inst parameter")
+ ;
+ Inst = constrained_inst_vars(_, SubInst),
+ inst_is_bound_to_functors(ModuleInfo, SubInst, Functors)
+ ;
+ Inst = defined_inst(InstName),
+ inst_lookup(ModuleInfo, InstName, NextInst),
+ inst_is_bound_to_functors(ModuleInfo, NextInst, Functors)
+ ;
+ ( Inst = free
+ ; Inst = free(_)
+ ; Inst = any(_, _)
+ ; Inst = ground(_, _)
+ ; Inst = abstract_inst(_, _)
+ ; Inst = not_reached
+ ),
+ fail
+ ).
+
+%-----------------------------------------------------------------------------%
+
+inst_results_bound_inst_list_is_ground(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_mt(BoundInsts, no, ModuleInfo)
+ )
+ ;
+ InstResults = inst_test_no_results,
+ bound_inst_list_is_ground_mt(BoundInsts, no, ModuleInfo)
+ ).
+
+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 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)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+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
+ ; 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)
+ ).
+
+:- 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_mt(list(bound_inst)::in, maybe(mer_type)::in,
+ module_info::in) is semidet.
+
+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_mt(BoundInsts, MaybeType, ModuleInfo).
+
+:- 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.
+
+bound_inst_list_is_ground_mt_2([], _, _, !Expansions).
+bound_inst_list_is_ground_mt_2([BoundInst | BoundInsts], MaybeType, ModuleInfo,
+ !Expansions) :-
+ BoundInst = bound_functor(Name, Args),
+ maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, Name,
+ list.length(Args), MaybeTypes),
+ inst_list_is_ground_mt_2(Args, MaybeTypes, ModuleInfo, !Expansions),
+ bound_inst_list_is_ground_mt_2(BoundInsts, MaybeType, ModuleInfo,
+ !Expansions).
+
+:- pred bound_inst_list_is_ground_or_any(list(bound_inst)::in, module_info::in)
+ is semidet.
+
+bound_inst_list_is_ground_or_any([], _).
+bound_inst_list_is_ground_or_any([BoundInst | BoundInsts], ModuleInfo) :-
+ BoundInst = bound_functor(_Name, Args),
+ inst_list_is_ground_or_any(Args, ModuleInfo),
+ bound_inst_list_is_ground_or_any(BoundInsts, ModuleInfo).
+
+:- 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.
+
+bound_inst_list_is_ground_or_any_2([], _, !Expansions).
+bound_inst_list_is_ground_or_any_2([BoundInst | BoundInsts], ModuleInfo,
+ !Expansions) :-
+ BoundInst = bound_functor(_Name, Args),
+ inst_list_is_ground_or_any_2(Args, ModuleInfo, !Expansions),
+ bound_inst_list_is_ground_or_any_2(BoundInsts, ModuleInfo, !Expansions).
+
+bound_inst_list_is_unique([], _).
+bound_inst_list_is_unique([BoundInst | BoundInsts], ModuleInfo) :-
+ BoundInst = bound_functor(_Name, Args),
+ inst_list_is_unique(Args, ModuleInfo),
+ bound_inst_list_is_unique(BoundInsts, ModuleInfo).
+
+:- pred bound_inst_list_is_unique_2(list(bound_inst)::in, module_info::in,
+ set(mer_inst)::in, set(mer_inst)::out) is semidet.
+
+bound_inst_list_is_unique_2([], _, !Expansions).
+bound_inst_list_is_unique_2([BoundInst | BoundInsts], ModuleInfo,
+ !Expansions) :-
+ BoundInst = bound_functor(_Name, Args),
+ inst_list_is_unique_2(Args, ModuleInfo, !Expansions),
+ bound_inst_list_is_unique_2(BoundInsts, ModuleInfo, !Expansions).
+
+bound_inst_list_is_mostly_unique([], _).
+bound_inst_list_is_mostly_unique([BoundInst | BoundInsts], ModuleInfo) :-
+ BoundInst = bound_functor(_Name, Args),
+ inst_list_is_mostly_unique(Args, ModuleInfo),
+ bound_inst_list_is_mostly_unique(BoundInsts, ModuleInfo).
+
+:- pred bound_inst_list_is_mostly_unique_2(list(bound_inst)::in,
+ module_info::in, set(mer_inst)::in, set(mer_inst)::out) is semidet.
+
+bound_inst_list_is_mostly_unique_2([], _, !Expansions).
+bound_inst_list_is_mostly_unique_2([BoundInst | BoundInsts], ModuleInfo,
+ !Expansions) :-
+ BoundInst = bound_functor(_Name, Args),
+ inst_list_is_mostly_unique_2(Args, ModuleInfo, !Expansions),
+ bound_inst_list_is_mostly_unique_2(BoundInsts, ModuleInfo, !Expansions).
+
+bound_inst_list_is_not_partly_unique([], _).
+bound_inst_list_is_not_partly_unique([BoundInst | BoundInsts], ModuleInfo) :-
+ BoundInst = bound_functor(_Name, Args),
+ inst_list_is_not_partly_unique(Args, ModuleInfo),
+ bound_inst_list_is_not_partly_unique(BoundInsts, ModuleInfo).
+
+:- pred bound_inst_list_is_not_partly_unique_2(list(bound_inst)::in,
+ module_info::in, set(mer_inst)::in, set(mer_inst)::out) is semidet.
+
+bound_inst_list_is_not_partly_unique_2([], _, !Expansions).
+bound_inst_list_is_not_partly_unique_2([BoundInst | BoundInsts], ModuleInfo,
+ !Expansions) :-
+ BoundInst = bound_functor(_Name, Args),
+ inst_list_is_not_partly_unique_2(Args, ModuleInfo, !Expansions),
+ bound_inst_list_is_not_partly_unique_2(BoundInsts, ModuleInfo,
+ !Expansions).
+
+bound_inst_list_is_not_fully_unique([], _).
+bound_inst_list_is_not_fully_unique([BoundInst | BoundInsts], ModuleInfo) :-
+ BoundInst = bound_functor(_Name, Args),
+ inst_list_is_not_fully_unique(Args, ModuleInfo),
+ bound_inst_list_is_not_fully_unique(BoundInsts, ModuleInfo).
+
+:- pred bound_inst_list_is_not_fully_unique_2(list(bound_inst)::in,
+ module_info::in, set(mer_inst)::in, set(mer_inst)::out) is semidet.
+
+bound_inst_list_is_not_fully_unique_2([], _, !Expansions).
+bound_inst_list_is_not_fully_unique_2([BoundInst | BoundInsts], ModuleInfo,
+ !Expansions) :-
+ BoundInst = bound_functor(_Name, Args),
+ inst_list_is_not_fully_unique_2(Args, ModuleInfo, !Expansions),
+ bound_inst_list_is_not_fully_unique_2(BoundInsts, ModuleInfo,
+ !Expansions).
+
+bound_inst_list_is_free([], _).
+bound_inst_list_is_free([BoundInst | BoundInsts], ModuleInfo) :-
+ BoundInst = bound_functor(_Name, Args),
+ inst_list_is_free(Args, ModuleInfo),
+ bound_inst_list_is_free(BoundInsts, ModuleInfo).
+
+%-----------------------------------------------------------------------------%
+
+inst_list_is_ground([], _).
+inst_list_is_ground([Inst | Insts], ModuleInfo) :-
+ inst_is_ground(ModuleInfo, Inst),
+ inst_list_is_ground(Insts, ModuleInfo).
+
+:- pred inst_list_is_ground_mt(list(mer_inst)::in, list(maybe(mer_type))::in,
+ module_info::in) is semidet.
+
+inst_list_is_ground_mt([], [], _).
+inst_list_is_ground_mt([Inst | Insts], [MaybeType | MaybeTypes], ModuleInfo) :-
+ inst_is_ground_mt(ModuleInfo, MaybeType, Inst),
+ inst_list_is_ground_mt(Insts, MaybeTypes, ModuleInfo).
+
+:- pred inst_list_is_ground_mt_2(list(mer_inst)::in, list(maybe(mer_type))::in,
+ module_info::in, set_tree234(mer_inst)::in, set_tree234(mer_inst)::out)
+ is semidet.
+
+inst_list_is_ground_mt_2([], [], _, !Expansions).
+inst_list_is_ground_mt_2([], [_ | _], _, !Expansions) :-
+ unexpected($module, $pred, "length mismatch").
+inst_list_is_ground_mt_2([_ | _], [], _, !Expansions) :-
+ unexpected($module, $pred, "length mismatch").
+inst_list_is_ground_mt_2([Inst | Insts], [MaybeType | MaybeTypes], ModuleInfo,
+ !Expansions) :-
+ inst_is_ground_mt_1(ModuleInfo, MaybeType, Inst, !Expansions),
+ inst_list_is_ground_mt_2(Insts, MaybeTypes, ModuleInfo, !Expansions).
+
+inst_list_is_ground_or_any([], _).
+inst_list_is_ground_or_any([Inst | Insts], ModuleInfo) :-
+ inst_is_ground_or_any(ModuleInfo, Inst),
+ inst_list_is_ground_or_any(Insts, ModuleInfo).
+
+:- pred inst_list_is_ground_or_any_2(list(mer_inst)::in, module_info::in,
+ set(mer_inst)::in, set(mer_inst)::out) is semidet.
+
+inst_list_is_ground_or_any_2([], _, !Expansions).
+inst_list_is_ground_or_any_2([Inst | Insts], ModuleInfo, !Expansions) :-
+ inst_is_ground_or_any_2(ModuleInfo, Inst, !Expansions),
+ inst_list_is_ground_or_any_2(Insts, ModuleInfo, !Expansions).
+
+inst_list_is_unique([], _).
+inst_list_is_unique([Inst | Insts], ModuleInfo) :-
+ inst_is_unique(ModuleInfo, Inst),
+ inst_list_is_unique(Insts, ModuleInfo).
+
+:- pred inst_list_is_unique_2(list(mer_inst)::in, module_info::in,
+ set(mer_inst)::in, set(mer_inst)::out) is semidet.
+
+inst_list_is_unique_2([], _, !Expansions).
+inst_list_is_unique_2([Inst | Insts], ModuleInfo, !Expansions) :-
+ inst_is_unique_2(ModuleInfo, Inst, !Expansions),
+ inst_list_is_unique_2(Insts, ModuleInfo, !Expansions).
+
+inst_list_is_mostly_unique([], _).
+inst_list_is_mostly_unique([Inst | Insts], ModuleInfo) :-
+ inst_is_mostly_unique(ModuleInfo, Inst),
+ inst_list_is_mostly_unique(Insts, ModuleInfo).
+
+:- pred inst_list_is_mostly_unique_2(list(mer_inst)::in, module_info::in,
+ set(mer_inst)::in, set(mer_inst)::out) is semidet.
+
+inst_list_is_mostly_unique_2([], _, !Expansions).
+inst_list_is_mostly_unique_2([Inst | Insts], ModuleInfo, !Expansions) :-
+ inst_is_mostly_unique_2(ModuleInfo, Inst, !Expansions),
+ inst_list_is_mostly_unique_2(Insts, ModuleInfo, !Expansions).
+
+inst_list_is_not_partly_unique([], _).
+inst_list_is_not_partly_unique([Inst | Insts], ModuleInfo) :-
+ inst_is_not_partly_unique(ModuleInfo, Inst),
+ inst_list_is_not_partly_unique(Insts, ModuleInfo).
+
+:- pred inst_list_is_not_partly_unique_2(list(mer_inst)::in, module_info::in,
+ set(mer_inst)::in, set(mer_inst)::out) is semidet.
+
+inst_list_is_not_partly_unique_2([], _, !Expansions).
+inst_list_is_not_partly_unique_2([Inst | Insts], ModuleInfo, !Expansions) :-
+ inst_is_not_partly_unique_2(ModuleInfo, Inst, !Expansions),
+ inst_list_is_not_partly_unique_2(Insts, ModuleInfo, !Expansions).
+
+inst_list_is_not_fully_unique([], _).
+inst_list_is_not_fully_unique([Inst | Insts], ModuleInfo) :-
+ inst_is_not_fully_unique(ModuleInfo, Inst),
+ inst_list_is_not_fully_unique(Insts, ModuleInfo).
+
+:- pred inst_list_is_not_fully_unique_2(list(mer_inst)::in, module_info::in,
+ set(mer_inst)::in, set(mer_inst)::out) is semidet.
+
+inst_list_is_not_fully_unique_2([], _, !Expansions).
+inst_list_is_not_fully_unique_2([Inst | Insts], ModuleInfo, !Expansions) :-
+ inst_is_not_fully_unique_2(ModuleInfo, Inst, !Expansions),
+ inst_list_is_not_fully_unique_2(Insts, ModuleInfo, !Expansions).
+
+inst_list_is_free([], _).
+inst_list_is_free([Inst | Insts], ModuleInfo) :-
+ inst_is_free(ModuleInfo, Inst),
+ inst_list_is_free(Insts, ModuleInfo).
+
+inst_list_is_ground_or_dead([], [], _).
+inst_list_is_ground_or_dead([Inst | Insts], [Live | Lives], ModuleInfo) :-
+ (
+ Live = is_live,
+ inst_is_ground(ModuleInfo, Inst)
+ ;
+ Live = is_dead
+ ),
+ inst_list_is_ground_or_dead(Insts, Lives, ModuleInfo).
+
+inst_list_is_ground_or_any_or_dead([], [], _).
+inst_list_is_ground_or_any_or_dead([Inst | Insts], [Live | Lives],
+ ModuleInfo) :-
+ (
+ Live = is_live,
+ inst_is_ground_or_any(ModuleInfo, Inst)
+ ;
+ Live = is_dead
+ ),
+ inst_list_is_ground_or_any_or_dead(Insts, Lives, ModuleInfo).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+inst_contains_inst_name(Inst, ModuleInfo, InstName) :-
+ set.init(Expansions0),
+ inst_contains_inst_name_2(Inst, ModuleInfo, InstName, yes,
+ Expansions0, _Expansions).
+
+:- type inst_names == set(inst_name).
+
+:- pred inst_contains_inst_name_2(mer_inst::in, module_info::in, inst_name::in,
+ bool::out, inst_names::in, inst_names::out) is det.
+
+inst_contains_inst_name_2(Inst, ModuleInfo, InstName, Contains, !Expansions) :-
+ (
+ ( Inst = abstract_inst(_, _)
+ ; Inst = any(_, _)
+ ; Inst = free
+ ; Inst = free(_)
+ ; Inst = ground(_, _)
+ ; Inst = inst_var(_)
+ ; Inst = not_reached
+ ),
+ Contains = no
+ ;
+ Inst = constrained_inst_vars(_, SubInst),
+ inst_contains_inst_name_2(SubInst, ModuleInfo, InstName, Contains,
+ !Expansions)
+ ;
+ Inst = defined_inst(ThisInstName),
+ ( if InstName = ThisInstName then
+ Contains = yes
+ else
+ ( if set.insert_new(ThisInstName, !Expansions) then
+ inst_lookup(ModuleInfo, ThisInstName, ThisInst),
+ set.insert(ThisInstName, !Expansions),
+ inst_contains_inst_name_2(ThisInst, ModuleInfo, InstName,
+ Contains, !Expansions)
+ else
+ Contains = no
+ )
+ )
+ ;
+ 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
+ % variables for the skeletons whose insts contain an average of N/2
+ % occurences of `bound' each, so the complexity of running
+ % inst_contains_inst_name_2 on all their insts is quadratic in N.
+ %
+ % The inst_test result argument of bound/3 is an attempt at solving
+ % this problem.
+ %
+ % We could also try to solve this performance problem with a cache
+ % of the results of recent invocations of inst_contains_inst_name.
+ (
+ InstResults = inst_test_results_fgtc,
+ Contains = no
+ ;
+ InstResults = inst_test_results(_, _, InstNamesResult, _, _, _),
+ (
+ InstNamesResult =
+ inst_result_contains_inst_names_known(InstNameSet),
+ ( if set.contains(InstNameSet, InstName) then
+ % The Inst may contain InstName, and probably does,
+ % but verify it.
+ bound_inst_list_contains_inst_name(ArgInsts, ModuleInfo,
+ InstName, Contains, !Expansions)
+ else
+ Contains = no
+ )
+ ;
+ InstNamesResult = inst_result_contains_inst_names_unknown,
+ bound_inst_list_contains_inst_name(ArgInsts, ModuleInfo,
+ InstName, Contains, !Expansions)
+ )
+ ;
+ InstResults = inst_test_no_results,
+ bound_inst_list_contains_inst_name(ArgInsts, ModuleInfo,
+ InstName, Contains, !Expansions)
+ )
+ ).
+
+:- pred bound_inst_list_contains_inst_name(list(bound_inst)::in,
+ module_info::in, inst_name::in, bool::out,
+ inst_names::in, inst_names::out) is det.
+
+bound_inst_list_contains_inst_name([], _ModuleInfo,
+ _InstName, no, !Expansions).
+bound_inst_list_contains_inst_name([BoundInst | BoundInsts], ModuleInfo,
+ InstName, Contains, !Expansions) :-
+ BoundInst = bound_functor(_Functor, ArgInsts),
+ inst_list_contains_inst_name(ArgInsts, ModuleInfo, InstName, Contains1,
+ !Expansions),
+ (
+ Contains1 = yes,
+ Contains = yes
+ ;
+ Contains1 = no,
+ bound_inst_list_contains_inst_name(BoundInsts, ModuleInfo,
+ InstName, Contains, !Expansions)
+ ).
+
+:- pred inst_list_contains_inst_name(list(mer_inst)::in, module_info::in,
+ inst_name::in, bool::out, inst_names::in, inst_names::out) is det.
+
+inst_list_contains_inst_name([], _ModuleInfo, _InstName, no, !Expansions).
+inst_list_contains_inst_name([Inst | Insts], ModuleInfo, InstName, Contains,
+ !Expansions) :-
+ inst_contains_inst_name_2(Inst, ModuleInfo, InstName, Contains1,
+ !Expansions),
+ (
+ Contains1 = yes,
+ Contains = yes
+ ;
+ Contains1 = no,
+ inst_list_contains_inst_name(Insts, ModuleInfo, InstName, Contains,
+ !Expansions)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+maybe_any_to_bound(yes(Type), ModuleInfo, Uniq, none, Inst) :-
+ not type_is_solver_type(ModuleInfo, Type),
+ ( if type_constructors(ModuleInfo, Type, Constructors) then
+ type_to_ctor_det(Type, TypeCtor),
+ constructors_to_bound_any_insts(ModuleInfo, Uniq, TypeCtor,
+ Constructors, BoundInsts0),
+ list.sort_and_remove_dups(BoundInsts0, 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_inst_names_known(set.init),
+ inst_result_contains_inst_vars_known(set.init),
+ inst_result_contains_types_known(set.init),
+ inst_result_type_ctor_propagated(TypeCtor)
+ ),
+ Inst = bound(Uniq, InstResult, BoundInsts)
+ else if type_may_contain_solver_type(ModuleInfo, Type) then
+ % For a type for which constructors are not available (e.g. an
+ % abstract type) and which may contain solver types, we fail, meaning
+ % that we will use `any' for this type.
+ fail
+ else
+ Inst = ground(Uniq, none)
+ ).
+
+:- pred type_may_contain_solver_type(module_info::in, mer_type::in) is semidet.
+
+type_may_contain_solver_type(ModuleInfo, Type) :-
+ TypeCtorCat = classify_type(ModuleInfo, Type),
+ type_may_contain_solver_type_2(TypeCtorCat) = yes.
+
+:- func type_may_contain_solver_type_2(type_ctor_category) = bool.
+
+type_may_contain_solver_type_2(CtorCat) = MayContainSolverType :-
+ (
+ ( CtorCat = ctor_cat_builtin(_)
+ ; CtorCat = ctor_cat_enum(_)
+ ; CtorCat = ctor_cat_higher_order
+ ; CtorCat = ctor_cat_builtin_dummy
+ ; CtorCat = ctor_cat_void
+ ; CtorCat = ctor_cat_system(_)
+ ; CtorCat = ctor_cat_user(cat_user_direct_dummy)
+ ),
+ MayContainSolverType = no
+ ;
+ ( CtorCat = ctor_cat_variable
+ ; CtorCat = ctor_cat_tuple
+ ; CtorCat = ctor_cat_user(cat_user_notag)
+ ; CtorCat = ctor_cat_user(cat_user_general)
+ ),
+ MayContainSolverType = yes
+ ).
+
+%-----------------------------------------------------------------------------%
+
diff --git a/compiler/inst_util.m b/compiler/inst_util.m
index 7ee0341..1a00bbb 100644
--- a/compiler/inst_util.m
+++ b/compiler/inst_util.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1997-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
@@ -50,6 +51,20 @@
:- import_module list.
:- import_module maybe.
+%-----------------------------------------------------------------------------%
+
+ % inst_expand(ModuleInfo, Inst0, Inst) checks if the top-level part
+ % of the inst is a defined inst, and if so replaces it with the definition.
+ %
+:- pred inst_expand(module_info::in, mer_inst::in, mer_inst::out) is det.
+
+ % inst_expand_and_remove_constrained_inst_vars is the same as inst_expand
+ % except that it also removes constrained_inst_vars from the top level,
+ % replacing them with the constraining inst.
+ %
+:- pred inst_expand_and_remove_constrained_inst_vars(module_info::in,
+ mer_inst::in, mer_inst::out) is det.
+
%---------------------------------------------------------------------------%
% Mode checking is like abstract interpretation. The predicates below
@@ -149,6 +164,7 @@
:- implementation.
:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
:- import_module hlds.hlds_data.
@@ -164,6 +180,26 @@
%---------------------------------------------------------------------------%
+inst_expand(ModuleInfo, !Inst) :-
+ ( if !.Inst = defined_inst(InstName) then
+ inst_lookup(ModuleInfo, InstName, !:Inst),
+ inst_expand(ModuleInfo, !Inst)
+ else
+ true
+ ).
+
+inst_expand_and_remove_constrained_inst_vars(ModuleInfo, !Inst) :-
+ ( if !.Inst = defined_inst(InstName) then
+ inst_lookup(ModuleInfo, InstName, !:Inst),
+ inst_expand(ModuleInfo, !Inst)
+ else if !.Inst = constrained_inst_vars(_, !:Inst) then
+ inst_expand(ModuleInfo, !Inst)
+ else
+ true
+ ).
+
+%---------------------------------------------------------------------------%
+
abstractly_unify_inst(Live, InstA, InstB, Real, Inst, Detism, !ModuleInfo) :-
% Check whether this pair of insts is already in the unify_insts table.
module_info_get_inst_table(!.ModuleInfo, InstTable0),
diff --git a/compiler/instmap.m b/compiler/instmap.m
index eeed3cc..15b3060 100644
--- a/compiler/instmap.m
+++ b/compiler/instmap.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2001, 2003-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -361,6 +362,7 @@
:- implementation.
:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
diff --git a/compiler/interval.m b/compiler/interval.m
index 7af5193..ca63c54 100644
--- a/compiler/interval.m
+++ b/compiler/interval.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2002-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -188,7 +189,7 @@
:- implementation.
:- import_module check_hlds.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module hlds.arg_info.
:- import_module hlds.code_model.
diff --git a/compiler/lco.m b/compiler/lco.m
index c952068..1bcbc75 100644
--- a/compiler/lco.m
+++ b/compiler/lco.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -166,7 +167,8 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
+:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
:- import_module hlds.arg_info.
diff --git a/compiler/loop_inv.m b/compiler/loop_inv.m
index ee19b45..d7502b1 100644
--- a/compiler/loop_inv.m
+++ b/compiler/loop_inv.m
@@ -2,6 +2,7 @@
% vim: ts=4 sw=4 et ft=mercury
%-----------------------------------------------------------------------------%
% Copyright (C) 2002-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -120,7 +121,7 @@
:- implementation.
:- import_module check_hlds.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_util.
:- import_module hlds.code_model.
diff --git a/compiler/mode_util.m b/compiler/mode_util.m
index 37da0d9..e604f45 100644
--- a/compiler/mode_util.m
+++ b/compiler/mode_util.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1994-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -209,6 +210,7 @@
:- implementation.
:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.type_util.
:- import_module hlds.goal_form.
diff --git a/compiler/modecheck_call.m b/compiler/modecheck_call.m
index 750d4ea..1585783 100644
--- a/compiler/modecheck_call.m
+++ b/compiler/modecheck_call.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2001, 2003-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -79,6 +80,7 @@
:- implementation.
:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_errors.
:- import_module check_hlds.mode_util.
diff --git a/compiler/modecheck_goal.m b/compiler/modecheck_goal.m
index 97e433a..44e633c 100644
--- a/compiler/modecheck_goal.m
+++ b/compiler/modecheck_goal.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2009-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -108,7 +109,7 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_debug.
:- import_module check_hlds.mode_errors.
@@ -1609,7 +1610,7 @@ solver_var_must_be_initialised(VarTypes, ModuleInfo, InstMaps, Var) :-
type_is_solver_type_with_auto_init(ModuleInfo, VarType),
list.member(InstMap, InstMaps),
instmap_lookup_var(InstMap, Var, Inst),
- not inst_match.inst_is_free(ModuleInfo, Inst).
+ not inst_is_free(ModuleInfo, Inst).
:- pred add_necessary_disj_init_calls(list(hlds_goal)::in,
list(hlds_goal)::out, list(instmap)::in, list(instmap)::out,
@@ -1660,7 +1661,7 @@ solver_vars_to_init(Vars, ModuleInfo, InstMap) =
solver_var_to_init(ModuleInfo, InstMap, Var) :-
instmap_lookup_var(InstMap, Var, Inst),
- inst_match.inst_is_free(ModuleInfo, Inst).
+ inst_is_free(ModuleInfo, Inst).
%-----------------------------------------------------------------------------%
:- end_module check_hlds.modecheck_goal.
diff --git a/compiler/modecheck_unify.m b/compiler/modecheck_unify.m
index 6a51d63..0e71a14 100644
--- a/compiler/modecheck_unify.m
+++ b/compiler/modecheck_unify.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -43,6 +44,7 @@
:- implementation.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.inst_match.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_debug.
@@ -847,7 +849,7 @@ add_solver_init_calls_if_needed(InstOfX, ArgVars0, ExtraGoals, !ModeInfo) :-
% so we can insert the necessary initialisation calls.
ArgVars0 = [_ | _],
HowToCheckGoal = check_modes,
- inst_match.inst_is_free(ModuleInfo0, InstOfX),
+ inst_is_free(ModuleInfo0, InstOfX),
mode_info_may_init_solver_vars(!.ModeInfo),
mode_info_solver_init_is_supported(!.ModeInfo),
instmap_lookup_vars(InstMap0, ArgVars0, InstArgs0),
@@ -877,7 +879,7 @@ all_arg_vars_are_non_free_or_solver_vars([_ | _], [], _, _, _) :-
unexpected($module, $pred, "mismatched list lengths").
all_arg_vars_are_non_free_or_solver_vars([ArgVar | ArgVars], [Inst | Insts],
VarTypes, ModuleInfo, ArgVarsToInit) :-
- ( if inst_match.inst_is_free(ModuleInfo, Inst) then
+ ( if inst_is_free(ModuleInfo, Inst) then
lookup_var_type(VarTypes, ArgVar, ArgType),
type_is_or_may_contain_solver_type(ModuleInfo, ArgType),
all_arg_vars_are_non_free_or_solver_vars(ArgVars, Insts,
diff --git a/compiler/modecheck_util.m b/compiler/modecheck_util.m
index 8d3f3af..9d93647 100644
--- a/compiler/modecheck_util.m
+++ b/compiler/modecheck_util.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2009-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -190,6 +191,7 @@
:- import_module check_hlds.delay_info.
:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_errors.
:- import_module check_hlds.mode_util.
diff --git a/compiler/modes.m b/compiler/modes.m
index 086ebae..7e865d9 100644
--- a/compiler/modes.m
+++ b/compiler/modes.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1994-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -132,6 +133,8 @@
:- import_module check_hlds.delay_partial_inst.
:- import_module check_hlds.det_analysis.
:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
+:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_debug.
:- import_module check_hlds.mode_errors.
:- import_module check_hlds.mode_util.
@@ -1353,8 +1356,8 @@ check_final_insts(Vars, Insts, VarInsts, InferModes, GroundMatchesBound,
%
% (c) the option `--solver-type-auto-init' is enabled.
%
- inst_match.inst_is_free(ModuleInfo, VarInst),
- inst_match.inst_is_any(ModuleInfo, Inst),
+ inst_is_free(ModuleInfo, VarInst),
+ inst_is_any(ModuleInfo, Inst),
type_is_solver_type_with_auto_init(ModuleInfo, Type),
mode_info_solver_init_is_supported(!.ModeInfo)
then
diff --git a/compiler/pd_util.m b/compiler/pd_util.m
index 22a9b3b..e0e94fe 100644
--- a/compiler/pd_util.m
+++ b/compiler/pd_util.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1998-2012 University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -158,7 +159,7 @@
:- import_module check_hlds.det_analysis.
:- import_module check_hlds.det_report.
:- import_module check_hlds.det_util.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_info.
:- import_module check_hlds.mode_util.
diff --git a/compiler/prog_rep.m b/compiler/prog_rep.m
index e5f6f4a..4a1c9d4 100644
--- a/compiler/prog_rep.m
+++ b/compiler/prog_rep.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2000-2012 University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -87,7 +88,7 @@
:- implementation.
:- import_module backend_libs.proc_label.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module hlds.code_model.
:- import_module hlds.goal_util.
diff --git a/compiler/simplify_goal_call.m b/compiler/simplify_goal_call.m
index e2c7d9d..4aff722 100644
--- a/compiler/simplify_goal_call.m
+++ b/compiler/simplify_goal_call.m
@@ -1,7 +1,7 @@
%----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%----------------------------------------------------------------------------%
-% Copyright (C) 2014 The Mercury team.
+% Copyright (C) 2014-2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%----------------------------------------------------------------------------%
@@ -53,7 +53,7 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
:- import_module hlds.goal_util.
diff --git a/compiler/simplify_goal_disj.m b/compiler/simplify_goal_disj.m
index d18f3d9..a121cf2 100644
--- a/compiler/simplify_goal_disj.m
+++ b/compiler/simplify_goal_disj.m
@@ -1,7 +1,7 @@
%----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%----------------------------------------------------------------------------%
-% Copyright (C) 2014 The Mercury team.
+% Copyright (C) 2014-2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%----------------------------------------------------------------------------%
@@ -50,6 +50,7 @@
:- implementation.
:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.simplify.simplify_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.make_goal.
diff --git a/compiler/simplify_goal_switch.m b/compiler/simplify_goal_switch.m
index 583b41f..fa05966 100644
--- a/compiler/simplify_goal_switch.m
+++ b/compiler/simplify_goal_switch.m
@@ -1,7 +1,7 @@
%----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%----------------------------------------------------------------------------%
-% Copyright (C) 2014 The Mercury team.
+% Copyright (C) 2014-2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%----------------------------------------------------------------------------%
@@ -35,7 +35,8 @@
:- implementation.
:- import_module check_hlds.det_util.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
+:- import_module check_hlds.inst_util.
:- import_module check_hlds.simplify.simplify_goal.
:- import_module check_hlds.type_util.
:- import_module hlds.make_goal.
diff --git a/compiler/size_prof.m b/compiler/size_prof.m
index 927e4ca..e5d8d7b 100644
--- a/compiler/size_prof.m
+++ b/compiler/size_prof.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2003-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -104,7 +105,7 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.polymorphism.
:- import_module check_hlds.simplify.
diff --git a/compiler/stm_expand.m b/compiler/stm_expand.m
index ddb3949..c595c6d 100644
--- a/compiler/stm_expand.m
+++ b/compiler/stm_expand.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1995-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public Licence - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -166,7 +167,7 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.polymorphism.
:- import_module hlds.goal_util.
diff --git a/compiler/structure_sharing.domain.m b/compiler/structure_sharing.domain.m
index bd1cac4..3a0985b 100644
--- a/compiler/structure_sharing.domain.m
+++ b/compiler/structure_sharing.domain.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2005-2008, 2010-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -299,7 +300,7 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module hlds.hlds_llds.
:- import_module hlds.status.
diff --git a/compiler/switch_detection.m b/compiler/switch_detection.m
index bc60634..7ae88ea 100644
--- a/compiler/switch_detection.m
+++ b/compiler/switch_detection.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1994-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -68,7 +69,7 @@
:- implementation.
:- import_module check_hlds.det_util.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.type_util.
:- import_module hlds.goal_util.
:- import_module hlds.instmap.
diff --git a/compiler/term_util.m b/compiler/term_util.m
index ac59e09..6daabc4 100644
--- a/compiler/term_util.m
+++ b/compiler/term_util.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1997-2007, 2010-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
@@ -197,7 +198,7 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
diff --git a/compiler/trace_gen.m b/compiler/trace_gen.m
index d7493bb..03bd85e 100644
--- a/compiler/trace_gen.m
+++ b/compiler/trace_gen.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1997-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -237,7 +238,7 @@
:- implementation.
:- import_module backend_libs.builtin_ops.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
:- import_module hlds.code_model.
diff --git a/compiler/unify_proc.m b/compiler/unify_proc.m
index 6aed84e..d278518 100644
--- a/compiler/unify_proc.m
+++ b/compiler/unify_proc.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1994-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -130,7 +131,7 @@
:- implementation.
:- import_module check_hlds.clause_to_proc.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.polymorphism.
:- import_module check_hlds.post_typecheck.
diff --git a/compiler/unneeded_code.m b/compiler/unneeded_code.m
index 3fb205c..74262cc 100644
--- a/compiler/unneeded_code.m
+++ b/compiler/unneeded_code.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2000-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -72,7 +73,7 @@
:- implementation.
-:- import_module check_hlds.inst_match.
+:- import_module check_hlds.inst_test.
:- import_module check_hlds.mode_util.
:- import_module hlds.goal_form.
:- import_module hlds.goal_path.
More information about the reviews
mailing list