Tabling [1/3]
Oliver Hutchison
ohutch at students.cs.mu.OZ.AU
Mon Mar 23 16:00:17 AEDT 1998
Estimated hours taken: 250
Add support for tabling.
This change allows for model_det, model_semidet and model_non memoing,
minimal model and loop detection tabling.
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:
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. Support for partially instantiated modes is currently
missing as it represents a large amount of work for a case that
is currently not used.
compiler/module_qual.m:
compile/prog_data.m:
compiler/prog_io_pragma.m:
Add three new pragma types:
`memo'
`loop_check'
`minimal_model'
and code to support them.
compiler/simplify.m:
Don't report infinite recursion warning if a procedure has
minimal model evaluation.
compiler/stratify.m:
Change the stratification analyser so that it reports cases of
definite non-stratification. Rather than reporting warnings for
any code that is not definitely stratified.
Remove reference to the old memo marker.
compiler/switch_detection.m:
Fix a small bug where goal were being placed in reverse order.
Call list__reverse on the list of goals.
compiler/table_gen.m:
New module to do the actual tabling transformation.
compiler/notes/compiler_design.html:
Document addition of new tabling pass to the compiler.
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/mercury_deep_copy.c:
runtime/mercury_type_info.h:
runtime/mercury_type_info.c:
Move the make_type_info function into the mercury_type_info module
and make it public.
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:
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/16 03:56:50
@@ -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, EvalMethod) },
+ { determinism_to_code_model(InferredDetism, CodeMod) },
+ (
+ { valid_code_model_for_eval_method(EvalMethod, CodeMod) }
+ ->
+ {
+ 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(EvalMethod, EvalMethodS) },
+ io__write_string("Error: `pragma "),
+ io__write_string(EvalMethodS),
+ io__write_string("' declaration not allowed for procedure\n"),
+ prog_out__write_context(Context),
+ io__write_string(" with determinism `"),
+ mercury_output_det(InferredDetism),
+ io__write_string("'.\n"),
+ 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(EvalMethod), 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.191
diff -u -r1.191 hlds_out.m
--- hlds_out.m 1998/03/12 01:12:09 1.191
+++ hlds_out.m 1998/03/12 01:39:37
@@ -550,7 +550,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/17 06:59:25
@@ -111,6 +111,15 @@
; clauses
; none.
+ % The evaluation method that should be used for a pred
+
+:- type eval_method ---> eval_normal % normal mercury
+ % evaluation
+ ; eval_loop_check % loop check only
+ ; eval_memo % memoing + loop check
+ ; eval_minimal. % minimal model
+ % evaluation
+
% 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 +203,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 +944,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 +1031,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 +1079,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 +1090,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 +1100,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 +1164,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 +1280,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 +1306,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 +1532,56 @@
).
%-----------------------------------------------------------------------------%
+
+:- 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.
+
+ % Convert an evaluation method to a string.
+:- pred eval_method_to_string(eval_method, string).
+:- mode eval_method_to_string(in, out) is det.
+
+ % Return true if the given evaluation method requires a
+ % stratification check.
+:- pred eval_method_need_stratification(eval_method).
+:- mode eval_method_need_stratification(in) is semidet.
+
+ % Return the change a given evaluation method can do to a given
+ % determinism.
+:- 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_loop_check, model_non).
+valid_code_model_for_eval_method(eval_minimal, model_semi).
+valid_code_model_for_eval_method(eval_minimal, model_non).
+
+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_minimal, "minimal_model").
+
+eval_method_need_stratification(eval_minimal).
+
+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_minimal, Det0, Det) :-
+ det_conjunction_detism(semidet, Det0, Det).
+
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/10 01:57:11
@@ -587,7 +587,8 @@
% 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.
@@ -596,6 +597,14 @@
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 generator 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/instmap.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/instmap.m,v
retrieving revision 1.20
diff -u -r1.20 instmap.m
--- instmap.m 1998/03/03 17:34:42 1.20
+++ instmap.m 1998/03/18 05:43:24
@@ -270,6 +270,8 @@
:- import_module std_util, require.
+:- import_module io.
+
:- type instmap_delta == instmap.
:- type instmap ---> reachable(instmapping)
@@ -766,10 +768,17 @@
ModuleInfo1 = ModuleInfoPrime,
map__det_insert(InstMapping0, Var, Inst, InstMapping1)
;
+ gio(IO0),
+ io__print([InstA, InstB], IO0, IO1),
+ io__nl(IO1, _IO2),
error("merge_instmapping_delta_2: unexpected mode error")
),
merge_instmapping_delta_2(Vars, InstMap, InstMappingA, InstMappingB,
InstMapping1, InstMapping, ModuleInfo1, ModuleInfo).
+
+:- pred gio(io__state::uo) is det.
+
+:- pragma c_code(gio(I::uo), " I = 0").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.49
diff -u -r1.49 intermod.m
--- intermod.m 1998/03/18 17:30:33 1.49
+++ intermod.m 1998/03/23 01:45:33
@@ -179,7 +179,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/23 04:33:03
@@ -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,29 @@
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)
+ ;
+ { module_info_incr_errors(Module0, Module) },
+ prog_out__write_context(Context),
+ io__write_string("Error: `:- pragma "),
+ { eval_method_to_string(Type, EvalMethodS) },
+ io__write_string(EvalMethodS),
+ io__write_string(
+"' declaration requires the base_type_layout\n"),
+ prog_out__write_context(Context),
+ io__write_string(
+" structures. Use the --type-layout flag to enable them.\n")
+ ),
+ { Info = Info0 }
+ ;
+ % don't worry about any pragma decs but c_code, tabling
% and fact_table here
{ Module = Module0 },
{ Info = Info0 }
@@ -698,38 +719,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 +2494,195 @@
%-----------------------------------------------------------------------------%
+:- 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, Arity, MaybePredOrFunc,
+ MaybeModes, Context, ModuleInfo0, ModuleInfo) -->
+ { module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
+ { eval_method_to_string(EvalMethod, EvalMethodS) },
+
+ % Find out if we are tabling a predicate or a function
+ (
+ { MaybePredOrFunc = yes(PredOrFunc0) }
+ ->
+ { PredOrFunc = PredOrFunc0 },
+
+ % 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, PredIds0) }
+ ->
+ { PredIds = PredIds0 },
+ { ModuleInfo1 = ModuleInfo0 }
+ ;
+ { 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) },
+ { module_info_set_predicate_table(ModuleInfo0,
+ PredicateTable1, ModuleInfo1) },
+ { PredIds = [PredId] }
+ )
+ ;
+ (
+ { predicate_table_search_sym_arity(PredicateTable0,
+ PredName, Arity, PredIds0) }
+ ->
+ { ModuleInfo1 = ModuleInfo0 },
+ { PredIds = PredIds0 }
+ ;
+ { module_info_name(ModuleInfo0, ModuleName) },
+ { string__format("pragma (%s)", [s(EvalMethodS)],
+ Message1) },
+ maybe_undefined_pred_error(PredName, Arity,
+ predicate, Context, Message1),
+ { preds_add_implicit(PredicateTable0,
+ ModuleName, PredName, Arity, Context,
+ predicate, PredId, PredicateTable1) },
+ { module_info_set_predicate_table(ModuleInfo0,
+ PredicateTable1, ModuleInfo1) },
+ { PredIds = [PredId] }
+ )
+ ),
+ list__foldl2(module_add_pragma_tabled_2(EvalMethod, PredName,
+ Arity, MaybePredOrFunc, MaybeModes, Context),
+ PredIds, ModuleInfo1, ModuleInfo).
+
+
+:- pred module_add_pragma_tabled_2(eval_method, sym_name, int,
+ maybe(pred_or_func), maybe(list(mode)), term__context,
+ pred_id, module_info, module_info, io__state, io__state).
+:- mode module_add_pragma_tabled_2(in, in, in, in, in, in, in, in, out,
+ di, uo) is det.
+
+module_add_pragma_tabled_2(EvalMethod, PredName, Arity0, MaybePredOrFunc,
+ MaybeModes, Context, PredId, ModuleInfo0, ModuleInfo) -->
+
+ % Lookup the pred_info for this pred,
+ { module_info_get_predicate_table(ModuleInfo0, PredicateTable) },
+ { predicate_table_get_preds(PredicateTable, Preds) },
+ { map__lookup(Preds, PredId, PredInfo0) },
+
+ % Find out if we are tabling a predicate or a function
+ (
+ { MaybePredOrFunc = yes(PredOrFunc0) }
+ ->
+ { PredOrFunc = PredOrFunc0 }
+ ;
+ { pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc) }
+ ),
+ (
+ { 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")
+ ;
+ []
+ ),
+
+ (
+ { pred_info_is_imported(PredInfo0) }
+ ->
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+ prog_out__write_context(Context),
+ io__write_string("Error: `:- pragma "),
+ io__write_string(EvalMethodS),
+ io__write_string("' declaration for imported "),
+ hlds_out__write_call_id(PredOrFunc, PredName/Arity),
+ io__write_string(".\n")
+ ;
+ % 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(PredInfo0, 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(PredInfo0, Procs,
+ PredInfo) },
+ { module_info_set_pred_info(ModuleInfo1,
+ PredId, PredInfo, ModuleInfo) }
+ ;
+ { module_info_incr_errors(ModuleInfo1,
+ ModuleInfo) },
+ 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")
+ )
+ ;
+ { set_eval_method_list(ExistingProcs, EvalMethod,
+ Procs0, Procs) },
+ { pred_info_set_procedures(PredInfo0, 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 +3499,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 +3992,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.79
diff -u -r1.79 mercury_compile.m
--- mercury_compile.m 1998/03/20 02:58:08 1.79
+++ mercury_compile.m 1998/03/23 01:45:37
@@ -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.
@@ -742,10 +742,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"), !,
@@ -1270,6 +1273,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/16 04:26:46
@@ -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,124 @@
% 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_context(ProcInfo, Context) },
+ { eval_method_to_string(EvalMethod, EvalMethodS) },
+ globals__io_lookup_bool_option(verbose_errors,
+ VerboseErrors),
+ { proc_info_argmodes(ProcInfo, Modes) },
+ (
+ \+ { only_fully_in_out_modes(Modes,
+ ModuleInfo0) }
+ ->
+ prog_out__write_context(Context),
+ 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(
+" partially instantiated modes.\n"),
+ ( { VerboseErrors = yes } ->
+ io__write_string(
+" Tabling of predicates/functions with partially instantiated modes
+ is not currently implemented.\n")
+ ;
+ []
+ ),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo1) }
+ ;
+ { ModuleInfo1 = ModuleInfo0 }
+ ),
+ (
+ \+ { only_nonunique_modes(Modes,
+ ModuleInfo1) }
+ ->
+ prog_out__write_context(Context),
+ 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 modes.\n"),
+ ( { VerboseErrors = yes } ->
+ io__write_string(
+" Tabling of predicates/functions with unique modes is not allowed
+ as this would lead to a copying of the unique arguments which
+ would result in them no longer being unique.\n")
+ ;
+ []
+ ),
+ { module_info_incr_errors(ModuleInfo1, ModuleInfo2) }
+ ;
+ { ModuleInfo2 = ModuleInfo1 }
+ )
+ ;
+ { ModuleInfo2 = ModuleInfo0 }
+
+ ),
+ proc_check_eval_methods(Rest, PredId, ModuleInfo2, ModuleInfo).
+
+:- pred only_fully_in_out_modes(list(mode), module_info).
+:- mode only_fully_in_out_modes(in, in) is semidet.
+
+only_fully_in_out_modes([], _).
+only_fully_in_out_modes([Mode|Rest], ModuleInfo) :-
+ mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
+ (
+ inst_is_ground(ModuleInfo, InitialInst)
+ ;
+ inst_is_free(ModuleInfo, InitialInst),
+ (
+ inst_is_free(ModuleInfo, FinalInst)
+ ;
+ inst_is_ground(ModuleInfo, FinalInst)
+ )
+ ),
+ only_fully_in_out_modes(Rest, ModuleInfo).
+
+:- pred only_nonunique_modes(list(mode), module_info).
+:- mode only_nonunique_modes(in, in) is semidet.
+
+only_nonunique_modes([], _).
+only_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),
+ only_nonunique_modes(Rest, ModuleInfo).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/module_qual.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/module_qual.m,v
retrieving revision 1.35
diff -u -r1.35 module_qual.m
--- module_qual.m 1998/03/18 08:07:41 1.35
+++ module_qual.m 1998/03/23 01:45:38
@@ -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.67
diff -u -r1.67 modules.m
--- modules.m 1998/03/20 05:52:29 1.67
+++ modules.m 1998/03/23 01:45:39
@@ -744,7 +744,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).
@@ -753,6 +752,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/16 05:24:24
@@ -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/13 00:58:30
@@ -431,9 +431,15 @@
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)),
+ parse_tabling_pragma(ModuleName, "memo", eval_memo,
+ PragmaTerms, ErrorTerm, Result).
+parse_pragma_type(ModuleName, "loop_check", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
+ parse_tabling_pragma(ModuleName, "loop_check", eval_loop_check,
+ PragmaTerms, ErrorTerm, Result).
+parse_pragma_type(ModuleName, "minimal_model", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
+ parse_tabling_pragma(ModuleName, "minimal_model", eval_minimal,
PragmaTerms, ErrorTerm, Result).
parse_pragma_type(ModuleName, "obsolete", PragmaTerms,
@@ -778,6 +784,99 @@
PragmaVars = [], % return any old junk in PragmaVars
Error = yes("arguments not in form 'Var :: mode'")
).
+
+
+:- pred parse_tabling_pragma(module_name, string, eval_method, list(term),
+ term, maybe1(item)).
+:- mode parse_tabling_pragma(in, in, in, in, in, out) is det.
+
+parse_tabling_pragma(ModuleName, PragmaName, TablingType, PragmaTerms,
+ ErrorTerm, Result) :-
+ (
+ PragmaTerms = [PredAndModesTerm0]
+ ->
+ (
+ % Is this a simple pred/arity pragma
+ PredAndModesTerm0 = term__functor(term__atom("/"),
+ [PredNameTerm, ArityTerm], _)
+ ->
+ (
+ parse_implicitly_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 = []
+ ),
+ string__append_list(["`pragma ", PragmaName, "(...)' declaration"],
+ ParseMsg),
+ parse_qualified_term(PredAndModesTerm, PredAndModesTerm0,
+ ParseMsg, 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_list(["syntax error in pragma '",
+ PragmaName, "(...)' declaration"],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)
+ )
+ ;
+ string__append_list(["wrong number of arguments in `pragma ",
+ PragmaName, "(...)' declaration"], ErrorMessage),
+ Result = error(ErrorMessage, ErrorTerm)
+ ).
:- pred convert_int_list(term::in, maybe1(list(int))::out) is det.
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/16 02:14:53
@@ -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,15 @@
proc_info_argmodes(ProcInfo1, ArgModes),
simplify_info_get_common_info(Info1, CommonInfo1),
simplify__input_args_are_equiv(Args, HeadVars, ArgModes,
- CommonInfo1, ModuleInfo1)
- ->
+ CommonInfo1, ModuleInfo1),
+
+ %
+ % Don't count procs using minimal evaluation as they
+ % should always terminate if they have a finite number
+ % of answers.
+ %
+ \+ proc_info_eval_method(ProcInfo, eval_minimal)
+ ->
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/23 04:34:40
@@ -8,9 +8,7 @@
% Main authors: ohutch, conway.
-% This module performs stratification analysis. It is highly
-% conservative and will emit errors for any calls outside the module or
-% for any calls to higher order predicates
+% This module performs stratification analysis.
% It works by processing the call graph 1 scc at a time. It traverses
% the goal for each procedure in the scc and reports an error or
% warning (depending on the context) for any negated call to another member
@@ -41,9 +39,7 @@
% If the "warn-non-stratification" option is set this
% pred will check the entire module for stratification
% otherwise it will only check preds in the stratified_preds
- % set of the module_info structure. If possible non
- % stratification is detected in loops containing these preds
- % an error will be issued otherwise a warning will be issued.
+ % set of the module_info structure.
:- pred stratify__check_stratification(module_info, module_info,
io__state, io__state).
:- mode stratify__check_stratification(in, out, di, uo) is det.
@@ -101,27 +97,24 @@
:- mode first_order_check_sccs(in, in, in, in, out, di, uo) is det.
first_order_check_sccs([], _, _, Module, Module) --> [].
-first_order_check_sccs([SCCl - SCCs|Rest], StratifiedPreds, Warn,
+first_order_check_sccs([SCCl - SCCs|Rest], StratifiedPreds, Warn0,
Module0, Module) -->
- ( % if there is a pred that must be stratified in the
- % current scc then emit errors instead of warnings
- % if we encounter non stratification
+ (
{ set__intersect(SCCs, StratifiedPreds, I) },
{ set__empty(I) }
->
- { Error = no }
+ { Warn = Warn0 }
;
- { Error = yes }
+ { Warn = yes }
),
(
- { Error = yes
- ; Warn = yes }
+ { Warn = yes }
->
- first_order_check_scc(SCCl, Error, Module0, Module1)
+ first_order_check_scc(SCCl, no, Module0, Module1)
;
{ Module1 = Module0 }
),
- first_order_check_sccs(Rest, StratifiedPreds, Warn, Module1, Module).
+ first_order_check_sccs(Rest, StratifiedPreds, Warn0, Module1, Module).
:- pred first_order_check_scc(list(pred_proc_id), bool, module_info,
module_info, io__state, io__state).
@@ -195,8 +188,8 @@
{ Module = Module0 }
).
first_order_check_goal(unify(_Var, _RHS, _Mode, _Uni, _Context), _GoalInfo,
- _Negated, _WholeScc, _ThisPredProcId, _, Module, Module) --> [].
-first_order_check_goal(call(CPred, CProc, _Args, BuiltinState, _Contex, _Sym),
+ _Negated, _WholeScc, _ThisPredProcId, _, Module, Module) --> [].
+first_order_check_goal(call(CPred, CProc, _Args, _BuiltinState, _Contex, _Sym),
GInfo, Negated, WholeScc, ThisPredProcId,
Error, Module0, Module) -->
{ Callee = proc(CPred, CProc) },
@@ -209,34 +202,14 @@
"call introduces a non-stratified loop",
Error, Module0, Module)
;
- { BuiltinState = not_builtin },
- { \+ local_proc(Module0, Callee) }
- ->
- { goal_info_get_context(GInfo, Context) },
- emit_message(ThisPredProcId, Context,
- "call to non-local predicate may introduce a non-stratified loop",
- Error, Module0, Module)
-
- ;
{ Module = Module0 }
).
first_order_check_goal(higher_order_call(_Var, _Vars, _Types, _Modes,
- _Det, _PredOrFunc),
- GInfo, _Negated, _WholeScc, ThisPredProcId, Error,
- Module0, Module) -->
- { goal_info_get_context(GInfo, Context) },
- emit_message(ThisPredProcId, Context,
- "higher order call may introduce a non-stratified loop",
- Error, Module0, Module).
-
- % XXX This is very conservative.
+ _Det, _PredOrFunc), _GInfo, _Negated, _WholeScc, _ThisPredProcId,
+ _Error, Module, Module) --> [].
first_order_check_goal(class_method_call(_Var, _Num, _Vars, _Types, _Modes,
- _Det), GInfo, _Negated, _WholeScc, ThisPredProcId, Error,
- Module0, Module) -->
- { goal_info_get_context(GInfo, Context) },
- emit_message(ThisPredProcId, Context,
- "class method call may introduce a non-stratified loop",
- Error, Module0, Module).
+ _Det), _GInfo, _Negated, _WholeScc, _ThisPredProcId, _Error,
+ Module, Module) --> [].
:- pred first_order_check_goal_list(list(hlds_goal), bool,
list(pred_proc_id), pred_proc_id, bool, module_info,
@@ -266,13 +239,6 @@
first_order_check_case_list(Goals, Negated, WholeScc, ThisPredProcId,
Error, Module1, Module).
-:- pred local_proc(module_info, pred_proc_id).
-:- mode local_proc(in, in) is semidet.
-local_proc(Module, proc(PredId, ProcId)) :-
- module_info_pred_info(Module, PredId, PredInfo),
- pred_info_non_imported_procids(PredInfo, ProcIds),
- list__member(ProcId, ProcIds).
-
%-----------------------------------------------------------------------------%
% XXX : Currently we don't allow the higher order case so this code
@@ -299,14 +265,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: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.17
diff -u -r1.17 compiler_design.html
--- compiler_design.html 1998/01/10 09:14:51 1.17
+++ compiler_design.html 1998/03/12 06:34:25
@@ -353,7 +353,13 @@
<p>
-The first two passes of this stage are code simplifications.
+The first pass of this stage does tabling transformations (table_gen.m).
+This involves the insertion of several calls to tabling predicates
+defined in mercury_builtin.m and the addition of some scaffolding structure.
+
+<p>
+
+The next two passes of this stage are code simplifications.
<ul>
<li> introduction of type_info arguments for polymorphic predicates,
@@ -374,7 +380,7 @@
<p>
-To improve efficiency, the above two passes are actually combined into
+To improve efficiency, the above two passes are actually combined into
one - polymorphism.m calls calls lambda__transform_lambda directly.
<p>
More information about the developers
mailing list