Test cases for DCG rule translation to "normal" Prolog clauses

[Paulo Moura]

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>
-----------------------------------------------------------