diff: tabling code (compiler only)

Oliver Hutchison ohutch at students.cs.mu.oz.au
Wed Sep 24 11:54:30 AEST 1997



Estimated time taken : 200 

Added code to handle tabling pragmas and to generate tabling code for the
memo and loop_check cases. 
The changes to the runtime are not included in this diff.


compiler/code_gen.m :
	Added code to call the new tabled prolog and epilog code generators 
	when appropriate. 

compiler/code_info.m :
	Moved code_info__get_exprn_info/3 out of the implementation and
	placed it in the interface so that table_gen could use the
	exprn_info for register allocation.

compiler/det_analysis.m :
	Added code to allow an evaluation model to change the detism. This 
	can happen in the case of minimal model? evaluation where a det 
	proc will become semidet.

compiler/det_report.m :
	Added code to check for detism errors in tabled evaluation
	models.

compiler/hlds_pred.m :
	Added new field to proc_info that indicates which evaluation
	model should be used to evaluate the proc.
	Added some preds to describe the various new evaluation models.

compiler/inlining.m :
	Added code to prevent tabled procs from being inlined. Perhaps
	we could add support for inlining of tabled procs?

compiler/llds_out.m :
	Added note about duplicate code. 

compiler/hlds_out.m :
compiler/prog_data.m :
compiler/make_hlds.m :
compiler/module_qual.m :
compiler/mercury_to_mercury.m :
	Removed code referring to the memo transformation.
	Added code to handle the various tabling pragmas.

compiler/prog_io_pragma.m :
	Removed code to parse memo pragmas.
	Added code to parse tabled pragmas. The tabling pragmas can be
	defined in two ways 1) you can use pred name + modes 2) you can
	use pred name + arity. If pred name and arity is given then only 
	the procs with modes for which the tabling model are valid will 
	be generated with tables.

compiler/stratify.m :
	Removed code that referred to the memo transformation.

compiler/type_util.m :
	Added two predicates that return the C structure name for
	type_info and type_layout given a type id.

compiler/table_gen.m :
	New module with code to generate the tabled prolog and epilog
	code for tabled pocs. Most of the actual work of tabling is done by
	the runtime this module generates calls to the runtime code.
 

Index: compiler/code_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_gen.m,v
retrieving revision 1.34
diff -u -r1.34 code_gen.m
--- code_gen.m	1997/09/14 09:20:35	1.34
+++ code_gen.m	1997/09/16 02:00:59
@@ -14,7 +14,7 @@
 %	sequences to code_info, and other modules. The generation of
 %	calls is done by call_gen, switches by switch_gen, if-then-elses
 %	by ite_gen, unifications by unify_gen, disjunctions by disj_gen,
-%	and pragma_c_codes by pragma_c_gen.
+%	tabled procs by table_gen and pragma_c_codes by pragma_c_gen.
 %
 %	The general scheme for generating semideterministic code is
 %	to treat it as deterministic code, and have a fall-through
@@ -36,7 +36,7 @@
 		% Translate a HLDS structure into an LLDS
 
 :- pred generate_code(module_info, module_info, list(c_procedure),
-						io__state, io__state).
+			io__state, io__state).
 :- mode generate_code(in, out, out, di, uo) is det.
 
 :- pred generate_proc_code(proc_info, proc_id, pred_id, module_info, 
@@ -59,7 +59,7 @@
 
 :- implementation.
 
-:- import_module call_gen, unify_gen, ite_gen, switch_gen.
+:- import_module call_gen, unify_gen, ite_gen, switch_gen, table_gen.
 :- import_module disj_gen, pragma_c_gen, globals, options, hlds_out.
 :- import_module code_aux, middle_rec, passes_aux.
 :- import_module code_util, type_util, mode_util.
@@ -162,6 +162,8 @@
 		ContInfo0, CellCount0, ContInfo, CellCount, Proc) -->
 		% find out if the proc is deterministic/etc
 	{ proc_info_interface_code_model(ProcInfo, CodeModel) },
+		% find the eval model
+	{ proc_info_eval_model(ProcInfo, EvalModel) },
 		% get the goal for this procedure
 	{ proc_info_goal(ProcInfo, Goal) },
 		% get the information about this procedure that we need.
@@ -189,8 +191,8 @@
 		PredId, ProcId, ProcInfo, InitialInst, FollowVars,
 		ModuleInfo, CellCount0, ContInfo0, CodeInfo0) },
 		% generate code for the procedure
-	{ generate_category_code(CodeModel, Goal, CodeTree, SUsed, CodeInfo0,
-		CodeInfo) },
+	{ generate_category_code(CodeModel, EvalModel, Goal, CodeTree, SUsed, 
+		CodeInfo0, CodeInfo) },
 		% extract the new continuation_info and cell count
 	{ code_info__get_continuation_info(ContInfo1, CodeInfo, _CodeInfo1) },
 	{ code_info__get_cell_count(CellCount, CodeInfo, _CodeInfo2) },
@@ -231,13 +233,28 @@
 	{ proc_id_to_int(ProcId, LldsProcId) },
 	{ Proc = c_procedure(Name, Arity, LldsProcId, Instructions) }.
 
-:- pred generate_category_code(code_model, hlds_goal, code_tree, maybe(int),
-				code_info, code_info).
-:- mode generate_category_code(in, in, out, out, in, out) is det.
+:- pred generate_category_code(code_model, eval_model, hlds_goal, code_tree, 
+		maybe(int), code_info, code_info).
+:- mode generate_category_code(in, in, in, out, out, in, out) is det.
 
-generate_category_code(model_det, Goal, Instrs, Used) -->
+generate_category_code(model_det, EvalModel, Goal, Instrs, Used) -->
 		% generate the code for the body of the clause
 	(
+		{ EvalModel = model_memo 
+		; EvalModel = model_loop_check }
+	->
+		% Make a new failure cont (not model_non)
+		code_info__manufacture_failure_cont(no),
+		
+		% generate the code for the body of the clause
+		code_gen__generate_goal(model_det, Goal, Instr1),
+		table_gen__generate_det_prolog(EvalModel, Instr0, Used),
+		table_gen__generate_det_epilog(EvalModel, Instr2),
+		
+		% combine the prolog, body and epilog
+		{ Instrs = tree(Instr0, tree(Instr1, Instr2)) }
+		
+	;	
 		code_info__get_globals(Globals),
 		{ globals__lookup_bool_option(Globals, middle_rec, yes) },
 		middle_rec__match_and_generate(Goal, MiddleRecInstrs)
@@ -279,19 +296,26 @@
 		{ Instrs = tree(Instr0, tree(Instr1, Instr2)) }
 	).
 
-generate_category_code(model_semi, Goal, Instrs, Used) -->
+generate_category_code(model_semi, EvalModel, Goal, Instrs, Used) -->
 		% Make a new failure cont (not model_non)
 	code_info__manufacture_failure_cont(no),
 
-		% generate the code for the body of the clause
+	% generate the code for the body of the clause
 	code_gen__generate_goal(model_semi, Goal, Instr1),
-	code_gen__generate_semi_prolog(Instr0, Used),
-	code_gen__generate_semi_epilog(Instr2),
-
+	(
+		{ EvalModel = model_memo 
+		; EvalModel = model_loop_check }
+	->
+		table_gen__generate_semi_prolog(EvalModel, Instr0, Used),
+		table_gen__generate_semi_epilog(EvalModel, Instr2)
+	;
+		code_gen__generate_semi_prolog(Instr0, Used),
+		code_gen__generate_semi_epilog(Instr2)
+	),
 		% combine the prolog, body and epilog
 	{ Instrs = tree(Instr0, tree(Instr1, Instr2)) }.
 
-generate_category_code(model_non, Goal, Instrs, Used) -->
+generate_category_code(model_non, EvalModel, Goal, Instrs, Used) -->
 		% Make a failure continuation, we lie and
 		% say that it is nondet, and then unset it
 		% so that it points to do_fail
@@ -299,9 +323,15 @@
 
 		% generate the code for the body of the clause
 	code_gen__generate_goal(model_non, Goal, Instr1),
-	code_gen__generate_non_prolog(Instr0, Used),
-	code_gen__generate_non_epilog(Instr2),
-
+	(
+		{ EvalModel = model_memo }
+	->
+		table_gen__generate_memo_non_prolog(Instr0, Used),
+		table_gen__generate_memo_non_epilog(Instr2)
+	;
+		code_gen__generate_non_prolog(Instr0, Used),
+		code_gen__generate_non_epilog(Instr2)
+	),
 		% combine the prolog, body and epilog
 	{ Instrs = tree(Instr0, tree(Instr1, Instr2)) }.
 
Index: compiler/code_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_info.m,v
retrieving revision 1.212
diff -u -r1.212 code_info.m
--- code_info.m	1997/09/14 03:54:36	1.212
+++ code_info.m	1997/09/16 02:01:01
@@ -35,7 +35,7 @@
 
 :- import_module hlds_pred, hlds_goal, llds, instmap.
 :- import_module globals.
-:- import_module bool, set, std_util, assoc_list.
+:- import_module bool, set, std_util, assoc_list, code_exprn.
 
 :- implementation.
 
@@ -123,6 +123,10 @@
 :- pred code_info__set_continuation_info(continuation_info, 
 		code_info, code_info).
 :- mode code_info__set_continuation_info(in, in, out) is det.
+		
+		% Get the exprn info structure for the current pred 
+:- pred code_info__get_exprn_info(exprn_info, code_info, code_info).
+:- mode code_info__get_exprn_info(out, in, out) is det.
 
 %---------------------------------------------------------------------------%
 
@@ -139,9 +143,6 @@
 
 :- pred code_info__set_cell_count(int, code_info, code_info).
 :- mode code_info__set_cell_count(in, in, out) is det.
-
-:- pred code_info__get_exprn_info(exprn_info, code_info, code_info).
-:- mode code_info__get_exprn_info(out, in, out) is det.
 
 :- pred code_info__set_exprn_info(exprn_info, code_info, code_info).
 :- mode code_info__set_exprn_info(in, in, out) is det.
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_analysis.m,v
retrieving revision 1.122
diff -u -r1.122 det_analysis.m
--- det_analysis.m	1997/09/01 14:01:06	1.122
+++ det_analysis.m	1997/09/16 02:01:12
@@ -255,8 +255,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_model(Proc0, EvalModel),
+	eval_model_change_to_determinism(EvalModel, 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.40
diff -u -r1.40 det_report.m
--- det_report.m	1997/09/01 14:01:15	1.40
+++ det_report.m	1997/09/18 01:25:51
@@ -99,6 +99,7 @@
 :- import_module passes_aux.
 
 :- import_module bool, int, list, map, set, varset, std_util, term, require.
+:- import_module string.
 
 %-----------------------------------------------------------------------------%
 
@@ -118,25 +119,27 @@
 		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(
 				warn_det_decls_too_lax,
 				ShouldIssueWarning),
-			( { ShouldIssueWarning = yes } ->
+			( 	
+				{ ShouldIssueWarning = yes }
+			->
 				{ Message = "  warning: determinism declaration could be tighter.\n" },
 				report_determinism_problem(PredId,
 					ProcId, ModuleInfo0, Message,
@@ -144,25 +147,53 @@
 			;
 				[]
 			),
-			{ 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 model
+	{ proc_info_eval_model(ProcInfo0, EvalModel0) },
+	{ determinism_to_code_model(InferredDetism, CodeMod) },
+	( 
+		{ valid_code_model_for_eval_model(EvalModel0, CodeMod,
+			EvalModel) }
+	->
+		{
+		    proc_info_set_eval_model(ProcInfo0, EvalModel, 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_model_to_string(EvalModel0, EvalModelS) },
+		{ string__append_list([
+			"Error: Invalid determinism for 'pragma ",
+			EvalModelS,
+			"(...)'\n"], ErrorMessage) },
+		io__write_string(ErrorMessage),
+		{ module_info_incr_errors(ModuleInfo1, ModuleInfo) }
 	).
 
+
 :- 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.
@@ -183,8 +214,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.
@@ -226,6 +257,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"),
@@ -280,7 +312,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_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_out.m,v
retrieving revision 1.172
diff -u -r1.172 hlds_out.m
--- hlds_out.m	1997/09/01 14:02:10	1.172
+++ hlds_out.m	1997/09/16 02:01:31
@@ -503,7 +503,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__write_marker(Marker) -->
 	{ hlds_out__marker_name(Marker, Name) },
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_pred.m,v
retrieving revision 1.35
diff -u -r1.35 hlds_pred.m
--- hlds_pred.m	1997/07/27 15:00:33	1.35
+++ hlds_pred.m	1997/07/28 01:32:19
@@ -109,6 +109,21 @@
 			;	clauses		
 			;	none.
 
+	% The evaluation model that should be used for a pred
+
+:- type eval_model	--->	model_normal		% normal mercury 
+							% evaluation
+			;	model_memo		% memoing evaluation
+			;	model_loop_check	% memoing + loop check
+			;	model_minimal		% minimal model 
+							% evaluation
+			;	model_well_founded	% well founded model
+							% evaluation
+			;	if_valid(eval_model).	% 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.
@@ -205,18 +220,15 @@
 				% 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
+	;	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).
 
 :- type marker_status
 	--->	request(marker)
 	;	done(marker).
 
+
+
 	% Various predicates for accessing the information stored in the
 	% pred_id and pred_info data structures.
 
@@ -487,7 +499,8 @@
 
 pred_info_set_procedures(PredInfo0, Procedures, PredInfo) :-
 	PredInfo0 = predicate(A, B, C, D, _, F, G, H, I, J, K, L, M, N),
-	PredInfo = predicate(A, B, C, D, Procedures, F, G, H, I, J, K, L, M, N).
+	PredInfo = predicate(A, B, C, D, Procedures, F, G, H, I, J, K, 
+		L, M, N).
 
 pred_info_context(PredInfo, Context) :-
 	PredInfo = predicate(_, _, _, _, _, Context, _, _, _, _, _, _, _, _).
@@ -496,7 +509,8 @@
 	PredInfo = predicate(_, _, _, _, _, _, Module, _, _, _, _, _, _, _).
 
 pred_info_name(PredInfo, PredName) :-
-	PredInfo = predicate(_, _, _, _, _, _, _, PredName, _, _, _, _, _, _).
+	PredInfo = predicate(_, _, _, _, _, _, _, PredName, _, _, 
+		_, _, _, _).
 
 pred_info_arity(PredInfo, Arity) :-
 	PredInfo = predicate(_, _, _, _, _, _, _, _, Arity, _, _, _, _, _).
@@ -522,14 +536,16 @@
 
 pred_info_mark_as_external(PredInfo0, PredInfo) :-
 	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, _, K, L, M, N),
-	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, imported, K, L, M, N).
+	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, imported, K, L, 
+		M, N).
 
 pred_info_set_import_status(PredInfo0, Status, PredInfo) :-
 	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, _, K, L, M, N),
 	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, Status, K, L, M, N).
 
 pred_info_typevarset(PredInfo, TypeVarSet) :-
-	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, TypeVarSet, _, _, _).
+	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, TypeVarSet, 
+		_, _, _).
 
 pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo) :-
 	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, _, L, M, N),
@@ -537,11 +553,13 @@
 				N).
 
 pred_info_get_goal_type(PredInfo, GoalType) :-
-	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, GoalType, _, _).
+	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, GoalType, 
+		_, _).
 
 pred_info_set_goal_type(PredInfo0, GoalType, PredInfo) :-
 	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, _, M, N),
-	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, GoalType, M, N).
+	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, GoalType, 
+		M, N).
 
 pred_info_requested_inlining(PredInfo0) :-
 	pred_info_get_marker_list(PredInfo0, Markers),
@@ -556,7 +574,8 @@
 
 pred_info_set_marker_list(PredInfo0, Markers, PredInfo) :-
 	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, _, N),
-	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, L, Markers, N).
+	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, L, Markers, 
+		N).
 
 pred_info_get_is_pred_or_func(PredInfo, IsPredOrFunc) :-
 	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, _,
@@ -688,6 +707,12 @@
 :- pred proc_info_set_typeinfo_varmap(proc_info, map(tvar, var), proc_info).
 :- mode proc_info_set_typeinfo_varmap(in, in, out) is det.
 
+:- pred proc_info_eval_model(proc_info, eval_model).
+:- mode proc_info_eval_model(in, out) is det.
+
+:- pred proc_info_set_eval_model(proc_info, eval_model, proc_info).
+:- mode proc_info_set_eval_model(in, in, out) is det.
+
 :- pred proc_info_maybe_declared_argmodes(proc_info, maybe(list(mode))).
 :- mode proc_info_maybe_declared_argmodes(in, out) is det.
 
@@ -743,8 +768,9 @@
 					% for code generation
 			map(tvar, var),	% typeinfo vars for
 					% type parameters
-			maybe(list(mode))
+			maybe(list(mode)),
 					% declared modes of args
+			eval_model	% how should the proc be evaluated	
 		).
 
 
@@ -772,7 +798,7 @@
 	NewProc = procedure(
 		MaybeDet, BodyVarSet, BodyTypes, HeadVars, Modes, MaybeArgLives,
 		ClauseBody, MContext, StackSlots, InferredDet, CanProcess,
-		ArgInfo, InitialLiveness, TVarsMap, DeclaredModes
+		ArgInfo, InitialLiveness, TVarsMap, DeclaredModes, model_normal
 	).
 
 proc_info_set(DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
@@ -782,7 +808,7 @@
 	ProcInfo = procedure(
 		DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
 		HeadLives, Goal, Context, StackSlots, InferredDetism,
-		CanProcess, ArgInfo, Liveness, TVarMap, no).
+		CanProcess, ArgInfo, Liveness, TVarMap, no, model_normal).
 
 proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, Detism, Goal,
 		Context, TVarMap, ProcInfo) :-
@@ -791,13 +817,13 @@
 	MaybeHeadLives = no,
 	ProcInfo = procedure(yes(Detism), VarSet, VarTypes, HeadVars, HeadModes,
 		MaybeHeadLives, Goal, Context, StackSlots, Detism, yes, [],
-		Liveness, TVarMap, no).
+		Liveness, TVarMap, no, model_normal).
 
 proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal, ProcInfo) :-
 	ProcInfo0 = procedure(A, _, _, _, E, F, _,
-		H, I, J, K, L, M, N, O),
+		H, I, J, K, L, M, N, O, P),
 	ProcInfo = procedure(A, VarSet, VarTypes, HeadVars, E, F, Goal,
-		H, I, J, K, L, M, N, O).
+		H, I, J, K, L, M, N, O, P).
 
 proc_info_interface_determinism(ProcInfo, Determinism) :-
 	proc_info_declared_determinism(ProcInfo, MaybeDeterminism),
@@ -846,46 +872,55 @@
 	instmap__from_assoc_list(InstAL, InstMap).
 
 proc_info_declared_determinism(ProcInfo, Detism) :-
-	ProcInfo = procedure(Detism, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
+	ProcInfo = procedure(Detism, _, _, _, _, _, _, _, _, _, _, _, _, _, 
+		_, _).
 proc_info_variables(ProcInfo, VarSet) :-
-	ProcInfo = procedure(_, VarSet, _, _, _, _, _, _, _, _, _, _, _, _, _).
+	ProcInfo = procedure(_, VarSet, _, _, _, _, _, _, _, _, _, _, _, _, 
+		_, _).
 proc_info_vartypes(ProcInfo, VarTypes) :-
 	ProcInfo = procedure(_, _, VarTypes, _, _, _, _, _, 
-		_, _, _, _, _, _, _).
+		_, _, _, _, _, _, _, _).
 proc_info_headvars(ProcInfo, HeadVars) :-
 	ProcInfo = procedure(_, _, _, HeadVars, _, _, _, _, _,
-		_, _, _, _, _, _).
+		_, _, _, _, _, _, _).
 proc_info_argmodes(ProcInfo, Modes) :-
-	ProcInfo = procedure(_, _, _, _, Modes, _, _, _, _, _, _, _, _, _, _).
+	ProcInfo = procedure(_, _, _, _, Modes, _, _, _, _, _, _, _, _, _, 
+		_, _).
 proc_info_maybe_arglives(ProcInfo, ArgLives) :-
 	ProcInfo = procedure(_, _, _, _, _, ArgLives, _, _, _,
-		_, _, _, _, _, _).
+		_, _, _, _, _, _, _).
 proc_info_goal(ProcInfo, Goal) :-
-	ProcInfo = procedure(_, _, _, _, _, _, Goal, _, _, _, _, _, _, _, _).
+	ProcInfo = procedure(_, _, _, _, _, _, Goal, _, _, _, _, _, _, _, 
+		_, _).
 proc_info_context(ProcInfo, Context) :-
 	ProcInfo = procedure(_, _, _, _, _, _, _, Context, 
-		_, _, _, _, _, _, _).
+		_, _, _, _, _, _, _, _).
 proc_info_stack_slots(ProcInfo, StackSlots) :-
 	ProcInfo = procedure(_, _, _, _, _, _, _, _, StackSlots,
-		_, _, _, _, _, _).
+		_, _, _, _, _, _, _).
 proc_info_inferred_determinism(ProcInfo, Detism) :-
-	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, Detism, _, _, _, _, _).
+	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, Detism, _, _, _, 
+		_, _, _).
 proc_info_can_process(ProcInfo, CanProcess) :-
  	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, CanProcess,
-		_, _, _, _).
+		_, _, _, _, _).
 proc_info_arg_info(ProcInfo, ArgInfo) :-
 	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, ArgInfo,
-		_, _, _).
+		_, _, _, _).
 proc_info_liveness_info(ProcInfo, Liveness) :-
 	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, Liveness,
-		_, _).
+		_, _, _).
 proc_info_typeinfo_varmap(ProcInfo, TVarMap) :-
 	ProcInfo = procedure(_, _, _, _, _, _, _,
-		_, _, _, _, _, _, TVarMap, _).
+		_, _, _, _, _, _, TVarMap, _, _).
 
 proc_info_maybe_declared_argmodes(ProcInfo, MaybeArgModes) :-
 	ProcInfo = procedure(_, _, _, _, _, _, _,
-		_, _, _, _, _, _, _, MaybeArgModes).
+		_, _, _, _, _, _, _, MaybeArgModes, _).
+
+proc_info_eval_model(ProcInfo, EvalModel) :-
+	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, 
+		_, _, _, EvalModel).
 
 proc_info_declared_argmodes(ProcInfo, ArgModes) :-
 	proc_info_maybe_declared_argmodes(ProcInfo, MaybeArgModes),
@@ -918,67 +953,77 @@
 %							% vars.
 %				O	maybe(list(mode)) % declared modes
 %							% of args
+%				P	eval_model	% model for
+%							% evaluation of
+%							% proc
 % 				).
 
 proc_info_set_varset(ProcInfo0, VarSet, ProcInfo) :-
-	ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O),
-	ProcInfo = procedure(A, VarSet, C, D, E, F, G, H, I, J, K, L, M, N, O).
+	ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O, P),
+	ProcInfo = procedure(A, VarSet, C, D, E, F, G, H, I, J, K, L, 
+		M, N, O, P).
 
 proc_info_set_variables(ProcInfo0, Vars, ProcInfo) :-
-	ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O),
-	ProcInfo = procedure(A, Vars, C, D, E, F, G, H, I, J, K, L, M, N, O).
+	ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O, P),
+	ProcInfo = procedure(A, Vars, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 proc_info_set_vartypes(ProcInfo0, Vars, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, _, D, E, F, G, H, I, J, K, L, M, N, O),
-	ProcInfo = procedure(A, B, Vars, D, E, F, G, H, I, J, K, L, M, N, O).
+	ProcInfo0 = procedure(A, B, _, D, E, F, G, H, I, J, K, L, M, N, O, P),
+	ProcInfo = procedure(A, B, Vars, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 proc_info_set_headvars(ProcInfo0, HeadVars, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, _, E, F, G, H, I, J, K, L, M, N, O),
+	ProcInfo0 = procedure(A, B, C, _, E, F, G, H, I, J, K, L, M, N, O, P),
 	ProcInfo = procedure(A, B, C, HeadVars, E, F, G, H,
-			I, J, K, L, M, N, O).
+			I, J, K, L, M, N, O, P).
 
 proc_info_set_argmodes(ProcInfo0, ArgModes, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, _, F, G, H, I, J, K, L, M, N, O),
+	ProcInfo0 = procedure(A, B, C, D, _, F, G, H, I, J, K, L, M, N, O, P),
 	ProcInfo = procedure(A, B, C, D, ArgModes, F, G, H, I,
-			J, K, L, M, N, O).
+			J, K, L, M, N, O, P).
 
 proc_info_set_maybe_arglives(ProcInfo0, ArgLives, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, E, _, G, H, I, J, K, L, M, N, O),
+	ProcInfo0 = procedure(A, B, C, D, E, _, G, H, I, J, K, L, M, N, O, P),
 	ProcInfo = procedure(A, B, C, D, E, ArgLives, G, H, I, J,
-			K, L, M, N, O).
+			K, L, M, N, O, P).
 
 proc_info_set_inferred_determinism(ProcInfo0, Detism, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O),
-	ProcInfo = procedure(A, B, C, D, E, F, G, H, I, Detism, K, L, M, N, O).
+	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O, P),
+	ProcInfo = procedure(A, B, C, D, E, F, G, H, I, Detism, K, L, M, 
+		N, O, P).
 
 proc_info_set_can_process(ProcInfo0, CanProcess, ProcInfo) :-
- 	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, _, L, M, N, O),
+ 	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, _, L, M, N, O, P),
  	ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, CanProcess, 
-			L, M, N, O).
+			L, M, N, O, P).
 
 proc_info_set_goal(ProcInfo0, Goal, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, E, F, _, H, I, J, K, L, M, N, O),
-	ProcInfo = procedure(A, B, C, D, E, F, Goal, H, I, J, K, L, M, N, O).
+	ProcInfo0 = procedure(A, B, C, D, E, F, _, H, I, J, K, L, M, N, O, P),
+	ProcInfo = procedure(A, B, C, D, E, F, Goal, H, I, J, K, L, M, N, O, P).
 
 proc_info_set_stack_slots(ProcInfo0, StackSlots, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, _, J, K, L, M, N, O),
+	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, _, J, K, L, M, N, O, P),
 	ProcInfo = procedure(A, B, C, D, E, F, G, H, StackSlots,
-			J, K, L, M, N, O).
+			J, K, L, M, N, O, P).
 
 proc_info_set_arg_info(ProcInfo0, ArgInfo, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, _, M, N, O),
+	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, _, M, N, O, P),
 	ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, ArgInfo,
-			M, N, O).
+			M, N, O, P).
 
 proc_info_set_liveness_info(ProcInfo0, Liveness, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, _, N, O),
+	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, _, N, O, P),
 	ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, Liveness,
-			N, O).
+			N, O, P).
 
 proc_info_set_typeinfo_varmap(ProcInfo0, TVarMap, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, _, O),
+	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, _, O, P),
 	ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
-			J, K, L, M, TVarMap, O).
+			J, K, L, M, TVarMap, O, P).
+
+proc_info_set_eval_model(ProcInfo0, EvalModel, ProcInfo) :-
+	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, _),
+	ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, 
+		EvalModel).
 
 proc_info_get_typeinfo_vars_setwise(ProcInfo, Vars, TypeInfoVars) :-
 	set__to_sorted_list(Vars, VarList),
@@ -1075,3 +1120,62 @@
 	).
 
 %-----------------------------------------------------------------------------%
+
+:- interface.
+
+:- pred valid_code_model_for_eval_model(eval_model, code_model, eval_model).
+:- mode valid_code_model_for_eval_model(in, in, out) is semidet.
+
+:- pred eval_model_to_string(eval_model, string).
+:- mode eval_model_to_string(in, out) is det.
+
+:- pred eval_model_change_to_determinism(eval_model, determinism, 
+		determinism).
+:- mode eval_model_change_to_determinism(in, in, out) is det.
+
+:- implementation.
+
+valid_code_model_for_eval_model(model_normal, _, model_normal).
+valid_code_model_for_eval_model(model_memo, model_det, model_memo).
+valid_code_model_for_eval_model(model_memo, model_semi, model_memo).
+valid_code_model_for_eval_model(model_memo, model_non, model_memo).
+valid_code_model_for_eval_model(model_loop_check, model_det, model_loop_check).
+valid_code_model_for_eval_model(model_loop_check, model_semi, model_loop_check).
+valid_code_model_for_eval_model(model_minimal, model_semi, model_minimal).
+valid_code_model_for_eval_model(model_well_founded, model_semi, 
+	model_well_founded).
+valid_code_model_for_eval_model(model_well_founded, model_non, 
+	model_well_founded).
+valid_code_model_for_eval_model(if_valid(Model), CodeMod, Model) :-
+	(
+		valid_code_model_for_eval_model(Model, CodeMod, NewModel)
+	->
+		Model = NewModel
+	;
+		Model = model_normal
+	).
+
+eval_model_to_string(model_normal, 		"normal").
+eval_model_to_string(model_memo, 		"memo").
+eval_model_to_string(model_loop_check, 		"loop_check").
+eval_model_to_string(model_well_founded, 	"well_founded_model").
+eval_model_to_string(model_minimal, 		"minimal_model").
+eval_model_to_string(if_valid(Model), String) :-
+	eval_model_to_string(Model, String).
+
+
+eval_model_change_to_determinism(model_normal, Detism, Detism).
+eval_model_change_to_determinism(model_memo, Detism, Detism).
+eval_model_change_to_determinism(model_loop_check, Detism, Detism).
+eval_model_change_to_determinism(model_well_founded, Detism, Detism).
+eval_model_change_to_determinism(model_minimal, det, semidet).
+eval_model_change_to_determinism(model_minimal, semidet, semidet).
+eval_model_change_to_determinism(model_minimal, multidet, multidet).
+eval_model_change_to_determinism(model_minimal, nondet, nondet).
+eval_model_change_to_determinism(model_minimal, cc_multidet, cc_multidet).
+eval_model_change_to_determinism(model_minimal, cc_nondet, cc_nondet).
+eval_model_change_to_determinism(model_minimal, erroneous, erroneous).
+eval_model_change_to_determinism(model_minimal, failure, failure).
+eval_model_change_to_determinism(if_valid(Model), Detism0, Detism) :-
+	eval_model_change_to_determinism(Model, Detism0, Detism).
+
Index: compiler/inlining.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inlining.m,v
retrieving revision 1.69
diff -u -r1.69 inlining.m
--- inlining.m	1997/09/01 14:02:31	1.69
+++ inlining.m	1997/09/16 02:01:33
@@ -590,15 +590,23 @@
 	% 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 evlaluation
+
+	proc_info_eval_model(ProcInfo, model_normal),
+	
 	% don't inlining anything we have been specifically requested
 	% not to inline.
 
Index: compiler/llds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds_out.m,v
retrieving revision 1.55
diff -u -r1.55 llds_out.m
--- llds_out.m	1997/08/25 17:48:26	1.55
+++ llds_out.m	1997/09/16 02:01:51
@@ -2046,6 +2046,10 @@
 output_code_addr(do_not_reached) -->
 	io__write_string("ENTRY(do_not_reached)").
 
+%
+%	Note : Changes to this pred must also be reflected in
+%	type_util__type_info_name/3 and type_util__type_layout_name/3
+%	
 :- pred output_data_addr(string, data_name, io__state, io__state).
 :- mode output_data_addr(in, in, di, uo) is det.
 
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.239
diff -u -r1.239 make_hlds.m
--- make_hlds.m	1997/09/01 14:03:20	1.239
+++ make_hlds.m	1997/09/18 02:36:49
@@ -289,17 +289,16 @@
 		% clauses).
 		{ Pragma = c_code(_, _, _, _, _, _) },
 		{ Module = Module0 }
-	;
+	;	
 		% Handle pragma c_code decls later on (when we process
 		% clauses).
 		{ Pragma = c_code(_, _, _, _, _, _, _, _) },
 		{ Module = Module0 }
 	;
-		{ Pragma = memo(Name, Arity) },
-		add_pred_marker(Module0, "memo", Name, Arity, Context,
-			[request(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,
@@ -502,6 +501,12 @@
 		module_add_pragma_fact_table(Pred, Arity, File, 
 			Status, Context, Module0, Module, Info0, Info)
 	;
+		{ Pragma = tabled(Type, Name, Arity, PredOrFunc, Mode) }
+	->
+		module_add_pragma_tabled(Type, Name, Arity, PredOrFunc, Mode, 
+			Status, Context, Module0, Module),
+		{ Info = Info0 }
+	;
 		% don't worry about any pragma decs but c_code
 		% and fact_table here
 		{ Module = Module0 },
@@ -509,30 +514,6 @@
 	).
 add_item_clause(nothing, Status, Status, _, Module, Module, Info, Info) --> [].
 
-%-----------------------------------------------------------------------------%
-
-:- 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) }
-	).
 
 %-----------------------------------------------------------------------------%
 
@@ -1821,6 +1802,146 @@
 	pragma_add_markers_2(Markers, MarkerList1, MarkerList).
 
 %---------------------------------------------------------------------------%
+
+:- pred module_add_pragma_tabled(eval_model, sym_name, int, pred_or_func, 
+		maybe(list(mode)), import_status, term__context, 
+		module_info, module_info, io__state, io__state).
+:- mode module_add_pragma_tabled(in, in, in, in, in, in, in, in, out, 
+	di, uo) is det. 
+	
+module_add_pragma_tabled(TableModel, PredName, Arity, PredOrFunc, MModes,  
+			Status, Context, ModuleInfo0, ModuleInfo) --> 
+	{ module_info_name(ModuleInfo0, ModuleName) },
+	io__stderr_stream(StdErr),
+		% print out a progress message
+	{ eval_model_to_string(TableModel, TableModelS) },
+	globals__io_lookup_bool_option(very_verbose, VeryVerbose),
+	( 
+		{ VeryVerbose = yes }
+	->
+		io__write_string("% Processing `:- pragma "),
+		io__write_string(TableModelS),
+		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.) 
+	{ module_info_get_predicate_table(ModuleInfo0, PredicateTable0) }, 
+	(
+		(
+			% if we know the modes we know the pred/func too
+			{ MModes = yes(_),
+			predicate_table_search_pf_sym_arity(PredicateTable0,
+				PredOrFunc, PredName, Arity, [PredId0]) }
+		;
+			{ MModes = no,
+			predicate_table_search_sym_arity(PredicateTable0,
+				PredName, Arity, [PredId0]) }
+		)
+	->
+		{ PredId = PredId0 },
+		{ PredicateTable1 = PredicateTable0 }
+	;
+		io__set_output_stream(StdErr, OldStream1),
+		{ string__format("pragma (%s)", [s(TableModelS)], Message1) },
+		maybe_undefined_pred_error(PredName, Arity, PredOrFunc,
+			Context, Message1),
+		{ preds_add_implicit(PredicateTable0,
+				ModuleName, PredName, Arity, Context,
+				PredOrFunc, PredId, PredicateTable1) },
+		io__set_output_stream(OldStream1, _)
+	),
+		% Lookup the pred_info for this pred,
+		% add the pragma to the proc_info in the proc_table in the
+		% pred_info, and save the pred_info.
+	{ predicate_table_get_preds(PredicateTable1, Preds0) },
+	{ map__lookup(Preds0, PredId, PredInfo0) },
+	{ Status = opt_imported ->
+		pred_info_set_import_status(PredInfo0, opt_imported, PredInfo1)
+	;
+		PredInfo1 = PredInfo0
+	},
+	( 
+		{ 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(TableModelS),
+		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, _)
+	;
+
+		% we have to make sure the tabled preds are stratified
+		{ module_info_stratified_preds(ModuleInfo0, StratPredIds0) },
+		{ set__insert(StratPredIds0, PredId, StratPredIds) },
+		{ module_info_set_stratified_preds(ModuleInfo0, StratPredIds, 
+			ModuleInfo1) },
+		% add the eval model to the proc_info for this procedure
+		{ pred_info_procedures(PredInfo1, Procs0) },
+		{ map__to_assoc_list(Procs0, ExistingProcs) },
+		(
+			{ MModes = yes(Modes) }
+		->
+			(
+				{ get_matching_procedure(ExistingProcs, Modes,
+						ModuleInfo1, ProcId) }
+			->
+				{ map__lookup(Procs0, ProcId, ProcInfo0) },
+				{ proc_info_set_eval_model(ProcInfo0, 
+					TableModel, 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(TableModelS),
+				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_model_list(ExistingProcs, 
+				if_valid(TableModel), Procs0, Procs) },
+			{ pred_info_set_procedures(PredInfo1, Procs, 
+				PredInfo) },
+			{ module_info_set_pred_info(ModuleInfo1, PredId, 
+				PredInfo, ModuleInfo) }
+		)
+	).
+
+
+:- pred set_eval_model_list(assoc_list(proc_id, proc_info), eval_model, 
+	proc_table, proc_table).
+:- mode set_eval_model_list(in, in, in, out) is det.
+
+set_eval_model_list([], _, Procs, Procs).
+set_eval_model_list([ProcId - ProcInfo0|Rest], EvalModel, Procs0, Procs) :-
+	proc_info_set_eval_model(ProcInfo0, EvalModel, ProcInfo),
+	map__det_update(Procs0, ProcId, ProcInfo, Procs1),
+	set_eval_model_list(Rest, EvalModel, Procs1, Procs).
+	
+
+%------------------------------------------------------------------------------%
 
 	% Find the procedure with modes which match the ones we want.
 
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.118
diff -u -r1.118 mercury_to_mercury.m
--- mercury_to_mercury.m	1997/09/15 14:04:14	1.118
+++ mercury_to_mercury.m	1997/09/18 02:16:33
@@ -287,8 +287,9 @@
 		{ Pragma = obsolete(Pred, Arity) },
 		mercury_output_pragma_decl(Pred, Arity, "obsolete")
 	;
-		{ Pragma = memo(Pred, Arity) },
-		mercury_output_pragma_decl(Pred, Arity, "memo")
+		{ Pragma = tabled(Type, Pred, Arity, _PredOrFunc, _Mode) },
+		{ eval_model_to_string(Type, TypeS) },
+		mercury_output_pragma_decl(Pred, Arity, TypeS)
 	;
 		{ Pragma = inline(Pred, Arity) },
 		mercury_output_pragma_decl(Pred, Arity, "inline")
Index: compiler/module_qual.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/module_qual.m,v
retrieving revision 1.23
diff -u -r1.23 module_qual.m
--- module_qual.m	1997/09/14 09:24:29	1.23
+++ module_qual.m	1997/09/16 02:02:10
@@ -597,7 +597,17 @@
 	c_code(Rec, SymName, PredOrFunc, PragmaVars,
 		SavedVars, LabelCount, 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/prog_data.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_data.m,v
retrieving revision 1.25
diff -u -r1.25 prog_data.m
--- prog_data.m	1997/09/14 09:24:30	1.25
+++ prog_data.m	1997/09/16 02:02:18
@@ -101,9 +101,9 @@
 				% Whether or not the C code may call Mercury,
 				% PredName, Predicate or Function, Vars/Mode, 
 				% SavedeVars, LabelNames, VarNames, C Code
-
-			;	memo(sym_name, int)
-				% Predname, Arity
+			;	tabled(eval_model, sym_name, int, 
+					pred_or_func, maybe(list(mode)))
+				% Tabling type, Predname, Arity, Mode?
 
 			;	inline(sym_name, int)
 				% Predname, Arity
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.6
diff -u -r1.6 prog_io_pragma.m
--- prog_io_pragma.m	1997/07/27 15:01:29	1.6
+++ prog_io_pragma.m	1997/07/28 01:34:28
@@ -233,10 +233,31 @@
 
 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", model_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", 
+			model_loop_check, PragmaTerm, Result)
+	;
+		Result = error(
+		"wrong number of arguments in `pragma loop_check(...)' declaration",
+			ErrorTerm)
+				
+	).
 
 parse_pragma_type(ModuleName, "obsolete", PragmaTerms,
 		ErrorTerm, _VarSet, Result) :-
@@ -491,6 +512,81 @@
 		PragmaVars = [],	% return any old junk in PragmaVars
 		Error = yes("arguments not in form 'Var :: mode'")
 	).
+
+
+:- pred parse_tabling_pragma(module_name, string, eval_model, 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, "",
+	    	ok(PredName, [])),
+	    ArityTerm = term__functor(term__integer(Arity), [], _)
+	->
+	    Result = ok(pragma(tabled(TablingType, PredName, Arity, 
+			predicate, 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,
+			"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, Arity),
+	    	Result = ok(pragma(tabled(TablingType, PredName, Arity, 
+			PredOrFunc, yes(Modes))))
+	    ;
+		string__append("unknown mode in pragma ", PragmaName, 
+			ErrorMessage),
+		Result = error(ErrorMessage, PredAndModesTerm)
+	    )
+        ;
+	    PredNameResult = error(Msg, Term),
+	    Result = error(Msg, Term)
+	)
+    ;
+	Result = error("unexpected variable in pragma(tabled, ...)",
+						PredAndModesTerm0)
+    ).
 
 :- pred convert_int_list(term::in, maybe1(list(int))::out) is det.
 
Index: compiler/stratify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/stratify.m,v
retrieving revision 1.10
diff -u -r1.10 stratify.m
--- stratify.m	1997/09/01 14:04:49	1.10
+++ stratify.m	1997/09/16 02:02:28
@@ -296,14 +296,14 @@
 	{ PredProcId = proc(PredId, ProcId) },
 	{ module_info_pred_info(Module0, PredId, PredInfo) },
 	globals__io_lookup_bool_option(warn_non_stratification, Warn),
-	{ pred_info_get_marker_list(PredInfo, Markers) },
-	( 	
-		{ list__member(request(memo), Markers) }
-	->
-		{ Error = yes }
-	;
-		{ Error = no }
-	),
+%	{ pred_info_get_marker_list(PredInfo, Markers) },
+%	( 	
+%		{ list__member(request(memo), Markers) }
+%	->
+%		{ Error = yes }
+%	;
+		{ Error = no },
+%	),
 	(	( { Error = yes 
 		; Warn = yes } ),
 		{ map__search(HOInfo, PredProcId, HigherOrderInfo) }
cvs diff: compiler/table_gen.m is a new entry, no comparison available
Index: compiler/type_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/type_util.m,v
retrieving revision 1.46
diff -u -r1.46 type_util.m
--- type_util.m	1997/09/01 04:19:00	1.46
+++ type_util.m	1997/09/16 02:02:35
@@ -93,6 +93,16 @@
 :- pred type_util__type_id_arity(module_info, type_id, arity).
 :- mode type_util__type_id_arity(in, in, out) is det.
 
+	% Given a type id return the name of the type info 
+	% structure for that type
+:- pred type_util__type_info_name(module_info, type_id, string).
+:- mode type_util__type_info_name(in, in, out) is det.
+
+	% Given a type id return the name of the type layout
+	% structure for that type
+:- pred type_util__type_layout_name(module_info, type_id, string).
+:- mode type_util__type_layout_name(in, in, out) is det.
+
 	% If the type is a du type, return the list of its constructors.
 
 :- pred type_constructors(type, module_info, list(constructor)).
@@ -164,7 +174,7 @@
 
 :- implementation.
 :- import_module bool, list, term, require, map, std_util.
-:- import_module prog_io, prog_io_goal, prog_util.
+:- import_module prog_io, prog_io_goal, prog_util, llds_out, string.
 
 type_util__type_id_module(_ModuleInfo, qualified(ModuleName, _) -_, ModuleName).
 type_util__type_id_module(_ModuleInfo, unqualified(_) - _, "").
@@ -182,6 +192,22 @@
 
 type_util__var(term__variable(Var), Var).
 
+type_util__type_info_name(Module, TypeId, Name) :-
+	type_util__type_id_module(Module, TypeId, TypeModule),
+	type_util__type_id_name(Module, TypeId, TypeName0),
+	type_util__type_id_arity(Module, TypeId, TypeArity),
+	llds_out__name_mangle(TypeName0, TypeName),
+	string__format("mercury_data_%s__base_type_info_%s_%d", 
+		[s(TypeModule), s(TypeName), i(TypeArity)], Name).
+
+type_util__type_layout_name(Module, TypeId, Name) :-
+	type_util__type_id_module(Module, TypeId, TypeModule),
+	type_util__type_id_name(Module, TypeId, TypeName0),
+	type_util__type_id_arity(Module, TypeId, TypeArity),
+	llds_out__name_mangle(TypeName0, TypeName),
+	string__format("mercury_data_%s__base_type_layout_%s_%d", 
+		[s(TypeModule), s(TypeName), i(TypeArity)], Name).
+		
 %-----------------------------------------------------------------------------%
 
 	% Given a type, determine what sort of type it is.


%---------------------------------------------------------------------------%
% Copyright (C) 1996-1997 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% Table generation - generate prolog and epilog code for tabled procs. 
%
% Main author: ohutch.
%
% Notes:
%	
%	Most of the code to do the tabling work is defined in the
%	runtime and called with c_code intructions that are generated by
%	this module.
%
%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- module table_gen.

:- interface.

:- import_module code_info, llds.

%------------------------------------------------------------------------------%

	% Generate the prolog for det memoing procs
:- pred table_gen__generate_det_prolog(eval_model, code_tree, maybe(int),
	code_info, code_info).
:- mode table_gen__generate_det_prolog(in, out, out, in, out) is det.

	% Generate the epilog for det memoing procs
:- pred table_gen__generate_det_epilog(eval_model, code_tree, code_info, 
	code_info).
:- mode table_gen__generate_det_epilog(in, out, in, out) is det.


:- pred table_gen__generate_semi_prolog(eval_model, code_tree, maybe(int), 
	code_info, code_info).
:- mode table_gen__generate_semi_prolog(in, out, out, in, out) is det.


:- pred table_gen__generate_semi_epilog(eval_model, code_tree, code_info, 
	code_info).
:- mode table_gen__generate_semi_epilog(in, out, in, out) is det.


:- pred table_gen__generate_memo_non_prolog(code_tree, maybe(int), code_info,
	code_info).
:- mode table_gen__generate_memo_non_prolog(out, out, in, out) is det.

:- pred table_gen__generate_memo_non_epilog(code_tree, code_info, code_info).
:- mode table_gen__generate_memo_non_epilog(out, in, out) is det.

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%

:- implementation.

:- import_module type_util, code_aux.
:- import_module bool.
:- import_module hlds_module, hlds_pred, hlds_goal, llds, code_info.
:- import_module list, assoc_list, io, hlds_data, code_gen.
:- import_module call_gen, unify_gen, ite_gen, switch_gen.
:- import_module disj_gen, pragma_c_gen, globals, options, hlds_out.
:- import_module code_aux, middle_rec, passes_aux, code_exprn.
:- import_module code_util, type_util, mode_util.
:- import_module prog_data, instmap.
:- import_module bool, char, int, string, list, term.
:- import_module map, tree, std_util, require, set, varset.

%------------------------------------------------------------------------------%

table_gen__generate_det_prolog(EvalModel, EntryCode, SUsed) -->
	code_info__get_stack_slots(StackSlots),
	code_info__get_varset(VarSet),
	{ code_aux__explain_stack_slots(StackSlots, VarSet, SlotsComment) },
	code_info__get_total_stackslot_count(NS0),
	code_info__get_pred_id(PredId),
	code_info__get_proc_id(ProcId),
	code_info__get_succip_used(Used),
	code_info__get_module_info(ModuleInfo),
	{ code_util__make_local_entry_label(ModuleInfo, PredId, ProcId, no,
		Entry) },
	{ CodeA = node([
		comment(SlotsComment) - "",
		label(Entry) - "Procedure entry point - det memoing tabled"
	]) },
	(
		{ Used = yes }
	->
		{ NS is NS0 + 1 },
		{ CodeD = node([
			assign(stackvar(NS), lval(succip)) -
					"save the success ip"
		]) },
		{ SUsed = yes(NS) }
	;
		{ SUsed = no },
		{ NS = NS0 },
		{ CodeD = empty }
	),

	% generate the table lookup code
        { predicate_name(ModuleInfo, PredId, PredName) },
        { predicate_arity(ModuleInfo, PredId, Arity) },
        { proc_id_to_int(ProcId, ProcIdI) },
	{ string__format("%s_%d_%d_table", [s(PredName), i(Arity), 
		i(ProcIdI)], TableStubName) },
	(
		{ EvalModel = model_loop_check }
	->
		generate_memo_lookup(TableStubName, no, yes, TempReg, CodeC1)
	;
		generate_memo_lookup(TableStubName, no, no, TempReg, CodeC1)
	),
	
	% generate code to save table address
	{ CodeC2 = node([assign(stackvar(NS+1), lval(TempReg)) -
		"Save table address"]) },
	
	% Allocate stack frame with one extra slot for the table address
	{ CodeB = tree(
		CodeC1,
		tree(node([incr_sp(NS+1, PredName) - "Allocate stack frame"]),
			CodeC2) 
		)},
	
	{ PStart = node([comment("Start of procedure prologue") - ""]) },
	{ PEnd = node([comment("End of procedure prologue") - ""]) },
	{ EntryCode = tree(tree(PStart, tree(CodeA, CodeB)), 
		tree(CodeD, PEnd)) }.

	
%---------------------------------------------------------------------------%

table_gen__generate_det_epilog(_EvalModel, ExitCode) -->
	code_info__get_instmap(Instmap),
	code_info__get_arginfo(ArgModes),
	code_info__get_headvars(HeadVars),
	{ assoc_list__from_corresponding_lists(HeadVars, ArgModes, Args)},
	(
		{ instmap__is_unreachable(Instmap) }
	->
		{ CodeA = empty }
	;
		code_info__setup_call(Args, callee, CodeA)
	),
	code_info__get_succip_used(Used),
	code_info__get_total_stackslot_count(NS0),
	(
		{ Used = yes }
	->
		{ NS is NS0 + 1 },
		{ CodeC = node([
			assign(succip, lval(stackvar(NS))) -
					"restore the success ip"
		]) }
	;
		{ NS = NS0 },
		{ CodeC = empty }
	),
	gen_save_answers(NS+1, CodeE),
	{ CodeB1 = node([ goto(succip) - "Return from procedure call"]) },
	{ CodeB0 = node([ decr_sp(NS+1) - "Deallocate stack frame" ]) }, 
	{ code_gen__output_args(Args, LiveArgs) },
	{ LiveValCode = node([
		livevals(LiveArgs) - ""
	]) },
	{ CodeB = tree(CodeB0, tree(LiveValCode, CodeB1)) },
	{ EStart = node([comment("Start of procedure epilogue") - ""]) },
	{ EEnd = node([comment("End of procedure epilogue") - ""]) },
	{ ExitCode = tree(tree(EStart, CodeA),
					tree(CodeC, tree(tree(CodeE, EEnd), 
						CodeB))) }.

%---------------------------------------------------------------------------%


table_gen__generate_semi_prolog(EvalModel, EntryCode, SUsed) -->
	code_info__get_stack_slots(StackSlots),
	code_info__get_varset(VarSet),
	{ code_aux__explain_stack_slots(StackSlots, VarSet, SlotsComment) },
	code_info__get_total_stackslot_count(NS0),
	code_info__get_pred_id(PredId),
	code_info__get_proc_id(ProcId),
	code_info__get_succip_used(Used),
	code_info__get_module_info(ModuleInfo),
	{ code_util__make_local_entry_label(ModuleInfo, PredId, ProcId, no,
		Entry) },
	{ CodeA = node([
		comment(SlotsComment) - "",
		label(Entry) - "Procedure entry point - semidet memoing tabled"
	]) },
	(
		{ Used = yes }
	->
		{ NS is NS0 + 1 },
		{ CodeD = node([
			assign(stackvar(NS), lval(succip)) -
					"save the success ip"
		]) },
		{ SUsed = yes(NS) }
	;
		{ SUsed = no },
		{ NS = NS0 },
		{ CodeD = empty }
	),

	% generate the table lookup code 
	{ predicate_name(ModuleInfo, PredId, PredName) },
        { predicate_arity(ModuleInfo, PredId, Arity) },
	{ proc_id_to_int(ProcId, ProcIdI) },
        { string__format("%s_%d_%d_table", [s(PredName), i(Arity), 
		i(ProcIdI)], TableStubName) },

	(
		{ EvalModel = model_loop_check }
	->
		generate_memo_lookup(TableStubName, yes, yes, TempReg, CodeC1)
	;
		generate_memo_lookup(TableStubName, yes, no, TempReg, CodeC1)
	),
	
	% generate code to save table address
	{ CodeC2 = node([assign(stackvar(NS+1), lval(TempReg)) -
		"Save table address"]) },
	
	% Allocate stack frame with one extra slot for the table address
	{ CodeB = tree(
		CodeC1,
		tree(node([incr_sp(NS+1, PredName) - "Allocate stack frame"]),
			CodeC2) 
		)},
	
	{ PStart = node([comment("Start of procedure prologue") - ""]) },
	{ PEnd = node([comment("End of procedure prologue") - ""]) },
	{ EntryCode = tree(tree(PStart, tree(CodeA, CodeB)), 
		tree(CodeD, PEnd)) }.

%---------------------------------------------------------------------------%

table_gen__generate_semi_epilog(_EvalModel, Instr) -->
        code_info__get_instmap(Instmap),
        code_info__get_arginfo(ArgModes),
        code_info__get_headvars(HeadVars),
        {assoc_list__from_corresponding_lists(HeadVars, ArgModes, Args) },
        (
                { instmap__is_unreachable(Instmap) }
        ->
                { CodeA = empty }
        ;
                code_info__setup_call(Args, callee, CodeA)
        ),
        code_info__restore_failure_cont(FailureCont),
        code_info__get_succip_used(Used),
        code_info__get_total_stackslot_count(NS0),
        { code_gen__output_args(Args, LiveArgs0) },
        { set__insert(LiveArgs0, reg(r, 1), LiveArgs) },
        { SLiveValCode = node([
                livevals(LiveArgs) - ""
        ]) },
        { set__singleton_set(LiveArg, reg(r, 1)) },
        { FLiveValCode = node([
                livevals(LiveArg) - ""
        ]) },
        (
                { Used = yes }
        ->
                { NS is NS0 + 1 },
                { CodeC = node([
                        assign(succip, lval(stackvar(NS))) -
                                        "restore the success ip"
                ]) }
        ;
                { NS = NS0 },
                { CodeC = empty }
        ),
        { UnLink = tree(
        	CodeC,
                node([
                	decr_sp(NS+1) - "Deallocate stack frame"
                ])
        ) },

	gen_save_answers(NS+1, SaveAnswers),
	gen_save_failure(NS+1, SaveFailure),
	
        { Success = tree(
                UnLink,
                node([ assign(reg(r, 1), const(true)) - "Succeed" ])
        ) },
        { Failure = tree(
                UnLink,
                node([ assign(reg(r, 1), const(false)) - "Fail" ])
        ) },
        { ExitCode = tree(
                tree(
        	        tree(tree(SaveAnswers, Success), SLiveValCode),
                        node([ goto(succip) - "Return from procedure call" ])
                ),
                tree(
                        FailureCont,
                        tree(
                                tree(tree(SaveFailure, Failure), FLiveValCode),
                                node([ goto(succip) -
                                        "Return from procedure call" ])
                        )
                )
        ) },
        { EStart = node([comment("Start of procedure epilogue") - ""]) },
        { EEnd = node([comment("End of procedure epilogue") - ""]) },
        { Instr = tree(tree(EStart, CodeA), tree(ExitCode, EEnd)) }.

%---------------------------------------------------------------------------%

table_gen__generate_memo_non_prolog(EntryCode, no) -->
	code_info__get_stack_slots(StackSlots),
	code_info__get_varset(VarSet),
	{ code_aux__explain_stack_slots(StackSlots, VarSet, SlotsComment) },
	code_info__get_pred_id(PredId),
	code_info__get_proc_id(ProcId),
	code_info__get_total_stackslot_count(NS),
	code_info__get_module_info(ModuleInfo),
	{ code_util__make_local_entry_label(ModuleInfo, PredId, ProcId, no,
		Entry) },
	{ CodeA = node([
		comment(SlotsComment) - "",
		label(Entry) - "Procedure entry point - nondet"
	]) },
		% The `name' argument to mkframe() is just for
		% debugging purposes.  We construct it as "predname/arity".
	{ predicate_name(ModuleInfo, PredId, PredName) },
	{ predicate_arity(ModuleInfo, PredId, PredArity) },
	{ string__int_to_string(PredArity, PredArityString) },
	{ string__append(PredName, "/", Tmp) },
	{ string__append(Tmp, PredArityString, Name) },
	{ CodeB = node([
		mkframe(Name, NS, do_fail) - "Nondet stackframe"
	]) },
	{ PStart = node([comment("Start of procedure prologue") - ""]) },
	{ PEnd = node([comment("End of procedure prologue") - ""]) },
	{ EntryCode = tree(tree(PStart, CodeA), tree(CodeB, PEnd)) }.

%---------------------------------------------------------------------------%

table_gen__generate_memo_non_epilog(Instr) -->
	code_info__get_instmap(Instmap),
	code_info__get_arginfo(ArgModes),
	code_info__get_headvars(HeadVars),
	{assoc_list__from_corresponding_lists(HeadVars, ArgModes, Args) },
	(
		{ instmap__is_unreachable(Instmap) }
	->
		{ CodeA = empty }
	;
		code_info__setup_call(Args, callee, CodeA)
	),
	{ code_gen__output_args(Args, LiveArgs) },
	{ LiveValCode = node([
		livevals(LiveArgs) - ""
	]) },
	{ ExitCode = tree(LiveValCode, node([
		goto(do_succeed(no)) - "Succeed"
	])) },
	{ EStart = node([comment("Start of procedure epilogue") - ""]) },
	{ EEnd = node([comment("End of procedure epilogue") - ""]) },
	{ Instr = tree(tree(EStart, CodeA), tree(ExitCode, EEnd)) }.

%---------------------------------------------------------------------------%

:- pred gen_save_failure(int, code_tree, code_info, code_info).
:- mode gen_save_failure(in, out, in, out) is det.

gen_save_failure(SavedSlot, Code) -->
	get_input_output_args(_, OutputArgs),
	code_info__get_exprn_info(ExprnInfo),
	{ assoc_list__keys(OutputArgs, OutputArgRegs) },
	{ get_free_reg(ExprnInfo, OutputArgRegs, TempReg) },
	{ TempReg = TempRegN - TempRegS },
	{ RestoreTable = node([assign(TempRegN, 
		lval(stackvar(SavedSlot))) -
		"Restore answer table address"]) },
	{ string__format("MEMO_SAVE_FAILURE(%s);\n", [s(TempRegS)], 
		SaveFailure) },
	{ Code = tree(RestoreTable, node([c_code(SaveFailure) - 
		"Save failure in the answer table"])) }.

:- pred gen_save_answers(int, code_tree, code_info, code_info).
:- mode gen_save_answers(in, out, in, out) is det.

gen_save_answers(SavedSlot, Code) -->
	get_input_output_args(_, OutputArgs),
	code_info__get_exprn_info(ExprnInfo),
	{ assoc_list__keys(OutputArgs, OutputArgRegs) },
	{ get_free_reg(ExprnInfo, OutputArgRegs, TempReg) },
	{ TempReg = TempRegN - TempRegS },
	{ RestoreTable = node([assign(TempRegN, 
		lval(stackvar(SavedSlot))) -
		"Restore answer table address"]) },
	{ list__length(OutputArgs, NumAnswers) },
	{ string__format("MEMO_CREATE_ANSWER_BLOCK(%s, %d);\n", 
		[s(TempRegS), i(NumAnswers)], CreateAnsCode) },
	{ CreateAns = node([c_code(CreateAnsCode) - 
		"Create an answer block"]) },
	code_info__get_module_info(Module),
	{ gen_save_answer_list(OutputArgs, Module, 0, TempRegS, SaveAnswers) },
	{ Code = tree(tree(RestoreTable, CreateAns), node(SaveAnswers)) }.

:- pred gen_save_answer_list(assoc_list(lval, type), module_info, int, string, 
		list(instruction)).
:- mode gen_save_answer_list(in, in, in, in, out) is det.

gen_save_answer_list([], _, _, _, []).
gen_save_answer_list([Reg - Type|Args], Module, Offset0, TempReg, 
		SaveAnswers) :-
	reg_to_string(Reg, RegString),
	(
		type_to_type_id(Type, TypeId, _)
	->
		type_util__type_info_name(Module, TypeId, TypeInfo),
		string__format("MEMO_SAVE_ANSWER(%d, %s, %s, %s);\n",
			[i(Offset0), s(TempReg), s(RegString), s(TypeInfo)], 
			SaveAnswerS),
		SaveAnswer = (c_code(SaveAnswerS) -
			"Save answer in answer table"),
		SaveAnswers = [SaveAnswer|OtherSaves],
		Offset is Offset0 + 1,
		gen_save_answer_list(Args, Module, Offset, TempReg, OtherSaves)
	;
		error("gen_save_answer_list: unexpected type")
	).

	
:- pred generate_memo_lookup(string, bool, bool, lval, code_tree, code_info, 
	code_info).
:- mode generate_memo_lookup(in, in, in, out, out, in, out) is det.

generate_memo_lookup(TableStubName, CanFail, LoopCheck, 
		TempRegN, LookupCode) -->
	% Get the input argumets of the proc
	get_input_output_args(InputArgs, OutputArgs),
	{ assoc_list__keys(InputArgs, InputArgRegs) },
	code_info__get_exprn_info(ExprnInfo),
	{ get_free_reg(ExprnInfo, InputArgRegs, TempReg) },
	{ TempReg = TempRegN - TempRegS },
	% Gen the code to hold the table
	{ string__format(

"{
		static Word %s = (Word)NULL;
		%s = (Word)&%s;
	}
", 
		[s(TableStubName), s(TempRegS), s(TableStubName)],
		InitPointerCode) },
	{ InitPointer = node([c_code(InitPointerCode) - 
		"Point to the table"]) },
	code_info__get_module_info(Module),
	{ gen_lookups(InputArgs, TempRegS, Module, Lookups) },
	{ gen_answer_check(TempRegS, OutputArgs, CanFail, LoopCheck, 
		AnsCheck) },
	{ LookupCode = tree(tree(InitPointer, node(Lookups)), 
		node(AnsCheck)) }.

:- pred gen_answer_check(string, assoc_list(lval, type), bool, bool, 
	list(instruction)).
:- mode gen_answer_check(in, in, in, in, out) is det.

gen_answer_check(TempReg, OutputArgs, CanFail, LoopCheck, Code) :-
	(
		LoopCheck = yes
	->
		string__format(
"	if (MEMO_WORKING_ON_ANS(%s))
		MEMO_DIE_IN_HELL();
", 
			[s(TempReg)], LoopCheckProlog),
		string__format(
			"	MEMO_MARK_AS_WORKING_ON_ANS(%s);\n",
                        [s(TempReg)], LoopCheckEpilog)
	;
		LoopCheckProlog = "",
		LoopCheckEpilog = ""
	),
	(
		CanFail = no
	->
		gen_get_answers(OutputArgs, 0, TempReg, "\t\t", 
			GetAnswersString),
		string__format(
"if (MEMO_HAVE_ANSWER(%s)) {
%s		proceed();
	}\n", 
			[s(TempReg), s(GetAnswersString)], HaveAnsCode)
	;
		gen_get_answers(OutputArgs, 0, TempReg, "\t\t\t", 
			GetAnswersString),
		string__format(
"	if (MEMO_HAVE_ANSWER(%s)) {
		if (MEMO_HAS_FAILED(%s)) {
			r1 = FALSE;
		} else {
			r1 = TRUE;
%s		}
		proceed();
	}\n",
			[s(TempReg), s(TempReg), s(GetAnswersString)], 
			HaveAnsCode)
			
	),
	string__append_list([LoopCheckProlog, HaveAnsCode, LoopCheckEpilog],  
		CodeString),
	Code = [c_code(CodeString) - "Table return answers if present"].
	
:- pred gen_get_answers(assoc_list(lval, type), int, string, string, string).
:- mode gen_get_answers(in, in, in, in, out) is det.

gen_get_answers([], _, _, _, "").
gen_get_answers([Reg - _|Rest], Offset0, TempReg, LineProlog, 
		GetAnsString) :-
	reg_to_string(Reg, RegString),
	string__format("%s%s = MEMO_GET_ANSWER(%d, %s);\n%s",
		[s(LineProlog), s(RegString), i(Offset0),
		s(TempReg), s(NextGetAnswer)], GetAnsString),
	Offset is Offset0 + 1,
	gen_get_answers(Rest, Offset, TempReg, LineProlog, NextGetAnswer).

:- pred gen_lookups(assoc_list(lval, type), string, module_info, 
	list(instruction)).
:- mode gen_lookups(in, in, in, out) is det.

gen_lookups([], _, _, []).
gen_lookups([Reg - Type|Rest], TempReg, Module, Codes) :-
	classify_type(Type, Module, TypeClass),
	gen_lookup(TypeClass, Type, Reg, TempReg, Module, Code),
	gen_lookups(Rest, TempReg, Module, Codes0),
	list__append(Code, Codes0, Codes).
	
:- pred gen_lookup(builtin_type, type, lval, string, module_info, 
	list(instruction)).
:- mode gen_lookup(in, in, in, in, in, out) is det.

gen_lookup(int_type, _, Reg, TempReg, _Module, Code) :-
	reg_to_string(Reg, RegString),
	string__format(
		"MEMO_TABLE_INT((Word**)%s, (Integer)%s);\n",
		[s(TempReg), s(RegString)], CodeString),
	Code = [c_code(CodeString) - "Memoing tabel lookup"].
	
gen_lookup(char_type, _, Reg, TempReg, _Module, Code) :-
	reg_to_string(Reg, RegString),
	string__format(
		"MEMO_TABLE_CHAR((Word**)%s, (Char)%s);\n",
		[s(TempReg), s(RegString)], CodeString),
	Code = [c_code(CodeString) - "Memoing tabel lookup"].
	
gen_lookup(str_type, _, Reg, TempReg, _Module, Code) :-
	reg_to_string(Reg, RegString),
	string__format(
		"MEMO_TABLE_STRING((Word**)%s, (String)%s);\n",
		[s(TempReg), s(RegString)], CodeString),
	Code = [c_code(CodeString) - "Memoing tabel lookup"].

gen_lookup(float_type, _, Reg, TempReg, _Module, Code) :-
	reg_to_string(Reg, RegString),
	string__format(
		"MEMO_TABLE_FLOAT((Word**)%s, word_to_float(%s));\n",
		[s(TempReg), s(RegString)], CodeString),
	Code = [c_code(CodeString) - "Memoing tabel lookup"].

gen_lookup(enum_type, Type, Reg, TempReg, Module, Code) :-
	reg_to_string(Reg, RegString),
	(	
		type_to_type_id(Type, TypeId, _)
	->
		module_info_types(Module, TypeDefnTable),
		map__lookup(TypeDefnTable, TypeId, TypeDefn),
		hlds_data__get_type_defn_body(TypeDefn, TypeBody),
		(
			TypeBody = du_type(Ctors, _, yes, no)
		->
			list__length(Ctors, EnumRange)	
		;
			error(
		"gen_lookup: unsuported type in tabled predicte/function")
		),
		string__format(
			"MEMO_TABLE_ENUM((Word**)%s, %d, (Integer)%s);\n",
			[s(TempReg), i(EnumRange), s(RegString)], 
			CodeString),
		Code = [c_code(CodeString) - "Memoing tabel lookup"]
	;
		error("gen_lookup: unexpected type")
	).

gen_lookup(pred_type, _, _Reg, _TempReg, _, _Code) :-
	error("gen_lookup: pred_type unsupported").

gen_lookup(polymorphic_type, _Type, _Reg, _TempReg, _Module, _Code) :-
	error("gen_lookup: polymorphic types unsupported").

gen_lookup(user_type(_UType), Type, Reg, TempReg, Module, Code) :-
	reg_to_string(Reg, RegString),
	(
		type_to_type_id(Type, TypeId, _)
	->
		type_util__type_info_name(Module, TypeId, TypeInfo),
		string__format(
			"MEMO_TABLE_ANY((Word**)%s, ((const Word*)&%s), (Word)%s);\n",
			[s(TempReg), s(TypeInfo), s(RegString)], 
			CodeString),
		Code = [c_code(CodeString) - "Memoing tabel lookup"]
	;
		error("gen_lookup: unexpected type")
	).


:- pred reg_to_string(lval, string).
:- mode reg_to_string(in, out) is det.

reg_to_string(Reg, RegString) :-
	(
		Reg = reg(r, N)
	->
        	(  N > 32 ->
			string__format("r(%u)", [i(N)], RegString)
        	;
			string__format("r%u", [i(N)], RegString)
        	)
	;
        	error("reg_to_string: unsupported reg type")
	).


:- pred get_free_reg(exprn_info, list(lval), pair(lval, string)).
:- mode get_free_reg(in, in, out) is det.

get_free_reg(ExprnInfo0, LiveRegs, FreeReg) :-
	mark_regs_as_live(LiveRegs, ExprnInfo0, ExprnInfo),
	code_exprn__acquire_reg_prefer_given(r, 1, FreeRegN, ExprnInfo, _),
	reg_to_string(FreeRegN, FreeRegS),
	FreeReg = FreeRegN - FreeRegS.


:- pred mark_regs_as_live(list(lval), exprn_info, exprn_info).
:- mode mark_regs_as_live(in, in, out) is det.

mark_regs_as_live([], ExprnInfo, ExprnInfo).
mark_regs_as_live([Reg|Regs]) -->
	code_exprn__lock_reg(Reg),
	mark_regs_as_live(Regs).
		

:- pred get_input_output_args(assoc_list(lval, type), assoc_list(lval, type),
	code_info, code_info).
:- mode get_input_output_args(out, out, in, out) is det.

get_input_output_args(InputArgs, OutputArgs) -->
	code_info__get_arginfo(ArgInfo),
	code_info__get_module_info(Module),
	code_info__get_pred_id(PredId),
	{ module_info_pred_info(Module, PredId, PredInfo) },
	{ pred_info_arg_types(PredInfo, _, ArgTypes) },
	{ get_input_output_args2(ArgInfo, ArgTypes, InputArgs, OutputArgs) }.

:- pred get_input_output_args2(list(arg_info), list(type), 
	assoc_list(lval, type), assoc_list(lval, type)).
:- mode get_input_output_args2(in, in, out, out) is det.

get_input_output_args2([], [], [], []).
get_input_output_args2([_|_], [], [], []) :-
	error("get_input_args: lists are different lengths").
get_input_output_args2([], [_|_], [], []) :-
	error("get_input_args: lists are different lengths").
get_input_output_args2([arg_info(ArgLoc, ArgMode)|Args], [Type|Types], 
		InArgs, OutArgs) :-
	code_util__arg_loc_to_register(ArgLoc, Reg),
	(
		ArgMode = top_in
	->
		InArgs = [Reg - Type|InArgsRest],
		get_input_output_args2(Args, Types, InArgsRest, OutArgs)
	;	
		ArgMode = top_out
	->
		OutArgs = [Reg - Type|OutArgsRest],
		get_input_output_args2(Args, Types, InArgs, OutArgsRest)	
	;
		get_input_output_args2(Args, Types, InArgs, OutArgs)
	).





More information about the developers mailing list