%		Translate DCG rules
%		From Clocksin & Mellish (with some changes)

op(1200, xfx, -->)!
% op(1101,fx,'{')!
% op(1100,xf,'}')!

dcg :- read_from_this_file, repeat, grammar, eof, !, fail.

parse(X) :-
	inlist(L),
	(X(Y, L, []) | Y = "What?"),
	print(Y).

grammar :-
	read(X),
	(X = stop -> abort | true),
	translate(X, Y), !,
	assertz(Y).
grammar :- eof, !.
grammar :- print("DCG Syntax Error"), skip('.').

translate((P0 --> Q0), (P :- Q)) :-
	left_hand_side(P0, S0, S, P),
	right_hand_side(Q0, S0, S, Q1),
	flatten(Q1, Q).

left_hand_side((NT, Ts), S0, S, P) :- !,
	nonvar(NT),
	islist(Ts),
	tag(NT, S0, S1, P),
	append(Ts, S0, S1).
left_hand_side(NT, S0, S, P) :-
	nonvar(NT),
	tag(NT, S0, S, P).

right_hand_side((X1, X2), S0, S, P) :- !,
	right_hand_side(X1, S0, S1, P1),
	right_hand_side(X2, S1, S, P2),
	and(P1, P2, P).
right_hand_side((X1 | X2), S0, S, (P1 | P2)) :- !,
	or(X1, S0, S, P1),
	or(X2, S0, S, P2).
right_hand_side({P}, S, S, P) :- !.
right_hand_side(!, S, S, !) :- !.
right_hand_side(Ts, S0, S, true) :-
	islist(Ts), !,
	append(Ts,S, S0).
right_hand_side(X, S0, S, P) :-
	tag(X, S0, S, P).

or(X, S0, S, P) :-
	right_hand_side(X, S0a, S, Pa),
	(var(S0a), S0a = S, !, S0 = S0a, P = Pa
	| P = (S0=S0a, Pa)).

tag(X, S0, S, P) :-
	X =.. [F, ..A],
	append(A, [S0, S], AX),
	P =.. [F, ..AX].

and(true, P, P) :- !.
and(P, true, P) :- !.
and(P, Q, (P, Q)).


islist([]) :- !.
islist([_, .._]).

append([A, ..B], C, [A, ..D]) :- append(B, C, D).
append([], X, X).

flatten((P1|P2),(Q1|Q2)) :- !,
   flatten(P1,Q1),
   flatten(P2,Q2).
flatten(((P1,P2),P3),Q) :- flatten((P1,(P2,P3)),Q).
flatten((P1,P2),(Q1,Q2)) :- !,
   flatten(P1,Q1),
   flatten(P2,Q2).
flatten(A,A) :- !.

inlist(X) :- ratom(Y), next(Y, X).

next('.', []) :- !.
next(X, [X, ..Y]) :- inlist(Y).

% :- private([grammar, translate, left_hand_side, right_hand_side, or, tag, and, islist, append, flatten, inlist, next]).
