msyds/comp-syntax-gu-mlt
1
0
Fork 0
forked from GitHub/comp-syntax-gu-mlt
Code Pull Requests Activity

first version of the lab material in place

Browse Source
This commit is contained in:
aarneranta
2021-03-24 09:14:41 +01:00
parent 040c93bddf
commit 7afba566d5
27 changed files with 2514 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

56
lab2/README.md Normal file
View File

@@ -0,0 +1,56 @@
# Lab 2: Multilingual generation and translation
This lab corresponds to Chapters 5 to 9 of the Notes, but follows them only loosely.
Therefore we will structure it according to the exercise sessions
rather than chapters.
The abstract syntax is given in the subdirectory grammars/abstract/
The compulsory lab assignment has two alternatives:
1. Complete MiniLang for your language of choice
2. Complete MicroLang + application (Doctor) for your language of choice
If you want to work on the Mini grammar you can ignore everything about the Micro grammar and just work on the corresponding Mini file instead
## Session 5
1. Design a morphology for the main lexical types (N, A, V) with parameters and a couple of paradigms.
2. Test it by implementing the lexicon in the MicroLang module. You need to define lincat N,A,V,V2 as well as the paradigms in MicroResource.
*To deliver*: the lexicon part of files MicroGrammarX.gf and MicroResourceX.gf for your language of choice X. Follow the structure of MicroGrammarEng and MicroResourceEng when preparing these.
## Session 6
1. Define the linearization types of main phrasal categories - the remaining categories in MicroLang.
2. Define the rest of the linearization rules in MicroLang.
*To deliver*: MicroLangX and MicroResourceX for your language of choice, with the lexicon part from Session 5 completed with syntax part.
## Session 7
1. Complete the rest of the definitions of RGL categories and functions in MiniGrammar.
2. Add concrete UD labels.
3. Generate a synthetic UD treebank. The simplest way to do this from the
GF shell is random generation; change english/MiniLangEng.labels to
the labels of your own language:
gr -cat=Utt -number=22 -depth=6 | vd -output=conll
-abslabels=abstract/MiniLang.labels -cnclabels=english/MiniLangEng.labels
*Hint*: if your language is already in the standard RGL, you can implement it easily by making a copy of the files in grammar/swedish.
But use this implementation only as a reference with which to test your own one: your lab submission must not make any use of the RGL modules, except Prelude!
*To deliver* (but only if you select this assignment): file Mini..X.gf for your language X, together with MiniLangX.labels and a treebank in CoNLL format with 20 trees.
*Deadline*: until the end of the course.
## Session 8
1. Implement a simple application grammar, application/Doctor.gf.
This can be be done either by using your own MiniResource or the standard resource.
There are two versions of English implementation to support this.
Your first approximation can be just to copy it and change the words.
*To deliver* (but only if you select this assignment): file DoctorX.gf for your language X.
*Deadline*: until the end of the course.

165
lab2/grammar/abstract/MicroLang.gf Normal file
View File

@@ -0,0 +1,165 @@
abstract MicroLang = {
-- a very minimal version of MiniGrammar + MiniLexicon, helping to get started
-----------------------------------------------------
---------------- Grammar part -----------------------
-----------------------------------------------------
cat
-- Common
Utt ; -- sentence, question, word... e.g. "be quiet"
-- Cat
S ; -- declarative sentence e.g. "she lives here"
VP ; -- verb phrase e.g. "lives here"
Comp ; -- complement of copula e.g. "warm"
AP ; -- adjectival phrase e.g. "warm"
CN ; -- common noun (without determiner) e.g. "red house"
NP ; -- noun phrase (subject or object) e.g. "the red house"
Det ; -- determiner phrase e.g. "those"
Prep ; -- preposition, or just case e.g. "in", dative
V ; -- one-place verb e.g. "sleep"
V2 ; -- two-place verb e.g. "love"
A ; -- one-place adjective e.g. "warm"
N ; -- common noun e.g. "house"
Pron ; -- personal pronoun e.g. "she"
Adv ; -- adverbial phrase e.g. "in the house"
fun
-- Phrase
UttS : S -> Utt ; -- he walks
UttNP : NP -> Utt ; -- he
-- Sentence
PredVPS : NP -> VP -> S ; -- John walks --s shortcut even wrt MiniGrammar
-- Verb
UseV : V -> VP ; -- sleep
ComplV2 : V2 -> NP -> VP ; -- love it ---s
UseComp : Comp -> VP ; -- be small
CompAP : AP -> Comp ; -- small
AdvVP : VP -> Adv -> VP ; -- sleep here
-- Noun
DetCN : Det -> CN -> NP ; -- the man
UsePron : Pron -> NP ; -- she
a_Det : Det ; -- indefinite singular ---s
aPl_Det : Det ; -- indefinite plural ---s
the_Det : Det ; -- definite singular ---s
thePl_Det : Det ; -- definite plural ---s
UseN : N -> CN ; -- house
AdjCN : AP -> CN -> CN ; -- big house
-- Adjective
PositA : A -> AP ; -- warm
-- Adverb
PrepNP : Prep -> NP -> Adv ; -- in the house
-- Structural
in_Prep : Prep ;
on_Prep : Prep ;
with_Prep : Prep ;
he_Pron : Pron ;
she_Pron : Pron ;
they_Pron : Pron ;
-----------------------------------------------------
---------------- Lexicon part -----------------------
-----------------------------------------------------
fun
already_Adv : Adv ;
animal_N : N ;
apple_N : N ;
baby_N : N ;
bad_A : A ;
beer_N : N ;
big_A : A ;
bike_N : N ;
bird_N : N ;
black_A : A ;
blood_N : N ;
blue_A : A ;
boat_N : N ;
book_N : N ;
boy_N : N ;
bread_N : N ;
break_V2 : V2 ;
buy_V2 : V2 ;
car_N : N ;
cat_N : N ;
child_N : N ;
city_N : N ;
clean_A : A ;
clever_A : A ;
cloud_N : N ;
cold_A : A ;
come_V : V ;
computer_N : N ;
cow_N : N ;
dirty_A : A ;
dog_N : N ;
drink_V2 : V2 ;
eat_V2 : V2 ;
find_V2 : V2 ;
fire_N : N ;
fish_N : N ;
flower_N : N ;
friend_N : N ;
girl_N : N ;
good_A : A ;
go_V : V ;
grammar_N : N ;
green_A : A ;
heavy_A : A ;
horse_N : N ;
hot_A : A ;
house_N : N ;
-- john_PN : PN ;
jump_V : V ;
kill_V2 : V2 ;
-- know_VS : VS ;
language_N : N ;
live_V : V ;
love_V2 : V2 ;
man_N : N ;
milk_N : N ;
music_N : N ;
new_A : A ;
now_Adv : Adv ;
old_A : A ;
-- paris_PN : PN ;
play_V : V ;
read_V2 : V2 ;
ready_A : A ;
red_A : A ;
river_N : N ;
run_V : V ;
sea_N : N ;
see_V2 : V2 ;
ship_N : N ;
sleep_V : V ;
small_A : A ;
star_N : N ;
swim_V : V ;
teach_V2 : V2 ;
train_N : N ;
travel_V : V ;
tree_N : N ;
understand_V2 : V2 ;
wait_V2 : V2 ;
walk_V : V ;
warm_A : A ;
water_N : N ;
white_A : A ;
wine_N : N ;
woman_N : N ;
yellow_A : A ;
young_A : A ;
}

16
lab2/grammar/abstract/MicroLang.labels Normal file
View File

@@ -0,0 +1,16 @@
PredVPS nsubj head
ComplV2 head obj
AdvVP head advmod
DetCN det head
AdjCN amod head
PrepNP case head
Det DET
Prep ADP
V VERB
V2 VERB
A ADJ
N NOUN
Pron PRON
Adv ADV

121
lab2/grammar/abstract/MiniGrammar.gf Normal file
View File

@@ -0,0 +1,121 @@
abstract MiniGrammar = {
-- collected from GF/lib/src/abstract/*.gf
-- the functions marked ---s are shortcuts
-- the leading comments, e.g. "-- Common", indicate the standard RGL module
cat
-- Common
Utt ; -- sentence, question, word... e.g. "be quiet"
Pol ; -- polarity e.g. positive, negative
Temp ; -- temporal features e.g. present, anterior
-- Cat
Imp ; -- imperative e.g. "walk", "don't walk"
S ; -- declarative sentence e.g. "she lives here"
QS ; -- question sentence e.g. "does she live here"
Cl ; -- declarative clause, with all tenses e.g. "she looks at this"
QCl ; -- question clause e.g. "does she look at this"
VP ; -- verb phrase e.g. "lives here"
Comp ; -- complement of copula e.g. "in trouble"
AP ; -- adjectival phrase e.g. "very warm"
CN ; -- common noun (without determiner) e.g. "red house"
NP ; -- noun phrase (subject or object) e.g. "the red house"
IP ; -- interrogative phrase e.g. "who"
Pron ; -- personal pronoun e.g. "she"
Det ; -- determiner phrase e.g. "those"
Conj ; -- conjunction e.g. "and"
Prep ; -- preposition, or just case e.g. "in", dative
V ; -- one-place verb e.g. "sleep"
V2 ; -- two-place verb e.g. "love"
VS ; -- sentence-complement verb e.g. "know"
VV ; -- verb-phrase-complement verb e.g. "want"
A ; -- one-place adjective e.g. "warm"
N ; -- common noun e.g. "house"
PN ; -- proper name e.g. "Paris"
Adv ; -- adverbial phrase e.g. "in the house"
IAdv ; -- interrogative adverbial e.g. "where"
fun
-- Phrase
UttS : S -> Utt ; -- John walks
UttQS : QS -> Utt ; -- does John walk
UttNP : NP -> Utt ; -- John
UttAdv : Adv -> Utt ; -- in the house
UttIAdv : IAdv -> Utt ; -- why
UttImpSg : Pol -> Imp -> Utt ; -- (do not) walk
-- Sentence
UseCl : Temp -> Pol -> Cl -> S ; -- John has not walked
UseQCl : Temp -> Pol -> QCl -> QS ; -- has John walked
PredVP : NP -> VP -> Cl ; -- John walks / John does not walk
QuestCl : Cl -> QCl ; -- does John (not) walk
QuestVP : IP -> VP -> QCl ; -- who does (not) walk
ImpVP : VP -> Imp ; -- walk / do not walk
-- Verb
UseV : V -> VP ; -- sleep
ComplV2 : V2 -> NP -> VP ; -- love it ---s
ComplVS : VS -> S -> VP ; -- know that it is good
ComplVV : VV -> VP -> VP ; -- want to be good
UseComp : Comp -> VP ; -- be small
CompAP : AP -> Comp ; -- small
CompNP : NP -> Comp ; -- a man
CompAdv : Adv -> Comp ; -- in the house
AdvVP : VP -> Adv -> VP ; -- sleep here
-- Noun
DetCN : Det -> CN -> NP ; -- the man
UsePN : PN -> NP ; -- John
UsePron : Pron -> NP ; -- he
MassNP : CN -> NP ; -- milk
a_Det : Det ; -- indefinite singular ---s
aPl_Det : Det ; -- indefinite plural ---s
the_Det : Det ; -- definite singular ---s
thePl_Det : Det ; -- definite plural ---s
UseN : N -> CN ; -- house
AdjCN : AP -> CN -> CN ; -- big house
-- Adjective
PositA : A -> AP ; -- warm
-- Adverb
PrepNP : Prep -> NP -> Adv ; -- in the house
-- Conjunction
CoordS : Conj -> S -> S -> S ; -- he walks and she runs ---s
-- Tense
PPos : Pol ; -- I sleep [positive polarity]
PNeg : Pol ; -- I do not sleep [negative polarity]
TSim : Temp ; -- simultanous: she sleeps ---s
TAnt : Temp ; -- anterior: she has slept ---s
-- Structural
and_Conj : Conj ;
or_Conj : Conj ;
every_Det : Det ;
in_Prep : Prep ;
on_Prep : Prep ;
with_Prep : Prep ;
i_Pron : Pron ;
youSg_Pron : Pron ;
he_Pron : Pron ;
she_Pron : Pron ;
we_Pron : Pron ;
youPl_Pron : Pron ;
they_Pron : Pron ;
whoSg_IP : IP ;
where_IAdv : IAdv ;
why_IAdv : IAdv ;
have_V2 : V2 ;
want_VV : VV ;
}

8
lab2/grammar/abstract/MiniLang.gf Normal file
View File

@@ -0,0 +1,8 @@
abstract MiniLang =
MiniGrammar,
MiniLexicon
** {
flags startcat = Utt ;
}

27
lab2/grammar/abstract/MiniLang.labels Normal file
View File

@@ -0,0 +1,27 @@
AdjCN amod head
AdvVP head advmod
ComplV2 head obj
ComplVS head ccomp
ComplVV head xcomp
CoordS cc head conj
DetCN det head
PredVP nsubj head
PrepNP case head
QuestVP nsubj head
UseCl empty empty head
UseQCl empty empty head
UttImpSg emoty head
A ADJ
Adv ADV
Conj CONJ
Det DET
IAdv ADV
N NOUN
PN PROPN
Prep ADP
Pron PRON
V VERB
V2 VERB
VV VERB
VS VERB

92
lab2/grammar/abstract/MiniLexicon.gf Normal file
View File

@@ -0,0 +1,92 @@
abstract MiniLexicon = MiniGrammar ** {
fun
already_Adv : Adv ;
animal_N : N ;
apple_N : N ;
baby_N : N ;
bad_A : A ;
beer_N : N ;
big_A : A ;
bike_N : N ;
bird_N : N ;
black_A : A ;
blood_N : N ;
blue_A : A ;
boat_N : N ;
book_N : N ;
boy_N : N ;
bread_N : N ;
break_V2 : V2 ;
buy_V2 : V2 ;
car_N : N ;
cat_N : N ;
child_N : N ;
city_N : N ;
clean_A : A ;
clever_A : A ;
cloud_N : N ;
cold_A : A ;
come_V : V ;
computer_N : N ;
cow_N : N ;
dirty_A : A ;
dog_N : N ;
drink_V2 : V2 ;
eat_V2 : V2 ;
find_V2 : V2 ;
fire_N : N ;
fish_N : N ;
flower_N : N ;
friend_N : N ;
girl_N : N ;
good_A : A ;
go_V : V ;
grammar_N : N ;
green_A : A ;
heavy_A : A ;
horse_N : N ;
hot_A : A ;
house_N : N ;
john_PN : PN ;
jump_V : V ;
kill_V2 : V2 ;
know_VS : VS ;
language_N : N ;
live_V : V ;
love_V2 : V2 ;
man_N : N ;
milk_N : N ;
music_N : N ;
new_A : A ;
now_Adv : Adv ;
old_A : A ;
paris_PN : PN ;
play_V : V ;
read_V2 : V2 ;
ready_A : A ;
red_A : A ;
river_N : N ;
run_V : V ;
sea_N : N ;
see_V2 : V2 ;
ship_N : N ;
sleep_V : V ;
small_A : A ;
star_N : N ;
swim_V : V ;
teach_V2 : V2 ;
train_N : N ;
travel_V : V ;
tree_N : N ;
understand_V2 : V2 ;
wait_V2 : V2 ;
walk_V : V ;
warm_A : A ;
water_N : N ;
white_A : A ;
wine_N : N ;
woman_N : N ;
yellow_A : A ;
young_A : A ;
}

148
lab2/grammar/api/MiniSyntax.gf Normal file
View File

@@ -0,0 +1,148 @@
incomplete resource MiniSyntax =
open MiniGrammar
in {
oper
mkUtt = overload {
mkUtt : S -> Utt
= UttS ;
mkUtt : QS -> Utt
= UttQS ;
mkUtt : NP -> Utt
= UttNP ;
mkUtt : Adv -> Utt
= UttAdv ;
mkUtt : Pol -> Imp -> Utt
= UttImpSg ;
mkUtt : Imp -> Utt
= UttImpSg PPos
} ;
mkImp = overload {
mkImp : VP -> Imp
= ImpVP ;
} ;
mkS = overload {
mkS : Temp -> Pol -> Cl -> S
= UseCl ;
mkS : Pol -> Cl -> S
= UseCl TSim ;
mkS : Temp -> Cl -> S
= \t -> UseCl t PPos ;
mkS : Cl -> S
= UseCl TSim PPos ;
mkS : Conj -> S -> S -> S
= CoordS ;
} ;
mkQS = overload {
mkQS : Temp -> Pol -> QCl -> QS
= UseQCl ;
mkQS : Pol -> QCl -> QS
= UseQCl TSim ;
mkQS : Temp -> QCl -> QS
= \t -> UseQCl t PPos ;
mkQS : QCl -> QS
= UseQCl TSim PPos ;
} ;
positivePol : Pol
= PPos ;
negativePol : Pol
= PNeg ;
simultaneousAnt : Temp
= TSim ;
anteriorAnt : Temp
= TAnt ;
mkCl = overload {
mkCl : NP -> VP -> Cl
= PredVP ;
mkCl : NP -> V -> Cl
= \np,v -> PredVP np (UseV v) ;
mkCl : NP -> V2 -> NP -> Cl
= \np,v,obj -> PredVP np (ComplV2 v obj) ;
mkCl : NP -> VS -> S -> Cl
= \np,v,obj -> PredVP np (ComplVS v obj) ;
mkCl : NP -> VV -> VP -> Cl
= \np,v,obj -> PredVP np (ComplVV v obj) ;
mkCl : NP -> AP -> Cl
= \np,ap -> PredVP np (UseComp (CompAP ap)) ;
mkCl : NP -> A -> Cl
= \np,a -> PredVP np (UseComp (CompAP (PositA a))) ;
} ;
mkQCl = overload {
mkQCl : Cl -> QCl
= QuestCl ;
mkQCl : IP -> VP -> QCl
= QuestVP ;
} ;
mkVP = overload {
mkVP : V -> VP
= UseV ;
mkVP : V2 -> NP -> VP
= ComplV2 ;
mkVP : AP -> VP
= \ap -> UseComp (CompAP ap) ;
mkVP : A -> VP
= \a -> UseComp (CompAP (PositA a)) ;
mkVP : NP -> VP
= \np -> UseComp (CompNP np) ;
mkVP : Adv -> VP
= \adv -> UseComp (CompAdv adv) ;
mkVP : VP -> Adv -> VP
= AdvVP ;
} ;
mkNP = overload {
mkNP : Det -> CN -> NP
= DetCN ;
mkNP : Det -> N -> NP
= \det,n -> DetCN det (UseN n) ;
mkNP : Pron -> NP
= UsePron ;
mkNP : PN -> NP
= UsePN ;
mkNP : CN -> NP
= MassNP ;
mkNP : N -> NP
= \n -> MassNP (UseN n) ;
} ;
i_NP : NP
= UsePron i_Pron ;
you_NP : NP
= UsePron youSg_Pron ;
he_NP : NP
= UsePron he_Pron ;
she_NP : NP
= UsePron she_Pron ;
mkCN = overload {
mkCN : N -> CN
= UseN ;
mkCN : AP -> CN -> CN
= AdjCN ;
mkCN : A -> N -> CN
= \a,n -> AdjCN (PositA a) (UseN n) ;
mkCN : A -> CN -> CN
= \a,cn -> AdjCN (PositA a) cn ;
} ;
mkAP = overload {
mkAP : A -> AP
= PositA ;
} ;
mkAdv = overload {
mkAdv : Prep -> NP -> Adv
= PrepNP ;
} ;
}

6
lab2/grammar/api/MiniSyntaxEng.gf Normal file
View File

@@ -0,0 +1,6 @@
--# -path=.:../english:../abstract
resource MiniSyntaxEng =
MiniGrammarEng ** --- inheriting everything from Grammar, not just Cat and Structural
MiniSyntax with
(MiniGrammar=MiniGrammarEng) ;

92
lab2/grammar/application/Doctor.gf Normal file
View File

@@ -0,0 +1,92 @@
abstract Doctor = {
flags startcat = Phrase ;
cat
Phrase ;
Fact ;
Action ;
Property ;
Profession ;
Person ;
Place ;
Substance ;
Illness ;
fun
presPosPhrase : Fact -> Phrase ;
presNegPhrase : Fact -> Phrase ;
pastPosPhrase : Fact -> Phrase ;
pastNegPhrase : Fact -> Phrase ;
presQuestionPhrase : Fact -> Phrase ;
pastQuestionPhrase : Fact -> Phrase ;
impPosPhrase : Action -> Phrase ;
impNegPhrase : Action -> Phrase ;
actionFact : Person -> Action -> Fact ;
propertyFact : Person -> Property -> Fact ;
isProfessionProperty : Profession -> Property ;
isAtPlaceProperty : Place -> Property ;
haveIllnessProperty : Illness -> Property ;
needProfessionProperty : Profession -> Property ;
theProfessionPerson : Profession -> Person ;
iMascPerson : Person ;
iFemPerson : Person ;
youMascPerson : Person ;
youFemPerson : Person ;
hePerson : Person ;
shePerson : Person ;
goToAction : Place -> Action ;
stayAtAction : Place -> Action ;
vaccinateAction : Person -> Action ;
examineAction : Person -> Action ;
takeSubstanceAction : Substance -> Action ;
coughAction : Action ;
breatheAction : Action ;
vomitAction : Action ;
sleepAction : Action ;
undressAction : Action ;
dressAction : Action ;
eatAction : Action ;
drinkAction : Action ;
smokeAction : Action ;
measureTemperatureAction : Action ;
measureBloodPressureAction : Action ;
hospitalPlace : Place ;
homePlace : Place ;
schoolPlace : Place ;
workPlace : Place ;
doctorProfession : Profession ;
nurseProfession : Profession ;
interpreterProfession : Profession ;
bePregnantProperty : Property ;
beIllProperty : Property ;
beWellProperty : Property ;
beDeadProperty : Property ;
haveAllergiesProperty : Property ;
havePainsProperty : Property ;
haveChildrenProperty : Property ;
feverIllness : Illness ;
fluIllness : Illness ;
headacheIllness : Illness ;
diarrheaIllness : Illness ;
heartDiseaseIllness : Illness ;
lungDiseaseIllness : Illness ;
hypertensionIllness : Illness ;
alcoholSubstance : Substance ;
medicineSubstance : Substance ;
drugsSubstance : Substance ;
}

117
lab2/grammar/application/DoctorEng.gf Normal file
View File

@@ -0,0 +1,117 @@
--# -path=.:../abstract:../english:../api
-- model implementation using Mini RGL
concrete DoctorEng of Doctor =
open
MiniSyntaxEng,
MiniParadigmsEng,
Prelude
in {
-- application using your own Mini* modules
lincat
Phrase = Utt ;
Fact = Cl ;
Action = VP ;
Property = VP ;
Profession = CN ;
Person = NP ;
Place = {at,to : Adv} ;
Substance = NP ;
Illness = NP ;
lin
presPosPhrase fact = mkUtt (mkS fact) ;
presNegPhrase fact = mkUtt (mkS negativePol fact) ;
pastPosPhrase fact = mkUtt (mkS anteriorAnt fact) ;
pastNegPhrase fact = mkUtt (mkS anteriorAnt negativePol fact) ;
-- presQuestionPhrase fact = mkUtt (mkQS (mkQCl fact)) ;
-- pastQuestionPhrase fact = mkUtt (mkQS anteriorAnt (mkQCl fact)) ;
presQuestionPhrase fact = let p : Utt = mkUtt (mkQS (mkQCl fact)) in p ** {s = p.s ++ SOFT_BIND ++ "?"} ;
pastQuestionPhrase fact = let p : Utt = mkUtt (mkQS anteriorAnt (mkQCl fact)) in p ** {s = p.s ++ SOFT_BIND ++ "?"} ;
impPosPhrase action = mkUtt (mkImp action) ;
impNegPhrase action = mkUtt negativePol (mkImp action) ;
actionFact person action = mkCl person action ;
propertyFact person property = mkCl person property ;
isProfessionProperty profession = mkVP (mkNP a_Det profession) ;
needProfessionProperty profession = mkVP need_V2 (mkNP a_Det profession) ;
isAtPlaceProperty place = mkVP place.at ;
haveIllnessProperty illness = mkVP have_V2 illness ;
theProfessionPerson profession = mkNP the_Det profession ;
iMascPerson = i_NP ;
iFemPerson = i_NP ;
youMascPerson = you_NP ;
youFemPerson = you_NP ;
hePerson = he_NP ;
shePerson = she_NP ;
goToAction place = mkVP (mkVP go_V) place.to ;
stayAtAction place = mkVP (mkVP stay_V) place.at ;
vaccinateAction person = mkVP vaccinate_V2 person ;
examineAction person = mkVP examine_V2 person ;
takeSubstanceAction substance = mkVP take_V2 substance ;
-- end of what could be a functor
--------------------------------
coughAction = mkVP (mkV "cough") ;
breatheAction = mkVP (mkV "breathe") ;
vomitAction = mkVP (mkV "vomit") ;
sleepAction = mkVP (mkV "sleep" "slept" "slept") ;
undressAction = mkVP (mkVP take_V2 (mkNP thePl_Det (mkN "clothe"))) (pAdv "off") ;
dressAction = mkVP (mkVP put_V2 (mkNP thePl_Det (mkN "clothe"))) (pAdv "on") ;
eatAction = mkVP (mkV "eat" "ate" "eaten") ;
drinkAction = mkVP (mkV "drink" "drank" "drunk") ;
smokeAction = mkVP (mkV "smoke") ;
measureTemperatureAction = mkVP (mkV2 (mkV "measure")) (mkNP the_Det (mkN "body temperature")) ;
measureBloodPressureAction = mkVP (mkV2 (mkV "measure")) (mkNP the_Det (mkN "blood pressure")) ;
hospitalPlace = {at = pAdv "at the hospital" ; to = pAdv "to the hospital"} ;
homePlace = {at = pAdv "at home" ; to = pAdv "home"} ;
schoolPlace = {at = pAdv "at school" ; to = pAdv "to school"} ;
workPlace = {at = pAdv "at work" ; to = pAdv "to work"} ;
doctorProfession = mkCN (mkN "doctor") ;
nurseProfession = mkCN (mkN "nurse") ;
interpreterProfession = mkCN (mkN "interpreter") ;
bePregnantProperty = mkVP (mkA "pregnant") ;
beIllProperty = mkVP (mkA "ill") ;
beWellProperty = mkVP (mkA "well") ;
beDeadProperty = mkVP (mkA "dead") ;
haveAllergiesProperty = mkVP have_V2 (mkNP aPl_Det (mkN "allergy")) ;
havePainsProperty = mkVP have_V2 (mkNP aPl_Det (mkN "pain")) ;
haveChildrenProperty = mkVP have_V2 (mkNP aPl_Det (mkN "child" "children")) ;
feverIllness = mkNP a_Det (mkN "fever") ;
fluIllness = mkNP a_Det (mkN "flu") ;
headacheIllness = mkNP a_Det (mkN "headache") ;
diarrheaIllness = mkNP a_Det (mkN "diarrhea") ;
heartDiseaseIllness = mkNP a_Det (mkN "heart disease") ;
lungDiseaseIllness = mkNP a_Det (mkN "lung disease") ;
hypertensionIllness = mkNP (mkN "hypertension") ;
alcoholSubstance = mkNP (mkN "alcohol") ;
medicineSubstance = mkNP a_Det (mkN "drug") ;
drugsSubstance = mkNP aPl_Det (mkN "drug") ;
oper
pAdv : Str -> Adv = MiniParadigmsEng.mkAdv ;
go_V = mkV "go" "went" "gone" ;
stay_V = mkV "stay" ;
need_V2 = mkV2 (mkV "need") ;
take_V2 = mkV2 (mkV "take" "took" "taken") ;
put_V2 = mkV2 (mkV "put" "put" "put") ;
vaccinate_V2 = mkV2 (mkV "vaccinate") ;
examine_V2 = mkV2 (mkV "examine") ;
}

118
lab2/grammar/application/DoctorFraMerle.gf Normal file
View File

@@ -0,0 +1,118 @@
--# -path=.:../abstract:../english:../api
-- model implementation using Mini RGL
concrete DoctorFraMerle of Doctor =
open
SyntaxFre,
ParadigmsFre,
Prelude,
StructuralFre
in {
-- application using your own Mini* modules
lincat
Phrase = Utt ;
Fact = Cl ;
Action = VP ;
Property = VP ;
Profession = CN ;
Person = NP ;
Place = {at,to : Adv} ;
Substance = NP ;
Illness = NP ;
lin
presPosPhrase fact = mkUtt (mkS fact) ;
presNegPhrase fact = mkUtt (mkS negativePol fact) ;
pastPosPhrase fact = mkUtt (mkS anteriorAnt fact) ;
pastNegPhrase fact = mkUtt (mkS anteriorAnt negativePol fact) ;
presQuestionPhrase fact = let p : Utt = mkUtt (mkQS (mkQCl fact)) in p ** {s = p.s ++ SOFT_BIND ++ "?"} ;
pastQuestionPhrase fact = let p : Utt = mkUtt (mkQS anteriorAnt (mkQCl fact)) in p ** {s = p.s ++ SOFT_BIND ++ "?"} ;
impPosPhrase action = mkUtt (mkImp action) ;
impNegPhrase action = mkUtt negativePol (mkImp action) ;
actionFact person action = mkCl person action ;
propertyFact person property = mkCl person property ;
isProfessionProperty profession = mkVP (mkNP a_Det profession) ;
needProfessionProperty profession = mkVP need_V2 (mkNP a_Det profession) ;
isAtPlaceProperty place = mkVP place.at ;
haveIllnessProperty illness = mkVP have_V2 illness ;
theProfessionPerson profession = mkNP the_Det profession ;
iMascPerson = i_NP ;
iFemPerson = i_NP ;
youMascPerson = youPol_NP ;
youFemPerson = youPol_NP ;
hePerson = he_NP ;
shePerson = she_NP ;
goToAction place = mkVP (mkVP go_V) place.to ;
stayAtAction place = mkVP (mkVP stay_V) place.at ;
vaccinateAction person = mkVP vaccinate_V2 person ;
examineAction person = mkVP examine_V2 person ;
takeSubstanceAction substance = mkVP take_V2 substance ;
-- end of what could be a functor
--------------------------------
coughAction = mkVP (mkV "tousser") ;
breatheAction = mkVP (mkV "respirer") ;
vomitAction = mkVP (mkV "vomir") ;
sleepAction = mkVP (mkV "dormir" "dors" "dormons" "dorment" "dormit" "dormira" "dormi") ;
undressAction = mkVP (reflV (mkV "déshabiller")) ;
dressAction = mkVP (reflV (mkV "habiller")) ;
eatAction = mkVP (mkV "manger") ;
drinkAction = mkVP (mkV "boire" "bois" "buvons" "boivent" "but" "boira" "bu") ;
smokeAction = mkVP (mkV "fumer") ;
measureTemperatureAction = mkVP (mkV2 (mkV "mesurer")) (mkNP the_Det (mkN "temperatur du corps" feminine)) ;
measureBloodPressureAction = mkVP (mkV2 (mkV "mesurer")) (mkNP the_Det (mkN "tension artérielle")) ;
--these are identical for 'at' and 'to' in French
hospitalPlace = {at = pAdv "à l'hôpital" ; to = pAdv "à l'hôpital"} ;
homePlace = {at = pAdv "à la maison" ; to = pAdv "à la maison"} ;
schoolPlace = {at = pAdv "à l'école" ; to = pAdv "à l'école"} ;
workPlace = {at = pAdv "au travail" ; to = pAdv "au travail"} ;
doctorProfession = mkCN (mkN "médecin") ;
nurseProfession = mkCN ((mkN "infirmière") | (mkN "infermier")) ;
interpreterProfession = mkCN (mkN "interprète") ;
bePregnantProperty = mkVP (mkA "enceinte") ;
beIllProperty = mkVP (mkA "malade") ;
beWellProperty = mkVP (mkA "bien" "bien" "bien" "bien") ;
beDeadProperty = mkVP (mkA "mort") ;
haveAllergiesProperty = mkVP have_V2 (mkNP aPl_Det (mkN "allergie")) ;
havePainsProperty = mkVP have_V2 (mkNP aPl_Det (mkN "douleur")) ;
haveChildrenProperty = mkVP have_V2 (mkNP aPl_Det (mkN "enfant")) ;
feverIllness = mkNP (mkN "fièvre") ;
fluIllness = mkNP a_Det (mkN "grippe") ;
headacheIllness = mkNP a_Det (mkN "mal de crâne") ;
diarrheaIllness = mkNP (mkN "diarrhée") ;
heartDiseaseIllness = mkNP a_Det (mkN "cardiopathie") ;
lungDiseaseIllness = mkNP a_Det (mkN "maladie pulmonaire") ;
hypertensionIllness = mkNP (mkN "hypertension") ;
alcoholSubstance = mkNP (mkN "alcool") ;
medicineSubstance = mkNP a_Det (mkN "médicament") ;
drugsSubstance = mkNP aPl_Det (mkN "drogue") ;
oper
pAdv : Str -> Adv = ParadigmsFre.mkAdv ;
go_V = etreV (mkV "aller" "vais" "allons" "vont" "alla" "ira" "allé") ;
stay_V = etreV (mkV "rester") ;
need_V2 = mkV2 (mkV (mkV have_V2) "besoin d'") ;
--need_V2 = mkV2 (mkV "nécessiter") ;
take_V2 = mkV2 (mkV "prendre" "prends" "prenons" "prennent" "prit" "prendra" "pris") ;
put_V2 = mkV2 (mkV "mettre" "mets" "mettons" "mettent" "mit" "mettra" "mis") ;
vaccinate_V2 = mkV2 (mkV "vacciner") ;
examine_V2 = mkV2 (mkV "examiner") ;
}

113
lab2/grammar/application/DoctorRGLEng.gf Normal file
View File

@@ -0,0 +1,113 @@
concrete DoctorRGLEng of Doctor =
open
SyntaxEng,
ParadigmsEng,
Prelude
in {
-- application using standard RGL
lincat
Phrase = Utt ;
Fact = Cl ;
Action = VP ;
Property = VP ;
Profession = CN ;
Person = NP ;
Place = {at,to : Adv} ;
Substance = NP ;
Illness = NP ;
lin
presPosPhrase fact = mkUtt (mkS fact) ;
presNegPhrase fact = mkUtt (mkS negativePol fact) ;
pastPosPhrase fact = mkUtt (mkS anteriorAnt fact) ;
pastNegPhrase fact = mkUtt (mkS anteriorAnt negativePol fact) ;
-- presQuestionPhrase fact = mkUtt (mkQS (mkQCl fact)) ;
-- pastQuestionPhrase fact = mkUtt (mkQS anteriorAnt (mkQCl fact)) ;
presQuestionPhrase fact = let p : Utt = mkUtt (mkQS (mkQCl fact)) in p ** {s = p.s ++ SOFT_BIND ++ "?"} ;
pastQuestionPhrase fact = let p : Utt = mkUtt (mkQS anteriorAnt (mkQCl fact)) in p ** {s = p.s ++ SOFT_BIND ++ "?"} ;
impPosPhrase action = mkUtt (mkImp action) ;
impNegPhrase action = mkUtt negativePol (mkImp action) ;
actionFact person action = mkCl person action ;
propertyFact person property = mkCl person property ;
isProfessionProperty profession = mkVP (mkNP a_Det profession) ;
needProfessionProperty profession = mkVP need_V2 (mkNP a_Det profession) ;
isAtPlaceProperty place = mkVP place.at ;
haveIllnessProperty illness = mkVP have_V2 illness ;
theProfessionPerson profession = mkNP the_Det profession ;
iMascPerson = i_NP ;
iFemPerson = i_NP ;
youMascPerson = you_NP ;
youFemPerson = you_NP ;
hePerson = he_NP ;
shePerson = she_NP ;
goToAction place = mkVP (mkVP go_V) place.to ;
stayAtAction place = mkVP (mkVP stay_V) place.at ;
vaccinateAction person = mkVP vaccinate_V2 person ;
examineAction person = mkVP examine_V2 person ;
takeSubstanceAction substance = mkVP take_V2 substance ;
-- end of what could be a functor
--------------------------------
coughAction = mkVP (mkV "cough") ;
breatheAction = mkVP (mkV "breathe") ;
vomitAction = mkVP (mkV "vomit") ;
sleepAction = mkVP (mkV "sleep" "slept" "slept") ;
undressAction = mkVP (mkVP take_V2 (mkNP thePl_Det (mkN "clothe"))) (pAdv "off") ;
dressAction = mkVP (mkVP put_V2 (mkNP thePl_Det (mkN "clothe"))) (pAdv "on") ;
eatAction = mkVP (mkV "eat" "ate" "eaten") ;
drinkAction = mkVP (mkV "drink" "drank" "drunk") ;
smokeAction = mkVP (mkV "smoke") ;
measureTemperatureAction = mkVP (mkV2 (mkV "measure")) (mkNP the_Det (mkN "body temperature")) ;
measureBloodPressureAction = mkVP (mkV2 (mkV "measure")) (mkNP the_Det (mkN "blood pressure")) ;
hospitalPlace = {at = pAdv "at the hospital" ; to = pAdv "to the hospital"} ;
homePlace = {at = pAdv "at home" ; to = pAdv "home"} ;
schoolPlace = {at = pAdv "at school" ; to = pAdv "to school"} ;
workPlace = {at = pAdv "at work" ; to = pAdv "to work"} ;
doctorProfession = mkCN (mkN "doctor") ;
nurseProfession = mkCN (mkN "nurse") ;
interpreterProfession = mkCN (mkN "interpreter") ;
bePregnantProperty = mkVP (mkA "pregnant") ;
beIllProperty = mkVP (mkA "ill") ;
beWellProperty = mkVP (mkA "well") ;
beDeadProperty = mkVP (mkA "dead") ;
haveAllergiesProperty = mkVP have_V2 (mkNP aPl_Det (mkN "allergy")) ;
havePainsProperty = mkVP have_V2 (mkNP aPl_Det (mkN "pain")) ;
haveChildrenProperty = mkVP have_V2 (mkNP aPl_Det (mkN "child" "children")) ;
feverIllness = mkNP a_Det (mkN "fever") ;
fluIllness = mkNP a_Det (mkN "flu") ;
headacheIllness = mkNP a_Det (mkN "headache") ;
diarrheaIllness = mkNP a_Det (mkN "diarrhea") ;
heartDiseaseIllness = mkNP a_Det (mkN "heart disease") ;
lungDiseaseIllness = mkNP a_Det (mkN "lung disease") ;
hypertensionIllness = mkNP (mkN "hypertension") ;
alcoholSubstance = mkNP (mkN "alcohol") ;
medicineSubstance = mkNP a_Det (mkN "drug") ;
drugsSubstance = mkNP aPl_Det (mkN "drug") ;
oper
pAdv : Str -> Adv = ParadigmsEng.mkAdv ;
go_V = mkV "go" "went" "gone" ;
stay_V = mkV "stay" ;
need_V2 = mkV2 (mkV "need") ;
take_V2 = mkV2 (mkV "take" "took" "taken") ;
put_V2 = mkV2 (mkV "put" "put" "put") ;
vaccinate_V2 = mkV2 (mkV "vaccinate") ;
examine_V2 = mkV2 (mkV "examine") ;
}

112
lab2/grammar/application/DoctorSweBritta.gf Normal file
View File

@@ -0,0 +1,112 @@
concrete DoctorSweBritta of Doctor =
open
SyntaxSwe,
ParadigmsSwe,
Prelude
in {
-- application using standard RGL
lincat
Phrase = Utt ;
Fact = Cl ;
Action = VP ;
Property = VP ;
Profession = CN ;
Person = NP ;
Place = {at,to : Adv} ;
Substance = NP ;
Illness = NP ;
lin
presPosPhrase fact = mkUtt (mkS fact) ;
presNegPhrase fact = mkUtt (mkS negativePol fact) ;
pastPosPhrase fact = mkUtt (mkS anteriorAnt fact) ;
pastNegPhrase fact = mkUtt (mkS anteriorAnt negativePol fact) ;
-- presQuestionPhrase fact = mkUtt (mkQS (mkQCl fact)) ;
-- pastQuestionPhrase fact = mkUtt (mkQS anteriorAnt (mkQCl fact)) ;
presQuestionPhrase fact = let p : Utt = mkUtt (mkQS (mkQCl fact)) in p ** {s = p.s ++ SOFT_BIND ++ "?"} ;
pastQuestionPhrase fact = let p : Utt = mkUtt (mkQS anteriorAnt (mkQCl fact)) in p ** {s = p.s ++ SOFT_BIND ++ "?"} ;
impPosPhrase action = mkUtt (mkImp action) ;
impNegPhrase action = mkUtt negativePol (mkImp action) ;
actionFact person action = mkCl person action ;
propertyFact person property = mkCl person property ;
isProfessionProperty profession = mkVP (mkNP profession) ;
needProfessionProperty profession = mkVP need_V2 (mkNP a_Det profession) ;
isAtPlaceProperty place = mkVP place.at ;
haveIllnessProperty illness = mkVP have_V2 illness ;
theProfessionPerson profession = mkNP the_Det profession ;
iMascPerson = i_NP ;
iFemPerson = i_NP ;
youMascPerson = you_NP ;
youFemPerson = you_NP ;
hePerson = he_NP ;
shePerson = she_NP ;
goToAction place = mkVP (mkVP go_V) place.to ;
stayAtAction place = mkVP (mkVP stay_V) place.at ;
vaccinateAction person = mkVP vaccinate_V2 person ;
examineAction person = mkVP examine_V2 person ;
takeSubstanceAction substance = mkVP use_V2 substance ;
-- end of what could be a functor
--------------------------------
coughAction = mkVP (mkV "hostar") ;
breatheAction = mkVP (mkV "andas" "andas" "andas" "andades" "andats" "andad") ;
vomitAction = mkVP (mkV "kräkas" "kräks" "kräks" "kräktes" "kräkts" "kräkt") ;
sleepAction = mkVP (mkV "sova" "sov" "sovit") ;
undressAction = mkVP (mkV2 (take_V "av" )) (mkNP thePl_Det (mkN "kläd" "kläder")) ;
dressAction = mkVP (mkV2 (take_V "på")) (mkNP thePl_Det (mkN "kläd" "kläder")) ;
eatAction = mkVP (mkV "äta" "åt" "ätit") ;
drinkAction = mkVP (mkV "dricka" "drack" "druckit") ;
smokeAction = mkVP (mkV "röker") ;
measureTemperatureAction = mkVP (mkV2 (mkV "mäter")) (mkNP the_Det (mkN "kroppstemperatur")) ;
measureBloodPressureAction = mkVP (mkV2 (mkV "mäter")) (mkNP the_Det (mkN "blodtryck" "blodtrycket" "blodtryck" "blodtrycken")) ;
hospitalPlace = {at = pAdv "på sjukhuset" ; to = pAdv "till sjukhuset"} ;
homePlace = {at = pAdv "hemma" ; to = pAdv "hem"} ;
schoolPlace = {at = pAdv "i skolan" ; to = pAdv "till skolan"} ;
workPlace = {at = pAdv "på jobbet" ; to = pAdv "till jobbet"} ;
doctorProfession = mkCN (mkN "läkare" "läkare") ;
nurseProfession = mkCN (mkN "sköterska") ;
interpreterProfession = mkCN (mkN "tolk") ;
bePregnantProperty = mkVP (mkA "gravid") ;
beIllProperty = mkVP (mkA "sjuk") ;
beWellProperty = mkVP (mkA "frisk") ;
beDeadProperty = mkVP (mkA "död") ;
haveAllergiesProperty = mkVP have_V2 (mkNP aPl_Det (mkN "allergi" "allergier")) ;
havePainsProperty = mkVP have_V2 (mkNP aPl_Det (mkN "smärta")) ;
haveChildrenProperty = mkVP have_V2 (mkNP aPl_Det (mkN "barn" "barn")) ;
feverIllness = mkNP (mkN "feber") ;
fluIllness = mkNP (mkN "influensa") ;
headacheIllness = mkNP (mkN "huvudvärk") ;
diarrheaIllness = mkNP (mkN "diarré") ;
heartDiseaseIllness = mkNP a_Det (mkN "hjärtsjukdom") ;
lungDiseaseIllness = mkNP a_Det (mkN "lungsjukdom") ;
hypertensionIllness = mkNP (mkN "hypertoni") ;
alcoholSubstance = mkNP (mkN "alkohol") ;
medicineSubstance = mkNP a_Det (mkN "medicin") ;
drugsSubstance = mkNP aPl_Det (mkN "drog" "droger") ;
oper
pAdv : Str -> Adv = ParadigmsSwe.mkAdv ;
go_V = mkV "gå" "gick" "gått" ;
stay_V = mkV "stannar" ;
take_V = mkV (mkV "ta" "tar" "ta" "tog" "tagit" "tagen") ;
need_V2 = mkV2 (mkV "behöver") ;
use_V2 = mkV2 (mkV "använda" "använde" "använt") ;
vaccinate_V2 = mkV2 (mkV "vaccinerar") ;
examine_V2 = mkV2 (mkV "undersöker") ;
}

225
lab2/grammar/english/MicroLangEn.gf Normal file
View File

@@ -0,0 +1,225 @@
--# -path=.:../abstract
concrete MicroLangEn of MicroLang = open MicroResEn, Prelude in {
-----------------------------------------------------
---------------- Grammar part -----------------------
-----------------------------------------------------
lincat
Utt = {s : Str} ;
S = {s : Str} ;
VP = {verb : Verb ; compl : Str} ; ---s special case of Mini
Comp = {s : Str} ;
AP = Adjective ;
CN = Noun ;
NP = {s : Case => Str ; a : Agreement} ;
Pron = {s : Case => Str ; a : Agreement} ;
Det = {s : Str ; n : Number} ;
Prep = {s : Str} ;
V = Verb ;
V2 = Verb2 ;
A = Adjective ;
N = Noun ;
Adv = {s : Str} ;
lin
UttS s = s ;
UttNP np = {s = np.s ! Acc} ;
PredVPS np vp = {
s = np.s ! Nom ++ vp.verb.s ! agr2vform np.a ++ vp.compl
} ;
UseV v = {
verb = v ;
compl = [] ;
} ;
ComplV2 v2 np = {
verb = v2 ;
compl = v2.c ++ np.s ! Acc -- NP object in the accusative, preposition first
} ;
UseComp comp = {
verb = be_Verb ; -- the verb is the copula "be"
compl = comp.s
} ;
CompAP ap = ap ;
AdvVP vp adv =
vp ** {compl = vp.compl ++ adv.s} ;
DetCN det cn = {
s = \\c => det.s ++ cn.s ! det.n ;
a = Agr det.n ;
} ;
UsePron p = p ;
a_Det = {s = pre {"a"|"e"|"i"|"o" => "an" ; _ => "a"} ; n = Sg} ; --- a/an can get wrong
aPl_Det = {s = "" ; n = Pl} ;
the_Det = {s = "the" ; n = Sg} ;
thePl_Det = {s = "the" ; n = Pl} ;
UseN n = n ;
AdjCN ap cn = {
s = table {n => ap.s ++ cn.s ! n}
} ;
PositA a = a ;
PrepNP prep np = {s = prep.s ++ np.s ! Acc} ;
in_Prep = {s = "in"} ;
on_Prep = {s = "on"} ;
with_Prep = {s = "with"} ;
he_Pron = {
s = table {Nom => "he" ; Acc => "him"} ;
a = Agr Sg ;
} ;
she_Pron = {
s = table {Nom => "she" ; Acc => "her"} ;
a = Agr Sg ;
} ;
they_Pron = {
s = table {Nom => "they" ; Acc => "them"} ;
a = Agr Pl ;
} ;
-----------------------------------------------------
---------------- Lexicon part -----------------------
-----------------------------------------------------
lin already_Adv = mkAdv "already" ;
lin animal_N = mkN "animal" ;
lin apple_N = mkN "apple" ;
lin baby_N = mkN "baby" ;
lin bad_A = mkA "bad" ;
lin beer_N = mkN "beer" ;
lin big_A = mkA "big" ;
lin bike_N = mkN "bike" ;
lin bird_N = mkN "bird" ;
lin black_A = mkA "black" ;
lin blood_N = mkN "blood" ;
lin blue_A = mkA "blue" ;
lin boat_N = mkN "boat" ;
lin book_N = mkN "book" ;
lin boy_N = mkN "boy" ;
lin bread_N = mkN "bread" ;
lin break_V2 = mkV2 (mkV "break" "broke" "broken") ;
lin buy_V2 = mkV2 (mkV "buy" "bought" "bought") ;
lin car_N = mkN "car" ;
lin cat_N = mkN "cat" ;
lin child_N = mkN "child" "children" ;
lin city_N = mkN "city" ;
lin clean_A = mkA "clean" ;
lin clever_A = mkA "clever" ;
lin cloud_N = mkN "cloud" ;
lin cold_A = mkA "cold" ;
lin come_V = mkV "come" "came" "come" ;
lin computer_N = mkN "computer" ;
lin cow_N = mkN "cow" ;
lin dirty_A = mkA "dirty" ;
lin dog_N = mkN "dog" ;
lin drink_V2 = mkV2 (mkV "drink" "drank" "drunk") ;
lin eat_V2 = mkV2 (mkV "eat" "ate" "eaten") ;
lin find_V2 = mkV2 (mkV "find" "found" "found") ;
lin fire_N = mkN "fire" ;
lin fish_N = mkN "fish" "fish" ;
lin flower_N = mkN "flower" ;
lin friend_N = mkN "friend" ;
lin girl_N = mkN "girl" ;
lin good_A = mkA "good" ;
lin go_V = mkV "go" "went" "gone" ;
lin grammar_N = mkN "grammar" ;
lin green_A = mkA "green" ;
lin heavy_A = mkA "heavy" ;
lin horse_N = mkN "horse" ;
lin hot_A = mkA "hot" ;
lin house_N = mkN "house" ;
-- lin john_PN = mkPN "John" ;
lin jump_V = mkV "jump" ;
lin kill_V2 = mkV2 "kill" ;
-- lin know_VS = mkVS (mkV "know" "knew" "known") ;
lin language_N = mkN "language" ;
lin live_V = mkV "live" ;
lin love_V2 = mkV2 (mkV "love") ;
lin man_N = mkN "man" "men" ;
lin milk_N = mkN "milk" ;
lin music_N = mkN "music" ;
lin new_A = mkA "new" ;
lin now_Adv = mkAdv "now" ;
lin old_A = mkA "old" ;
-- lin paris_PN = mkPN "Paris" ;
lin play_V = mkV "play" ;
lin read_V2 = mkV2 (mkV "read" "read" "read") ;
lin ready_A = mkA "ready" ;
lin red_A = mkA "red" ;
lin river_N = mkN "river" ;
lin run_V = mkV "run" "ran" "run" ;
lin sea_N = mkN "sea" ;
lin see_V2 = mkV2 (mkV "see" "saw" "seen") ;
lin ship_N = mkN "ship" ;
lin sleep_V = mkV "sleep" "slept" "slept" ;
lin small_A = mkA "small" ;
lin star_N = mkN "star" ;
lin swim_V = mkV "swim" "swam" "swum" ;
lin teach_V2 = mkV2 (mkV "teach" "taught" "taught") ;
lin train_N = mkN "train" ;
lin travel_V = mkV "travel" ;
lin tree_N = mkN "tree" ;
lin understand_V2 = mkV2 (mkV "understand" "understood" "understood") ;
lin wait_V2 = mkV2 "wait" "for" ;
lin walk_V = mkV "walk" ;
lin warm_A = mkA "warm" ;
lin water_N = mkN "water" ;
lin white_A = mkA "white" ;
lin wine_N = mkN "wine" ;
lin woman_N = mkN "woman" "women" ;
lin yellow_A = mkA "yellow" ;
lin young_A = mkA "young" ;
---------------------------
-- Paradigms part ---------
---------------------------
oper
mkN = overload {
mkN : Str -> Noun -- predictable noun, e.g. car-cars, boy-boys, fly-flies, bush-bushes
= \n -> lin N (smartNoun n) ;
mkN : Str -> Str -> Noun -- irregular noun, e.g. man-men
= \sg,pl -> lin N (mkNoun sg pl) ;
} ;
mkA : Str -> A
= \s -> lin A {s = s} ;
mkV = overload {
mkV : (inf : Str) -> V -- predictable verb, e.g. play-plays, cry-cries, wash-washes
= \s -> lin V (smartVerb s) ;
mkV : (inf,pres,part : Str) -> V -- irregular verb, e.g. drink-drank-drunk
= \inf,pres,part -> lin V (irregVerb inf pres part) ;
} ;
mkV2 = overload {
mkV2 : Str -> V2 -- predictable verb with direct object, e.g. "wash"
= \s -> lin V2 (smartVerb s ** {c = []}) ;
mkV2 : Str -> Str -> V2 -- predictable verb with preposition, e.g. "wait - for"
= \s,p -> lin V2 (smartVerb s ** {c = p}) ;
mkV2 : V -> V2 -- any verb with direct object, e.g. "drink"
= \v -> lin V2 (v ** {c = []}) ;
mkV2 : V -> Str -> V2 -- any verb with preposition
= \v,p -> lin V2 (v ** {c = p}) ;
} ;
mkAdv : Str -> Adv
= \s -> lin Adv {s = s} ;
mkPrep : Str -> Prep
= \s -> lin Prep {s = s} ;
}

1
lab2/grammar/english/MicroLangEng.labels Normal file
View File

@@ -0,0 +1 @@
UseComp {"es","sont"} AUX cop head

241
lab2/grammar/english/MicroLangFr.gf Normal file
View File

@@ -0,0 +1,241 @@
--# -path=.:../abstract
concrete MicroLangFr of MicroLang = open MicroResFr, Prelude in {
-----------------------------------------------------
---------------- Grammar part -----------------------
-----------------------------------------------------
lincat
Utt = {s : Str} ;
S = {s : Str} ;
VP = {verb : Verb ; compl : Number => Gender => Str} ;
Comp = Adjective ;
AP = Adjective ;
CN = Noun ;
NP = {s : Case => Str ; gen : Gender ; num : Number } ;
Pron = {s : Case => Str ; gen : Gender ; num: Number } ;
Det = {s : Str ; num : Number ; gen : Gender } ;
Prep = {s : Str} ;
V = Verb ;
V2 = Verb2 ;
A = Adjective ;
N = Noun ;
Adv = {s : Str} ;
lin
UttS s = s ;
UttNP np = {s = np.s ! Acc} ;
-- PredVP : NP -> VP -> Cl
PredVPS np vp = {
s = np.s ! Nom ++ vp.verb.s ! agr2vform np.num ++ vp.compl ! np.num ! np.gen
} ;
-- V -> VP
UseV v = {
verb = v ;
compl = \\num,gen => [] ;
} ;
-- V2 -> NP -> VP
ComplV2 v2 np = {
verb = v2 ;
compl = \\num,gen => v2.c ! num ! gen ++ np.s ! Acc -- NP object in the accusative
} ;
UseComp comp = {
verb = be_Verb ; -- the verb is the copula "être"
compl = \\num,gen => comp.s ! num ! gen
} ;
CompAP ap = ap ;
AdvVP vp adv =
vp ** {compl = \\num,gen => vp.compl ! num ! gen ++ adv.s} ; --update complement by + adv
-- Det -> CN -> NP
DetCN det cn = {
s = \\c => det.s ++ cn.s ! det.num ;
gen = cn.gen ;
num = det.num ;
} ;
a_Det = {s = pre {"a"|"e"|"i"|"o" => "l'" ; _ => "le"} ; num = Sg ; gen = M | F} ;
aPl_Det = {s = "la" ; num = Sg ; gen = F} ;
the_Det = {s = "les" ; num = Pl ; gen = M | F} ;
thePl_Det = {s = "des" ; num = Pl ; gen = M | F} ;
UsePron p = p ;
-- N -> CN
UseN noun = noun ;
-- AP -> CN -> CN
AdjCN ap cn = {
s = \\num => ap.s ! num ! cn.gen ++ cn.s ! num ; --table from number to gender to string
gen = cn.gen ;
} ;
PositA a = a ;
PrepNP prep np = {s = prep.s ++ np.s ! Acc} ;
in_Prep = {s = "dans"} ;
on_Prep = {s = "sur"} ;
with_Prep = {s = "avec"} ;
he_Pron = {
s = table {Nom => "il" ; Acc => "le"} ;
num = Sg ;
pers = P3 ;
gen = M ;
} ;
she_Pron = {
s = table {Nom => "elle" ; Acc => "la"} ;
num = Sg ;
pers = P3 ;
gen = F ;
} ;
they_Pron = {
s = table {Nom => "ils" ; Acc => "les"} ;
num = Pl ;
pers = P3 ;
gen = M | F ;
} ;
-----------------------------------------------------
---------------- Lexicon part -----------------------
-----------------------------------------------------
lin already_Adv = mkAdv "déja" ;
lin animal_N = mkN "animal" ;
lin apple_N = mkN "pomme" ;
lin baby_N = mkN "bébé" ;
lin bad_A = mkA "mauvais" ;
lin beer_N = mkN "bière" ;
lin big_A = mkA "grand" ;
lin bike_N = mkN "vélo" ;
lin bird_N = mkN "oiseau" ;
lin black_A = mkA "noir" ;
lin blood_N = mkN "sang" "sang";
lin blue_A = mkA "bleu" ;
lin boat_N = mkN "bâteau" ;
lin book_N = mkN "livre" ;
lin boy_N = mkN "garçon" ;
lin bread_N = mkN "pain" ;
lin break_V2 = mkV2 (mkV "casser") ;
lin buy_V2 = mkV2 (mkV "acheter" "achète" "achetons" "achètes" "achetez" "achète" "achetent") ;
lin car_N = mkN "voiture" ;
lin cat_N = mkN "chat" ;
lin child_N = mkN "enfant" ;
lin city_N = mkN "ville" ;
lin clean_A = mkA "propre" ;
lin clever_A = mkA "intelligent" ;
lin cloud_N = mkN "nuage" ;
lin cold_A = mkA "froid" ;
lin come_V = mkV "venir" "viens" "venons" "viens" "venez" "vient" "viennent" ;
lin computer_N = mkN "ordinateur" ;
lin cow_N = mkN "vache" ;
lin dirty_A = mkA "sale" ;
lin dog_N = mkN "chien" ;
lin drink_V2 = mkV2 (mkV "boire" "bois" "buvons" "bois" "buvez" "boit" "boivent") ;
lin eat_V2 = mkV2 (mkV "manger") ;
lin find_V2 = mkV2 (mkV "trouver") ;
lin fire_N = mkN "feu" ;
lin fish_N = mkN "poisson" ;
lin flower_N = mkN "fleur" ;
lin friend_N = mkN "ami" ;
lin girl_N = mkN "fille" ;
lin good_A = mkA "bon" ;
lin go_V = mkV "aller" "vais" "allons" "vas" "allez" "va" "vont" ;
lin grammar_N = mkN "grammaire" ;
lin green_A = mkA "vert" ;
lin heavy_A = mkA "lourd" ;
lin horse_N = mkN "cheval" ;
lin hot_A = mkA "chaud" ;
lin house_N = mkN "maison" ;
-- lin john_PN = mkPN "John" ;
lin jump_V = mkV "sauter" ;
lin kill_V2 = mkV2 "tuer" ;
-- lin know_VS = mkVS (mkV "savoir" "sais" "savons" "sais" "savez" "sait" "savent") ;
lin language_N = mkN "langue" ;
lin live_V = mkV "vivre" ;
lin love_V2 = mkV2 (mkV "aimer") ;
lin man_N = mkN "homme" ;
lin milk_N = mkN "lait" "lait" ;
lin music_N = mkN "musique" ;
lin new_A = mkA "nouveau" ;
lin now_Adv = mkAdv "maintenant" ;
lin old_A = mkA "ancien" ;
-- lin paris_PN = mkPN "Paris" ;
lin play_V = mkV "jouer" ;
lin read_V2 = mkV2 (mkV "lire" "lis" "lisons" "lis" "lisez" "lit" "lisent") ;
lin ready_A = mkA "prêt" ;
lin red_A = mkA "rouge" ;
lin river_N = mkN "rivière" ;
lin run_V = mkV "courir" ;
lin sea_N = mkN "mer" ;
lin see_V2 = mkV2 (mkV "voir") ;
lin ship_N = mkN "navire" ;
lin sleep_V = mkV "acheter" "achète" "achètes" "achete" "achètons" "achetez" "achetent" ;
lin small_A = mkA "petit" ;
lin star_N = mkN "etoile" ;
lin swim_V = mkV "nager" ;
lin teach_V2 = mkV2 (mkV "enseigner") ;
lin train_N = mkN "train" ;
lin travel_V = mkV "voyager" ;
lin tree_N = mkN "arbre" ;
lin understand_V2 = mkV2 (mkV "comprendre") ;
lin wait_V2 = mkV2 "attendre" ;
lin walk_V = mkV "marcher" ;
lin warm_A = mkA "chaud" ;
lin water_N = mkN "eau" ;
lin white_A = mkA "blanc" ;
lin wine_N = mkN "vin" ;
lin woman_N = mkN "femme" ;
lin yellow_A = mkA "jaune" ;
lin young_A = mkA "jeune" ;
---------------------------
-- Paradigms part ---------
---------------------------
oper
mkN = overload {
mkN : Str -> Noun -- predictable nouns according to the pattern matching
= \n -> lin N (smartNoun n) ;
mkN : Str -> Str -> Noun -- irregular nouns
= \sg,pl -> lin N (mkNoun sg pl) ;
} ;
mkA : Str -> A = \s -> lin A (smartA s) ;
mkV = overload {
mkV : (inf : Str) -> V
= \s -> lin V (smartVerb s) ;
mkV : (inf,p1sg,p2sg,p3sg,p1pl,p2pl,p3pl : Str) -> V
= \inf,p1sg,p2sg,p3sg,p1pl,p2pl,p3pl -> lin V (irregVerb inf p1sg p2sg p3sg p1pl p2pl p3pl) ;
} ;
mkV2 = overload {
mkV2 : Str -> V2
= \s -> lin V2 (smartVerb s ** {c =\\num,gen => []}) ;
mkV2 : Str -> Str -> V2 -- predictable verb with preposition
= \s,p -> lin V2 (smartVerb s ** {c =\\num,gen => p}) ;
mkV2 : V -> V2 -- any verb with direct object
= \v -> lin V2 (v ** {c =\\num,gen => []}) ;
mkV2 : V -> Str -> V2 -- any verb with preposition
= \v,p -> lin V2 (v ** {c =\\num,gen => p}) ;
} ;
mkAdv : Str -> Adv
= \s -> lin Adv {s = s} ;
mkPrep : Str -> Prep
= \s -> lin Prep {s = s} ;
}

75
lab2/grammar/english/MicroResEn.gf Normal file
View File

@@ -0,0 +1,75 @@
resource MicroResEn = open Prelude in {
param
Number = Sg | Pl ;
Case = Nom | Acc ;
Agreement = Agr Number ; ---s Person to be added
-- all forms of normal Eng verbs, although not yet used in MiniGrammar
VForm = Inf | PresSg3 | Past | PastPart | PresPart ;
oper
Noun : Type = {s : Number => Str} ;
mkNoun : Str -> Str -> Noun = \sg,pl -> {
s = table {Sg => sg ; Pl => pl}
} ;
regNoun : Str -> Noun = \sg -> mkNoun sg (sg + "s") ;
-- smart paradigm
smartNoun : Str -> Noun = \sg -> case sg of {
_ + ("ay"|"ey"|"oy"|"uy") => regNoun sg ;
x + "y" => mkNoun sg (x + "ies") ;
_ + ("ch"|"sh"|"s"|"o") => mkNoun sg (sg + "es") ;
_ => regNoun sg
} ;
Adjective : Type = {s : Str} ;
Verb : Type = {s : VForm => Str} ;
mkVerb : (inf,pres,past,pastpart,prespart : Str) -> Verb
= \inf,pres,past,pastpart,prespart -> {
s = table {
Inf => inf ;
PresSg3 => pres ;
Past => past ;
PastPart => pastpart ;
PresPart => prespart
}
} ;
regVerb : (inf : Str) -> Verb = \inf ->
mkVerb inf (inf + "s") (inf + "ed") (inf + "ed") (inf + "ing") ;
-- regular verbs with predictable variations
smartVerb : Str -> Verb = \inf -> case inf of {
pl + ("a"|"e"|"i"|"o"|"u") + "y" => regVerb inf ;
cr + "y" => mkVerb inf (cr + "ies") (cr + "ied") (cr + "ied") (inf + "ing") ;
lov + "e" => mkVerb inf (inf + "s") (lov + "ed") (lov + "ed") (lov + "ing") ;
kis + ("s"|"sh"|"x"|"o") => mkVerb inf (inf + "es") (inf + "ed") (inf + "ed") (inf + "ing") ;
_ => regVerb inf
} ;
-- normal irregular verbs e.g. drink,drank,drunk
irregVerb : (inf,past,pastpart : Str) -> Verb =
\inf,past,pastpart ->
let verb = smartVerb inf
in mkVerb inf (verb.s ! PresSg3) past pastpart (verb.s ! PresPart) ;
-- two-place verb with "case" as preposition; for transitive verbs, c=[]
Verb2 : Type = Verb ** {c : Str} ;
be_Verb : Verb = mkVerb "are" "is" "was" "been" "being" ; ---s to be generalized
---s a very simplified verb agreement function for Micro
agr2vform : Agreement -> VForm = \a -> case a of {
Agr Sg => PresSg3 ;
Agr Pl => Inf
} ;
}

162
lab2/grammar/english/MicroResFr.gf Normal file
View File

@@ -0,0 +1,162 @@
resource MicroResFr = open Prelude in {
param
Number = Sg | Pl ;
Case = Nom | Acc ;
Gender = F | M ;
Person = P1 | P2 | P3 ;
-- infinitive | present forms of French verbs
VForm = VInf | VPres Person Number;
oper
--------------------- NOUNS --------------------------
------------------------------------------------------
Noun : Type = {s : Number => Str ; gen : Gender} ;
mkNoun : Str -> Str -> Noun = \sg,pl -> {
s = table {Sg => sg ; Pl => pl} ;
gen = mkGen sg
} ;
regNoun : Str -> Noun = \sg -> mkNoun sg (sg + "s") ;
smartNoun : Str -> Noun = \sg -> case sg of {
_ + ("é"|"o"|"e"|"n"|"t"|"r"|"i"|"il"|"ol"|"el") => regNoun sg ;
_ + ("au"|"eu"|"eau") => mkNoun sg (sg + "x") ;
noun + "al" => mkNoun sg (noun + "aux") ;
noun + ("z"|"s"|"x") => mkNoun sg sg ; --plural defective nouns
("sang"|"lait") => mkNoun sg sg --attempt in
} ;
mkGen: Str -> Gender = \sg -> case sg of {
root + ("au"|"isson"|"eu"|"t"|"o"|"age"|"é"|"ire"|"al"|"i"|"g"|"in"|"at"|"nt"|"en") => M ; -- some general rules for M nouns
("garçon"|"livre"|"arbre") => M ; -- exceptions for M
root + ("té"|"ion"|"elle"|"me"|"ère"|"eur"|"ure"|"che"|"le"|"aire"|"ue"|"er") => F ; -- some general rules for F nouns
("maison" | "eau") => F -- exceptions for F
} ;
----------------------- ADJ inflection tables ----------------------
--------------------------------------------------------------------
Adjective : Type = {s : Number => Gender => Str} ;
mkAdjective : (msg,fsg,mpl,fpl : Str) -> Adjective = \msg,fsg,mpl,fpl ->
{s = table { Sg => table { M => msg ; F => fsg } ; Pl => table { M => mpl ; F => fpl }
} ;
} ;
regA : (msg : Str) -> Adjective = \grand ->
mkAdjective grand (grand + "e") (grand + "s") (grand + "es") ;
irA_anc : (msg : Str) -> Adjective = \blanc ->
mkAdjective blanc (blanc+"he") (blanc + "s") (blanc+"hes" ) ;
irA_eau : (msg : Str) -> Adjective = \nouv ->
mkAdjective (nouv + "eau") (nouv + "elle") (nouv + "eaux") (nouv + "elles") ;
-- adj that are gender invariable - have the same form for both genders in Sg | Pl: e.g. "calme" "calme" "calmes" "calmes"
invar_gen : (msg : Str) -> Adjective = \propre ->
mkAdjective propre propre (propre + "s") (propre + "s") ;
-- adj that are number invariable - have the same form for both genders in Sg: e.g."anglais" "anglaise" "anglais" "anglaises"
invar_num : (msg : Str) -> Adjective = \mauvais ->
mkAdjective mauvais (mauvais + "e") mauvais (mauvais + "es") ;
dupl_n : (msg : Str) -> Adjective = \bon ->
let bonn = bon + last bon
in
mkAdjective bon (bonn + "e") (bon + "s") (bonn + "es") ;
smartA : (msg : Str) -> Adjective = \adj -> case adj of {
_ + ("d"|"t"|"eu"|"r") => regA adj ;
_ + "anc" => irA_anc adj ;
adj + "eau" => irA_eau adj ;
_ + "e" => invar_gen adj ;
_ + ("ien"|"on"|"en") => dupl_n adj ;
_ + "s" => invar_num adj
} ;
------------------- VERB Paradigms------------------------
----------------------------------------------------------
Verb : Type = {s : VForm => Str} ;
mkVerb : (vinf,p1sg,p1pl,p2sg,p2pl,p3sg,p3pl : Str) -> Verb
= \vinf,p1sg,p1pl,p2sg,p2pl,p3sg,p3pl -> {
s = table {
VInf => vinf ;
VPres P1 Sg => p1sg ;
VPres P2 Sg => p2sg ;
VPres P3 Sg => p3sg ;
VPres P1 Pl => p1pl ;
VPres P2 Pl => p2pl ;
VPres P3 Pl => p3pl
} ;
} ;
-- verbs ending in -ger that need an extra "e" for the 1st Person pl
ger_Verb : Str -> Verb = \manger ->
let mange = init manger
in
mkVerb manger mange (mange + "ons") (mange + "s") (mange + "z") mange (mange + "nt") ;
er_Verb : Str -> Verb = \aimer ->
let aim = init aimer
in
mkVerb aimer aim (aim + "ons") (aim + "s") (aim + "z") aim (aim + "nt") ;
ir_Verb : Str -> Verb = \cour ->
mkVerb cour (cour + "s") (cour + "ons") (cour + "s") (cour + "ez") (cour + "t") (cour + "ent") ;
re_Verb : Str -> Verb = \attendre ->
let attend = init attendre
in
mkVerb attendre (attend + "ds") (attend + "dons") (attend + "ds") (attend + "dez") (attend + "d") (attend + "dent") ;
-- regular verbs with predictable variations
smartVerb : Str -> Verb = \v -> case v of {
v + "re" => re_Verb v ;
v + "ir" => ir_Verb v ;
v + "er" => er_Verb v ;
_ + "g" + "er" => ger_Verb v
} ;
-- some irregular verbs e.g. acheter achète achètes
irregVerb : (vinf,p1sg,p2sg,p3sg,p1pl,p2pl,p3pl : Str) -> Verb =
\vinf,p1sg,p2sg,p3sg,p1pl,p2pl,p3pl ->
mkVerb vinf p1sg p2sg p3sg p1pl p2pl p3pl ;
-- two-place verb with "case" as preposition; for transitive verbs, c=[]
Verb2 : Type = Verb ** {c : Number => Gender => Str} ;
be_Verb : Verb = mkVerb "être" "suis" "es" "est" "sommes" "êtes" "sont" ; ---s to be generalized
Determiner : Type = {s : Str ; n : Number ; gen : Gender} ;
mkDet : Str -> Number -> Gender -> Determiner ;
mkDet str num gen = {s=str ; n = num ; gen = gen} ;
---s a very simplified verb agreement function for Micro
agr2vform : Number -> VForm = \a -> case a of {
Sg => VPres P3 Sg ;
Pl => VPres P3 Pl
} ;
}

234
lab2/grammar/english/MiniGrammarEng.gf Normal file
View File

@@ -0,0 +1,234 @@
--# -path=.:../abstract
concrete MiniGrammarEng of MiniGrammar = open MiniResEng, Prelude in {
lincat
Utt = {s : Str} ;
Pol = {s : Str ; isTrue : Bool} ; -- the s field is empty, but needed for parsing
Temp = {s : Str ; isPres : Bool} ;
S = {s : Str} ;
QS = {s : Str} ;
Cl = { -- word order is fixed in S and QS
subj : Str ; -- subject
verb : Bool => Bool => {fin,inf : Str} ; -- dep. on Pol,Temp, e.g. "does","sleep"
compl : Str -- after verb: complement, adverbs
} ;
QCl = Cl ** {isWh : Bool} ;
Imp = {s : Bool => Str} ;
VP = {verb : GVerb ; compl : Str} ;
Comp = {s : Str} ;
AP = Adjective ;
CN = Noun ;
NP = {s : Case => Str ; a : Agreement} ;
IP = {s : Case => Str ; a : Agreement} ;
Pron = {s : Case => Str ; a : Agreement} ;
Det = {s : Str ; n : Number} ;
Conj = {s : Str} ;
Prep = {s : Str} ;
V = Verb ;
V2 = Verb2 ;
VS = Verb ;
VV = Verb ; ---- only VV to VP
A = Adjective ;
N = Noun ;
PN = {s : Str} ;
Adv = {s : Str} ;
IAdv = {s : Str} ;
lin
UttS s = s ;
UttQS s = s ;
UttNP np = {s = np.s ! Acc} ; -- Acc: produce "me" rather than "I"
UttAdv adv = adv ;
UttIAdv iadv = iadv ;
UttImpSg pol imp = {s = pol.s ++ imp.s ! pol.isTrue} ;
UseCl temp pol cl =
let clt = cl.verb ! pol.isTrue ! temp.isPres -- isTrue regulates if "do" is used
in {
s = pol.s ++ temp.s ++ --- needed for parsing: a GF hack
cl.subj ++ -- she
clt.fin ++ -- does
negation pol.isTrue ++ -- not
clt.inf ++ -- drink
cl.compl -- beer
} ;
UseQCl temp pol qcl =
let
isWh = qcl.isWh ;
clt = qcl.verb ! andB isWh pol.isTrue ! temp.isPres ; -- no "do" in present positive Wh questions
verbsubj = case isWh of {
True => qcl.subj ++ clt.fin ; -- no inversion in Wh questions
False => clt.fin ++ qcl.subj
}
in {
s = pol.s ++ temp.s ++
verbsubj ++
negation pol.isTrue ++ -- not
clt.inf ++ -- drink
qcl.compl -- beer
} ;
PredVP np vp = {
subj = np.s ! Nom ;
compl = vp.compl ;
verb = \\plain,isPres => case <vp.verb.isAux, plain, isPres, np.a> of {
-- non-auxiliary verbs, negative/question present: "does (not) drink"
<False,False,True,Agr Sg Per3> => {fin = "does" ; inf = vp.verb.s ! VF Inf} ;
<False,False,True,_ > => {fin = "do" ; inf = vp.verb.s ! VF Inf} ;
-- non-auxiliary, plain present ; auxiliary, all present: "drinks", "is (not)"
<_,_, True, Agr Sg Per1> => {fin = vp.verb.s ! PresSg1 ; inf = []} ;
<_,_, True, Agr Sg Per3> => {fin = vp.verb.s ! VF PresSg3 ; inf = []} ;
<_,_, True, _> => {fin = vp.verb.s ! PresPl ; inf = []} ;
-- all verbs, past: "has (not) drunk", "has (not) been"
<_,_, False,Agr Sg Per3> => {fin = "has" ; inf = vp.verb.s ! VF PastPart} ;
<_,_, False,_ > => {fin = "have" ; inf = vp.verb.s ! VF PastPart}
-- the negation word "not" is put in place in UseCl, UseQCl
}
} ;
QuestCl cl = cl ** {isWh = False} ; -- since the parts are the same, we don't need to change anything
QuestVP ip vp = PredVP ip vp ** {isWh = True} ;
ImpVP vp = {
s = table {
True => vp.verb.s ! VF Inf ++ vp.compl ; -- in Eng, imperative = infinitive
False => "do not" ++ vp.verb.s ! VF Inf ++ vp.compl
}
} ;
UseV v = {
verb = verb2gverb v ; -- lift ordinary verbs to generalized verbs
compl = []
} ;
ComplV2 v2 np = {
verb = verb2gverb v2 ;
compl = v2.c ++ np.s ! Acc -- NP object in the accusative, preposition first
} ;
ComplVS vs s = {
verb = verb2gverb vs ;
compl = "that" ++ s.s ;
} ;
ComplVV vv vp = {
verb = verb2gverb vv ;
compl = "to" ++ vp.verb.s ! VF Inf ++ vp.compl ;
} ;
UseComp comp = {
verb = be_GVerb ; -- the verb is the copula "be"
compl = comp.s
} ;
CompAP ap = ap ;
CompNP np = {
s = np.s ! Nom -- NP complement is in the nominative
} ;
CompAdv adv = adv ;
AdvVP vp adv =
vp ** {compl = vp.compl ++ adv.s} ;
DetCN det cn = {
s = table {c => det.s ++ cn.s ! det.n} ;
a = Agr det.n Per3 -- this kind of NP is always third person
} ;
UsePN pn = {
s = \\_ => pn.s ;
a = Agr Sg Per3
} ;
UsePron p = p ; -- Pron is worst-case NP
MassNP cn = {
s = \\_ => cn.s ! Sg ;
a = Agr Sg Per3
} ;
a_Det = {s = pre {"a"|"e"|"i"|"o" => "an" ; _ => "a"} ; n = Sg} ; --- a/an can get wrong
aPl_Det = {s = "" ; n = Pl} ;
the_Det = {s = "the" ; n = Sg} ;
thePl_Det = {s = "the" ; n = Pl} ;
UseN n = n ;
AdjCN ap cn = {
s = table {n => ap.s ++ cn.s ! n}
} ;
PositA a = a ;
PrepNP prep np = {s = prep.s ++ np.s ! Acc} ;
CoordS conj a b = {s = a.s ++ conj.s ++ b.s} ;
PPos = {s = [] ; isTrue = True} ;
PNeg = {s = [] ; isTrue = False} ;
TSim = {s = [] ; isPres = True} ;
TAnt = {s = [] ; isPres = False} ;
and_Conj = {s = "and"} ;
or_Conj = {s = "or"} ;
every_Det = {s = "every" ; n = Sg} ;
in_Prep = {s = "in"} ;
on_Prep = {s = "on"} ;
with_Prep = {s = "with"} ;
i_Pron = {
s = table {Nom => "I" ; Acc => "me"} ;
a = Agr Sg Per1
} ;
youSg_Pron = {
s = \\_ => "you" ;
a = Agr Sg Per2
} ;
he_Pron = {
s = table {Nom => "he" ; Acc => "him"} ;
a = Agr Sg Per3
} ;
she_Pron = {
s = table {Nom => "she" ; Acc => "her"} ;
a = Agr Sg Per3
} ;
we_Pron = {
s = table {Nom => "we" ; Acc => "us"} ;
a = Agr Pl Per1
} ;
youPl_Pron = {
s = \\_ => "you" ;
a = Agr Pl Per2
} ;
they_Pron = {
s = table {Nom => "they" ; Acc => "them"} ;
a = Agr Pl Per3
} ;
whoSg_IP = {
s = table {Nom => "who" ; Acc => "whom"} ;
a = Agr Sg Per3
} ;
where_IAdv = {s = "where"} ;
why_IAdv = {s = "why"} ;
have_V2 = mkVerb "have" "has" "had" "had" "having" ** {c = []} ;
want_VV = regVerb "want" ;
}

3
lab2/grammar/english/MiniLangEng.gf Normal file
View File

@@ -0,0 +1,3 @@
--# -path=.:../abstract
concrete MiniLangEng of MiniLang = MiniGrammarEng, MiniLexiconEng ;

6
lab2/grammar/english/MiniLangEng.labels Normal file
View File

@@ -0,0 +1,6 @@
UseCl, UseQCl, ImpVP {"not"} PART advmod head
UseComp {"is","are","am","was","were","been","be"} AUX cop head
PredVP, QuestVP {"has","had","have","do","does"} AUX aux head
ImpVP {"do"} AUX aux head
ComplVS {"that"} SCONJ mark ccomp
ComplVV {"to"} PART mark xcomp

94
lab2/grammar/english/MiniLexiconEng.gf Normal file
View File

@@ -0,0 +1,94 @@
concrete MiniLexiconEng of MiniLexicon = MiniGrammarEng **
open
MiniParadigmsEng
in {
lin already_Adv = mkAdv "already" ;
lin animal_N = mkN "animal" ;
lin apple_N = mkN "apple" ;
lin baby_N = mkN "baby" ;
lin bad_A = mkA "bad" ;
lin beer_N = mkN "beer" ;
lin big_A = mkA "big" ;
lin bike_N = mkN "bike" ;
lin bird_N = mkN "bird" ;
lin black_A = mkA "black" ;
lin blood_N = mkN "blood" ;
lin blue_A = mkA "blue" ;
lin boat_N = mkN "boat" ;
lin book_N = mkN "book" ;
lin boy_N = mkN "boy" ;
lin bread_N = mkN "bread" ;
lin break_V2 = mkV2 (mkV "break" "broke" "broken") ;
lin buy_V2 = mkV2 (mkV "buy" "bought" "bought") ;
lin car_N = mkN "car" ;
lin cat_N = mkN "cat" ;
lin child_N = mkN "child" "children" ;
lin city_N = mkN "city" ;
lin clean_A = mkA "clean" ;
lin clever_A = mkA "clever" ;
lin cloud_N = mkN "cloud" ;
lin cold_A = mkA "cold" ;
lin come_V = mkV "come" "came" "come" ;
lin computer_N = mkN "computer" ;
lin cow_N = mkN "cow" ;
lin dirty_A = mkA "dirty" ;
lin dog_N = mkN "dog" ;
lin drink_V2 = mkV2 (mkV "drink" "drank" "drunk") ;
lin eat_V2 = mkV2 (mkV "eat" "ate" "eaten") ;
lin find_V2 = mkV2 (mkV "find" "found" "found") ;
lin fire_N = mkN "fire" ;
lin fish_N = mkN "fish" "fish" ;
lin flower_N = mkN "flower" ;
lin friend_N = mkN "friend" ;
lin girl_N = mkN "girl" ;
lin good_A = mkA "good" ;
lin go_V = mkV "go" "went" "gone" ;
lin grammar_N = mkN "grammar" ;
lin green_A = mkA "green" ;
lin heavy_A = mkA "heavy" ;
lin horse_N = mkN "horse" ;
lin hot_A = mkA "hot" ;
lin house_N = mkN "house" ;
lin john_PN = mkPN "John" ;
lin jump_V = mkV "jump" ;
lin kill_V2 = mkV2 "kill" ;
lin know_VS = mkVS (mkV "know" "knew" "known") ;
lin language_N = mkN "language" ;
lin live_V = mkV "live" ;
lin love_V2 = mkV2 (mkV "love") ;
lin man_N = mkN "man" "men" ;
lin milk_N = mkN "milk" ;
lin music_N = mkN "music" ;
lin new_A = mkA "new" ;
lin now_Adv = mkAdv "now" ;
lin old_A = mkA "old" ;
lin paris_PN = mkPN "Paris" ;
lin play_V = mkV "play" ;
lin read_V2 = mkV2 (mkV "read" "read" "read") ;
lin ready_A = mkA "ready" ;
lin red_A = mkA "red" ;
lin river_N = mkN "river" ;
lin run_V = mkV "run" "ran" "run" ;
lin sea_N = mkN "sea" ;
lin see_V2 = mkV2 (mkV "see" "saw" "seen") ;
lin ship_N = mkN "ship" ;
lin sleep_V = mkV "sleep" "slept" "slept" ;
lin small_A = mkA "small" ;
lin star_N = mkN "star" ;
lin swim_V = mkV "swim" "swam" "swum" ;
lin teach_V2 = mkV2 (mkV "teach" "taught" "taught") ;
lin train_N = mkN "train" ;
lin travel_V = mkV "travel" ;
lin tree_N = mkN "tree" ;
lin understand_V2 = mkV2 (mkV "understand" "understood" "understood") ;
lin wait_V2 = mkV2 "wait" "for" ;
lin walk_V = mkV "walk" ;
lin warm_A = mkA "warm" ;
lin water_N = mkN "water" ;
lin white_A = mkA "white" ;
lin wine_N = mkN "wine" ;
lin woman_N = mkN "woman" "women" ;
lin yellow_A = mkA "yellow" ;
lin young_A = mkA "young" ;
}

49
lab2/grammar/english/MiniParadigmsEng.gf Normal file
View File

@@ -0,0 +1,49 @@
resource MiniParadigmsEng = open
MiniGrammarEng,
MiniResEng
in {
oper
mkN = overload {
mkN : Str -> Noun -- predictable noun, e.g. car-cars, boy-boys, fly-flies, bush-bushes
= \n -> lin N (smartNoun n) ;
mkN : Str -> Str -> Noun -- irregular noun, e.g. man-men
= \sg,pl -> lin N (mkNoun sg pl) ;
} ;
mkPN : Str -> PN
= \s -> lin PN {s = s} ;
mkA : Str -> A
= \s -> lin A {s = s} ;
mkV = overload {
mkV : (inf : Str) -> V -- predictable verb, e.g. play-plays, cry-cries, wash-washes
= \s -> lin V (smartVerb s) ;
mkV : (inf,pres,part : Str) -> V -- irregular verb, e.g. drink-drank-drunk
= \inf,pres,part -> lin V (irregVerb inf pres part) ;
} ;
mkV2 = overload {
mkV2 : Str -> V2 -- predictable verb with direct object, e.g. "wash"
= \s -> lin V2 (smartVerb s ** {c = []}) ;
mkV2 : Str -> Str -> V2 -- predictable verb with preposition, e.g. "wait - for"
= \s,p -> lin V2 (smartVerb s ** {c = p}) ;
mkV2 : V -> V2 -- any verb with direct object, e.g. "drink"
= \v -> lin V2 (v ** {c = []}) ;
mkV2 : V -> Str -> V2 -- any verb with preposition
= \v,p -> lin V2 (v ** {c = p}) ;
} ;
mkVS : V -> VS
= \v -> lin VS v ;
mkAdv : Str -> Adv
= \s -> lin Adv {s = s} ;
mkPrep : Str -> Prep
= \s -> lin Prep {s = s} ;
}

99
lab2/grammar/english/MiniResEng.gf Normal file
View File

@@ -0,0 +1,99 @@
resource MiniResEng = open Prelude in {
param
Number = Sg | Pl ;
Case = Nom | Acc ;
Person = Per1 | Per2 | Per3 ;
Agreement = Agr Number Person ;
-- all forms of normal Eng verbs, although not yet used in MiniGrammar
VForm = Inf | PresSg3 | Past | PastPart | PresPart ;
oper
Noun : Type = {s : Number => Str} ;
mkNoun : Str -> Str -> Noun = \sg,pl -> {
s = table {Sg => sg ; Pl => pl}
} ;
regNoun : Str -> Noun = \sg -> mkNoun sg (sg + "s") ;
-- smart paradigm
smartNoun : Str -> Noun = \sg -> case sg of {
_ + ("ay"|"ey"|"oy"|"uy") => regNoun sg ;
x + "y" => mkNoun sg (x + "ies") ;
_ + ("ch"|"sh"|"s"|"o") => mkNoun sg (sg + "es") ;
_ => regNoun sg
} ;
Adjective : Type = {s : Str} ;
Verb : Type = {s : VForm => Str} ;
mkVerb : (inf,pres,past,pastpart,prespart : Str) -> Verb
= \inf,pres,past,pastpart,prespart -> {
s = table {
Inf => inf ;
PresSg3 => pres ;
Past => past ;
PastPart => pastpart ;
PresPart => prespart
}
} ;
regVerb : (inf : Str) -> Verb = \inf ->
mkVerb inf (inf + "s") (inf + "ed") (inf + "ed") (inf + "ing") ;
-- regular verbs with predictable variations
smartVerb : Str -> Verb = \inf -> case inf of {
pl + ("a"|"e"|"i"|"o"|"u") + "y" => regVerb inf ;
cr + "y" => mkVerb inf (cr + "ies") (cr + "ied") (cr + "ied") (inf + "ing") ;
lov + "e" => mkVerb inf (inf + "s") (lov + "ed") (lov + "ed") (lov + "ing") ;
kis + ("s"|"sh"|"x"|"o") => mkVerb inf (inf + "es") (inf + "ed") (inf + "ed") (inf + "ing") ;
_ => regVerb inf
} ;
-- normal irregular verbs e.g. drink,drank,drunk
irregVerb : (inf,past,pastpart : Str) -> Verb =
\inf,past,pastpart ->
let verb = smartVerb inf
in mkVerb inf (verb.s ! PresSg3) past pastpart (verb.s ! PresPart) ;
negation : Bool -> Str = \b -> case b of {True => [] ; False => "not"} ;
-- two-place verb with "case" as preposition; for transitive verbs, c=[]
Verb2 : Type = Verb ** {c : Str} ;
-- generalized verb, here just "be"
param
GVForm = VF VForm | PresSg1 | PresPl | PastPl ;
oper
GVerb : Type = {
s : GVForm => Str ;
isAux : Bool
} ;
be_GVerb : GVerb = {
s = table {
PresSg1 => "am" ;
PresPl => "are" ;
PastPl => "were" ;
VF vf => (mkVerb "be" "is" "was" "been" "being").s ! vf
} ;
isAux = True
} ;
-- in VP formation, all verbs are lifted to GVerb, but morphology doesn't need to know this
verb2gverb : Verb -> GVerb = \v -> {s =
table {
PresSg1 => v.s ! Inf ;
PresPl => v.s ! Inf ;
PastPl => v.s ! Past ;
VF vf => v.s ! vf
} ;
isAux = False
} ;
}