/* GRAMMAR.PL Copyright (C) 1983,85,86 by Kyoto Artificial Brain Associates*/

/*
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

   	<< dictio.dcg >>
	s --> np,vp.
	np --> n.
	np --> det,np.
	vp --> vi.
	vp --> vt,np.

	vi --> [walk].
	vt --> [have].
	det --> [a].
	n  -->  [dog].

	?- grammar('dictio.dcg').
	yes
	?- analize([dog,walk],X).
	X	= s
	yes

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

   	<< dictio2.dcg >>

	s([s,Np,Vp])--> np(Np),vp(Vp).
	np([np,Det,Noun])-->det(Det),n(Noun).
	np([np,Noun])-->n(Noun).
	np([np,[not,only],Np,[but,also],Np2])
			--> [not,only],np(Np),[but,also],np(Np2).
	vp([vp,Vi])-->vi(Vi).
	vp([vp,Vt,Np])--> vt(Vt),np(Np).
	n([n,bill])--> [bill].
	n([n,'I'])--> ['I'].
	n([n,children])--> [children].
	n([n,pen]) --> [pen].
	det([det,a])-->[a].
	vi([vi,walks])-->[walks].
	vi([vi,walk])-->[walk].
	vt([vt,have])-->[have].

	?- grammar('dictio2.dcg').
	yes
	?- analize(['I',have,children],X).
	X	= [s,[np,[n,'I']],[vp,[vt,have],[np,[n,children]]]]
	yes

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*/

:- s_mode(_,on).

/* 構文解析 */

:- public analize/2.

analize(Words,Syntax) :-
	gr_elem(Pred),
	(G =..[Pred,Syntax,Words,[]],G,!;G=..[Pred,Words,[]],G,!,Syntax=Pred).

/* ＤＣＧ　トランスレータ起動述語 */

:- public grammar/1.

grammar(F) :- see(F),repeat,read(X),grammar1(X),X=end_of_file,!,seen.

grammar1( end_of_file ) :- !.
grammar1( (P --> Q) ) :-!,
	expand_head(P,P1,S0,S,Pred),	/* 頭部展開 */
	expand_body(Q,Q1,S0,S),		/* 胴部展開 */
	grammatical_element_assert(Pred),
	dcg_assert(P1,Q1).
grammar1(X):-assertz(X).

dcg_assert(A,true):- !,assert(A).
dcg_assert(A,B):-    assert((A:-B)).

grammatical_element_assert(Pred) :- gr_elem(Pred),!.
grammatical_element_assert(Pred) :- assert(gr_elem(Pred)).

/* 頭部展開 */
expand_head((P1,P2),Q,S0,S,F):- 
	!,P1=..[F|A],g_append(P2,S,S1),g_append(A,[S0,S1],A1),Q=..[F|A1].

expand_head(P,Q,S0,S,F) :-
	P=..[F|A],g_append(A,[S0,S],A1),Q=..[F|A1].

/* 胴部展開 */
expand_body(P,Q,S0,S) :- 	/* Body has Goals */
	uni(P,A),!,
	expand_bodies(A,A1,S0,S),
	expand_make_and(A1,Q).

uni(','(X,Y),[X|Z]) :- !,uni(Y,Z).
uni(X,[X]) :-!.

expand_make_and([],true) :- !.
expand_make_and([X],X) :- !.
expand_make_and([X|Y],','(X,Z)) :- !,expand_make_and(Y,Z).


/* 胴部の個々の要素の変換 */

expand_bodies([],[],S0,S0) :- !.

expand_bodies([P|PL],Q,S0,S) :-		/* 終端要素 */
	(list(P);P=[]),
	!,g_append(P,S1,S0),
	expand_bodies(PL,Q,S1,S).

expand_bodies([!|PL],[!|QL],S0,S) :- 	/* カットオペレータ */
	!,expand_bodies(PL,QL,S0,S).

expand_bodies([{P}|PL],Q,S0,S) :- 	/* 補強項 */
	!,expand_prolog(P,Q,QL),
	expand_bodies(PL,QL,S0,S).


expand_bodies([P|PL],[Q|QL],S0,S) :- 	/* 文法要素 */
	P=..[F|A],g_append(A,[S0,S1],A1),Q=..[F|A1],  
	expand_bodies(PL,QL,S1,S).

%%%%%%%%%%

expand_prolog(P,Q,QL) :- uni(P,G),g_append(G,QL,Q),!.
expand_prolog(P,[P|QL],QL).

g_append([],X,X) :- !.
g_append([A|X],Y,[A|Z]) :- g_append(X,Y,Z).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:-s_mode(_,off).
