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