/* Filename: grammar.pro Programmer: Br. David Carlson Date of creation: April 14, 1988 Revised: December 17, 1999 to run under yap. Description: This program will read sentences from the file grammar.in, and then analyze them, and store their grammatical structure in the grammar.out file. A limited set of grammar rules is used. A limited dictionary of words is used as well. Start the program with the goal: go. */ go :- see('grammar.in'), tell('grammar.out'), doSentences, told, seen. doSentences :- at_end_of_stream, !. doSentences :- get0(StartChar), StartChar \== 32, StartChar \== 10, !, readSentence(StartChar, WordList), process(WordList), doSentences. doSentences :- doSentences. readSentence(StartChar, [Word1| RestWords]) :- readWord(StartChar, Word1, NextChar), restOfSentence(NextChar, RestWords). /* Unlike in trans2.pro, here we return an empty list since we don't want to keep that end of sentence marker. */ restOfSentence(NextChar, []) :- endOfSentence(NextChar), !. restOfSentence(NextChar, [Word| RemainingWords]) :- readWord(NextChar, Word, NextNextChar), restOfSentence(NextNextChar, RemainingWords). /* endOfSentence true for . ! ? */ endOfSentence(46). endOfSentence(33). endOfSentence(63). readWord(StartChar, [LCString | RestCharList], NextChar) :- wordChar(StartChar, LCString), !, get0(NextNextChar), restOfWord(NextNextChar, RestCharList, NextChar). readWord(_, Word, NextChar) :- /* skip blanks, etc at start */ get0(AnotherChar), readWord(AnotherChar, Word, NextChar). wordChar(Ch, Ch) :- Ch =< 122, Ch >= 97. % already a lower case character wordChar(Ch, LowerCh) :- Ch =< 90, Ch >= 65, LowerCh is Ch + 32. wordChar(45, 45). /* The - char */ wordChar(39, 39). /* the ' char */ restOfWord(Char, [LCString| RestCharList], NextChar) :- wordChar(Char, LCString), !, get0(AnotherChar), restOfWord(AnotherChar, RestCharList, NextChar). restOfWord(Char, [], Char). /* char cannot occur in a word */ process(L) :- sentence(L, S), !, printSen(S). process(_) :- nl, write('This sentence cannot be analyzed.'), nl. sentence(L, sen1(NP, VP)) :- append(L1, L2, L), nounphrase(L1, NP), verbphrase(L2, VP), !. sentence(L, sen2(vp2(V, NP, PP))) :- verbphrase(L, vp2(V, NP, PP)). nounphrase([W], np1(n(W))) :- noun(W), !. nounphrase([W], np2(pn(W))) :- pronoun(W), !. nounphrase([W1, W2], np3(det(W1), n(W2))) :- determiner(W1), noun(W2), !. nounphrase([W1, W2, W3], np4(det(W1), ad(W2), n(W3))) :- determiner(W1), adj(W2), noun(W3). verbphrase([W1| L], vp1(v(W1), NP)) :- verb(W1), nounphrase(L, NP), !. verbphrase([W1| L], vp2(v(W1), NP, PP)) :- verb(W1), append(L2, L3, L), nounphrase(L2, NP), prepphrase(L3, PP), !. verbphrase([W1, W2| L], vp3(av(W1), v(W2), NP)) :- auxverb(W1), verb(W2), nounphrase(L, NP), !. verbphrase([W1, W2| L], vp4(av(W1), v(W2), NP, PP)) :- auxverb(W1), verb(W2), append(L2, L3, L), nounphrase(L2, NP), prepphrase(L3, PP). prepphrase([W1| L], pp(pr(W1), NP)) :- prep(W1), nounphrase(L, NP). append([], L, L). append([X|L1], L2, [X|L3]) :- append(L1, L2, L3). printSen(sen1(NP, VP)) :- nl, write('sen('), printnp(NP), write(','), nl, write(' '), printvp(VP), write(')'), nl. printSen(sen2(VP)) :- !, nl, write('sen('), printvp(VP), write(')'), nl. printnp(np1(n(Noun))) :- write('np(n('), writeString(Noun), write('))'). printnp(np2(pn(Pronoun))) :- write('np(pn('), writeString(Pronoun), write('))'). printnp(np3(det(D), n(Noun))) :- write('np(det('), writeString(D), write('), n('), writeString(Noun), write('))'). printnp(np4(det(D), ad(Adj), n(Noun))) :- write('np(det('), writeString(D), write('), ad('), writeString(Adj), write('), n('), writeString(Noun), write('))'). printvp(vp1(v(Verb), NP)) :- write('vp(v('), writeString(Verb), write('), '), printnp(NP), write(')'). printvp(vp2(v(Verb), NP, PP)) :- write('vp(v('), writeString(Verb), write('), '), printnp(NP), write(','), nl, write(' '), printpp(PP), write(')'). printvp(vp3(av(AuxVerb), v(Verb), NP)) :- write('vp(av('), writeString(AuxVerb), write('), v('), writeString(Verb), write('), '), printnp(NP), write(')'). printvp(vp4(av(AuxVerb), v(Verb), NP, PP)) :- write('vp(av('), writeString(AuxVerb), write('), v('), writeString(Verb), write('), '), printnp(NP), write(','), nl, write(' '), printpp(PP), write(')'). printpp(pp(pr(Prep), NP)) :- write('pp(pr('), writeString(Prep), write('), '), printnp(NP), write(')'). writeString([]). writeString([Head | Tail]) :- put(Head), writeString(Tail). noun("computer"). noun("desk"). noun("person"). noun("man"). noun("woman"). noun("boy"). noun("girl"). noun("wife"). noun("husband"). noun("tree"). noun("teacher"). noun("student"). noun("hill"). noun("stream"). noun("yard"). noun("valley"). noun("paper"). noun("pen"). noun("pencil"). noun("subject"). noun("prolog"). noun("class"). noun("computers"). noun("persons"). noun("desks"). noun("men"). noun("women"). noun("boys"). noun("girls") . noun("wives"). noun("husbands"). noun("trees"). noun("teachers"). noun("students"). noun("hills"). noun("streams"). noun("yards"). noun("valleys"). noun("papers"). noun("pens"). noun("pencils"). noun("subjects"). noun("classes"). noun("calculus"). noun("foundation"). noun("foundations"). noun("work"). noun("works"). noun("view"). noun("views"). noun("programming"). noun("example"). noun("examples"). noun("screen"). noun("screens"). noun("color"). noun("colors"). noun("database"). noun("databases"). noun("disk"). noun("disks"). pronoun("i"). pronoun("you"). pronoun("he"). pronoun("she"). pronoun("it"). pronoun("we"). pronoun("they"). pronoun("me"). pronoun("them"). pronoun("her"). pronoun("him"). determiner("the"). determiner("a"). determiner("an"). determiner("that"). determiner("this"). determiner("these"). determiner("those"). determiner("each"). determiner("every"). determiner("all"). determiner("some"). determiner("his"). determiner("her"). determiner("their"). determiner("our"). determiner("your"). determiner("my"). auxverb("can"). auxverb("will"). auxverb("has"). auxverb("had"). auxverb("did"). auxverb("does"). auxverb("is"). auxverb("am"). auxverb("are"). auxverb("was"). auxverb("were"). auxverb("have"). auxverb("do"). auxverb("shall"). auxverb("could"). auxverb("may"). auxverb("might"). auxverb("must"). auxverb("should"). auxverb("would"). verb("is"). verb("has"). verb("are"). verb("have"). verb("run"). verb("runs"). verb("weighs"). verb("weigh"). verb("love"). verb("loves"). verb("hate"). verb("hates"). verb("ran"). verb("weighed"). verb("loved"). verb("hated"). verb("climb"). verb("climbs"). verb("climbed"). verb("write"). verb("writes"). verb("wrote"). verb("send"). verb("sends"). verb("sent"). verb("get"). verb("gets"). verb("got"). verb("gotten"). verb("give"). verb("gives"). verb("gave"). verb("given"). verb("written"). verb("push"). verb("pushes"). verb("pushed"). verb("provide"). verb("provides"). verb("transform"). verb("transforms"). verb("try"). verb("set"). verb("sets"). verb("transformed"). verb("provided"). verb("tries"). verb("tried"). verb("load"). verb("loads"). verb("loaded"). verb("like"). verb("likes"). verb("print"). verb("prints"). verb("printed"). prep("on"). prep("in"). prep("at"). prep("under"). prep("over"). prep("into"). prep("before"). prep("after"). prep("to"). prep("for"). prep("by"). prep("of"). prep("from"). adj("big"). adj("small"). adj("beautiful"). adj("large"). adj("tiny"). adj("hot"). adj("cold"). adj("warm"). adj("red"). adj("yellow"). adj("green"). adj("white"). adj("black"). adj("blue"). adj("orange"). adj("purple"). adj("funny"). adj("sad"). adj("propositional"). adj("hard"). adj("soft"). adj("current").