[m-rev.] EDCG new file (edcg.m)

[Peter Nicholas MALKIN]

%-----------------------------------------------------------------------------%
% Copyright (C) 1999-2000 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.
%-----------------------------------------------------------------------------%

% File: edcg.m.
% Main author: pnmalk.

% This file provides predicates to transform code with EDCG notation into code
% without. The transformation takes place after purity.
%
% There are three steps to EDCG transformation:
% (i) EDCG inference: The form of EDCG references for a predicate are
% inferred from EDCG operators and also predicate calls which use EDCG
% variables, used within a clause for the predicate. If the global option
% infer_edcgs is true then fixed point iteration is used to infer the forms of
% EDCG references without using any EDCG form declarations. Otherwise a single
% pass is done using the declared forms of EDCG references as well as the EDCG
% operators to infer the forms of EDCG references. This single pass is only done
% for those predicates that require it. A predicate requires it if it has
% declared EDCG references, or contains an EDCG operator, EDCG goal or a
% predicate call which has EDCG arguments (unless the predicate is called in
% expanded form).
%
% (ii) EDCG checking: The inferred form of an EDCG reference for a predicate is
% checked against the declared form. Error messages are given if the inferred
% and declared forms are incompatible and warning messages are given if the
% inferred and declared forms are compatible but not the same (refer to
% edcg_form_compare/3).
%
% (iii) EDCG expansion: EDCG operators, EDCG goals and predicate calls with EDCG
% references are expanded. After the expansion there will be no EDCG operators
% or EDCG goals in the HLDS, and all predicate calls will be in standard form.
% A predicate requires expansion if it has declared or inferred EDCG references,
% or contains an EDCG operator, EDCG goal or a predicate call which has EDCG
% arguments (unless the predicate is called in expanded form).
%
% Expansion is based upon atomic goals (an atomic goal is a unification or a
% predicate call). The value of the current reference ($) and the next reference
% ($=) are the same throughout the atomic goal, this includes any EDCG reference
% implicit or explicit in a predicate call. The order in which they appear
% within the atomic goals is irrelevant (however the order of the atomic goals
% is relevant). The purpose of the atomic_goal_id for goals is to indicate
% when two hlds goals were originally (in the source code) in the same atomic
% goal.
%
% For example the following atomic goals are equivalent:
%	(i) $EDCG_ref = $=EDCG_ref
%	(ii) $=EDCG_ref = $EDCG_ref
%
% However these following goals are not equivalent. In the first instance the
% operators refer to the same variable. In the second they refer to different
% variables:
%	(i) $=EDCG_ref = Var, Var = a_functor(A, B, C, $EDCG_ref)
%	(ii) a_functor(A, B, C, $EDCG_ref) = Var, Var = $=EDCG_ref
%
% Also, given `:- pred pred_call +edcg(changed(EDCG_ref)).',
% the following predicate calls are equivalent:
%	(i) pred_call		% implicit
%	(ii) pred_call($EDCG_ref, $=EDCG_ref) % expanded
%	(iii) pred_call +edcg(EDCG_ref($EDCG_ref, $=EDCG_ref)) % explicit
% 
% XXX: Using EDCGs with higher order terms has not been implemented. In fact
% the reason that EDCGs has been implmemented after typecheck was to enable
% EDCGs to be used with higher order terms.

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

:- module edcg.

:- interface.  

:- import_module list, io.
:- import_module hlds_module.
:- import_module prog_data.

	% Predicate to expand EDCG clauses.

:- pred expand_edcgs(module_info, module_info, io__state, io__state).
:- mode expand_edcgs(in, out, di, uo) is det.

	% Returns a list types that are to be appended onto the end of the 
	% head type list of a particular predicate. Used by typecheck.
:- pred get_edcg_pred_types(module_info, edcg_forms, list(type)).
:- mode get_edcg_pred_types(in, in, out) is det.

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

:- implementation.

:- import_module prog_util, prog_out, prog_io, prog_io_util, prog_io_goal.
:- import_module bool, io, term, map, string, set, int, assoc_list.
:- import_module require, varset.
:- import_module hlds_data, hlds_goal, hlds_module, hlds_pred.
:- import_module make_hlds, error_util, std_util, mercury_to_mercury.
:- import_module code_util, quantification, options, globals.

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

	% Predicate to inferr and check edcg declarations.
:- pred infer_edcgs(module_info, module_info, io__state, io__state).
:- mode infer_edcgs(in, out, di, uo) is det.

infer_edcgs(Module0, Module) -->
	{ module_info_predids(Module0, PredIds) },
	globals__io_lookup_int_option(edcg_inference_iteration_limit,
		MaxIterations),
	infer_to_fixpoint(MaxIterations, PredIds, Module0, Module).

:- pred infer_to_fixpoint(int, list(pred_id), module_info, module_info,
		io__state, io__state).
:- mode infer_to_fixpoint(in, in, in, out, di, uo) is det.

infer_to_fixpoint(NumIterations, PredIds, Module0, Module) -->
	globals__io_lookup_bool_option(infer_edcgs, Inferring),
	infer_preds_edcgs(PredIds, Inferring, Module0, Module1, no, Changed),

	% Do not iterate if nothing has changed since last time or we
	% are not inferring EDCGs and so we are just performing a check.
	( ({ Changed = no }  ; { Inferring = no}) ->
		{ Module = Module1 }
	;
		{ NumIterations1 = NumIterations - 1 },
		( { NumIterations1 > 0 } ->
			infer_to_fixpoint(NumIterations1, PredIds, Module1,
				Module)
		;
			report_max_iterations_exceeded,
			{ Module = Module1 }
		)
	).

:- pred report_max_iterations_exceeded(io__state, io__state).
:- mode report_max_iterations_exceeded(di, uo) is det.

report_max_iterations_exceeded -->
	io__set_exit_status(1),
	io__write_strings([
	   "EDCG inference iteration limit exceeded.\n",
	   "This probably indicates that your program has an EDCG error.\n",
	   "You should declare the edcg arguments explicitly.\n"
	]),
	globals__io_lookup_int_option(edcg_inference_iteration_limit,
		MaxIterations),
	io__format("(The current limit is %d iterations.  You can use the\n",
		[i(MaxIterations)]),
	io__write_string("`--edcg-inference-iteration-limit' option to increase the limit).\n").


:- pred infer_preds_edcgs(list(pred_id), bool, module_info, module_info,
	bool, bool, io__state, io__state).
:- mode infer_preds_edcgs(in, in, in, out, in, out, di, uo) is det.

infer_preds_edcgs([], _, ModuleInfo, ModuleInfo, Changed, Changed) --> [].
infer_preds_edcgs([PredId | PredIds], Inferring, ModuleInfo0, ModuleInfo,
		Changed0, Changed) -->
	{ module_info_preds(ModuleInfo0, Preds0) },
	{ map__lookup(Preds0, PredId, PredInfo0) },
	(
		{ pred_info_is_imported(PredInfo0) }
	->
		{ ModuleInfo2 = ModuleInfo0 },
		{ Changed2 = Changed0 }
	;
		{ infer_predicate_edcgs(PredInfo0, ModuleInfo0, Inferring,
			PredInfo1, Changed1) },
		{ map__det_update(Preds0, PredId, PredInfo1, Preds) },
		{ module_info_set_preds(ModuleInfo0, Preds,
			ModuleInfo2) },
		{ bool__or(Changed0, Changed1, Changed2) }
	),
	infer_preds_edcgs(PredIds, Inferring, ModuleInfo2, ModuleInfo,
		Changed2, Changed).

:- pred infer_predicate_edcgs(pred_info, module_info, bool,
		pred_info, bool).
:- mode infer_predicate_edcgs(in, in, in, out, out) is det.

infer_predicate_edcgs(PredInfo0, ModuleInfo, Inferring, PredInfo, Changed) :-
	(
		% Compiler-generated predicates do not use edcgs.
		% Same for builtins.
		( code_util__compiler_generated(PredInfo0)
		; code_util__predinfo_is_builtin(PredInfo0))
	->
		Changed = no,
		PredInfo = PredInfo0
	;
	 	pred_info_clauses_info(PredInfo0, ClausesInfo0),
		pred_info_edcg_args(PredInfo0, 
			pred_edcg_info(Declared, Inferred0, 
			NeedsEDCGTransform0)),
		(
			% Infer edcgs for this predicate if we are
			% inferring or if we are checking edcg forms
			% and this predicate needs an EDCG
			% transformation.
			(Inferring = yes ; NeedsEDCGTransform0 = yes)
		->
			clauses_info_clauses(ClausesInfo0, Clauses0),

			edcg_infer_init(ModuleInfo, Inferring, EDCGInfer0),
			edcg_infer_clause_list(Clauses0, Clauses,
					EDCGInfer0, EDCGInfer),
			edcg_infer_final(EDCGInfer, Inferred, Changed0,
				NeedsEDCGTransform0, NeedsEDCGTransform),

			clauses_info_set_clauses(ClausesInfo0, Clauses,
				ClausesInfo),
			pred_info_set_clauses_info(PredInfo0, ClausesInfo,
				PredInfo1),
			pred_info_set_edcg_args(PredInfo1, 
				pred_edcg_info(Declared, Inferred, 
				NeedsEDCGTransform), PredInfo),

			% Check if anything changed
			(
				Changed0 = no,
				edcg_forms_identical(Inferred0, Inferred)
			->
				Changed = no
			;
				Changed = yes
			)
		;
			% We are not inferring edcg arguments and we do not
			% need to check this predicate for edcg argument
			% usage.
			Changed = no,
			PredInfo = PredInfo0
		)
	).

:- pred edcg_infer_clause_list(list(clause), list(clause),
		edcg_infer, edcg_infer).
:- mode edcg_infer_clause_list(in, out, in, out) is det.

edcg_infer_clause_list(Clauses0, Clauses, EDCGInfer0, EDCGInfer) :-
	edcg_infer_clause_list_2(Clauses0, Clauses, EDCGInfer0, 
		EDCGInferList),
	edcg_infer_join(EDCGInferList, EDCGInfer0, EDCGInfer).

:- pred edcg_infer_clause_list_2(list(clause), list(clause),
		edcg_infer, list(edcg_infer)).
:- mode edcg_infer_clause_list_2(in, out, in, out) is det.

edcg_infer_clause_list_2([], [], _, []).
edcg_infer_clause_list_2([Clause0|Clauses0], [Clause|Clauses],
		EDCGInferIn, [EDCGInfer|EDCGInferList]) :-
	edcg_infer_clause(Clause0, Clause, EDCGInferIn, EDCGInfer),
	edcg_infer_clause_list_2(Clauses0, Clauses, EDCGInferIn,
		EDCGInferList).

:- pred edcg_infer_clause(clause, clause, edcg_infer,
		edcg_infer).
:- mode edcg_infer_clause(in, out, in, out) is det.

edcg_infer_clause(Clause0, Clause) -->
	{ Clause0 = clause(Modes, Body0, MaybeEDCG, Context) },
	{ Clause = clause(Modes, Body, MaybeEDCG, Context) },
	edcg_infer_goal(Body0, Body).

:- pred edcg_infer_goal(hlds_goal, hlds_goal, edcg_infer,
		edcg_infer).
:- mode edcg_infer_goal(in, out, in, out) is det.

edcg_infer_goal(conj(List0) - Info, conj(List) - Info) -->
	list__map_foldl(edcg_infer_goal, List0, List).
edcg_infer_goal(par_conj(List0, SM) - Info, par_conj(List, SM) - Info) -->
	list__map_foldl(edcg_infer_goal, List0, List).
edcg_infer_goal(disj(List0, SM) - Info, disj(List, SM) - Info) -->
	edcg_infer_disj(List0, List).
edcg_infer_goal(if_then_else(Vs, A, B, C, SM) - Info,
		if_then_else(Vs, A0, B0, C0, SM) - Info) -->
	edcg_infer_if_then_else(A, B, C, A0, B0, C0).
edcg_infer_goal(not(A0) - Info, not(A) - Info) -->
	edcg_infer_goal(A0, A).
edcg_infer_goal(some(Vs, C, G0) - Info, some(Vs, C, G) - Info) -->
	edcg_infer_goal(G0, G).
edcg_infer_goal(call(PredId, Mode, Vars, EDCGArgs, Builtin, Context, Name) -
		Info, 
		call(PredId, Mode, Vars, EDCGArgs, Builtin, Context, Name) -
		Info, EDCGInfer0, EDCGInfer) :-
	goal_info_get_atomic_goal_id(Info, GoalId),
	edcg_infer_pred_call(PredId, Vars, EDCGArgs, GoalId,
		EDCGInfer0, EDCGInfer).
edcg_infer_goal(generic_call(GenericCall, Args, C, D) - Info,
		generic_call(GenericCall, Args, C, D) - Info, 
		EDCGInfer, EDCGInfer).
edcg_infer_goal(edcg_goal(Declared, Inferred0, Goal0) - Info,
		edcg_goal(Declared, Inferred, Goal) - Info, 
		EDCGInfer0, EDCGInfer) :-
	edcg_infer_begin_goal(Declared, EDCGInfer0, EDCGInfer1),
	edcg_infer_goal(Goal0, Goal, EDCGInfer1, EDCGInfer2),
	edcg_infer_end_goal(Inferred0, Inferred, EDCGInfer2,
		EDCGInfer).
edcg_infer_goal(unify(A, B, Mode, Category, UnifyContext) - Info,
		unify(A, B, Mode, Category, UnifyContext) - Info) -->
	{ goal_info_get_atomic_goal_id(Info, GoalId) },
	edcg_infer_unif(B, GoalId).
edcg_infer_goal(switch(_, _, _, _) - _Info, _) -->
	{ error("edcg_infer_goal: unexpected switch") }.
edcg_infer_goal(pragma_foreign_code(A, B, C, D, E, F, G) - Info,
		pragma_foreign_code(A, B, C, D, E, F, G) - Info) --> [].
edcg_infer_goal(bi_implication(LHS0, RHS0) - Info, 
		bi_implication(LHS, RHS) - Info) -->
	edcg_infer_goal(LHS0, LHS),
	edcg_infer_goal(RHS0, RHS).

:- pred edcg_infer_disj(list(hlds_goal), list(hlds_goal), edcg_infer,
		edcg_infer).
:- mode edcg_infer_disj(in, out, in, out) is det.

edcg_infer_disj(Goals0, Goals, EDCGInfer0, EDCGInfer) :-
	edcg_infer_disj_2(Goals0, Goals, EDCGInfer0, EDCGInferList),
	edcg_infer_join(EDCGInferList, EDCGInfer0, EDCGInfer).

:- pred edcg_infer_disj_2(list(hlds_goal), list(hlds_goal), edcg_infer,
		list(edcg_infer)).
:- mode edcg_infer_disj_2(in, out, in, out) is det.

edcg_infer_disj_2([], [], _, []).
edcg_infer_disj_2([Goal0|Goals0], [Goal|Goals], EDCGInferIn, 
		[EDCGInfer | EDCGInferList]) :-
	edcg_infer_goal(Goal0, Goal, EDCGInferIn, EDCGInfer),
	edcg_infer_disj_2(Goals0, Goals, EDCGInferIn, EDCGInferList).

:- pred edcg_infer_if_then_else(hlds_goal, hlds_goal, hlds_goal,
		hlds_goal, hlds_goal, hlds_goal, edcg_infer, edcg_infer).
:- mode edcg_infer_if_then_else(in, in, in, out, out, out, in, out) is det.

edcg_infer_if_then_else(A0, B0, C0, A, B, C, EDCGInfer0,
		EDCGInfer) :-
	edcg_infer_goal(A0, A, EDCGInfer0, EDCGInfer1),
	edcg_infer_goal(B0, B, EDCGInfer1, EDCGInfer2),
	edcg_infer_goal(C0, C, EDCGInfer0, EDCGInfer3),
	edcg_infer_join([EDCGInfer2, EDCGInfer3], EDCGInfer0,
		EDCGInfer).

:- pred edcg_infer_pred_call(pred_id, list(prog_var), edcgs, atomic_goal_id,
		edcg_infer, edcg_infer).
:- mode edcg_infer_pred_call(in, in, in, in, in, out) is det.

edcg_infer_pred_call(PredId, Vars, EDCGs, Id, EDCGInfer0, EDCGInfer) :-
	EDCGInfer0^module_info = ModuleInfo,
	module_info_pred_info(ModuleInfo, PredId, PredInfo),
	list__length(Vars, CallArity),
	pred_info_visual_arity(PredInfo, VisualArity),
	(
		% Check to see if it was an expanded edcg pred call.
		CallArity = VisualArity
	->
		pred_info_edcg_args(PredInfo, 
			pred_edcg_info(Declared, Inferred, _)),
		(
			EDCGInfer0^is_inferring = yes
		->
			EDCGForms = Inferred
		;
			EDCGForms = Declared
		),
		assoc_list__keys(EDCGs, EDCGArgs),
		% The set of edcgs listed explicitly at the call site.
		set__list_to_set(EDCGArgs, EDCGSet),
		edcg_infer_pred_call_2(EDCGForms, EDCGSet, Id, 
			EDCGInfer0, EDCGInfer)
	;
		EDCGInfer = EDCGInfer0
	).

:- pred edcg_infer_pred_call_2(edcg_forms, set(edcg_arg), atomic_goal_id,
		edcg_infer, edcg_infer).
:- mode edcg_infer_pred_call_2(in, in, in, in, out) is det.

edcg_infer_pred_call_2([], _, _, EDCGInfer, EDCGInfer).
edcg_infer_pred_call_2([EDCGArg - Form|EDCGForms], EDCGSet, Id,
		EDCGInfer0, EDCGInfer) :-
	(
		% Is the edcg argument listed explicitly at call site
		set__member(EDCGArg, EDCGSet)
	->
		EDCGInfer1 = EDCGInfer0
	;
		edcg_form_update(EDCGArg, Form, Id, 
			EDCGInfer0, EDCGInfer1)
	),
	edcg_infer_pred_call_2(EDCGForms, EDCGSet, Id, 
		EDCGInfer1, EDCGInfer).

:- pred edcg_infer_unif(unify_rhs, atomic_goal_id, 
		edcg_infer, edcg_infer).
:- mode edcg_infer_unif(in, in, in, out) is det.

edcg_infer_unif(RHS, Id, EDCGInfer0, EDCGInfer) :-
	(
		RHS = edcg_op(EDCGArg, Operator)
	->
		operator_to_form(Operator, Form),
		edcg_form_update(EDCGArg, Form, Id, 
			EDCGInfer0, EDCGInfer)
	;
		EDCGInfer = EDCGInfer0
	).

	% edcg_infer_join(EDCGInferList, EDCGInferIn, EDCGInferOut)
	% 	EDCGInferOut is all of the edcg_infer data in EDCGInferList
	% 	combined. If EDCGList is empty then EDCGInferOut is EDCGInferIn.
	%	This predicate is used to combine edcg_infer data from
	%	disjuncts, if-then-elses and clauses.
:- pred edcg_infer_join(list(edcg_infer), edcg_infer, edcg_infer).
:- mode edcg_infer_join(in, in, out) is det.

edcg_infer_join([], EDCGInfer, EDCGInfer).
edcg_infer_join([EDCGInfer0|EDCGInfers], _, EDCGInfer) :-
	edcg_infer_join_2(EDCGInfer0, EDCGInfers, EDCGInfer).

:- pred edcg_infer_join_2(edcg_infer, list(edcg_infer), edcg_infer).
:- mode edcg_infer_join_2(in, in, out) is det.

edcg_infer_join_2(EDCGInfer, [], EDCGInfer).
edcg_infer_join_2(EDCGInfer0, [EDCGInferIn|EDCGInfers], EDCGInfer) :-
	EDCGInfer0^inferred = EDCGFormMap0,
	EDCGInferIn^inferred = EDCGFormMap1,
	map__union(edcg_form_join, EDCGFormMap0, EDCGFormMap1, 
		EDCGFormMap),
	EDCGInfer0^goal_inferred = EDCGGoalFormMaps0,
	EDCGInferIn^goal_inferred = EDCGGoalFormMaps1,
	edcg_infer_join_3(EDCGGoalFormMaps0, EDCGGoalFormMaps1,
		EDCGGoalFormMaps),
	EDCGInfer0^is_changed = Changed0,
	EDCGInferIn^is_changed = Changed1,
	bool__or(Changed0, Changed1, Changed),
	EDCGInfer1 = EDCGInfer0^inferred := EDCGFormMap,
	EDCGInfer2 = EDCGInfer1^goal_inferred := EDCGGoalFormMaps,
	EDCGInfer3 = EDCGInfer2^is_changed := Changed,
	edcg_infer_join_2(EDCGInfer3, EDCGInfers, EDCGInfer).

	% edcg_infer_join_3(EDCGFormMapList1, EDCGFormMapList2,
	% 		EDCGFormMapListOut)
	%	EDCGFormMapList1 and EDCGFormList2 are infer data for edcg
	%	goals. EDCGFormMapListOut is edcg goal infer data from
	%	EDCGFormMapList1 and EDCGFormMapList2 combined.
:- pred edcg_infer_join_3(list(edcg_form_map), list(edcg_form_map),
		list(edcg_form_map)).
:- mode edcg_infer_join_3(in, in, out) is det.

edcg_infer_join_3([], [], []).
edcg_infer_join_3([_|_], [], _) :-
	error("edcg_infer_join_3: list length mismatch.").
edcg_infer_join_3([], [_|_], _) :-
	error("edcg_infer_join_3: list length mismatch.").
edcg_infer_join_3([EDCGFormMap1|Rest1], [EDCGFormMap2|Rest2],
		[EDCGFormMap|Rest]) :-
	map__union(edcg_form_join, EDCGFormMap1, EDCGFormMap2, 
		EDCGFormMap),
	edcg_infer_join_3(Rest1, Rest2, Rest).

	% edcg_infer_begin_goal(EDCGGoalInfo, EDCGInfer0, EDCGInfer)
	%	This predicate is called before inferring the edcg forms for an
	%	edcg goal. EDCGInfer0 is updated to EDCGInfer according the to
	%	forms of hidden arguments EDCGGoalInfo.
:- pred edcg_infer_begin_goal(edcg_goal_info, edcg_infer, edcg_infer).
:- mode edcg_infer_begin_goal(in, in, out) is det.

edcg_infer_begin_goal(EDCGs, EDCGInfer0, EDCGInfer) :-
	assoc_list__keys(EDCGs, EDCGArgs),
	map__init(EDCGFormMap0),
	new_edcg_form_map(EDCGArgs, EDCGFormMap0, EDCGFormMap),
	EDCGInfer0^goal_inferred = GoalInferred0,
	GoalInferred = EDCGFormMap.GoalInferred0,
	EDCGInfer = EDCGInfer0^goal_inferred := GoalInferred.

	% edcg_infer_end_goal(Inferred0, Inferred, EDCGInfer0, EDCGInfer)
	%	This predicate is called after inferring the edcg forms for an
	%	edcg goal. EDCGInfer is EDCGInfer0 with the edcg goal form data
	%	removed.
:- pred edcg_infer_end_goal(edcg_forms, edcg_forms, 
		edcg_infer, edcg_infer).
:- mode edcg_infer_end_goal(in, out, in, out) is det.

edcg_infer_end_goal(Inferred0, Inferred, EDCGInfer0, EDCGInfer) :-
	EDCGInfer0^goal_inferred = GoalInferred0,
	(
		GoalInferred0 = [GoalInfer|GoalInferred]
	->
		EDCGInfer1 = EDCGInfer0^goal_inferred := GoalInferred,
		edcg_form_map_to_edcg_forms(GoalInfer, Inferred)
	;
		error("edcg_infer_end_goal: no goal to end.")
	),
	(
		% Check whether the inferred forms for the edcg goal has changed
		% since last iteration.
		EDCGInfer1^is_changed = no,
		edcg_forms_identical(Inferred0, Inferred)
	->
		EDCGInfer = EDCGInfer1^is_changed := yes
	;
		EDCGInfer = EDCGInfer1
	).

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

:- type edcg_form_map == map(edcg_arg, pair(form, atomic_goal_id)).

:- pred new_edcg_form_map(list(edcg_arg),
		edcg_form_map, edcg_form_map).
:- mode new_edcg_form_map(in, in, out) is det.

new_edcg_form_map([], EDCGFormMap, EDCGFormMap).
new_edcg_form_map([EDCGArg | EDCGArgs], EDCGFormMap0,
		EDCGFormMap) :-
	init_atomic_goal_id(Id),
	map__det_insert(EDCGFormMap0, EDCGArg, nothing - Id, 
		EDCGFormMap1),
	new_edcg_form_map(EDCGArgs, EDCGFormMap1, EDCGFormMap).

	% edcg_form_update(EDCGArg, Form, Id, EDCGInfer0, EDCGInfer)
	%	EDCGInfer is EDCGInfer0 with the form of EDCGArg updated.
:- pred edcg_form_update(edcg_arg, form, atomic_goal_id, 
		edcg_infer, edcg_infer).
:- mode edcg_form_update(in, in, in, in, out) is det.

edcg_form_update(EDCGArg, Form, Id, EDCGInfer0, EDCGInfer) :-
	(
		% Update the edcg goal inferred forms for EDCGArg
		EDCGInfer0^goal_inferred = GoalInferred0,
		edcg_form_update_goal_inferred(EDCGArg, Form, Id,
			GoalInferred0, GoalInferred)
	->
		EDCGInfer = EDCGInfer0^goal_inferred := GoalInferred
	;
		% Update the predicate inferred forms for EDCGArg
		EDCGInfer0^inferred = Inferred0,
		edcg_form_update_inferred(EDCGArg, Form, Id, Inferred0,
			Inferred),
		EDCGInfer = EDCGInfer0^inferred := Inferred
	).

	% Update predicate inferred forms
:- pred edcg_form_update_inferred(edcg_arg, form, atomic_goal_id, 
		edcg_form_map, edcg_form_map).
:- mode edcg_form_update_inferred(in, in, in, in, out) is det.

edcg_form_update_inferred(EDCGArg, EDCGForm, EDCGId,
		EDCGFormMap0, EDCGFormMap) :-
	(
		map__search(EDCGFormMap0, EDCGArg, Form0 - Id0)
	->
		update_edcg_form(Form0, Id0, EDCGForm, EDCGId, Form),
		map__det_update(EDCGFormMap0, EDCGArg, Form - EDCGId, 
			EDCGFormMap)
	;
		map__det_insert(EDCGFormMap0, EDCGArg, EDCGForm-EDCGId,
			EDCGFormMap)
	).

	% Update edcg goal inferred forms.
:- pred edcg_form_update_goal_inferred(edcg_arg, form, atomic_goal_id, 
		list(edcg_form_map), list(edcg_form_map)).
:- mode edcg_form_update_goal_inferred(in, in, in, in, out) is semidet.

edcg_form_update_goal_inferred(EDCGArg, EDCGForm, EDCGId,
		[EDCGFormMap0|Rest0], [EDCGFormMap|Rest]) :-
	(
		map__search(EDCGFormMap0, EDCGArg, Form0 - Id0)
	->
		update_edcg_form(Form0, Id0, EDCGForm, EDCGId, Form),
		map__det_update(EDCGFormMap0, EDCGArg, Form - EDCGId, 
			EDCGFormMap),
		Rest = Rest0
	;
		EDCGFormMap = EDCGFormMap0,
		edcg_form_update_goal_inferred(EDCGArg, EDCGForm,
			EDCGId, Rest0, Rest)
	).

	% Assumes that the edcg forms are sorted.
:- pred edcg_forms_identical(edcg_forms, edcg_forms).
:- mode edcg_forms_identical(in, in) is semidet.

edcg_forms_identical(EDCGForms, EDCGForms).

	% Update the inferred form of an edcg argument.
:- pred update_edcg_form(form, atomic_goal_id, form, atomic_goal_id, form).
:- mode update_edcg_form(in, in, in, in, out) is det.

update_edcg_form(nothing, _, Form, _, Form).
update_edcg_form(changed, _, _, _, changed).
update_edcg_form(passed, _, nothing, _, passed).
update_edcg_form(passed, _, passed, _, passed).
update_edcg_form(passed, _, changed, _, changed).
update_edcg_form(passed, _, produced, _, changed).
update_edcg_form(produced, _, nothing, _, produced).
update_edcg_form(produced, _, produced, _, produced).
update_edcg_form(produced, IdOld, changed, IdNew, Form) :-
	(
		IdOld = IdNew
	->
		Form = changed
	;
		Form = produced
	).
update_edcg_form(produced, IdOld, passed, IdNew, Form) :-
	(
		IdOld = IdNew
	->
		Form = changed
	;
		Form = produced
	).

	% Join the inferred forms of an edcg argument from disjuncts,
	% if-the-elses, and clauses.
:- pred edcg_form_join(pair(form, atomic_goal_id), pair(form, atomic_goal_id),
		pair(form, atomic_goal_id)).
:- mode edcg_form_join(in, in, out) is det.

edcg_form_join(nothing - _, Form - Id, Form - Id).
edcg_form_join(changed - _, _ - Id, changed - Id).
edcg_form_join(produced - _, changed - Id, changed - Id).
edcg_form_join(produced - _, produced - Id, produced - Id).
edcg_form_join(produced - _, passed - Id, changed - Id).
edcg_form_join(produced - _, nothing - Id, produced - Id).
edcg_form_join(passed - _, changed - Id, changed - Id).
edcg_form_join(passed - _, produced - Id, changed - Id).
edcg_form_join(passed - _, passed - Id, passed - Id).
edcg_form_join(passed - _, nothing - Id, passed - Id).

:- pred operator_to_form(edcg_operator, form).
:- mode operator_to_form(in, out) is det.

operator_to_form(current, passed).
operator_to_form(next, produced).

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

:- type edcg_infer 
	---> edcg_infer(
		inferred 	:: edcg_form_map,
			% inferred edcg forms for a predicate.
		goal_inferred	:: list(edcg_form_map),
			% inferred edcg forms for edcg goals.
		module_info :: module_info,
		is_changed	:: bool, 
			% is_changed indicates whether EDCG goal inferrences
			% have changed
		is_inferring	:: bool
			% Are we inferrring edcg arguments
	).

:- pred edcg_infer_init(module_info, bool, edcg_infer).
:- mode edcg_infer_init(in, in, out) is det.

edcg_infer_init(Module, Inferring, 
		edcg_infer(Inferred, [], Module, no, Inferring)) :-
	map__init(Inferred).

	% edcg_infer_final(EDCGInfer, EDCGForms, 
	%	Changed, NeedsEDCGTransform0, NeedsEDCGTransform) :-
	% Changed is true if during the edcgs inferred changed since last
	% time. NeedsEdcgTransform is true if the predicate needs an Edcg
	% transform performed upon it.
:- pred edcg_infer_final(edcg_infer, edcg_forms, bool, bool, bool).
:- mode edcg_infer_final(in, out, out, in, out) is det.

edcg_infer_final(EDCGInfer, EDCGForms, Changed,
		NeedsEDCGTransform0, NeedsEDCGTransform) :-
	EDCGInfer^is_changed = Changed,
	EDCGInfer^inferred = Inferred,
	edcg_form_map_to_edcg_forms(Inferred, EDCGForms),
	(
		% If edcg arguments have been declared, inferred or the
		% predicate contains a clause in which some EDCG construct is
		% used (NeedsEDCGTransform0) then we must perform an EDCG
		% transformation on the predicate.
		(
			EDCGForms = [_|_]
		;
			NeedsEDCGTransform0 = yes
		)
	->
		NeedsEDCGTransform = yes
	;
		NeedsEDCGTransform = no
	).

:- pred edcg_form_map_to_edcg_forms(edcg_form_map, edcg_forms).
:- mode edcg_form_map_to_edcg_forms(in, out) is det.

edcg_form_map_to_edcg_forms(EDCGFormMap, EDCGForms) :-
	map__to_sorted_assoc_list(EDCGFormMap, EDCGForms0),
	list__map(edcg_form_convert, EDCGForms0, EDCGForms).

:- pred edcg_form_convert(pair(edcg_arg, pair(form, atomic_goal_id)),
		pair(edcg_arg, form)).
:- mode edcg_form_convert(in, out) is det.

edcg_form_convert(EDCGArg - (Form - _), EDCGArg - Form).

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

:- type var_set_types == pair(prog_varset, vartypes).

expand_edcgs(ModuleInfo0, ModuleInfo) -->
	infer_edcgs(ModuleInfo0, ModuleInfo1),
	{ module_info_predids(ModuleInfo1, PredIds) },
	{ module_info_edcgs(ModuleInfo1, Edcgs) },
	globals__io_lookup_bool_option(infer_edcgs, Inferring),
	{ edcg_info_init(Edcgs, Inferring, EDCGInfo) },
	expand_edgs_2(PredIds, EDCGInfo, ModuleInfo1, ModuleInfo).

:- pred expand_edgs_2(list(pred_id), edcg_info, module_info, module_info,
		io__state, io__state).
:- mode expand_edgs_2(in, in, in, out, di, uo) is det.

expand_edgs_2([], _, ModuleInfo, ModuleInfo) --> [].
expand_edgs_2([PredId | PredIds], EDCGInfo, ModuleInfo0, ModuleInfo) -->
	{ module_info_preds(ModuleInfo0, Preds0) },
	{ map__lookup(Preds0, PredId, PredInfo0) },
	(
		{ pred_info_is_imported(PredInfo0)
		; pred_info_is_pseudo_imported(PredInfo0) }
	->
		{ ModuleInfo2 = ModuleInfo0 }
	;
		expand_pred(PredId, PredInfo0, PredInfo, ModuleInfo0, 
			EDCGInfo, Errors),
		maybe_edcg_error(Errors, PredId, ModuleInfo0,
			ModuleInfo1),
		{ map__det_update(Preds0, PredId, PredInfo, Preds) },
		{ module_info_get_predicate_table(ModuleInfo1, PredTable0) },
		{ predicate_table_set_preds(PredTable0, Preds, PredTable) },
		{ module_info_set_predicate_table(ModuleInfo1, PredTable,
			ModuleInfo2) }
	),
	expand_edgs_2(PredIds, EDCGInfo, ModuleInfo2, ModuleInfo).

:- pred expand_pred(pred_id, pred_info, pred_info, module_info, 
		edcg_info, list(edcg_error), io__state, io__state).
:- mode expand_pred(in, in, out, in, in, out, di, uo) is det.

expand_pred(PredId, PredInfo0, PredInfo, ModuleInfo, EDCGInfo0, Errors) -->
	{ pred_info_edcg_args(PredInfo0, 
		pred_edcg_info(_, _, NeedsEdcgTransform)) },
	(
		% We do not need to perform an edcg transformation on this
		% predicate.
		{ NeedsEdcgTransform = no }
	->
		{ PredInfo0 = PredInfo },
		{ Errors = [] }
	;
		{ expand_pred_2(PredInfo0, PredInfo, ModuleInfo, 
			EDCGInfo0, Errors, Inferred) },
		write_inference_message(PredId, PredInfo, ModuleInfo, Inferred)
	).

:- pred expand_pred_2(pred_info, pred_info, module_info, 
		edcg_info, list(edcg_error), bool).
:- mode expand_pred_2(in, out, in, in, out, out) is det.

expand_pred_2(PredInfo0, PredInfo, ModuleInfo, EDCGInfo0, Errors, 
		Inferred) :-
	pred_info_edcg_args(PredInfo0, 
		pred_edcg_info(DeclaredForms, InferredForms, _)),
	pred_info_visual_arity(PredInfo0, VisualArity),
	pred_info_context(PredInfo0, Context),
	pred_info_clauses_info(PredInfo0, ClausesInfo0),
	pred_info_procedures(PredInfo0, Procs0),
	pred_info_arg_types(PredInfo0, TVarSet, Eqtvars, VisualTypes),
	clauses_info_clauses(ClausesInfo0, Clauses0),
	clauses_info_varset(ClausesInfo0, VarSet0),
	clauses_info_headvars(ClausesInfo0, VisualHeadVars),
	clauses_info_vartypes(ClausesInfo0, VarTypes0),

	% Correct the total arity and the clause head visual and edcg
	% arguments if the edcg arguments were inferred.
	(
		EDCGInfo0^inferring = yes,
		DeclaredForms = []
	->
		EDCGForms = InferredForms,
		EDCGInfo1 = EDCGInfo0,
		(
			InferredForms = [_|_],
			Inferred = yes
		;
			InferredForms = [],
			Inferred = no
		)
	;
		EDCGForms = DeclaredForms,
			% Check the declared forms against the inferred forms.
		edcg_info_check_forms(DeclaredForms, InferredForms, Context, 
			EDCGInfo0, EDCGInfo1),
		Inferred = no
	),
	list__append(VisualHeadVars, EDCGHeadVars, HeadVars),

		% Update the predicate's type information
	get_edcg_pred_types(ModuleInfo, EDCGForms, EDCGTypes),
	list__length(EDCGTypes, EDCGArity),
	TotalArity = VisualArity + EDCGArity,
	make_n_fresh_vars("EDCGHeadVar__", VisualArity,
		TotalArity, VarSet0, EDCGHeadVars, VarSet1),
	map__det_insert_from_corresponding_lists(VarTypes0, EDCGHeadVars,
		EDCGTypes, VarTypes1),
	list__append(VisualTypes, EDCGTypes, Types),
		% Expand edcgs
	EDCGInfo2 = EDCGInfo1^varsettypes := (VarSet1 - VarTypes1),
	edcg_info_initial_state(EDCGForms, EDCGInfo2, EDCGInfo3),
	expand_clauses(Clauses0, Clauses, HeadVars, EDCGForms, InferredForms,
		EDCGHeadVars, VisualArity, ModuleInfo, EDCGInfo3, EDCGInfo4),

	update_procedures(EDCGForms, Context, EDCGTypes,
		VisualArity, ModuleInfo, Procs0, Procs, EDCGInfo4,
		EDCGInfo),

	EDCGInfo^varsettypes = (VarSet - VarTypes),
	EDCGInfo^errors = Errors,

	clauses_info_set_vartypes(ClausesInfo0, VarTypes, ClausesInfo1),
	clauses_info_set_headvars(ClausesInfo1, HeadVars, ClausesInfo2),
	clauses_info_set_varset(ClausesInfo2, VarSet, ClausesInfo3),
	clauses_info_set_clauses(ClausesInfo3, Clauses, ClausesInfo),
	pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo1),
	pred_info_set_arg_types(PredInfo1, TVarSet, Eqtvars, Types, 
		PredInfo2),
	pred_info_set_procedures(PredInfo2, Procs, PredInfo3),
	pred_info_set_arity(PredInfo3, TotalArity, PredInfo).

:- pred expand_clauses(list(clause), list(clause), list(prog_var), edcg_forms,
		edcg_forms, list(prog_var), arity, module_info,
		edcg_info, edcg_info).
:- mode expand_clauses(in, out, in, in, in, in, in, in, in, out) is det.

expand_clauses([], [], _, _, _, _, _, _, EDCGInfo, EDCGInfo).
expand_clauses([Clause0 | Clauses0], [Clause | Clauses], HeadVars,
		EDCGForms, InferredForms, EDCGHeadVars, VisualArity, ModuleInfo,
		EDCGInfoIn0, EDCGInfo) :-
	Clause0 = clause(Ids, Body0, MaybeEdcg, Context),
	Clause = clause(Ids, Body, MaybeEdcg, Context),

	(	
		MaybeEdcg = edcg_no,	% functor -->> is not used
		( EDCGForms = [_|_] ; InferredForms = [_|_] )
	->
		% -->> should have been used
		edcg_info_error(functor_error(Context),
			EDCGInfoIn0, EDCGInfoIn1)
	;
		MaybeEdcg = edcg_yes,	% functor -->> is used
		EDCGForms = [],
		InferredForms = []
	->
		% Unnecessary use of functor -->>
		edcg_info_error(functor_warning(Context),
			EDCGInfoIn0, EDCGInfoIn1)
	;
		EDCGInfoIn1 = EDCGInfoIn0
	),

	expand_body(Body0, Body1, ModuleInfo, EDCGInfoIn1, EDCGInfoOut0),
	edcg_head_vars(EDCGForms, EDCGInfoIn1, EDCGInfoOut0, 
		EDCGVars),
	insert_unifications(EDCGHeadVars, EDCGVars, Context, VisualArity,
		Body1, Body2),
	map__init(Empty),
	EDCGInfoOut0^varsettypes = (VarSet0 - VarTypes),
	implicitly_quantify_clause_body(HeadVars, Body2, VarSet0, Empty,
		Body, VarSet, _, _Warnings),
	EDCGInfoOut = EDCGInfoOut0^varsettypes := (VarSet - VarTypes),
	edcg_info_merge(EDCGInfoIn1, EDCGInfoOut, EDCGInfoIn),

	expand_clauses(Clauses0, Clauses, HeadVars, EDCGForms, InferredForms,
		EDCGHeadVars, VisualArity, ModuleInfo, EDCGInfoIn, EDCGInfo).

:- pred expand_body(hlds_goal, hlds_goal, module_info,
		edcg_info, edcg_info).
:- mode expand_body(in, out, in, in, out) is det.

expand_body(Body0 - Info, Body - Info, ModuleInfo, EDCGInfo0, EDCGInfo) :-
	Body0 = conj(Goals0), 
	Body  = conj(Goals), 
	expand_conj(Goals0, Goals, ModuleInfo, EDCGInfo0, EDCGInfo).

expand_body(Body0 - Info, Body - Info, ModuleInfo, EDCGInfo0, EDCGInfo) :-
	Body0 = par_conj(Goals0, SM),
	Body  =  par_conj(Goals, SM),
	expand_par_conj(Goals0, Goals, ModuleInfo, EDCGInfo0, EDCGInfo).

expand_body(Body0 - Info, Body - Info, ModuleInfo, EDCGInfo0, EDCGInfo) :-
	Body0 = disj(Goals0,Store), 
	Body  =  disj(Goals,Store), 
	expand_disj(Goals0, ModuleInfo, EDCGInfo0, GoalsAndEDCGInfo,
		EDCGInfo1),
	update_disj(GoalsAndEDCGInfo, EDCGInfo1, Goals, EDCGInfo).

expand_body(Body0 - Info, Body - Info, ModuleInfo, EDCGInfo0, EDCGInfo) :-
	Body0 = call(PredId,ProcId,Vars0,EDCGVars,BIState,UContext,Name),
	Body  = call(PredId,ProcId,Vars,[],BIState,UContext,Name),
	module_info_preds(ModuleInfo, Preds),
	map__lookup(Preds, PredId, CalleePredInfo),
	pred_info_visual_arity(CalleePredInfo, VisualArity),
	goal_info_get_context(Info, Context),
	goal_info_get_atomic_goal_id(Info, GoalId),
	list__length(Vars0, CallArity),
	(
		% Check whether the predicate is called in expanded form
		CallArity = VisualArity
	->
		pred_info_edcg_args(CalleePredInfo, 
			pred_edcg_info(Declared, Inferred, _)),
		( 
			EDCGInfo0^inferring = yes,
			Declared = []
		->
			EDCGForms = Inferred
		;
			EDCGForms = Declared
		),
		pred_call_edcg_args(GoalId, EDCGForms, 
			EDCGVars, Context, PredId, Vars1, EDCGInfo0, EDCGInfo),
		list__append(Vars0, Vars1, Vars)
	;
		% Predicate was called in expanded form.
		Vars = Vars0,
		(
			EDCGVars = [],
			edcg_info_error(pred_call_warning(PredId, Context), 
				EDCGInfo0, EDCGInfo)
		;
			% Predicate was called in expanded form with explicit
			% edcg arguments listed.
			EDCGVars = [_|_],
			edcg_info_error(
				pred_call_expanded_error(PredId, Context),
				EDCGInfo0, EDCGInfo)
		)
	).

expand_body(Body0 - Info, Body - Info, _ModuleInfo,
		EDCGInfo0, EDCGInfo) :-
	Body0 = unify(Var,RHS0,Mode,Unification,UnifyContext),
	Body  = unify(Var,RHS,Mode,Unification,UnifyContext),
	goal_info_get_context(Info, Context),
	goal_info_get_atomic_goal_id(Info, GoalId),
	expand_unify_rhs(RHS0, RHS, Context, GoalId, 
		EDCGInfo0, EDCGInfo).

expand_body(Body0 - Info, Body - Info, ModuleInfo,
		EDCGInfo0, EDCGInfo) :-
	Body0 = if_then_else(Vars,Goali0,Goalt0,Goale0,Store),
	Body  = if_then_else(Vars,Goali,Goalt,Goale,Store),
	expand_body(Goali0, Goali, ModuleInfo, EDCGInfo0, EDCGInfo1),
	expand_body(Goalt0, Goalt1, ModuleInfo, EDCGInfo1, EDCGInfoThen),
	edcg_info_merge(EDCGInfo0, EDCGInfoThen, EDCGInfo2),
	expand_body(Goale0, Goale1, ModuleInfo, EDCGInfo2, EDCGInfoElse),
	edcg_info_combine(EDCGInfoThen, EDCGInfoElse, EDCGInfo3),
	edcg_info_new(EDCGInfo3, EDCGInfo),
	update_goal(Goalt1, EDCGInfoThen, EDCGInfo, Goalt),
	update_goal(Goale1, EDCGInfoElse, EDCGInfo, Goale).

expand_body(Body0 - Info, Body - Info, ModuleInfo,
		EDCGInfo0, EDCGInfo) :-
	Body0 = not(Goal0),
	Body  = not(Goal),
	expand_body(Goal0, Goal, ModuleInfo, EDCGInfo0, EDCGInfo).

expand_body(Body0 - Info, Body - Info, ModuleInfo,
		EDCGInfo0, EDCGInfo) :-
	Body0 = some(Vars,CanRemove,Goal0),
	Body = some(Vars,CanRemove,Goal),
	expand_body(Goal0, Goal, ModuleInfo, EDCGInfo0, EDCGInfo).

expand_body(Body0 - Info, Body - Info, _ModuleInfo,
		EDCGInfo, EDCGInfo) :-
	Body0 = generic_call(GenericCall,Args,Modes,Det),
	Body = generic_call(GenericCall,Args,Modes,Det).

expand_body(Body0 - Info, Body - Info, ModuleInfo,
		EDCGInfo0, EDCGInfo) :-
	Body0 = edcg_goal(EdcgGoalInfo, Inferred, Goal0),
	expand_edcg_goal(EdcgGoalInfo, Goal0, ModuleInfo,
		EDCGInfo0, EDCGInfo1, Declared, Body - _Info),
	goal_info_get_context(Info, Context),
	% Check the declared forms against the inferred forms.
	edcg_info_check_forms(Declared, Inferred, Context,
		EDCGInfo1, EDCGInfo).

expand_body(Body0 - Info, Body - Info, _ModuleInfo,
		EDCGInfo, EDCGInfo) :-
	Body0 = pragma_foreign_code(A,B,C,D,E,F,G),
	Body  = pragma_foreign_code(A,B,C,D,E,F,G).

expand_body(Body0 - Info, Body - Info, _ModuleInfo,
		EDCGInfo, EDCGInfo) :-
	Body0 = switch(Var,Canfail,Cases,StoreMap),
	Body  = switch(Var,Canfail,Cases,StoreMap),
	% Switches are yet to be created.
	error("edcg:expand_body: unexpected switch").

expand_body(Body0 - Info, Body - Info, _ModuleInfo,
		EDCGInfo, EDCGInfo) :-
	Body0 = bi_implication(Goal1,Goal2),
	Body  = bi_implication(Goal1,Goal2),
	error("edcg:expand_body: unexpected bi-implication").

:- pred expand_conj(list(hlds_goal), list(hlds_goal), module_info,
		edcg_info, edcg_info).
:- mode expand_conj(in, out, in, in, out) is det.

expand_conj([], [], _, EDCGInfo, EDCGInfo).
expand_conj([Goal0 | Goals0], Goals, ModuleInfo,
		EDCGInfo0, EDCGInfo) :-
	expand_body(Goal0, Goal, ModuleInfo,
		EDCGInfo0, EDCGInfo1),
	 % edcg expansion may produce conjunctions that are not completely
	 % flattened.
	goal_to_conj_list(Goal, ConjList),
	expand_conj(Goals0, Goals1, ModuleInfo,
		EDCGInfo1, EDCGInfo),
	list__append(ConjList, Goals1, Goals).

:- pred expand_par_conj(list(hlds_goal), list(hlds_goal), module_info, 
		edcg_info, edcg_info).
:- mode expand_par_conj(in, out, in, in, out) is det.

expand_par_conj([], [], _, EDCGInfo, EDCGInfo).
expand_par_conj([Goal0 | Goals0], [Goal | Goals], ModuleInfo,
		EDCGInfo0, EDCGInfo) :-
	expand_body(Goal0, Goal, ModuleInfo, EDCGInfo0, EDCGInfo1),
	expand_par_conj(Goals0, Goals, ModuleInfo, EDCGInfo1, EDCGInfo).

:- pred expand_disj(list(hlds_goal), module_info, edcg_info,
		assoc_list(hlds_goal, edcg_info), edcg_info).
:- mode expand_disj(in, in, in, out, out) is det.

expand_disj([], _, EDCGInfo, [], EDCGInfo).
expand_disj([Goal0 | Goals0],  ModuleInfo, EDCGInfoIn0, 
		[Goal - EDCGInfoOut | GoalsAndEDCGInfo], EDCGInfo) :-
	expand_body(Goal0, Goal, ModuleInfo, EDCGInfoIn0, EDCGInfoOut),
	edcg_info_merge(EDCGInfoIn0, EDCGInfoOut, EDCGInfoIn),
	expand_disj_2(Goals0, ModuleInfo, EDCGInfoIn, GoalsAndEDCGInfo,
		EDCGInfoOut, EDCGInfo).

:- pred expand_disj_2(list(hlds_goal), module_info, edcg_info,
		assoc_list(hlds_goal, edcg_info), edcg_info, edcg_info).
:- mode expand_disj_2(in, in, in, out, in, out) is det.

expand_disj_2([], _, _, [], EDCGInfo, EDCGInfo).
expand_disj_2([Goal0 | Goals0],  ModuleInfo, EDCGInfoIn0,
		[Goal - EDCGInfoOut | GoalsAndEDCGInfo], 
		EDCGInfo0, EDCGInfo) :-
	expand_body(Goal0, Goal, ModuleInfo, EDCGInfoIn0, EDCGInfoOut),
	edcg_info_merge(EDCGInfoIn0, EDCGInfoOut, EDCGInfoIn),
	edcg_info_combine(EDCGInfo0, EDCGInfoOut, EDCGInfo1),
	expand_disj_2(Goals0, ModuleInfo, EDCGInfoIn, GoalsAndEDCGInfo,
		EDCGInfo1, EDCGInfo).

:- pred expand_unify_rhs(unify_rhs, unify_rhs, prog_context, atomic_goal_id,
		edcg_info, edcg_info).
:- mode expand_unify_rhs(in, out, in, in, in, out) is det.

expand_unify_rhs(var(Var), var(Var), _Context, _Id, 
		EDCGInfo, EDCGInfo).
expand_unify_rhs(functor(Id,Vars), functor(Id,Vars), _Context, _Id,
		EDCGInfo, EDCGInfo).
expand_unify_rhs(lambda_goal(A,B,C,D,E,F,G,H), lambda_goal(A,B,C,D,E,F,G,H), 
		_Context, _Id, EDCGInfo, EDCGInfo).
expand_unify_rhs(edcg_op(EDCGArg, current), var(Var), Context, Id,
		EDCGInfo0, EDCGInfo) :-
	(
		edcg_info_pass(Id, EDCGArg, Var0,
			EDCGInfo0, EDCGInfo1)
	->
		EDCGInfo = EDCGInfo1,
		Var = Var0
	;
		edcg_info_error(scope_error(current, Context, EDCGArg), 
			EDCGInfo0, EDCGInfo1),
			% Make it alive to avoid future errors
		edcg_info_birth(EDCGArg, EDCGInfo1, EDCGInfo),
		edcg_info_get_var(EDCGArg, EDCGInfo, Var)
	).
expand_unify_rhs(edcg_op(EDCGArg, next), var(Var), Context, Id,
		EDCGInfo0, EDCGInfo) :-
	(
		edcg_info_produce(Id, EDCGArg, Var0, 
			EDCGInfo0, EDCGInfo1)
	->
		EDCGInfo = EDCGInfo1,
		Var0 = Var
	;
		edcg_info_error(scope_error(next, Context, EDCGArg), 
			EDCGInfo0, EDCGInfo1),
			% Make it alive to avoid future errors
		edcg_info_birth(EDCGArg, EDCGInfo1, EDCGInfo),
		edcg_info_get_var(EDCGArg, EDCGInfo, Var)
	).

:- pred expand_edcg_goal(edcg_goal_info, hlds_goal, 
		module_info, edcg_info, edcg_info, edcg_forms, hlds_goal).
:- mode expand_edcg_goal(in, in, in, in, out, out, out) is det.

expand_edcg_goal(EdcgGoalInfo, Goal0, ModuleInfo,
		EDCGInfo0, EDCGInfo, EDCGForms, Goal) :-
	assoc_list__keys(EdcgGoalInfo, EDCGArgs),
	edcg_info_convert(EDCGArgs, EDCGInfo0, EDCGInfo1),
	expand_body(Goal0, Goal1, ModuleInfo, EDCGInfo1, EDCGInfo2),
	insert_edcg_unifs(EdcgGoalInfo, Goal1, Goal, 
		EDCGInfo1, EDCGInfo2, EDCGForms),
	edcg_info_revert(EDCGArgs, EDCGInfo0, EDCGInfo2, EDCGInfo).

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

get_edcg_pred_types(_, [], []).
get_edcg_pred_types(ModuleInfo, [EDCGArg - Form|Rest], 
	    TypeList) :-
	module_info_edcgs(ModuleInfo, EDCGTable),
	edcg_table_fetch_edcg_type(EDCGArg, EDCGTable, Type),
	( 
		Form = changed 
	->
		TypeList = [Type,Type|TypeList0]
	;
		Form = nothing
	->
		TypeList = TypeList0
	;
		TypeList = [Type|TypeList0]
	),
	get_edcg_pred_types(ModuleInfo, Rest, TypeList0).

	% Returns a list of modes that are to be appended onto the end of the
	% head mode list of a particular predicate.
:- pred get_edcg_pred_modes(edcg_forms, list(mode), 
		term__context, module_info, edcg_info, edcg_info, bool).
:- mode get_edcg_pred_modes(in, out, in, in, in, out, out) is det.

get_edcg_pred_modes([], [], _, _, EDCGInfo, EDCGInfo, no).
get_edcg_pred_modes([EDCGArg - Form|Rest], ModeList, Context,
		ModuleInfo, EDCGInfo0, EDCGInfo, FoundError) :-
	module_info_edcgs(ModuleInfo, EDCGTable),
	( 
		edcg_table_fetch_edcg_mode(EDCGArg, Form, EDCGTable, Modes)
	->
		get_edcg_pred_modes(Rest, ModeList0, Context,
			ModuleInfo, EDCGInfo0, EDCGInfo, FoundError),
		list__append(Modes, ModeList0, ModeList)
	;
		edcg_info_error(undef_mode_error(EDCGArg, Form, Context),	
			EDCGInfo0, EDCGInfo1),
		get_edcg_pred_modes(Rest, ModeList, Context,
			ModuleInfo, EDCGInfo1, EDCGInfo, _),
		FoundError = yes
	).

	% Adds edcg argument modes to the procedure calls.
:- pred update_procedures(edcg_forms, term__context, list(type), arity,
		module_info, proc_table, proc_table, edcg_info, edcg_info).
:- mode update_procedures(in, in, in, in, in, in, out, in, out) is det.

update_procedures(EDCGForms, Context, Types, VisualArity, ModuleInfo, 
		ProcTable0, ProcTable, EDCGInfo0, EDCGInfo) :-
	get_edcg_pred_modes(EDCGForms, Modes, Context,
		ModuleInfo, EDCGInfo0, EDCGInfo, FoundError),
	( FoundError = no ->
		map__keys(ProcTable0, ProcIds),
		update_procedures_2(ProcIds, Modes, Types, VisualArity,
			ProcTable0, ProcTable)
	;
		ProcTable = ProcTable0
	).

:- pred update_procedures_2(list(proc_id), list(mode), list(type), arity,
		proc_table, proc_table).
:- mode update_procedures_2(in, in, in, in, in, out) is det.

update_procedures_2([], _, _, _, ProcTable, ProcTable).
update_procedures_2([ProcId | Rest], EDCGModes, Types, VisualArity,
		ProcTable0, ProcTable) :-
	map__lookup(ProcTable0, ProcId, ProcInfo0),
	proc_info_argmodes(ProcInfo0, Modes0),
	proc_info_varset(ProcInfo0, VarSet0),
	proc_info_headvars(ProcInfo0, VisualVars),
	proc_info_vartypes(ProcInfo0, VarTypes0),
	list__append(Modes0, EDCGModes, Modes),
	list__length(Modes, TotalArity),
	make_n_fresh_vars("EDCGHeadVar__", VisualArity, TotalArity, VarSet0,
		EDCGVars, VarSet),
	map__det_insert_from_corresponding_lists(VarTypes0, EDCGVars,
		Types, VarTypes),
	list__append(VisualVars, EDCGVars, Vars),
	proc_info_set_vartypes(ProcInfo0, VarTypes, ProcInfo1),
	proc_info_set_argmodes(ProcInfo1, Modes, ProcInfo2),
	proc_info_set_varset(ProcInfo2, VarSet, ProcInfo3),
	proc_info_set_headvars(ProcInfo3, Vars, ProcInfo),
	map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable1),
	update_procedures_2(Rest, EDCGModes, Types, VisualArity, 
		ProcTable1, ProcTable).

	% edcg_head_vars(FormsAndNamesList, EDCGInfoIn,
	% 	EDCGInfoOut, VisualArgs)
	% 
	% Given a list of FormsAndNames declared for a particular predicate,
	% the pre state (EDCGInfoIn) and post state of a clause for that
	% predicate, VisualAndEDCGArgs is a list edcg arguments for that
	% clause head.
:- pred edcg_head_vars(edcg_forms, edcg_info, edcg_info, list(prog_var)).
:- mode edcg_head_vars(in, in, in, out) is det.

edcg_head_vars([], _, _, []).
edcg_head_vars([EDCGArg - changed | Rest], EDCGInfo0, EDCGInfo1,
	    Vars) :-
	edcg_info_get_state_info(EDCGArg, EDCGInfo0,
		StateInfo1),
	state_info_get_var(StateInfo1, Var1),
	edcg_info_get_state_info(EDCGArg, EDCGInfo1,
		StateInfo2),
	state_info_get_var(StateInfo2, Var2),
	Vars = [Var1, Var2 | Vars0],
	edcg_head_vars(Rest, EDCGInfo0, EDCGInfo1, Vars0).
edcg_head_vars([EDCGArg - passed | Rest], EDCGInfo0, EDCGInfo1,
	    Vars) :-
	edcg_info_get_state_info(EDCGArg, EDCGInfo0,
		StateInfo),
	state_info_get_var(StateInfo, Var),
	Vars = [Var | Vars0],
	edcg_head_vars(Rest, EDCGInfo0, EDCGInfo1, Vars0).
edcg_head_vars([EDCGArg - produced|Rest], EDCGInfo0, EDCGInfo1,
	    Vars) :-
	edcg_info_get_state_info(EDCGArg, EDCGInfo1,
		StateInfo),
	state_info_get_var(StateInfo, Var),
	Vars = [Var | Vars0],
	edcg_head_vars(Rest, EDCGInfo0, EDCGInfo1, Vars0).
edcg_head_vars([_ - nothing|_], _, _, _) :-
	error("edcg_head_vars: nothing cannot be a user defined form.").

	% pred_call_edcg_args(Id, EDCGForms, EDCGExplicitArgs,
	% 	Context, PredId, Vars, EDCGInfoIn, EDCGInfoOut)
	% 
	% Vars is the list of edcg arguments to be appended onto the predicate
	% call.
:- pred pred_call_edcg_args(atomic_goal_id, edcg_forms, edcgs, 
		prog_context, pred_id, list(prog_var), edcg_info,
		edcg_info).
:- mode pred_call_edcg_args(in, in, in, in, in, out, in, out) is det.

pred_call_edcg_args(_, [], [], _, _, [], EDCGInfo, EDCGInfo).
pred_call_edcg_args(Id, [], [EDCGArg - _| Rest], Context, PredId, Vars, 
		EDCGInfo0, EDCGInfo) :-
	edcg_info_error(pred_call_explicit_error(PredId, Context, EDCGArg),
		EDCGInfo0, EDCGInfo1),
	pred_call_edcg_args(Id, [], Rest, Context, PredId, Vars, 
		EDCGInfo1, EDCGInfo).
pred_call_edcg_args(Id, [EDCGArg - Form | Rest], EDCGs0, Context, PredId, 
		Vars, EDCGInfo0, EDCGInfo) :-
	(
			% Was the edcg argument explicitly listed in the
			% predicate call
		get_explicit_edcg_args(EDCGArg, Form, Context, PredId, 
			EDCGs0, EDCGs1, ExplicitVars0, 
			EDCGInfo0, EDCGInfo1)
	->
		pred_call_edcg_args(Id, Rest, EDCGs1, Context, PredId, 
			Vars1, EDCGInfo1, EDCGInfo),
		list__append(ExplicitVars0, Vars1, Vars)
	;
		Form = passed,
		edcg_info_pass(Id, EDCGArg, Var, 
			EDCGInfo0, EDCGInfo1)
	->
		Vars = [Var | Vars0],
		pred_call_edcg_args(Id, Rest, EDCGs0, Context, PredId, 
			Vars0, EDCGInfo1, EDCGInfo)
	;
		Form = changed,
		edcg_info_change(Id, EDCGArg, Var1, Var2, 
			EDCGInfo0, EDCGInfo1)
	->
		Vars = [Var1, Var2 | Vars0],
		pred_call_edcg_args(Id, Rest, EDCGs0, Context, PredId, 
			Vars0, EDCGInfo1, EDCGInfo)
	;
		Form = produced,
		edcg_info_produce(Id, EDCGArg, Var, 
			EDCGInfo0, EDCGInfo1)
	->
		Vars = [Var | Vars0],
		pred_call_edcg_args(Id, Rest, EDCGs0, Context, PredId, 
			Vars0, EDCGInfo1, EDCGInfo)
	;
		edcg_info_error(pred_call_error(PredId, Context, EDCGArg),
			EDCGInfo0, EDCGInfo1),
		edcg_info_birth(EDCGArg, EDCGInfo1, EDCGInfo2),
		pred_call_edcg_args(Id, [EDCGArg - Form|Rest], EDCGs0, 
			Context, PredId, Vars, EDCGInfo2, EDCGInfo)
	).

	% Get the edcg arguments listed with the predicate call for an edcg
	% argument.
:- pred get_explicit_edcg_args(edcg_arg, form, prog_context, pred_id,
		edcgs, edcgs, list(prog_var), edcg_info, edcg_info).
:- mode get_explicit_edcg_args(in, in, in, in, in, out, out, in, out) 
		is semidet.

get_explicit_edcg_args(EDCGArg, Form, Context, PredId, 
		[EDCGArg0 - Vars | EDCGs0], EDCGs, 
		VarList, EDCGInfo0, EDCGInfo) :-
	(
		EDCGArg = EDCGArg0
	->
		EDCGs = EDCGs0,
		(
			(
				Form = changed,
				Vars = [_Var1, _Var2]
			;
				Form = passed,
				Vars = [_Var]
			;
				Form = produced,
				Vars = [_Var]
			)
		->
			VarList = Vars,
			EDCGInfo = EDCGInfo0
		;
			VarList = [],
			edcg_info_error(pred_call_form_error(Context,
				EDCGArg, Form, PredId),
				EDCGInfo0, EDCGInfo)
		)
	;
		get_explicit_edcg_args(EDCGArg, Form, Context, PredId,
			EDCGs0, EDCGs1, VarList, EDCGInfo0, EDCGInfo),
		EDCGs = [EDCGArg0 - Vars | EDCGs1]
	).

	% update_disj(DisjunctAndEDCGInfoList, EDCGInfoIn,
	% 	GoalInfo, HLDSGoalList, EDCGInfoOut)
	% 
	% Given a list of disjuncts it calls update_disjunct/8 on every
	% disjunct. HLDSGoalList is the final list of HLDSGoals with 
	% the appropriate unifications appended such that all edcg
	% variables in scope at the end of the disjunction represent
	% consistent variables accross disjunctions. EDCGInfoOut is the
	% consistent post state of the disjunctions.
:- pred update_disj(assoc_list(hlds_goal, edcg_info), edcg_info,
		list(hlds_goal), edcg_info).
:- mode update_disj(in, in, out, out) is det.

update_disj([], EDCGInfo, [], EDCGInfo).
update_disj([HldsGoal0 - EDCGInfo0 | Rest], EDCGInfo1, 
		[HldsGoal | GoalList], EDCGInfo) :-
	update_goal(HldsGoal0, EDCGInfo0, EDCGInfo1, HldsGoal),
	update_disj(Rest, EDCGInfo1, GoalList, EDCGInfo).


	% update_goal(HLDSGoalIn, Context, EDCGInfoIn,
	% 	EDCGInfoFinal, HLDSGoalOut)
	%
	% HLDSGoalOut is HLDSIn with a list of unifications appended onto it.
	% The unifications are to match variables across disjunctions or
	% the THEN and ELSE parts of if-then-elses. All edcg argument
	% variables in EDCGInfoIn, that do not match their corresponding
	% edcg argument variable in EDCGInfoFinal are unified with it. 
:- pred update_goal(hlds_goal, edcg_info, edcg_info, hlds_goal).
:- mode update_goal(in, in, in, out) is det.

update_goal(HldsGoal0, EDCGInfo0, EDCGInfo1, HldsGoal) :-
	EDCGInfo0^state_info_table = StateTable0,
	EDCGInfo1^state_info_table = StateTable1,
	map__keys(StateTable0, EDCGArgs),
	HldsGoal0 = _Goal - HldsGoalInfo,
	goal_info_get_context(HldsGoalInfo, Context),
	update_goal_2(EDCGArgs, Context, StateTable0, StateTable1, 
		HldsGoals),
	goal_to_conj_list(HldsGoal0, ConjList),
	list__append(ConjList, HldsGoals, HldsGoalList),
	conj_list_to_goal(HldsGoalList, HldsGoalInfo, HldsGoal).

:- pred update_goal_2(list(edcg_arg), term__context,
	    state_info_table, state_info_table, list(hlds_goal)).
:- mode update_goal_2(in, in, in, in, out) is det.

update_goal_2([], _, _, _, []).
update_goal_2([EDCGArg|EDCGArgList], Context,
	    StateTable0, StateTable1, Goals) :-
	map__lookup(StateTable0, EDCGArg, StateInfo0),
	map__lookup(StateTable1, EDCGArg, StateInfo1),
	( 
		state_info_is_alive(StateInfo0),
		state_info_is_alive(StateInfo1)
	->
		state_info_get_var(StateInfo0, Var0),
		state_info_get_var(StateInfo1, Var1),
		create_atomic_unification(Var0, var(Var1), Context, 
			explicit, [], Goal),
		Goals = [Goal | Goals0],
		update_goal_2(EDCGArgList, Context,
			StateTable0, StateTable1, Goals0)
	; 
		state_info_is_alive(StateInfo0)
	->
		error("EDCG variable mismatch across goals.")
	;
		state_info_is_alive(StateInfo1)
	->
		error("EDCG variable mismatch across goals.")
	;
		update_goal_2(EDCGArgList, Context,
			StateTable0, StateTable1, Goals)
	).

	% Insert unifications at the start of an edcg goal, to unify edcg
	% arguments with the edcg goal head vars.
:- pred insert_edcg_unifs(edcg_goal_info, hlds_goal, hlds_goal,
		edcg_info, edcg_info, edcg_forms).
:- mode insert_edcg_unifs(in, in, out, in, in, out) is det.

insert_edcg_unifs(EdcgGoalInfo, Goal0, Goal, EDCGInfo0, EDCGInfo,
		EDCGForms) :-
	Goal0 = _GoalExpr - GoalInfo,
	goal_info_get_context(GoalInfo, Context),
	insert_edcg_unifs_2(EdcgGoalInfo, Context, EDCGInfo0, EDCGInfo,
		ConjList0, EDCGForms),
	goal_to_conj_list(Goal0, ConjList1),
	list__append(ConjList0, ConjList1, ConjList),
	conj_list_to_goal(ConjList, GoalInfo, Goal).

:- pred insert_edcg_unifs_2(edcg_goal_info, context, edcg_info, edcg_info,
		list(hlds_goal), edcg_forms).
:- mode insert_edcg_unifs_2(in, in, in, in, out, out) is det.

insert_edcg_unifs_2([], _, _, _, [], []).
insert_edcg_unifs_2([EDCGArg - changed(Var1, Var2) | Rest],
		Context, EDCGInfo0, EDCGInfo1, Goals, EDCGForms) :-
	edcg_info_get_state_info(EDCGArg, EDCGInfo0,
		StateInfo1),
	state_info_get_var(StateInfo1, EDCGVar1),
	edcg_info_get_state_info(EDCGArg, EDCGInfo1,
		StateInfo2),
	state_info_get_var(StateInfo2, EDCGVar2),
	create_atomic_unification(Var1, var(EDCGVar1), Context,
		explicit, [], Goal1),
	create_atomic_unification(Var2, var(EDCGVar2), Context,
		explicit, [], Goal2),
	Goals = [Goal1, Goal2 | Goals0],
	EDCGForms = [EDCGArg - changed | EDCGForms0],
	insert_edcg_unifs_2(Rest, Context, EDCGInfo0, EDCGInfo1, Goals0,
		EDCGForms0).
insert_edcg_unifs_2([EDCGArg - passed(Var) | Rest], Context,
		EDCGInfo0, EDCGInfo1, Goals, EDCGForms) :-
	edcg_info_get_state_info(EDCGArg, EDCGInfo0,
		StateInfo),
	state_info_get_var(StateInfo, EDCGVar),
	create_atomic_unification(Var, var(EDCGVar), Context,
		explicit, [], Goal),
	Goals = [Goal | Goals0],
	EDCGForms = [EDCGArg - passed | EDCGForms0],
	insert_edcg_unifs_2(Rest, Context, EDCGInfo0, EDCGInfo1, Goals0,
		EDCGForms0).
insert_edcg_unifs_2([EDCGArg - produced(Var) | Rest], Context,
		EDCGInfo0, EDCGInfo1, Goals, EDCGForms) :-
	edcg_info_get_state_info(EDCGArg, EDCGInfo1,
		StateInfo),
	state_info_get_var(StateInfo, EDCGVar),
	create_atomic_unification(Var, var(EDCGVar), Context,
		explicit, [], Goal),
	Goals = [Goal | Goals0],
	EDCGForms = [EDCGArg - produced | EDCGForms0],
	insert_edcg_unifs_2(Rest, Context, EDCGInfo0, EDCGInfo1, Goals0,
		EDCGForms0).

	% This predicate is used to set the initial edcg_info for an EDCG
	% goal. EDCGArgs is a list of edcg variables with a scope local to
	% the EDCG goal. Every edcg variable in EDCGArgs has its state
	% changed within EDCGInfoIn. The new state is `alive' with a fresh
	% variable as listed in Vars. The form of the new state is the
	% corresponding form from Forms. EDCGInfoOut is EDCGInfoIn with the
	% new states of the EDCGArgs.
:- pred edcg_info_convert(list(edcg_arg), edcg_info, edcg_info).
:- mode edcg_info_convert(in, in, out) is det. 

edcg_info_convert([], EDCGInfo, EDCGInfo).
edcg_info_convert([EDCGArg | EDCGArgs], EDCGInfo0, EDCGInfo) :-
	edcg_info_get_state_info(EDCGArg, EDCGInfo0,
		StateInfo0),
	EDCGInfo0^varsettypes = VarSetTypes0,
	state_info_new(VarSetTypes0, VarSetTypes, StateInfo0, StateInfo),
	EDCGInfo1 = EDCGInfo0^varsettypes := VarSetTypes,
	edcg_info_set_state_info(EDCGArg, EDCGInfo1,
		StateInfo, EDCGInfo2),
	edcg_info_convert(EDCGArgs, EDCGInfo2, EDCGInfo).

	% edcg_info_revert(EDCGArgs, EDCGInfoInitial, EDCGInfoFinal,
	%	       EDCGInfoOut)
	%
	% EDCGInfoOut is EDCGInfoFinal except that the edcg variables in
	% EDCGArgs have their state set to what it is in EDCGInfoInitial.
	% This predicate is used after processing EDCG goals. EDCGInfoIntial
	% is the edcg_info before the goal and EDCGInfoFinal is the state at
	% the end of the goal. EDCGArgs is a list of edcg variables with a
	% scope local to the EDCG goal. This predicate undoes
	% edcg_info_convert/6.
:- pred edcg_info_revert(list(edcg_arg), edcg_info, 
	edcg_info, edcg_info).
:- mode edcg_info_revert(in, in, in, out) is det.

edcg_info_revert([], _, EDCGInfo, EDCGInfo).
edcg_info_revert([EDCGArg | EDCGArgs], EDCGInfo0, EDCGInfo1,
		EDCGInfo) :-
	edcg_info_get_state_info(EDCGArg, EDCGInfo0, StateInfo),
	edcg_info_set_state_info(EDCGArg, EDCGInfo1, StateInfo,
		EDCGInfo2),
	edcg_info_revert(EDCGArgs, EDCGInfo0, EDCGInfo2,
		EDCGInfo).

:- pred insert_unifications(list(prog_var), list(prog_var), prog_context,
		arity, hlds_goal, hlds_goal).
:- mode insert_unifications(in, in, in, in, in, out) is det.

insert_unifications(HeadVars, Vars, Context, VisualArity, Goal0, Goal) :-
	Goal0 = _ - GoalInfo,
	goal_to_conj_list(Goal0, Goals0),
	insert_unifications_2(HeadVars, Vars, Context, VisualArity, 
		Goals0, Goals),
	conj_list_to_goal(Goals, GoalInfo, Goal).

:- pred insert_unifications_2(list(prog_var), list(prog_var), prog_context,
		arity, list(hlds_goal), list(hlds_goal)).
:- mode insert_unifications_2(in, in, in, in, in, out) is det.

insert_unifications_2([], [], _, _, Goals, Goals).
insert_unifications_2([_|_], [], _, _, _, _) :-
	error("insert_unifications_2: list length mistmatch.").
insert_unifications_2([], [_|_], _, _, _, _) :-
	error("insert_unifications_2: list length mistmatch.").
insert_unifications_2([Var1 | Vars1], [Var2 | Vars2], Context, ArgNum0,
		Goals0, [Goal | Goals]) :-
	ArgNum is ArgNum0 + 1,
	UnifyMainContext = head(ArgNum),
	UnifySubContexts = [],
	create_atomic_unification(Var1, var(Var2), Context, UnifyMainContext,
		UnifySubContexts, Goal),
	insert_unifications_2(Vars1, Vars2, Context, ArgNum, Goals0, Goals).

:- pred write_inference_message(pred_id, pred_info, module_info, bool,
		io__state, io__state).
:- mode write_inference_message(in, in, in, in, di, uo) is det.

write_inference_message(_, _, _, no) --> [].
write_inference_message(PredId, PredInfo, ModuleInfo, yes) -->
	{ pred_info_context(PredInfo, Context) },
	{ pred_info_edcg_args(PredInfo,
		pred_edcg_info(_Declared, Inferred, _)) },
	prog_out__write_context(Context),
	io__write_string("EDCG Inferred "),
	mercury_output_pred_type(ModuleInfo, PredId, Inferred, Context).

%---------------------------------------------------------------------------%
	% EDCGInfo Utility predicates.

	% edcg_info is a data structure containing all the states of the
	% edcg arguments defined in the module. 
:- type edcg_info
	--->    edcg_info(
				state_info_table 	:: state_info_table, 
				errors 			:: list(edcg_error),
				varsettypes 		:: var_set_types,
				inferring 		:: bool
							).  

:- type state_info_table     ==    map(edcg_arg, state_info).

	% name_table is a map from all unqualified edcg argument names
	% to qualified names.
:- type name_table     ==    map(string, list(edcg_arg)). 

:- pred edcg_info_init(edcg_table, bool, edcg_info).
:- mode edcg_info_init(in, in, out) is det.

edcg_info_init(EdcgTable, Inferring, EDCGInfo) :-
	map__init(StateTable),
	varset__init(VarSet),
	map__init(VarTypes),
	EDCGInfo0 = edcg_info(StateTable, [], VarSet-VarTypes, Inferring),
	edcg_table_get_etype_table(EdcgTable, Htypes),
	map__to_assoc_list(Htypes, EDCGArgAndTypeInfo),
	list__foldl(edcg_info_add_edcg_arg, EDCGArgAndTypeInfo, 
		EDCGInfo0, EDCGInfo).

	% Adds a edcg argument to the current edcg information.
:- pred edcg_info_add_edcg_arg(pair(edcg_arg, etype_info),
		edcg_info, edcg_info).
:- mode edcg_info_add_edcg_arg(in, in, out) is det.

edcg_info_add_edcg_arg(EDCGArg - (etype_defn(Type) - _Context), 
		EDCGInfo0, EDCGInfo) :-
	state_info_init(EDCGArg, Type, StateInfo),
	EDCGInfo0^state_info_table = StateTable0,
	map__det_insert(StateTable0, EDCGArg, StateInfo, StateTable),
	EDCGInfo = EDCGInfo0^state_info_table := StateTable.

	% edcg_info_initial_state(FormsAndNames, EDCGInfoIn, EDCGInfoOut):
	%
	% EDCGInfoOut is EDCGInfoIn with all the edcg arguments
	% in FormsAndNames having appropriate information added, such 
	% that EDCGInfoOut is the pre state of a predicate with 
	% the FormsAndNames declaration. 
	% IsFact is yes if the Clause with FormsAndNames is a fact.
	% It is needed to flag whether an underscore needs to be
	% prefixed to the NameBase, to prevent unused variable warnings.
:- pred edcg_info_initial_state(edcg_forms, edcg_info, edcg_info).
:- mode edcg_info_initial_state(in, in, out) is det.

edcg_info_initial_state([]) --> [].
edcg_info_initial_state([EDCGArg - _|Rest]) -->
	edcg_info_birth(EDCGArg),
	edcg_info_initial_state(Rest).

	% edcg_info_combine(EDCGInfoIn, EDCGInfoOld, EDCGInfoOut):
	% 
	% This predicate is called inbetween processing disjuncts or THEN and
	% ELSE parts. EDCGInfoOld is the edcg pre state of all the
	% disjuncts or THEN and ELSE parts to be processed. EDCGInfoIn is
	% the post state of the last processed disjuct or THEN part.
	% EDCGInfoOut is EDCGInfoOld with the variable suffixes updated
	% to correspond to the ones in EDCGInfoIn.
	% the unique naming of all edcg variables created.
:- pred edcg_info_combine(edcg_info, edcg_info, edcg_info).
:- mode edcg_info_combine(in, in, out) is det.

edcg_info_combine(EDCGInfo1, EDCGInfo2, EDCGInfo) :-
	EDCGInfo2^state_info_table = StateTable,
	map__keys(StateTable, EDCGArgs),
	edcg_info_combine_2(EDCGArgs, EDCGInfo1, EDCGInfo2, EDCGInfo).

:- pred edcg_info_combine_2(list(edcg_arg), edcg_info, edcg_info,
	edcg_info).
:- mode edcg_info_combine_2(in, in, in, out) is det.

edcg_info_combine_2([], _, EDCGInfo, EDCGInfo).
edcg_info_combine_2(EDCGArg.EDCGArgs, EDCGInfo0, EDCGInfo1,
		EDCGInfo) :-
	edcg_info_get_state_info(EDCGArg, EDCGInfo0, StateInfo0),
	edcg_info_get_state_info(EDCGArg, EDCGInfo1, StateInfo1),
	Suffix0 = StateInfo0 ^ var_suffix,
	Suffix1 = StateInfo1 ^ var_suffix,
	(
		Suffix0 > Suffix1
	->
		StateInfo = StateInfo0
	;
		StateInfo = StateInfo1
	),
	edcg_info_set_state_info(EDCGArg, EDCGInfo1, StateInfo,
		EDCGInfo2),
	edcg_info_combine_2(EDCGArgs, EDCGInfo0, EDCGInfo2, EDCGInfo).

	% edcg_info_new(EDCGInfoIn, EDCGInfoOut).
	% 
	% This predicate is called after edcg_info_combine/3, and before
	% update_goal/4 for if-then-elses.  EDCGInfoOut is EDCGInfoIn with
	% all alive edcg arguments assigned to new variables. EDCGInfoOut
	% becomes the final edcg_info for the then and else parts of the goal.
	% This ensures that edcg argument's scopes are never restricted to the
	% `if' part of an if-then-else.
:- pred edcg_info_new(edcg_info, edcg_info).
:- mode edcg_info_new(in, out) is det.

edcg_info_new(EDCGInfo0, EDCGInfo) :-
	EDCGInfo0^state_info_table = StateTable0,
	map__keys(StateTable0, EDCGArgs),
	edcg_info_new_2(EDCGArgs, EDCGInfo0, EDCGInfo).

:- pred edcg_info_new_2(list(edcg_arg), edcg_info, edcg_info).
:- mode edcg_info_new_2(in, in, out) is det.

edcg_info_new_2([], EDCGInfo, EDCGInfo).
edcg_info_new_2([EDCGArg | Rest], EDCGInfo0, EDCGInfo) :-
	edcg_info_get_state_info(EDCGArg, EDCGInfo0, StateInfo0),
	EDCGInfo0^varsettypes = VarSetTypes0,
	state_info_new_var(VarSetTypes0, VarSetTypes, StateInfo0, StateInfo),
	EDCGInfo1 = EDCGInfo0^varsettypes := VarSetTypes,
	edcg_info_set_state_info(EDCGArg, EDCGInfo1, StateInfo, 
		EDCGInfo2),
	edcg_info_new_2(Rest, EDCGInfo2, EDCGInfo).

	% Start the scope of a edcg variable.
	% Will produce a software error if the edcg variable is already in
	% scope.
:- pred edcg_info_birth(edcg_arg, edcg_info, edcg_info).
:- mode edcg_info_birth(in, in, out) is det.

edcg_info_birth(EDCGArg, EDCGInfo0, EDCGInfo) :-
	edcg_info_get_state_info(EDCGArg, EDCGInfo0, StateInfo0),
	EDCGInfo0^varsettypes = VarSetTypes0,
	state_info_birth(VarSetTypes0, VarSetTypes,
		StateInfo0, StateInfo),
	EDCGInfo1 = EDCGInfo0^varsettypes := VarSetTypes,
	edcg_info_set_state_info(EDCGArg, EDCGInfo1, 
		StateInfo, EDCGInfo).

	% Returns the variable that the edcg variable currently represents.
	% Used for predicate calls where the form of the edcg variable for the
	% predicate is passed.
	% Fails if the edcg argument is not in scope.
:- pred edcg_info_pass(atomic_goal_id, edcg_arg, prog_var,
		edcg_info, edcg_info).
:- mode edcg_info_pass(in, in, out, in, out) is semidet.

edcg_info_pass(Id, EDCGArg, Var, EDCGInfo0, EDCGInfo) :-
	edcg_info_get_state_info(EDCGArg, EDCGInfo0, StateInfo0),
	state_info_pass(Id, StateInfo0, StateInfo, Var),
	edcg_info_set_state_info(EDCGArg, EDCGInfo0, StateInfo,
		EDCGInfo).

	% Returns the variable that the edcg variable currently represents.
	% Used for predicate calls where the form of the edcg variable for the
	% predicate is produced.
	% Fails if the edcg argument is not in scope.
:- pred edcg_info_produce(atomic_goal_id, edcg_arg, prog_var, 				edcg_info, edcg_info).
:- mode edcg_info_produce(in, in, out, in, out) is semidet.

edcg_info_produce(Id, EDCGArg, Var, EDCGInfo0, EDCGInfo) :-
	edcg_info_get_state_info(EDCGArg, EDCGInfo0, StateInfo0),
	EDCGInfo0^varsettypes = VarSetTypes0,
	state_info_produce(Id, VarSetTypes0, VarSetTypes, 
		StateInfo0, StateInfo, Var),
	EDCGInfo1 = EDCGInfo0^varsettypes := VarSetTypes,
	edcg_info_set_state_info(EDCGArg, EDCGInfo1, 
		StateInfo, EDCGInfo).

	% Returns the variable that the edcg variable currently represents.
	% Used for predicate calls where the form of the edcg variable for the
	% predicate is changed.
	% Fails if the edcg argument is dead.
:- pred edcg_info_change(atomic_goal_id, edcg_arg, prog_var, prog_var, 
		edcg_info, edcg_info).
:- mode edcg_info_change(in, in, out, out, in, out) is semidet.

edcg_info_change(Id, EDCGArg, Var1, Var2, EDCGInfo0, EDCGInfo) :-
	edcg_info_get_state_info(EDCGArg, EDCGInfo0, StateInfo0),
	EDCGInfo0^varsettypes = VarSetTypes0,
	state_info_change(Id, VarSetTypes0, VarSetTypes, StateInfo0, StateInfo, 
		Var1, Var2),
	EDCGInfo1 = EDCGInfo0^varsettypes := VarSetTypes,
	edcg_info_set_state_info(EDCGArg, EDCGInfo1, 
		StateInfo, EDCGInfo).

	% edcg_info_merge(EDCGInfo0, EDCGInfo1, EDCGInfo)
	%	EDCGInfo is EDCGInfo0 with the errors and the varsettypes
	%	of EDCGInfo1.
:- pred edcg_info_merge(edcg_info, edcg_info, edcg_info).
:- mode edcg_info_merge(in, in, out) is det.

edcg_info_merge(EDCGInfo0, EDCGInfoOut, EDCGInfo) :-
	EDCGInfo1 = EDCGInfo0^errors := EDCGInfoOut^errors,
	EDCGInfo = EDCGInfo1^varsettypes := EDCGInfoOut^varsettypes.

:- pred edcg_info_check_forms(edcg_forms, edcg_forms, term__context,
		edcg_info, edcg_info).
:- mode edcg_info_check_forms(in, in, in, in, out) is det.

edcg_info_check_forms(Declared0, Inferred, Context, 
		EDCGInfo0, EDCGInfo) :-
	list__sort(Declared0, Declared),
	% Inferred should already be sorted.
	edcg_info_check_forms_2(Declared, Inferred, Strict, Loose),
	( not(Strict = []) ->
		edcg_info_error(infer_error(Strict, Context), EDCGInfo0,
			EDCGInfo1)
	;
		EDCGInfo1 = EDCGInfo0
	),
	( not(Loose = []) ->
		edcg_info_error(infer_warning(Loose, Context), EDCGInfo1,
			EDCGInfo)
	;
		EDCGInfo = EDCGInfo1
	).

:- pred edcg_info_check_forms_2(edcg_forms, edcg_forms,	
		assoc_list(edcg_arg, pair(form)), 
		assoc_list(edcg_arg, pair(form))).
:- mode edcg_info_check_forms_2(in, in, out, out) is det.

edcg_info_check_forms_2(Declared, Inferred, Strict, Loose) :-
	(
		Declared = [],
		Inferred = [],
		Strict = [],
		Loose = []
	;
		Declared = [EDCGArg - Form| Rest],
		Inferred = [],
		Loose = [EDCGArg - (Form - nothing) | Loose0],
		edcg_info_check_forms_2(Rest, Inferred, Strict, Loose0)
	;
		Declared = [],
		Inferred = [EDCGArg - Form| Rest],
		Strict = [EDCGArg - (nothing - Form) | Strict0],
		edcg_info_check_forms_2(Declared, Rest, Strict0, Loose)
	;
		Declared = [EDCGArg1 - Form1 | DeclaredTail],
		Inferred = [EDCGArg2 - Form2 | InferredTail],
		compare(R, EDCGArg1, EDCGArg2),
		(
			R = (=),
			edcg_form_compare(FormR, Form1, Form2),
			(
				FormR = equal,
				Strict = Strict0,
				Loose = Loose0
			;
				FormR = strict,
				Strict = [EDCGArg1 - (Form1 - Form2)|Strict0],
				Loose = Loose0
			;
				FormR = loose,
				Loose = [EDCGArg1 - (Form1 - Form2)|Loose0],
				Strict = Strict0
			),
			edcg_info_check_forms_2(DeclaredTail, InferredTail,
				Strict0, Loose0)
		;
			R = (<),
			Loose = [EDCGArg1 - (Form1 - nothing) | Loose0],
			edcg_info_check_forms_2(DeclaredTail, Inferred,
				Strict, Loose0)
		;
			R = (>),
			Strict = [EDCGArg2 - (nothing - Form2) | Strict0],
			edcg_info_check_forms_2(Declared, InferredTail,
				Strict0, Loose)
		)
	).

	% form_compare: 
	%	strict means that the forms are incompatible.
	%	loose means that the forms are compatible but not equal.
:- type form_compare
	--->	equal
	;	strict
	;	loose.

:- pred edcg_form_compare(form_compare, form, form).
:- mode edcg_form_compare(out, in, in) is det.

edcg_form_compare(equal, nothing, nothing).
edcg_form_compare(strict, nothing, passed).
edcg_form_compare(strict, nothing, produced).
edcg_form_compare(strict, nothing, changed).
edcg_form_compare(equal, passed, passed).
edcg_form_compare(loose, passed, nothing).
edcg_form_compare(strict, passed, produced).
edcg_form_compare(strict, passed, changed).
edcg_form_compare(equal, produced, produced).
edcg_form_compare(loose, produced, nothing).
edcg_form_compare(strict, produced, passed).
edcg_form_compare(strict, produced, changed).
edcg_form_compare(equal, changed, changed).
edcg_form_compare(loose, changed, nothing).
edcg_form_compare(loose, changed, passed).
edcg_form_compare(loose, changed, produced).

%---------------------------------------------------------------------------%
	% EDCGInfo Error predicates.

	% The edcg_error structure stores all information relating to any
	% errors caused by edcg arguments.
:- type edcg_error 
	--->	pred_call_error(pred_id, term__context, edcg_arg)
		% edcg argument for predicate call out of scope 
	;	pred_call_explicit_error(pred_id, term__context, edcg_arg)
		% explicit edcg argument not used in called predicate 
	;	pred_call_expanded_error(pred_id, term__context)
		% predicate called in expanded form also has explicit arguments
	;	pred_call_form_error(term__context, edcg_arg, form, pred_id) 
		% an explicit edcg argument has the wrong form for the declared
		% predicate
	;	pred_call_warning(pred_id, term__context)
		% warning that a predicate was called in explicit form
	;	scope_error(edcg_operator, term__context, edcg_arg)
		% an edcg argument was referenced out of scope
	;	infer_error(assoc_list(edcg_arg, pair(form)), term__context)
		% mismatched declared and inferred edcg arguments
	;	infer_warning(assoc_list(edcg_arg, pair(form)), term__context)
		% mismatched declared and inferred edcg arguments
	;	undef_mode_error(edcg_arg, form, term__context)
		% no mode defined for a form
	;	functor_error(term__context)
		% `-->>' not used when it should be
	;	functor_warning(term__context).
		% `-->>' used when is does not have to be

	% edcg_info_error(EDCGError, EDCGInfoIn, EDCGInfoOut)
	%
	% EDCGInfoOut is EDCGInfoIn with EDCGError appended onto
	% its list of errors.
:- pred edcg_info_error(edcg_error, edcg_info, edcg_info).
:- mode edcg_info_error(in, in, out) is det.

edcg_info_error(Error, EDCGInfo0, EDCGInfo) :-
	EDCGInfo0^errors = Errors,
	EDCGInfo = EDCGInfo0^errors := Error.Errors.

	% maybe_edcg_error/8 :
	% prints out error messages corresponding to error states returned
	% from processing the Body of a clause.
:- pred maybe_edcg_error(list(edcg_error), pred_id,
		module_info, module_info, io__state, io__state).
:- mode maybe_edcg_error(in, in, in, out, di, uo) is det.

maybe_edcg_error(Errors0, PredId, ModuleInfo0, ModuleInfo) -->
	{ list__reverse(Errors0, Errors) },
	{ error_util__describe_one_pred_name(ModuleInfo0, PredId,
		PredString) },
	{ PredFormat = [words("In clause for"), fixed(PredString), nl] },
	maybe_edcg_error_2(Errors, PredFormat, ModuleInfo0, ModuleInfo).

:- pred maybe_edcg_error_2(list(edcg_error), list(format_component),
		module_info, module_info, io__state, io__state).
:- mode maybe_edcg_error_2(in, in, in, out, di, uo) is det.

maybe_edcg_error_2([], _, ModuleInfo, ModuleInfo) --> [].
maybe_edcg_error_2([Error|Rest], PredFormat, ModuleInfo0, ModuleInfo) -->
	maybe_edcg_error_3(Error, PredFormat, ModuleInfo0, ModuleInfo1),
	maybe_edcg_error_2(Rest, PredFormat, ModuleInfo1, ModuleInfo).

:- pred maybe_edcg_error_3(edcg_error, list(format_component), 
		module_info, module_info,
		io__state, io__state).
:- mode maybe_edcg_error_3(in, in, in, out, di, uo) is det.

maybe_edcg_error_3(pred_call_form_error(Context, EDCGArg, Form, PredId),
		PredFormat, ModuleInfo0, ModuleInfo) -->
	{ form_to_string(Form, FormString) },
	{ sym_name_to_string(EDCGArg, EDCGArgString) },
	{ error_util__describe_one_pred_name(ModuleInfo0, PredId,
		PredString) },
	{ Message = [words("EDCG variable"), words(EDCGArgString), 
		words("has the wrong arity for the declared form:"), 
		words(FormString), words(", for the call to"), 
		fixed(PredString)] },
	{ list__append(PredFormat, Message, FormatComps) },
	error_util__write_error_pieces(Context, 0, FormatComps),
	{ module_info_incr_errors(ModuleInfo0, ModuleInfo) }.

maybe_edcg_error_3(infer_error(Strict, Context),
		PredFormat, ModuleInfo0, ModuleInfo) -->
	{ list__append(PredFormat,
		[words("EDCG edcg form declaration error:")],
		FormComps0) },
	{ form_error(Strict, FormComps1) },
	{ list__append(FormComps0, FormComps1, FormComps) },
	error_util__write_error_pieces(Context, 0, FormComps),
	{ module_info_incr_errors(ModuleInfo0, ModuleInfo) }.

maybe_edcg_error_3(infer_warning(Loose, Context),
		PredFormat, ModuleInfo, ModuleInfo) -->
	{ list__append(PredFormat,
		[words("EDCG edcg form declaration warning:")],
		FormComps0) },
	{ form_error(Loose, FormComps1) },
	{ list__append(FormComps0, FormComps1, FormComps) },
	error_util__report_warning(Context, 0, FormComps).

maybe_edcg_error_3(pred_call_error(PredId, Context, 
	    EDCGArg), PredFormat, ModuleInfo0, ModuleInfo) -->
	{ error_util__describe_one_pred_name(ModuleInfo0, PredId, PredString) },
	{ list__append(PredFormat, 
		[words("EDCG scope error: At call to"), 
		words(PredString), nl], FormatComps0) },
	{ scope_error(EDCGArg, MessageString) },
	{ list__append(FormatComps0, [words(MessageString)], FormatComps) },
	error_util__write_error_pieces(Context, 0, FormatComps),
	{ module_info_incr_errors(ModuleInfo0, ModuleInfo) }.

maybe_edcg_error_3(pred_call_explicit_error(PredId, Context, 
	    EDCGArg), PredFormat, ModuleInfo0, ModuleInfo) -->
	{ error_util__describe_one_pred_name(ModuleInfo0, PredId, PredString) },
	{ list__append(PredFormat, 
		[words("EDCG pred call error: At call to"), 
		words(PredString), nl], FormatComps0) },
	{ sym_name_to_string(EDCGArg, EDCGArgString) },
	{ string__append(EDCGArgString, 
		" is not used in the called predicate.", MessageString) },
	{ list__append(FormatComps0, [words(MessageString)], FormatComps) },
	error_util__write_error_pieces(Context, 0, FormatComps),
	{ module_info_incr_errors(ModuleInfo0, ModuleInfo) }.

maybe_edcg_error_3(pred_call_expanded_error(PredId, Context),
		PredFormat, ModuleInfo0, ModuleInfo) -->
	{ error_util__describe_one_pred_name(ModuleInfo0, PredId, PredString) },
	{ list__append(PredFormat, 
		[words("EDCG pred call error: At call to"), 
		words(PredString), nl], FormatComps0) },
	{ string__append(" predicate is called in expanded form ",
		"and has explicit edcg arguments.", MessageString) },
	{ list__append(FormatComps0, [words(MessageString)], FormatComps) },
	error_util__write_error_pieces(Context, 0, FormatComps),
	{ module_info_incr_errors(ModuleInfo0, ModuleInfo) }.

maybe_edcg_error_3(pred_call_warning(PredId, Context),
		PredFormat, ModuleInfo, ModuleInfo) -->
	{ error_util__describe_one_pred_name(ModuleInfo, PredId,
		PredString) },
	{ list__append(PredFormat,
		[words("Call to predicate"), fixed(PredString),
		words("with edcg arguments in expanded form.")], FormComps) },
	error_util__report_warning(Context, 0, FormComps).

maybe_edcg_error_3(scope_error(Op, Context, EDCGArg),
		PredFormat, ModuleInfo0, ModuleInfo) -->
	{ edcg_operator_to_string(Op, OpString) },
	{ list__append(PredFormat, [words("EDCG scope error: At operator"), 
		words(OpString), nl], FormatComps0) },
	{ scope_error(EDCGArg, MessageString) },
	{ list__append(FormatComps0, [words(MessageString)], FormatComps) },
	error_util__write_error_pieces(Context, 0, FormatComps),
	{ module_info_incr_errors(ModuleInfo0, ModuleInfo) }.

maybe_edcg_error_3(undef_mode_error(EDCGArg, Form, Context),
		PredFormat, ModuleInfo0, ModuleInfo) -->
	{ sym_name_to_string(EDCGArg, EDCGString) },
	{ form_to_string(Form, FormString) },
	{ list__append(PredFormat,
		[words("No mode(s) declared for edcg argument"),
		words(EDCGString), words("for the form"), words(FormString),
		nl], FormatComps) },
	error_util__write_error_pieces(Context, 0, FormatComps),
	{ module_info_incr_errors(ModuleInfo0, ModuleInfo) }.

maybe_edcg_error_3(functor_error(Context),
		PredFormat, ModuleInfo0, ModuleInfo) -->
	{ list__append(PredFormat,
		[words("Clause uses edcg variables and hence"),
		words("should have functor `-->>'.")],
		FormatComps) },
	error_util__write_error_pieces(Context, 0, FormatComps),
	{ module_info_incr_errors(ModuleInfo0, ModuleInfo) }.

maybe_edcg_error_3(functor_warning(Context),
		PredFormat, ModuleInfo, ModuleInfo) -->
	{ list__append(PredFormat,
		[words("Clause does not use edcg variables and hence"),
		words("does not need functor `-->>'.")],
		FormatComps) },
	error_util__report_warning(Context, 0, FormatComps).

:- pred scope_error(edcg_arg, string).
:- mode scope_error(in, out) is det.

scope_error(EDCGArg, String) :-
	sym_name_to_string(EDCGArg, EDCGArgString),
	string__append(EDCGArgString, " is not in scope", String).

:- pred form_error(assoc_list(edcg_arg, pair(form)), list(format_component)).
:- mode form_error(in, out) is det.

form_error(EDCGForms, FormComp) :-
	list__map(form_error_2, EDCGForms, Strings),
	error_util__list_to_pieces(Strings, FormComp).

:- pred form_error_2(pair(edcg_arg, pair(form)), string).
:- mode form_error_2(in, out) is det.

form_error_2(EDCGArg - (Form1 - Form2), String) :-
	sym_name_to_string(EDCGArg, EDCGString),
	form_to_string(Form1, Form1String),
	form_to_string(Form2, Form2String),
	string__append_list([EDCGString, " declared ", Form1String,
		" but inferred ", Form2String], String).

%---------------------------------------------------------------------------%
	% EDCGInfo Get and Set predicates

:- implementation.

:- pred edcg_info_get_state_info(edcg_arg, edcg_info, state_info).
:- mode edcg_info_get_state_info(in, in, out) is det.

edcg_info_get_state_info(EDCGArg, EDCGInfo, StateInfo) :-
	EDCGInfo^state_info_table = StateTable,
	map__lookup(StateTable, EDCGArg, StateInfo).

	% Overwrite any existing state information for the edcg id.
:- pred edcg_info_set_state_info(edcg_arg, edcg_info, state_info,
	edcg_info).
:- mode edcg_info_set_state_info(in, in, in, out) is det.

edcg_info_set_state_info(EDCGArg, EDCGInfo0, StateInfo, EDCGInfo) :-
	EDCGInfo0^state_info_table = StateTable0,
	map__set(StateTable0, EDCGArg, StateInfo, StateTable),
	EDCGInfo = EDCGInfo0^state_info_table := StateTable.

	% edcg_info_get_vars(EDCGArg, EDCGInfo, Var)
	%
	% Var is the variable that EDCGArg currently represents in EDCGInfo.
:- pred edcg_info_get_var(edcg_arg, edcg_info, prog_var).
:- mode edcg_info_get_var(in, in, out) is det.

edcg_info_get_var(EDCGArg, EDCGInfo, Var) :-
	edcg_info_get_state_info(EDCGArg, EDCGInfo, StateInfo),
	state_info_get_var(StateInfo, Var).

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

	% StateInfo Utility predicates.

:- implementation.

	% Note that var_suffix is the next available suffix and not the
	% actual suffix of var.
:- type state_info
	--->	state_info(
			name_base :: name_base,
			var_suffix :: var_suffix,
			(type) :: (type),
			state_sub_info :: state_sub_info).

:- type state_sub_info
	--->	curr(prog_var)
		% The current variable the edcg reference refers to.
	;	curr_next(atomic_goal_id, prog_var, prog_var)
		% The current and next variables the edcg reference refers to.
	;	dead.
		% The edcg reference is not in scope.

:- type name_base    ==    string.
:- type var_suffix    ==    int.
	

:- pred state_info_init(edcg_arg, type, state_info).
:- mode state_info_init(in, in, out) is det.

state_info_init(EDCGArg, Type, StateInfo) :-
	create_var_name(EDCGArg, NameBase),
	init_var_suffix(Suffix),
	StateInfo = state_info(NameBase, Suffix, Type, dead).

	% change the state_info from dead to current.
:- pred state_info_birth(var_set_types, var_set_types,
	state_info, state_info).
:- mode state_info_birth(in, out, in, out) is det.

state_info_birth(VarSetTypes0, VarSetTypes, 
		state_info(NameBase, Suffix0, Type, dead), 
		state_info(NameBase, Suffix, Type, curr(Var))) :-
	new_var(VarSetTypes0, NameBase, Suffix0, Type, VarSetTypes, 
		Suffix, Var).
state_info_birth(_,_,state_info(_,_,_,curr(_)), _) :-
	error("EDCG argument assumed dead when alive.\n").
state_info_birth(_,_,state_info(_,_,_,curr_next(_,_,_)), _) :-
	error("EDCG argument assumed dead when alive.\n").

	% Used for edcg goals,
	% Creates a new variable and sets the state to current 
:- pred state_info_new(var_set_types, var_set_types, 
		state_info, state_info).
:- mode state_info_new(in, out, in, out) is det.

state_info_new(VarSetTypes0, VarSetTypes, StateInfo0, StateInfo) :-
	StateInfo0 = state_info(NameBase, Suffix0, Type, _),
	new_var(VarSetTypes0, NameBase, Suffix0, Type, VarSetTypes, 
		Suffix, Var),
	StateInfo = state_info(NameBase, Suffix, Type, curr(Var)).

:- pred state_info_new_var(var_set_types, var_set_types, 
		state_info, state_info).
:- mode state_info_new_var(in, out, in, out) is det.

state_info_new_var(VarSetTypes0, VarSetTypes, 
		state_info(NameBase, Suffix0, Type, StateSubInfo0),
		state_info(NameBase, Suffix, Type, StateSubInfo)) :-
	(
		StateSubInfo0 = dead
	->
		StateSubInfo = dead,
		Suffix = Suffix0,
		VarSetTypes = VarSetTypes0
	;
		StateSubInfo = curr(Var),
		new_var(VarSetTypes0, NameBase, Suffix0, Type, VarSetTypes, 
			Suffix, Var)
	).

	% Used with the operator '$=', and for a predicate call with a form of
	% produced for the edcg variable.
:- pred state_info_produce(atomic_goal_id, var_set_types, var_set_types, 
		state_info, state_info, prog_var).
:- mode state_info_produce(in, in, out, in, out, out) is semidet.

state_info_produce(Id, VarSetTypes0, VarSetTypes, StateInfo0, StateInfo, Var) :-
	state_info_change(Id, VarSetTypes0, VarSetTypes, StateInfo0, StateInfo,
		_, Var).

	% Used for a predicate call with a form of changed for the edcg
	% variable.
:- pred state_info_change(atomic_goal_id, var_set_types, var_set_types, 
		state_info, state_info, prog_var, prog_var).
:- mode state_info_change(in, in, out, in, out, out, out) is semidet.

state_info_change(IdNew, VarSetTypes0, VarSetTypes, 
		state_info(NameBase,Suffix0,Type,StateSubInfo),
		state_info(NameBase,Suffix,Type,curr_next(IdNew,Var1,Var2)), 
		Var1, Var2) :-
	(
		StateSubInfo = curr(Var1),
		new_var(VarSetTypes0, NameBase, Suffix0, Type, VarSetTypes, 
			Suffix, Var2)
	;
		StateSubInfo = curr_next(IdOld,VarOld1,VarOld2),
		(
			IdNew = IdOld
		->
			Var1 = VarOld1,
			Var2 = VarOld2,
			VarSetTypes = VarSetTypes0,
			Suffix = Suffix0
		;
			new_var(VarSetTypes0, NameBase, Suffix0, Type, 
				VarSetTypes, Suffix, Var2),
			Var1 = VarOld2
		)
	).

	% Used with the '$' operator and used for a predicate call with a form
	% of passed for the edcg variable.
:- pred state_info_pass(atomic_goal_id, state_info, state_info, prog_var).
:- mode state_info_pass(in, in, out, out) is semidet.

state_info_pass(IdNew,
		state_info(NameBase,Suffix,Type,StateSubInfo0),
		state_info(NameBase,Suffix,Type,StateSubInfo), Var) :-
	(
		StateSubInfo0 = curr(Var),
		StateSubInfo = StateSubInfo0
	;
		StateSubInfo0 = curr_next(IdOld,Var1,Var2),
		(
			IdNew = IdOld
		->
			StateSubInfo = curr_next(IdNew,Var1,Var2),
			Var = Var1
		;
			StateSubInfo = curr(Var2),
			Var = Var2
		)
	).
	
:- pred state_info_is_alive(state_info::in) is semidet.

state_info_is_alive(state_info(_,_,_,curr(_))).
state_info_is_alive(state_info(_,_,_,curr_next(_,_,_))).

:- pred state_info_get_var(state_info, prog_var).
:- mode state_info_get_var(in, out) is det.

state_info_get_var(state_info(_,_,_,curr(Var)), Var).
state_info_get_var(state_info(_,_,_,curr_next(_,_,Var)), Var).
state_info_get_var(state_info(_,_,_,dead), _Var) :-
	error("EDCG argument incorrectly assumed dead.\n").

	% new_var(VarSetIn, NameBase, SuffixOld, VarSetOut, SuffixNew,
	%	Var): 
	% VarSetOut is VarSetIn with the Var added with NameBase and SuffixOld,
	% SuffixNew is the next available suffix to use.
:- pred new_var(var_set_types, name_base, var_suffix, type, 
		var_set_types, var_suffix, prog_var).
:- mode new_var(in,  in, in, in, out, out, out) is det.

new_var(VarSet0 - VarTypes0, NameBase, Suffix0, Type, VarSet - VarTypes, 
		Suffix, Var) :-
	string__int_to_string(Suffix0, SuffixString),
	string__append(NameBase, SuffixString, VarName),
	varset__new_named_var(VarSet0, VarName, Var, VarSet),
	map__det_insert(VarTypes0, Var, Type, VarTypes),
	next_var_suffix(Suffix0, Suffix).

	% Creates a string to be used as the base for the variable names.
:- pred create_var_name(edcg_arg::in, name_base::out) is det.

create_var_name(EDCGArg, VarName) :-
	unqualify_name(EDCGArg, Name),
	sym_name_get_module_name(EDCGArg, unqualified(""), ModuleName0),
	unqualify_name(ModuleName0, ModuleName),
	string__append_list(["EDCG_", ModuleName, "_", Name], VarName).

:- pred init_var_suffix(var_suffix::out) is det.

init_var_suffix(0).

:- pred next_var_suffix(var_suffix::in, var_suffix::out) is det.

next_var_suffix(Suffix, NewSuffix) :-
	NewSuffix is Suffix + 1.

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

--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------