[m-rev.] diff: pred_info and write_cons_id cleanup
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri May 21 08:17:54 AEST 2004
Cleanup of parts of hlds_pred.m and hlds_out.m.
compiler/hlds_pred.m.m:
Simplify the part of this file dealing with pred_infos. Order the
arguments of pred_info in a meaningful manner, put the declarations
and definitions of get/set predicates in the corresponding order,
and put the arguments of the predicates that create pred_infos
in the corresponding order.
Delete the cond field, since it won't be used in its current form.
compiler/hlds_out.m:
Redefine write_cons_id in terms of cons_id_to_string, since having both
definitions is a double maintenance problem. This also eliminates
the unnecessary differences between the two old definitions.
Fix an old FIXME: when printing clauses, don't print the goal
annotations that do not make sense in clauses. Print clause numbers
next to each clause to make confusion between clauses and procedures
even less likely.
compiler/prog_out.m:
Add function versions of some utility predicates for use by the new
version of cons_id_to_string.
compiler/*.m:
Conform to the changes in hlds_pred.m. In some cases, clean up nearby
code.
tests/invalid/purity/purity_nonsense.m:
Conform to the fact that write_cons_id doesn't now do unnecessary
quoting of a predicate name.
Zoltan.
cvs server: Diffing .
cvs server: Diffing analysis
cvs server: Diffing bindist
cvs server: Diffing boehm_gc
cvs server: Diffing boehm_gc/Mac_files
cvs server: Diffing boehm_gc/cord
cvs server: Diffing boehm_gc/cord/private
cvs server: Diffing boehm_gc/doc
cvs server: Diffing boehm_gc/include
cvs server: Diffing boehm_gc/include/private
cvs server: Diffing boehm_gc/tests
cvs server: Diffing browser
cvs server: Diffing bytecode
cvs server: Diffing compiler
Index: compiler/accumulator.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/accumulator.m,v
retrieving revision 1.29
diff -u -b -r1.29 accumulator.m
--- compiler/accumulator.m 14 May 2004 08:40:19 -0000 1.29
+++ compiler/accumulator.m 20 May 2004 22:06:17 -0000
@@ -1589,7 +1589,6 @@
ModuleName = pred_info_module(PredInfo),
Name = pred_info_name(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
- Cond = true,
pred_info_context(PredInfo, PredContext),
pred_info_get_markers(PredInfo, Markers),
pred_info_get_class_context(PredInfo, ClassContext),
@@ -1606,9 +1605,9 @@
make_pred_name_with_context(ModuleName, "AccFrom", PredOrFunc, Name,
Line, Counter, SymName),
- pred_info_create(ModuleName, SymName, TypeVarSet, ExistQVars, Types,
- Cond, PredContext, local, Markers, PredOrFunc, ClassContext,
- Owner, Assertions, NewProcInfo, NewProcId, NewPredInfo).
+ pred_info_create(ModuleName, SymName, PredOrFunc, PredContext,
+ local, Markers, Types, TypeVarSet, ExistQVars, ClassContext,
+ Assertions, Owner, NewProcInfo, NewProcId, NewPredInfo).
%-----------------------------------------------------------------------------%
Index: compiler/builtin_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/builtin_ops.m,v
retrieving revision 1.14
diff -u -b -r1.14 builtin_ops.m
--- compiler/builtin_ops.m 20 Oct 2003 07:29:04 -0000 1.14
+++ compiler/builtin_ops.m 20 May 2004 22:06:17 -0000
@@ -90,8 +90,7 @@
:- type array_elem_type
---> elem_type_string % ml_string_type
; elem_type_int % mlds__native_int_type
- ; elem_type_generic % mlds__generic_type
- .
+ ; elem_type_generic. % mlds__generic_type
% translate_builtin:
%
@@ -105,9 +104,8 @@
% in the code returned -- see below for details.
% (bytecode_gen.m depends on these guarantees.)
%
-:- pred translate_builtin(module_name, string, proc_id, list(T),
- simple_code(T)).
-:- mode translate_builtin(in, in, in, in, out(simple_code)) is semidet.
+:- pred translate_builtin(module_name::in, string::in, proc_id::in,
+ list(T)::in, simple_code(T)::out(simple_code)) is semidet.
:- type simple_code(T)
---> assign(T, simple_expr(T))
@@ -159,17 +157,17 @@
FullyQualifiedModule = unqualified(ModuleName),
builtin_translation(ModuleName, PredName, ProcInt, Args, Code).
-:- pred builtin_translation(string, string, int, list(T), simple_code(T)).
-:- mode builtin_translation(in, in, in, in, out) is semidet.
+:- pred builtin_translation(string::in, string::in, int::in, list(T)::in,
+ simple_code(T)::out) is semidet.
% Note that the code we generate for unsafe_type_cast is not
% type-correct. Back-ends that require type-correct intermediate
% code (e.g. the MLDS back-end) must handle unsafe_type_cast
% separately, rather than by calling builtin_translation.
-builtin_translation("private_builtin", "unsafe_type_cast", 0,
- [X, Y], assign(Y, leaf(X))).
-builtin_translation("builtin", "unsafe_promise_unique", 0,
- [X, Y], assign(Y, leaf(X))).
+builtin_translation("private_builtin", "unsafe_type_cast", 0, [X, Y],
+ assign(Y, leaf(X))).
+builtin_translation("builtin", "unsafe_promise_unique", 0, [X, Y],
+ assign(Y, leaf(X))).
builtin_translation("private_builtin", "builtin_int_gt", 0, [X, Y],
test(binary((>), leaf(X), leaf(Y)))).
@@ -217,6 +215,7 @@
assign(Y, binary((-), int_const(0), leaf(X)))).
builtin_translation("int", "\\", 0, [X, Y],
assign(Y, unary(bitwise_complement, leaf(X)))).
+
builtin_translation("int", ">", 0, [X, Y],
test(binary((>), leaf(X), leaf(Y)))).
builtin_translation("int", "<", 0, [X, Y],
@@ -238,6 +237,7 @@
assign(Y, leaf(X))).
builtin_translation("float", "-", 0, [X, Y],
assign(Y, binary(float_minus, float_const(0.0), leaf(X)))).
+
builtin_translation("float", ">", 0, [X, Y],
test(binary(float_gt, leaf(X), leaf(Y)))).
builtin_translation("float", "<", 0, [X, Y],
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.57
diff -u -b -r1.57 check_typeclass.m
--- compiler/check_typeclass.m 5 Apr 2004 05:06:45 -0000 1.57
+++ compiler/check_typeclass.m 20 May 2004 22:06:17 -0000
@@ -683,7 +683,6 @@
% Introduce a new predicate which calls the implementation
% given in the instance declaration.
- Cond = true,
map__init(Proofs),
add_marker(class_instance_method, Markers0, Markers1),
( InstancePredDefn = name(_) ->
@@ -710,10 +709,10 @@
PredArity, ArgTypes, Markers, Context, Status, ClausesInfo,
ModuleInfo0, ModuleInfo1, QualInfo0, QualInfo, !IO),
- pred_info_init(InstanceModuleName, PredName, PredArity, ArgTypeVars,
- ExistQVars, ArgTypes, Cond, Context, ClausesInfo, Status,
- Markers, none, PredOrFunc, ClassContext, Proofs, User,
- PredInfo0),
+ pred_info_init(InstanceModuleName, PredName, PredArity, PredOrFunc,
+ Context, Status, none, Markers,
+ ArgTypes, ArgTypeVars, ExistQVars, ClassContext, Proofs,
+ User, ClausesInfo, PredInfo0),
pred_info_set_clauses_info(ClausesInfo, PredInfo0, PredInfo1),
% Fill in some information in the pred_info which is
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.116
diff -u -b -r1.116 higher_order.m
--- compiler/higher_order.m 19 May 2004 03:59:10 -0000 1.116
+++ compiler/higher_order.m 20 May 2004 22:06:17 -0000
@@ -2511,9 +2511,9 @@
ClausesInfo = clauses_info(EmptyVarSet, EmptyVarTypes,
EmptyTVarNameMap, EmptyVarTypes, [], [],
EmptyTIMap, EmptyTCIMap, no),
- pred_info_init(PredModule, SymName, Arity, ArgTVarSet, ExistQVars,
- Types, true, Context, ClausesInfo, Status, MarkerList, GoalType,
- PredOrFunc, ClassContext, EmptyProofs, Owner, NewPredInfo0),
+ pred_info_init(PredModule, SymName, Arity, PredOrFunc, Context,
+ Status, GoalType, MarkerList, Types, ArgTVarSet, ExistQVars,
+ ClassContext, EmptyProofs, Owner, ClausesInfo, NewPredInfo0),
pred_info_set_typevarset(TypeVarSet, NewPredInfo0, NewPredInfo1),
module_info_get_predicate_table(ModuleInfo0, PredTable0),
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.330
diff -u -b -r1.330 hlds_out.m
--- compiler/hlds_out.m 19 May 2004 03:59:13 -0000 1.330
+++ compiler/hlds_out.m 20 May 2004 22:06:17 -0000
@@ -285,6 +285,9 @@
hlds_out__write_class_id(class_id(Name, Arity), !IO) :-
prog_out__write_sym_name_and_arity(Name / Arity, !IO).
+hlds_out__write_cons_id(ConsId, !IO) :-
+ io__write_string(hlds_out__cons_id_to_string(ConsId), !IO).
+
hlds_out__cons_id_to_string(cons(SymName, Arity)) = String :-
prog_out__sym_name_to_string(SymName, SymNameString0),
( string__contains_char(SymNameString0, '*') ->
@@ -297,60 +300,38 @@
string__append(Str0, CharStr, Str)
)
),
- string__foldl(Stuff, SymNameString0, "", SymNameString)
+ string__foldl(Stuff, SymNameString0, "", SymNameString1)
;
- SymNameString = SymNameString0
+ SymNameString1 = SymNameString0
),
+ SymNameString = term_io__escaped_string(SymNameString1),
string__int_to_string(Arity, ArityString),
string__append_list([SymNameString, "/", ArityString], String).
-
hlds_out__cons_id_to_string(int_const(Int)) = String :-
string__int_to_string(Int, String).
-
-hlds_out__cons_id_to_string(string_const(String)) = S :-
- string__append_list(["""", String, """"], S).
-
-hlds_out__cons_id_to_string(float_const(_)) = "<float>".
-hlds_out__cons_id_to_string(pred_const(_, _, _)) = "<pred>".
-hlds_out__cons_id_to_string(type_ctor_info_const(_, _, _)) =
- "<type_ctor_info>".
+hlds_out__cons_id_to_string(string_const(String)) =
+ term_io__quoted_string(String).
+hlds_out__cons_id_to_string(float_const(Float)) =
+ float_to_string(Float).
+hlds_out__cons_id_to_string(pred_const(PredId, ProcId, _)) =
+ "<pred " ++ int_to_string(pred_id_to_int(PredId)) ++
+ " proc " ++ int_to_string(proc_id_to_int(ProcId)) ++ ">".
+hlds_out__cons_id_to_string(type_ctor_info_const(Module, Ctor, Arity)) =
+ "<type_ctor_info " ++ sym_name_to_string(Module) ++ "." ++
+ Ctor ++ "/" ++ int_to_string(Arity) ++ ">".
hlds_out__cons_id_to_string(base_typeclass_info_const(_, _, _, _)) =
"<base_typeclass_info>".
hlds_out__cons_id_to_string(type_info_cell_constructor(_)) =
"<type_info_cell_constructor>".
hlds_out__cons_id_to_string(typeclass_info_cell_constructor) =
"<typeclass_info_cell_constructor>".
-hlds_out__cons_id_to_string(tabling_pointer_const(_, _)) =
- "<tabling_pointer>".
+hlds_out__cons_id_to_string(tabling_pointer_const(PredId, ProcId)) =
+ "<tabling_pointer " ++ int_to_string(pred_id_to_int(PredId)) ++
+ ", " ++ int_to_string(proc_id_to_int(ProcId)) ++ ">".
hlds_out__cons_id_to_string(deep_profiling_proc_layout(_)) =
"<deep_profiling_proc_layout>".
hlds_out__cons_id_to_string(table_io_decl(_)) = "<table_io_decl>".
-hlds_out__write_cons_id(cons(SymName, Arity)) -->
- prog_out__write_sym_name_and_arity(SymName / Arity).
-hlds_out__write_cons_id(int_const(Int)) -->
- io__write_int(Int).
-hlds_out__write_cons_id(string_const(String)) -->
- term_io__quote_string(String).
-hlds_out__write_cons_id(float_const(Float)) -->
- io__write_float(Float).
-hlds_out__write_cons_id(pred_const(_PredId, _ProcId, _)) -->
- io__write_string("<pred>").
-hlds_out__write_cons_id(type_ctor_info_const(_, _, _)) -->
- io__write_string("<type_ctor_info>").
-hlds_out__write_cons_id(base_typeclass_info_const(_, _, _, _)) -->
- io__write_string("<base_typeclass_info>").
-hlds_out__write_cons_id(type_info_cell_constructor(_)) -->
- io__write_string("<type_info_cell_constructor>").
-hlds_out__write_cons_id(typeclass_info_cell_constructor) -->
- io__write_string("<typeclass_info_cell_constructor>").
-hlds_out__write_cons_id(tabling_pointer_const(_, _)) -->
- io__write_string("<tabling_pointer>").
-hlds_out__write_cons_id(deep_profiling_proc_layout(_)) -->
- io__write_string("<deep_profiling_proc_layout>").
-hlds_out__write_cons_id(table_io_decl(_)) -->
- io__write_string("<table_io_decl>").
-
% The code of this predicate duplicates the functionality of
% hlds_error_util__describe_one_pred_name. Changes here should be made
% there as well.
@@ -1005,12 +986,12 @@
% XXX FIXME Never write the clauses out verbosely -
% disable the dump_hlds_options option before writing
% them, and restore its initial value afterwards
- % globals__io_set_option(dump_hlds_options, string("")),
+ set_dump_opts_for_clauses(SavedDumpString, !IO),
hlds_out__write_clauses(Indent, ModuleInfo, PredId,
VarSet, AppendVarnums, HeadVars, PredOrFunc,
- Clauses, no, !IO)
- % globals__io_set_option(dump_hlds_options,
- % string(Verbose), !IO)
+ Clauses, no, !IO),
+ globals__io_set_option(dump_hlds_options,
+ string(SavedDumpString), !IO)
;
true
),
@@ -1057,6 +1038,28 @@
ImportStatus, PredInfo, !IO),
io__write_string("\n", !IO).
+:- pred set_dump_opts_for_clauses(string::out, io::di, io::uo) is det.
+
+set_dump_opts_for_clauses(SavedDumpStr, !IO) :-
+ globals__io_lookup_string_option(dump_hlds_options, SavedDumpStr, !IO),
+ DumpStr0 = "",
+ ( string__contains_char(SavedDumpStr, 'c') ->
+ DumpStr1 = DumpStr0 ++ "c"
+ ;
+ DumpStr1 = DumpStr0
+ ),
+ ( string__contains_char(SavedDumpStr, 'n') ->
+ DumpStr2 = DumpStr1 ++ "n"
+ ;
+ DumpStr2 = DumpStr1
+ ),
+ ( string__contains_char(SavedDumpStr, 'v') ->
+ DumpStr = DumpStr2 ++ "v"
+ ;
+ DumpStr = DumpStr2
+ ),
+ globals__io_set_option(dump_hlds_options, string(DumpStr), !IO).
+
:- pred hlds_out__write_marker_list(list(marker)::in, io::di, io::uo) is det.
hlds_out__write_marker_list(Markers, !IO) :-
@@ -1126,17 +1129,30 @@
hlds_out__write_clauses(Indent, ModuleInfo, PredId, VarSet, AppendVarnums,
HeadVars, PredOrFunc, Clauses0, TypeQual, !IO) :-
+ hlds_out__write_clauses_2(Indent, ModuleInfo, PredId, VarSet,
+ AppendVarnums, HeadVars, PredOrFunc, Clauses0, TypeQual,
+ 1, !IO).
+
+:- pred hlds_out__write_clauses_2(int::in, module_info::in, pred_id::in,
+ prog_varset::in, bool::in, list(prog_var)::in, pred_or_func::in,
+ list(clause)::in, maybe_vartypes::in, int::in, io::di, io::uo) is det.
+
+hlds_out__write_clauses_2(Indent, ModuleInfo, PredId, VarSet, AppendVarnums,
+ HeadVars, PredOrFunc, Clauses0, TypeQual, ClauseNum, !IO) :-
(
Clauses0 = [Clause | Clauses]
->
term__var_list_to_term_list(HeadVars, HeadTerms),
UseDeclaredModes = no,
+ io__write_string("% clause ", !IO),
+ io__write_int(ClauseNum, !IO),
+ io__write_string("\n", !IO),
hlds_out__write_clause(Indent, ModuleInfo, PredId, VarSet,
AppendVarnums, HeadTerms, PredOrFunc,
Clause, UseDeclaredModes, TypeQual, !IO),
- hlds_out__write_clauses(Indent, ModuleInfo, PredId, VarSet,
+ hlds_out__write_clauses_2(Indent, ModuleInfo, PredId, VarSet,
AppendVarnums, HeadVars, PredOrFunc, Clauses, TypeQual,
- !IO)
+ ClauseNum + 1, !IO)
;
true
).
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.142
diff -u -b -r1.142 hlds_pred.m
--- compiler/hlds_pred.m 19 May 2004 03:59:15 -0000 1.142
+++ compiler/hlds_pred.m 20 May 2004 22:06:17 -0000
@@ -56,34 +56,44 @@
:- type pred_id.
:- type proc_id.
-:- func hlds_pred__initial_pred_id = pred_id.
-
-:- func hlds_pred__initial_proc_id = proc_id.
-
-:- pred hlds_pred__next_pred_id(pred_id::in, pred_id::out) is det.
+ % Predicate and procedure ids are abstract data types. One important
+ % advantage of this arrangement is to make it harder to accidentally
+ % use an integer in their place. However, you can convert between
+ % integers and pred_ids/proc_ids with the following predicates and
+ % functions.
:- pred pred_id_to_int(pred_id, int).
:- mode pred_id_to_int(in, out) is det.
:- mode pred_id_to_int(out, in) is det.
+:- func pred_id_to_int(pred_id) = int.
:- pred proc_id_to_int(proc_id, int).
:- mode proc_id_to_int(in, out) is det.
:- mode proc_id_to_int(out, in) is det.
+:- func proc_id_to_int(proc_id) = int.
- % For semidet complicated unifications with mode (in, in),
- % these are defined to have the same proc_id (0). This
- % returns that proc_id.
+ % Return the id of the first predicate in a module, and of the first
+ % procedure in a predicate.
-:- pred hlds_pred__in_in_unification_proc_id(proc_id::out) is det.
+:- func hlds_pred__initial_pred_id = pred_id.
+:- func hlds_pred__initial_proc_id = proc_id.
- % Return an invalid pred_id. Used to initialize the pred_id
- % in call(...) goals before we do typechecking or when type-checking
- % finds that there was no predicate which matched the call.
+ % Return an invalid predicate or procedure id. These are intended
+ % to be used to initialize the relevant fields in in call(...) goals
+ % before we do type- and mode-checks, or when those check find that
+ % there was no predicate matching the call.
:- func invalid_pred_id = pred_id.
-
:- func invalid_proc_id = proc_id.
+:- pred hlds_pred__next_pred_id(pred_id::in, pred_id::out) is det.
+
+ % For semidet complicated unifications with mode (in, in),
+ % these are defined to have the same proc_id (0). This
+ % returns that proc_id.
+
+:- pred hlds_pred__in_in_unification_proc_id(proc_id::out) is det.
+
:- type pred_info.
:- type proc_info.
@@ -248,7 +258,6 @@
:- pred clauses_info_set_typeclass_info_varmap(typeclass_info_varmap::in,
clauses_info::in, clauses_info::out) is det.
- % XXX we should use field names for clause
:- type clause --->
clause(
applicable_procs :: list(proc_id),
@@ -262,7 +271,8 @@
%-----------------------------------------------------------------------------%
-:- type implementation_language ---> mercury
+:- type implementation_language
+ ---> mercury
; foreign_language(foreign_language).
% The type of goals that have been given for a pred.
@@ -535,11 +545,10 @@
:- type pred_attributes.
:- type attribute
- ---> custom(type)
+ ---> custom(type).
% A custom attribute, indended to be associated
% with this predicate in the underlying
% implementation.
- .
% Aditi predicates are identified by their owner as well as
% module, name and arity.
@@ -605,6 +614,34 @@
:- pred type_info_locn_set_var(prog_var::in,
type_info_locn::in, type_info_locn::out) is det.
+ % pred_info_init(ModuleName, SymName, Arity, PredOrFunc, Context,
+ % Status, GoalType, Markers, ArgTypes, TypeVarSet, ExistQVars,
+ % ClassContext, ClassProofs, User, ClausesInfo, PredInfo)
+ %
+ % Return a pred_info whose fields are filled in from the information
+ % (direct and indirect) in the arguments, and from defaults.
+
+:- pred pred_info_init(module_name::in, sym_name::in, arity::in,
+ pred_or_func::in, prog_context::in, import_status::in, goal_type::in,
+ pred_markers::in, list(type)::in, tvarset::in, existq_tvars::in,
+ class_constraints::in, constraint_proof_map::in, aditi_owner::in,
+ clauses_info::in, pred_info::out) is det.
+
+ % pred_info_create(ModuleName, SymName, PredOrFunc, Context,
+ % Status, Markers, TypeVarSet, ExistQVars, ArgTypes,
+ % ClassContext, Assertions, User, ProcInfo, ProcId, PredInfo)
+ %
+ % Return a pred_info whose fields are filled in from the information
+ % (direct and indirect) in the arguments, and from defaults. The given
+ % proc_info becomes the only procedure of the predicate (currently)
+ % and its proc_id is returned as the second last argument.
+
+:- pred pred_info_create(module_name::in, sym_name::in, pred_or_func::in,
+ prog_context::in, import_status::in, pred_markers::in,
+ list(type)::in, tvarset::in, existq_tvars::in, class_constraints::in,
+ set(assert_id)::in, aditi_owner::in, proc_info::in, proc_id::out,
+ pred_info::out) is det.
+
% hlds_pred__define_new_pred(Goal, CallGoal, Args, ExtraArgs, InstMap,
% PredName, TVarSet, VarTypes, ClassContext, TVarMap, TCVarMap,
% VarSet, Markers, Owner, IsAddressTaken,
@@ -614,6 +651,7 @@
% call the created predicate. ExtraArgs is the list of extra
% type_infos and typeclass_infos required by typeinfo liveness
% which were added to the front of the argument list.
+
:- pred hlds_pred__define_new_pred(hlds_goal::in, hlds_goal::out,
list(prog_var)::in, list(prog_var)::out, instmap::in, string::in,
tvarset::in, vartypes::in, class_constraints::in, type_info_varmap::in,
@@ -624,26 +662,85 @@
% Various predicates for accessing the information stored in the
% pred_id and pred_info data structures.
-:- pred pred_info_init(module_name::in, sym_name::in, arity::in, tvarset::in,
- existq_tvars::in, list(type)::in, condition::in, prog_context::in,
- clauses_info::in, import_status::in, pred_markers::in, goal_type::in,
- pred_or_func::in, class_constraints::in, constraint_proof_map::in,
- aditi_owner::in, pred_info::out) is det.
-
-:- pred pred_info_create(module_name::in, sym_name::in, tvarset::in,
- existq_tvars::in, list(type)::in, condition::in, prog_context::in,
- import_status::in, pred_markers::in, pred_or_func::in,
- class_constraints::in, aditi_owner::in, set(assert_id)::in,
- proc_info::in, proc_id::out, pred_info::out) is det.
+:- type head_type_params == list(tvar).
:- func pred_info_module(pred_info) = module_name.
-
:- func pred_info_name(pred_info) = string.
% pred_info_arity returns the arity of the predicate
% *not* counting inserted type_info arguments for polymorphic preds.
:- func pred_info_arity(pred_info) = arity.
+ % N-ary functions are converted into N+1-ary predicates.
+ % (Clauses are converted in make_hlds, but calls to functions
+ % cannot be converted until after type-checking, once we have
+ % resolved overloading. So we do that during mode analysis.)
+ % The `is_pred_or_func' field of the pred_info records whether
+ % a pred_info is really for a predicate or whether it is for
+ % what was originally a function.
+:- func pred_info_is_pred_or_func(pred_info) = pred_or_func.
+
+:- pred pred_info_context(pred_info::in, prog_context::out) is det.
+:- pred pred_info_import_status(pred_info::in, import_status::out) is det.
+:- pred pred_info_get_goal_type(pred_info::in, goal_type::out) is det.
+:- pred pred_info_get_markers(pred_info::in, pred_markers::out) is det.
+:- pred pred_info_get_attributes(pred_info::in, pred_attributes::out) is det.
+:- pred pred_info_arg_types(pred_info::in, list(type)::out) is det.
+:- pred pred_info_typevarset(pred_info::in, tvarset::out) is det.
+:- pred pred_info_get_exist_quant_tvars(pred_info::in, existq_tvars::out)
+ is det.
+:- pred pred_info_get_head_type_params(pred_info::in, head_type_params::out)
+ is det.
+:- pred pred_info_get_class_context(pred_info::in, class_constraints::out)
+ is det.
+:- pred pred_info_get_constraint_proofs(pred_info::in,
+ constraint_proof_map::out) is det.
+:- pred pred_info_get_unproven_body_constraints(pred_info::in,
+ list(class_constraint)::out) is det.
+:- pred pred_info_get_maybe_special_pred(pred_info::in,
+ maybe(special_pred)::out) is det.
+:- pred pred_info_get_maybe_instance_method_constraints(pred_info::in,
+ maybe(instance_method_constraints)::out) is det.
+:- pred pred_info_get_assertions(pred_info::in, set(assert_id)::out) is det.
+:- pred pred_info_get_aditi_owner(pred_info::in, string::out) is det.
+:- pred pred_info_get_indexes(pred_info::in, list(index_spec)::out) is det.
+:- pred pred_info_clauses_info(pred_info::in, clauses_info::out) is det.
+:- pred pred_info_procedures(pred_info::in, proc_table::out) is det.
+
+:- pred pred_info_set_import_status(import_status::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_goal_type(goal_type::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_markers(pred_markers::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_attributes(pred_attributes::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_typevarset(tvarset::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_head_type_params(head_type_params::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_class_context(class_constraints::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_constraint_proofs(constraint_proof_map::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_unproven_body_constraints(list(class_constraint)::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_maybe_special_pred(maybe(special_pred)::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_maybe_instance_method_constraints(
+ maybe(instance_method_constraints)::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_assertions(set(assert_id)::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_aditi_owner(string::in, pred_info::in, pred_info::out)
+ is det.
+:- pred pred_info_set_indexes(list(index_spec)::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_clauses_info(clauses_info::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_procedures(proc_table::in,
+ pred_info::in, pred_info::out) is det.
+
% Return a list of all the proc_ids for the valid modes
% of this predicate. This does not include candidate modes
% that were generated during mode inference but which mode
@@ -671,48 +768,15 @@
:- pred pred_info_remove_procid(proc_id::in, pred_info::in, pred_info::out)
is det.
-:- pred pred_info_arg_types(pred_info::in, list(type)::out) is det.
-
:- pred pred_info_arg_types(pred_info::in, tvarset::out, existq_tvars::out,
list(type)::out) is det.
:- pred pred_info_set_arg_types(tvarset::in, existq_tvars::in, list(type)::in,
pred_info::in, pred_info::out) is det.
-:- pred pred_info_get_exist_quant_tvars(pred_info::in, existq_tvars::out)
- is det.
-
:- pred pred_info_get_univ_quant_tvars(pred_info::in, existq_tvars::out)
is det.
-:- type head_type_params == list(tvar).
-
-:- pred pred_info_get_head_type_params(pred_info::in, head_type_params::out)
- is det.
-
-:- pred pred_info_set_head_type_params(head_type_params::in,
- pred_info::in, pred_info::out) is det.
-
-:- pred pred_info_get_unproven_body_constraints(pred_info::in,
- list(class_constraint)::out) is det.
-
-:- pred pred_info_set_unproven_body_constraints(list(class_constraint)::in,
- pred_info::in, pred_info::out) is det.
-
-:- pred pred_info_clauses_info(pred_info::in, clauses_info::out) is det.
-
-:- pred pred_info_set_clauses_info(clauses_info::in,
- pred_info::in, pred_info::out) is det.
-
-:- pred pred_info_procedures(pred_info::in, proc_table::out) is det.
-
-:- pred pred_info_set_procedures(proc_table::in, pred_info::in, pred_info::out)
- is det.
-
-:- pred pred_info_context(pred_info::in, prog_context::out) is det.
-
-:- pred pred_info_import_status(pred_info::in, import_status::out) is det.
-
:- pred pred_info_is_imported(pred_info::in) is semidet.
:- pred pred_info_is_pseudo_imported(pred_info::in) is semidet.
@@ -738,16 +802,6 @@
:- pred pred_info_mark_as_external(pred_info::in, pred_info::out) is det.
-:- pred pred_info_set_import_status(import_status::in,
- pred_info::in, pred_info::out) is det.
-
-:- pred pred_info_typevarset(pred_info::in, tvarset::out) is det.
-
-:- pred pred_info_set_typevarset(tvarset::in, pred_info::in, pred_info::out)
- is det.
-
-:- pred pred_info_get_goal_type(pred_info::in, goal_type::out) is det.
-
% Do we have a clause goal type?
% (this means either "clauses" or "clauses_and_pragmas")
@@ -761,9 +815,6 @@
:- pred pred_info_update_goal_type(goal_type::in,
pred_info::in, pred_info::out) is det.
-:- pred pred_info_set_goal_type(goal_type::in, pred_info::in, pred_info::out)
- is det.
-
% Succeeds if there was a `:- pragma inline(...)' declaration
% for this predicate. Note that the compiler may decide
% to inline a predicate even if there was no pragma inline(...)
@@ -776,56 +827,6 @@
:- pred pred_info_requested_no_inlining(pred_info::in) is semidet.
- % N-ary functions are converted into N+1-ary predicates.
- % (Clauses are converted in make_hlds, but calls to functions
- % cannot be converted until after type-checking, once we have
- % resolved overloading. So we do that during mode analysis.)
- % The `is_pred_or_func' field of the pred_info records whether
- % a pred_info is really for a predicate or whether it is for
- % what was originally a function.
-
-:- func pred_info_is_pred_or_func(pred_info) = pred_or_func.
-
-:- pred pred_info_get_class_context(pred_info::in, class_constraints::out)
- is det.
-
-:- pred pred_info_set_class_context(class_constraints::in,
- pred_info::in, pred_info::out) is det.
-
-:- pred pred_info_get_constraint_proofs(pred_info::in,
- constraint_proof_map::out) is det.
-
-:- pred pred_info_set_constraint_proofs(constraint_proof_map::in,
- pred_info::in, pred_info::out) is det.
-
-:- pred pred_info_get_aditi_owner(pred_info::in, string::out) is det.
-
-:- pred pred_info_set_aditi_owner(string::in, pred_info::in, pred_info::out)
- is det.
-
-:- pred pred_info_get_indexes(pred_info::in, list(index_spec)::out) is det.
-
-:- pred pred_info_set_indexes(list(index_spec)::in,
- pred_info::in, pred_info::out) is det.
-
-:- pred pred_info_get_assertions(pred_info::in, set(assert_id)::out) is det.
-
-:- pred pred_info_set_assertions(set(assert_id)::in,
- pred_info::in, pred_info::out) is det.
-
-:- pred pred_info_get_maybe_special_pred(pred_info::in,
- maybe(special_pred)::out) is det.
-
-:- pred pred_info_set_maybe_special_pred(maybe(special_pred)::in,
- pred_info::in, pred_info::out) is det.
-
-:- pred pred_info_get_maybe_instance_method_constraints(pred_info::in,
- maybe(instance_method_constraints)::out) is det.
-
-:- pred pred_info_set_maybe_instance_method_constraints(
- maybe(instance_method_constraints)::in, pred_info::in, pred_info::out)
- is det.
-
:- pred pred_info_get_purity(pred_info::in, purity::out) is det.
:- pred pred_info_get_promised_purity(pred_info::in, purity::out) is det.
@@ -834,16 +835,6 @@
:- pred terminates_to_markers(terminates::in, pred_markers::out) is det.
-:- pred pred_info_get_markers(pred_info::in, pred_markers::out) is det.
-
-:- pred pred_info_set_markers(pred_markers::in, pred_info::in, pred_info::out)
- is det.
-
-:- pred pred_info_get_attributes(pred_info::in, pred_attributes::out) is det.
-
-:- pred pred_info_set_attributes(pred_attributes::in,
- pred_info::in, pred_info::out) is det.
-
:- pred pred_info_get_call_id(pred_info::in, simple_call_id::out) is det.
% create an empty set of markers
@@ -891,23 +882,23 @@
:- type pred_id == int.
:- type proc_id == int.
-hlds_pred__initial_pred_id = 0.
-
-hlds_pred__initial_proc_id = 0.
-
-hlds_pred__next_pred_id(PredId, NextPredId) :-
- NextPredId = PredId + 1.
-
pred_id_to_int(PredId, PredId).
+pred_id_to_int(PredId) = PredId.
proc_id_to_int(ProcId, ProcId).
+proc_id_to_int(ProcId) = ProcId.
-hlds_pred__in_in_unification_proc_id(0).
+hlds_pred__initial_pred_id = 0.
+hlds_pred__initial_proc_id = 0.
invalid_pred_id = -1.
-
invalid_proc_id = -1.
+hlds_pred__next_pred_id(PredId, NextPredId) :-
+ NextPredId = PredId + 1.
+
+hlds_pred__in_in_unification_proc_id(0).
+
status_is_exported(imported(_), no).
status_is_exported(external(_), no).
status_is_exported(abstract_imported, no).
@@ -953,6 +944,8 @@
may_be_partially_qualified
).
+%-----------------------------------------------------------------------------%
+
% The information specific to a predicate, as opposed to a procedure.
% (Functions count as predicates.)
%
@@ -962,25 +955,8 @@
% values of those type_info-related variables;
% accurate GC for the MLDS back-end relies on this.
:- type pred_info --->
- predicate(
- decl_typevarset :: tvarset,
- % names of type vars
- % in the predicate's type decl
- arg_types :: list(type),
- % argument types
- condition :: condition,
- % formal specification
- % (not used)
-
- clauses_info :: clauses_info,
-
- procedures :: proc_table,
-
- context :: prog_context,
- % the location (line #)
- % of the :- pred decl.
-
- (module) :: module_name,
+ pred_info(
+ module_name :: module_name,
% module in which pred occurs
name :: string,
% predicate name
@@ -988,33 +964,33 @@
% the arity of the pred
% (*not* counting any inserted
% type_info arguments)
+ is_pred_or_func :: pred_or_func,
+ % whether this "predicate" was really
+ % a predicate or a function
+ context :: prog_context,
+ % the location (line #) of the :- pred decl.
+
import_status :: import_status,
- typevarset :: tvarset,
- % names of type vars
- % in the predicate's type decl
- % or in the variable type assignments
goal_type :: goal_type,
- % whether the goals seen so far for
- % this pred are clauses,
- % pragma foreign_code(...) decs, or none
+ % whether the goals seen so far, if any,
+ % for this predicate are clauses or
+ % pragma foreign_code(...) declarations
+
markers :: pred_markers,
% various boolean flags
attributes :: pred_attributes,
% various attributes
- is_pred_or_func :: pred_or_func,
- % whether this "predicate" was really
- % a predicate or a function
- class_context :: class_constraints,
- % the class constraints on the
- % type variables in the predicate's
- % type declaration
- constraint_proofs :: constraint_proof_map,
- % explanations of how redundant
- % constraints were eliminated. These
- % are needed by polymorphism.m to
- % work out where to get the
- % typeclass_infos from.
- % Computed during type checking.
+
+ arg_types :: list(type),
+ % argument types
+ decl_typevarset :: tvarset,
+ % names of type vars
+ % in the predicate's type decl
+ typevarset :: tvarset,
+ % names of type vars
+ % in the predicate's type decl
+ % or in the variable type assignments
+
exist_quant_tvars :: existq_tvars,
% the set of existentially quantified
% type variables in the predicate's
@@ -1031,6 +1007,18 @@
% (the type_infos are returned from
% the called preds).
% Computed during type checking.
+
+ class_context :: class_constraints,
+ % the class constraints on the
+ % type variables in the predicate's
+ % type declaration
+ constraint_proofs :: constraint_proof_map,
+ % explanations of how redundant
+ % constraints were eliminated. These
+ % are needed by polymorphism.m to
+ % work out where to get the
+ % typeclass_infos from.
+ % Computed during type checking.
unproven_body_constraints :: list(class_constraint),
% unproven class constraints on type
% variables in the predicate's body,
@@ -1038,24 +1026,13 @@
% after type checking has finished,
% post_typecheck.m will report a type
% error).
- aditi_owner :: aditi_owner,
- % The owner of this predicate if
- % it is an Aditi predicate. Set to
- % the value of --aditi-user if no
- % `:- pragma owner' declaration exists.
- indexes :: list(index_spec),
- % Indexes if this predicate is
- % an Aditi base relation, ignored
- % otherwise.
- assertions :: set(assert_id),
- % List of assertions which
- % mention this predicate.
+
maybe_special_pred :: maybe(special_pred),
% If the predicate is a unify, compare
% or index predicate, specify which
% one, and for which type constructor.
maybe_instance_method_constraints
- :: maybe(instance_method_constraints)
+ :: maybe(instance_method_constraints),
% If this predicate is a class method
% implementation, record extra
% information about the class context
@@ -1063,64 +1040,225 @@
% correctly set up the extra
% type_info and typeclass_info
% arguments.
+
+ assertions :: set(assert_id),
+ % List of assertions which
+ % mention this predicate.
+
+ aditi_owner :: aditi_owner,
+ % The owner of this predicate if
+ % it is an Aditi predicate. Set to
+ % the value of --aditi-user if no
+ % `:- pragma owner' declaration exists.
+ indexes :: list(index_spec),
+ % Indexes if this predicate is
+ % an Aditi base relation, ignored
+ % otherwise.
+
+ clauses_info :: clauses_info,
+ procedures :: proc_table
).
-pred_info_init(ModuleName, SymName, Arity, TypeVarSet, ExistQVars, Types,
- Cond, Context, ClausesInfo, Status, Markers, GoalType,
- PredOrFunc, ClassContext, ClassProofs, User, PredInfo) :-
- map__init(Procs),
+pred_info_init(ModuleName, SymName, Arity, PredOrFunc, Context,
+ Status, GoalType, Markers, ArgTypes, TypeVarSet, ExistQVars,
+ ClassContext, ClassProofs, User, ClausesInfo, PredInfo) :-
unqualify_name(SymName, PredName),
sym_name_get_module_name(SymName, ModuleName, PredModuleName),
- term__vars_list(Types, TVars),
+ term__vars_list(ArgTypes, TVars),
list__delete_elems(TVars, ExistQVars, HeadTypeParams),
Attributes = [],
UnprovenBodyConstraints = [],
- Indexes = [],
- set__init(Assertions),
MaybeUCI = no,
MaybeInstanceConstraints = no,
- PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
- Context, PredModuleName, PredName, Arity, Status, TypeVarSet,
- GoalType, Markers, Attributes, PredOrFunc, ClassContext,
- ClassProofs, ExistQVars, HeadTypeParams,
- UnprovenBodyConstraints, User, Indexes, Assertions,
- MaybeUCI, MaybeInstanceConstraints).
-
-pred_info_create(ModuleName, SymName, TypeVarSet, ExistQVars, Types, Cond,
- Context, Status, Markers, PredOrFunc, ClassContext, User,
- Assertions, ProcInfo, ProcId, PredInfo) :-
- map__init(Procs0),
- proc_info_declared_determinism(ProcInfo, MaybeDetism),
- next_mode_id(Procs0, MaybeDetism, ProcId),
- map__det_insert(Procs0, ProcId, ProcInfo, Procs),
- list__length(Types, Arity),
+ set__init(Assertions),
+ Indexes = [],
+ map__init(Procs),
+ PredInfo = pred_info(PredModuleName, PredName, Arity, PredOrFunc,
+ Context, Status, GoalType, Markers, Attributes,
+ ArgTypes, TypeVarSet, TypeVarSet, ExistQVars, HeadTypeParams,
+ ClassContext, ClassProofs, UnprovenBodyConstraints,
+ MaybeUCI, MaybeInstanceConstraints, Assertions,
+ User, Indexes, ClausesInfo, Procs).
+
+pred_info_create(ModuleName, SymName, PredOrFunc, Context, Status, Markers,
+ ArgTypes, TypeVarSet, ExistQVars, ClassContext, Assertions,
+ User, ProcInfo, ProcId, PredInfo) :-
+ list__length(ArgTypes, Arity),
proc_info_varset(ProcInfo, VarSet),
proc_info_vartypes(ProcInfo, VarTypes),
proc_info_headvars(ProcInfo, HeadVars),
- proc_info_typeinfo_varmap(ProcInfo, TypeInfoMap),
- proc_info_typeclass_info_varmap(ProcInfo, TypeClassInfoMap),
unqualify_name(SymName, PredName),
- % The empty list of clauses is a little white lie.
- Clauses = [],
Attributes = [],
- map__init(TVarNameMap),
- HasForeignClauses = no,
- ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap,
- VarTypes, HeadVars, Clauses, TypeInfoMap, TypeClassInfoMap,
- HasForeignClauses),
map__init(ClassProofs),
- term__vars_list(Types, TVars),
+ term__vars_list(ArgTypes, TVars),
list__delete_elems(TVars, ExistQVars, HeadTypeParams),
UnprovenBodyConstraints = [],
Indexes = [],
MaybeUCI = no,
MaybeInstanceConstraints = no,
- PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
- Context, ModuleName, PredName, Arity, Status, TypeVarSet,
- clauses, Markers, Attributes, PredOrFunc, ClassContext,
- ClassProofs, ExistQVars, HeadTypeParams,
- UnprovenBodyConstraints, User, Indexes, Assertions,
- MaybeUCI, MaybeInstanceConstraints).
+
+ % The empty list of clauses is a little white lie.
+ Clauses = [],
+ map__init(TVarNameMap),
+ proc_info_typeinfo_varmap(ProcInfo, TypeInfoMap),
+ proc_info_typeclass_info_varmap(ProcInfo, TypeClassInfoMap),
+ HasForeignClauses = no,
+ ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap,
+ VarTypes, HeadVars, Clauses, TypeInfoMap, TypeClassInfoMap,
+ HasForeignClauses),
+
+ proc_info_declared_determinism(ProcInfo, MaybeDetism),
+ map__init(Procs0),
+ next_mode_id(Procs0, MaybeDetism, ProcId),
+ map__det_insert(Procs0, ProcId, ProcInfo, Procs),
+
+ PredInfo = pred_info(ModuleName, PredName, Arity, PredOrFunc,
+ Context, Status, clauses, Markers, Attributes,
+ ArgTypes, TypeVarSet, TypeVarSet, ExistQVars, HeadTypeParams,
+ ClassContext, ClassProofs, UnprovenBodyConstraints,
+ MaybeUCI, MaybeInstanceConstraints, Assertions,
+ User, Indexes, ClausesInfo, Procs).
+
+hlds_pred__define_new_pred(Goal0, Goal, ArgVars0, ExtraTypeInfos, InstMap0,
+ PredName, TVarSet, VarTypes0, ClassContext, TVarMap, TCVarMap,
+ VarSet0, InstVarSet, Markers, Owner, IsAddressTaken,
+ ModuleInfo0, ModuleInfo, PredProcId) :-
+ Goal0 = _GoalExpr - GoalInfo,
+ goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
+ instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap),
+
+ % XXX The set of existentially quantified type variables
+ % here might not be correct.
+ ExistQVars = [],
+
+ % If interface typeinfo liveness is set, all type_infos for the
+ % arguments need to be passed in, not just the ones that are used.
+ % Similarly if the address of a procedure of this predicate is taken,
+ % so that we can copy the closure.
+ module_info_globals(ModuleInfo0, Globals),
+ ExportStatus = local,
+ non_special_interface_should_use_typeinfo_liveness(ExportStatus,
+ IsAddressTaken, Globals, TypeInfoLiveness),
+ ( TypeInfoLiveness = yes ->
+ goal_info_get_nonlocals(GoalInfo, NonLocals),
+ goal_util__extra_nonlocal_typeinfos(TVarMap, TCVarMap,
+ VarTypes0, ExistQVars, NonLocals, ExtraTypeInfos0),
+ set__delete_list(ExtraTypeInfos0, ArgVars0, ExtraTypeInfos1),
+ set__to_sorted_list(ExtraTypeInfos1, ExtraTypeInfos),
+ list__append(ExtraTypeInfos, ArgVars0, ArgVars)
+ ;
+ ArgVars = ArgVars0,
+ ExtraTypeInfos = []
+ ),
+
+ goal_info_get_context(GoalInfo, Context),
+ goal_info_get_determinism(GoalInfo, Detism),
+ compute_arg_types_modes(ArgVars, VarTypes0, InstMap0, InstMap,
+ ArgTypes, ArgModes),
+
+ module_info_name(ModuleInfo0, ModuleName),
+ SymName = qualified(ModuleName, PredName),
+
+ % Remove unneeded variables from the vartypes and varset.
+ goal_util__goal_vars(Goal0, GoalVars0),
+ set__insert_list(GoalVars0, ArgVars, GoalVars),
+ map__select(VarTypes0, GoalVars, VarTypes),
+ varset__select(VarSet0, GoalVars, VarSet),
+
+ % Approximate the termination information
+ % for the new procedure.
+ ( goal_cannot_loop(ModuleInfo0, Goal0) ->
+ TermInfo = yes(cannot_loop)
+ ;
+ TermInfo = no
+ ),
+
+ MaybeDeclaredDetism = no,
+ proc_info_create(VarSet, VarTypes, ArgVars, ArgModes, InstVarSet,
+ MaybeDeclaredDetism, Detism, Goal0, Context,
+ TVarMap, TCVarMap, IsAddressTaken, ProcInfo0),
+ proc_info_set_maybe_termination_info(TermInfo, ProcInfo0, ProcInfo),
+
+ set__init(Assertions),
+
+ pred_info_create(ModuleName, SymName, predicate, Context,
+ ExportStatus, Markers, ArgTypes, TVarSet, ExistQVars,
+ ClassContext, Assertions, Owner, ProcInfo, ProcId, PredInfo),
+
+ module_info_get_predicate_table(ModuleInfo0, PredTable0),
+ predicate_table_insert(PredInfo, PredId, PredTable0, PredTable),
+ module_info_set_predicate_table(PredTable, ModuleInfo0, ModuleInfo),
+
+ GoalExpr = call(PredId, ProcId, ArgVars, not_builtin, no, SymName),
+ Goal = GoalExpr - GoalInfo,
+ PredProcId = proc(PredId, ProcId).
+
+:- pred compute_arg_types_modes(list(prog_var)::in, vartypes::in,
+ instmap::in, instmap::in, list(type)::out, list(mode)::out) is det.
+
+compute_arg_types_modes([], _, _, _, [], []).
+compute_arg_types_modes([Var | Vars], VarTypes, InstMap0, InstMap,
+ [Type | Types], [Mode | Modes]) :-
+ map__lookup(VarTypes, Var, Type),
+ instmap__lookup_var(InstMap0, Var, Inst0),
+ instmap__lookup_var(InstMap, Var, Inst),
+ Mode = (Inst0 -> Inst),
+ compute_arg_types_modes(Vars, VarTypes, InstMap0, InstMap,
+ Types, Modes).
+
+%-----------------------------------------------------------------------------%
+
+% The trivial access predicates.
+
+pred_info_module(PI) = PI ^ module_name.
+pred_info_name(PI) = PI ^ name.
+pred_info_arity(PI) = PI ^ arity.
+
+pred_info_is_pred_or_func(PI) = PI ^ is_pred_or_func.
+pred_info_context(PI, PI ^ context).
+pred_info_import_status(PI, PI ^ import_status).
+pred_info_get_goal_type(PI, PI ^ goal_type).
+pred_info_get_markers(PI, PI ^ markers).
+pred_info_get_attributes(PI, PI ^ attributes).
+pred_info_arg_types(PI, PI ^ arg_types).
+pred_info_typevarset(PI, PI ^ typevarset).
+pred_info_get_exist_quant_tvars(PI, PI ^ exist_quant_tvars).
+pred_info_get_head_type_params(PI, PI ^ head_type_params).
+pred_info_get_class_context(PI, PI ^ class_context).
+pred_info_get_constraint_proofs(PI, PI ^ constraint_proofs).
+pred_info_get_unproven_body_constraints(PI, PI ^ unproven_body_constraints).
+pred_info_get_maybe_special_pred(PI, PI ^ maybe_special_pred).
+pred_info_get_maybe_instance_method_constraints(PI,
+ PI ^ maybe_instance_method_constraints).
+pred_info_get_assertions(PI, PI ^ assertions).
+pred_info_get_aditi_owner(PI, PI ^ aditi_owner).
+pred_info_get_indexes(PI, PI ^ indexes).
+pred_info_clauses_info(PI, PI ^ clauses_info).
+pred_info_procedures(PI, PI ^ procedures).
+
+pred_info_set_import_status(X, PI, PI ^ import_status := X).
+pred_info_set_goal_type(X, PI, PI ^ goal_type := X).
+pred_info_set_markers(X, PI, PI ^ markers := X).
+pred_info_set_attributes(X, PI, PI ^ attributes := X).
+pred_info_set_typevarset(X, PI, PI ^ typevarset := X).
+pred_info_set_head_type_params(X, PI, PI ^ head_type_params := X).
+pred_info_set_class_context(X, PI, PI ^ class_context := X).
+pred_info_set_constraint_proofs(X, PI, PI ^ constraint_proofs := X).
+pred_info_set_unproven_body_constraints(X, PI,
+ PI ^ unproven_body_constraints := X).
+pred_info_set_maybe_special_pred(X, PI,
+ PI ^ maybe_special_pred := X).
+pred_info_set_maybe_instance_method_constraints(X, PI,
+ PI ^ maybe_instance_method_constraints := X).
+pred_info_set_assertions(X, PI, PI ^ assertions := X).
+pred_info_set_aditi_owner(X, PI, PI ^ aditi_owner := X).
+pred_info_set_indexes(X, PI, PI ^ indexes := X).
+pred_info_set_clauses_info(X, PI, PI ^ clauses_info := X).
+pred_info_set_procedures(X, PI, PI ^ procedures := X).
+
+%-----------------------------------------------------------------------------%
+
+% The non-trivial access predicates.
pred_info_all_procids(PredInfo) = ProcIds :-
ProcTable = PredInfo ^ procedures,
@@ -1184,13 +1322,6 @@
map__delete(Procs0, ProcId, Procs),
pred_info_set_procedures(Procs, !PredInfo).
-pred_info_clauses_info(PredInfo, PredInfo ^ clauses_info).
-
-pred_info_set_clauses_info(X, PredInfo, PredInfo ^ clauses_info := X).
-
-pred_info_arg_types(PredInfo, ArgTypes) :-
- pred_info_arg_types(PredInfo, _TypeVars, _ExistQVars, ArgTypes).
-
pred_info_arg_types(PredInfo, PredInfo ^ decl_typevarset,
PredInfo ^ exist_quant_tvars, PredInfo ^ arg_types).
@@ -1200,20 +1331,6 @@
^ exist_quant_tvars := ExistQVars)
^ arg_types := ArgTypes.
-pred_info_procedures(PredInfo, PredInfo ^ procedures).
-
-pred_info_set_procedures(X, PredInfo, PredInfo ^ procedures := X).
-
-pred_info_context(PredInfo, PredInfo ^ context).
-
-pred_info_module(PredInfo) = PredInfo ^ (module).
-
-pred_info_name(PredInfo) = PredInfo ^ name.
-
-pred_info_arity(PredInfo) = PredInfo ^ arity.
-
-pred_info_import_status(PredInfo, PredInfo ^ import_status).
-
pred_info_is_imported(PredInfo) :-
pred_info_import_status(PredInfo, Status),
( Status = imported(_)
@@ -1282,14 +1399,6 @@
PredInfo = PredInfo0 ^ import_status :=
external(PredInfo0 ^ import_status).
-pred_info_set_import_status(X, PredInfo, PredInfo ^ import_status := X).
-
-pred_info_typevarset(PredInfo, PredInfo ^ typevarset).
-
-pred_info_set_typevarset(X, PredInfo, PredInfo ^ typevarset := X).
-
-pred_info_get_goal_type(PredInfo, PredInfo ^ goal_type).
-
pred_info_clause_goal_type(PredInfo) :-
clause_goal_type(PredInfo ^ goal_type).
@@ -1333,8 +1442,6 @@
),
pred_info_set_goal_type(GoalType, !PredInfo).
-pred_info_set_goal_type(X, PredInfo, PredInfo ^ goal_type := X).
-
pred_info_requested_inlining(PredInfo0) :-
pred_info_get_markers(PredInfo0, Markers),
check_marker(Markers, inline).
@@ -1371,26 +1478,6 @@
terminates_to_markers(does_not_terminate, [does_not_terminate]).
terminates_to_markers(depends_on_mercury_calls, []).
-pred_info_get_markers(PredInfo, PredInfo ^ markers).
-
-pred_info_set_markers(X, PredInfo, PredInfo ^ markers := X).
-
-pred_info_get_attributes(PredInfo, PredInfo ^ attributes).
-
-pred_info_set_attributes(X, PredInfo, PredInfo ^ attributes := X).
-
-pred_info_is_pred_or_func(PredInfo) = PredInfo ^ is_pred_or_func.
-
-pred_info_set_class_context(X, PredInfo, PredInfo ^ class_context := X).
-
-pred_info_get_class_context(PredInfo, PredInfo ^ class_context).
-
-pred_info_set_constraint_proofs(X, PredInfo, PredInfo ^ constraint_proofs := X).
-
-pred_info_get_constraint_proofs(PredInfo, PredInfo ^ constraint_proofs).
-
-pred_info_get_exist_quant_tvars(PredInfo, PredInfo ^ exist_quant_tvars).
-
pred_info_get_univ_quant_tvars(PredInfo, UnivQVars) :-
pred_info_arg_types(PredInfo, ArgTypes),
term__vars_list(ArgTypes, ArgTypeVars0),
@@ -1398,39 +1485,6 @@
pred_info_get_exist_quant_tvars(PredInfo, ExistQVars),
list__delete_elems(ArgTypeVars, ExistQVars, UnivQVars).
-pred_info_get_head_type_params(PredInfo, PredInfo ^ head_type_params).
-
-pred_info_set_head_type_params(X, PredInfo, PredInfo ^ head_type_params := X).
-
-pred_info_get_unproven_body_constraints(PredInfo,
- PredInfo ^ unproven_body_constraints).
-
-pred_info_set_unproven_body_constraints(X, PredInfo,
- PredInfo ^ unproven_body_constraints := X).
-
-pred_info_get_aditi_owner(PredInfo, PredInfo ^ aditi_owner).
-
-pred_info_set_aditi_owner(X, PredInfo, PredInfo ^ aditi_owner := X).
-
-pred_info_get_indexes(PredInfo, PredInfo ^ indexes).
-
-pred_info_set_indexes(X, PredInfo, PredInfo ^ indexes := X).
-
-pred_info_get_assertions(PredInfo, PredInfo ^ assertions).
-
-pred_info_set_assertions(X, PredInfo, PredInfo ^ assertions := X).
-
-pred_info_get_maybe_special_pred(PredInfo, PredInfo ^ maybe_special_pred).
-
-pred_info_set_maybe_special_pred(X, PredInfo,
- PredInfo ^ maybe_special_pred := X).
-
-pred_info_get_maybe_instance_method_constraints(PredInfo,
- PredInfo ^ maybe_instance_method_constraints).
-
-pred_info_set_maybe_instance_method_constraints(X, PredInfo,
- PredInfo ^ maybe_instance_method_constraints := X).
-
%-----------------------------------------------------------------------------%
pred_info_get_call_id(PredInfo, PredOrFunc - qualified(Module, Name)/Arity) :-
@@ -1501,95 +1555,6 @@
CI ^ clause_typeclass_info_varmap := X).
%-----------------------------------------------------------------------------%
-
-hlds_pred__define_new_pred(Goal0, Goal, ArgVars0, ExtraTypeInfos, InstMap0,
- PredName, TVarSet, VarTypes0, ClassContext, TVarMap, TCVarMap,
- VarSet0, InstVarSet, Markers, Owner, IsAddressTaken,
- ModuleInfo0, ModuleInfo, PredProcId) :-
- Goal0 = _GoalExpr - GoalInfo,
- goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
- instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap),
-
- % XXX The set of existentially quantified type variables
- % here might not be correct.
- ExistQVars = [],
-
- % If interface typeinfo liveness is set, all type_infos for the
- % arguments need to be passed in, not just the ones that are used.
- % Similarly if the address of a procedure of this predicate is taken,
- % so that we can copy the closure.
- module_info_globals(ModuleInfo0, Globals),
- ExportStatus = local,
- non_special_interface_should_use_typeinfo_liveness(ExportStatus,
- IsAddressTaken, Globals, TypeInfoLiveness),
- ( TypeInfoLiveness = yes ->
- goal_info_get_nonlocals(GoalInfo, NonLocals),
- goal_util__extra_nonlocal_typeinfos(TVarMap, TCVarMap,
- VarTypes0, ExistQVars, NonLocals, ExtraTypeInfos0),
- set__delete_list(ExtraTypeInfos0, ArgVars0, ExtraTypeInfos1),
- set__to_sorted_list(ExtraTypeInfos1, ExtraTypeInfos),
- list__append(ExtraTypeInfos, ArgVars0, ArgVars)
- ;
- ArgVars = ArgVars0,
- ExtraTypeInfos = []
- ),
-
- goal_info_get_context(GoalInfo, Context),
- goal_info_get_determinism(GoalInfo, Detism),
- compute_arg_types_modes(ArgVars, VarTypes0, InstMap0, InstMap,
- ArgTypes, ArgModes),
-
- module_info_name(ModuleInfo0, ModuleName),
- SymName = qualified(ModuleName, PredName),
-
- % Remove unneeded variables from the vartypes and varset.
- goal_util__goal_vars(Goal0, GoalVars0),
- set__insert_list(GoalVars0, ArgVars, GoalVars),
- map__select(VarTypes0, GoalVars, VarTypes),
- varset__select(VarSet0, GoalVars, VarSet),
-
- % Approximate the termination information
- % for the new procedure.
- ( goal_cannot_loop(ModuleInfo0, Goal0) ->
- TermInfo = yes(cannot_loop)
- ;
- TermInfo = no
- ),
-
- MaybeDeclaredDetism = no,
- proc_info_create(VarSet, VarTypes, ArgVars, ArgModes, InstVarSet,
- MaybeDeclaredDetism, Detism, Goal0, Context,
- TVarMap, TCVarMap, IsAddressTaken, ProcInfo0),
- proc_info_set_maybe_termination_info(TermInfo, ProcInfo0, ProcInfo),
-
- set__init(Assertions),
-
- pred_info_create(ModuleName, SymName, TVarSet, ExistQVars, ArgTypes,
- true, Context, ExportStatus, Markers, predicate, ClassContext,
- Owner, Assertions, ProcInfo, ProcId, PredInfo),
-
- module_info_get_predicate_table(ModuleInfo0, PredTable0),
- predicate_table_insert(PredInfo, PredId, PredTable0, PredTable),
- module_info_set_predicate_table(PredTable, ModuleInfo0, ModuleInfo),
-
- GoalExpr = call(PredId, ProcId, ArgVars, not_builtin, no, SymName),
- Goal = GoalExpr - GoalInfo,
- PredProcId = proc(PredId, ProcId).
-
-:- pred compute_arg_types_modes(list(prog_var)::in, vartypes::in,
- instmap::in, instmap::in, list(type)::out, list(mode)::out) is det.
-
-compute_arg_types_modes([], _, _, _, [], []).
-compute_arg_types_modes([Var | Vars], VarTypes, InstMap0, InstMap,
- [Type | Types], [Mode | Modes]) :-
- map__lookup(VarTypes, Var, Type),
- instmap__lookup_var(InstMap0, Var, Inst0),
- instmap__lookup_var(InstMap, Var, Inst),
- Mode = (Inst0 -> Inst),
- compute_arg_types_modes(Vars, VarTypes, InstMap0, InstMap,
- Types, Modes).
-
-%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% Various predicates for accessing the proc_info data structure.
@@ -2323,7 +2288,6 @@
proc_info_arg_info(ProcInfo, ArgInfo) :-
( yes(ArgInfo0) = ProcInfo ^ arg_pass_info ->
ArgInfo = ArgInfo0
-
;
error("proc_info_arg_info: arg_pass_info not set")
).
@@ -2369,7 +2333,8 @@
proc_info_set_maybe_termination_info(MT, ProcInfo,
ProcInfo ^ maybe_termination := MT).
proc_info_set_address_taken(AT, ProcInfo, ProcInfo ^ is_address_taken := AT).
-proc_info_set_need_maxfr_slot(NMS, ProcInfo, ProcInfo ^ need_maxfr_slot := NMS).
+proc_info_set_need_maxfr_slot(NMS, ProcInfo,
+ ProcInfo ^ need_maxfr_slot := NMS).
proc_info_set_call_table_tip(CTT, ProcInfo, ProcInfo ^ call_table_tip := CTT).
proc_info_set_maybe_proc_table_info(MTI, ProcInfo,
ProcInfo ^ maybe_table_info := MTI).
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.87
diff -u -b -r1.87 lambda.m
--- compiler/lambda.m 23 Mar 2004 10:52:04 -0000 1.87
+++ compiler/lambda.m 20 May 2004 22:06:17 -0000
@@ -561,10 +561,10 @@
set__init(Assertions),
- pred_info_create(ModuleName, PredName, TVarSet, ExistQVars,
- ArgTypes, true, LambdaContext, local, LambdaMarkers,
- PredOrFunc, Constraints, Owner, Assertions, ProcInfo,
- ProcId, PredInfo),
+ pred_info_create(ModuleName, PredName, PredOrFunc,
+ LambdaContext, local, LambdaMarkers,
+ ArgTypes, TVarSet, ExistQVars, Constraints,
+ Assertions, Owner, ProcInfo, ProcId, PredInfo),
% save the new predicate in the predicate table
Index: compiler/magic.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic.m,v
retrieving revision 1.42
diff -u -b -r1.42 magic.m
--- compiler/magic.m 23 Mar 2004 10:52:05 -0000 1.42
+++ compiler/magic.m 20 May 2004 22:06:17 -0000
@@ -657,9 +657,9 @@
% type classes aren't supported in Aditi.
{ ClassConstraints = constraints([], []) },
{ set__init(Assertions) },
- { pred_info_create(Module, NewName, TVarSet,
- ExistQVars, ArgTypes, true, Context, Status, Markers,
- PredOrFunc, ClassConstraints, Owner, Assertions, ProcInfo0,
+ { pred_info_create(Module, NewName, PredOrFunc, Context,
+ Status, Markers, ArgTypes, TVarSet, ExistQVars,
+ ClassConstraints, Assertions, Owner, ProcInfo0,
NewProcId, NewPredInfo0) },
{ pred_info_set_indexes(Indexes, NewPredInfo0, NewPredInfo) },
@@ -1157,8 +1157,9 @@
ExistQVars = [],
set__init(Assertions),
pred_info_create(PredModule, qualified(PredModule, NewPredName),
- TVarSet, ExistQVars, NewArgTypes, true, DummyContext,
- exported, Markers, predicate, ClassContext, User, Assertions,
+ predicate, DummyContext, exported, Markers,
+ NewArgTypes, TVarSet, ExistQVars,
+ ClassContext, Assertions, User,
JoinProcInfo, JoinProcId, JoinPredInfo),
module_info_get_predicate_table(!.ModuleInfo, Preds0),
@@ -1293,9 +1294,9 @@
{ ClassConstraints = constraints([], []) },
{ ExistQVars = [] },
{ set__init(Assertions) },
- { pred_info_create(ModuleName, SymName, TVarSet, ExistQVars,
- AllArgTypes, true, Context, local, Markers, predicate,
- ClassConstraints, Owner, Assertions, ProcInfo, MagicProcId,
+ { pred_info_create(ModuleName, SymName, predicate, Context,
+ local, Markers, AllArgTypes, TVarSet, ExistQVars,
+ ClassConstraints, Assertions, Owner, ProcInfo, MagicProcId,
MagicPredInfo) },
{ module_info_get_predicate_table(ModuleInfo0, PredTable0) },
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.467
diff -u -b -r1.467 make_hlds.m
--- compiler/make_hlds.m 12 May 2004 14:24:23 -0000 1.467
+++ compiler/make_hlds.m 20 May 2004 22:06:17 -0000
@@ -337,20 +337,20 @@
add_item_decl_pass_1(pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
PredOrFunc, PredName, TypesAndModes, _WithType, _WithInst,
- MaybeDet, Cond, Purity, ClassContext),
+ MaybeDet, _Cond, Purity, ClassContext),
Context, !Status, !Module, no, !IO) :-
init_markers(Markers),
module_add_pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
- PredOrFunc, PredName, TypesAndModes, MaybeDet, Cond, Purity,
+ PredOrFunc, PredName, TypesAndModes, MaybeDet, Purity,
ClassContext, Markers, Context, !.Status, _, !Module, !IO).
add_item_decl_pass_1(pred_or_func_mode(VarSet, MaybePredOrFunc, PredName,
- Modes, _WithInst, MaybeDet, Cond),
+ Modes, _WithInst, MaybeDet, _Cond),
Context, !Status, !Module, no, !IO) :-
( MaybePredOrFunc = yes(PredOrFunc) ->
!.Status = item_status(ImportStatus, _),
IsClassMethod = no,
- module_add_mode(VarSet, PredName, Modes, MaybeDet, Cond,
+ module_add_mode(VarSet, PredName, Modes, MaybeDet,
ImportStatus, Context, PredOrFunc, IsClassMethod, _,
!Module, !IO)
;
@@ -1219,10 +1219,11 @@
ModuleName = pred_info_module(PredInfo0),
pred_info_get_aditi_owner(PredInfo0, Owner),
- pred_info_init(ModuleName, SpecName, PredArity, TVarSet,
- ExistQVars, Types, true, Context, Clauses,
- Status, Markers, none, PredOrFunc,
- ClassContext, Proofs, Owner, NewPredInfo0),
+ pred_info_init(ModuleName, SpecName, PredArity,
+ PredOrFunc, Context, Status, none, Markers,
+ Types, TVarSet, ExistQVars,
+ ClassContext, Proofs,
+ Owner, Clauses, NewPredInfo0),
pred_info_set_procedures(Procs,
NewPredInfo0, NewPredInfo),
module_info_get_predicate_table(ModuleInfo2,
@@ -2843,17 +2844,17 @@
:- pred module_add_pred_or_func(tvarset::in, inst_varset::in, existq_tvars::in,
pred_or_func::in, sym_name::in, list(type_and_mode)::in,
- maybe(determinism)::in, condition::in, purity::in,
+ maybe(determinism)::in, purity::in,
class_constraints::in, pred_markers::in, prog_context::in,
item_status::in, maybe(pair(pred_id, proc_id))::out,
module_info::in, module_info::out, io::di, io::uo) is det.
module_add_pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
- PredOrFunc, PredName, TypesAndModes, MaybeDet, Cond, Purity,
+ PredOrFunc, PredName, TypesAndModes, MaybeDet, Purity,
ClassContext, Markers, Context, item_status(Status, NeedQual),
MaybePredProcId, !Module, !IO) :-
split_types_and_modes(TypesAndModes, Types, MaybeModes0),
- add_new_pred(TypeVarSet, ExistQVars, PredName, Types, Cond, Purity,
+ add_new_pred(TypeVarSet, ExistQVars, PredName, Types, Purity,
ClassContext, Markers, Context, Status, NeedQual, PredOrFunc,
!Module, !IO),
(
@@ -2892,7 +2893,7 @@
IsClassMethod = no
),
module_add_mode(InstVarSet, PredName, Modes, MaybeDet,
- Cond, Status, Context, PredOrFunc, IsClassMethod,
+ Status, Context, PredOrFunc, IsClassMethod,
PredProcId, !Module, !IO),
MaybePredProcId = yes(PredProcId)
;
@@ -3075,7 +3076,7 @@
(
Method = pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
PredOrFunc, PredName, TypesAndModes, _WithType,
- _WithInst, MaybeDet, Cond, Purity, ClassContext,
+ _WithInst, MaybeDet, _Cond, Purity, ClassContext,
Context),
term__var_list_to_term_list(Vars, VarTerms),
ClassContext = constraints(UnivCnstrs, ExistCnstrs),
@@ -3085,16 +3086,16 @@
add_marker(class_method, Markers0, Markers),
module_add_pred_or_func(TypeVarSet, InstVarSet,
ExistQVars, PredOrFunc, PredName, TypesAndModes,
- MaybeDet, Cond, Purity, NewClassContext, Markers,
+ MaybeDet, Purity, NewClassContext, Markers,
Context, Status, MaybePredIdProcId, !Module, !IO)
;
Method = pred_or_func_mode(VarSet, MaybePredOrFunc, PredName,
- Modes, _WithInst, MaybeDet, Cond, Context),
+ Modes, _WithInst, MaybeDet, _Cond, Context),
( MaybePredOrFunc = yes(PredOrFunc) ->
Status = item_status(ImportStatus, _),
IsClassMethod = yes,
module_add_mode(VarSet, PredName, Modes, MaybeDet,
- Cond, ImportStatus, Context, PredOrFunc,
+ ImportStatus, Context, PredOrFunc,
IsClassMethod, PredIdProcId, !Module, !IO),
MaybePredIdProcId = yes(PredIdProcId)
;
@@ -3240,7 +3241,7 @@
%-----------------------------------------------------------------------------%
:- pred add_new_pred(tvarset::in, existq_tvars::in, sym_name::in,
- list(type)::in, condition::in, purity::in, class_constraints::in,
+ list(type)::in, purity::in, class_constraints::in,
pred_markers::in, prog_context::in, import_status::in,
need_qualifier::in, pred_or_func::in,
module_info::in, module_info::out, io::di, io::uo) is det.
@@ -3249,7 +3250,7 @@
% lambda expressions into separate predicates, so any changes may need
% to be reflected there too.
-add_new_pred(TVarSet, ExistQVars, PredName, Types, Cond, Purity, ClassContext,
+add_new_pred(TVarSet, ExistQVars, PredName, Types, Purity, ClassContext,
Markers0, Context, ItemStatus, NeedQual, PredOrFunc,
!Module, !IO) :-
% Only preds with opt_imported clauses are tagged as opt_imported, so
@@ -3279,10 +3280,10 @@
markers_to_marker_list(PurityMarkers, MarkersList),
list__foldl(add_marker, MarkersList, Markers0, Markers),
globals__io_lookup_string_option(aditi_user, Owner, !IO),
- pred_info_init(ModuleName, PredName, Arity, TVarSet,
- ExistQVars, Types, Cond, Context, ClausesInfo, Status,
- Markers, none, PredOrFunc, ClassContext, Proofs,
- Owner, PredInfo0),
+ pred_info_init(ModuleName, PredName, Arity, PredOrFunc,
+ Context, Status, none, Markers,
+ Types, TVarSet, ExistQVars, ClassContext, Proofs,
+ Owner, ClausesInfo, PredInfo0),
(
predicate_table_search_pf_m_n_a(PredicateTable0,
is_fully_qualified, PredOrFunc, MNameOfPred,
@@ -3796,7 +3797,6 @@
Name = special_pred_name(SpecialPredId, TypeCtor),
PredName = unqualified(Name),
special_pred_name_arity(SpecialPredId, _, Arity),
- Cond `with_type` condition = true,
clauses_info_init(Arity, ClausesInfo0),
adjust_special_pred_status(SpecialPredId, Status0, Status),
map__init(Proofs),
@@ -3807,9 +3807,9 @@
ExistQVars = [],
module_info_globals(!.Module, Globals),
globals__lookup_string_option(Globals, aditi_user, Owner),
- pred_info_init(ModuleName, PredName, Arity, TVarSet, ExistQVars,
- ArgTypes, Cond, Context, ClausesInfo0, Status, Markers,
- none, predicate, ClassContext, Proofs, Owner, PredInfo0),
+ pred_info_init(ModuleName, PredName, Arity, predicate, Context,
+ Status, none, Markers, ArgTypes, TVarSet, ExistQVars,
+ ClassContext, Proofs, Owner, ClausesInfo0, PredInfo0),
pred_info_set_maybe_special_pred(yes(SpecialPredId - TypeCtor),
PredInfo0, PredInfo1),
ArgLives = no,
@@ -3891,15 +3891,14 @@
% Add a mode declaration for a predicate.
:- pred module_add_mode(inst_varset::in, sym_name::in, list(mode)::in,
- maybe(determinism)::in, condition::in, import_status::in,
- prog_context::in, pred_or_func::in, bool::in,
- pair(pred_id, proc_id)::out, module_info::in, module_info::out,
- io::di, io::uo) is det.
+ maybe(determinism)::in, import_status::in, prog_context::in,
+ pred_or_func::in, bool::in, pair(pred_id, proc_id)::out,
+ module_info::in, module_info::out, io::di, io::uo) is det.
% We should store the mode varset and the mode condition
% in the hlds - at the moment we just ignore those two arguments.
-module_add_mode(InstVarSet, PredName, Modes, MaybeDet, _Cond, Status, MContext,
+module_add_mode(InstVarSet, PredName, Modes, MaybeDet, Status, MContext,
PredOrFunc, IsClassMethod, PredProcId, !ModuleInfo, !IO) :-
% Lookup the pred or func declaration in the predicate table.
@@ -4037,7 +4036,6 @@
varset__init(TVarSet0),
make_n_fresh_vars("T", Arity, TypeVars, TVarSet0, TVarSet),
term__var_list_to_term_list(TypeVars, Types),
- Cond = true,
map__init(Proofs),
% The class context is empty since this is an implicit
% definition. Inference will fill it in.
@@ -4048,9 +4046,9 @@
init_markers(Markers0),
module_info_globals(ModuleInfo, Globals),
globals__lookup_string_option(Globals, aditi_user, Owner),
- pred_info_init(ModuleName, PredName, Arity, TVarSet, ExistQVars,
- Types, Cond, Context, ClausesInfo, Status, Markers0, none,
- PredOrFunc, ClassContext, Proofs, Owner, PredInfo0),
+ pred_info_init(ModuleName, PredName, Arity, PredOrFunc, Context,
+ Status, none, Markers0, Types, TVarSet, ExistQVars,
+ ClassContext, Proofs, Owner, ClausesInfo, PredInfo0),
add_marker(infer_type, Markers0, Markers),
pred_info_set_markers(Markers, PredInfo0, PredInfo),
(
Index: compiler/prog_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_out.m,v
retrieving revision 1.49
diff -u -b -r1.49 prog_out.m
--- compiler/prog_out.m 15 Mar 2003 03:09:07 -0000 1.49
+++ compiler/prog_out.m 20 May 2004 22:06:17 -0000
@@ -55,6 +55,7 @@
% the standard Mercury module qualifier operator.
:- pred prog_out__sym_name_to_string(sym_name, string).
:- mode prog_out__sym_name_to_string(in, out) is det.
+:- func prog_out__sym_name_to_string(sym_name) = string.
% sym_name_to_string(SymName, String):
% convert a symbol name and arity to a "<Name>/<Arity>" string,
@@ -62,12 +63,14 @@
% the standard Mercury module qualifier operator.
:- pred prog_out__sym_name_and_arity_to_string(sym_name_and_arity, string).
:- mode prog_out__sym_name_and_arity_to_string(in, out) is det.
+:- func prog_out__sym_name_and_arity_to_string(sym_name_and_arity) = string.
% sym_name_to_string(SymName, Separator, String):
% convert a symbol name to a string,
% with module qualifiers separated by Separator.
:- pred prog_out__sym_name_to_string(sym_name, string, string).
:- mode prog_out__sym_name_to_string(in, in, out) is det.
+:- func prog_out__sym_name_to_string(sym_name, string) = string.
:- pred prog_out__write_module_spec(module_specifier, io__state, io__state).
:- mode prog_out__write_module_spec(in, di, uo) is det.
@@ -181,10 +184,16 @@
prog_out__sym_name_to_string(SymName, String) :-
prog_out__sym_name_to_string(SymName, ".", String).
+prog_out__sym_name_to_string(SymName) = String :-
+ prog_out__sym_name_to_string(SymName, String).
+
prog_out__sym_name_to_string(SymName, Separator, String) :-
prog_out__sym_name_to_string_2(SymName, Separator, Parts, []),
string__append_list(Parts, String).
+prog_out__sym_name_to_string(SymName, Separator) = String :-
+ prog_out__sym_name_to_string(SymName, Separator, String).
+
:- pred prog_out__sym_name_to_string_2(sym_name, string,
list(string), list(string)).
:- mode prog_out__sym_name_to_string_2(in, in, out, in) is det.
@@ -199,6 +208,9 @@
prog_out__sym_name_to_string(SymName, SymNameString),
string__int_to_string(Arity, ArityString),
string__append_list([SymNameString, "/", ArityString], String).
+
+prog_out__sym_name_and_arity_to_string(SymName/Arity) = String :-
+ prog_out__sym_name_and_arity_to_string(SymName/Arity, String).
% write out a module specifier
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.91
diff -u -b -r1.91 unused_args.m
--- compiler/unused_args.m 5 Apr 2004 05:07:44 -0000 1.91
+++ compiler/unused_args.m 20 May 2004 22:06:17 -0000
@@ -1043,9 +1043,9 @@
pred_info_get_class_context(!.PredInfo, ClassContext),
pred_info_get_aditi_owner(!.PredInfo, Owner),
map__init(EmptyProofs),
- pred_info_init(PredModule, Name, Arity, Tvars, ExistQVars, ArgTypes,
- true, Context, ClausesInfo, Status, Markers, GoalType,
- PredOrFunc, ClassContext, EmptyProofs, Owner, !:PredInfo),
+ pred_info_init(PredModule, Name, Arity, PredOrFunc, Context,
+ Status, GoalType, Markers, ArgTypes, Tvars, ExistQVars,
+ ClassContext, EmptyProofs, Owner, ClausesInfo, !:PredInfo),
pred_info_set_typevarset(TypeVars, !PredInfo).
% Replace the goal in the procedure with one to call the given
cvs server: Diffing compiler/notes
cvs server: Diffing debian
cvs server: Diffing deep_profiler
cvs server: Diffing deep_profiler/notes
cvs server: Diffing doc
cvs server: Diffing extras
cvs server: Diffing extras/aditi
cvs server: Diffing extras/cgi
cvs server: Diffing extras/complex_numbers
cvs server: Diffing extras/complex_numbers/samples
cvs server: Diffing extras/complex_numbers/tests
cvs server: Diffing extras/concurrency
cvs server: Diffing extras/curs
cvs server: Diffing extras/curs/samples
cvs server: Diffing extras/curses
cvs server: Diffing extras/curses/sample
cvs server: Diffing extras/dynamic_linking
cvs server: Diffing extras/error
cvs server: Diffing extras/graphics
cvs server: Diffing extras/graphics/mercury_glut
cvs server: Diffing extras/graphics/mercury_opengl
cvs server: Diffing extras/graphics/mercury_tcltk
cvs server: Diffing extras/graphics/samples
cvs server: Diffing extras/graphics/samples/calc
cvs server: Diffing extras/graphics/samples/maze
cvs server: Diffing extras/graphics/samples/pent
cvs server: Diffing extras/lazy_evaluation
cvs server: Diffing extras/lex
cvs server: Diffing extras/lex/samples
cvs server: Diffing extras/lex/tests
cvs server: Diffing extras/logged_output
cvs server: Diffing extras/moose
cvs server: Diffing extras/moose/samples
cvs server: Diffing extras/moose/tests
cvs server: Diffing extras/morphine
cvs server: Diffing extras/morphine/non-regression-tests
cvs server: Diffing extras/morphine/scripts
cvs server: Diffing extras/morphine/source
cvs server: Diffing extras/odbc
cvs server: Diffing extras/posix
cvs server: Diffing extras/quickcheck
cvs server: Diffing extras/quickcheck/tutes
cvs server: Diffing extras/references
cvs server: Diffing extras/references/samples
cvs server: Diffing extras/references/tests
cvs server: Diffing extras/stream
cvs server: Diffing extras/trailed_update
cvs server: Diffing extras/trailed_update/samples
cvs server: Diffing extras/trailed_update/tests
cvs server: Diffing extras/xml
cvs server: Diffing extras/xml/samples
cvs server: Diffing java
cvs server: Diffing java/runtime
cvs server: Diffing library
cvs server: Diffing profiler
cvs server: Diffing robdd
cvs server: Diffing runtime
cvs server: Diffing runtime/GETOPT
cvs server: Diffing runtime/machdeps
cvs server: Diffing samples
cvs server: Diffing samples/c_interface
cvs server: Diffing samples/c_interface/c_calls_mercury
cvs server: Diffing samples/c_interface/cplusplus_calls_mercury
cvs server: Diffing samples/c_interface/mercury_calls_c
cvs server: Diffing samples/c_interface/mercury_calls_cplusplus
cvs server: Diffing samples/c_interface/mercury_calls_fortran
cvs server: Diffing samples/c_interface/simpler_c_calls_mercury
cvs server: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs server: Diffing samples/diff
cvs server: Diffing samples/muz
cvs server: Diffing samples/rot13
cvs server: Diffing samples/solutions
cvs server: Diffing samples/tests
cvs server: Diffing samples/tests/c_interface
cvs server: Diffing samples/tests/c_interface/c_calls_mercury
cvs server: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs server: Diffing samples/tests/c_interface/mercury_calls_c
cvs server: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs server: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs server: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs server: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs server: Diffing samples/tests/diff
cvs server: Diffing samples/tests/muz
cvs server: Diffing samples/tests/rot13
cvs server: Diffing samples/tests/solutions
cvs server: Diffing samples/tests/toplevel
cvs server: Diffing scripts
cvs server: Diffing tests
cvs server: Diffing tests/benchmarks
cvs server: Diffing tests/debugger
cvs server: Diffing tests/debugger/declarative
cvs server: Diffing tests/dppd
cvs server: Diffing tests/general
cvs server: Diffing tests/general/accumulator
cvs server: Diffing tests/general/string_format
cvs server: Diffing tests/general/structure_reuse
cvs server: Diffing tests/grade_subdirs
cvs server: Diffing tests/hard_coded
cvs server: Diffing tests/hard_coded/exceptions
cvs server: Diffing tests/hard_coded/purity
cvs server: Diffing tests/hard_coded/sub-modules
cvs server: Diffing tests/hard_coded/typeclasses
cvs server: Diffing tests/invalid
cvs server: Diffing tests/invalid/purity
Index: tests/invalid/purity/purity_nonsense.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/purity_nonsense.err_exp,v
retrieving revision 1.4
diff -u -b -r1.4 purity_nonsense.err_exp
--- tests/invalid/purity/purity_nonsense.err_exp 12 Feb 2003 22:58:20 -0000 1.4
+++ tests/invalid/purity/purity_nonsense.err_exp 20 May 2004 22:06:17 -0000
@@ -8,32 +8,32 @@
purity_nonsense.m:018: expected type was `(impure (pred))'.
purity_nonsense.m:012: In clause for predicate `purity_nonsense.e12/0':
purity_nonsense.m:012: in argument 1 of call to predicate `impure/1':
-purity_nonsense.m:012: error: the language construct \\+/1 should be
+purity_nonsense.m:012: error: the language construct \+/1 should be
purity_nonsense.m:012: used as a goal, not as an expression.
purity_nonsense.m:012: In clause for predicate `purity_nonsense.e12/0':
purity_nonsense.m:012: in argument 1 of call to predicate `impure/1':
-purity_nonsense.m:012: in argument 1 of functor `\\+/1':
+purity_nonsense.m:012: in argument 1 of functor `\+/1':
purity_nonsense.m:012: error: the language construct impure/1 should be
purity_nonsense.m:012: used as a goal, not as an expression.
purity_nonsense.m:012: In clause for predicate `purity_nonsense.e12/0':
purity_nonsense.m:012: in argument 1 of call to predicate `impure/1':
-purity_nonsense.m:012: in argument 1 of functor `\\+/1':
+purity_nonsense.m:012: in argument 1 of functor `\+/1':
purity_nonsense.m:012: in argument 1 of functor `impure/1':
purity_nonsense.m:012: error: undefined symbol `imp/0'.
purity_nonsense.m:012: In clause for predicate `purity_nonsense.e12/0':
purity_nonsense.m:012: error: `impure' marker in an inappropriate place.
purity_nonsense.m:013: In clause for predicate `purity_nonsense.e13/0':
purity_nonsense.m:013: in argument 1 of call to predicate `semipure/1':
-purity_nonsense.m:013: error: the language construct \\+/1 should be
+purity_nonsense.m:013: error: the language construct \+/1 should be
purity_nonsense.m:013: used as a goal, not as an expression.
purity_nonsense.m:013: In clause for predicate `purity_nonsense.e13/0':
purity_nonsense.m:013: in argument 1 of call to predicate `semipure/1':
-purity_nonsense.m:013: in argument 1 of functor `\\+/1':
+purity_nonsense.m:013: in argument 1 of functor `\+/1':
purity_nonsense.m:013: error: the language construct semipure/1 should be
purity_nonsense.m:013: used as a goal, not as an expression.
purity_nonsense.m:013: In clause for predicate `purity_nonsense.e13/0':
purity_nonsense.m:013: in argument 1 of call to predicate `semipure/1':
-purity_nonsense.m:013: in argument 1 of functor `\\+/1':
+purity_nonsense.m:013: in argument 1 of functor `\+/1':
purity_nonsense.m:013: in argument 1 of functor `semipure/1':
purity_nonsense.m:013: error: undefined symbol `semi/0'.
purity_nonsense.m:013: In clause for predicate `purity_nonsense.e13/0':
cvs server: Diffing tests/misc_tests
cvs server: Diffing tests/mmc_make
cvs server: Diffing tests/mmc_make/lib
cvs server: Diffing tests/recompilation
cvs server: Diffing tests/tabling
cvs server: Diffing tests/term
cvs server: Diffing tests/valid
cvs server: Diffing tests/warnings
cvs server: Diffing tools
cvs server: Diffing trace
cvs server: Diffing util
cvs server: Diffing vim
cvs server: Diffing vim/after
cvs server: Diffing vim/ftplugin
cvs server: Diffing vim/syntax
--------------------------------------------------------------------------
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