%%%   Patch pour Quintus à mettre en commentaires si not/2 est déjà défini
% :- op(900,fy, [not]).
% not(X):- \+ X.

% adaptation française des fichiers nations.pro et nations.data 
% du livre "Prolog for Natural Language Processing"

:- consult('listes.pro'), consult('sortie.pro').

phr(Rep) --> np(X,Rep1,Rep), vp(X,Rep1).

np(X,Rep1,Rep) --> det(X,Rep2,Rep1,Rep), n_adj(X,Rep3), relative(X,Rep3,Rep2).
np(X,Rep,Rep)  --> nom_propre(X).
np(X,Rep,Rep)  --> [du],nom_objet(X).

vp(X,Rep) --> verbe_tr(X,Y,Rep1), np(Y,Rep1,Rep).
vp(X,Rep) --> aux(etre), comp(X,_,Rep).

relative(X,Rep1,and(Rep1,Rep2)) -->
        pron_rel, np(Z,Rep3,Rep2), verbe_tr(Z,X,Rep3).
relative(X,Rep1,and(Rep1,Rep2)) -->
        pron_rel, aux(etre), comp(X,Rep2,Rep2).
relative(X,Rep1,and(Rep1,Rep2)) -->
        pron_rel, verbe_tr(X,Y,Rep2), np(Y,_,Rep2).
relative(_,Rep,Rep) --> [].

n_adj(X,Rep) --> nom(X,Rep).
n_adj(X,and(Rep1,Rep2)) --> nom(X,Rep1),adj(X,Rep2).

comp(X,Rep,Rep) --> adj(X,Rep).
comp(X,Rep,Rep) --> [un], nom(X,Rep).
comp(X,Rep,Rep) --> [un], n_adj(X,Rep1), relative(X,Rep1,Rep).

% lexique

nom_propre(jacques) --> [jacques].
nom_propre(guy)     --> [guy].
nom_propre(toni)    --> [toni].
nom_propre(gabriel) -->[gabriel].

nom_objet(oka)      --> [oka].
nom_objet(camembert) --> [camembert].
nom_objet(gruyere) --> [gruyere].

adj(X,suisse(X)) --> [suisse].
adj(X,quebecois(X)) --> [quebecois].
adj(X,francais(X))  --> [francais].

nom(X,professeur(X)) --> [professeur].
nom(X,agronome(X)) --> [agronome].
nom(X,musicien(X)) --> [musicien].

verbe_tr(X,Y,mange(X,Y)) --> [mange].
verbe_tr(X,Y,visite(X,Y)) --> [visite].

aux(etre) --> [est].

det(X,Rep2,Rep1,the(X,Rep2,Rep1)) --> [le].
det(X,Rep2,Rep1,exists(X,Rep2,Rep1)) --> [un].
det(X,Rep2,Rep1,all(X,Rep2,Rep1)) --> [tout].

pron_rel --> [qui].
pron_rel --> [que].

% verification
test(Text) :- phr(Rep,Text,[]), pp(Rep), nl, evaluer(Rep). 

% creation de nouveaux faits
fait(Text) :- phr(Rep,Text,[]), pp(Rep), nl, essayer_d_affirmer(Rep).

% questions
demander(Text) :- phr(Rep,Text,[]), evaluer(Rep). 

%%%
%%          evaluation
%%%
evaluer(exists(_,P,Q)) :- !,evaluer(P), evaluer(Q).
evaluer(the(_,P,Q))    :- !,evaluer(P), !, evaluer(Q). % premiere solution
evaluer(and(P,Q))      :- !,evaluer(P), evaluer(Q).
evaluer(all(X,P,Q))    :- !,not(evaluer(exists(X,P,not(Q)))).
evaluer(Rep) :- call(Rep).                             % cas facile...

essayer_d_affirmer(exists(_,_,Q)) :- mauvais(Q).
essayer_d_affirmer(exists(X,P,Q)) :-
        not(evaluer(exists(X,P,Q))), traduire(P,P1), assert(':-'(Q,P1)),
        Q=..[Qname|_], write('nouvelle clause '),write(Qname), write('ajoutee').
essayer_d_affirmer(Rep) :- evaluer(Rep), write('deja connu').
essayer_d_affirmer(Rep) :- not(evaluer(Rep)), assert(Rep), write('du nouveau').

mauvais(and(_))        :- write('tete complexe').
mauvais(exists(_,_,_)) :- write('existentiel').
         
traduire(and(V,W),','(V1,W1)) :- traduire(V,V1), traduire(W,W1).
traduire(V,V).

%%% 
%%   Base de données
%%%
suisse(jacques).
suisse(toni).
quebecois(guy).
francais(gabriel).

professeur(jacques).
professeur(guy).
agronome(toni).
musicien(gabriel).

prefere(suisse,gruyere).
prefere(quebecois,oka).
prefere(francais,camembert).

habite(suisse,suisse).
habite(quebecois,quebec).
habite(francais,france).
habite(Personne,Pays) :- nationalite(N,Personne), habite(N,Pays).

presde(suisse,france).
presde(france,suisse).

nationalite(N,X) :- dans(N,[suisse,quebecois,francais]),
                    P=..[N,X], call(P).

:- dynamic mange/2, visite/2.
mange(X,Y) :- prefere(Nationalite,Y), P=..[Nationalite,X], call(P).
visite(X,Y) :- presde(CX,CY), habite(X,CX), habite(Y,CY).

/************     exemples
| ?- test([guy,visite,jacques]).
visite(guy,
       jacques)
no

| ?- fait([guy,visite,jacques]).
visite(guy,
       jacques)
du nouveau
yes

| ?- test([le,professeur,que,guy,visite,est,suisse]).
the(_7150,
    and(professeur(_7150),
        visite(guy,
               _7150)),
    suisse(_7150))
yes

| ?- test([guy,mange,du,oka]).
mange(guy,
      oka)
yes

| ?- test([tout,agronome,qui,est,suisse,mange,du,gruyere]).
all(_6960,
    and(agronome(_6960),
        suisse(_6960)),
    mange(_6960,
          gruyere))
yes

| ?- test([un,agronome,est,quebecois]).
exists(_6908,
       agronome(_6908),
       quebecois(_6908))
no

| ?- test([tout,agronome,qui,est,quebecois,mange,du,gruyere]).
all(_6960,
    and(agronome(_6960),
        quebecois(_6960)),
    mange(_6960,
          gruyere))
yes   %% eh oui car il n'y a pas d'agronome quebecois...

************/