1/*  Copyright 1986-2020 David H. D. Warren and Fernando C. N. Pereira
    2
    3    Permission is hereby granted, free of charge, to any person obtaining a
    4    copy of this software and associated documentation files (the
    5    "Software"), to deal in the Software without restriction, including
    6    without limitation the rights to use, copy, modify, merge, publish,
    7    distribute, sublicense, and/or sell copies of the Software, and to
    8    permit persons to whom the Software is furnished to do so, subject to
    9    the following conditions:
   10
   11    The above copyright notice and this permission notice shall be included
   12    in all copies or substantial portions of the Software.
   13
   14    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
   15    OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
   16    MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
   17    IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
   18    CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
   19    TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
   20    SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
   21*/
   22
   23% Modes
   24
   25:- mode word(+).   26:- mode ~(+).   27:- mode conj(+).   28:- mode adverb(+).   29:- mode sup_adj(+,?).   30:- mode rel_adj(+,?).   31:- mode adj(+,?).   32:- mode name_template(+,-).   33:- mode name(+).   34:- mode terminator(+,?).   35:- mode pers_pron(+,?,?,?,?).   36:- mode poss_pron(+,?,?,?).   37:- mode rel_pron(+,?).   38:- mode regular_past(+,?).   39:- mode regular_pres(+).   40:- mode verb_root(+).   41:- mode verb_form(+,?,?,?).   42:- mode noun_sin(+).   43:- mode noun_plu(+,?).   44:- mode noun_form(+,?,?).   45:- mode prep(+).   46:- mode quantifier_pron(+,?,?).   47:- mode tr_number(+,?).   48:- mode number(+,?,?).   49:- mode det(+,?,?,?).   50:- mode int_art(+,?,?,?).   51:- mode int_pron(+,?).   52
   53% =================================================================
   54% General Dictionary
   55
   56word(Word) :- ~(Word).
   57word(Word) :- conj(Word).
   58word(Word) :- adverb(Word).
   59word(Word) :- sup_adj(Word,_).
   60word(Word) :- rel_adj(Word,_).
   61word(Word) :- adj(Word,_).
   62word(Word) :- name(Word).
   63word(Word) :- terminator(Word,_).
   64word(Word) :- pers_pron(Word,_,_,_,_).
   65word(Word) :- poss_pron(Word,_,_,_).
   66word(Word) :- rel_pron(Word,_).
   67word(Word) :- verb_form(Word,_,_,_).
   68word(Word) :- noun_form(Word,_,_).
   69word(Word) :- prep(Word).
   70word(Word) :- quantifier_pron(Word,_,_).
   71word(Word) :- number(Word,_,_).
   72word(Word) :- det(Word,_,_,_).
   73word(Word) :- int_art(Word,_,_,_).
   74word(Word) :- int_pron(Word,_).
   75word(Word) :- loc_pred(Word,_).
   76
   77~how.
   78~whose.
   79~there.
   80~of.
   81~('''').
   82~(',').
   83~s.
   84~than.
   85~at.
   86~the.
   87~not.
   88~(as).
   89~that.
   90~less.
   91~more.
   92~least.
   93~most.
   94~many.
   95~where.
   96~when.
   97conj(and).
   98conj(or).
   99
  100int_pron(what,undef).
  101int_pron(which,undef).
  102int_pron(who,subj).
  103int_pron(whom,compl).
  104
  105int_art(what,X,_,int_det(X)).
  106int_art(which,X,_,int_det(X)).
  107
  108det(the,No,the(No),def).
  109det(a,sin,a,indef).
  110det(an,sin,a,indef).
  111det(every,sin,every,indef).
  112det(some,_,some,indef).
  113det(any,_,any,indef).
  114det(all,plu,all,indef).
  115det(each,sin,each,indef).
  116det(no,_,no,indef).
  117
  118number(W,I,Nb) :-
  119   tr_number(W,I),
  120   ag_number(I,Nb).
  121
  122tr_number(nb(I),I).
  123tr_number(one,1).
  124tr_number(two,2).
  125tr_number(three,3).
  126tr_number(four,4).
  127tr_number(five,5).
  128tr_number(six,6).
  129tr_number(seven,7).
  130tr_number(eight,8).
  131tr_number(nine,9).
  132tr_number(ten,10).
  133
  134ag_number(1,sin).
  135ag_number(N,plu) :- N>1.
  136
  137quantifier_pron(everybody,every,person).
  138quantifier_pron(everyone,every,person).
  139quantifier_pron(everything,every,thing).
  140quantifier_pron(somebody,some,person).
  141quantifier_pron(someone,some,person).
  142quantifier_pron(something,some,thing).
  143quantifier_pron(anybody,any,person).
  144quantifier_pron(anyone,any,person).
  145quantifier_pron(anything,any,thing).
  146quantifier_pron(nobody,no,person).
  147quantifier_pron(nothing,no,thing).
  148
  149prep(as).
  150prep(at).
  151prep(of).
  152prep(to).
  153prep(by).
  154prep(with).
  155prep(in).
  156prep(on).
  157prep(from).
  158prep(into).
  159prep(through).
  160
  161noun_form(Plu,Sin,plu) :- noun_plu(Plu,Sin).
  162noun_form(Sin,Sin,sin) :- noun_sin(Sin).
  163
  164verb_form(V,V,inf,_) :- verb_root(V).
  165verb_form(V,V,pres+fin,Agmt) :-
  166   regular_pres(V),
  167   root_form(Agmt),
  168   verb_root(V).
  169verb_form(Past,Root,past+_,_) :-
  170   regular_past(Past,Root).
  171
  172root_form(1+sin).
  173root_form(2+_).
  174root_form(1+plu).
  175root_form(3+plu).
  176
  177verb_root(be).
  178verb_root(have).
  179verb_root(do).
  180
  181verb_form(am,be,pres+fin,1+sin).
  182verb_form(are,be,pres+fin,2+sin).
  183verb_form(is,be,pres+fin,3+sin).
  184verb_form(are,be,pres+fin,_+plu).
  185verb_form(was,be,past+fin,1+sin).
  186verb_form(were,be,past+fin,2+sin).
  187verb_form(was,be,past+fin,3+sin).
  188verb_form(were,be,past+fin,_+plu).
  189verb_form(been,be,past+part,_).
  190verb_form(being,be,pres+part,_).
  191
  192verb_type(be,aux+be).
  193
  194regular_pres(have).
  195
  196regular_past(had,have).
  197
  198verb_form(has,have,pres+fin,3+sin).
  199verb_form(having,have,pres+part,_).
  200
  201verb_type(have,aux+have).
  202
  203regular_pres(do).
  204
  205verb_form(does,do,pres+fin,3+sin).
  206verb_form(did,do,past+fin,_).
  207verb_form(doing,do,pres+part,_).
  208verb_form(done,do,past+part,_).
  209
  210verb_type(do,aux+ditrans).
  211
  212rel_pron(who,subj).
  213rel_pron(whom,compl).
  214rel_pron(which,undef).
  215
  216poss_pron(my,_,1,sin).
  217poss_pron(your,_,2,_).
  218poss_pron(his,masc,3,sin).
  219poss_pron(her,fem,3,sin).
  220poss_pron(its,neut,3,sin).
  221poss_pron(our,_,1,plu).
  222poss_pron(their,_,3,plu).
  223
  224pers_pron(i,_,1,sin,subj).
  225pers_pron(you,_,2,_,_).
  226pers_pron(he,masc,3,sin,subj).
  227pers_pron(she,fem,3,sin,subj).
  228pers_pron(it,neut,3,sin,_).
  229pers_pron(we,_,1,plu,subj).
  230pers_pron(them,_,3,plu,subj).
  231pers_pron(me,_,1,sin,compl(_)).
  232pers_pron(him,masc,3,sin,compl(_)).
  233pers_pron(her,fem,3,sin,compl(_)).
  234pers_pron(us,_,1,plu,compl(_)).
  235pers_pron(them,_,3,plu,compl(_)).
  236
  237terminator(.,_).
  238terminator(?,?).
  239terminator(!,!).
  240
  241name(Name) :-
  242   name_template(Name,_), !.
  243
  244% =================================================================
  245% Specialised Dictionary
  246
  247loc_pred(east,prep(eastof)).
  248loc_pred(west,prep(westof)).
  249loc_pred(north,prep(northof)).
  250loc_pred(south,prep(southof)).
  251
  252adj(minimum,restr).
  253adj(maximum,restr).
  254adj(average,restr).
  255adj(total,restr).
  256adj(african,restr).
  257adj(american,restr).
  258adj(asian,restr).
  259adj(european,restr).
  260adj(great,quant).
  261adj(big,quant).
  262adj(small,quant).
  263adj(large,quant).
  264adj(old,quant).
  265adj(new,quant).
  266adj(populous,quant).
  267
  268rel_adj(greater,great).
  269rel_adj(less,small).
  270rel_adj(bigger,big).
  271rel_adj(smaller,small).
  272rel_adj(larger,large).
  273rel_adj(older,old).
  274rel_adj(newer,new).
  275
  276sup_adj(biggest,big).
  277sup_adj(smallest,small).
  278sup_adj(largest,large).
  279sup_adj(oldest,old).
  280sup_adj(newest,new).
  281
  282noun_form(proportion,proportion,_).
  283noun_form(percentage,percentage,_).
  284
  285noun_sin(average).
  286noun_sin(total).
  287noun_sin(sum).
  288noun_sin(degree).
  289noun_sin(sqmile).
  290noun_sin(ksqmile).
  291noun_sin(thousand).
  292noun_sin(million).
  293noun_sin(time).
  294noun_sin(place).
  295noun_sin(area).
  296noun_sin(capital).
  297noun_sin(city).
  298noun_sin(continent).
  299noun_sin(country).
  300noun_sin(latitude).
  301noun_sin(longitude).
  302noun_sin(ocean).
  303noun_sin(person).
  304noun_sin(population).
  305noun_sin(region).
  306noun_sin(river).
  307noun_sin(sea).
  308noun_sin(seamass).
  309noun_sin(number).
  310
  311noun_plu(averages,average).
  312noun_plu(totals,total).
  313noun_plu(sums,sum).
  314noun_plu(degrees,degree).
  315noun_plu(sqmiles,sqmile).
  316noun_plu(ksqmiles,ksqmile).
  317noun_plu(million,million).
  318noun_plu(thousand,thousand).
  319noun_plu(times,time).
  320noun_plu(places,place).
  321noun_plu(areas,area).
  322noun_plu(capitals,capital).
  323noun_plu(cities,city).
  324noun_plu(continents,continent).
  325noun_plu(countries,country).
  326noun_plu(latitudes,latitude).
  327noun_plu(longitudes,longitude).
  328noun_plu(oceans,ocean).
  329noun_plu(persons,person).  noun_plu(people,person).
  330noun_plu(populations,population).
  331noun_plu(regions,region).
  332noun_plu(rivers,river).
  333noun_plu(seas,sea).
  334noun_plu(seamasses,seamass).
  335noun_plu(numbers,number).
  336
  337verb_root(border).
  338verb_root(contain).
  339verb_root(drain).
  340verb_root(exceed).
  341verb_root(flow).
  342verb_root(rise).
  343
  344regular_pres(rise).
  345
  346verb_form(rises,rise,pres+fin,3+sin).
  347verb_form(rose,rise,past+fin,_).
  348verb_form(risen,rise,past+part,_).
  349
  350regular_pres(border).
  351
  352regular_past(bordered,border).
  353
  354verb_form(borders,border,pres+fin,3+sin).
  355verb_form(bordering,border,pres+part,_).
  356
  357regular_pres(contain).
  358
  359regular_past(contained,contain).
  360
  361verb_form(contains,contain,pres+fin,3+sin).
  362verb_form(containing,contain,pres+part,_).
  363
  364regular_pres(drain).
  365
  366regular_past(drained,drain).
  367
  368verb_form(drains,drain,pres+fin,3+sin).
  369verb_form(draining,drain,pres+part,_).
  370
  371regular_pres(exceed).
  372
  373regular_past(exceeded,exceed).
  374
  375verb_form(exceeds,exceed,pres+fin,3+sin).
  376verb_form(exceeding,exceed,pres+part,_).
  377
  378verb_type(rise,main+intrans).
  379verb_type(border,main+trans).
  380verb_type(contain,main+trans).
  381verb_type(drain,main+intrans).
  382verb_type(exceed,main+trans).
  383
  384regular_pres(flow).
  385
  386regular_past(flowed,flow).
  387
  388verb_form(flows,flow,pres+fin,3+sin).
  389verb_form(flowing,flow,pres+part,_).
  390
  391verb_type(flow,main+intrans).
  392
  393adverb(yesterday).
  394adverb(tomorrow)