/*-------------------------------------------------------------------------*/
/* GNU Prolog                                                              */
/*                                                                         */
/* Part  : Prolog buit-in predicates                                       */
/* File  : dcg.pl                                                          */
/* Descr.: DCG rule / term expansion management                            */
/* Author: Daniel Diaz                                                     */
/*                                                                         */
/* Copyright (C) 1999 Daniel Diaz                                          */
/*                                                                         */
/* GNU Prolog is free software; you can redistribute it and/or modify it   */
/* under the terms of the GNU General Public License as published by the   */
/* Free Software Foundation; either version 2, or any later version.       */
/*                                                                         */
/* GNU Prolog is distributed in the hope that it will be useful, but       */
/* WITHOUT ANY WARRANTY; without even the implied warranty of              */
/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU        */
/* General Public License for more details.                                */
/*                                                                         */
/* You should have received a copy of the GNU General Public License along */
/* with this program; if not, write to the Free Software Foundation, Inc.  */
/* 59 Temple Place - Suite 330, Boston, MA 02111, USA.                     */
/*-------------------------------------------------------------------------*/

:- built_in.

'$use_dcg'.


expand_term(T1,T3):-                                      % must be steadfast
	set_bip_name(expand_term,2),
        '$expand_term1'(T1,T2),
	T2=T3.

'$expand_term1'(T1,T2):-
	(var(T1), T2=T1
	     ;
        '$call_term_expansion'(T1,T2)
             ;
	'$dcg_trans_init_error'(expand_term,2),
        '$dcg_trans_rule'(T1,T2)
             ;
        T2=T1),
       !.




'$call_term_expansion'(T1,T2):-
	current_predicate(term_expansion/2),
	call(term_expansion(T1,T2)).




phrase(NT0,S0):-
	'$phrase'(NT0,S0,[],2).




phrase(NT0,S0,S):-
	'$phrase'(NT0,S0,S,3).




'$phrase'(NT0,S0,S,Arity):-
	set_bip_name(phrase,Arity),
	'$check_list_or_partial_list'(S0),
	'$dcg_trans_init_error'(phrase,Arity),
	'$dcg_trans_body'(NT0,NT,T0,T),
	T0=S0,
	T=S,
	'$call'(NT,phrase,Arity,true).




	% The DCG to Prolog clause translator

'$dcg_trans_rule'((H-->B),(H1:-B1)):-
	'$dcg_trans_rule1'(H,B,H1,B1),
%	'$balance_conj'(B1),             % uncomment for a well-balanced body
	true.




'$dcg_trans_rule1'(H,_,_,_):-
	var(H),
	!,
	'$dcg_trans_prep_error',
	'$pl_err_instantiation'.

'$dcg_trans_rule1'((H,TList),B,H1,B2):-
	!,
	'$dcg_trans_non_term'(H,H1,LIn,LOut),
	'$dcg_trans_body'(B,B1,LIn,LOut1),
	'$dcg_trans_term_list'(TList,BTList,LOut,LOut1),
	'$dcg_trans_and'(B1,BTList,B2).

'$dcg_trans_rule1'(H,B,H1,B1):-
	'$dcg_trans_non_term'(H,H1,LIn,LOut),
	'$dcg_trans_body'(B,B1,LIn,LOut).




'$dcg_trans_body'(B,B1,LIn,LOut):-
	nonvar(B),
	'$dcg_trans_body1'(B,B1,LIn,LOut),
	!.

'$dcg_trans_body'(B,B1,LIn,LOut):-
	'$dcg_trans_non_term'(B,B1,LIn,LOut).


'$dcg_trans_body1'((P,Q),B1,LIn,LOut):-
	!,
	'$dcg_trans_body'(P,P1,LIn,LIn1),
	'$dcg_trans_body'(Q,Q1,LIn1,LOut),
	'$dcg_trans_and'(P1,Q1,B1).

'$dcg_trans_body1'((P->Q),(P1->Q1),LIn,LOut):-
	!,
	'$dcg_trans_body'(P,P1,LIn,LIn1),
	'$dcg_trans_body'(Q,Q1,LIn1,LOut).

'$dcg_trans_body1'((P;Q),(P1;Q1),LIn,LOut):-
	!,
	'$dcg_trans_or'(P,P1,LIn,LOut),
	'$dcg_trans_or'(Q,Q1,LIn,LOut).

'$dcg_trans_body1'(!,!,LIn,LIn):-
	!.

'$dcg_trans_body1'({G},G,LIn,LIn):-
	!.

'$dcg_trans_body1'([],true,LIn,LIn):-
	!.

'$dcg_trans_body1'(TList,B,LIn,LOut):-
	TList=[_|_],
	'$dcg_trans_term_list'(TList,B,LIn,LOut).




	% we here avoid simple useless (true,X) or (X,true) conjunctions
	% if P contains nested conjuctions we obtain a ill-balanced
	% conjuction. This is not really a problem since the compiler knows
	% how to handle it. In any case it is possible to use '$balance_conj'
	% to adjust the whole body term.

'$dcg_trans_and'(P,Q,B):-
	P==true,
	!,
	B=Q.

'$dcg_trans_and'(P,Q,B):-
	Q==true,
	!,
	B=P.

'$dcg_trans_and'(P,Q,(P,Q)).




'$dcg_trans_or'(B,B2,LIn,LOut1):-
	'$dcg_trans_body'(B,B1,LIn,LOut),
	(LIn==LOut -> '$dcg_trans_and'(LOut1=LOut,B1,B2)
                   ;
                      LOut1=LOut,
                      B2=B1).




        % a non terminal (i.e. a variable or a callable), add LIn\LOut

'$dcg_trans_non_term'(NT,NT1,LIn,LOut):-
	var(NT),
	!,
	NT1=phrase(NT,LIn,LOut).

'$dcg_trans_non_term'(NT,NT1,LIn,LOut):-
	callable(NT),
	!,
	functor(NT,F,N),
	N1 is N+1,
	N2 is N1+1,
	functor(NT1,F,N2),
	arg(N1,NT1,LIn),
	arg(N2,NT1,LOut),
	'$dcg_trans_non_term_args'(N,NT,NT1).

'$dcg_trans_non_term'(NT,_,_,_):-
	'$dcg_trans_prep_error',
	'$pl_err_type'(callable,NT).




'$dcg_trans_non_term_args'(0,_,_):-
	!.

'$dcg_trans_non_term_args'(N,NT,NT1):-
	arg(N,NT,A),
	arg(N,NT1,A),
	N1 is N-1,
	'$dcg_trans_non_term_args'(N1,NT,NT1).




'$dcg_trans_term_list'(TList,B,LIn,LOut):-
	'$dcg_trans_term_list1'(TList,B,LIn,LOut),
	!.

'$dcg_trans_term_list'(TList,_,_,_):-
	'$dcg_trans_prep_error',
	'$pl_err_type'(list,TList).


'$dcg_trans_term_list1'(TList,_,_,_):-
	var(TList),
	!,
	'$dcg_trans_prep_error',
	'$pl_err_instantiation'.

'$dcg_trans_term_list1'([],true,LIn,LIn):-
	!.

'$dcg_trans_term_list1'([T|TList],B,LIn,LOut):-
	!,
	'$dcg_trans_term'(T,B1,LIn,LIn1),
	'$dcg_trans_term_list1'(TList,B2,LIn1,LOut),
	'$dcg_trans_and'(B1,B2,B).




	% A terminal, connect

'$dcg_trans_term'(T,LIn=[T|LOut],LIn,LOut).




	% Error context management

'$dcg_trans_init_error'(Name,Arity):-
	'$sys_var_put'(20,Name),
	'$sys_var_write'(21,Arity).

'$dcg_trans_prep_error':-
	'$sys_var_get'(20,Name),
	'$sys_var_read'(21,Arity),
	set_bip_name(Name,Arity).



/*
	% Update in-place a conjunction (to obtain a well-balanced term)
	% this is a quick and dirty solution (no extra memory required)

'$balance_conj'(X):-
	nonvar(X),
	X=(L,R),
	!,
	'$balance_conj1'(L,R,X),
	'$balance_conj'(R).

'$balance_conj'(_).


'$balance_conj1'(PL,PR,P):-
	nonvar(PL),
	PL=(L,R),
	!,
	setarg(1,P,L),
	setarg(2,P,PL),
	setarg(1,PL,R),
	setarg(2,PL,PR),
	'$balance_conj'(P).

'$balance_conj1'(_,_,_).

*/
