From 6edf6f1dd305e269c9ccf187cfad30d54ab7f7d8 Mon Sep 17 00:00:00 2001
From: vsc <vsc@b08c6af1-5177-4d33-ba66-4b1c6b8b522a>
Date: Fri, 5 Nov 2004 03:03:54 +0000
Subject: [PATCH] fix DCGs to be closer to standard.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1173 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
---
 pl/grammar.yap | 46 ++++++++++++++++++++++++++++++++--------------
 1 file changed, 32 insertions(+), 14 deletions(-)

diff --git a/pl/grammar.yap b/pl/grammar.yap
index 5f3098e89..892ccd969 100644
--- a/pl/grammar.yap
+++ b/pl/grammar.yap
@@ -21,24 +21,40 @@
     Also, phrase/2-3 check their first argument.
 */
 
-'$translate_rule'((LP-->RP), H) :-
-	RP == [],
-	!,
-	'$t_head'(LP, S, S, H).
-'$translate_rule'((LP-->RP), (H:-B)):-
-	'$t_head'(LP, S, SR, H),
-	'$t_body'(RP, _, last, S, SR, B1),
+'$translate_rule'((LP-->RP), (NH:-B)) :-
+	'$t_head'(LP, NH, NGs, S, SR, (LP-->RP)),
+	 (var(NGs) ->
+	     '$t_body'(RP, _, last, S, SR, B1)
+	 ;
+	     '$t_body'((RP,{NGs}), _, last, S, SR, B1)
+	 ),
 	'$t_tidy'(B1, B).
 
 
-'$t_head'((LP,List), S, SR, H):- !,
-	'$append'(List, SR, List2),
-	'$extend'([S,List2], LP, H).
-'$t_head'(M:LP, S, SR, M:H) :- !,
-	'$extend'([S,SR], LP, H).
-'$t_head'(LP, S, SR, H) :-
-	'$extend'([S,SR], LP, H).
+'$t_head'(V, _, _, _, _, G0) :- var(V), !,
+	'$do_error'(instantiation_error,G0).
+'$t_head'((H,List), NH, NGs, S, S1, G0) :- !,
+	'$t_hgoal'(H, NH, S, SR, G0),
+	'$t_hlist'(List, S1, SR, NGs, G0).
+'$t_head'(H, NH, _, S, SR, G0) :-
+	'$t_hgoal'(H, NH, S, SR, G0).
 	
+'$t_hgoal'(V, _, _, _, G0) :- var(V), !,
+	'$do_error'(instantiation_error,G0).
+'$t_hgoal'(M:H, M:NH, S, SR, G0) :- !,
+	'$t_hgoal'(H, NH, S, SR, G0).
+'$t_hgoal'(H, NH, S, SR, _) :-
+	'$extend'([S,SR],H,NH).
+
+'$t_hlist'(V, _, _, _, G0) :- var(V), !,
+	'$do_error'(instantiation_error,G0).
+'$t_hlist'([], S0, SR, true, _).
+'$t_hlist'([H], S0, SR, ('C'(SR,H,S0)), _) :- !.
+'$t_hlist'([H|List], S0, SR, ('C'(SR,H,S1),G0), Goal) :- !,
+	'$t_hlist'(List, S0, S1, G0, Goal).
+'$t_hlist'(T, _, _, _, Goal) :-
+	'$do_error'(type_error(list,T),Goal).
+
 
 %
 % Two extra variables:
@@ -64,6 +80,8 @@
 '$t_body'((T->R), ToFill, Last, S, SR, (Tt->Rt)) :- !,
 	'$t_body'(T, ToFill, not_last, S, SR1, Tt),
 	'$t_body'(R, ToFill, Last, SR1, SR, Rt).
+'$t_body'(\+T, ToFill, Last, S, SR, (Tt->fail ; S=SR)) :- !,
+	'$t_body'(T, ToFill, not_last, S, _, Tt).
 '$t_body'((T;R), _ToFill, _, S, SR, (Tt;Rt)) :- !,
 	'$t_body'(T, _, last, S, SR, Tt),
 	'$t_body'(R, _, last, S, SR, Rt).