Tabling [1/3]
Oliver Hutchison
ohutch at students.cs.mu.OZ.AU
Mon Mar 9 17:56:12 AEDT 1998
Hi
This is the change to add support for det and nondet tabling it is
not totaly complete as I have not included documentation but I think it
would be good to get the code committed as I expect it has the potential
to cause a quite a few conflicts. There are some XXX comments in
make_hlds.m I intent to fix the problems they address once this code has
been committed (the fix is really a separate bug fix).
Tom or Zoltan would be the best people to review this diff?
-------------------------------------------------------------------------------
Estimated hours taken: 200
Add support for tabling.
This change allows for both deterministic and non deterministic memoing,
minimal model semidet code and loop detection.
compiler/base_type_layout.m:
Update comments to reflect new runtime naming standard.
compiler/det_analysis.m:
Allow tabling to change the result of det analysis. This is
necessary in the case of minimal model tabling which can
turn a det procedure into a semidet one.
compiler/det_report.m:
compiler/hlds_data.m:
Add code to report error messages for various non compatible
tabling methods and determinism.
compiler/hlds_out.m:
compiler/modules.m:
compiler/stratify.m:
Remove reference to the old memo marker.
compiler/hlds_pred.m:
Create new type (eval_method) to define which of the available
evaluation methods should be used each procedure.
Add new field to the proc_info structure.
Add several new predicates relating to the new eval_method type.
compiler/inlining.m:
compiler/intermod.m:
Make sure only procedures with normal evaluation are inlined.
compiler/make_hlds.m:
Add code to process new tabling pragmas.
compiler/mercury_compile.m:
Call the tabling transformation code.
compiler/modes.m:
Make sure that all procedures with non normal evaluation have
no unique/partially instantiated modes. Produce error messages
if they do.
compiler/module_qual.m:
compile/prog_data.m:
compiler/prog_io_pragma.m:
Add three new pragma types:
memo
loop_check
minimal
and code to support them.
compiler/purity.m:
Make sure that only procedures with normal evaluation are
allowed to be impure/semipure. Produce error messages for
procedures which are not.
compiler/simplify.m:
Only report infinite recursion warning if a procedure has
normal evaluation.
compiler/table_gen.m:
New module to do the actual tabling transformation.
doc/reference_manual.texi:
Fix mistake in example.
library/mercury_builtin.m:
Add many new predicates for support of tabling.
library/std_util.m:
library/store.m:
Move the functions :
ML_compare_type_info
ML_collapse_equivalences
ML_create_type_info
to the runtime.
runtime/Mmakefile:
runtime/mercury_imp.h:
Add references to new files added for tabling support.
runtime/mercury_string.h:
Change hash macro so it does not cause a name clash with any
variable called "hash".
runtime/mercury_type_info.c:
runtime/mercury_type_info.h:
Add three new functions taken from the library :
MR_compare_type_info
MR_collapse_equivalences
MR_create_type_info.
runtime/mercury_table_any.c:
runtime/mercury_table_any.h:
runtime/mercury_table_enum.c:
runtime/mercury_table_enum.h:
runtime/mercury_table_int_float_string.c:
runtime/mercury_table_int_float_string.h:
runtime/mercury_table_type_info.c:
runtime/mercury_table_type_info.h:
runtime/mercury_tabling.h:
runtime/mercury_table_profile.c:
runtime/mercury_table_profile.h:
New modules for the support of tabling.
Index: compiler/base_type_layout.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/base_type_layout.m,v
retrieving revision 1.28
diff -u -r1.28 base_type_layout.m
--- base_type_layout.m 1998/03/03 17:33:33 1.28
+++ base_type_layout.m 1998/03/05 02:04:14
@@ -34,8 +34,9 @@
% io.m - io__stream type
% mercury_builtin.m - builtin types
%
-% runtime: type_info.h - defines layout macros
-% deep_copy.{c,h} - deep_copy
+% runtime: mercury_type_info.h - defines layout macros
+% mercury_deep_copy.{c,h} - deep_copy
+% mercury_table_any.c - tabling
%
% Any module that uses base_type_layouts should register itself here.
% Changes can by minimized by using the macros in type_info.h.
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_analysis.m,v
retrieving revision 1.130
diff -u -r1.130 det_analysis.m
--- det_analysis.m 1998/03/03 17:34:02 1.130
+++ det_analysis.m 1998/03/05 02:04:20
@@ -258,8 +258,12 @@
determinism_components(Detism1, CanFail1, MaxSoln1),
det_switch_canfail(CanFail0, CanFail1, CanFail),
det_switch_maxsoln(MaxSoln0, MaxSoln1, MaxSoln),
- determinism_components(Detism, CanFail, MaxSoln),
+ determinism_components(Detism2, CanFail, MaxSoln),
+ % Now see if the evaluation model can change the detism
+ proc_info_eval_method(Proc0, EvalMethod),
+ eval_method_change_determinism(EvalMethod, Detism2, Detism),
+
% Save the newly inferred information
proc_info_set_goal(Proc0, Goal, Proc1),
proc_info_set_inferred_determinism(Proc1, Detism, Proc),
Index: compiler/det_report.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_report.m,v
retrieving revision 1.49
diff -u -r1.49 det_report.m
--- det_report.m 1998/03/03 17:34:04 1.49
+++ det_report.m 1998/03/05 02:09:56
@@ -108,7 +108,7 @@
:- import_module globals, options, prog_out, hlds_out, mercury_to_mercury.
:- import_module passes_aux.
-:- import_module bool, int, map, set, std_util, require.
+:- import_module bool, int, map, set, std_util, require, string.
%-----------------------------------------------------------------------------%
@@ -128,19 +128,19 @@
module_info, module_info, io__state, io__state).
:- mode check_determinism(in, in, in, in, in, out, di, uo) is det.
-check_determinism(PredId, ProcId, _PredInfo, ProcInfo,
+check_determinism(PredId, ProcId, PredInfo0, ProcInfo0,
ModuleInfo0, ModuleInfo) -->
- { proc_info_declared_determinism(ProcInfo, MaybeDetism) },
- { proc_info_inferred_determinism(ProcInfo, InferredDetism) },
+ { proc_info_declared_determinism(ProcInfo0, MaybeDetism) },
+ { proc_info_inferred_determinism(ProcInfo0, InferredDetism) },
(
{ MaybeDetism = no },
- { ModuleInfo = ModuleInfo0 }
+ { ModuleInfo1 = ModuleInfo0 }
;
{ MaybeDetism = yes(DeclaredDetism) },
{ compare_determinisms(DeclaredDetism, InferredDetism, Cmp) },
(
{ Cmp = sameas },
- { ModuleInfo = ModuleInfo0 }
+ { ModuleInfo1 = ModuleInfo0 }
;
{ Cmp = looser },
globals__io_lookup_bool_option(
@@ -154,25 +154,79 @@
;
[]
),
- { ModuleInfo = ModuleInfo0 }
+ { ModuleInfo1 = ModuleInfo0 }
;
{ Cmp = tighter },
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo1) },
{ Message = " error: determinism declaration not satisfied.\n" },
report_determinism_problem(PredId,
- ProcId, ModuleInfo, Message,
+ ProcId, ModuleInfo1, Message,
DeclaredDetism, InferredDetism),
- { proc_info_goal(ProcInfo, Goal) },
+ { proc_info_goal(ProcInfo0, Goal) },
globals__io_get_globals(Globals),
- { det_info_init(ModuleInfo, PredId, ProcId, Globals,
+ { det_info_init(ModuleInfo1, PredId, ProcId, Globals,
DetInfo) },
det_diagnose_goal(Goal, DeclaredDetism, [], DetInfo, _)
% XXX with the right verbosity options, we want to
% call report_determinism_problem only if diagnose
% returns false, i.e. it didn't print a message.
)
+ ),
+
+ % make sure the code model is valid given the eval method
+ { proc_info_eval_method(ProcInfo0, EvalMethod0) },
+ { determinism_to_code_model(InferredDetism, CodeMod) },
+ (
+ { valid_code_model_for_eval_method(EvalMethod0, CodeMod) }
+ ->
+ {
+ get_actual_eval_method(EvalMethod0, EvalMethod),
+ proc_info_set_eval_method(ProcInfo0, EvalMethod, ProcInfo),
+ pred_info_procedures(PredInfo0, ProcTable0),
+ map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
+ pred_info_set_procedures(PredInfo0, ProcTable, PredInfo),
+ module_info_set_pred_info(ModuleInfo1, PredId, PredInfo,
+ ModuleInfo)
+ }
+ ;
+ { proc_info_context(ProcInfo0, Context) },
+ prog_out__write_context(Context),
+ { eval_method_to_string(EvalMethod0, EvalMethodS) },
+ io__write_string("Error : `pragma "),
+ io__write_string(EvalMethodS),
+ io__write_string(
+"' declaration not allowed for procedure with determinism `"),
+ mercury_output_det(InferredDetism),
+ io__write_string("'."), io__nl,
+ globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
+ ( { VerboseErrors = yes } ->
+ io__write_string(
+"\tThe pragma requested is only valid for the folowing determinism(s): \n"),
+ { solutions(get_valid_dets(EvalMethod0), Sols) },
+ print_dets(Sols)
+ ;
+ []
+ ),
+ { module_info_incr_errors(ModuleInfo1, ModuleInfo) }
).
+:- pred get_valid_dets(eval_method, determinism).
+:- mode get_valid_dets(in, out) is multidet.
+
+get_valid_dets(EvalMethod, Det) :-
+ valid_code_model_for_eval_method(EvalMethod, CodeModel),
+ determinism_to_code_model(Det, CodeModel).
+
+:- pred print_dets(list(determinism), io__state, io__state).
+:- mode print_dets(in, di, uo) is det.
+
+print_dets([]) --> [].
+print_dets([D|Rest]) -->
+ io__write_string("\t\t"),
+ mercury_output_det(D),
+ io__nl,
+ print_dets(Rest).
+
:- pred check_if_main_can_fail(pred_id, proc_id, pred_info, proc_info,
module_info, module_info, io__state, io__state).
:- mode check_if_main_can_fail(in, in, in, in, in, out, di, uo) is det.
@@ -193,8 +247,8 @@
determinism_components(DeclaredDeterminism, can_fail, _)
}
->
- { proc_info_context(ProcInfo, Context) },
- prog_out__write_context(Context),
+ { proc_info_context(ProcInfo, Context1) },
+ prog_out__write_context(Context1),
% The error message is actually a lie -
% main/2 can also be `erroneous'. But mentioning
% that would probably just confuse people.
@@ -236,6 +290,7 @@
->
% ... then it is an error.
{ pred_info_name(PredInfo, PredName) },
+
{ proc_info_context(ProcInfo, FuncContext) },
prog_out__write_context(FuncContext),
io__write_string("Error: invalid determinism for function\n"),
@@ -290,7 +345,7 @@
DeclaredDetism, InferredDetism) -->
globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn),
( { HaltAtWarn = yes } ->
- io__set_exit_status(1)
+ io__set_exit_status(1)
;
[]
),
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_data.m,v
retrieving revision 1.22
diff -u -r1.22 hlds_data.m
--- hlds_data.m 1998/03/03 17:34:27 1.22
+++ hlds_data.m 1998/03/05 02:04:23
@@ -674,6 +674,7 @@
:- pred determinism_to_code_model(determinism, code_model).
:- mode determinism_to_code_model(in, out) is det.
+:- mode determinism_to_code_model(out, in) is multidet.
:- implementation.
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_out.m,v
retrieving revision 1.190
diff -u -r1.190 hlds_out.m
--- hlds_out.m 1998/03/03 17:34:33 1.190
+++ hlds_out.m 1998/03/05 02:04:24
@@ -537,7 +537,6 @@
hlds_out__marker_name(dnf, "dnf").
hlds_out__marker_name(magic, "magic").
hlds_out__marker_name(obsolete, "obsolete").
-hlds_out__marker_name(memo, "memo").
hlds_out__marker_name(class_method, "class_method").
hlds_out__marker_name((impure), "impure").
hlds_out__marker_name((semipure), "semipure").
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_pred.m,v
retrieving revision 1.46
diff -u -r1.46 hlds_pred.m
--- hlds_pred.m 1998/03/03 17:34:35 1.46
+++ hlds_pred.m 1998/03/05 02:26:20
@@ -111,6 +111,21 @@
; clauses
; none.
+ % The evaluation method that should be used for a pred
+
+:- type eval_method ---> eval_normal % normal mercury
+ % evaluation
+ ; eval_memo % memoing evaluation
+ ; eval_loop_check % memoing + loop check
+ ; eval_minimal % minimal model
+ % evaluation
+ ; eval_well_founded % well founded model
+ % evaluation
+ ; if_valid(eval_method). % ignore the eval model
+ % if the detism of the
+ % proc is not valid for
+ % the eval model
+
% Note: `liveness' and `liveness_info' record liveness in the sense
% used by code generation. This is *not* the same thing as the notion
% of liveness used by mode analysis! See compiler/notes/glossary.html.
@@ -194,12 +209,9 @@
% Conflicts with `inline' marker.
; dnf % Requests that this predicate be transformed
% into disjunctive normal form.
- % Used for pragma(memo).
; magic % Requests that this predicate be transformed
% using the magic set transformation
% Used for pragma(memo).
- ; memo % Requests that this predicate be evaluated
- % using memoing.
% Used for pragma(memo).
; class_method % Requests that this predicate be transformed
% into the appropriate call to a class method
@@ -938,6 +950,12 @@
proc_info).
:- mode proc_info_set_typeinfo_varmap(in, in, out) is det.
+:- pred proc_info_eval_method(proc_info, eval_method).
+:- mode proc_info_eval_method(in, out) is det.
+
+:- pred proc_info_set_eval_method(proc_info, eval_method, proc_info).
+:- mode proc_info_set_eval_method(in, in, out) is det.
+
:- pred proc_info_typeclass_info_varmap(proc_info, map(class_constraint, var)).
:- mode proc_info_typeclass_info_varmap(in, out) is det.
@@ -1019,6 +1037,7 @@
map(class_constraint, var),
% typeclass_info vars for class
% constraints
+ eval_method, % how should the proc be evaluated
maybe(arg_size_info),
% Information about the relative sizes
% of the input and output args of the
@@ -1066,8 +1085,8 @@
NewProc = procedure(
MaybeDet, BodyVarSet, BodyTypes, HeadVars, Modes, MaybeArgLives,
ClauseBody, MContext, StackSlots, InferredDet, CanProcess,
- ArgInfo, InitialLiveness, TVarsMap, TCVarsMap, no, no,
- DeclaredModes, ArgsMethod
+ ArgInfo, InitialLiveness, TVarsMap, TCVarsMap, eval_normal,
+ no, no, DeclaredModes, ArgsMethod
).
proc_info_set(DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
@@ -1077,7 +1096,7 @@
ProcInfo = procedure(
DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
HeadLives, Goal, Context, StackSlots, InferredDetism,
- CanProcess, ArgInfo, Liveness, TVarMap, TCVarsMap,
+ CanProcess, ArgInfo, Liveness, TVarMap, TCVarsMap, eval_normal,
ArgSizes, Termination, no, ArgsMethod).
proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, Detism, Goal,
@@ -1087,13 +1106,14 @@
MaybeHeadLives = no,
ProcInfo = procedure(yes(Detism), VarSet, VarTypes, HeadVars, HeadModes,
MaybeHeadLives, Goal, Context, StackSlots, Detism, yes, [],
- Liveness, TVarMap, TCVarsMap, no, no, no, ArgsMethod).
+ Liveness, TVarMap, TCVarsMap, eval_normal, no, no, no,
+ ArgsMethod).
proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal, ProcInfo) :-
ProcInfo0 = procedure(A, _, _, _, E, F, _,
- H, I, J, K, L, M, N, O, P, Q, R, S),
+ H, I, J, K, L, M, N, O, P, Q, R, S, T),
ProcInfo = procedure(A, VarSet, VarTypes, HeadVars, E, F, Goal,
- H, I, J, K, L, M, N, O, P, Q, R, S).
+ H, I, J, K, L, M, N, O, P, Q, R, S, T).
proc_info_interface_determinism(ProcInfo, Determinism) :-
proc_info_declared_determinism(ProcInfo, MaybeDeterminism),
@@ -1150,80 +1170,84 @@
).
proc_info_declared_determinism(ProcInfo, A) :-
- ProcInfo = procedure(A, _, _, _, _, _, _, _, _,
- _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(A, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ _, _, _, _).
proc_info_varset(ProcInfo, B) :-
- ProcInfo = procedure(_, B, _, _, _, _, _, _, _,
- _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, B, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ _, _, _, _).
proc_info_vartypes(ProcInfo, C) :-
- ProcInfo = procedure(_, _, C, _, _, _, _, _, _,
- _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, C, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ _, _, _, _).
proc_info_headvars(ProcInfo, D) :-
- ProcInfo = procedure(_, _, _, D, _, _, _, _, _,
- _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, D, _, _, _, _, _, _, _, _, _, _, _, _,
+ _, _, _, _).
proc_info_argmodes(ProcInfo, E) :-
- ProcInfo = procedure(_, _, _, _, E, _, _, _, _,
- _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, E, _, _, _, _, _, _, _, _, _, _, _,
+ _, _, _, _).
proc_info_maybe_arglives(ProcInfo, F) :-
- ProcInfo = procedure(_, _, _, _, _, F, _, _, _,
- _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, F, _, _, _, _, _, _, _, _, _, _,
+ _, _, _, _).
proc_info_goal(ProcInfo, G) :-
- ProcInfo = procedure(_, _, _, _, _, _, G, _, _,
- _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, G, _, _, _, _, _, _, _, _, _,
+ _, _, _, _).
proc_info_context(ProcInfo, H) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, H, _,
- _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, H, _, _, _, _, _, _, _, _,
+ _, _, _, _).
proc_info_stack_slots(ProcInfo, I) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, I,
- _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, I, _, _, _, _, _, _, _,
+ _, _, _, _).
proc_info_inferred_determinism(ProcInfo, J) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _,
- J, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, J, _, _, _, _, _, _,
+ _, _, _, _).
proc_info_can_process(ProcInfo, K) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _,
- _, K, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, K, _, _, _, _, _,
+ _, _, _, _).
proc_info_arg_info(ProcInfo, L) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _,
- _, _, L, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, L, _, _, _, _,
+ _, _, _, _).
proc_info_liveness_info(ProcInfo, M) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _,
- _, _, _, M, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, M, _, _, _,
+ _, _, _, _).
proc_info_typeinfo_varmap(ProcInfo, N) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _,
- _, _, _, _, N, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, N, _, _,
+ _, _, _, _).
proc_info_typeclass_info_varmap(ProcInfo, O) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _,
- _, _, _, _, _, O, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, O, _,
+ _, _, _, _).
+
+proc_info_eval_method(ProcInfo, P) :-
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, P,
+ _, _, _, _).
-proc_info_get_maybe_arg_size_info(ProcInfo, P) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _,
- _, _, _, _, _, _, P, _, _, _).
-
-proc_info_get_maybe_termination_info(ProcInfo, Q) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _,
- _, _, _, _, _, _, _, Q, _, _).
-
-proc_info_maybe_declared_argmodes(ProcInfo, R) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _,
- _, _, _, _, _, _, _, _, R, _).
-
-proc_info_args_method(ProcInfo, S) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _,
- _, _, _, _, _, _, _, _, _, S).
+proc_info_get_maybe_arg_size_info(ProcInfo, Q) :-
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ Q, _, _, _).
+
+proc_info_get_maybe_termination_info(ProcInfo, R) :-
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ _, R, _, _).
+
+proc_info_maybe_declared_argmodes(ProcInfo, S) :-
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ _, _, S, _).
+
+proc_info_args_method(ProcInfo, T) :-
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ _, _, _, T).
% :- type proc_info
% ---> procedure(
@@ -1262,18 +1286,21 @@
% O map(class_constraint, var),
% % typeclass_info vars for class
% % constraints
-% P maybe(arg_size_info),
+% P eval_method,
+% % info on how the proc sould be
+% % evaluated
+% Q maybe(arg_size_info),
% % Information about the relative sizes
% % of the input and output args of the
% % procedure. Set by termination
% % analysis.
-% Q maybe(termination_info),
+% R maybe(termination_info),
% % The termination properties of the
% % procedure. Set by termination
% % analysis.
-% R maybe(list(mode))
+% S maybe(list(mode))
% % declared modes of arguments.
-% S args_method
+% T args_method
% % The args_method to be used for
% % the procedure. Usually this will
% % be set to the value of the --args
@@ -1285,100 +1312,106 @@
% ).
proc_info_set_varset(ProcInfo0, B, ProcInfo) :-
- ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
+ ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
proc_info_set_vartypes(ProcInfo0, C, ProcInfo) :-
- ProcInfo0 = procedure(A, B, _, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
+ ProcInfo0 = procedure(A, B, _, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
proc_info_set_headvars(ProcInfo0, D, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, _, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
+ ProcInfo0 = procedure(A, B, C, _, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
proc_info_set_argmodes(ProcInfo0, E, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, _, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
+ ProcInfo0 = procedure(A, B, C, D, _, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
proc_info_set_maybe_arglives(ProcInfo0, F, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, _, G, H, I,
- J, K, L, M, N, O, P, Q, R, S),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
+ ProcInfo0 = procedure(A, B, C, D, E, _, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
proc_info_set_goal(ProcInfo0, G, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, _, H, I,
- J, K, L, M, N, O, P, Q, R, S),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
+ ProcInfo0 = procedure(A, B, C, D, E, F, _, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
proc_info_set_stack_slots(ProcInfo0, I, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, _,
- J, K, L, M, N, O, P, Q, R, S),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, _, J, K, L, M, N, O,
+ P, Q, R, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
proc_info_set_inferred_determinism(ProcInfo0, J, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I,
- _, K, L, M, N, O, P, Q, R, S),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O,
+ P, Q, R, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
proc_info_set_can_process(ProcInfo0, K, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I,
- J, _, L, M, N, O, P, Q, R, S),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, _, L, M, N, O,
+ P, Q, R, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
proc_info_set_arg_info(ProcInfo0, L, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I,
- J, K, _, M, N, O, P, Q, R, S),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, _, M, N, O,
+ P, Q, R, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
proc_info_set_liveness_info(ProcInfo0, M, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, _, N, O, P, Q, R, S),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, _, N, O,
+ P, Q, R, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
proc_info_set_typeinfo_varmap(ProcInfo0, N, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, _, O, P, Q, R, S),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, _, O,
+ P, Q, R, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
proc_info_set_typeclass_info_varmap(ProcInfo0, O, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, _, P, Q, R, S),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
-
-proc_info_set_maybe_arg_size_info(ProcInfo0, P, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, _, Q, R, S),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
-
-proc_info_set_maybe_termination_info(ProcInfo0, Q, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, _, R, S),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
-
-proc_info_set_args_method(ProcInfo0, S, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, _),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
- J, K, L, M, N, O, P, Q, R, S).
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, _,
+ P, Q, R, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
+
+proc_info_set_eval_method(ProcInfo0, P, ProcInfo) :-
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ _, Q, R, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
+
+proc_info_set_maybe_arg_size_info(ProcInfo0, Q, ProcInfo) :-
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, _, R, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
+
+proc_info_set_maybe_termination_info(ProcInfo0, R, ProcInfo) :-
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, _, S, T),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
+
+proc_info_set_args_method(ProcInfo0, T, ProcInfo) :-
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, _),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
+ P, Q, R, S, T).
proc_info_get_typeinfo_vars_setwise(ProcInfo, Vars, TypeInfoVars) :-
set__to_sorted_list(Vars, VarList),
@@ -1505,3 +1538,74 @@
).
%-----------------------------------------------------------------------------%
+
+:- interface.
+
+ % check if the given evaluation method is allowed with
+ % the given code model
+:- pred valid_code_model_for_eval_method(eval_method, code_model).
+:- mode valid_code_model_for_eval_method(in, in) is semidet.
+:- mode valid_code_model_for_eval_method(in, out) is multidet.
+
+:- pred get_actual_eval_method(eval_method, eval_method).
+:- mode get_actual_eval_method(in, out) is det.
+
+:- pred eval_method_to_string(eval_method, string).
+:- mode eval_method_to_string(in, out) is det.
+
+:- pred eval_method_need_stratification(eval_method).
+:- mode eval_method_need_stratification(in) is semidet.
+
+:- pred eval_method_change_determinism(eval_method, determinism,
+ determinism).
+:- mode eval_method_change_determinism(in, in, out) is det.
+
+:- implementation.
+
+:- import_module det_analysis.
+
+valid_code_model_for_eval_method(eval_normal, model_det).
+valid_code_model_for_eval_method(eval_normal, model_semi).
+valid_code_model_for_eval_method(eval_normal, model_non).
+valid_code_model_for_eval_method(eval_memo, model_det).
+valid_code_model_for_eval_method(eval_memo, model_semi).
+valid_code_model_for_eval_method(eval_memo, model_non).
+valid_code_model_for_eval_method(eval_loop_check, model_det).
+valid_code_model_for_eval_method(eval_loop_check, model_semi).
+valid_code_model_for_eval_method(eval_minimal, model_semi).
+valid_code_model_for_eval_method(eval_well_founded, model_semi).
+valid_code_model_for_eval_method(eval_well_founded, model_non).
+valid_code_model_for_eval_method(if_valid(Method0), CodeMod) :-
+ valid_code_model_for_eval_method(Method0, CodeMod).
+
+get_actual_eval_method(EvalMethod0, EvalMethod) :-
+ (
+ EvalMethod0 = if_valid(Method0)
+ ->
+ get_actual_eval_method(Method0, EvalMethod)
+ ;
+ EvalMethod = EvalMethod0
+ ).
+
+eval_method_to_string(eval_normal, "normal").
+eval_method_to_string(eval_memo, "memo").
+eval_method_to_string(eval_loop_check, "loop_check").
+eval_method_to_string(eval_well_founded, "well_founded_model").
+eval_method_to_string(eval_minimal, "minimal_model").
+eval_method_to_string(if_valid(Method), String) :-
+ eval_method_to_string(Method, String).
+
+ % XXX : We can't realy use the stratification check as it is to
+ % conservative.
+eval_method_need_stratification(_) :-
+ semidet_fail.
+
+eval_method_change_determinism(eval_normal, Detism, Detism).
+eval_method_change_determinism(eval_memo, Detism, Detism).
+eval_method_change_determinism(eval_loop_check, Detism, Detism).
+eval_method_change_determinism(eval_well_founded, Detism, Detism).
+eval_method_change_determinism(eval_minimal, Det0, Det) :-
+ det_conjunction_detism(semidet, Det0, Det).
+eval_method_change_determinism(if_valid(Method), Detism0, Detism) :-
+ eval_method_change_determinism(Method, Detism0, Detism).
+
Index: compiler/inlining.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inlining.m,v
retrieving revision 1.74
diff -u -r1.74 inlining.m
--- inlining.m 1998/03/03 17:34:37 1.74
+++ inlining.m 1998/03/05 02:04:25
@@ -587,15 +587,26 @@
% don't try to inline imported predicates, since we don't
% have the code for them.
- module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo,
+ ProcInfo),
\+ pred_info_is_imported(PredInfo),
% this next line catches the case of locally defined
% unification predicates for imported types.
+
\+ (
pred_info_is_pseudo_imported(PredInfo),
+
hlds_pred__in_in_unification_proc_id(ProcId)
),
+ % Only try to inline procedures which are evaluated using
+ % normal evaluation. Currently we can't inline procs evaluated
+ % using any of the other methods because the code genertor for
+ % the methods can only handle whole procedures not code
+ % fragments.
+
+ proc_info_eval_method(ProcInfo, eval_normal),
+
% don't inlining anything we have been specifically requested
% not to inline.
Index: compiler/intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.46
diff -u -r1.46 intermod.m
--- intermod.m 1998/03/03 17:34:44 1.46
+++ intermod.m 1998/03/05 02:04:27
@@ -180,7 +180,9 @@
{ inlining__is_simple_goal(Goal,
InlineThreshold) },
{ pred_info_get_markers(PredInfo0, Markers) },
- { \+ check_marker(Markers, no_inline) }
+ { \+ check_marker(Markers, no_inline) },
+ { proc_info_eval_method(ProcInfo,
+ eval_normal) }
;
{ pred_info_requested_inlining(PredInfo0) }
;
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.263
diff -u -r1.263 make_hlds.m
--- make_hlds.m 1998/03/04 19:47:34 1.263
+++ make_hlds.m 1998/03/05 02:35:35
@@ -323,12 +323,11 @@
% clauses).
{ Pragma = c_code(_, _, _, _, _, _) },
{ Module = Module0 }
- ;
- { Pragma = memo(Name, Arity) },
- add_pred_marker(Module0, "memo", Name, Arity, Context,
- memo, [], Module1),
- add_stratified_pred(Module1, "memo", Name, Arity, Context,
- Module)
+ ;
+ % Handle pragma tabled decls later on (when we process
+ % clauses).
+ { Pragma = tabled(_, _, _, _, _) },
+ { Module = Module0 }
;
{ Pragma = inline(Name, Arity) },
add_pred_marker(Module0, "inline", Name, Arity, Context,
@@ -526,7 +525,21 @@
module_add_pragma_fact_table(Pred, Arity, File,
Status, Context, Module0, Module, Info0, Info)
;
- % don't worry about any pragma decs but c_code
+ { Pragma = tabled(Type, Name, Arity, PredOrFunc, Mode) }
+ ->
+ globals__io_lookup_bool_option(type_layout, TypeLayout),
+ (
+ { TypeLayout = yes }
+ ->
+ module_add_pragma_tabled(Type, Name, Arity, PredOrFunc,
+ Mode, Context, Module0, Module)
+ ;
+ % XXX this is an error
+ { module_info_incr_errors(Module0, Module) }
+ ),
+ { Info = Info0 }
+ ;
+ % don't worry about any pragma decs but c_code, tabling
% and fact_table here
{ Module = Module0 },
{ Info = Info0 }
@@ -698,38 +711,12 @@
%-----------------------------------------------------------------------------%
-:- pred add_stratified_pred(module_info, string, sym_name, arity,
- term__context, module_info, io__state, io__state).
-:- mode add_stratified_pred(in, in, in, in, in, out, di, uo) is det.
-
-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) }
- ->
- { module_info_stratified_preds(Module0, StratPredIds0) },
- { set__insert_list(StratPredIds0, PredIds, StratPredIds) },
- { module_info_set_stratified_preds(Module0, StratPredIds,
- Module) }
- ;
- { string__append_list(
- ["`:- pragma ", PragmaName, "' declaration"],
- Description) },
- undefined_pred_or_func_error(Name, Arity, Context,
- Description),
- { module_info_incr_errors(Module0, Module) }
- ).
-
-%-----------------------------------------------------------------------------%
-
% add_pred_marker(ModuleInfo0, PragmaName, Name, Arity, Context,
% Marker, ConflictMarkers, ModuleInfo, IO0, IO)
% Adds Marker to the marker list of the pred(s) with give Name and
% Arity, updating the ModuleInfo. If the named pred does not exist,
% or the pred already has a marker in ConflictMarkers, report
% an error.
-
:- pred add_pred_marker(module_info, string, sym_name, arity,
term__context, marker, list(marker), module_info,
io__state, io__state).
@@ -2499,6 +2486,169 @@
%-----------------------------------------------------------------------------%
+:- pred module_add_pragma_tabled(eval_method, sym_name, int,
+ maybe(pred_or_func), maybe(list(mode)),
+ term__context, module_info, module_info,
+ io__state, io__state).
+:- mode module_add_pragma_tabled(in, in, in, in, in, in, in, out,
+ di, uo) is det.
+
+module_add_pragma_tabled(EvalMethod, PredName, Arity0, MaybePredOrFunc,
+ MaybeModes, Context, ModuleInfo0, ModuleInfo) -->
+ io__stderr_stream(StdErr),
+
+ { module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
+
+ % Find out if we are tabling a predicate or a function
+ (
+ { MaybePredOrFunc = yes(PredOrFunc0) }
+ ->
+ { PredOrFunc = PredOrFunc0 }
+ ;
+ (
+ { predicate_table_search_sym_arity(PredicateTable0,
+ PredName, Arity0, [PredId0]) }
+ ->
+ { predicate_table_get_preds(PredicateTable0, Preds0) },
+ { map__lookup(Preds0, PredId0, PredInfo0) },
+ { pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc) }
+ ;
+ % XXX Fix this when we fix all the other
+ % XXX pragmas that dont properly support this
+ % XXX case
+ { error(
+"module_add_pragma_tabled: predicate and function with same name/arity") }
+ )
+ ),
+
+ (
+ { PredOrFunc = predicate },
+ { Arity = Arity0 }
+ ;
+ { PredOrFunc = function },
+ { Arity is Arity0 + 1 }
+ ),
+
+ % print out a progress message
+ { eval_method_to_string(EvalMethod, EvalMethodS) },
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose),
+ (
+ { VeryVerbose = yes }
+ ->
+ io__write_string("% Processing `:- pragma "),
+ io__write_string(EvalMethodS),
+ io__write_string("' for "),
+ hlds_out__write_call_id(PredOrFunc, PredName/Arity),
+ io__write_string("...\n")
+ ;
+ []
+ ),
+
+ % Lookup the pred declaration in the predicate table.
+ % (If it's not there, print an error message and insert
+ % a dummy declaration for the predicate.)
+ (
+ { predicate_table_search_pf_sym_arity(PredicateTable0,
+ PredOrFunc, PredName, Arity, [PredId1]) }
+ ->
+ { PredId = PredId1 },
+ { PredicateTable1 = PredicateTable0 }
+ ;
+ { module_info_name(ModuleInfo0, ModuleName) },
+ { string__format("pragma (%s)", [s(EvalMethodS)], Message1) },
+ maybe_undefined_pred_error(PredName, Arity, PredOrFunc,
+ Context, Message1),
+ { preds_add_implicit(PredicateTable0,
+ ModuleName, PredName, Arity, Context,
+ PredOrFunc, PredId, PredicateTable1) }
+ ),
+ % Lookup the pred_info for this pred,
+ { predicate_table_get_preds(PredicateTable1, Preds1) },
+ { map__lookup(Preds1, PredId, PredInfo1) },
+
+ (
+ { pred_info_is_imported(PredInfo1) }
+ ->
+ io__set_output_stream(StdErr, OldStream2),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+ prog_out__write_context(Context),
+ io__write_string("Error: `:- pragma "),
+ io__write_string(EvalMethodS),
+ io__write_string("' "),
+ io__write_string("declaration for imported "),
+ hlds_out__write_call_id(PredOrFunc, PredName/Arity),
+ io__write_string(".\n"),
+ io__set_output_stream(OldStream2, _)
+ ;
+ % do we have to make sure the tabled preds are stratified?
+ (
+ { eval_method_need_stratification(EvalMethod) }
+ ->
+ { module_info_stratified_preds(ModuleInfo0,
+ StratPredIds0) },
+ { set__insert(StratPredIds0, PredId, StratPredIds) },
+ { module_info_set_stratified_preds(ModuleInfo0,
+ StratPredIds, ModuleInfo1) }
+ ;
+ { ModuleInfo1 = ModuleInfo0 }
+ ),
+
+ % add the eval model to the proc_info for this procedure
+ { pred_info_procedures(PredInfo1, Procs0) },
+ { map__to_assoc_list(Procs0, ExistingProcs) },
+ (
+ { MaybeModes = yes(Modes) }
+ ->
+ (
+ { get_procedure_matching_argmodes(
+ ExistingProcs, Modes, ModuleInfo1,
+ ProcId) }
+ ->
+ { map__lookup(Procs0, ProcId, ProcInfo0) },
+ { proc_info_set_eval_method(ProcInfo0,
+ EvalMethod, ProcInfo) },
+ { map__det_update(Procs0, ProcId, ProcInfo,
+ Procs) },
+ { pred_info_set_procedures(PredInfo1, Procs,
+ PredInfo) },
+ { module_info_set_pred_info(ModuleInfo1,
+ PredId, PredInfo, ModuleInfo) }
+ ;
+ { module_info_incr_errors(ModuleInfo1,
+ ModuleInfo) },
+ io__set_output_stream(StdErr, OldStream4),
+ prog_out__write_context(Context),
+ io__write_string("Error: `:- pragma "),
+ io__write_string(EvalMethodS),
+ io__write_string(
+ "' declaration for undeclared mode of "),
+ hlds_out__write_call_id(PredOrFunc,
+ PredName/Arity),
+ io__write_string(".\n"),
+ io__set_output_stream(OldStream4, _)
+ )
+ ;
+ { set_eval_method_list(ExistingProcs,
+ if_valid(EvalMethod), Procs0, Procs) },
+ { pred_info_set_procedures(PredInfo1, Procs,
+ PredInfo) },
+ { module_info_set_pred_info(ModuleInfo1, PredId,
+ PredInfo, ModuleInfo) }
+ )
+ ).
+
+:- pred set_eval_method_list(assoc_list(proc_id, proc_info), eval_method,
+ proc_table, proc_table).
+:- mode set_eval_method_list(in, in, in, out) is det.
+
+set_eval_method_list([], _, Procs, Procs).
+set_eval_method_list([ProcId - ProcInfo0|Rest], EvalMethod, Procs0, Procs) :-
+ proc_info_set_eval_method(ProcInfo0, EvalMethod, ProcInfo),
+ map__det_update(Procs0, ProcId, ProcInfo, Procs1),
+ set_eval_method_list(Rest, EvalMethod, Procs1, Procs).
+
+%-----------------------------------------------------------------------------%
+
% from the list of pragma_vars extract the modes.
:- pred pragma_get_modes(list(pragma_var), list(mode)).
:- mode pragma_get_modes(in, out) is det.
@@ -3315,6 +3465,7 @@
transform_goal(Goal0, VarSet0, Subst, Goal, VarSet, Info0, Info),
{ goal_info_init(GoalInfo) }.
+
transform_goal_2(if_then_else(Vars0, A0, B0, C0), _, VarSet0, Subst,
if_then_else(Vars, A, B, C, Empty) - GoalInfo, VarSet, Info0, Info)
-->
@@ -3807,7 +3958,7 @@
Modes, Det, HLDS_Goal),
Context, MainContext, SubContext, Goal) }
;
- % handle if-then-else expressions
+ % handle if-then-else expressions
{ F = term__atom("else"),
Args = [term__functor(term__atom("if"), [
term__functor(term__atom("then"),
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.76
diff -u -r1.76 mercury_compile.m
--- mercury_compile.m 1998/03/03 17:35:03 1.76
+++ mercury_compile.m 1998/03/05 23:38:28
@@ -32,7 +32,7 @@
:- import_module handle_options, prog_io, prog_out, modules, module_qual.
:- import_module equiv_type, make_hlds, typecheck, purity, modes.
:- import_module switch_detection, cse_detection, det_analysis, unique_modes.
-:- import_module check_typeclass, simplify, intermod, trans_opt.
+:- import_module check_typeclass, simplify, intermod, trans_opt, table_gen.
:- import_module bytecode_gen, bytecode.
:- import_module (lambda), polymorphism, termination, higher_order, inlining.
:- import_module dnf, constraint, unused_args, dead_proc_elim, saved_vars.
@@ -743,10 +743,13 @@
% :- mode mercury_compile__middle_pass(in, di, uo, di, uo) is det.
:- mode mercury_compile__middle_pass(in, in, out, di, uo) is det.
-mercury_compile__middle_pass(ModuleName, HLDS25, HLDS50) -->
+mercury_compile__middle_pass(ModuleName, HLDS24, HLDS50) -->
globals__io_lookup_bool_option(verbose, Verbose),
globals__io_lookup_bool_option(statistics, Stats),
+ mercury_compile__tabling(HLDS24, Verbose, HLDS25),
+ mercury_compile__maybe_dump_hlds(HLDS25, "25", "tabling"), !,
+
mercury_compile__maybe_polymorphism(HLDS25, Verbose, Stats, HLDS26),
mercury_compile__maybe_dump_hlds(HLDS26, "26", "polymorphism"), !,
@@ -1271,6 +1274,19 @@
;
{ ModuleInfo = ModuleInfo0 }
).
+
+%-----------------------------------------------------------------------------%
+
+:- pred mercury_compile__tabling(module_info, bool,
+ module_info, io__state, io__state).
+:- mode mercury_compile__tabling(in, in, out, di, uo) is det.
+
+mercury_compile__tabling(HLDS0, Verbose, HLDS) -->
+ maybe_write_string(Verbose,
+ "% Transforming tabled predicates..."),
+ maybe_flush_output(Verbose),
+ { table_gen__process_module(HLDS0, HLDS) },
+ maybe_write_string(Verbose, " done.\n").
%-----------------------------------------------------------------------------%
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.133
diff -u -r1.133 mercury_to_mercury.m
--- mercury_to_mercury.m 1998/03/03 17:35:08 1.133
+++ mercury_to_mercury.m 1998/03/05 02:04:33
@@ -303,8 +303,9 @@
{ Pragma = obsolete(Pred, Arity) },
mercury_output_pragma_decl(Pred, Arity, predicate, "obsolete")
;
- { Pragma = memo(Pred, Arity) },
- mercury_output_pragma_decl(Pred, Arity, predicate, "memo")
+ { Pragma = tabled(Type, Pred, Arity, _PredOrFunc, _Mode) },
+ { eval_method_to_string(Type, TypeS) },
+ mercury_output_pragma_decl(Pred, Arity, predicate, TypeS)
;
{ Pragma = inline(Pred, Arity) },
mercury_output_pragma_decl(Pred, Arity, predicate, "inline")
Index: compiler/modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modes.m,v
retrieving revision 1.221
diff -u -r1.221 modes.m
--- modes.m 1998/03/03 17:35:23 1.221
+++ modes.m 1998/03/05 23:42:13
@@ -335,16 +335,19 @@
globals__io_lookup_int_option(mode_inference_iteration_limit,
MaxIterations),
modecheck_to_fixpoint(PredIds, MaxIterations, WhatToCheck, ModuleInfo0,
- ModuleInfo, UnsafeToContinue),
+ ModuleInfo1, UnsafeToContinue),
( { WhatToCheck = check_unique_modes },
- write_mode_inference_messages(PredIds, yes, ModuleInfo)
+ write_mode_inference_messages(PredIds, yes, ModuleInfo1),
+ { ModuleInfo2 = ModuleInfo1 }
; { WhatToCheck = check_modes },
( { UnsafeToContinue = yes } ->
- write_mode_inference_messages(PredIds, no, ModuleInfo)
+ write_mode_inference_messages(PredIds, no, ModuleInfo1)
;
[]
- )
- ).
+ ),
+ check_eval_methods(ModuleInfo1, ModuleInfo2)
+ ),
+ { ModuleInfo = ModuleInfo2 }.
% Iterate over the list of pred_ids in a module.
@@ -1805,6 +1808,87 @@
% XXX could do better; it's not really explicit
mode_context_to_unify_context(uninitialized, _, _) :-
error("mode_context_to_unify_context: uninitialized context").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- pred check_eval_methods(module_info, module_info, io__state, io__state).
+:- mode check_eval_methods(in, out, di, uo) is det.
+
+check_eval_methods(ModuleInfo0, ModuleInfo) -->
+ { module_info_predids(ModuleInfo0, PredIds) },
+ pred_check_eval_methods(PredIds, ModuleInfo0, ModuleInfo).
+
+:- pred pred_check_eval_methods(list(pred_id), module_info, module_info,
+ io__state, io__state).
+:- mode pred_check_eval_methods(in, in, out, di, uo) is det.
+
+pred_check_eval_methods([], M, M) --> [].
+pred_check_eval_methods([PredId|Rest], ModuleInfo0, ModuleInfo) -->
+ { module_info_preds(ModuleInfo0, Preds) },
+ { map__lookup(Preds, PredId, PredInfo) },
+ { pred_info_procids(PredInfo, ProcIds) },
+ proc_check_eval_methods(ProcIds, PredId, ModuleInfo0, ModuleInfo1),
+ pred_check_eval_methods(Rest, ModuleInfo1, ModuleInfo).
+
+:- pred proc_check_eval_methods(list(proc_id), pred_id, module_info,
+ module_info, io__state, io__state).
+:- mode proc_check_eval_methods(in, in, in, out, di, uo) is det.
+
+proc_check_eval_methods([], _, M, M) --> [].
+proc_check_eval_methods([ProcId|Rest], PredId, ModuleInfo0, ModuleInfo) -->
+ { module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
+ _, ProcInfo) },
+ { proc_info_eval_method(ProcInfo, EvalMethod) },
+ ( \+ { EvalMethod = eval_normal } ->
+ { proc_info_argmodes(ProcInfo, Modes) },
+ (
+ \+ { only_fully_in_out_nonunique_modes(Modes,
+ ModuleInfo0) }
+ ->
+ { proc_info_context(ProcInfo, Context) },
+ prog_out__write_context(Context),
+ { eval_method_to_string(EvalMethod, EvalMethodS) },
+ io__write_string("Error : `pragma "),
+ io__write_string(EvalMethodS),
+ io__write_string(
+"' declaration not allowed for procedure with\n"),
+ prog_out__write_context(Context),
+ io__write_string(
+"unique/partially instantiated modes.\n"),
+ globals__io_lookup_bool_option(verbose_errors,
+ VerboseErrors),
+ ( { VerboseErrors = yes } ->
+ io__write_string(
+" Perhaps there sould be a good message at this point?\n")
+ ;
+ []
+ ),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo1) }
+ ;
+ { ModuleInfo1 = ModuleInfo0 }
+ )
+ ;
+ { ModuleInfo1 = ModuleInfo0 }
+
+ ),
+ proc_check_eval_methods(Rest, PredId, ModuleInfo1, ModuleInfo).
+
+:- pred only_fully_in_out_nonunique_modes(list(mode), module_info).
+:- mode only_fully_in_out_nonunique_modes(in, in) is semidet.
+
+only_fully_in_out_nonunique_modes([], _).
+only_fully_in_out_nonunique_modes([Mode|Rest], ModuleInfo) :-
+ mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
+ inst_is_not_partly_unique(ModuleInfo, InitialInst),
+ inst_is_not_partly_unique(ModuleInfo, FinalInst),
+ (
+ inst_is_ground(ModuleInfo, InitialInst)
+ ;
+ inst_is_free(ModuleInfo, InitialInst),
+ inst_is_ground(ModuleInfo, FinalInst)
+ ),
+ only_fully_in_out_nonunique_modes(Rest, ModuleInfo).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/module_qual.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/module_qual.m,v
retrieving revision 1.32
diff -u -r1.32 module_qual.m
--- module_qual.m 1998/03/04 19:47:38 1.32
+++ module_qual.m 1998/03/05 02:04:37
@@ -654,7 +654,17 @@
c_code(Rec, SymName, PredOrFunc, PragmaVars, Varset, CCode),
Info0, Info) -->
qualify_pragma_vars(PragmaVars0, PragmaVars, Info0, Info).
-qualify_pragma(memo(A, B), memo(A, B), Info, Info) --> [].
+qualify_pragma(tabled(A, B, C, D, MModes0), tabled(A, B, C, D, MModes),
+ Info0, Info) -->
+ (
+ { MModes0 = yes(Modes0) }
+ ->
+ qualify_mode_list(Modes0, Modes, Info0, Info),
+ { MModes = yes(Modes) }
+ ;
+ { Info = Info0 },
+ { MModes = no }
+ ).
qualify_pragma(inline(A, B), inline(A, B), Info, Info) --> [].
qualify_pragma(no_inline(A, B), no_inline(A, B), Info, Info) --> [].
qualify_pragma(obsolete(A, B), obsolete(A, B), Info, Info) --> [].
Index: compiler/modules.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modules.m,v
retrieving revision 1.61
diff -u -r1.61 modules.m
--- modules.m 1998/03/06 09:05:12 1.61
+++ modules.m 1998/03/09 01:20:35
@@ -541,7 +541,6 @@
pragma_allowed_in_interface(c_header_code(_), no).
pragma_allowed_in_interface(c_code(_), no).
pragma_allowed_in_interface(c_code(_, _, _, _, _, _), no).
-pragma_allowed_in_interface(memo(_, _), no).
pragma_allowed_in_interface(inline(_, _), no).
pragma_allowed_in_interface(no_inline(_, _), no).
pragma_allowed_in_interface(obsolete(_, _), yes).
@@ -550,6 +549,7 @@
pragma_allowed_in_interface(source_file(_), yes).
% yes, but the parser will strip out `source_file' pragmas anyway...
pragma_allowed_in_interface(fact_table(_, _, _), no).
+pragma_allowed_in_interface(tabled(_, _, _, _, _), no).
pragma_allowed_in_interface(promise_pure(_, _), no).
pragma_allowed_in_interface(unused_args(_, _, _, _, _), no).
pragma_allowed_in_interface(termination_info(_, _, _, _, _), yes).
Index: compiler/prog_data.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_data.m,v
retrieving revision 1.32
diff -u -r1.32 prog_data.m
--- prog_data.m 1998/03/03 17:35:40 1.32
+++ prog_data.m 1998/03/05 02:04:41
@@ -104,9 +104,6 @@
% PredName, Predicate or Function, Vars/Mode,
% VarNames, C Code Implementation Info
- ; memo(sym_name, arity)
- % Predname, Arity
-
; inline(sym_name, arity)
% Predname, Arity
@@ -140,6 +137,10 @@
; fact_table(sym_name, arity, string)
% Predname, Arity, Fact file name.
+ ; tabled(eval_method, sym_name, int, maybe(pred_or_func),
+ maybe(list(mode)))
+ % Tabling type, Predname, Arity, PredOrFunc?, Mode?
+
; promise_pure(sym_name, arity)
% Predname, Arity
@@ -155,6 +156,7 @@
% This includes c_code, and imported predicates.
% termination_info pragmas are used in opt and
% trans_opt files.
+
; terminates(sym_name, arity)
% Predname, Arity
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.13
diff -u -r1.13 prog_io_pragma.m
--- prog_io_pragma.m 1998/03/03 17:35:47 1.13
+++ prog_io_pragma.m 1998/03/05 02:04:43
@@ -431,10 +431,42 @@
parse_pragma_type(ModuleName, "memo", PragmaTerms,
ErrorTerm, _VarSet, Result) :-
- parse_simple_pragma(ModuleName, "memo",
- lambda([Name::in, Arity::in, Pragma::out] is det,
- Pragma = memo(Name, Arity)),
- PragmaTerms, ErrorTerm, Result).
+ (
+ PragmaTerms = [PragmaTerm]
+ ->
+ parse_tabling_pragma(ModuleName, "memo", eval_memo,
+ PragmaTerm, Result)
+ ;
+ Result = error(
+ "wrong number of arguments in `pragma memo(...)' declaration",
+ ErrorTerm)
+
+ ).
+parse_pragma_type(ModuleName, "loop_check", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
+ (
+ PragmaTerms = [PragmaTerm]
+ ->
+ parse_tabling_pragma(ModuleName, "loop_check",
+ eval_loop_check, PragmaTerm, Result)
+ ;
+ Result = error(
+ "wrong number of arguments in `pragma loop_check(...)' declaration",
+ ErrorTerm)
+ ).
+parse_pragma_type(ModuleName, "minimal", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
+ (
+ PragmaTerms = [PragmaTerm]
+ ->
+ parse_tabling_pragma(ModuleName, "minimal",
+ eval_minimal, PragmaTerm, Result)
+ ;
+ Result = error(
+ "wrong number of arguments in `pragma minimal(...)' declaration",
+ ErrorTerm)
+
+ ).
parse_pragma_type(ModuleName, "obsolete", PragmaTerms,
ErrorTerm, _VarSet, Result) :-
@@ -778,6 +810,88 @@
PragmaVars = [], % return any old junk in PragmaVars
Error = yes("arguments not in form 'Var :: mode'")
).
+
+
+:- pred parse_tabling_pragma(module_name, string, eval_method, term,
+ maybe1(item)).
+:- mode parse_tabling_pragma(in, in, in, in, out) is det.
+
+parse_tabling_pragma(ModuleName, PragmaName, TablingType,
+ PredAndModesTerm0, Result) :-
+ (
+ % Is this a simple pred/arity pragma
+ PredAndModesTerm0 = term__functor(term__atom("/"),
+ [PredNameTerm, ArityTerm], _)
+ ->
+ (
+ parse_qualified_term(ModuleName, PredNameTerm, PredAndModesTerm0,
+ "", ok(PredName, [])),
+ ArityTerm = term__functor(term__integer(Arity), [], _)
+ ->
+ Result = ok(pragma(tabled(TablingType, PredName, Arity, no, no)))
+ ;
+ string__append_list(
+ ["expected predname/arity for `pragma ",
+ PragmaName, "(...)' declaration"], ErrorMsg),
+ Result = error(ErrorMsg, PredAndModesTerm0)
+ )
+ ;
+ % Is this a specific mode pragma
+ PredAndModesTerm0 = term__functor(Const, Terms0, _)
+ ->
+ (
+ % is this a function or a predicate?
+ Const = term__atom("="),
+ Terms0 = [FuncAndModesTerm, FuncResultTerm0]
+ ->
+ % function
+ PredOrFunc = function,
+ PredAndModesTerm = FuncAndModesTerm,
+ FuncResultTerms = [ FuncResultTerm0 ]
+ ;
+ % predicate
+ PredOrFunc = predicate,
+ PredAndModesTerm = PredAndModesTerm0,
+ FuncResultTerms = []
+ ),
+ parse_qualified_term(ModuleName, PredAndModesTerm, PredAndModesTerm0,
+ "tabled pragma declaration", PredNameResult),
+ (
+ PredNameResult = ok(PredName, ModeList0),
+ (
+ PredOrFunc = predicate,
+ ModeList = ModeList0
+ ;
+ PredOrFunc = function,
+ list__append(ModeList0, FuncResultTerms, ModeList)
+ ),
+ (
+ convert_mode_list(ModeList, Modes)
+ ->
+ list__length(Modes, Arity0),
+ (
+ PredOrFunc = function
+ ->
+ Arity is Arity0 - 1
+ ;
+ Arity = Arity0
+ ),
+ Result = ok(pragma(tabled(TablingType, PredName, Arity,
+ yes(PredOrFunc), yes(Modes))))
+ ;
+ string__append("unknown mode in pragma ", PragmaName,
+ ErrorMessage),
+ Result = error(ErrorMessage, PredAndModesTerm)
+ )
+ ;
+ PredNameResult = error(Msg, Term),
+ Result = error(Msg, Term)
+ )
+ ;
+ string__append_list(["unexpected variable in `pragma ", PragmaName,
+ "'"], ErrorMessage),
+ Result = error(ErrorMessage, PredAndModesTerm0)
+ ).
:- pred convert_int_list(term::in, maybe1(list(int))::out) is det.
Index: compiler/purity.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/purity.m,v
retrieving revision 1.9
diff -u -r1.9 purity.m
--- purity.m 1998/03/03 17:35:55 1.9
+++ purity.m 1998/03/05 02:04:45
@@ -477,24 +477,55 @@
),
(
{ DeclPurity \= pure, Promised = yes } ->
- { NumErrors is NumErrors0 + 1 },
+ { NumErrors1 is NumErrors0 + 1 },
error_inconsistent_promise(ModuleInfo, PredInfo, PredId,
DeclPurity)
; { less_pure(DeclPurity, WorstPurity) } ->
- { NumErrors = NumErrors0 },
+ { NumErrors1 = NumErrors0 },
warn_exaggerated_impurity_decl(ModuleInfo, PredInfo, PredId,
DeclPurity, WorstPurity)
; { less_pure(Purity, DeclPurity), Promised = no } ->
- { NumErrors is NumErrors0 + 1 },
+ { NumErrors1 is NumErrors0 + 1 },
error_inferred_impure(ModuleInfo, PredInfo, PredId, Purity)
; { Purity = pure, Promised = yes } ->
- { NumErrors = NumErrors0 },
+ { NumErrors1 = NumErrors0 },
warn_unnecessary_promise_pure(ModuleInfo, PredInfo, PredId)
;
- { NumErrors = NumErrors0 }
+ { NumErrors1 = NumErrors0 }
+ ),
+ (
+ { \+ has_only_normal_evaluation(PredInfo) },
+ { Purity \= pure },
+ { Promised = no }
+ ->
+ error_invalid_eval_model_for_purity(ModuleInfo, PredInfo,
+ Purity, EvalErrors),
+ { NumErrors is NumErrors1 + EvalErrors }
+ ;
+ { NumErrors = NumErrors1 }
).
+% Returns true if all the modes of the given predinfo are evaluated using
+% the normal evaluation method. We dont want to table impure preds.
+:- pred has_only_normal_evaluation(pred_info).
+:- mode has_only_normal_evaluation(in) is semidet.
+
+has_only_normal_evaluation(PredInfo) :-
+ pred_info_procids(PredInfo, ProcIds),
+ pred_info_procedures(PredInfo, Procs),
+ has_only_normal_evaluation2(ProcIds, Procs).
+
+
+:- pred has_only_normal_evaluation2(list(proc_id), proc_table).
+:- mode has_only_normal_evaluation2(in, in) is semidet.
+
+has_only_normal_evaluation2([], _).
+has_only_normal_evaluation2([ProcId|Rest], Procs) :-
+ map__lookup(Procs, ProcId, ProcInfo),
+ proc_info_eval_method(ProcInfo, eval_normal),
+ has_only_normal_evaluation2(Rest, Procs).
+
% Infer the purity of a single (non-pragma c_code) predicate
:- pred compute_purity(list(clause), list(clause), pred_info, module_info,
@@ -824,6 +855,48 @@
)
).
+
+:- pred error_invalid_eval_model_for_purity(module_info, pred_info, purity,
+ int, io__state, io__state).
+:- mode error_invalid_eval_model_for_purity(in, in, in, out, di, uo) is det.
+
+error_invalid_eval_model_for_purity(Module, PredInfo, Purity, Errors) -->
+ { pred_info_procids(PredInfo, ProcIds) },
+ { pred_info_procedures(PredInfo, Procs) },
+ { pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
+ error_invalid_eval_model_for_purity2(ProcIds, Procs, PredOrFunc,
+ Module, Purity, Errors).
+
+:- pred error_invalid_eval_model_for_purity2(list(proc_id), proc_table,
+ pred_or_func, module_info, purity, int, io__state, io__state).
+:- mode error_invalid_eval_model_for_purity2(in, in, in, in, in, out,
+ di, uo) is det.
+
+error_invalid_eval_model_for_purity2([], _, _, _, _, 0) --> [].
+error_invalid_eval_model_for_purity2([ProcId|Rest], Procs, PredOrFunc, Module,
+ Purity, Errors) -->
+ { map__lookup(Procs, ProcId, ProcInfo) },
+ { proc_info_eval_method(ProcInfo, EvalMethod) },
+ (
+ { EvalMethod \= eval_normal }
+ ->
+ { proc_info_context(ProcInfo, Context) },
+ { eval_method_to_string(EvalMethod, EvalMethodS) },
+ prog_out__write_context(Context),
+ io__write_string("Error: pragma "),
+ io__write_string(EvalMethodS),
+ io__write_string(" not allowed for "),
+ hlds_out__write_pred_or_func(PredOrFunc),
+ io__write_string(" with purity "),
+ write_purity(Purity),
+ io__write_string(".\n"),
+ { Errors0 = 1 }
+ ;
+ { Errors0 = 0 }
+ ),
+ error_invalid_eval_model_for_purity2(Rest, Procs, PredOrFunc, Module,
+ Purity, Errors1),
+ { Errors is Errors0 + Errors1 }.
:- pred write_context_and_pred_id(module_info, pred_info, pred_id,
io__state, io__state).
Index: compiler/simplify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/simplify.m,v
retrieving revision 1.55
diff -u -r1.55 simplify.m
--- simplify.m 1998/03/03 17:35:58 1.55
+++ simplify.m 1998/03/05 02:04:47
@@ -433,14 +433,15 @@
simplify__goal_2(Goal0, GoalInfo0, Goal, GoalInfo, Info0, Info) :-
Goal0 = call(PredId, ProcId, Args, IsBuiltin, _, _),
+ simplify_info_get_module_info(Info0, ModuleInfo),
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo,
+ ProcInfo),
%
% check for calls to predicates with `pragma obsolete' declarations
%
(
simplify_do_warn(Info0),
- simplify_info_get_module_info(Info0, ModuleInfo),
- module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_markers(PredInfo, Markers),
check_marker(Markers, obsolete),
%
@@ -502,8 +503,13 @@
proc_info_argmodes(ProcInfo1, ArgModes),
simplify_info_get_common_info(Info1, CommonInfo1),
simplify__input_args_are_equiv(Args, HeadVars, ArgModes,
- CommonInfo1, ModuleInfo1)
- ->
+ CommonInfo1, ModuleInfo1),
+
+ %
+ % Only count procs using normal evaluation
+ %
+ proc_info_eval_method(ProcInfo, eval_normal)
+ ->
goal_info_get_context(GoalInfo0, Context2),
simplify_info_add_msg(Info1, warn_infinite_recursion(Context2),
Info2)
Index: compiler/stratify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/stratify.m,v
retrieving revision 1.15
diff -u -r1.15 stratify.m
--- stratify.m 1998/02/12 01:17:48 1.15
+++ stratify.m 1998/03/05 23:49:16
@@ -299,14 +299,7 @@
{ PredProcId = proc(PredId, ProcId) },
{ module_info_pred_info(Module0, PredId, PredInfo) },
globals__io_lookup_bool_option(warn_non_stratification, Warn),
- { pred_info_get_markers(PredInfo, Markers) },
- (
- { check_marker(Markers, memo) }
- ->
- { Error = yes }
- ;
- { Error = no }
- ),
+ { Error = no },
( ( { Error = yes ; Warn = yes } ),
{ map__search(HOInfo, PredProcId, HigherOrderInfo) }
->
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/switch_detection.m,v
retrieving revision 1.80
diff -u -r1.80 switch_detection.m
--- switch_detection.m 1998/02/12 01:17:49 1.80
+++ switch_detection.m 1998/02/19 00:51:48
@@ -538,8 +538,10 @@
:- mode fix_case_list(in, in, out) is det.
fix_case_list([], _, []).
-fix_case_list([Functor - DisjList | Cases0], GoalInfo,
+fix_case_list([Functor - DisjList0 | Cases0], GoalInfo,
[case(Functor, Goal) | Cases]) :-
+ % We need to put the list back the right way around.
+ list__reverse(DisjList0, DisjList),
disj_list_to_goal(DisjList, GoalInfo, Goal),
fix_case_list(Cases0, GoalInfo, Cases).
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/staff/zs/imp/mercury/doc/reference_manual.texi,v
retrieving revision 1.87
diff -u -r1.87 reference_manual.texi
--- reference_manual.texi 1998/03/03 17:38:59 1.87
+++ reference_manual.texi 1998/03/05 02:05:03
@@ -1185,7 +1185,7 @@
are as follows:
@example
-:- func length(list(T) = int.
+:- func length(list(T)) = int.
:- mode length(in_listskel) = out.
:- mode length(out_listskel) = in.
More information about the developers
mailing list