1/************************************************************************* 2* * 3* YAP Prolog * 4* * 5* Yap Prolog was developed at NCCUP - Universidade do Porto * 6* * 7* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * 8* * 9************************************************************************** 10* * 11* File: grammar.pl * 12* Last rev: * 13* mods: * 14* comments: BNF grammar for Prolog * 15* * 16*************************************************************************/ 17 18% :- meta_predicate ^(?,0,?). 19% ^(Xs, Goal, Xs) :- call(Goal). 20 21% :- meta_predicate ^(?,1,?,?). 22% ^(Xs0, Goal, Xs0, Xs) :- call(Goal, Xs). 23 24/* 25 Variables X in grammar rule bodies are translated as 26 if phrase(X) had been written, where phrase/3 is obvious. 27 Also, phrase/2-3 check their first argument. 28*/ 29 30'$translate_rule'((LP-->RP), (NH:-B)) :- 31 '$t_head'(LP, NH, NGs, S, SR, (LP-->RP)), 32 (var(NGs) -> 33 '$t_body'(RP, _, last, S, SR, B1) 34 ; 35 '$t_body'((RP,{NGs}), _, last, S, SR, B1) 36 ), 37 '$t_tidy'(B1, B). 38 39 40'$t_head'(V, _, _, _, _, G0) :- var(V), !, 41 '$do_error'(instantiation_error,G0). 42'$t_head'((H,List), NH, NGs, S, S1, G0) :- !, 43 '$t_hgoal'(H, NH, S, SR, G0), 44 '$t_hlist'(List, S1, SR, NGs, G0). 45'$t_head'(H, NH, _, S, SR, G0) :- 46 '$t_hgoal'(H, NH, S, SR, G0). 47 48'$t_hgoal'(V, _, _, _, G0) :- var(V), !, 49 '$do_error'(instantiation_error,G0). 50'$t_hgoal'(M:H, M:NH, S, SR, G0) :- !, 51 '$t_hgoal'(H, NH, S, SR, G0). 52'$t_hgoal'(H, NH, S, SR, _) :- 53 '$extend'([S,SR],H,NH). 54 55'$t_hlist'(V, _, _, _, G0) :- var(V), !, 56 '$do_error'(instantiation_error,G0). 57'$t_hlist'([], _, _, true, _). 58'$t_hlist'([H], S0, SR, ('C'(SR,H,S0)), _) :- !. 59'$t_hlist'([H|List], S0, SR, ('C'(SR,H,S1),G0), Goal) :- !, 60 '$t_hlist'(List, S0, S1, G0, Goal). 61'$t_hlist'(T, _, _, _, Goal) :- 62 '$do_error'(type_error(list,T),Goal). 63 64 65% 66% Two extra variables: 67% ToFill tells whether we need to explictly close the chain of 68% variables. 69% Last tells whether we are the ones who should close that chain. 70% 71'$t_body'(Var, filled_in, _, S, S1, phrase(Var,S,S1)) :- 72 var(Var), 73 !. 74'$t_body'(!, to_fill, last, S, S1, (!, S1 = S)) :- !. 75'$t_body'(!, _, _, S, S, !) :- !. 76'$t_body'([], to_fill, last, S, S1, S1=S) :- !. 77'$t_body'([], _, _, S, S, true) :- !. 78'$t_body'([X], filled_in, _, S, SR, 'C'(S,X,SR)) :- !. 79'$t_body'([X|R], filled_in, Last, S, SR, ('C'(S,X,SR1),RB)) :- !, 80 '$t_body'(R, filled_in, Last, SR1, SR, RB). 81'$t_body'({T}, to_fill, last, S, S1, (T, S1=S)) :- !. 82'$t_body'({T}, _, _, S, S, T) :- !. 83'$t_body'((T,R), ToFill, Last, S, SR, (Tt,Rt)) :- !, 84 '$t_body'(T, ToFill, not_last, S, SR1, Tt), 85 '$t_body'(R, ToFill, Last, SR1, SR, Rt). 86'$t_body'((T->R), ToFill, Last, S, SR, (Tt->Rt)) :- !, 87 '$t_body'(T, ToFill, not_last, S, SR1, Tt), 88 '$t_body'(R, ToFill, Last, SR1, SR, Rt). 89'$t_body'(\+T, ToFill, _, S, SR, (Tt->fail ; S=SR)) :- !, 90 '$t_body'(T, ToFill, not_last, S, _, Tt). 91'$t_body'((T;R), _ToFill, _, S, SR, (Tt;Rt)) :- !, 92 '$t_body'(T, _, last, S, SR, Tt), 93 '$t_body'(R, _, last, S, SR, Rt). 94'$t_body'((T|R), _ToFill, _, S, SR, (Tt;Rt)) :- !, 95 '$t_body'(T, _, last, S, SR, Tt), 96 '$t_body'(R, _, last, S, SR, Rt). 97'$t_body'(M:G, ToFill, Last, S, SR, M:NG) :- !, 98 '$t_body'(G, ToFill, Last, S, SR, NG). 99'$t_body'(T, filled_in, _, S, SR, Tt) :- 100 '$extend'([S,SR], T, Tt). 101 102 103 104'$extend'(More, OldT, NewT) :- 105 OldT =.. OldL, 106 lists:append(OldL, More, NewL), 107 NewT =.. NewL. 108 109 110'$t_tidy'(P,P) :- var(P), !. 111'$t_tidy'((P1;P2), (Q1;Q2)) :- !, 112 '$t_tidy'(P1, Q1), 113 '$t_tidy'(P2, Q2). 114'$t_tidy'((P1->P2), (Q1->Q2)) :- !, 115 '$t_tidy'(P1, Q1), 116 '$t_tidy'(P2, Q2). 117'$t_tidy'(((P1,P2),P3), Q) :- 118 '$t_tidy'((P1,(P2,P3)), Q). 119'$t_tidy'((true,P1), Q1) :- !, 120 '$t_tidy'(P1, Q1). 121'$t_tidy'((P1,true), Q1) :- !, 122 '$t_tidy'(P1, Q1). 123'$t_tidy'((P1,P2), (Q1,Q2)) :- !, 124 '$t_tidy'(P1, Q1), 125 '$t_tidy'(P2, Q2). 126'$t_tidy'(A, A). 127 128 129'C'([X|S],X,S). 130 131 132phrase(PhraseDef, WordList) :- 133 phrase(PhraseDef, WordList, []). 134 135 136phrase(P, S0, S) :- 137 var(P), !, 138 '$do_error'(instantiation_error,phrase(P,S0,S)). 139phrase(P, S0, S) :- 140 ( primitive(P), \+ atom(P) ), !, 141 '$do_error'(type_error(callable,P),phrase(P,S0,S)). 142phrase([], S0, S) :- !, 143 S0 = S. 144phrase([H|T], S0, S) :- !, 145 lists:append([H|T], S, S0). 146phrase(Phrase, S0, S) :- 147 '$t_body'(Phrase, _, last, S0, S, Goal), !, 148 '$execute'(Goal). 149 150 151