Tabling [3/3]

Oliver Hutchison ohutch at students.cs.mu.OZ.AU
Mon Mar 23 15:52:10 AEDT 1998


New File: compiler/table_gen.m
===================================================================
%-----------------------------------------------------------------------------%
% Copyright (C) 1997-1998 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.
%-----------------------------------------------------------------------------%
%
% Main author: ohutch
%
% This module transforms HLDS code to a form that allows tabled evaluation,
% minimal model evaluation and loop detection.  The tabling transformation 
% adds calls to several tabling predicates as well as restructuring the 
% HLDS to implement answer clause resolution, suspension and loop detection.
%
% The loop detection transformation adds code to a procedure that allows 
% early detection of infinite loops. If such loops are detected the program 
% will terminate with helpfully error message.
%
% The memo transformation adds code that allows a procedure to "memo" 
% (remember) answers once they have been generated using program clause 
% resolution.
% 
% The minimal model transformation changes the semantics of the procedure
% being transformed. See the paper K. Sagonas. `The SLG-WAM: A 
% Search-Efficient Engine for Well-Founded Evaluation of Normal Logic 
% Programs.' PhD thesis, SUNY at Stony Brook, 1996 for a description of 
% the semantics behind the transformation. Currently only SLGd is 
% implemented. 
%
% Example of transformation for semidet minimal_model :
%
%	Given the following code for left recursive transitive closure :
%
%	:- pred p(int, int).
%	:- mode p(in, in) is semidet.
%
%	p(A, B) :- e(A, B).
%	p(A, B) :- p(A, C), e(C, B).
%
%	The transformed code would be :
%
%	p(A, B) :-
%			% Code to get a handle on the table
%		c_code(T0::out, "
%			static Word Table = 0;
%			T0 = &Table;
%		"),
%
%			% Code to lookup input arguments 
%		impure table_lookup_insert_int(T0, A, T1),
%		impure table_lookup_insert_int(T1, B, T2),
%		(if
%			semipure table_have_ans(T2)
%		then
%				% True if the subgoal has already succeeded
%			semipure table_has_succeeded(T2)
%		else
%		   	(if
%					% Fail if we are already working on
%					% an ans for this subgoal
%				semipure table_not_working_on_ans(T2),
%
%					% Mark this subgoal as being evaluated
%				impure table_mark_as_working(T2),
%				
%				(
%					%
%					% Original goals
%					%
%				)
%			then
%				impure table_mark_as_succeeded(T2)
%			else	
%				impure table_mark_as_failed(T2)	
%			)
%		).
%
% Example of transformation for nondet minimal_model :
%
%	Given the following code for left recursive transitive closure :
%	
%	:- pred p(int, int).
%	:- mode p(in, out) is nondet 
%
%	p(A, B) :- e(A, B).
%	p(A, B) :- p(A, C), e(C, B).
%	
%	The transformed code would be :
%
%	p(A, B) :-
%			% Code to get a handle on the table
%		c_code(T0::out, "
%			static Word Table = 0;
%			T0 = &Table;
%		"),
%			% Code to lookup input arguments and setup table
%		impure table_lookup_insert_int(T0, A, T1),
%		impure table_setup(T1, T2),
%		(if
%			semipure table_have_all_ans(T2)
%		then
%				% Code to return all ans if we have found
%				% them
%			impure table_return_all_ans(T2, Ans),
%			impure table_restore_int_ans(Ans, 0, B)
%		else if
%			semipure table_have_some_ans(T2)
%		then
%				% Code to suspend the current computational
%				% branch
%			impure table_suspend(T2, Ans),
%			impure table_restore_int_ans(Ans, 0, B)
%		else 
%		   	(		% Mark that this subgoal is being
%					% evaluated
%				impure table_mark_have_some_ans(T2),
%				
%				(
%					%
%					% Original goals
%					%					
%				),
%				
%					% Code to check for duplicate
%					% answers
%				impure table_get_ans_table(T2, AT0),
%				impure table_lookup_insert_int(AT0, B, AT1),
%			
%					% The following pred is semidet
%					% it will fail if the answer is
%					% already in the table.	
%				semipure table_has_not_returned(AT1),
%
%					% Code to save a new ans in the 
%					% table.
%				impure table_mark_as_returned(AT1),
%				impure table_new_ans_slot(T2, AS),
%				impure table_create_ans_block(AS, 1, AB),
%				impure table_save_int_ans(AB, 0, B)
%			;
%					% Code to resume suspended nodes.
%				impure table_resume(T2)
%			;
%					% Code to mark the current subgoal
%					% as totally evaluated.
%				impure table_mark_have_all_ans(T2)
%			)
%		).
%		   		
% The memo and loopcheck transformations are very similar to the above
% transformations except that for the memo case the code for handing 
% loops (fail in the semi_det case, suspend in the nondet case) is changed to
% a loop check. And in the loop_check case the code for memoing answers is 
% dropped and the loop handling code is modified to call an error predicate.
%			
%-----------------------------------------------------------------------------%
:- module table_gen.

:- interface.

:- import_module hlds_module.

:- pred table_gen__process_module(module_info, module_info).
:- mode table_gen__process_module(in, out) is det.

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

:- implementation.

:- import_module hlds_out, prog_out.
:- import_module hlds_pred, instmap.
:- import_module code_aux, det_analysis, follow_code, goal_util, const_prop.
:- import_module hlds_module, hlds_goal, hlds_data, (inst), inst_match.
:- import_module globals, options, passes_aux, prog_data, mode_util, type_util.
:- import_module code_util, quantification, modes, purity.
:- import_module bool, list, set, map, require, std_util, term, varset, int.
:- import_module assoc_list, string, llds.

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

table_gen__process_module(Module0, Module) :-
	module_info_preds(Module0, Preds0),
	map__keys(Preds0, PredIds),
	table_gen__process_preds(PredIds, Module0, Module).

:- pred table_gen__process_preds(list(pred_id), module_info, module_info).
:- mode table_gen__process_preds(in, in, out) is det.

table_gen__process_preds([], Module, Module).
table_gen__process_preds([PredId | PredIds], Module0, Module) :-
	table_gen__process_pred(PredId, Module0, Module1),
	table_gen__process_preds(PredIds, Module1, Module).

:- pred table_gen__process_pred(pred_id, module_info, module_info).
:- mode table_gen__process_pred(in, in, out) is det.

table_gen__process_pred(PredId, Module0, Module) :-
	module_info_pred_info(Module0, PredId, PredInfo),
	pred_info_procids(PredInfo, ProcIds),
	table_gen__process_procs(PredId, ProcIds, Module0, Module).

:- pred table_gen__process_procs(pred_id, list(proc_id),
					module_info, module_info).
:- mode table_gen__process_procs(in, in, in, out) is det.
table_gen__process_procs(_PredId, [], Module, Module).
table_gen__process_procs(PredId, [ProcId | ProcIds], Module0,
		Module) :-
	module_info_preds(Module0, PredTable),
	map__lookup(PredTable, PredId, PredInfo),
	pred_info_procedures(PredInfo, ProcTable),
	map__lookup(ProcTable, ProcId, ProcInfo),
	
	proc_info_eval_method(ProcInfo, EvalMethod),

	(
		EvalMethod \= eval_normal
	->
		table_gen__process_proc(EvalMethod, PredId, ProcId, ProcInfo, 
				PredInfo, Module0, Module1)
	;
		Module1 = Module0
	),
	
	table_gen__process_procs(PredId, ProcIds, Module1, Module).


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

:- pred table_gen__process_proc(eval_method, pred_id, proc_id, proc_info, 
		pred_info, module_info, module_info).
:- mode table_gen__process_proc(in, in, in, in, in, in, out) is det.

table_gen__process_proc(EvalMethod, PredId, ProcId, ProcInfo0, PredInfo0, 
		Module0, Module) :-
	% grab the appropriate fields from the pred_info and proc_info
	proc_info_interface_code_model(ProcInfo0, CodeModel),
	proc_info_headvars(ProcInfo0, HeadVars),
	proc_info_varset(ProcInfo0, VarSet0),
	proc_info_vartypes(ProcInfo0, VarTypes0),
	proc_info_goal(ProcInfo0, OrigGoal),
	proc_info_argmodes(ProcInfo0, ArgModes),

	(
		CodeModel = model_det,
		table_gen__create_new_det_goal(EvalMethod, OrigGoal, 
			PredInfo0, Module0, HeadVars, ArgModes, VarTypes0, 
			VarTypes, VarSet0, VarSet, Goal)
	;
		CodeModel = model_semi,
		table_gen__create_new_semi_goal(EvalMethod, OrigGoal, 
			PredInfo0, Module0, HeadVars, ArgModes, VarTypes0, 
			VarTypes, VarSet0, VarSet, Goal)
	;
		CodeModel = model_non,
		table_gen__create_new_non_goal(EvalMethod, OrigGoal, 
			PredInfo0, Module0, HeadVars, ArgModes, VarTypes0, 
			VarTypes, VarSet0, VarSet, Goal)
	),

	% set the new values of the fields in proc_info and pred_info
	% and save in the module info
	proc_info_set_goal(ProcInfo0, Goal, ProcInfo1),
	proc_info_set_varset(ProcInfo1, VarSet, ProcInfo2),
	proc_info_set_vartypes(ProcInfo2, VarTypes, ProcInfo),

	pred_info_procedures(PredInfo0, ProcTable1),
	map__det_update(ProcTable1, ProcId, ProcInfo, ProcTable),
	pred_info_set_procedures(PredInfo0, ProcTable, PredInfo),
	module_info_preds(Module0, PredTable0),
	map__det_update(PredTable0, PredId, PredInfo, PredTable),
	module_info_set_preds(Module0, PredTable, Module).


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

		%
		% Transform deterministic procedures.
		%
:- pred table_gen__create_new_det_goal(eval_method, hlds_goal, pred_info, 
		module_info, list(var), list(mode), map(var, type), 
		map(var, type), varset, varset, hlds_goal).
:- mode table_gen__create_new_det_goal(in, in, in, in, in, in, in, out, in, 
		out, out) is det.

table_gen__create_new_det_goal(EvalMethod, OrigGoal, PredInfo, Module, 
		HeadVars, HeadVarModes, VarTypes0, VarTypes, VarSet0, 
		VarSet, Goal) :-
	get_input_output_vars(HeadVars, HeadVarModes, Module, InputVars, 
		OutputVars),

	generate_det_lookup_goal(InputVars, Module, VarTypes0, VarTypes1, 
		VarSet0, VarSet1, TableVar, LookUpGoal),
	generate_call("table_have_ans", [TableVar], semidet, semipure, 
		[], Module, HaveAnsCheckGoal),
	generate_save_goal(OutputVars, TableVar, VarTypes1, VarTypes2,
		VarSet1, VarSet2, Module, SaveAnsGoal0),
	generate_restore_goal(OutputVars, TableVar,  Module, VarTypes2,
		VarTypes3, VarSet2, VarSet3, RestoreAnsGoal),
	generate_call("table_mark_done_working", [TableVar], det, impure,
		[], Module, DoneWorkingGoal),
	generate_loop_error_goal(PredInfo, Module, VarTypes3, VarTypes,
		VarSet3, VarSet, LoopErrorGoal),  

	OrigGoal = _ - OrigGoalInfo,
	goal_info_get_nonlocals(OrigGoalInfo, OrigNonLocals),
	goal_info_get_instmap_delta(OrigGoalInfo, OrigInstMapDelta),
	
	set__insert(OrigNonLocals, TableVar, GenAnsNonLocals),

	
	( EvalMethod = eval_loop_check ->
		SaveAnsGoal = DoneWorkingGoal
	;	EvalMethod = eval_memo ->
		SaveAnsGoal = SaveAnsGoal0
	;
		error(
    "table_gen__create_new_det_goal: unsupported evaluation model")
	),
	
	generate_call("table_working_on_ans", [TableVar], semidet,
		semipure, [], Module, WorkingCheckGoal),
	generate_call("table_mark_as_working", [TableVar], det,
		impure, [], Module, MarkAsWorkingGoal),

	NoLoopGenAnsGoalEx = conj([MarkAsWorkingGoal, OrigGoal,
		SaveAnsGoal]),
	create_instmap_delta([MarkAsWorkingGoal, OrigGoal, 
		SaveAnsGoal], NoLoopGenInstMapDelta0),
	instmap_delta_restrict(NoLoopGenInstMapDelta0, GenAnsNonLocals,
		NoLoopGenInstMapDelta),
	goal_info_init(GenAnsNonLocals, NoLoopGenInstMapDelta, det,
		NoLoopGenGoalInfo),
	NoLoopGenAnsGoal = NoLoopGenAnsGoalEx - NoLoopGenGoalInfo,

	map__init(StoreMap),
	GenAnsGoalEx = if_then_else([], WorkingCheckGoal, 
		LoopErrorGoal, NoLoopGenAnsGoal, StoreMap),
	create_instmap_delta([WorkingCheckGoal, LoopErrorGoal,
		NoLoopGenAnsGoal], GenAnsInstMapDelta0),
	instmap_delta_restrict(GenAnsInstMapDelta0, GenAnsNonLocals, 
		GenAnsInstMapDelta),
	goal_info_init(GenAnsNonLocals, GenAnsInstMapDelta, det, 
		GenAnsGoalInfo),
			
	GenAnsGoal = GenAnsGoalEx - GenAnsGoalInfo

	ITEGoalEx = if_then_else([], HaveAnsCheckGoal, RestoreAnsGoal, 
		GenAnsGoal, StoreMap),
	create_instmap_delta([HaveAnsCheckGoal, RestoreAnsGoal, GenAnsGoal],
		ITEInstMapDelta0),
	instmap_delta_restrict(ITEInstMapDelta0, GenAnsNonLocals,
		ITEInstMapDelta),
	goal_info_init(GenAnsNonLocals, ITEInstMapDelta, det, 
		ITEGoalInfo),
	ITEGoal = ITEGoalEx - ITEGoalInfo,	

	GoalEx = conj([LookUpGoal, ITEGoal]),
	goal_info_init(OrigNonLocals, OrigInstMapDelta, det, GoalInfo),

	Goal = GoalEx - GoalInfo.

%------------------------------------------------------------------------------%
	
		%
		% Transform semi deterministic procedures
		%
:- pred table_gen__create_new_semi_goal(eval_method, hlds_goal, pred_info, 
		module_info, list(var), list(mode), map(var, type), 
		map(var, type), varset, varset, hlds_goal).
:- mode table_gen__create_new_semi_goal(in, in, in, in, in, in, in, out, in, 
		out, out) is det.

table_gen__create_new_semi_goal(EvalMethod, OrigGoal, PredInfo, Module, 
		HeadVars, HeadVarModes, VarTypes0, VarTypes, VarSet0, 
		VarSet, Goal) :-
	get_input_output_vars(HeadVars, HeadVarModes, Module, InputVars, 
		OutputVars),

	generate_det_lookup_goal(InputVars, Module, VarTypes0, VarTypes1, 
		VarSet0, VarSet1, TableVar, LookUpGoal),
	generate_call("table_have_ans", [TableVar], semidet, semipure, 
		[], Module, HaveAnsCheckGoal),
	generate_save_goal(OutputVars, TableVar, VarTypes1, VarTypes2,
		VarSet1, VarSet2, Module, SaveAnsGoal0),
	generate_restore_goal(OutputVars, TableVar,  Module, VarTypes2,
		VarTypes3, VarSet2, VarSet3, RestoreTrueAnsGoal),
	generate_loop_error_goal(PredInfo, Module, VarTypes3, VarTypes,
		VarSet3, VarSet, LoopErrorGoal),  
	generate_call("table_mark_as_failed", [TableVar], failure, impure, 
		[], Module, MarkAsFailedGoal),
	generate_call("table_has_succeeded", [TableVar], semidet, semipure,
		[], Module, HasSucceededCheckGoal),
	generate_call("table_mark_done_working", [TableVar], det, impure,
		[], Module, DoneWorkingGoal),

	OrigGoal = _ - OrigGoalInfo,
	goal_info_get_nonlocals(OrigGoalInfo, OrigNonLocals),
	goal_info_get_instmap_delta(OrigGoalInfo, OrigInstMapDelta),
	
	set__insert(OrigNonLocals, TableVar, GenAnsNonLocals),

	map__init(StoreMap),
	(
		(
			EvalMethod = eval_loop_check
		;
			EvalMethod = eval_memo
		)
	->
		(
			EvalMethod = eval_loop_check
		->
			SaveAnsGoal = DoneWorkingGoal
		;
			SaveAnsGoal = SaveAnsGoal0
		),
		generate_call("table_working_on_ans", [TableVar], semidet,
			semipure, [], Module, WorkingCheckGoal),
		generate_call("table_mark_as_working", [TableVar], det,
			impure, [], Module, MarkAsWorkingGoal),
	
		NoLoopGenAnsGoalEx = conj([MarkAsWorkingGoal, OrigGoal]),
		create_instmap_delta([MarkAsWorkingGoal, OrigGoal], 
			NoLoopGenInstMapDelta0),
		instmap_delta_restrict(NoLoopGenInstMapDelta0, GenAnsNonLocals,
			NoLoopGenInstMapDelta),
		goal_info_init(GenAnsNonLocals, NoLoopGenInstMapDelta, semidet,
			NoLoopGenGoalInfo),
		NoLoopGenAnsGoal = NoLoopGenAnsGoalEx - NoLoopGenGoalInfo,

		GenTrueAnsGoalEx = if_then_else([], WorkingCheckGoal, 
			LoopErrorGoal, NoLoopGenAnsGoal, StoreMap),
		create_instmap_delta([WorkingCheckGoal, LoopErrorGoal,
			NoLoopGenAnsGoal], GenTrueAnsInstMapDelta0),
		instmap_delta_restrict(GenTrueAnsInstMapDelta0, 
			GenAnsNonLocals, GenTrueAnsInstMapDelta),
		goal_info_init(GenAnsNonLocals, GenTrueAnsInstMapDelta, 
			semidet, GenTrueAnsGoalInfo),
				
		GenTrueAnsGoal = GenTrueAnsGoalEx - GenTrueAnsGoalInfo
	;
		EvalMethod = eval_minimal
	->
		SaveAnsGoal = SaveAnsGoal0,

		generate_call("table_not_working_on_ans", [TableVar], semidet,
			semipure, [], Module, NotWorkingCheckGoal),
		
		generate_call("table_mark_as_working", [TableVar], det,
			impure, [], Module, MarkAsWorkingGoal),
	
		GenTrueAnsGoalEx = conj([NotWorkingCheckGoal, 
			MarkAsWorkingGoal, OrigGoal]),
		
		create_instmap_delta([NotWorkingCheckGoal, MarkAsWorkingGoal, 
			OrigGoal, SaveAnsGoal], GenTrueAnsInstMapDelta0),
		instmap_delta_restrict(GenTrueAnsInstMapDelta0, 
			GenAnsNonLocals, GenTrueAnsInstMapDelta),
		goal_info_init(GenAnsNonLocals, GenTrueAnsInstMapDelta, 
			semidet, GenTrueAnsGoalInfo),
				
		GenTrueAnsGoal = GenTrueAnsGoalEx - GenTrueAnsGoalInfo
	;
		error(
    "table_gen__create_new_semi_goal: unsupported evaluation model")
	),

	RestAnsGoalEx = conj([HasSucceededCheckGoal, RestoreTrueAnsGoal]),
	set__singleton_set(RestNonLocals0, TableVar),
	set__insert_list(RestNonLocals0, OutputVars, RestNonLocals),
	create_instmap_delta([HasSucceededCheckGoal, RestoreTrueAnsGoal], 
		RestInstMapDelta0),
	instmap_delta_restrict(RestInstMapDelta0, RestNonLocals,
		RestInstMapDelta),
	goal_info_init(RestNonLocals, RestInstMapDelta, semidet, 
		RestAnsGoalInfo),
	RestoreAnsGoal = RestAnsGoalEx - RestAnsGoalInfo,

	GenAnsGoalEx = if_then_else([], GenTrueAnsGoal, SaveAnsGoal, 
		MarkAsFailedGoal, StoreMap),
	create_instmap_delta([GenTrueAnsGoal, SaveAnsGoal, MarkAsFailedGoal], 
		GenAnsGoalInstMapDelta0),
	instmap_delta_restrict(GenAnsGoalInstMapDelta0, GenAnsNonLocals,
		GenAnsGoalInstMapDelta),
	goal_info_init(GenAnsNonLocals, GenAnsGoalInstMapDelta, semidet,
		GenAnsGoalInfo),
	GenAnsGoal = GenAnsGoalEx - GenAnsGoalInfo,
	
	ITEGoalEx = if_then_else([], HaveAnsCheckGoal, RestoreAnsGoal, 
		GenAnsGoal, StoreMap),
	create_instmap_delta([HaveAnsCheckGoal, RestoreAnsGoal, GenAnsGoal],
		ITEInstMapDelta0),
	instmap_delta_restrict(ITEInstMapDelta0, GenAnsNonLocals,
		ITEInstMapDelta),
	goal_info_init(GenAnsNonLocals, ITEInstMapDelta, semidet, 
		ITEGoalInfo),
	ITEGoal = ITEGoalEx - ITEGoalInfo,	

	GoalEx = conj([LookUpGoal, ITEGoal]),
	goal_info_init(OrigNonLocals, OrigInstMapDelta, semidet, GoalInfo),

	Goal = GoalEx - GoalInfo.
	

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

		%
		% Transform non deterministic procedures
		%
:- pred table_gen__create_new_non_goal(eval_method, hlds_goal, pred_info, 
		module_info, list(var), list(mode), map(var, type), 
		map(var, type), varset, varset, hlds_goal).
:- mode table_gen__create_new_non_goal(in, in, in, in, in, in, in, out, in, 
		out, out) is det.

table_gen__create_new_non_goal(EvalMethod, OrigGoal, PredInfo, Module, 
		HeadVars, HeadVarModes, VarTypes0, VarTypes, VarSet0, 
		VarSet, Goal) :-
	get_input_output_vars(HeadVars, HeadVarModes, Module, InputVars, 
		OutputVars),

	generate_non_lookup_goal(InputVars, Module, VarTypes0, VarTypes1, 
		VarSet0, VarSet1, TableVar, LookUpGoal),
	generate_call("table_have_all_ans", [TableVar], semidet, semipure, 
		[], Module, HaveAllAnsCheckGoal),
	generate_non_save_goal(OutputVars, TableVar, VarTypes1, VarTypes2,
		VarSet1, VarSet2, Module, SaveAnsGoal0),
	generate_restore_all_goal(OutputVars, TableVar,  Module, VarTypes2,
		VarTypes3, VarSet2, VarSet3, RestoreAllAnsGoal),
	generate_call("table_have_some_ans", [TableVar], semidet, semipure,
		[], Module, HaveSomeAnsCheckGoal),
	generate_suspend_goal(OutputVars, TableVar, Module, VarTypes3, 
		VarTypes4, VarSet3, VarSet4, SuspendGoal),
	generate_loop_error_goal(PredInfo, Module, VarTypes4, VarTypes,
		VarSet4, VarSet, LoopErrorGoal),  
	generate_call("table_mark_have_some_ans", [TableVar], det, impure,
		[], Module, MarkHaveSomeAnsGoal),
	generate_call("table_resume", [TableVar], failure, impure,
		[], Module, ResumeGoal0),
	generate_call("table_mark_have_all_ans", [TableVar], failure, impure,
		[], Module, MarkHaveAllAnsGoal),

	true_goal(TrueGoal),
	fail_goal(FailGoal),
	
	OrigGoal = _ - OrigGoalInfo,
	goal_info_get_nonlocals(OrigGoalInfo, OrigNonLocals),
	goal_info_get_instmap_delta(OrigGoalInfo, OrigInstMapDelta),
	
	map__init(StoreMap),
	(
		EvalMethod = eval_memo
	->
		SaveAnsGoal = SaveAnsGoal0,
		WorkingOnAnsGoal = LoopErrorGoal
	;
		EvalMethod = eval_loop_check
	->
		SaveAnsGoal = TrueGoal, 
		WorkingOnAnsGoal = LoopErrorGoal
	;
		EvalMethod = eval_minimal
	->
		SaveAnsGoal = SaveAnsGoal0,
		WorkingOnAnsGoal = SuspendGoal
	;
		error(
    "table_gen__create_new_non_goal: unsupported evaluation model")
	),


	GenAnsGoalPart1Ex = conj([MarkHaveSomeAnsGoal, OrigGoal, SaveAnsGoal]),
	set__insert(OrigNonLocals, TableVar, GenAnsGoalPart1NonLocals),
	create_instmap_delta([MarkHaveSomeAnsGoal, OrigGoal, SaveAnsGoal],
		GenAnsGoalPart1IMD0),
	instmap_delta_restrict(GenAnsGoalPart1IMD0, GenAnsGoalPart1NonLocals,
		GenAnsGoalPart1IMD),
	goal_info_init(GenAnsGoalPart1NonLocals, GenAnsGoalPart1IMD, nondet,
		GenAnsGoalPart1GoalInfo),
	GenAnsGoalPart1 = GenAnsGoalPart1Ex - GenAnsGoalPart1GoalInfo,

	(
		EvalMethod = eval_minimal
	->
		ResumeGoal = ResumeGoal0
	;
		ResumeGoal = FailGoal
	),
	GenAnsGoalEx = disj([GenAnsGoalPart1, ResumeGoal, MarkHaveAllAnsGoal], 
		StoreMap),
	GenAnsGoal = GenAnsGoalEx - GenAnsGoalPart1GoalInfo,

	ITE1GoalEx = if_then_else([], HaveSomeAnsCheckGoal, WorkingOnAnsGoal, 
		GenAnsGoal, StoreMap),
	ITE1Goal = ITE1GoalEx - GenAnsGoalPart1GoalInfo,

	(
		EvalMethod = eval_loop_check
	->
		ITE2Goal = ITE1Goal
	;	
		ITE2GoalEx = if_then_else([], HaveAllAnsCheckGoal, 
			RestoreAllAnsGoal, ITE1Goal, StoreMap),
		ITE2Goal = ITE2GoalEx - GenAnsGoalPart1GoalInfo
	),

	GoalEx = conj([LookUpGoal, ITE2Goal]),
	goal_info_init(OrigNonLocals, OrigInstMapDelta, nondet, GoalInfo),

	Goal = GoalEx - GoalInfo.

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

	
:- pred generate_get_table_goals(map(var, type), map(var, type), varset,
		varset, module_info, var, hlds_goal).
:- mode generate_get_table_goals(in, out, in, out, in, out, out) is det.

generate_get_table_goals(VarTypes0, VarTypes, VarSet0, VarSet, Module, 
		TableVar, Goal) :-
	generate_new_table_var(VarTypes0, VarTypes, VarSet0, VarSet, 
		TableVar),

		% The predicate get_table/1 is used only for its pred_info
		% the code is not actualy called.  We have to steal the 
		% pred_info for the c_code instruction below.		
	module_info_get_predicate_table(Module, PredTable),
	mercury_private_builtin_module(BuiltinModule),
	(
		predicate_table_search_pred_m_n_a(PredTable,
			BuiltinModule, "get_table", 1, 
			[PredId0])
	->
		PredId = PredId0
	;
		error("can't locate get_table/1")
	),
	module_info_pred_info(Module, PredId, PredInfo),
	(
		pred_info_procids(PredInfo, [ProcId0])
	->
		ProcId = ProcId0
	;
		error("too many modes for predicate get_table/1")
	),
	
	TableVarInst = ground(unique, no), 
	TableVarMode = (free -> TableVarInst), 
	get_table_var_type(TableVarType),
	
	GoalEx = pragma_c_code(will_not_call_mercury, PredId, ProcId,
			[TableVar], [yes("MC_table_var" - TableVarMode)], 
			[TableVarType], ordinary( 
"	{
		static Word MR_table = 0;
		MC_table_var = (Word)&MR_table;
	}
", 
		no)), 
	
	
	set__singleton_set(NonLocals, TableVar),
	instmap_delta_from_assoc_list([TableVar - TableVarInst],
		InstMapDelta),
	goal_info_init(NonLocals, InstMapDelta, det, 
		GoalInfo0),
	goal_info_add_feature(GoalInfo0, impure, GoalInfo),
	Goal = GoalEx - GoalInfo.

%------------------------------------------------------------------------------%
	
:- pred generate_det_lookup_goal(list(var), module_info, map(var, type), 
		map(var, type), varset, varset, var, hlds_goal).
:- mode generate_det_lookup_goal(in, in, in, out, in, out, out, out) is det.

generate_det_lookup_goal(Vars, Module, VarTypes0, VarTypes, VarSet0, VarSet, 
		TableVar, Goal) :-

	generate_get_table_goals(VarTypes0, VarTypes1, VarSet0, VarSet1, Module,
		TableVar0, GetTableGoal),
	generate_lookup_goals(Vars, TableVar0, TableVar, Module, 
		VarTypes1, VarTypes, VarSet1, VarSet, LookupGoals),

	GoalEx = conj([GetTableGoal | LookupGoals]),
	set__singleton_set(NonLocals0, TableVar),
	set__insert_list(NonLocals0, Vars, NonLocals),
	instmap_delta_from_assoc_list([], InstMapDelta),
	goal_info_init(NonLocals, InstMapDelta, det, GoalInfo),
	Goal = GoalEx - GoalInfo.
	
:- pred generate_non_lookup_goal(list(var), module_info, map(var, type), 
		map(var, type), varset, varset, var, hlds_goal).
:- mode generate_non_lookup_goal(in, in, in, out, in, out, out, out) is det.

generate_non_lookup_goal(Vars, Module, VarTypes0, VarTypes, VarSet0, VarSet, 
		TableVar, Goal) :-

	generate_get_table_goals(VarTypes0, VarTypes1, VarSet0, VarSet1, Module,
		TableVar0, GetTableGoal),
	generate_lookup_goals(Vars, TableVar0, TableVar1, Module, 
		VarTypes1, VarTypes2, VarSet1, VarSet2, LookupGoals),
	generate_new_table_var(VarTypes2, VarTypes, VarSet2, VarSet, 
		TableVar),
	generate_call("table_setup", [TableVar1, TableVar], det, impure,
		[TableVar - ground(unique, no)], Module, SetupGoal),

	list__append([GetTableGoal | LookupGoals], [SetupGoal], Goals),
	GoalEx = conj(Goals),
	set__singleton_set(NonLocals0, TableVar),
	set__insert_list(NonLocals0, Vars, NonLocals),
	create_instmap_delta(Goals, InstMapDelta0),
	instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
	goal_info_init(NonLocals, InstMapDelta, det, GoalInfo),
	Goal = GoalEx - GoalInfo.

		
:- pred generate_lookup_goals(list(var), var, var, module_info, 
		map(var, type), map(var, type), varset, varset, 
		list(hlds_goal)).
:- mode generate_lookup_goals(in, in, out, in, in, out, in, out, out) is det.


generate_lookup_goals([], TableVar, TableVar, _, VarTypes, VarTypes, VarSet, 
		VarSet, []).
generate_lookup_goals([Var|Rest], TableVar0, TableVar, Module, VarTypes0, 
		VarTypes, VarSet0, VarSet, [Goal|RestGoals]) :-
	map__lookup(VarTypes0, Var, VarType),

	classify_type(VarType, Module, TypeCat),
	gen_lookup_call_for_type(TypeCat, VarType, TableVar0, Var,
		Module, VarTypes0, VarTypes1, VarSet0, VarSet1, TableVar1, 
		Goal),
	generate_lookup_goals(Rest, TableVar1, TableVar, Module, 
		VarTypes1, VarTypes, VarSet1, VarSet, RestGoals).


:- pred gen_lookup_call_for_type(builtin_type, type, var, var, module_info, 
		map(var, type), map(var, type), varset, varset, var, 
		hlds_goal).
:- mode gen_lookup_call_for_type(in, in, in, in, in, in, out, in, 
		out, out, out) is det.

gen_lookup_call_for_type(TypeCat, Type, TableVar, ArgVar, Module, VarTypes0,
		VarTypes, VarSet0, VarSet, NextTableVar, Goal) :-
	(
		TypeCat = enum_type
	->
		(
			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_call_for_type: enum type is not du_type?")    
			),
			gen_int_construction("RangeVar", EnumRange, VarTypes0, 
				VarTypes1, VarSet0, VarSet1, RangeVar, 
				RangeUnifyGoal),

			generate_new_table_var(VarTypes1, VarTypes, VarSet1, 
				VarSet, NextTableVar),
			generate_call("table_lookup_insert_enum", [TableVar,
				RangeVar, ArgVar, NextTableVar], det, impure,
				[NextTableVar - ground(unique, no)], Module, 
				LookupGoal),
			set__init(NonLocals0),
			set__insert_list(NonLocals0, [TableVar, ArgVar], 
				NonLocals), 
			instmap_delta_from_assoc_list([], InstMapDelta),
			goal_info_init(NonLocals, InstMapDelta, det, GoalInfo),
			Goal = conj([RangeUnifyGoal, LookupGoal]) - GoalInfo
		;
			error("gen_lookup: unexpected type")
		)
	;
		(
			(
				TypeCat = pred_type
			;
				TypeCat = polymorphic_type
			;
				TypeCat = user_type
			)
		->
			(
				term__vars(Type, [])
			->
				LookupPredName = "table_lookup_insert_user"
			;
				LookupPredName = "table_lookup_insert_poly"
			)
		;
			builtin_type_to_string(TypeCat, CatString),
			string__append("table_lookup_insert_", CatString,
				LookupPredName)
		),
		generate_new_table_var(VarTypes0, VarTypes, VarSet0, VarSet, 
			NextTableVar),
		generate_call(LookupPredName, [TableVar, ArgVar, NextTableVar], 
			det, impure, [NextTableVar - ground(unique, no)], 
			Module, Goal)
	).


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

:- pred generate_save_goal(list(var), var, map(var, type), map(var, type),
		varset, varset, module_info, hlds_goal).
:- mode generate_save_goal(in, in, in, out, in, out, in, out) is det.

generate_save_goal(AnsList, TableVar, VarTypes0, VarTypes, VarSet0,
		VarSet, Module, Goal) :-
	
	list__length(AnsList, NumAnsVars),
	(
		NumAnsVars \= 0
	->
		gen_int_construction("NumAnsVars", NumAnsVars, VarTypes0, 
			VarTypes1, VarSet0, VarSet1, NumAnsVarsVar, 
			NumAnsVarsUnifyGoal),
	
		generate_new_table_var(VarTypes1, VarTypes2, VarSet1, VarSet2,
			AnsTableVar),
		
		generate_call("table_create_ans_block", [TableVar, 
			NumAnsVarsVar, AnsTableVar], det, impure, 
			[AnsTableVar - ground(unique, no)], Module, 
			GenAnsBlockGoal),
	
		generate_save_goals(AnsList, AnsTableVar, 0, Module, 
			VarTypes2, VarTypes, VarSet2, VarSet, SaveGoals),

		GoalEx = conj([NumAnsVarsUnifyGoal, GenAnsBlockGoal | 
			SaveGoals]),
		set__singleton_set(NonLocals0, TableVar),
		set__insert_list(NonLocals0, AnsList, NonLocals),
		create_instmap_delta([NumAnsVarsUnifyGoal, GenAnsBlockGoal |
			SaveGoals], InstMapDelta0),
		instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
		goal_info_init(NonLocals, InstMapDelta, det,  GoalInfo),
		Goal = GoalEx - GoalInfo
	;
		VarTypes = VarTypes0,
		VarSet = VarSet0,
		generate_call("table_mark_as_succeeded", [TableVar], det,
			impure, [], Module, Goal)
	).
	
:- pred generate_non_save_goal(list(var), var, map(var, type), map(var, type),
		varset, varset, module_info, hlds_goal).
:- mode generate_non_save_goal(in, in, in, out, in, out, in, out) is det.

generate_non_save_goal(AnsList, TableVar, VarTypes0, VarTypes, VarSet0,
		VarSet, Module, Goal) :-
	
	generate_new_table_var(VarTypes0, VarTypes1, VarSet0, VarSet1,
		AnsTableVar0),
	generate_call("table_get_ans_table", [TableVar, AnsTableVar0], det, 
		impure, [AnsTableVar0 - ground(unique, no)], Module, 
		GetAnsTableGoal),
	generate_lookup_goals(AnsList, AnsTableVar0, AnsTableVar1, Module, 
		VarTypes1, VarTypes2, VarSet1, VarSet2, LookupAnsGoals),
	generate_call("table_has_not_returned", [AnsTableVar1], semidet, 
		semipure, [], Module, NewAnsCheckGoal),
	generate_call("table_mark_as_returned", [AnsTableVar1], det, impure,
		[],  Module, MarkAsReturnedGoal),

	generate_new_table_var(VarTypes2, VarTypes3, VarSet2, VarSet3,
		AnsBlockVar0),
	generate_call("table_new_ans_slot", [TableVar, AnsBlockVar0], det,
		impure, [AnsBlockVar0 - ground(unique, no)], Module,
		GenAnsSlotGoal),
	
	list__length(AnsList, NumAnsVars),
	gen_int_construction("NumAnsVars", NumAnsVars, VarTypes3, VarTypes4,
		VarSet3, VarSet4, NumAnsVarsVar, NumAnsVarsUnifyGoal),
	generate_new_table_var(VarTypes4, VarTypes5, VarSet4, VarSet5,
		AnsBlockVar),
	generate_call("table_create_ans_block", [AnsBlockVar0, NumAnsVarsVar,
		AnsBlockVar], det, impure, [AnsBlockVar - ground(unique, no)], 
		Module, GenAnsBlockGoal),
	
	generate_save_goals(AnsList, AnsBlockVar, 0, Module, VarTypes5,
		VarTypes, VarSet5, VarSet, SaveGoals),


	list__append([GetAnsTableGoal | LookupAnsGoals],
		[NewAnsCheckGoal, MarkAsReturnedGoal, GenAnsSlotGoal, 
		NumAnsVarsUnifyGoal, GenAnsBlockGoal | SaveGoals], Goals),

	GoalEx = conj(Goals),
	set__singleton_set(NonLocals0, TableVar),
	set__insert_list(NonLocals0, AnsList, NonLocals),
	create_instmap_delta(Goals, InstMapDelta0),
	instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
	goal_info_init(NonLocals, InstMapDelta, semidet,  GoalInfo),
	Goal = GoalEx - GoalInfo.


:- pred generate_save_goals(list(var), var, int, module_info, map(var, type),
		map(var, type), varset, varset, list(hlds_goal)).
:- mode generate_save_goals(in, in, in, in, in, out, in, out, out) is det.

generate_save_goals([], _TableVar, _Offset, _Module, VarTypes, VarTypes,
		VarSet, VarSet, []).
generate_save_goals([Var|Rest], TableVar, Offset0, Module, VarTypes0, 
		VarTypes, VarSet0, VarSet, [OffsetUnifyGoal, 
		CallGoal|RestGoals]) :-

	gen_int_construction("OffsetVar", Offset0, VarTypes0, VarTypes1,
		VarSet0, VarSet1, OffsetVar, OffsetUnifyGoal),
	
	map__lookup(VarTypes1, Var, VarType),
	classify_type(VarType, Module, TypeCat),
	
	gen_save_call_for_type(TypeCat, VarType, TableVar, Var, OffsetVar, 
		Module, CallGoal),

	Offset is Offset0 + 1,
	generate_save_goals(Rest, TableVar, Offset, Module, VarTypes1, 
		VarTypes, VarSet1, VarSet, RestGoals).


:- pred gen_save_call_for_type(builtin_type, type, var, var, var, module_info, 
		hlds_goal).
:- mode gen_save_call_for_type(in, in, in, in, in, in, out) is det.

gen_save_call_for_type(TypeCat, _Type, TableVar, Var, OffsetVar, Module, 
		Goal) :-
	(
		not_builtin_type(TypeCat)
	->
		LookupPredName = "table_save_any_ans"
	;
		builtin_type_to_string(TypeCat, CatString),
		string__append_list(["table_save_", CatString, "_ans"],
			LookupPredName)
	),
	generate_call(LookupPredName, [TableVar, OffsetVar, Var], 
		det, impure, [], Module, Goal).
		

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


:- pred generate_restore_goal(list(var), var, module_info, map(var, type),
		map(var, type), varset, varset, hlds_goal).
:- mode generate_restore_goal(in, in, in, in, out, in, out, out) is det.

generate_restore_goal(OutputVars, TableVar, Module, VarTypes0, VarTypes, 
		VarSet0, VarSet, Goal) :-

	generate_restore_goals(OutputVars, TableVar, 0, Module, VarTypes0, 
		VarTypes, VarSet0, VarSet, RestoreGoals),
	
	GoalEx = conj(RestoreGoals),
	set__singleton_set(NonLocals0, TableVar),
	set__insert_list(NonLocals0, OutputVars, NonLocals),
	create_instmap_delta(RestoreGoals, InstMapDelta0),
	instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
	goal_info_init(NonLocals, InstMapDelta, det, 
		GoalInfo),
	Goal = GoalEx - GoalInfo.
	
:- pred generate_restore_all_goal(list(var), var, module_info, map(var, type),
		map(var, type), varset, varset, hlds_goal).
:- mode generate_restore_all_goal(in, in, in, in, out, in, out, out) is det.

generate_restore_all_goal(OutputVars, TableVar, Module, VarTypes0, VarTypes, 
		VarSet0, VarSet, Goal) :-

	generate_new_table_var(VarTypes0, VarTypes1, VarSet0, VarSet1, 
		AnsTableVar),
	generate_call("table_return_all_ans", [TableVar, AnsTableVar], 
		nondet, semipure, [AnsTableVar - ground(unique, no)], 
		Module, ReturnAnsBlocksGoal),
	
	generate_restore_goals(OutputVars, AnsTableVar, 0, Module, VarTypes1, 
		VarTypes, VarSet1, VarSet, RestoreGoals),
	
	GoalEx = conj([ReturnAnsBlocksGoal | RestoreGoals]),
	set__singleton_set(NonLocals0, TableVar),
	set__insert_list(NonLocals0, OutputVars, NonLocals),
	create_instmap_delta([ReturnAnsBlocksGoal | RestoreGoals],
		InstMapDelta0),
	instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
	goal_info_init(NonLocals, InstMapDelta, nondet, 
		GoalInfo),
	Goal = GoalEx - GoalInfo.
	
:- pred generate_restore_goals(list(var), var, int, module_info, map(var, type),
		map(var, type), varset, varset, list(hlds_goal)).
:- mode generate_restore_goals(in, in, in, in, in, out, in, out, out) is det.

generate_restore_goals([], _TableVar, _Offset, _Module, VarTypes, VarTypes,
		VarSet, VarSet, []).
generate_restore_goals([Var|Rest], TableVar, Offset0, Module, VarTypes0, 
		VarTypes, VarSet0, VarSet, [OffsetUnifyGoal, 
		CallGoal|RestGoals]) :-

	gen_int_construction("OffsetVar", Offset0, VarTypes0, VarTypes1,
		VarSet0, VarSet1, OffsetVar, OffsetUnifyGoal),
	
	map__lookup(VarTypes1, Var, VarType),
	classify_type(VarType, Module, TypeCat),
	
	gen_restore_call_for_type(TypeCat, VarType, TableVar, Var, OffsetVar, 
		Module, CallGoal),

	Offset is Offset0 + 1,
	generate_restore_goals(Rest, TableVar, Offset, Module, VarTypes1, 
		VarTypes, VarSet1, VarSet, RestGoals).


:- pred gen_restore_call_for_type(builtin_type, type, var, var, var, 
		module_info, hlds_goal).
:- mode gen_restore_call_for_type(in, in, in, in, in, in, out) is det.

gen_restore_call_for_type(TypeCat, _Type, TableVar, Var, OffsetVar, Module, 
		Goal) :-
	(
		not_builtin_type(TypeCat)
	->
		LookupPredName = "table_restore_any_ans"
	;
		builtin_type_to_string(TypeCat, CatString),
		string__append_list(["table_restore_", CatString, "_ans"],
			LookupPredName)
	),
	generate_call(LookupPredName, [TableVar, OffsetVar, Var], 
		det, impure, [Var - ground(shared, no)], Module, Goal).

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

:- pred generate_suspend_goal(list(var), var, module_info, map(var, type),
		map(var, type), varset, varset, hlds_goal).
:- mode generate_suspend_goal(in, in, in, in, out, in, out, out) is det.

generate_suspend_goal(OutputVars, TableVar, Module, VarTypes0, VarTypes, 
		VarSet0, VarSet, Goal) :-
	
	generate_new_table_var(VarTypes0, VarTypes1, VarSet0, VarSet1, 
		AnsTableVar),
	generate_call("table_suspend", [TableVar, AnsTableVar], 
		nondet, semipure, [AnsTableVar - ground(unique, no)], 
		Module, ReturnAnsBlocksGoal),
	
	generate_restore_goals(OutputVars, AnsTableVar, 0, Module, VarTypes1, 
		VarTypes, VarSet1, VarSet, RestoreGoals),
	
	GoalEx = conj([ReturnAnsBlocksGoal | RestoreGoals]),
	set__singleton_set(NonLocals0, TableVar),
	set__insert_list(NonLocals0, OutputVars, NonLocals),
	create_instmap_delta([ReturnAnsBlocksGoal | RestoreGoals],
		InstMapDelta0),
	instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
	goal_info_init(NonLocals, InstMapDelta, nondet, 
		GoalInfo),
	Goal = GoalEx - GoalInfo.	

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

:- pred generate_loop_error_goal(pred_info, module_info, map(var, type), 
		map(var, type), varset, varset, hlds_goal).
:- mode generate_loop_error_goal(in, in, in, out, in, out, out) is det.

generate_loop_error_goal(PredInfo, ModuleInfo, VarTypes0, VarTypes,
		VarSet0, VarSet, Goal) :-
	pred_info_module(PredInfo, Module),	
	pred_info_name(PredInfo, Name),
	pred_info_arity(PredInfo, Arity),
	pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
	hlds_out__pred_or_func_to_str(PredOrFunc, PredOrFuncS),
	prog_out__sym_name_to_string(qualified(Module, Name), NameS),
	string__int_to_string(Arity, ArityS),	
	string__append_list(["detected infinite recursion in ", PredOrFuncS,
		" ", NameS, "/", ArityS], Message),

	gen_string_construction("MessageS", Message, VarTypes0, VarTypes,
		VarSet0, VarSet, MessageVar, MessageConsGoal),
	generate_call("table_loopcheck_error", [MessageVar], erroneous, 
		impure, [], ModuleInfo, CallGoal),
		
	GoalEx = conj([MessageConsGoal, CallGoal]),
	set__init(NonLocals),
	create_instmap_delta([MessageConsGoal, CallGoal],
		InstMapDelta0),
	instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
	goal_info_init(NonLocals, InstMapDelta, failure, 
		GoalInfo),
	Goal = GoalEx - GoalInfo.	
	
			
%------------------------------------------------------------------------------%

:- pred generate_new_table_var(map(var, type), map(var, type), varset, varset,
		var).
:- mode generate_new_table_var(in, out, in, out, out) is det.

generate_new_table_var(VarTypes0, VarTypes, VarSet0, VarSet, Var) :-
	varset__new_named_var(VarSet0, "TableVar", Var, VarSet),
	get_table_var_type(Type),
	map__set(VarTypes0, Var, Type, VarTypes).

:- pred generate_call(string, list(var), determinism, goal_feature,
		assoc_list(var, inst), module_info, hlds_goal).
:- mode generate_call(in, in, in, in, in, in, out) is det.

generate_call(PredName, Args, Detism0, Feature, InstMap, Module, Goal) :-
		% Implement failure as a det call folowed by a fail,
		% this is more efficient
	(
		Detism0 = failure
	->
		Detism = det
	;
		Detism = Detism0
	),
	list__length(Args, Arity),
	mercury_private_builtin_module(BuiltinModule),
	module_info_get_predicate_table(Module, PredTable),
	(
		predicate_table_search_pred_m_n_a(PredTable,
			BuiltinModule, PredName, Arity, 
			[PredId0])
	->
		PredId = PredId0
	;
		string__int_to_string(Arity, ArityS),
		string__append_list(["can't locate ", PredName, 
			"/", ArityS], ErrorMessage),
		error(ErrorMessage)
	),
	module_info_pred_info(Module, PredId, PredInfo),
	(
		pred_info_procids(PredInfo, [ProcId0])
	->
		ProcId = ProcId0
	;
		string__int_to_string(Arity, ArityS),
		string__append_list(["too many modes for pred ",
			PredName, "/", ArityS], ErrorMessage),
		error(ErrorMessage)
		
	),
	Call = call(PredId, ProcId, Args, not_builtin, no, qualified(
		BuiltinModule, PredName)), 
	set__init(NonLocals0),
	set__insert_list(NonLocals0, Args, NonLocals),
	(
		(
			Detism0 = failure
		;
			Detism = erroneous
		)
	->
		instmap_delta_init_unreachable(InstMapDelta)	
	;
		instmap_delta_from_assoc_list(InstMap, InstMapDelta)
	),
	goal_info_init(NonLocals, InstMapDelta, Detism, CallGoalInfo0),
	goal_info_add_feature(CallGoalInfo0, Feature, CallGoalInfo),
	CallGoal = Call - CallGoalInfo,
	(
		Detism0 = failure
	->
		fail_goal(FailGoal),
		goal_info_init(NonLocals, InstMapDelta, failure, GoalInfo),
		Goal = conj([CallGoal, FailGoal]) - GoalInfo
	;
		Goal = CallGoal
	).


:- pred gen_int_construction(string, int, map(var, type), map(var, type),
		varset, varset, var, hlds_goal).
:- mode gen_int_construction(in, in, in, out, in, out, out, out) is det.

gen_int_construction(VarName, VarValue, VarTypes0, VarTypes, VarSet0, VarSet,
		Var, Goal) :-
	
	varset__new_named_var(VarSet0, VarName, Var, VarSet),
	term__context_init(Context),
	VarType = term__functor(term__atom("int"), [], Context),
	map__set(VarTypes0, Var, VarType, VarTypes),

	Inst = bound(unique, [functor(int_const(VarValue), [])]),
	VarUnify = unify(Var, functor(int_const(VarValue), []),
		(free -> Inst) - (Inst -> Inst), 
		construct(Var, int_const(VarValue), [], []),
		unify_context(explicit, [])),
	set__singleton_set(VarNonLocals, Var),
	instmap_delta_from_assoc_list([Var - Inst],
		VarInstMapDelta),
	goal_info_init(VarNonLocals, VarInstMapDelta, det, 
		VarGoalInfo),
	Goal = VarUnify - VarGoalInfo.
	
:- pred gen_string_construction(string, string, map(var, type), map(var, type),
		varset, varset, var, hlds_goal).
:- mode gen_string_construction(in, in, in, out, in, out, out, out) is det.

gen_string_construction(VarName, VarValue, VarTypes0, VarTypes, VarSet0, VarSet,
		Var, Goal) :-
	
	varset__new_named_var(VarSet0, VarName, Var, VarSet),
	term__context_init(Context),
	VarType = term__functor(term__atom("string"), [], Context),
	map__set(VarTypes0, Var, VarType, VarTypes),

	Inst = bound(unique, [functor(string_const(VarValue), [])]),
	VarUnify = unify(Var, functor(string_const(VarValue), []),
		(free -> Inst) - (Inst -> Inst), 
		construct(Var, string_const(VarValue), [], []),
		unify_context(explicit, [])),
	set__singleton_set(VarNonLocals, Var),
	instmap_delta_from_assoc_list([Var - Inst],
		VarInstMapDelta),
	goal_info_init(VarNonLocals, VarInstMapDelta, det, 
		VarGoalInfo),
	Goal = VarUnify - VarGoalInfo.
	

:- pred get_table_var_type(type).
:- mode get_table_var_type(out) is det.

get_table_var_type(Type) :-
	mercury_private_builtin_module(BuiltinModule),
	construct_type(qualified(BuiltinModule, 
		"c_pointer") - 0, [], Type).	


:- pred get_input_output_vars(list(var), list(mode), module_info, list(var),
		list(var)).
:- mode get_input_output_vars(in, in, in, out, out) is det.

get_input_output_vars([], [], _, [], []).
get_input_output_vars([_|_], [], _, _, _) :-
	error("get_input_output_vars: lists not same length").
get_input_output_vars([], [_|_], _, _, _) :-
	error("get_input_output_vars: lists not same length").
get_input_output_vars([Var|RestV], [Mode|RestM], Module, InVars, OutVars) :-
	(
		mode_is_fully_input(Module, Mode)
	->
		get_input_output_vars(RestV, RestM, Module, InVars0, OutVars),
		InVars = [Var|InVars0]
	;
		mode_is_fully_output(Module, Mode)
	->
		get_input_output_vars(RestV, RestM, Module, InVars, OutVars0),
		OutVars = [Var|OutVars0]
	;
		error(
    "Only fully input/output arguments are allowed in tabled code!")
	).

:- pred create_instmap_delta(hlds_goals, instmap_delta).
:- mode create_instmap_delta(in, out) is det.

create_instmap_delta([], IMD) :-
	instmap_delta_from_assoc_list([], IMD).

create_instmap_delta([Goal|Rest], IMD) :-
	Goal = _ - GoalInfo,
	goal_info_get_instmap_delta(GoalInfo, IMD0),
	create_instmap_delta(Rest, IMD1),
	instmap_delta_apply_instmap_delta(IMD0, IMD1, IMD).


:- pred not_builtin_type(builtin_type).
:- mode not_builtin_type(in) is semidet.

not_builtin_type(pred_type).
not_builtin_type(enum_type).
not_builtin_type(polymorphic_type).
not_builtin_type(user_type).			

:- pred builtin_type_to_string(builtin_type, string).
:- mode builtin_type_to_string(in, out) is det.

builtin_type_to_string(int_type, 	"int").
builtin_type_to_string(char_type, 	"char").
builtin_type_to_string(str_type, 	"string").
builtin_type_to_string(float_type, 	"float").
builtin_type_to_string(pred_type, 	"pred").
builtin_type_to_string(enum_type, 	"enum").
builtin_type_to_string(polymorphic_type, "any").
builtin_type_to_string(user_type, 	"any").

New File: runtime/mercury_table_any.c
===================================================================
/*
** Copyright (C) 1997 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/

/*
** This module defines the mercury_table_type() function.
*/

#include "mercury_imp.h"
#include "mercury_tabling.h"
#include "mercury_table_any.h"
#include "mercury_type_info.h"
#include <stdio.h>

/*
** Prototypes.
*/
static Word get_base_type_layout_entry(Word data, Word *type_info);

MR_DECLARE_STRUCT(mercury_data___base_type_info_pred_0);
MR_DECLARE_STRUCT(mercury_data___base_type_info_func_0);


/*
** Due to the depth of the control here, we'll use 4 space indentation.
**
** NOTE : changes to this function will probably also have to be reflected 
** in mercury_deep_copy.c and std_util::ML_expand().
*/
TrieNode
MR_table_type(Word *type_info, Word data, TrieNode table)
{
    Word layout_entry, *entry_value, *data_value;
    int data_tag, entry_tag; 

    int arity, i;
    MemoryList allocated_memory_cells = NULL;
    Word *argument_vector, *type_info_vector, *new_type_info;

    Word new_data;

    data_tag = tag(data);
    data_value = (Word *) body(data, data_tag);

    layout_entry = get_base_type_layout_entry(data_tag, type_info);

    entry_tag = tag(layout_entry);
    entry_value = (Word *) body(layout_entry, entry_tag);

    switch(entry_tag) {

        case TYPELAYOUT_CONST_TAG:      /* and COMP_CONST_TAG */
            /* Some builtins need special treatment */
            if ((Word) entry_value <= TYPELAYOUT_MAX_VARINT) {
                int builtin_type = unmkbody(entry_value);

                switch(builtin_type) {

                    case TYPELAYOUT_UNASSIGNED_VALUE:
                        fatal_error("Attempt to use an UNASSIGNED tag "
                            "in table_any");
                        break;

                    case TYPELAYOUT_UNUSED_VALUE:
                        fatal_error("Attempt to use an UNUSED tag "
                            "in table_any");
                        break;

                    case TYPELAYOUT_STRING_VALUE:
                        table = (Word**) MR_TABLE_STRING(table, data);
                        break;

                    case TYPELAYOUT_FLOAT_VALUE:
                        table = (Word**) MR_TABLE_FLOAT(table, data);
                        break;

                    case TYPELAYOUT_INT_VALUE:
                        table = (Word**) MR_TABLE_INT(table, data);
                        break;

                    case TYPELAYOUT_CHARACTER_VALUE:
                        table = (Word**) MR_TABLE_CHAR(table, data);
                        break;

                    case TYPELAYOUT_UNIV_VALUE:
                    {
                        table = (Word**) MR_TABLE_TYPE_INFO(table,
                            data_value[UNIV_OFFSET_FOR_TYPEINFO]);
                        table = (Word**) MR_TABLE_ANY(table,
                            data_value[UNIV_OFFSET_FOR_TYPEINFO],
                            data_value[UNIV_OFFSET_FOR_DATA]);
                        break;
                    }
                    case TYPELAYOUT_PREDICATE_VALUE:
                    {
                           Word args = data_value[0];

                        table = (Word **) MR_TABLE_WORD(table, args);
                        table = (Word **) MR_TABLE_WORD(table, data_value[1]);
            
                        for (i = 0; i < args; i++) {
                            table = (Word **) MR_TABLE_ANY(table, 
                            (Word *) type_info[i + 
                                TYPEINFO_OFFSET_FOR_PRED_ARGS],
                                data_value[i+2]);
                        }
                    }
                    case TYPELAYOUT_VOID_VALUE:
                        fatal_error("Attempt to use a VOID tag in table_any");
                        break;

                    case TYPELAYOUT_ARRAY_VALUE:
                    {
                           MR_ArrayType *array;
                            Integer array_size;        
        
                        array = (MR_ArrayType *) data_value;
                        array_size = array->size;
            
                        new_type_info = make_type_info(type_info,
                            (Word *) 1, &allocated_memory_cells);
            
                        for (i = 0; i < array_size; i++) {
                            table = (Word**) MR_TABLE_ANY(table, 
                                new_type_info,
                                array->elements[i]);
                        }
                        break;
                    }
                    case TYPELAYOUT_TYPEINFO_VALUE:
                        table = (Word**) MR_TABLE_TYPE_INFO(table, data_value);
                        break;

                    case TYPELAYOUT_C_POINTER_VALUE:
                        fatal_error("Attempt to use a C_POINTER tag "
                            "in table");
                        break;

                    default:
                        fatal_error("Invalid tag value in table_any");
                        break;
                }
            } else {
                if (MR_TYPELAYOUT_ENUM_VECTOR_IS_ENUM(entry_value)) {
                    Word functors = 
                        MR_TYPELAYOUT_ENUM_VECTOR_NUM_FUNCTORS(entry_value);
                    table = (Word**) MR_TABLE_ENUM(table, functors, data);
                } else {
                    Word functors = 
                        MR_TYPELAYOUT_ENUM_VECTOR_NUM_FUNCTORS(entry_value);
                    table = (Word**) MR_TABLE_TAG(table, data_tag);
                    table = (Word**) MR_TABLE_ENUM(table, functors, 
                        (Word) data_value);
                }
            }
            break;

        case TYPELAYOUT_SIMPLE_TAG: 

            argument_vector = data_value;

            arity = entry_value[TYPELAYOUT_SIMPLE_ARITY_OFFSET];
            type_info_vector = entry_value + TYPELAYOUT_SIMPLE_ARGS_OFFSET;

            table = (Word**) MR_TABLE_TAG(table, data_tag);

                 /* copy arguments */
            for (i = 0; i < arity; i++) {
                new_type_info = make_type_info(type_info,
                    (Word *) type_info_vector[i], &allocated_memory_cells);
                
                table = (Word**) MR_TABLE_ANY(table, new_type_info,
                    argument_vector[i]);
            }
            break;

        case TYPELAYOUT_COMPLICATED_TAG:
        {
            Word secondary_tag;
            Word num_sharers;
            Word *new_entry;

            secondary_tag = *data_value;
            argument_vector = data_value + 1;
            new_entry = (Word *) entry_value[secondary_tag +1];
            arity = new_entry[TYPELAYOUT_SIMPLE_ARITY_OFFSET];
            type_info_vector = new_entry + 
                TYPELAYOUT_SIMPLE_ARGS_OFFSET;

            table = (Word**) MR_TABLE_TAG(table, data_tag);
       
            num_sharers = MR_TYPELAYOUT_COMPLICATED_VECTOR_NUM_SHARERS(
                    entry_value);
            table = (Word**) MR_TABLE_ENUM(table, num_sharers, secondary_tag);
            
            for (i = 0; i < arity; i++) {
                new_type_info = make_type_info(type_info,
                    (Word *) type_info_vector[i], &allocated_memory_cells);
                
                table = (Word**) MR_TABLE_ANY(table, new_type_info, 
                    argument_vector[i]);
            }
            break;
        }
        case TYPELAYOUT_EQUIV_TAG:
            /* note: we treat no_tag types just like equivalences */
            if ((Word) entry_value < TYPELAYOUT_MAX_VARINT) {
                table = (Word**) MR_TABLE_ANY(table,  
                    (Word *) type_info[(Word) entry_value], data);
            } else {
            /*
            ** offset 0 is no-tag indicator
            ** offset 1 is the pseudo-typeinfo
            ** (as per comments in base_type_layout.m)
            ** XXX should avoid use of hard-coded offset `1' here
            */
                new_type_info = make_type_info(type_info, 
                    (Word *) entry_value[1], &allocated_memory_cells);
                
                table = (Word**) MR_TABLE_ANY(table, new_type_info, data);
            }
            break;

        default:
            fatal_error("Unknown layout tag in table_any");
            break;
    }

    deallocate(allocated_memory_cells);    
    
    return table;
} /* end table_any() */

static Word 
get_base_type_layout_entry(Word data_tag, Word *type_info)
{
    Word *base_type_info, *base_type_layout;

    base_type_info = (Word *) type_info[0];

    if (base_type_info == 0) {
        base_type_info = type_info;
    }

    base_type_layout = (Word *) base_type_info[OFFSET_FOR_BASE_TYPE_LAYOUT];

    return base_type_layout[data_tag];
}


New File: runtime/mercury_table_any.h
===================================================================
#ifndef MERCURY_TABLE_ANY_H
#define MERCURY_TABLE_ANY_H

/*
** This function will lookup or insert any type of value into a 
** table. It uses the provided type_info to extract the necessary
** info to do this. It returns a pointer to the node found by the 
** insertion/lookup.
*/
TrieNode MR_table_type(Word *type_info, Word data_value, TrieNode Table);

#endif /* not MERCURY_TABLE_ANY_H */

New File: runtime/mercury_table_enum.c
===================================================================
/*
** Copyright (C) 1998 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/

/*
** This module defines the MR_int_index_lookup_or_add() function.
*/

#include "mercury_imp.h"

#define ELEMENT(Table, Key) ((Word**)&((Table)[Key]))

/*
**  MR_int_index_lookup_or_add() : This function maintains a simple indexed 
**	table of size Range.  
*/
TrieNode 
MR_int_index_lookup_or_add(TrieNode t, Integer key, Integer range)
{
	Word *table = *t;		/* Deref table */
	
	if (table == NULL) {
		*t = table = table_allocate(sizeof(Word*)*range);
		memset(table, 0, sizeof(Word*)*range);
	}

	return ELEMENT(table, key);
}


New File: runtime/mercury_table_enum.h
===================================================================
#ifndef MERCURY_TABLE_ENUM_H
#define MERCURY_TABLE_ENUM_H

/*
**  MR_int_index_lookup_or_add() : This function maintains a simple indexed 
**	table of size Range. The return value is a pointer to the table
** 	node found by the lookup/insert. 
*/
TrieNode MR_int_index_lookup_or_add(TrieNode, Integer, Integer);

#endif /* not MERCURY_TABLE_ENUM_H */

New File: runtime/mercury_table_int_float_string.c
===================================================================
/*
** Copyright (C) 1998 the University of Melbourne.
** this file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/

/*
** this module defines the int_hash_lookup_or_add(), float_hash_lookup_or_add()
** 	and string_hash_lookup_or_add() function.
*/

#include "mercury_imp.h"

/* Initial size of a new table */
#define TABLE_START_SIZE primes[0] 

/* 
** Maximum ratio of used to unused buckets in the table. Must be less than 
** 0.9 if you want even poor lookup times 
*/
#define MAX_EL_SIZE_RATIO 0.65

/* Extract info from a table */
#define SIZE(table)		(((TableRoot *) table)->size) 
#define ELEMENTS(table)	 	(((TableRoot *) table)->used_elements)
#define BUCKET(table, Bucket) 	((TableNode **) &(((TableRoot *) table)-> \
					elements))[(Bucket)]
typedef struct {
	Word key;
	Word * data;
} TableNode;

typedef struct {
	Word size;
	Word used_elements;
	Word elements;
} TableRoot;


static Word next_prime(Word);
static Word * create_hash_table(Word);
static void re_hash(Word *, Word, TableNode * Node);

/*
** Prime numbers which are close to powers of 2.  Used for choosing
** the next size for a hash table.
*/

#define NUM_OF_PRIMES 16
static Word primes[NUM_OF_PRIMES] =
    {127, 257, 509, 1021, 2053, 4099, 8191, 16381, 32771, 65537, 131071,
       262147, 524287, 1048573, 2097143, 4194301};

/*
** Return the next prime number greater than the number received.
** If no such prime number can be found, compute an approximate one.
*/
static Word 
next_prime(Word old_size) 
{
	int i;

	i = 0;
	while ( (old_size >= primes[i]) && (i < NUM_OF_PRIMES) ) {
		i++;
	}

	if (i < NUM_OF_PRIMES) {
		return (primes[i]);
	} else { 
		return (2 * old_size - 1);
	}
}

/* Create a new empty hash table */
static Word * 
create_hash_table(Word table_size)
{
   	Word i;
	TableRoot * table =
		table_allocate(sizeof(Word) * 2 + table_size * 
			sizeof(TableNode *));
	
	table->size = table_size;
	table->used_elements = 0;

	for (i=0; i<table_size; i++) {
		BUCKET(table, i) = NULL;
	}

	return (Word *) table;
}

/* 
** Insert key and Data into a new hash table using the given hash.
** this function does not have to do compares as the given key 
** is definitely not in the table. 
*/
static void
re_hash(Word * table, Word hash, TableNode * node)
{
	Word bucket = hash % SIZE(table);

	while (BUCKET(table, bucket)) {
		++bucket;

		if (bucket == SIZE(table))
			bucket = 0;
	}

	BUCKET(table, bucket) = node;
	++ELEMENTS(table);
}			

/* 
** Look to see if the given integer key is in the given table. If it
** is return the address of the data pointer associated with the key.
** If it is not; create a new element for the key in the table and
** return the address of its data pointer
*/
TrieNode 
MR_int_hash_lookup_or_add(TrieNode t, Integer key)
{
	TableNode * p, * q;
	Word * table = *t;	/* Deref the table pointer */
	Word bucket;
	
	/* Has the the table been built? */
	if (table == NULL) {
		table = create_hash_table(TABLE_START_SIZE);
		*t = table;
	}

	bucket = key % SIZE(table);
	p = BUCKET(table, bucket);

	/* Find if the element is present. If not add it */
	while (p) {
		if (key == p->key) {
			return &p->data;
		}

		if (bucket == SIZE(table))
			bucket = 0;
		
		p = BUCKET(table, bucket);
	}

	p = table_allocate(sizeof(TableNode));
	p->key = key;
	p->data = NULL;

	/* Rehash the table if it has grown to full */
	if ((float) ELEMENTS(table) / (float) SIZE(table) > 
	   		MAX_EL_SIZE_RATIO) 
	{
		int old_size = SIZE(table);
		int new_size = next_prime(old_size);
		Word * new_table = create_hash_table(new_size);
		int i;
		
		for (i = 0; i < old_size; i++) {
			q = BUCKET(table, i);
			if (q) {
				re_hash(new_table, q->key, q);
			}
		}
		
		/* Free the old table */
		table_free(table);

		/* Point to the new table */
		*t = new_table;
		
		/* Add a new element */
		re_hash(new_table, key, p);
	} else {
		BUCKET(table, bucket) = p;
		++ELEMENTS(table);
	}

	return &p->data;
}

/* 
** Look to see if the given float key is in the given table. If it
** is return the address of the data pointer associated with the key.
** If it is not create a new element for the key in the table and
** return the address of its data pointer
*/
TrieNode 
MR_float_hash_lookup_or_add(TrieNode t, Float key)
{
	TableNode * p, * q;
	Word * table = *t;	/* Deref the table pointer */
	Word bucket;
	Word hash;

	/* Has the the table been built? */
	if (table == NULL) {
		table = create_hash_table(TABLE_START_SIZE);
		*t = table;
	}

	hash = hash_float(key);
	bucket = hash % SIZE(table);

	p = BUCKET(table, bucket);

	/* Find if the element is present. If not add it */
	while (p) {
		if (key == word_to_float(p->key)) {
			return &p->data;
		}
		++bucket;
		
		if (bucket == SIZE(table))
			bucket = 0;
		
		p = BUCKET(table, bucket);
	}

	p = table_allocate(sizeof(TableNode));
	p->key = float_to_word(key);
	p->data = NULL;
	
	/* Rehash the table if it has grown to full */
	if ((float) ELEMENTS(table) / (float) SIZE(table) > 
	   		MAX_EL_SIZE_RATIO) 
	{
		int old_size = SIZE(table);
		int new_size = next_prime(old_size);
		Word * new_table = create_hash_table(new_size);
		int i;

		for (i = 0; i < old_size; i++) {
			q = BUCKET(table, i);
			if (q) {
				re_hash(new_table, hash_float(q->key), q); 
			}
		}
		
		/* Free the old table */
		table_free(table);

		/* Point to the new table */
		*t = new_table;
		
		/* Add a new element */
		re_hash(new_table, hash, p);
	} else {
		++ELEMENTS(table);
		BUCKET(table, bucket) = p;
	}

	return &p->data;
}



/* 
** Look to see if the given string key is in the given table. If it
** is return the address of the data pointer associated with the key.
** If it is not create a new element for the key in the table and
** return the address of its data pointer
*/
TrieNode 
MR_string_hash_lookup_or_add(TrieNode t, String key)
{
	TableNode * p, * q;
	Word * table = *t;	/* Deref the table pointer */
	Word bucket;
	Word hash;

	/* Has the the table been built? */
	if (table == NULL) {
		table = create_hash_table(TABLE_START_SIZE);
		*t = table;
	}

	hash = hash_string(key);
	bucket = hash % SIZE(table);

	p = BUCKET(table, bucket);

	/* Find if the element is present. */
	while (p) {
		int res = strtest((String)p->key, key);
		
		if (res == 0) {
			return &p->data;
		}
		++bucket;
		
		if (bucket == SIZE(table))
			bucket = 0;
		
		p = BUCKET(table, bucket);
	}

	p = table_allocate(sizeof(TableNode));
	p->key = (Word) key;
	p->data = NULL;
	
	/* Rehash the table if it has grown to full */
	if ((float) ELEMENTS(table) / (float) SIZE(table) > 
	   		MAX_EL_SIZE_RATIO) 
	{
		int old_size = SIZE(table);
		int new_size = next_prime(old_size);
		Word * new_table = create_hash_table(new_size);
		int i;

		for (i = 0; i < old_size; i++) {
			q = BUCKET(table, i);
			if (q) {
				re_hash(new_table, hash_string(q->key), q); 
			}
		}
		
		/* Free the old table */
		table_free(t);

		/* Point to the new table */
		*t = new_table;
		
		/* Add a new element to rehashed table */
		re_hash(new_table, hash, p); 
	} else {
		BUCKET(table, bucket) = p;
		++ELEMENTS(table);
	}

	return &p->data;
}

New File: runtime/mercury_table_int_float_string.h
===================================================================
#ifndef MERCURY_INT_FLOAT_STRING_H
#define MERCURY_INT_FLOAT_STRING_H


/* Look to see if the given integer key is in the given table. If it
** is return the address of the data pointer associated with the key.
** If it is not; create a new element for the key in the table and
** return the address of its data pointer
**/
TrieNode MR_int_hash_lookup_or_add(TrieNode Table, Integer Key);

/* Look to see if the given float key is in the given table. If it
** is return the address of the data pointer associated with the key.
** If it is not create a new element for the key in the table and
** return the address of its data pointer
**/
TrieNode MR_float_hash_lookup_or_add(TrieNode Table, Float Key);

/* Look to see if the given string key is in the given table. If it
** is return the address of the data pointer associated with the key.
** If it is not create a new element for the key in the table and
** return the address of its data pointer
**/
TrieNode MR_string_hash_lookup_or_add(TrieNode Table, String Key);

#endif /* not MERCURY_INT_FLOAT_STRING_H */

New File: runtime/mercury_table_type_info.c
===================================================================
/*
** Copyright (C) 1997 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/

/*
** This module defines the type_info_lookup_or_add() function.
*/

#include "mercury_imp.h"
#include "mercury_table_type_info.h"

typedef struct TreeNode_struct {
	Word * key;
	Word value;
	struct TreeNode_struct * right;
	struct TreeNode_struct * left;
} TreeNode;

TrieNode
MR_type_info_lookup_or_add(TrieNode table, Word * type_info)
{
	TreeNode *p, *q;
	int i;

	if (*table == NULL) {
		p = table_allocate(sizeof(TreeNode));

		p->key = type_info;
		p->value = (Word) NULL;
		p->left = NULL;
		p->right = NULL;

		*table = (Word *) p;

		return (Word**) &p->value;
	}
	
	p = (TreeNode*) *table;

	while (p != NULL) {
		i = MR_compare_type_info((Word) p->key, (Word) type_info);

		if (i == COMPARE_EQUAL) {
			return (Word**) &p->value;
		} 
		
		q = p;
		
		if (i == COMPARE_LESS) {
			p = p->left;
		} else {
			p = p->right;
		}
	}

	p = table_allocate(sizeof(TreeNode));
	p->key = type_info;
	p->value = (Word) NULL; 
	p->left = NULL;
	p->right = NULL;

	if (i == COMPARE_LESS) {
		q->left = p;
	} else {
		q ->right = p;
	}
	
	return (Word**) &p->value;
}

New File: runtime/mercury_table_type_info.h
===================================================================
#ifndef MERCURY_TABLE_TYPE_INFO
#define MERCURY_TABLE_TYPE_INFO

/*
** Lookup or insert the given type_info into the given table. Return a 
** pointer to the node of the table reached by the lookup/insert. 
*/
TrieNode MR_type_info_lookup_or_add(TrieNode, Word *);

#endif /* not MERCURY_TABLE_TYPE_INFO */

New File: runtime/mercury_tabling.h
===================================================================
/*
** Copyright (C) 1995-1997 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/

/*
** mercury_tabling.h - definitions of some basic macros used by the tabling
** code generated by the Mercury compiler and by the Mercury runtime.
*/

#ifndef MERCURY_TABLING_H
#define MERCURY_TABLING_H

#define MR_TABLE_DEBUG

typedef Word ** TrieNode;
typedef Word ** AnswerBlock;


#include "mercury_table_enum.h"
#include "mercury_table_any.h"
#include "mercury_table_type_info.h"
#include "mercury_table_int_float_string.h"


#define MR_TABLE_WORD(Table, Value)					\
	MR_int_hash_lookup_or_add(Table, (Integer)Value);

#define MR_TABLE_INT(Table, Value)					\
	MR_int_hash_lookup_or_add(Table, Value);

#define MR_TABLE_FLOAT(Table, Value)		  			\
	MR_float_hash_lookup_or_add(Table, Value);

#define MR_TABLE_CHAR(Table, Value)		   			\
	MR_int_hash_lookup_or_add(Table, (Integer)Value);

#define MR_TABLE_STRING(Table, Value)		 			\
	MR_string_hash_lookup_or_add(Table, (String)Value);
	
#define MR_TABLE_ENUM(Table, Range, Value)                              \
	MR_int_index_lookup_or_add(Table, Value, Range)

#define MR_TABLE_TAG(Table, Tag)					\
	MR_int_index_lookup_or_add(Table, Tag, 1 << TAGBITS)

#define MR_TABLE_TYPE_INFO(Table, Type)					\
	MR_type_info_lookup_or_add(Table, (Word*) Type)
	
#define MR_TABLE_ANY(Table, TypeInfo, Value)		  		\
	MR_table_type((Word*)TypeInfo, Value, Table)

#define MR_TABLE_CREATE_ANSWER_BLOCK(AnswerBlock, Elements)	 	\
	do {								\
		*AnswerBlock =	 					\
			table_allocate(sizeof(Word)*Elements);		\
	} while(0)

#define MR_TABLE_GET_ANSWER(Offset, AnswerBlock)			\
	(*((AnswerBlock)AnswerBlock))[Offset]


#ifdef CONSERVATIVE_GC

#define MR_TABLE_SAVE_ANSWER(Offset, AnswerBlock, Value, TypeInfo)	\
	do {								\
		(*((AnswerBlock)AnswerBlock))[Offset] = Value;		\
	} while(0)

#else /* not CONSERVATIVE_GC */

#define MR_TABLE_SAVE_ANSWER(Offset, AnswerBlock, Value, TypeInfo)	\
	do {								\
	   	save_transient_registers();				\
		(*((AnswerBlock)AnswerBlock))[Offset] = 		\
			deep_copy(Value, &TypeInfo, NULL, NULL);	\
		restore_transient_registers();		  		\
	} while(0)

#endif /* CONSERVATIVE_GC */


#ifdef CONSERVATIVE_GC

#define table_allocate(Size)						\
	GC_malloc(Size);

#define table_reallocate(Pointer, Size)					\
	GC_realloc(Pointer, Size);

#define table_free(Pointer)						\
	GC_free(Pointer);

#else /* not CONSERVATIVE_GC */

#define table_allocate(Size)                                            \
	(fatal_error("tabling only supported in conservative gc grades"),NULL)
#define table_reallocate(Pointer, Size)					\
	(fatal_error("tabling only supported in conservative gc grades"),NULL)
#define table_free(Pointer)						\
	fatal_error("tabling only supported in conservative gc grades")

#endif /* CONSERVATIVE_GC */

#define table_copy_mem(Dest, Source, Size)				\
	memcpy(Dest, Source, Size);

#ifdef MR_TABLE_DEBUG

#include <stdio.h>
#include <varargs.h>

static void table_printf(const char *format, ...)
{
	va_list list;
	
	va_start(list);
	vprintf(format, list);
}

#else /* not MR_TABLE_DEBUG */

static void table_printf(const char *format, ...)
{
}

#endif /* not MR_TABLE_DEBUG */

#endif /* not MERCURY_TABLING_H */




More information about the developers mailing list