[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


I'm implementing a DCG rule translator for the next Logtalk release ( 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(A, B):-A=[x|C]->C=B;q(A, B)

    p(A, B):-A=[a|B];A=[b|B]

    p(A, B):-q(A, B);r(A, B)

    p(A, B):-3, A=B

p-->[97, 98, 99];[113]
    p(A, B):-A=[97, 98, 99|B];A=[113|B]

    p(A, B):-q(A, B);A=B

p-->{a}, {b}, {c}
    p(A, B):-a, b, c, A=B

    p(A, B):-q->A=[a|B];A=[b|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) :-
                '$lgt_dcg_rule'(Rule, Clause),
                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, _, _, _) :-

'$lgt_dcg_head'(Nonterminal, CHead, S0, S) :-
        '$lgt_dcg_goal'(Nonterminal, CHead, S0, S).

'$lgt_dcg_body'(Var, phrase(Var, S0, S), S0, S) :-

'$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) :-
        (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.



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


reply via email to

[Prev in Thread] Current Thread [Next in Thread]