%%% A SIMPLE GRAMMAR FOR A FRAGMENT OF GERMAN

% THE GRAMMAR RULES

% sentences
%   a sentences is either a simple sentence or a main sentence together with
%   an auxiliary sentence
sD(M) --> s2D(M, middle).
sD(because(M1,M2)) --> s2D(M1, middle), [weil], s2D(M2, end).
sD(because(M1,M2)) --> [weil], s2D(M2, end), s2D(M1, front).

%   front/middle/end denotes position of verb (middle for normal sentences)
%   ATTENTION: the meaning of subject noun phrases is passed as an argument
%   to the vp (M1 in the above rule), so that the verb phrase can construct
%   the meaning of the sentence, including the meaning of the subject phrase.
s2D(M2,front)  --> parseD(Verb), npD(M1,A,nom), vpD(M1,M2,Verb,Part,A), parseD(Part).
s2D(M2,middle) --> npD(M1,A,nom), parseD(Verb), vpD(M1,M2,Verb,Part,A), parseD(Part).
s2D(M2,end)    --> npD(M1,A,nom), vpD(M1,M2,Verb,Part,A), parseD(Part), parseD(Verb).

% noun phrases
npD(M1,Agr,Case) --> np1D(M1,Agr,_,Case). % gender does not matter

%   noun phrases with a relative clause
%   gender of the noun phrase must match gender of the relative pronoun.
%   All agreements must match.
npD((M1,M2),A,Case) --> np1D(M1,A,G,Case), relativeD(A,G), vpD(M1,M2,Verb,Part,A), Part, Verb.

%   simple noun phrases
np1D(a(Agr,M1),Agr,G,Case)        --> articleD(indef,Agr,G,Case), nounD(M1,Agr,G,Case).
np1D(the(Agr,M1),Agr,G,Case)      --> articleD(def,Agr,G,Case),   nounD(M1,Agr,G,Case).
np1D((a(Agr,M2),M1),Agr,G,Case)   --> articleD(indef,Agr,G,Case), adjD(M1,indef,Agr,G,Case), nounD(M2,Agr,G,Case).
np1D((the(Agr,M2),M1),Agr,G,Case) --> articleD(def,Agr,G,Case),   adjD(M1,def,Agr,G,Case),   nounD(M2,Agr,G,Case).
np1D((the(s3,M2),M1),s3,G,Case)   --> articleD(def,s3,G,Case),    adjD(M1,def,s3,G,Case),    nameD(M2,G,Case).
np1D(M1,Agr,G,Case)               --> pronounD(M1,Agr,G,Case).
np1D(M1,s3,G,Case)                --> nameD(M1,G,Case).

% verb phrases
%   verb phrases only produce the complement. They contain two features, Verb and Part,
%   that contain the verb and participle (if any), which are introduced at the appropriate
%   locations by the "caller" of vpD.

% Following are rules for intransitive verbs, verbs with one NP complement,
% verbs with an adjective complement and verbs with two complements (in any order).
vpD(S,[M1,S],Verb,Part,Agr)       --> vp2D(M1,Verb,Part,Agr,-none).
vpD(S,[M1,S,M2],Verb,Part,Agr)    --> vp2D(M1,Verb,Part,Agr,-np:C), npD(M2,_,C).
vpD(S,[M1,S,M2],Verb,Part,Agr)    --> vp2D(M1,Verb,Part,Agr,-ap), adjD(M2,base,na,na,na).
vpD(S,[M1,S,M2,M3],Verb,Part,Agr) --> vp2D(M1,Verb,Part,Agr,-np:C1:C2), npD(M2,_,C1), npD(M3,_,C2).
vpD(S,[M1,S,M2,M3],Verb,Part,Agr) --> vp2D(M1,Verb,Part,Agr,-np:C1:C2), npD(M3,_,C2), npD(M2,_,C1).

% base verb phrases (in the four tenses required)
vp2D(M1,Verb,[],Agr,Objects)       --> [], {verbD(M1,Agr,Objects,Verb,[])}. % no participle
vp2D((T,M1),Verb,Part,Agr,Objects) --> [], {verbbaseD(M1,P,Objects,Part,[]), auxD(P,Agr,T,Verb,[])}.

% THE LEXICON

% German morphology is complicated, and when the number of words is
% not very high, it is much easier to give all word forms explicitly.

% articles
%   They are either definite or indefinite and distinguish gender, agreement,
%   and case.
articleD(def,s3,male,nom)      --> [der].
articleD(def,s3,male,dat)      --> [dem].
articleD(def,s3,male,acc)      --> [den].
articleD(def,s3,female,Case)   --> [die],   {eitherD(Case,nom,acc)}.
articleD(def,s3,female,dat)    --> [der].
articleD(def,s3,neutral,Case)  --> [das],   {eitherD(Case,nom,acc)}.
articleD(def,s3,neutral,dat)   --> [dem].
articleD(def,p3,none,Case)     --> [die],   {eitherD(Case,nom,acc)}.
articleD(def,p3,none,dat)      --> [den].

articleD(indef,s3,A,nom)       --> [ein],   {eitherD(A,male,neutral)}.
articleD(indef,s3,A,dat)       --> [einem], {eitherD(A,male,neutral)}.
articleD(indef,s3,male,acc)    --> [einen].
articleD(indef,s3,neutral,acc) --> [ein].
articleD(indef,s3,female,Case) --> [eine],  {eitherD(Case,nom,acc)}.
articleD(indef,s3,female,dat)  --> [einer].
articleD(indef,p3,none,Case)   --> [],      {caseD(Case)}.

% relative pronouns
%   They are a bit like articles, but not quite.
%   They depend on gender and agreement.
%   If they are not 3rd person, we add the pronoun to the relative clause.
%   This might sound a bit awkward, but sentence like "Er sieht mich, der schlafe"
%   is blatantly wrong, and "Er sieht mich, der schläft" is not really better.
relativeD(Third,G)   --> articleD(def,Third,G,nom). % 3s/3p
relativeD(s1,male)   --> [der, ich].
relativeD(s1,female) --> [die, ich].
relativeD(s2,male)   --> [der, du].
relativeD(s2,male)   --> [die, du].
relativeD(p1,male)   --> [die, wir].
relativeD(p2,male)   --> [die, ihr].

% verbs
%   Verb forms need to match tense, agreement and complement.
%   We also need to store information whether their perfect forms are built
%   using "sein" or "haben".
%   Morphological rules could be used for the different imperfect forms,
%   since they are quite regular, given the imperfect base form.
%   However, it does not seem worthwhile, especially since there are a
%   lot of irregularities for the present tense forms.

%   to see
verbD((pres,see1),s1,-np:acc)  --> [sehe].
verbD((pres,see1),s2,-np:acc)  --> [siehst].
verbD((pres,see1),s3,-np:acc)  --> [sieht].
verbD((pres,see1),Agr,-np:acc) --> [sehen],     {eitherD(Agr,p1,p3)}.
verbD((pres,see1),p2,-np:acc)  --> [seht].
verbD((past,see1),Agr,-np:acc) --> [sah],       {eitherD(Agr,s1,s3)}.
verbD((past,see1),s2,-np:acc)  --> [sahst].
verbD((past,see1),Agr,-np:acc) --> [sahen],     {eitherD(Agr,p1,p3)}.
verbD((past,see1),p2,-np:acc)  --> [saht].
verbbaseD(see1,haben,-np:acc)  --> [gesehen].

%   to sleep
verbD((pres,sleep1),s1,-none)  --> [schlafe].
verbD((pres,sleep1),s2,-none)  --> [schläfst].
verbD((pres,sleep1),s3,-none)  --> [schläft].
verbD((pres,sleep1),Agr,-none) --> [schlafen],  {eitherD(Agr,p1,p3)}.
verbD((pres,sleep1),p2,-none)  --> [schlaft].
verbD((past,sleep1),Agr,-none) --> [schlief],   {eitherD(Agr,s1,s3)}.
verbD((past,sleep1),s2,-none)  --> [schliefst].
verbD((past,sleep1),Agr,-none) --> [schliefen], {eitherD(Agr,p1,p3)}.
verbD((past,sleep1),p2,-none)  --> [schlieft].
verbbaseD(sleep1,haben,-none)  --> [geschlafen].

%   to give
verbD((pres,give1),s1,-np:dat:acc)  --> [gebe].
verbD((pres,give1),s2,-np:dat:acc)  --> [gibst].
verbD((pres,give1),s3,-np:dat:acc)  --> [gibt].
verbD((pres,give1),Agr,-np:dat:acc) --> [geben], {eitherD(Agr,p1,p3)}.
verbD((pres,give1),p2,-np:dat:acc)  --> [gebt].
verbD((past,give1),Agr,-np:dat:acc) --> [gab],   {eitherD(Agr,s1,s3)}.
verbD((past,give1),s2,-np:dat:acc)  --> [gabst].
verbD((past,give1),Agr,-np:dat:acc) --> [gaben], {eitherD(Agr,p1,p3)}.
verbD((past,give1),p2,-np:dat:acc)  --> [gabt].
verbbaseD(give1,haben,-np:dat:acc)  --> [gegeben].

%   to be
verbD((pres,be1),s1,Comp)  --> [bin],     {eitherD(Comp, -ap, -np:nom)}.
verbD((pres,be1),s2,Comp)  --> [bist],    {eitherD(Comp, -ap, -np:nom)}.
verbD((pres,be1),s3,Comp)  --> [ist],     {eitherD(Comp, -ap, -np:nom)}.
verbD((pres,be1),Agr,Comp) --> [sind],    {eitherD(Comp, -ap, -np:nom), eitherD(Agr,p1,p3)}.
verbD((pres,be1),p2,Comp)  --> [seid],    {eitherD(Comp, -ap, -np:nom)}.
verbD((past,be1),Agr,Comp) --> [war],     {eitherD(Comp, -ap, -np:nom), eitherD(Agr,s1,s3)}.
verbD((past,be1),s2,Comp)  --> [warst],   {eitherD(Comp, -ap, -np:nom)}.
verbD((past,be1),Agr,Comp) --> [waren],   {eitherD(Comp, -ap, -np:nom), eitherD(Agr,p1,p3)}.
verbD((past,be1),p2,Comp)  --> [wart],    {eitherD(Comp, -ap, -np:nom)}.
verbbaseD(be1,sein,Comp)   --> [gewesen], {eitherD(Comp, -ap, -np:nom)}.

% auxiliaries for perfect and plusquamperfect
%   They have an id, agreement and tense associated.

%   to be
auxD(sein,Agr,perf) --> verbD((pres,be1),Agr,-np:nom). % look up above
auxD(sein,Agr,plus) --> verbD((past,be1),Agr,-np:nom). % look up above

%   to have
auxD(haben,s1,perf)  --> [habe].
auxD(haben,s2,perf)  --> [hast].
auxD(haben,s3,perf)  --> [hat].
auxD(haben,Agr,perf) --> [haben],  {eitherD(Agr,p1,p3)}.
auxD(haben,p2,perf)  --> [habt].
auxD(haben,Agr,plus) --> [hatte],  {eitherD(Agr,s1,s3)}.
auxD(haben,s2,plus)  --> [hattest].
auxD(haben,Agr,plus) --> [hatten], {eitherD(Agr,p1,p3)}.
auxD(haben,p2,plus)  --> [hattet].

% pronouns
%   Those have the usual parameters: agreement, gender, and case.
%   nominative forms of pronouns
pronounD(me1,  s1,G,      nom) --> [ich],  {eitherD(G,male,female)}.
pronounD(you1, s2,G,      nom) --> [du],   {eitherD(G,male,female)}.
pronounD(he1,  s3,male,   nom) --> [er].
pronounD(she1, s3,female, nom) --> [sie].
pronounD(it1,  s3,neutral,nom) --> [es].
pronounD(we1,  p1,none,   nom) --> [wir].
pronounD(you2, p2,none,   nom) --> [ihr].
pronounD(you3, p3,none,   nom) --> [sie].
pronounD(they1,p3,none,   nom) --> [sie].
pronounD(they2,p3,none,   nom) --> [sie]. % non-person 3rd plural
%   dative forms of pronouns
pronounD(me1,  s1,G,      dat) --> [mir],  {eitherD(G,male,female)}.
pronounD(you1, s2,G,      dat) --> [dir],  {eitherD(G,male,female)}.
pronounD(he1,  s3,male,   dat) --> [ihm].
pronounD(she1, s3,female, dat) --> [ihr].
pronounD(it1,  s3,neutral,dat) --> [ihm].
pronounD(we1,  p1,none,   dat) --> [uns].
pronounD(you2, p2,none,   dat) --> [euch].
pronounD(you3, p3,none,   dat) --> [ihnen].
pronounD(they1,p3,none,   dat) --> [ihnen].
pronounD(they2,p3,none,   dat) --> [ihnen]. % non-person 3rd plural
%   accusative forms of pronouns
pronounD(me1,  s1,G,      acc) --> [mich], {eitherD(G,male,female)}.
pronounD(you1, s2,G,      acc) --> [dich], {eitherD(G,male,female)}.
pronounD(he1,  s3,male,   acc) --> [ihn].
pronounD(she1, s3,female, acc) --> [sie].
pronounD(it1,  s3,neutral,acc) --> [es].
pronounD(we1,  p1,none,   acc) --> [uns].
pronounD(you2, p2,none,   acc) --> [euch].
pronounD(you3, p3,none,   acc) --> [sie].
pronounD(they1,p3,none,   acc) --> [sie].
pronounD(they2,p3,none,   acc) --> [sie]. % non-person 3rd plural

% adjectives
%   We distinguish definite/indefinite, agreement (numerus), gender,
%   and case. There are lots and lots of different forms here, and
%   there is a lot of regularity to exploit.
%   We save a lot of work by using morphological rules.

adjD(M,base,na,na,na)           --> [W],      {adjBaseD(M,W)}.
adjD(M,def,s3,male,nom)         --> [W, -e],  {adjBaseD(M,W)}.
adjD(M,def,s3,female,nom)       --> [W, -e],  {adjBaseD(M,W)}.
adjD(M,def,s3,neutral,nom)      --> [W, -e],  {adjBaseD(M,W)}.
adjD(M,def,p3,none,nom)         --> [W, -en], {adjBaseD(M,W)}.
adjD(M,indef,s3,male,nom)       --> [W, -er], {adjBaseD(M,W)}.
adjD(M,indef,s3,female,nom)     --> [W, -e],  {adjBaseD(M,W)}.
adjD(M,indef,s3,neutral,nom)    --> [W, -es], {adjBaseD(M,W)}.
adjD(M,indef,p3,none,nom)       --> [W, -e],  {adjBaseD(M,W)}.
adjD(M,DefIndef,s3,male,dat)    --> [W, -en], {adjBaseD(M,W), eitherD(DefIndef,def,indef)}.
adjD(M,DefIndef,s3,female,dat)  --> [W, -en], {adjBaseD(M,W), eitherD(DefIndef,def,indef)}.
adjD(M,DefIndef,s3,neutral,dat) --> [W, -en], {adjBaseD(M,W), eitherD(DefIndef,def,indef)}.
adjD(M,DefIndef,p3,none,dat)    --> [W, -en], {adjBaseD(M,W), eitherD(DefIndef,def,indef)}.
adjD(M,def,s3,male,acc)         --> [W, -en], {adjBaseD(M,W)}.
adjD(M,def,s3,female,acc)       --> [W, -e],  {adjBaseD(M,W)}.
adjD(M,def,s3,neutral,acc)      --> [W, -e],  {adjBaseD(M,W)}.
adjD(M,def,p3,none,acc)         --> [W, -en], {adjBaseD(M,W)}.
adjD(M,indef,s3,male,acc)       --> [W, -en], {adjBaseD(M,W)}.
adjD(M,indef,s3,female,acc)     --> [W, -e],  {adjBaseD(M,W)}.
adjD(M,indef,s3,neutral,acc)    --> [W, -es], {adjBaseD(M,W)}.
adjD(M,indef,p3,none,acc)       --> [W, -e],  {adjBaseD(M,W)}.

adjBaseD(blue1,     blau).
adjBaseD(wonderful1,wundervoll).
adjBaseD(beautiful1,schön).
adjBaseD(small1,    klein).
adjBaseD(old1,      alt).

% nouns
%   They have to match agreement and case and forward their gender information.

%   the noun "woman"
nounD(woman1,s3,female,Case)          --> [frau],          {caseD(Case)}.
nounD(woman1,p3,none,Case)            --> [frauen],        {caseD(Case)}.
%   the noun "man"
nounD(man1,s3,male,Case)              --> [mann],          {caseD(Case)}.
nounD(man1,p3,none,Case)              --> [männer],        {eitherD(Case,nom,acc)}.
nounD(man1,p3,none,dat)               --> [männern].
%   the noun "check"
nounD(check1,s3,male,Case)            --> [scheck],        {caseD(Case)}.
nounD(check1,p3,none,Case)            --> [schecks],       {caseD(Case)}.
%   the noun "cellular phone"
nounD(cellularphone1,s3,neutral,Case) --> [handy],         {caseD(Case)}.
nounD(cellularphone1,p3,none,Case)    --> [handys],        {caseD(Case)}.
%   more official word for "cellular phone"
nounD(cellularphone1,s3,neutral,Case) --> [mobiltelefon],  {caseD(Case)}.
nounD(cellularphone1,p3,none,Case)    --> [mobiltelefone], {eitherD(Case,nom,acc)}.
nounD(cellularphone1,p3,none,dat)     --> [mobiltelefonen].

% names
%   We do distinguish cases for names since this were important if we
%   included genitive. Luckily, we don't need it, so this is easy.
nameD(name(eva),female,Case) --> [eva], {caseD(Case)}.
nameD(name(uta),female,Case) --> [uta], {caseD(Case)}.
nameD(name(bob),male,Case)   --> [bob], {caseD(Case)}.
nameD(name(uwe),male,Case)   --> [uwe], {caseD(Case)}.

%% AUXILIARY PREDICATES

caseD(nom).
caseD(dat).
caseD(acc). % lucky we don't need case(gen).

eitherD(A,_,A).
eitherD(A,A,_).

?- use_module(library(lists)). % append
parseD(A, S, T) :- append(A, T, S).

% The following is needed to solve a problem caused by the combination of
% relative sentences ("the man _who_sleeps_ is cool") and the production
% of meanings of sentences by passing the meaning of the NP as a parameter
% to the VP. When synthesizing sentences from the meanings, the npD rules
% are called with all variables unbound, and with relative sentences this
% leads to infinite loops. The block declaration states that the npD rules
% are called only when either the meaning or the sequence of sentences
% is bound to something.

:- block parseD(-,-,-).
:- block npD(-,?,?,-,?).

%% Example queries

% ?- sD(M,[ich,schlafe,weil,ich,alt,bin],[]).
% ?- sD(because([(pres,sleep1),me1],[(pres,be1),me1,old1]), S, []).
% ?- sD([(pres,see1),name(bob),((the(s3,name(eva)),beautiful1),[(pres,give1),
%       (the(s3,name(eva)),beautiful1),me1,a(s3,cellularphone1)])], S, []).