[m-rev.] for review: fix nested modules bug
Simon Taylor
stayl at cs.mu.OZ.AU
Fri Feb 21 18:45:56 AEDT 2003
Estimated hours taken: 8
Branches: main, release
Fix a bug reported by Michael Day which caused spurious
"predicate multiply defined" errors if there were predicates
`module1.p' and `module2.module1.p'.
compiler/hlds_module.m:
For each of the predicate table search predicates which
takes a module, add an extra argument which states whether
the module name passed in is fully qualified. If it is, then
a search for `module1.p' will not return `module2.module1.p'.
The module name is guaranteed to be fully qualified for
the head of predicate, clause, etc. items, and for calls
occurring in `.opt' files.
Add a predicate `lookup_builtin_pred_proc_id', for
looking up the builtin predicates in the predicate table.
compiler/goal_util.m:
Move code to look up builtin predicates into hlds_module.m.
Set the builtin_state field of the call goal returned
by generate_simple_call correctly.
compiler/hlds_pred.m:
Add a function `calls_are_fully_qualified' which takes
an import_status, and returns whether calls from goals
with that status are always fully qualified, which is
true iff the call is in a `.opt' file.
compiler/prog_io.m:
Module qualify the sym_names in `:- external' items.
compiler/*.m:
Fill in the extra argument of predicate table searches.
Use `lookup_builtin_pred_proc_id' rather than
`predicate_table_search_*'.
compiler/prog_util.m:
Add function versions of mercury_*_builtin_module.
compiler/polymorphism.m:
compiler/simplify.m:
compiler/unify_proc.m:
Use goal_util__generate_simple_call to call builtins,
rather than duplicating the code.
tests/valid/Mmakefile:
tests/valid/nested_module_bug.m:
tests/valid/intermod_bug_nested.m:
Test cases.
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.46
diff -u -u -r1.46 check_typeclass.m
--- compiler/check_typeclass.m 20 Mar 2002 12:35:53 -0000 1.46
+++ compiler/check_typeclass.m 21 Feb 2003 06:20:40 -0000
@@ -302,8 +302,8 @@
adjust_func_arity(MethodPredOrFunc, MethodArity,
MethodPredArity),
predicate_table_search_pf_sym_arity(PredTable,
- MethodPredOrFunc, MethodName, MethodPredArity,
- MatchingPredIds),
+ is_fully_qualified, MethodPredOrFunc,
+ MethodName, MethodPredArity, MatchingPredIds),
some [PredId] (
list__member(PredId, MatchingPredIds),
list__member(PredId, ClassPredIds)
Index: compiler/common.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/common.m,v
retrieving revision 1.65
diff -u -u -r1.65 common.m
--- compiler/common.m 17 Feb 2003 06:20:05 -0000 1.65
+++ compiler/common.m 21 Feb 2003 06:53:50 -0000
@@ -86,8 +86,9 @@
:- import_module check_hlds__det_util, check_hlds__det_report, libs__globals.
:- import_module libs__options, check_hlds__inst_match, hlds__instmap.
:- import_module hlds__hlds_data, hlds__hlds_module, (parse_tree__inst).
-:- import_module transform_hlds__pd_cost, term.
-:- import_module bool, map, set, eqvclass, require, std_util, string.
+:- import_module transform_hlds__pd_cost.
+:- import_module hlds__goal_util.
+:- import_module bool, map, set, eqvclass, require, std_util, string, term.
:- type structure
---> structure(prog_var, type, cons_id, list(prog_var)).
@@ -684,20 +685,10 @@
% since the call to the type cast hides the equivalence of
% the input and output.
simplify_info_get_module_info(Info0, ModuleInfo),
- module_info_get_predicate_table(ModuleInfo, PredTable),
- mercury_private_builtin_module(MercuryBuiltin),
- TypeCast = qualified(MercuryBuiltin, "unsafe_type_cast"),
- (
- predicate_table_search_pred_sym_arity(
- PredTable, TypeCast, 2, [PredId])
- ->
- hlds_pred__initial_proc_id(ProcId),
- GoalExpr = call(PredId, ProcId, [FromVar, ToVar],
- inline_builtin, no, TypeCast)
- ;
- error("common__generate_assign: \
- can't find unsafe_type_cast")
- ),
+ goal_info_get_context(GoalInfo0, Context),
+ goal_util__generate_simple_call(mercury_private_builtin_module,
+ "unsafe_type_cast", [FromVar, ToVar], only_mode,
+ det, no, [], ModuleInfo, Context, GoalExpr - _),
instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta)
),
goal_info_init(NonLocals, InstMapDelta, det, GoalInfo),
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.74
diff -u -u -r1.74 dead_proc_elim.m
--- compiler/dead_proc_elim.m 27 Jan 2003 09:20:44 -0000 1.74
+++ compiler/dead_proc_elim.m 20 Feb 2003 08:53:37 -0000
@@ -901,7 +901,10 @@
;
module_info_get_predicate_table(ModuleInfo, PredicateTable),
set__insert(NeededNames0, Name, NeededNames),
- ( predicate_table_search_sym(PredicateTable, Name, PredIds) ->
+ (
+ predicate_table_search_sym(PredicateTable,
+ may_be_partially_qualified, Name, PredIds)
+ ->
queue__put_list(Q0, PredIds, Q)
;
Q = Q0
Index: compiler/deep_profiling.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/deep_profiling.m,v
retrieving revision 1.13
diff -u -u -r1.13 deep_profiling.m
--- compiler/deep_profiling.m 27 Jan 2003 09:20:45 -0000 1.13
+++ compiler/deep_profiling.m 20 Feb 2003 14:18:45 -0000
@@ -1439,24 +1439,25 @@
classify_call(ModuleInfo, Expr, Class) :-
( Expr = call(PredId, ProcId, Args, _, _, _) ->
- module_info_get_predicate_table(ModuleInfo, PredTable),
- mercury_public_builtin_module(MercuryBuiltin),
(
- predicate_table_search_pred_m_n_a(PredTable,
- MercuryBuiltin, "unify", 2, [PredId]),
+ lookup_builtin_pred_proc_id(ModuleInfo,
+ mercury_public_builtin_module, "unify", 2,
+ mode_no(0), PredId, _),
Args = [TypeInfoVar | _]
->
Class = special(proc(PredId, ProcId), TypeInfoVar)
;
- predicate_table_search_pred_m_n_a(PredTable,
- MercuryBuiltin, "compare", 3, [PredId]),
+ lookup_builtin_pred_proc_id(ModuleInfo,
+ mercury_public_builtin_module, "compare", 3,
+ mode_no(0), PredId, _),
Args = [TypeInfoVar | _]
->
Class = special(proc(PredId, ProcId), TypeInfoVar)
;
- predicate_table_search_pred_m_n_a(PredTable,
- MercuryBuiltin, "compare_representation", 3,
- [PredId]),
+ lookup_builtin_pred_proc_id(ModuleInfo,
+ mercury_public_builtin_module,
+ "compare_representation", 3,
+ mode_no(0), PredId, _),
Args = [TypeInfoVar | _]
->
Class = special(proc(PredId, ProcId), TypeInfoVar)
@@ -1680,7 +1681,7 @@
module_info_get_predicate_table(ModuleInfo, PredTable),
(
predicate_table_search_pred_m_n_a(PredTable,
- ModuleName, Name, Arity, PredIds)
+ is_fully_qualified, ModuleName, Name, Arity, PredIds)
->
(
PredIds = [],
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.79
diff -u -u -r1.79 goal_util.m
--- compiler/goal_util.m 27 Jan 2003 09:20:45 -0000 1.79
+++ compiler/goal_util.m 21 Feb 2003 06:56:06 -0000
@@ -234,10 +234,6 @@
maybe(goal_feature)::in, assoc_list(prog_var, inst)::in,
module_info::in, term__context::in, hlds_goal::out) is det.
-:- type mode_no
- ---> only_mode % The pred must have exactly one mode.
- ; mode_no(int). % The Nth mode, counting from 0.
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -248,6 +244,7 @@
:- import_module check_hlds__purity, check_hlds__det_analysis.
:- import_module check_hlds__inst_match, check_hlds__mode_util.
:- import_module check_hlds__type_util.
+:- import_module ll_backend, ll_backend__code_util. % for builtin_state.
:- import_module int, string, require, varset.
@@ -1216,54 +1213,17 @@
goal_util__generate_simple_call(ModuleName, PredName, Args, ModeNo, Detism,
MaybeFeature, InstMap, Module, Context, CallGoal) :-
list__length(Args, Arity),
- module_info_get_predicate_table(Module, PredTable),
- (
- predicate_table_search_pred_m_n_a(PredTable,
- ModuleName, PredName, Arity,
- [PredId0])
- ->
- PredId = PredId0
- ;
- % Some of the table builtins are polymorphic,
- % and for them we need to subtract one from the arity
- % to take into account the type_info argument.
- predicate_table_search_pred_m_n_a(PredTable,
- ModuleName, PredName, Arity - 1,
- [PredId0])
- ->
- PredId = PredId0
- ;
- string__int_to_string(Arity, ArityS),
- string__append_list(["can't locate ", PredName,
- "/", ArityS], ErrorMessage),
- error(ErrorMessage)
- ),
- module_info_pred_info(Module, PredId, PredInfo),
- pred_info_procids(PredInfo, ProcIds),
- (
- ModeNo = only_mode,
- (
- ProcIds = [ProcId0]
- ->
- ProcId = ProcId0
- ;
- error(string__format(
- "expected single mode for %s/%d",
- [s(PredName), i(Arity)]))
- )
- ;
- ModeNo = mode_no(N),
- (
- list__index0(ProcIds, N, ProcId0)
- ->
- ProcId = ProcId0
- ;
- error(string__format(
- "there is no mode %d for %s/%d",
- [i(N), s(PredName), i(Arity)]))
- )
- ),
- Call = call(PredId, ProcId, Args, not_builtin, no,
+ lookup_builtin_pred_proc_id(Module, ModuleName, PredName,
+ Arity, ModeNo, PredId, ProcId),
+
+ % code_util__buitin_state only uses this to work out whether
+ % this is the "recursive" clause generated for the compiler
+ % for each builtin, so an invalid pred_id won't cause problems.
+ invalid_pred_id(InvalidPredId),
+ code_util__builtin_state(Module, InvalidPredId,
+ PredId, ProcId, BuiltinState),
+
+ Call = call(PredId, ProcId, Args, BuiltinState, no,
qualified(ModuleName, PredName)),
set__init(NonLocals0),
set__insert_list(NonLocals0, Args, NonLocals),
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.100
diff -u -u -r1.100 higher_order.m
--- compiler/higher_order.m 30 Jan 2003 05:59:20 -0000 1.100
+++ compiler/higher_order.m 20 Feb 2003 08:53:57 -0000
@@ -929,23 +929,12 @@
get_typeclass_info_args(ModuleInfo, TypeClassInfoVar, PredName, MakeResultType,
Args, Index, Goals, Vars, ProcInfo0, ProcInfo) :-
- mercury_private_builtin_module(PrivateBuiltin),
- SymName = qualified(PrivateBuiltin, PredName),
- module_info_get_predicate_table(ModuleInfo, PredTable),
- (
- predicate_table_search_pred_sym_arity(PredTable,
- SymName, 3, [ExtractArgPredId0])
- ->
- ExtractArgPredId = ExtractArgPredId0
- ;
- string__append("higher_order.m: can't find private_builtin__",
- PredName, Msg),
- error(Msg)
- ),
- hlds_pred__initial_proc_id(ExtractArgProcId),
+ lookup_builtin_pred_proc_id(ModuleInfo, mercury_private_builtin_module,
+ PredName, 3, only_mode, ExtractArgPredId, ExtractArgProcId),
get_typeclass_info_args_2(TypeClassInfoVar, ExtractArgPredId,
- ExtractArgProcId, SymName, MakeResultType,
- Args, Index, Goals, Vars, ProcInfo0, ProcInfo).
+ ExtractArgProcId,
+ qualified(mercury_private_builtin_module, PredName),
+ MakeResultType, Args, Index, Goals, Vars, ProcInfo0, ProcInfo).
:- pred get_typeclass_info_args_2(prog_var::in, pred_id::in, proc_id::in,
sym_name::in, pred(T, type)::(pred(in, out) is det),
@@ -2205,7 +2194,8 @@
mercury_private_builtin_module(MercuryBuiltin),
(
predicate_table_search_pred_m_n_a(PredicateTable,
- MercuryBuiltin, "unsafe_type_cast", 2, [PredIdPrime])
+ is_fully_qualified, MercuryBuiltin,
+ "unsafe_type_cast", 2, [PredIdPrime])
->
PredId = PredIdPrime
;
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.79
diff -u -u -r1.79 hlds_module.m
--- compiler/hlds_module.m 2 Jan 2003 06:53:54 -0000 1.79
+++ compiler/hlds_module.m 20 Feb 2003 09:11:08 -0000
@@ -1115,32 +1115,33 @@
% (b) predicates only or (c) functions only
% matching this (possibly module-qualified) sym_name.
-:- pred predicate_table_search_sym(predicate_table, sym_name, list(pred_id)).
-:- mode predicate_table_search_sym(in, in, out) is semidet.
-
-:- pred predicate_table_search_pred_sym(predicate_table, sym_name,
- list(pred_id)).
-:- mode predicate_table_search_pred_sym(in, in, out) is semidet.
-
-:- pred predicate_table_search_func_sym(predicate_table, sym_name,
- list(pred_id)).
-:- mode predicate_table_search_func_sym(in, in, out) is semidet.
+:- pred predicate_table_search_sym(predicate_table, is_fully_qualified,
+ sym_name, list(pred_id)).
+:- mode predicate_table_search_sym(in, in, in, out) is semidet.
+
+:- pred predicate_table_search_pred_sym(predicate_table,
+ is_fully_qualified, sym_name, list(pred_id)).
+:- mode predicate_table_search_pred_sym(in, in, in, out) is semidet.
+
+:- pred predicate_table_search_func_sym(predicate_table,
+ is_fully_qualified, sym_name, list(pred_id)).
+:- mode predicate_table_search_func_sym(in, in, in, out) is semidet.
% Search the table for (a) predicates or functions
% (b) predicates only or (c) functions only matching this
% (possibly module-qualified) sym_name & arity.
-:- pred predicate_table_search_sym_arity(predicate_table, sym_name, arity,
- list(pred_id)).
-:- mode predicate_table_search_sym_arity(in, in, in, out) is semidet.
-
-:- pred predicate_table_search_pred_sym_arity(predicate_table, sym_name, arity,
- list(pred_id)).
-:- mode predicate_table_search_pred_sym_arity(in, in, in, out) is semidet.
-
-:- pred predicate_table_search_func_sym_arity(predicate_table, sym_name, arity,
- list(pred_id)).
-:- mode predicate_table_search_func_sym_arity(in, in, in, out) is semidet.
+:- pred predicate_table_search_sym_arity(predicate_table, is_fully_qualified,
+ sym_name, arity, list(pred_id)).
+:- mode predicate_table_search_sym_arity(in, in, in, in, out) is semidet.
+
+:- pred predicate_table_search_pred_sym_arity(predicate_table,
+ is_fully_qualified, sym_name, arity, list(pred_id)).
+:- mode predicate_table_search_pred_sym_arity(in, in, in, in, out) is semidet.
+
+:- pred predicate_table_search_func_sym_arity(predicate_table,
+ is_fully_qualified, sym_name, arity, list(pred_id)).
+:- mode predicate_table_search_func_sym_arity(in, in, in, in, out) is semidet.
% Search the table for (a) predicates or functions
% (b) predicates only or (c) functions only
@@ -1193,18 +1194,26 @@
% I hope it doesn't break anything too badly...
%
% (`m_n_a' here is short for "module, name, arity".)
-
-:- pred predicate_table_search_m_n_a(predicate_table, module_name, string,
- arity, list(pred_id)).
-:- mode predicate_table_search_m_n_a(in, in, in, in, out) is semidet.
-
-:- pred predicate_table_search_pred_m_n_a(predicate_table, module_name, string,
- arity, list(pred_id)).
-:- mode predicate_table_search_pred_m_n_a(in, in, in, in, out) is semidet.
-
-:- pred predicate_table_search_func_m_n_a(predicate_table, module_name, string,
- arity, list(pred_id)).
-:- mode predicate_table_search_func_m_n_a(in, in, in, in, out) is semidet.
+
+ % Is the item known to be fully qualified?
+ % If so, a search for `pred foo.bar/2' will not match
+ % `pred baz.foo.bar/2'.
+:- type is_fully_qualified
+ ---> is_fully_qualified
+ ; may_be_partially_qualified
+ .
+
+:- pred predicate_table_search_m_n_a(predicate_table, is_fully_qualified,
+ module_name, string, arity, list(pred_id)).
+:- mode predicate_table_search_m_n_a(in, in, in, in, in, out) is semidet.
+
+:- pred predicate_table_search_pred_m_n_a(predicate_table, is_fully_qualified,
+ module_name, string, arity, list(pred_id)).
+:- mode predicate_table_search_pred_m_n_a(in, in, in, in, in, out) is semidet.
+
+:- pred predicate_table_search_func_m_n_a(predicate_table, is_fully_qualified,
+ module_name, string, arity, list(pred_id)).
+:- mode predicate_table_search_func_m_n_a(in, in, in, in, in, out) is semidet.
% Search the table for predicates or functions matching
% this pred_or_func category, module, name, and arity.
@@ -1214,10 +1223,9 @@
% NB. This is opposite to what happens with the search
% predicates declared above!!
-:- pred predicate_table_search_pf_m_n_a(predicate_table, pred_or_func,
- module_name, string,
- arity, list(pred_id)).
-:- mode predicate_table_search_pf_m_n_a(in, in, in, in, in, out) is semidet.
+:- pred predicate_table_search_pf_m_n_a(predicate_table, is_fully_qualified,
+ pred_or_func, module_name, string, arity, list(pred_id)).
+:- mode predicate_table_search_pf_m_n_a(in, in, in, in, in, in, out) is semidet.
% Search the table for predicates or functions matching
% this pred_or_func category, name, and arity.
@@ -1239,16 +1247,18 @@
% NB. This is opposite to what happens with the search
% predicates declared above!!
-:- pred predicate_table_search_pf_sym_arity(predicate_table, pred_or_func,
- sym_name, arity, list(pred_id)) is semidet.
-:- mode predicate_table_search_pf_sym_arity(in, in, in, in, out) is semidet.
+:- pred predicate_table_search_pf_sym_arity(predicate_table,
+ is_fully_qualified, pred_or_func,
+ sym_name, arity, list(pred_id)) is semidet.
+:- mode predicate_table_search_pf_sym_arity(in,
+ in, in, in, in, out) is semidet.
% Search the table for predicates or functions matching
% this pred_or_func category and sym_name.
-:- pred predicate_table_search_pf_sym(predicate_table, pred_or_func,
- sym_name, list(pred_id)) is semidet.
-:- mode predicate_table_search_pf_sym(in, in, in, out) is semidet.
+:- pred predicate_table_search_pf_sym(predicate_table, is_fully_qualified,
+ pred_or_func, sym_name, list(pred_id)) is semidet.
+:- mode predicate_table_search_pf_sym(in, in, in, in, out) is semidet.
% predicate_table_insert(PredTable0, PredInfo,
% NeedQual, PartialQualInfo, PredId, PredTable).
@@ -1284,21 +1294,29 @@
% Get the pred_id and proc_id matching a higher-order term with
% the given argument types, aborting with an error if none is
% found.
-:- pred get_pred_id_and_proc_id(sym_name, pred_or_func, tvarset, list(type),
- module_info, pred_id, proc_id).
-:- mode get_pred_id_and_proc_id(in, in, in, in, in, out, out) is det.
+:- pred get_pred_id_and_proc_id(is_fully_qualified, sym_name, pred_or_func,
+ tvarset, list(type), module_info, pred_id, proc_id).
+:- mode get_pred_id_and_proc_id(in, in, in, in, in, in, out, out) is det.
% Get the pred_id matching a higher-order term with
% the given argument types, failing if none is found.
-:- pred get_pred_id(sym_name, pred_or_func, tvarset, list(type),
- module_info, pred_id).
-:- mode get_pred_id(in, in, in, in, in, out) is semidet.
+:- pred get_pred_id(is_fully_qualified, sym_name, pred_or_func,
+ tvarset, list(type), module_info, pred_id).
+:- mode get_pred_id(in, in, in, in, in, in, out) is semidet.
% Given a pred_id, return the single proc_id, aborting
% if there are no modes or more than one mode.
:- pred get_proc_id(module_info, pred_id, proc_id).
:- mode get_proc_id(in, in, out) is det.
+:- type mode_no
+ ---> only_mode % The pred must have exactly one mode.
+ ; mode_no(int). % The Nth mode, counting from 0.
+
+:- pred lookup_builtin_pred_proc_id(module_info, module_name,
+ string, arity, mode_no, pred_id, proc_id).
+:- mode lookup_builtin_pred_proc_id(in, in, in, in, in, out, out) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -1462,30 +1480,31 @@
%-----------------------------------------------------------------------------%
-predicate_table_search_sym(PredicateTable, unqualified(Name), PredIdList) :-
+predicate_table_search_sym(PredicateTable, may_be_partially_qualified,
+ unqualified(Name), PredIdList) :-
predicate_table_search_name(PredicateTable, Name, PredIdList).
-predicate_table_search_sym(PredicateTable, qualified(Module, Name),
- PredIdList) :-
- predicate_table_search_module_name(PredicateTable,
+predicate_table_search_sym(PredicateTable, IsFullyQualified,
+ qualified(Module, Name), PredIdList) :-
+ predicate_table_search_module_name(PredicateTable, IsFullyQualified,
Module, Name, PredIdList),
PredIdList \= [].
-predicate_table_search_pred_sym(PredicateTable, unqualified(Name), PredIdList)
- :-
+predicate_table_search_pred_sym(PredicateTable, may_be_partially_qualified,
+ unqualified(Name), PredIdList) :-
predicate_table_search_pred_name(PredicateTable, Name, PredIdList).
-predicate_table_search_pred_sym(PredicateTable, qualified(Module, Name),
- PredIdList) :-
- predicate_table_search_pred_module_name(PredicateTable,
- Module, Name, PredIdList),
+predicate_table_search_pred_sym(PredicateTable, IsFullyQualified,
+ qualified(Module, Name), PredIdList) :-
+ predicate_table_search_pred_module_name(PredicateTable,
+ IsFullyQualified, Module, Name, PredIdList),
PredIdList \= [].
-predicate_table_search_func_sym(PredicateTable, unqualified(Name), PredIdList)
- :-
+predicate_table_search_func_sym(PredicateTable, may_be_partially_qualified,
+ unqualified(Name), PredIdList) :-
predicate_table_search_func_name(PredicateTable, Name, PredIdList).
-predicate_table_search_func_sym(PredicateTable, qualified(Module, Name),
- PredIdList) :-
- predicate_table_search_func_module_name(PredicateTable, Module,
- Name, PredIdList),
+predicate_table_search_func_sym(PredicateTable, IsFullyQualified,
+ qualified(Module, Name), PredIdList) :-
+ predicate_table_search_func_module_name(PredicateTable,
+ IsFullyQualified, Module, Name, PredIdList),
PredIdList \= [].
% Given a list of predicates, and a module name, find all the
@@ -1493,29 +1512,31 @@
%-----------------------------------------------------------------------------%
-predicate_table_search_sym_arity(PredicateTable, qualified(Module, Name),
- Arity, PredIdList) :-
- predicate_table_search_m_n_a(PredicateTable, Module, Name, Arity,
- PredIdList).
-predicate_table_search_sym_arity(PredicateTable, unqualified(Name),
- Arity, PredIdList) :-
+predicate_table_search_sym_arity(PredicateTable, IsFullyQualified,
+ qualified(Module, Name), Arity, PredIdList) :-
+ predicate_table_search_m_n_a(PredicateTable,
+ IsFullyQualified, Module, Name, Arity, PredIdList).
+predicate_table_search_sym_arity(PredicateTable, may_be_partially_qualified,
+ unqualified(Name), Arity, PredIdList) :-
predicate_table_search_name_arity(PredicateTable, Name, Arity,
PredIdList).
-predicate_table_search_pred_sym_arity(PredicateTable, qualified(Module, Name),
- Arity, PredIdList) :-
- predicate_table_search_pred_m_n_a(PredicateTable, Module, Name, Arity,
- PredIdList).
-predicate_table_search_pred_sym_arity(PredicateTable, unqualified(Name),
+predicate_table_search_pred_sym_arity(PredicateTable, IsFullyQualified,
+ qualified(Module, Name), Arity, PredIdList) :-
+ predicate_table_search_pred_m_n_a(PredicateTable,
+ IsFullyQualified, Module, Name, Arity, PredIdList).
+predicate_table_search_pred_sym_arity(PredicateTable,
+ may_be_partially_qualified, unqualified(Name),
Arity, PredIdList) :-
predicate_table_search_pred_name_arity(PredicateTable, Name, Arity,
PredIdList).
-predicate_table_search_func_sym_arity(PredicateTable, qualified(Module, Name),
- Arity, PredIdList) :-
- predicate_table_search_func_m_n_a(PredicateTable, Module, Name, Arity,
- PredIdList).
-predicate_table_search_func_sym_arity(PredicateTable, unqualified(Name),
+predicate_table_search_func_sym_arity(PredicateTable, IsFullyQualified,
+ qualified(Module, Name), Arity, PredIdList) :-
+ predicate_table_search_func_m_n_a(PredicateTable,
+ IsFullyQualified, Module, Name, Arity, PredIdList).
+predicate_table_search_func_sym_arity(PredicateTable,
+ may_be_partially_qualified, unqualified(Name),
Arity, PredIdList) :-
predicate_table_search_func_name_arity(PredicateTable, Name, Arity,
PredIdList).
@@ -1552,14 +1573,15 @@
%-----------------------------------------------------------------------------%
-:- pred predicate_table_search_module_name(predicate_table, module_name,
- string, list(pred_id)).
-:- mode predicate_table_search_module_name(in, in, in, out) is semidet.
+:- pred predicate_table_search_module_name(predicate_table, is_fully_qualified,
+ module_name, string, list(pred_id)).
+:- mode predicate_table_search_module_name(in, in, in, in, out) is semidet.
-predicate_table_search_module_name(PredicateTable, Module, Name, PredIds) :-
+predicate_table_search_module_name(PredicateTable, IsFullyQualified,
+ Module, Name, PredIds) :-
(
- predicate_table_search_pred_module_name(PredicateTable,
- Module, Name, PredPredIds0)
+ predicate_table_search_pred_module_name(PredicateTable,
+ IsFullyQualified, Module, Name, PredPredIds0)
->
PredPredIds = PredPredIds0
;
@@ -1567,7 +1589,7 @@
),
(
predicate_table_search_func_module_name(PredicateTable,
- Module, Name, FuncPredIds0)
+ IsFullyQualified, Module, Name, FuncPredIds0)
->
FuncPredIds = FuncPredIds0
;
@@ -1576,27 +1598,32 @@
list__append(FuncPredIds, PredPredIds, PredIds),
PredIds \= [].
-:- pred predicate_table_search_pred_module_name(predicate_table, module_name,
- string, list(pred_id)).
-:- mode predicate_table_search_pred_module_name(in, in, in, out) is semidet.
+:- pred predicate_table_search_pred_module_name(predicate_table,
+ is_fully_qualified, module_name, string, list(pred_id)).
+:- mode predicate_table_search_pred_module_name(in, in, in, in, out) is semidet.
-predicate_table_search_pred_module_name(PredicateTable,
+predicate_table_search_pred_module_name(PredicateTable, IsFullyQualified,
Module, PredName, PredIds) :-
PredicateTable = predicate_table(_,_,_,_,_, Pred_MNA_Index, _,_,_),
map__search(Pred_MNA_Index, Module - PredName, Arities),
map__values(Arities, PredIdLists),
- list__condense(PredIdLists, PredIds).
+ list__condense(PredIdLists, PredIds0),
+ maybe_filter_pred_ids_matching_module(IsFullyQualified,
+ Module, PredicateTable, PredIds0, PredIds).
+
+:- pred predicate_table_search_func_module_name(predicate_table,
+ is_fully_qualified, module_name, string, list(pred_id)).
+:- mode predicate_table_search_func_module_name(in,
+ in, in, in, out) is semidet.
-:- pred predicate_table_search_func_module_name(predicate_table, module_name,
- string, list(pred_id)).
-:- mode predicate_table_search_func_module_name(in, in, in, out) is semidet.
-
-predicate_table_search_func_module_name(PredicateTable,
+predicate_table_search_func_module_name(PredicateTable, IsFullyQualified,
Module, FuncName, PredIds) :-
PredicateTable = predicate_table(_,_,_,_,_,_,_,_, Func_MNA_Index),
map__search(Func_MNA_Index, Module - FuncName, Arities),
map__values(Arities, PredIdLists),
- list__condense(PredIdLists, PredIds).
+ list__condense(PredIdLists, PredIds0),
+ maybe_filter_pred_ids_matching_module(IsFullyQualified,
+ Module, PredicateTable, PredIds0, PredIds).
%-----------------------------------------------------------------------------%
@@ -1634,19 +1661,19 @@
%-----------------------------------------------------------------------------%
-predicate_table_search_m_n_a(PredicateTable, Module, Name, Arity,
- PredIds) :-
+predicate_table_search_m_n_a(PredicateTable, IsFullyQualified,
+ Module, Name, Arity, PredIds) :-
(
- predicate_table_search_pred_m_n_a(PredicateTable, Module,
- Name, Arity, PredPredIds0)
+ predicate_table_search_pred_m_n_a(PredicateTable,
+ IsFullyQualified, Module, Name, Arity, PredPredIds0)
->
PredPredIds = PredPredIds0
;
PredPredIds = []
),
(
- predicate_table_search_func_m_n_a(PredicateTable, Module,
- Name, Arity, FuncPredIds0)
+ predicate_table_search_func_m_n_a(PredicateTable,
+ IsFullyQualified, Module, Name, Arity, FuncPredIds0)
->
FuncPredIds = FuncPredIds0
;
@@ -1655,29 +1682,48 @@
list__append(FuncPredIds, PredPredIds, PredIds),
PredIds \= [].
-predicate_table_search_pred_m_n_a(PredicateTable, Module, PredName, Arity,
- PredIds) :-
+predicate_table_search_pred_m_n_a(PredicateTable, IsFullyQualified,
+ Module, PredName, Arity, PredIds) :-
PredicateTable = predicate_table(_, _, _, _, _, P_MNA_Index, _, _, _),
map__search(P_MNA_Index, Module - PredName, ArityIndex),
- map__search(ArityIndex, Arity, PredIds).
+ map__search(ArityIndex, Arity, PredIds0),
+ maybe_filter_pred_ids_matching_module(IsFullyQualified,
+ Module, PredicateTable, PredIds0, PredIds).
-predicate_table_search_func_m_n_a(PredicateTable, Module, FuncName, Arity,
- PredIds) :-
+predicate_table_search_func_m_n_a(PredicateTable, IsFullyQualified,
+ Module, FuncName, Arity, PredIds) :-
PredicateTable = predicate_table(_, _, _, _, _, _, _, _, F_MNA_Index),
map__search(F_MNA_Index, Module - FuncName, ArityIndex),
- map__search(ArityIndex, Arity, PredIds).
+ map__search(ArityIndex, Arity, PredIds0),
+ maybe_filter_pred_ids_matching_module(IsFullyQualified,
+ Module, PredicateTable, PredIds0, PredIds).
+
+:- pred maybe_filter_pred_ids_matching_module(is_fully_qualified,
+ module_name, predicate_table, list(pred_id), list(pred_id)).
+:- mode maybe_filter_pred_ids_matching_module(in, in, in, in, out) is det.
+
+maybe_filter_pred_ids_matching_module(may_be_partially_qualified, _, _,
+ PredIds, PredIds).
+maybe_filter_pred_ids_matching_module(is_fully_qualified, ModuleName,
+ PredicateTable, PredIds0, PredIds) :-
+ predicate_table_get_preds(PredicateTable, Preds),
+ PredIds = list__filter(
+ (pred(PredId::in) is semidet :-
+ map__lookup(Preds, PredId, PredInfo),
+ pred_info_module(PredInfo, ModuleName)
+ ), PredIds0).
%-----------------------------------------------------------------------------%
-predicate_table_search_pf_m_n_a(PredicateTable, predicate, Module, Name, Arity,
- PredIds) :-
- predicate_table_search_pred_m_n_a(PredicateTable, Module, Name, Arity,
- PredIds).
-predicate_table_search_pf_m_n_a(PredicateTable, function, Module, Name, Arity,
- PredIds) :-
+predicate_table_search_pf_m_n_a(PredicateTable, IsFullyQualified,
+ predicate, Module, Name, Arity, PredIds) :-
+ predicate_table_search_pred_m_n_a(PredicateTable, IsFullyQualified,
+ Module, Name, Arity, PredIds).
+predicate_table_search_pf_m_n_a(PredicateTable, IsFullyQualified,
+ function, Module, Name, Arity, PredIds) :-
FuncArity is Arity - 1,
- predicate_table_search_func_m_n_a(PredicateTable, Module, Name,
- FuncArity, PredIds).
+ predicate_table_search_func_m_n_a(PredicateTable, IsFullyQualified,
+ Module, Name, FuncArity, PredIds).
predicate_table_search_pf_name_arity(PredicateTable, predicate, Name, Arity,
PredIds) :-
@@ -1689,20 +1735,24 @@
predicate_table_search_func_name_arity(PredicateTable, Name, FuncArity,
PredIds).
-predicate_table_search_pf_sym_arity(PredicateTable, PredOrFunc,
- qualified(Module, Name), Arity, PredIdList) :-
- predicate_table_search_pf_m_n_a(PredicateTable, PredOrFunc,
+predicate_table_search_pf_sym_arity(PredicateTable, IsFullyQualified,
+ PredOrFunc, qualified(Module, Name), Arity, PredIdList) :-
+ predicate_table_search_pf_m_n_a(PredicateTable,
+ IsFullyQualified, PredOrFunc,
Module, Name, Arity, PredIdList).
-predicate_table_search_pf_sym_arity(PredicateTable, PredOrFunc,
- unqualified(Name), Arity, PredIdList) :-
+predicate_table_search_pf_sym_arity(PredicateTable, may_be_partially_qualified,
+ PredOrFunc, unqualified(Name), Arity, PredIdList) :-
predicate_table_search_pf_name_arity(PredicateTable, PredOrFunc,
Name, Arity, PredIdList).
-predicate_table_search_pf_sym(PredicateTable, predicate,
+predicate_table_search_pf_sym(PredicateTable, IsFullyQualified, predicate,
SymName, PredIdList) :-
- predicate_table_search_pred_sym(PredicateTable, SymName, PredIdList).
-predicate_table_search_pf_sym(PredicateTable, function, SymName, PredIdList) :-
- predicate_table_search_func_sym(PredicateTable, SymName, PredIdList).
+ predicate_table_search_pred_sym(PredicateTable, IsFullyQualified,
+ SymName, PredIdList).
+predicate_table_search_pf_sym(PredicateTable, IsFullyQualified,
+ function, SymName, PredIdList) :-
+ predicate_table_search_func_sym(PredicateTable, IsFullyQualified,
+ SymName, PredIdList).
%-----------------------------------------------------------------------------%
@@ -1832,13 +1882,14 @@
%-----------------------------------------------------------------------------%
-get_pred_id(SymName, PredOrFunc, TVarSet, ArgTypes, ModuleInfo,
- PredId) :-
+get_pred_id(IsFullyQualified, SymName, PredOrFunc, TVarSet,
+ ArgTypes, ModuleInfo, PredId) :-
module_info_get_predicate_table(ModuleInfo, PredicateTable),
list__length(ArgTypes, Arity),
(
predicate_table_search_pf_sym_arity(PredicateTable,
- PredOrFunc, SymName, Arity, PredIds),
+ IsFullyQualified, PredOrFunc, SymName,
+ Arity, PredIds),
% Resolve overloading using the argument types.
typecheck__find_matching_pred_id(PredIds, ModuleInfo,
TVarSet, ArgTypes, PredId0, _PredName)
@@ -1849,10 +1900,10 @@
fail
).
-get_pred_id_and_proc_id(SymName, PredOrFunc, TVarSet, ArgTypes, ModuleInfo,
- PredId, ProcId) :-
+get_pred_id_and_proc_id(IsFullyQualified, SymName, PredOrFunc, TVarSet,
+ ArgTypes, ModuleInfo, PredId, ProcId) :-
(
- get_pred_id(SymName, PredOrFunc, TVarSet,
+ get_pred_id(IsFullyQualified, SymName, PredOrFunc, TVarSet,
ArgTypes, ModuleInfo, PredId0)
->
PredId = PredId0
@@ -1900,6 +1951,56 @@
Message)
),
error(Message)
+ ).
+
+lookup_builtin_pred_proc_id(Module, ModuleName, PredName,
+ Arity, ModeNo, PredId, ProcId) :-
+ module_info_get_predicate_table(Module, PredTable),
+ (
+ predicate_table_search_pred_m_n_a(PredTable,
+ is_fully_qualified, ModuleName, PredName, Arity,
+ [PredId0])
+ ->
+ PredId = PredId0
+ ;
+ % Some of the table builtins are polymorphic,
+ % and for them we need to subtract one from the arity
+ % to take into account the type_info argument.
+ predicate_table_search_pred_m_n_a(PredTable,
+ is_fully_qualified, ModuleName, PredName, Arity - 1,
+ [PredId0])
+ ->
+ PredId = PredId0
+ ;
+ string__int_to_string(Arity, ArityS),
+ string__append_list(["can't locate ", PredName,
+ "/", ArityS], ErrorMessage),
+ error(ErrorMessage)
+ ),
+ module_info_pred_info(Module, PredId, PredInfo),
+ pred_info_procids(PredInfo, ProcIds),
+ (
+ ModeNo = only_mode,
+ (
+ ProcIds = [ProcId0]
+ ->
+ ProcId = ProcId0
+ ;
+ error(string__format(
+ "expected single mode for %s/%d",
+ [s(PredName), i(Arity)]))
+ )
+ ;
+ ModeNo = mode_no(N),
+ (
+ list__index0(ProcIds, N, ProcId0)
+ ->
+ ProcId = ProcId0
+ ;
+ error(string__format(
+ "there is no mode %d for %s/%d",
+ [i(N), s(PredName), i(Arity)]))
+ )
).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.116
diff -u -u -r1.116 hlds_pred.m
--- compiler/hlds_pred.m 21 Feb 2003 01:54:38 -0000 1.116
+++ compiler/hlds_pred.m 21 Feb 2003 02:01:51 -0000
@@ -362,6 +362,12 @@
% status_is_imported.
:- pred status_defined_in_this_module(import_status::in, bool::out) is det.
+ % Are calls from a predicate with the given import_status
+ % always fully qualified. For calls occurring in `.opt' files
+ % this will return `is_fully_qualified', otherwise
+ % `may_be_partially_qualified'.
+:- func calls_are_fully_qualified(import_status) = is_fully_qualified.
+
% Predicates can be marked with various boolean flags, called
% "markers".
@@ -947,6 +953,12 @@
status_defined_in_this_module(pseudo_exported, yes).
status_defined_in_this_module(exported_to_submodules, yes).
status_defined_in_this_module(local, yes).
+
+calls_are_fully_qualified(Status) =
+ ( Status = opt_imported ->
+ is_fully_qualified
+ ; may_be_partially_qualified
+ ).
% The information specific to a predicate, as opposed to a procedure.
% (Functions count as predicates.)
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.131
diff -u -u -r1.131 intermod.m
--- compiler/intermod.m 21 Feb 2003 04:23:13 -0000 1.131
+++ compiler/intermod.m 21 Feb 2003 04:27:32 -0000
@@ -348,6 +348,9 @@
\+ check_marker(Markers, class_method),
\+ check_marker(Markers, class_instance_method),
+ % Don't write stub clauses to `.opt' files.
+ \+ check_marker(Markers, stub),
+
% Don't export builtins since they will be
% recreated in the importing module anyway.
\+ code_util__compiler_generated(PredInfo),
@@ -900,7 +903,7 @@
;
InstanceMethodDefn0 = name(InstanceMethodName0),
PredOrFunc = predicate,
- typecheck__resolve_pred_overloading(ModuleInfo,
+ typecheck__resolve_pred_overloading(ModuleInfo, local,
MethodCallArgTypes, MethodCallTVarSet,
InstanceMethodName0, InstanceMethodName, PredId),
PredIds = [PredId | PredIds0],
@@ -968,7 +971,8 @@
module_info_get_predicate_table(ModuleInfo, PredicateTable),
(
predicate_table_search_func_sym_arity(PredicateTable,
- InstanceMethodName0, MethodArity, PredIds),
+ may_be_partially_qualified, InstanceMethodName0,
+ MethodArity, PredIds),
typecheck__find_matching_pred_id(PredIds, ModuleInfo,
MethodCallTVarSet, MethodCallArgTypes,
PredId, InstanceMethodFuncName)
@@ -1100,7 +1104,7 @@
map__lookup(SpecialPreds, SpecialId - TypeCtor, UnifyPredId),
module_info_pred_info(ModuleInfo, UnifyPredId, UnifyPredInfo),
pred_info_arg_types(UnifyPredInfo, TVarSet, _, ArgTypes),
- typecheck__resolve_pred_overloading(ModuleInfo, ArgTypes,
+ typecheck__resolve_pred_overloading(ModuleInfo, local, ArgTypes,
TVarSet, Pred0, Pred, UserEqPredId),
intermod__add_proc(UserEqPredId, _, Info0, Info).
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.434
diff -u -u -r1.434 make_hlds.m
--- compiler/make_hlds.m 19 Feb 2003 05:15:48 -0000 1.434
+++ compiler/make_hlds.m 21 Feb 2003 06:42:43 -0000
@@ -637,7 +637,8 @@
module_info_get_predicate_table(Module0, PredTable0),
(
predicate_table_search_func_sym_arity(PredTable0,
- SymName, FuncArity, PredIds)
+ is_fully_qualified, SymName,
+ FuncArity, PredIds)
->
predicate_table_get_preds(PredTable0, Preds0),
maybe_add_default_func_modes(PredIds, Preds0, Preds),
@@ -902,7 +903,9 @@
% ( R = A + B <=> R = B + A ).
%
{ GoalType = promise(PromiseType) },
- module_add_clause(Module0, VarSet, predicate, unqualified(Name),
+ { module_info_name(Module0, ModuleName) },
+ module_add_clause(Module0, VarSet, predicate,
+ qualified(ModuleName, Name),
HeadVars, Goal, Status, Context, GoalType,
Module, Info0, Info).
@@ -945,7 +948,8 @@
{ list__length(Modes, Arity) },
(
{ predicate_table_search_pf_sym_arity(PredTable,
- PredOrFunc, Name, Arity, [PredId]) }
+ may_be_partially_qualified, PredOrFunc, Name,
+ Arity, [PredId]) }
->
{ predicate_table_get_preds(PredTable, Preds) },
{ map__lookup(Preds, PredId, PredInfo) },
@@ -1160,7 +1164,8 @@
{ module_info_get_predicate_table(Module0, Preds) },
(
{ predicate_table_search_pf_sym_arity(Preds,
- PredOrFunc, SymName, Arity, [PredId]) }
+ is_fully_qualified, PredOrFunc, SymName,
+ Arity, [PredId]) }
->
{ module_info_unused_arg_info(Module0, UnusedArgInfo0) },
% convert the mode number to a proc_id
@@ -1191,10 +1196,11 @@
{ MaybePredOrFunc = yes(PredOrFunc) ->
adjust_func_arity(PredOrFunc, Arity, PredArity),
predicate_table_search_pf_sym_arity(Preds,
- PredOrFunc, SymName, PredArity, PredIds)
+ is_fully_qualified, PredOrFunc,
+ SymName, PredArity, PredIds)
;
predicate_table_search_sym_arity(Preds,
- SymName, Arity, PredIds)
+ is_fully_qualified, SymName, Arity, PredIds)
},
{ PredIds \= [] }
->
@@ -1652,8 +1658,8 @@
{ module_info_get_predicate_table(Module0, Preds) },
{ list__length(ModeList, Arity) },
(
- { predicate_table_search_pf_sym_arity(Preds,
- PredOrFunc, SymName, Arity, PredIds) },
+ { predicate_table_search_pf_sym_arity(Preds, is_fully_qualified,
+ PredOrFunc, SymName, Arity, PredIds) },
{ PredIds \= [] }
->
( { PredIds = [PredId] } ->
@@ -1725,8 +1731,8 @@
add_stratified_pred(Module0, PragmaName, Name, Arity, Context, Module) -->
{ module_info_get_predicate_table(Module0, PredTable0) },
(
- { predicate_table_search_sym_arity(PredTable0, Name,
- Arity, PredIds) }
+ { predicate_table_search_sym_arity(PredTable0,
+ is_fully_qualified, Name, Arity, PredIds) }
->
{ module_info_stratified_preds(Module0, StratPredIds0) },
{ set__insert_list(StratPredIds0, PredIds, StratPredIds) },
@@ -1933,8 +1939,8 @@
->
error("get_matching_pred_ids: unqualified name")
;
- predicate_table_search_sym_arity(PredTable0, Name,
- Arity, PredIds)
+ predicate_table_search_sym_arity(PredTable0,
+ is_fully_qualified, Name, Arity, PredIds)
).
%-----------------------------------------------------------------------------%
@@ -1949,7 +1955,7 @@
{ module_info_get_predicate_table(Module0, PredicateTable0) },
(
{ predicate_table_search_sym_arity(PredicateTable0,
- PredName, Arity, PredIdList) }
+ is_fully_qualified, PredName, Arity, PredIdList) }
->
{ module_mark_preds_as_external(PredIdList, Module0, Module) }
;
@@ -3177,8 +3183,9 @@
{ list__length(TypesAndModes, PredArity) },
{ module_info_get_predicate_table(Module0, PredTable) },
(
- { predicate_table_search_pf_m_n_a(PredTable, PorF,
- ModuleName, Name, PredArity, [PredId]) }
+ { predicate_table_search_pf_m_n_a(PredTable,
+ is_fully_qualified, PorF, ModuleName,
+ Name, PredArity, [PredId]) }
->
{ module_info_pred_info(Module0, PredId, PredInfo0) },
(
@@ -3347,8 +3354,8 @@
Owner, PredInfo0) },
(
{ predicate_table_search_pf_m_n_a(PredicateTable0,
- PredOrFunc, MNameOfPred, PName, Arity,
- [OrigPred|_]) }
+ is_fully_qualified, PredOrFunc, MNameOfPred,
+ PName, Arity, [OrigPred|_]) }
->
{ module_info_pred_info(Module1, OrigPred,
OrigPredInfo) },
@@ -3976,7 +3983,7 @@
{ module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
(
{ predicate_table_search_pf_sym_arity(PredicateTable0,
- PredOrFunc, PredName, Arity,
+ is_fully_qualified, PredOrFunc, PredName, Arity,
[PredId0]) }
->
{ ModuleInfo1 = ModuleInfo0 },
@@ -4136,7 +4143,7 @@
pred_info_set_markers(PredInfo0, Markers, PredInfo),
(
\+ predicate_table_search_pf_sym_arity(PredicateTable0,
- PredOrFunc, PredName, Arity, _)
+ is_fully_qualified, PredOrFunc, PredName, Arity, _)
->
module_info_get_partial_qualifier_info(ModuleInfo,
MQInfo),
@@ -4200,7 +4207,8 @@
{ module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
(
{ predicate_table_search_pf_sym_arity(PredicateTable0,
- PredOrFunc, PredName, Arity, [PredId0]) }
+ is_fully_qualified, PredOrFunc, PredName,
+ Arity, [PredId0]) }
->
{ PredId = PredId0 },
{ ModuleInfo1 = ModuleInfo0 },
@@ -4677,7 +4685,8 @@
{ module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
(
{ predicate_table_search_pf_sym_arity(PredicateTable0,
- PredOrFunc, PredName, Arity, [PredId0]) }
+ is_fully_qualified, PredOrFunc, PredName,
+ Arity, [PredId0]) }
->
{ PredId = PredId0 },
{ ModuleInfo1 = ModuleInfo0 }
@@ -4832,7 +4841,8 @@
{ module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
(
{ predicate_table_search_pf_sym_arity(PredicateTable0,
- PredOrFunc, PredName, Arity, [PredId0]) }
+ is_fully_qualified, PredOrFunc, PredName,
+ Arity, [PredId0]) }
->
{ PredId = PredId0 },
{ ModuleInfo1 = ModuleInfo0 }
@@ -4969,7 +4979,8 @@
% a dummy declaration for the predicate.)
(
{ predicate_table_search_pf_sym_arity(PredicateTable0,
- PredOrFunc, PredName, Arity, PredIds0) }
+ is_fully_qualified, PredOrFunc,
+ PredName, Arity, PredIds0) }
->
{ PredIds = PredIds0 },
{ ModuleInfo1 = ModuleInfo0 }
@@ -4987,7 +4998,8 @@
;
(
{ predicate_table_search_sym_arity(PredicateTable0,
- PredName, Arity, PredIds0) }
+ is_fully_qualified, PredName,
+ Arity, PredIds0) }
->
{ ModuleInfo1 = ModuleInfo0 },
{ PredIds = PredIds0 }
@@ -9099,8 +9111,8 @@
Module0, Module, Info0, Info) -->
{ module_info_get_predicate_table(Module0, PredicateTable) },
(
- { predicate_table_search_sym_arity(PredicateTable, Pred,
- Arity, PredIDs0) },
+ { predicate_table_search_sym_arity(PredicateTable,
+ is_fully_qualified, Pred, Arity, PredIDs0) },
{ PredIDs0 = [PredID | PredIDs1] }
->
(
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.263
diff -u -u -r1.263 modes.m
--- compiler/modes.m 30 Jan 2003 05:59:20 -0000 1.263
+++ compiler/modes.m 19 Feb 2003 13:15:31 -0000
@@ -2162,8 +2162,8 @@
Goal) :-
module_info_get_predicate_table(ModuleInfo, PredicateTable),
list__length(ArgVars, Arity),
- predicate_table_search_pred_m_n_a(PredicateTable, Module, Name, Arity,
- [PredId]),
+ predicate_table_search_pred_m_n_a(PredicateTable, is_fully_qualified,
+ Module, Name, Arity, [PredId]),
hlds_pred__proc_id_to_int(ModeId, 0), % first mode
Call = call(PredId, ModeId, ArgVars, not_builtin, CallUnifyContext,
qualified(Module, Name)),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.230
diff -u -u -r1.230 polymorphism.m
--- compiler/polymorphism.m 27 Jan 2003 09:20:50 -0000 1.230
+++ compiler/polymorphism.m 20 Feb 2003 13:37:59 -0000
@@ -2405,37 +2405,10 @@
% does not need extra type_info arguments
% even though its declaration is polymorphic.
- % Make the goal for the call
- varset__init(DummyTVarSet0),
- varset__new_var(DummyTVarSet0, TCVar,
- DummyTVarSet),
- mercury_private_builtin_module(PrivateBuiltin),
- ExtractSuperClass = qualified(PrivateBuiltin,
- "superclass_from_typeclass_info"),
- construct_type(qualified(PrivateBuiltin,
- "typeclass_info") - 1,
- [term__variable(TCVar)],
- TypeClassInfoType),
- construct_type(unqualified("int") - 0, [], IntType),
- get_pred_id_and_proc_id(ExtractSuperClass, predicate,
- DummyTVarSet,
- [TypeClassInfoType, IntType, TypeClassInfoType],
- ModuleInfo, PredId, ProcId),
- Call = call(PredId, ProcId,
- [SubClassVar, IndexVar, Var],
- not_builtin, no,
- ExtractSuperClass
- ),
-
- % Make the goal info for the call
- set__list_to_set([SubClassVar, IndexVar, Var],
- NonLocals),
- goal_info_init(GoalInfo0),
- goal_info_set_nonlocals(GoalInfo0, NonLocals,
- GoalInfo),
-
- % Put them together
- SuperClassGoal = Call - GoalInfo,
+ goal_util__generate_simple_call(mercury_private_builtin_module,
+ "superclass_from_typeclass_info",
+ [SubClassVar, IndexVar, Var], only_mode, det, no,
+ [], ModuleInfo, term__context_init, SuperClassGoal),
% Add it to the accumulator
ExtraGoals = [SuperClassGoal,IndexGoal|ExtraGoals1]
@@ -2510,8 +2483,8 @@
% build a unification to add the argvars to the
% base_typeclass_info
- mercury_private_builtin_module(PrivateBuiltin),
- NewConsId = cons(qualified(PrivateBuiltin, "typeclass_info"), 1),
+ NewConsId = cons(qualified(mercury_private_builtin_module,
+ "typeclass_info"), 1),
NewArgVars = [BaseVar|ArgVars],
TypeClassInfoTerm = functor(NewConsId, no, NewArgVars),
@@ -2542,7 +2515,8 @@
% note that we could perhaps be more accurate than
% `ground(shared)', but it shouldn't make any
% difference.
- InstConsId = cons(qualified(PrivateBuiltin, "typeclass_info"),
+ InstConsId = cons(qualified(mercury_private_builtin_module,
+ "typeclass_info"),
NumArgVars),
instmap_delta_from_assoc_list(
[NewVar -
@@ -2924,18 +2898,19 @@
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_module(PredInfo, Module),
pred_info_name(PredInfo, Name),
- PredName = qualified(Module, Name)
+ PredName = qualified(Module, Name),
+ special_pred_mode_num(SpecialPredId, ProcInt),
+ proc_id_to_int(ProcId, ProcInt)
;
polymorphism__get_category_name(TypeCategory, CategoryName),
special_pred_name_arity(SpecialPredId, SpecialName, _, Arity),
string__append_list(
["builtin_", SpecialName, "_", CategoryName], Name),
- polymorphism__get_builtin_pred_id(Name, Arity, ModuleInfo,
- PredId),
- PredName = unqualified(Name)
- ),
- special_pred_mode_num(SpecialPredId, ProcInt),
- proc_id_to_int(ProcId, ProcInt).
+ lookup_builtin_pred_proc_id(ModuleInfo,
+ mercury_private_builtin_module, Name, Arity,
+ only_mode, PredId, ProcId),
+ PredName = qualified(mercury_private_builtin_module, Name)
+ ).
:- pred polymorphism__get_category_name(builtin_type, string).
:- mode polymorphism__get_category_name(in, out) is det.
@@ -2952,23 +2927,6 @@
polymorphism__get_category_name(user_type, _) :-
error("polymorphism__get_category_name: user_type").
- % find the builtin predicate with the specified name
-
-:- pred polymorphism__get_builtin_pred_id(string, int, module_info, pred_id).
-:- mode polymorphism__get_builtin_pred_id(in, in, in, out) is det.
-
-polymorphism__get_builtin_pred_id(Name, Arity, ModuleInfo, PredId) :-
- module_info_get_predicate_table(ModuleInfo, PredicateTable),
- (
- mercury_private_builtin_module(PrivateBuiltin),
- predicate_table_search_pred_m_n_a(PredicateTable,
- PrivateBuiltin, Name, Arity, [PredId1])
- ->
- PredId = PredId1
- ;
- error("polymorphism__get_builtin_pred_id: pred_id lookup failed")
- ).
-
% Create a unification for a type_info or type_ctor_info variable:
%
% TypeInfoVar = type_info(CountVar,
@@ -2992,7 +2950,7 @@
polymorphism__init_type_info_var(Type, ArgVars, Symbol, VarSet0, VarTypes0,
TypeInfoVar, TypeInfoGoal, VarSet, VarTypes) :-
- mercury_private_builtin_module(PrivateBuiltin),
+ PrivateBuiltin = mercury_private_builtin_module,
ConsId = cons(qualified(PrivateBuiltin, Symbol), 1),
TypeInfoTerm = functor(ConsId, no, ArgVars),
@@ -3178,29 +3136,6 @@
polymorphism__gen_extract_type_info(TypeVar, TypeClassInfoVar, Index,
ModuleInfo, Goals, TypeInfoVar,
VarSet0, VarTypes0, VarSet, VarTypes) :-
-
- % We need a tvarset to pass to get_pred_id_and_proc_id
- varset__init(DummyTVarSet0),
-
- mercury_private_builtin_module(PrivateBuiltin),
- ExtractTypeInfo = qualified(PrivateBuiltin,
- "type_info_from_typeclass_info"),
-
- % We pretend that the `constraint' field of the
- % `typeclass_info' type is a type variable for the purposes of
- % locating `private_builtin:type_info_from_typeclass_info'.
- varset__new_var(DummyTVarSet0, DummyTypeClassTVar, DummyTVarSet1),
- construct_type(qualified(PrivateBuiltin, "typeclass_info") - 1,
- [term__variable(DummyTypeClassTVar)], TypeClassInfoType),
-
- construct_type(unqualified("int") - 0, [], IntType),
-
- varset__new_var(DummyTVarSet1, DummyTVar, DummyTVarSet),
- polymorphism__build_type_info_type(term__variable(DummyTVar),
- TypeInfoType),
- get_pred_id_and_proc_id(ExtractTypeInfo, predicate, DummyTVarSet,
- [TypeClassInfoType, IntType, TypeInfoType],
- ModuleInfo, PredId, ProcId),
polymorphism__make_count_var(Index, VarSet0, VarTypes0, IndexVar,
IndexGoal, VarSet1, VarTypes1),
@@ -3209,20 +3144,13 @@
"type_info", typeinfo_prefix, VarSet1, VarTypes1,
TypeInfoVar, VarSet, VarTypes),
- % Make the goal info for the call.
- % `type_info_from_typeclass_info' does not require an extra
- % type_info argument even though its declaration is
- % polymorphic.
- set__list_to_set([TypeClassInfoVar, IndexVar, TypeInfoVar], NonLocals),
- instmap_delta_from_assoc_list([TypeInfoVar - ground(shared, none)],
- InstmapDelta),
- goal_info_init(NonLocals, InstmapDelta, det, GoalInfo),
-
- Call = call(PredId, ProcId,
- [TypeClassInfoVar, IndexVar, TypeInfoVar],
- not_builtin, no, ExtractTypeInfo) - GoalInfo,
+ goal_util__generate_simple_call(mercury_private_builtin_module,
+ "type_info_from_typeclass_info",
+ [TypeClassInfoVar, IndexVar, TypeInfoVar], only_mode, det, no,
+ [TypeInfoVar - ground(shared, none)], ModuleInfo,
+ term__context_init, CallGoal),
- Goals = [IndexGoal, Call].
+ Goals = [IndexGoal, CallGoal].
%-----------------------------------------------------------------------------%
@@ -3358,7 +3286,7 @@
% class constraint about which a typeclass_info holds information.
% `type_util:type_to_ctor_and_args' treats it as a type variable.
construct_qualified_term(SymName, [], ClassNameTerm),
- mercury_private_builtin_module(PrivateBuiltin),
+ PrivateBuiltin = mercury_private_builtin_module,
construct_qualified_term(qualified(PrivateBuiltin, "constraint"),
[ClassNameTerm | ArgTypes], ConstraintTerm),
@@ -3368,14 +3296,13 @@
%---------------------------------------------------------------------------%
polymorphism__typeclass_info_class_constraint(TypeClassInfoType, Constraint) :-
- mercury_private_builtin_module(PrivateBuiltin),
+ PrivateBuiltin = mercury_private_builtin_module,
type_to_ctor_and_args(TypeClassInfoType,
qualified(PrivateBuiltin, "typeclass_info") - 1,
[ConstraintTerm]),
% type_to_ctor_and_args fails on `constraint/n', so we use
% `sym_name_and_args' instead.
- mercury_private_builtin_module(PrivateBuiltin),
sym_name_and_args(ConstraintTerm,
qualified(PrivateBuiltin, "constraint"),
[ClassNameTerm | ArgTypes]),
@@ -3383,9 +3310,8 @@
Constraint = constraint(ClassName, ArgTypes).
polymorphism__type_info_type(TypeInfoType, Type) :-
- mercury_private_builtin_module(PrivateBuiltin),
type_to_ctor_and_args(TypeInfoType,
- qualified(PrivateBuiltin, "type_info") - 1,
+ qualified(mercury_private_builtin_module, "type_info") - 1,
[Type]).
polymorphism__build_type_info_type(Type, TypeInfoType) :-
@@ -3395,8 +3321,7 @@
:- mode polymorphism__build_type_info_type(in, in, out) is det.
polymorphism__build_type_info_type(Symbol, Type, TypeInfoType) :-
- mercury_private_builtin_module(PrivateBuiltin),
- construct_type(qualified(PrivateBuiltin, Symbol) - 1,
+ construct_type(qualified(mercury_private_builtin_module, Symbol) - 1,
[Type], TypeInfoType).
%---------------------------------------------------------------------------%
@@ -3404,8 +3329,7 @@
polymorphism__is_typeclass_info_manipulator(ModuleInfo,
PredId, TypeClassManipulator) :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
- mercury_private_builtin_module(PrivateBuiltin),
- pred_info_module(PredInfo, PrivateBuiltin),
+ pred_info_module(PredInfo, mercury_private_builtin_module),
pred_info_name(PredInfo, PredName),
(
PredName = "type_info_from_typeclass_info",
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.44
diff -u -u -r1.44 post_typecheck.m
--- compiler/post_typecheck.m 27 Jan 2003 09:20:50 -0000 1.44
+++ compiler/post_typecheck.m 20 Feb 2003 09:11:06 -0000
@@ -453,10 +453,11 @@
% have the specified name and arity
%
pred_info_typevarset(CallerPredInfo, TVarSet),
+ pred_info_import_status(CallerPredInfo, Status),
pred_info_clauses_info(CallerPredInfo, ClausesInfo),
clauses_info_vartypes(ClausesInfo, VarTypes),
map__apply_to_list(Args0, VarTypes, ArgTypes),
- typecheck__resolve_pred_overloading(ModuleInfo,
+ typecheck__resolve_pred_overloading(ModuleInfo, Status,
ArgTypes, TVarSet, PredName0, PredName, PredId)
;
PredId = PredId0,
@@ -628,7 +629,8 @@
EvalMethod \= normal
->
call(AdjustArgTypes, ArgTypes0, ArgTypes),
- typecheck__resolve_pred_overloading(ModuleInfo,
+ pred_info_import_status(CallerPredInfo, Status),
+ typecheck__resolve_pred_overloading(ModuleInfo, Status,
ArgTypes, TVarSet, SymName0, SymName, PredId)
;
error(
@@ -1235,8 +1237,10 @@
%
\+ pred_info_is_field_access_function(ModuleInfo, PredInfo0),
+ pred_info_import_status(PredInfo0, Status),
module_info_get_predicate_table(ModuleInfo, PredTable),
predicate_table_search_func_sym_arity(PredTable,
+ calls_are_fully_qualified(Status),
PredName, Arity, PredIds),
% Check if any of the candidate functions have
@@ -1287,8 +1291,9 @@
map__apply_to_list(ArgVars0, VarTypes0, ArgTypes0),
AllArgTypes = ArgTypes0 ++ HOArgTypes,
pred_info_typevarset(PredInfo0, TVarSet),
- get_pred_id(Name, PredOrFunc, TVarSet, AllArgTypes,
- ModuleInfo, PredId)
+ pred_info_import_status(PredInfo0, Status),
+ get_pred_id(calls_are_fully_qualified(Status), Name,
+ PredOrFunc, TVarSet, AllArgTypes, ModuleInfo, PredId)
->
get_proc_id(ModuleInfo, PredId, ProcId),
ConsId = pred_const(PredId, ProcId, EvalMethod),
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.217
diff -u -u -r1.217 prog_io.m
--- compiler/prog_io.m 12 Feb 2003 22:58:11 -0000 1.217
+++ compiler/prog_io.m 20 Feb 2003 10:31:08 -0000
@@ -1240,9 +1240,10 @@
Result0 = ok(module_defn(VarSet, implementation)),
check_no_attributes(Result0, Attributes, Result).
-process_decl(_ModuleName, VarSet, "external", [PredSpec], Attributes,
+process_decl(ModuleName, VarSet, "external", [PredSpec], Attributes,
Result) :-
- parse_symbol_name_specifier(PredSpec, Result0),
+ parse_implicitly_qualified_symbol_name_specifier(ModuleName,
+ PredSpec, Result0),
process_maybe1(make_external(VarSet), Result0, Result1),
check_no_attributes(Result1, Attributes, Result).
@@ -3358,6 +3359,15 @@
:- pred parse_symbol_name_specifier(term, maybe1(sym_name_specifier)).
:- mode parse_symbol_name_specifier(in, out) is det.
parse_symbol_name_specifier(Term, Result) :-
+ root_module_name(DefaultModule),
+ parse_implicitly_qualified_symbol_name_specifier(DefaultModule,
+ Term, Result).
+
+:- pred parse_implicitly_qualified_symbol_name_specifier(module_name,
+ term, maybe1(sym_name_specifier)).
+:- mode parse_implicitly_qualified_symbol_name_specifier(in, in, out) is det.
+
+parse_implicitly_qualified_symbol_name_specifier(DefaultModule, Term, Result) :-
( %%% some [NameTerm, ArityTerm, Context]
Term = term__functor(term__atom("/"), [NameTerm, ArityTerm], _Context)
->
@@ -3365,7 +3375,8 @@
ArityTerm = term__functor(term__integer(Arity), [], _Context2)
->
( Arity >= 0 ->
- parse_symbol_name(NameTerm, NameResult),
+ parse_implicitly_qualified_symbol_name(DefaultModule,
+ NameTerm, NameResult),
process_maybe1(make_name_arity_specifier(Arity), NameResult,
Result)
;
@@ -3375,7 +3386,8 @@
Result = error("arity in symbol name specifier must be an integer", Term)
)
;
- parse_symbol_name(Term, SymbolNameResult),
+ parse_implicitly_qualified_symbol_name(DefaultModule,
+ Term, SymbolNameResult),
process_maybe1(make_name_specifier, SymbolNameResult, Result)
).
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.59
diff -u -u -r1.59 prog_util.m
--- compiler/prog_util.m 17 Jan 2003 05:56:47 -0000 1.59
+++ compiler/prog_util.m 21 Feb 2003 06:19:03 -0000
@@ -23,8 +23,8 @@
% just "builtin", and it may eventually be renamed "std:builtin".
% This module is automatically imported, as if via `import_module'.
-:- pred mercury_public_builtin_module(sym_name).
-:- mode mercury_public_builtin_module(out) is det.
+:- pred mercury_public_builtin_module(sym_name::out) is det.
+:- func mercury_public_builtin_module = sym_name.
% Returns the name of the module containing private builtins;
% traditionally this was "mercury_builtin", but it later became
@@ -32,23 +32,23 @@
% "std:private_builtin".
% This module is automatically imported, as if via `use_module'.
-:- pred mercury_private_builtin_module(sym_name).
-:- mode mercury_private_builtin_module(out) is det.
+:- pred mercury_private_builtin_module(sym_name::out) is det.
+:- func mercury_private_builtin_module = sym_name.
% Returns the name of the module containing builtins for tabling;
% originally these were in "private_builtin", but they
% may soon be moved into a separate module.
% This module is automatically imported iff tabling is enabled.
-:- pred mercury_table_builtin_module(sym_name).
-:- mode mercury_table_builtin_module(out) is det.
+:- pred mercury_table_builtin_module(sym_name::out) is det.
+:- func mercury_table_builtin_module = sym_name.
% Returns the name of the module containing the builtins for
% deep profiling.
% This module is automatically imported iff deep profiling is
% enabled.
-:- pred mercury_profiling_builtin_module(sym_name).
-:- mode mercury_profiling_builtin_module(out) is det.
+:- pred mercury_profiling_builtin_module(sym_name::out) is det.
+:- func mercury_profiling_builtin_module = sym_name.
% Succeeds iff the specified module is one of the three
% builtin modules listed above which are automatically imported.
@@ -67,7 +67,7 @@
% Given a symbol name, return the module qualifier(s).
% If the symbol is unqualified, then return the specified default
% module name.
-
+ %
:- pred sym_name_get_module_name(sym_name, module_name, module_name).
:- mode sym_name_get_module_name(in, in, out) is det.
@@ -201,20 +201,23 @@
:- implementation.
:- import_module parse_tree__mercury_to_mercury, (parse_tree__inst).
-:- import_module bool, string, int, map, varset.
+:- import_module bool, require, string, int, map, varset.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% We may eventually want to put the standard library into a package "std":
-% mercury_public_builtin_module(M) :-
-% M = qualified(unqualified("std"), "builtin"))).
-% mercury_private_builtin_module(M) :-
-% M = qualified(unqualified("std"), "private_builtin"))).
-mercury_public_builtin_module(unqualified("builtin")).
-mercury_private_builtin_module(unqualified("private_builtin")).
-mercury_table_builtin_module(unqualified("table_builtin")).
-mercury_profiling_builtin_module(unqualified("profiling_builtin")).
+% mercury_public_builtin_module = qualified(unqualified("std"), "builtin").
+% mercury_private_builtin_module(M) =
+% qualified(unqualified("std"), "private_builtin"))).
+mercury_public_builtin_module = unqualified("builtin").
+mercury_public_builtin_module(mercury_public_builtin_module).
+mercury_private_builtin_module = unqualified("private_builtin").
+mercury_private_builtin_module(mercury_private_builtin_module).
+mercury_table_builtin_module = unqualified("table_builtin").
+mercury_table_builtin_module(mercury_table_builtin_module).
+mercury_profiling_builtin_module = unqualified("profiling_builtin").
+mercury_profiling_builtin_module(mercury_profiling_builtin_module).
any_mercury_builtin_module(Module) :-
( mercury_public_builtin_module(Module)
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.51
diff -u -u -r1.51 purity.m
--- compiler/purity.m 21 Feb 2003 01:54:40 -0000 1.51
+++ compiler/purity.m 21 Feb 2003 02:01:52 -0000
@@ -787,8 +787,11 @@
{ map__apply_to_list(Args, VarTypes, ArgTypes0) },
{ list__append(ArgTypes0, VarArgTypes, PredArgTypes) },
ModuleInfo =^ module_info,
+ CallerPredInfo =^ pred_info,
+ { pred_info_import_status(CallerPredInfo, CallerStatus) },
(
- { get_pred_id(PName, PredOrFunc, TVarSet, PredArgTypes,
+ { get_pred_id(calls_are_fully_qualified(CallerStatus),
+ PName, PredOrFunc, TVarSet, PredArgTypes,
ModuleInfo, CalleePredId) }
->
{ module_info_pred_info(ModuleInfo,
Index: compiler/recompilation.usage.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.usage.m,v
retrieving revision 1.5
diff -u -u -r1.5 recompilation.usage.m
--- compiler/recompilation.usage.m 27 Jan 2003 09:20:50 -0000 1.5
+++ compiler/recompilation.usage.m 20 Feb 2003 08:53:21 -0000
@@ -637,7 +637,8 @@
{ module_info_get_predicate_table(ModuleInfo, PredTable) },
{ adjust_func_arity(PredOrFunc, OrigArity, Arity) },
{ predicate_table_search_pf_sym_arity(PredTable,
- PredOrFunc, SymName, OrigArity, MatchingPredIds) }
+ may_be_partially_qualified, PredOrFunc, SymName,
+ OrigArity, MatchingPredIds) }
->
{ Recorded = yes },
{ PredModules = set__list_to_set(list__map(
@@ -733,7 +734,10 @@
% Is it a higher-order term or function call.
%
module_info_get_predicate_table(ModuleInfo, PredicateTable),
- ( predicate_table_search_sym(PredicateTable, SymName, PredIds) ->
+ (
+ predicate_table_search_sym(PredicateTable,
+ may_be_partially_qualified, SymName, PredIds)
+ ->
MatchingPreds = list__filter_map(
recompilation__usage__get_pred_or_func_ctors(ModuleInfo,
SymName, Arity),
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.110
diff -u -u -r1.110 simplify.m
--- compiler/simplify.m 11 Feb 2003 05:43:06 -0000 1.110
+++ compiler/simplify.m 20 Feb 2003 08:56:35 -0000
@@ -1371,25 +1371,10 @@
% convert higher-order unifications into calls to
% builtin_unify_pred (which calls error/1)
%
- { SymName = unqualified("builtin_unify_pred") },
- { ArgVars = [XVar, YVar] },
- { module_info_get_predicate_table(ModuleInfo,
- PredicateTable) },
- {
- mercury_private_builtin_module(PrivateBuiltin),
- predicate_table_search_pred_m_n_a(
- PredicateTable,
- PrivateBuiltin, "builtin_unify_pred", 2,
- [PredId0])
- ->
- PredId = PredId0
- ;
- error("can't locate private_builtin:builtin_unify_pred/2")
- },
- { hlds_pred__in_in_unification_proc_id(ProcId) },
- { CallContext = call_unify_context(XVar, var(YVar), Context) },
- { Call0 = call(PredId, ProcId, ArgVars, not_builtin,
- yes(CallContext), SymName) },
+ { goal_info_get_context(GoalInfo0, GContext) },
+ { generate_simple_call(mercury_private_builtin_module,
+ "builtin_unify_pred", [XVar, YVar], mode_no(0),
+ semidet, no, [], ModuleInfo, GContext, Call0 - _) },
simplify__goal_2(Call0, GoalInfo0, Call1, GoalInfo),
{ Call = Call1 - GoalInfo },
{ ExtraGoals = [] }
@@ -1459,35 +1444,13 @@
module_info::in, simplify_info::in, unify_context::in,
hlds_goal_info::in, hlds_goal::out) is det.
-simplify__call_generic_unify(TypeInfoVar, XVar, YVar, ModuleInfo, Info,
- Context, GoalInfo0, Call) :-
+simplify__call_generic_unify(TypeInfoVar, XVar, YVar, ModuleInfo, _,
+ _, GoalInfo, Call) :-
ArgVars = [TypeInfoVar, XVar, YVar],
- module_info_get_predicate_table(ModuleInfo, PredicateTable),
- mercury_public_builtin_module(MercuryBuiltin),
- ( predicate_table_search_pred_m_n_a(PredicateTable,
- MercuryBuiltin, "unify", 2, [CallPredId])
- ->
- PredId = CallPredId
- ;
- error("simplify.m: can't find `builtin:unify/2'")
- ),
- % Note: the mode for polymorphic unifications
- % should be `in, in'.
- % (This should have been checked by mode analysis.)
- hlds_pred__in_in_unification_proc_id(ProcId),
-
- SymName = qualified(MercuryBuiltin, "unify"),
-
- simplify_info_get_det_info(Info, DetInfo),
- det_info_get_pred_id(DetInfo, CallerPredId),
- code_util__builtin_state(ModuleInfo, CallerPredId,
- PredId, ProcId, BuiltinState),
- CallContext = call_unify_context(XVar, var(YVar), Context),
- goal_info_get_nonlocals(GoalInfo0, NonLocals0),
- set__insert(NonLocals0, TypeInfoVar, NonLocals),
- goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo),
- Call = call(PredId, ProcId, ArgVars, BuiltinState, yes(CallContext),
- SymName) - GoalInfo.
+ goal_info_get_context(GoalInfo, Context),
+ goal_util__generate_simple_call(mercury_public_builtin_module,
+ "unify", ArgVars, mode_no(0), semidet, no, [],
+ ModuleInfo, Context, Call).
:- pred simplify__call_specific_unify(type_ctor::in, list(prog_var)::in,
prog_var::in, prog_var::in, proc_id::in,
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.32
diff -u -u -r1.32 type_ctor_info.m
--- compiler/type_ctor_info.m 14 Jan 2003 16:42:30 -0000 1.32
+++ compiler/type_ctor_info.m 20 Feb 2003 08:55:28 -0000
@@ -149,20 +149,12 @@
proc_id_to_int(CompareProcId, CompareProcInt),
Compare = proc(ComparePredId, CompareProcId)
;
- module_info_get_predicate_table(ModuleInfo, PredTable),
- mercury_private_builtin_module(PrivateBuiltin),
- (
- predicate_table_search_pred_m_n_a(PredTable,
- PrivateBuiltin, "unused", 0, PredIds),
- PredIds = [PredId]
- ->
- get_proc_id(ModuleInfo, PredId, ProcId),
- Unused = proc(PredId, ProcId),
- Unify = Unused,
- Compare = Unused
- ;
- error("type_ctor_info__gen_type_ctor_gen_info: no unique unused predicate")
- )
+ lookup_builtin_pred_proc_id(ModuleInfo,
+ mercury_private_builtin_module, "unused", 0,
+ only_mode, PredId, ProcId),
+ Unused = proc(PredId, ProcId),
+ Unify = Unused,
+ Compare = Unused
),
TypeCtorGenInfo = type_ctor_gen_info(TypeCtor, ModuleName, TypeName,
TypeArity, Status, TypeDefn, Unify, Compare).
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.328
diff -u -u -r1.328 typecheck.m
--- compiler/typecheck.m 21 Feb 2003 01:54:40 -0000 1.328
+++ compiler/typecheck.m 21 Feb 2003 02:01:53 -0000
@@ -124,9 +124,10 @@
% Abort if there is no matching pred.
% Abort if there are multiple matching preds.
-:- pred typecheck__resolve_pred_overloading(module_info, list(type),
- tvarset, sym_name, sym_name, pred_id).
-:- mode typecheck__resolve_pred_overloading(in, in, in, in, out, out) is det.
+:- pred typecheck__resolve_pred_overloading(module_info, import_status,
+ list(type), tvarset, sym_name, sym_name, pred_id).
+:- mode typecheck__resolve_pred_overloading(in,
+ in, in, in, in, out, out) is det.
% Find a predicate or function from the list of pred_ids
% which matches the given name and argument types.
@@ -1686,6 +1687,8 @@
(
CallId = PorF - SymName/Arity,
predicate_table_search_pf_sym_arity(PredicateTable,
+ calls_are_fully_qualified(
+ TypeCheckInfo1 ^ import_status),
PorF, SymName, Arity, PredIdList)
->
% handle the case of a non-overloaded predicate specially
@@ -1787,6 +1790,8 @@
typecheck_info_get_io_state(TypeCheckInfo1, IOState0),
(
predicate_table_search_pf_sym(PredicateTable,
+ calls_are_fully_qualified(
+ TypeCheckInfo1 ^ import_status),
PredOrFunc0, SymName, OtherIds),
predicate_table_get_preds(PredicateTable, Preds),
OtherIds \= []
@@ -1799,6 +1804,8 @@
; PredOrFunc0 = function, PredOrFunc = predicate
),
predicate_table_search_pf_sym(PredicateTable,
+ calls_are_fully_qualified(
+ TypeCheckInfo1 ^ import_status),
PredOrFunc, SymName, OtherIds),
OtherIds \= []
->
@@ -1873,12 +1880,12 @@
% module qualified, so they should not be considered
% when resolving overloading.
-typecheck__resolve_pred_overloading(ModuleInfo, ArgTypes, TVarSet,
+typecheck__resolve_pred_overloading(ModuleInfo, Status, ArgTypes, TVarSet,
PredName0, PredName, PredId) :-
module_info_get_predicate_table(ModuleInfo, PredTable),
(
- predicate_table_search_pred_sym(PredTable, PredName0,
- PredIds0)
+ predicate_table_search_pred_sym(PredTable,
+ calls_are_fully_qualified(Status), PredName0, PredIds0)
->
PredIds = PredIds0
;
@@ -3029,7 +3036,12 @@
Functor = cons(SymName, _),
typecheck_info_get_module_info(TypeCheckInfo, ModuleInfo),
module_info_get_predicate_table(ModuleInfo, PredicateTable),
- ( predicate_table_search_sym(PredicateTable, SymName, PredIdList) ->
+ (
+ predicate_table_search_sym(PredicateTable,
+ calls_are_fully_qualified(
+ TypeCheckInfo ^ import_status),
+ SymName, PredIdList)
+ ->
predicate_table_get_preds(PredicateTable, Preds),
make_pred_cons_info_list(TypeCheckInfo, PredIdList, Preds,
Arity, ModuleInfo, [], PredConsInfoList)
@@ -3246,8 +3258,9 @@
unqualify_name(FuncName, UnqualFuncName),
(
TypeCheckInfo ^ is_field_access_function = no,
- \+ predicate_table_search_func_m_n_a(PredTable, TypeModule,
- UnqualFuncName, Arity, _)
+ \+ predicate_table_search_func_m_n_a(PredTable,
+ is_fully_qualified, TypeModule, UnqualFuncName,
+ Arity, _)
;
TypeCheckInfo ^ is_field_access_function = yes
),
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.114
diff -u -u -r1.114 unify_proc.m
--- compiler/unify_proc.m 12 Feb 2003 22:58:13 -0000 1.114
+++ compiler/unify_proc.m 20 Feb 2003 09:35:59 -0000
@@ -1542,7 +1542,6 @@
unify_proc__build_call(Name, ArgVars, Context, Goal) -->
unify_proc__info_get_module_info(ModuleInfo),
- { module_info_get_predicate_table(ModuleInfo, PredicateTable) },
{ list__length(ArgVars, Arity) },
%
% We assume that the special preds compare/3, index/2, and unify/2
@@ -1550,31 +1549,12 @@
% by this module.
%
{ special_pred_name_arity(_, Name, _, Arity) ->
- mercury_public_builtin_module(MercuryBuiltin)
+ MercuryBuiltin = mercury_public_builtin_module
;
- mercury_private_builtin_module(MercuryBuiltin)
+ MercuryBuiltin = mercury_private_builtin_module
},
- {
- predicate_table_search_pred_m_n_a(PredicateTable,
- MercuryBuiltin, Name, Arity, [PredIdPrime])
- ->
- PredId = PredIdPrime
- ;
- prog_out__sym_name_to_string(qualified(MercuryBuiltin, Name),
- QualName),
- string__int_to_string(Arity, ArityString),
- string__append_list(["unify_proc__build_call: ",
- "invalid/ambiguous pred `",
- QualName, "/", ArityString, "'"],
- ErrorMessage),
- error(ErrorMessage)
- },
- { hlds_pred__initial_proc_id(ProcId) },
- { Call = call(PredId, ProcId, ArgVars, not_builtin,
- no, qualified(MercuryBuiltin, Name)) },
- { goal_info_init(GoalInfo0) },
- { goal_info_set_context(GoalInfo0, Context, GoalInfo) },
- { Goal = Call - GoalInfo }.
+ { goal_util__generate_simple_call(MercuryBuiltin, Name, ArgVars,
+ mode_no(0), erroneous, no, [], ModuleInfo, Context, Goal) }.
:- pred unify_proc__build_specific_call((type)::in, special_pred_id::in,
list(prog_var)::in, instmap_delta::in, determinism::in,
Index: tests/valid/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mercury.options,v
retrieving revision 1.5
diff -u -u -r1.5 Mercury.options
--- tests/valid/Mercury.options 17 Feb 2003 06:07:15 -0000 1.5
+++ tests/valid/Mercury.options 21 Feb 2003 06:11:07 -0000
@@ -40,6 +40,8 @@
MCFLAGS-higher_order4 = -O3
MCFLAGS-higher_order_implied_mode = -O-1
MCFLAGS-inhibit_warn_test = --inhibit-warnings --halt-at-warn
+MCFLAGS-intermod_bug_nested = --intermodule-optimization
+MCFLAGS-intermod_bug_nested.parser = --intermodule-optimization
MCFLAGS-intermod_dcg_bug = --intermodule-optimization
MCFLAGS-intermod_dcg_bug2 = --intermodule-optimization
MCFLAGS-intermod_impure = --intermodule-optimization
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.124
diff -u -u -r1.124 Mmakefile
--- tests/valid/Mmakefile 17 Feb 2003 06:07:15 -0000 1.124
+++ tests/valid/Mmakefile 21 Feb 2003 06:08:36 -0000
@@ -93,6 +93,7 @@
inlining_bug \
inst_perf_bug_1 \
int64 \
+ intermod_bug_nested \
intermod_dcg_bug \
intermod_impure \
intermod_lambda \
@@ -138,6 +139,7 @@
multidet_test \
nasty_func_test \
nested_mod_type_bug \
+ nested_module_bug \
nondet_live \
parsing_bug_main \
pred_with_no_modes \
Index: tests/valid/intermod_bug_nested.m
===================================================================
RCS file: tests/valid/intermod_bug_nested.m
diff -N tests/valid/intermod_bug_nested.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/valid/intermod_bug_nested.m 21 Feb 2003 06:08:03 -0000
@@ -0,0 +1,36 @@
+% Test case for spurious errors if there are predicates
+% module1.p and module2.module1.p.
+%
+:- module intermod_bug_nested.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+:- import_module intermod_bug_nested.parser.
+
+main -->
+ { parse_tokens("foo", [1,2], List) },
+ io__write(List),
+ io__nl.
+
+ :- module intermod_bug_nested.parser.
+
+ :- interface.
+
+ :- pred parse_tokens(string::in, list(int)::in,
+ list(int)::out) is det.
+
+ :- implementation.
+
+ :- import_module term_io.
+
+ parse_tokens(_, X, X).
+
+ :- end_module intermod_bug_nested.parser.
+
Index: tests/valid/nested_module_bug.m
===================================================================
RCS file: tests/valid/nested_module_bug.m
diff -N tests/valid/nested_module_bug.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/valid/nested_module_bug.m 21 Feb 2003 00:44:27 -0000
@@ -0,0 +1,34 @@
+% Test case for spurious errors if there are predicates
+% module1.p and module2.module1.p.
+%
+:- module nested_module_bug.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list, parser.
+:- import_module nested_module_bug.parser.
+
+main -->
+ { parse_tokens("foo", [1,2], List) },
+ io__write(List),
+ io__nl.
+
+ :- module nested_module_bug.parser.
+
+ :- interface.
+
+ :- pred parse_tokens(string::in, list(int)::in,
+ list(int)::out) is det.
+
+ :- implementation.
+
+ parse_tokens(_, X, X).
+
+ :- end_module nested_module_bug.parser.
+
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list