[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Test cases for DCG rule translation to "normal" Prolog clauses
From: |
Paulo Moura |
Subject: |
Test cases for DCG rule translation to "normal" Prolog clauses |
Date: |
Sat, 22 Mar 2003 16:12:18 +0000 |
Hi!
I'm implementing a DCG rule translator for the next Logtalk release
(http://www.logtalk.org). I have a few test cases that I found on the
web (specifically, a discussion on DCGs by Bart Demoen, Mats Carlsson,
Tony Dodd, Richard A. O’Keefe, and Roger Scowen). For those tests, my
translator seams to return correct results:
p-->[x]->[];q
p(A, B):-A=[x|C]->C=B;q(A, B)
p-->[a];[b]
p(A, B):-A=[a|B];A=[b|B]
p-->q;r
p(A, B):-q(A, B);r(A, B)
p-->{3}
p(A, B):-3, A=B
p-->[97, 98, 99];[113]
p(A, B):-A=[97, 98, 99|B];A=[113|B]
p-->q;[]
p(A, B):-q(A, B);A=B
p-->{a}, {b}, {c}
p(A, B):-a, b, c, A=B
p-->{q}->[a];[b]
p(A, B):-q->A=[a|B];A=[b|B]
p-->{q}->[];b
p(A, B):-q->A=B;b(A, B)
a-->[foo], {write(x)}, [bar]
a(A, B):-A=[foo|C], write(x), C=[bar|B]
a-->[foo], {write(hello)}, {nl}
a(A, B):-A=[foo|B], write(hello), nl
Anyone have additional test cases that is willing to share? The current
version of my translator is as follows:
% '$lgt_dcgrule_to_clause'(+dcgrule, -clause)
%
% converts a DCG rule to a normal clause
'$lgt_dcgrule_to_clause'(Rule, Clause) :-
catch(
'$lgt_dcg_rule'(Rule, Clause),
Error,
throw(error(Error, dcgrule(Rule)))).
'$lgt_dcg_rule'((RHead --> RBody), (CHead :- CBody)) :-
'$lgt_dcg_head'(RHead, CHead, S0, S),
'$lgt_dcg_body'(RBody, Body, S0, S),
'$lgt_dcg_simplify'(Body, CBody, S0, S).
'$lgt_dcg_head'(Nonterminal, _, _, _) :-
var(Nonterminal),
throw(instantiation_error).
'$lgt_dcg_head'(Nonterminal, CHead, S0, S) :-
'$lgt_dcg_goal'(Nonterminal, CHead, S0, S).
'$lgt_dcg_body'(Var, phrase(Var, S0, S), S0, S) :-
var(Var),
!.
'$lgt_dcg_body'((RGoal,RGoals), (CGoal,CGoals), S0, S) :-
!,
'$lgt_dcg_body'(RGoal, CGoal, S0, S1),
'$lgt_dcg_body'(RGoals, CGoals, S1, S).
'$lgt_dcg_body'((RGoal1 -> RGoal2), (CGoal1 -> CGoal2), S0, S) :-
!,
'$lgt_dcg_body'(RGoal1, CGoal1, S0, S1),
'$lgt_dcg_body'(RGoal2, CGoal2, S1, S).
'$lgt_dcg_body'((RGoal1;RGoal2), (CGoal1;CGoal2), S0, S) :-
!,
'$lgt_dcg_body'(RGoal1, CGoal1, S0, S),
'$lgt_dcg_body'(RGoal2, CGoal2, S0, S).
'$lgt_dcg_body'({Goal}, (Goal, S0=S), S0, S) :-
!.
'$lgt_dcg_body'(!, (!, S0=S), S0, S) :-
!.
'$lgt_dcg_body'([], (S0=S), S0, S) :-
!.
'$lgt_dcg_body'(\+ RGoal, CGoal, S0, S) :-
!,
'$lgt_dcg_body'((RGoal -> {fail};{true}), CGoal, S0, S).
'$lgt_dcg_body'([Terminal| Terminals], (CGoal,CGoals), S0, S) :-
!,
'$lgt_dcg_terminal'(Terminal, CGoal, S0, S1),
'$lgt_dcg_body'(Terminals, Goals, S1, S),
'$lgt_dcg_simplify_terminals'(Goals, CGoals).
'$lgt_dcg_body'(Non_terminal, CGoal, S0, S) :-
'$lgt_dcg_goal'(Non_terminal, CGoal, S0, S).
'$lgt_dcg_goal'(RGoal, _, _, _) :-
\+ '$lgt_callable'(RGoal),
throw(type_error(callable, RGoal)).
'$lgt_dcg_goal'(RGoal, CGoal, S0, S) :-
RGoal =.. RList,
'$lgt_append'(RList, [S0, S], CList),
CGoal =.. CList.
'$lgt_dcg_terminal'(Goal, S0=[Goal|S], S0, S).
'$lgt_dcg_simplify'((Goal1 -> Goal2), (SGoal1 -> SGoal2), S0, S) :-
!,
'$lgt_dcg_simplify'(Goal1, SGoal1, S0, S),
(Goal2 = (_,_) ->
'$lgt_dcg_simplify'(Goal2, SGoal2, S0, S)
;
Goal2 = SGoal2).
'$lgt_dcg_simplify'((Goal1;Goal2), (SGoal1;SGoal2), S0, S) :-
!,
'$lgt_dcg_simplify'(Goal1, SGoal1, S0, S),
'$lgt_dcg_simplify'(Goal2, SGoal2, S0, S).
'$lgt_dcg_simplify'((Goal1,Goal2), Body, S0, S) :-
!,
'$lgt_dcg_simplify'(Goal1, SGoal1, S0, S),
'$lgt_dcg_simplify'(Goal2, SGoal2, S0, S),
'$lgt_dcg_simplify_and'((SGoal1,SGoal2), Body).
'$lgt_dcg_simplify'(S1=S2, S0=S, S0, S) :-
S1 == S0,
S2 == S,
!.
'$lgt_dcg_simplify'(S1=S2, true, S0, S) :-
var(S2),
(S1 \== S0; S2 \== S),
!,
S1 = S2.
'$lgt_dcg_simplify'(Body, Body, _, _).
'$lgt_dcg_simplify_and'(((Goal1,Goal2),Goal3), Body) :-
!,
'$lgt_dcg_simplify_and'((Goal1,(Goal2,Goal3)), Body).
'$lgt_dcg_simplify_and'((true,Goal), Body) :-
!,
'$lgt_dcg_simplify_and'(Goal, Body).
'$lgt_dcg_simplify_and'((Goal,true), Body) :-
!,
'$lgt_dcg_simplify_and'(Goal, Body).
'$lgt_dcg_simplify_and'((Goal1,Goal2), (Goal1,Goal3)) :-
!,
'$lgt_dcg_simplify_and'(Goal2, Goal3).
'$lgt_dcg_simplify_and'(Goal, Goal).
'$lgt_dcg_simplify_terminals'((S=L,Goal1), Goal2) :-
!,
S = L,
'$lgt_dcg_simplify_terminals'(Goal1, Goal2).
'$lgt_dcg_simplify_terminals'(Goal, Goal).
The "funny" functors are just a consequence of this being internal code
of the Logtalk compiler. Logtalk is an open source project (available
under the Artistic license). If you find errors or can make
improvements on the above code, please share your comments with the
rest of us.
TIA,
Paulo
-----------------------------------------------------------
Paulo Jorge Lopes de Moura
Dep. of Informatics Office 4.3 Ext. 3257
University of Beira Interior Phone: +351 275319700
6201-001 Covilhã Fax: +351 275319891
Portugal
<mailto:address@hidden>
<http://www.logtalk.org/pmoura.html>
-----------------------------------------------------------
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- Test cases for DCG rule translation to "normal" Prolog clauses,
Paulo Moura <=