1
0
forked from GitHub/gf-core

tuning resource API

This commit is contained in:
aarne
2005-02-06 09:52:19 +00:00
parent bd432cf147
commit c30eebbba6
35 changed files with 2065 additions and 1432 deletions

View File

@@ -1,7 +1,7 @@
--# -path=.:../abstract:../../prelude
--# -val
concrete BasicEng of Basic = CategoriesEng ** open NewParadigmsEng in {
concrete BasicEng of Basic = CategoriesEng ** open ParadigmsEng in {
flags
startcat=Phr ; lexer=textlit ; unlexer=text ;
@@ -220,4 +220,10 @@ lin
put_V2 = mkV2 (irregDuplV "put" "put" "put") [] ;
stop_V = regV "stop" ;
jump_V = regV "jump" ;
here_Adv = mkAdv "here" ;
here7to_Adv = mkAdv "here" ;
here7from_Adv = mkAdv ["from here"] ;
there_Adv = mkAdv "there" ;
there7to_Adv = mkAdv "there" ;
there7from_Adv = mkAdv ["from there"] ;
} ;

View File

@@ -34,6 +34,7 @@ lincat
NP = {s : NPForm => Str ; a : Agr} ;
PN = {s : Case => Str ; g : Gender} ;
Det = {s : Str ; n : Number} ;
NDet = {s : Str} ;
N2 = Function ;
-- = CommNounPhrase ** {s2 : Preposition} ;
N3 = Function ** {s3 : Preposition} ;
@@ -88,6 +89,7 @@ lincat
RS = {s : Agr => Str} ;
IP = {s : NPForm => Str ; n : Number ; g : Gender} ;
IDet = {s : Str ; n : Number} ;
QCl = {s : Bool => SForm => QuestForm => Str} ;
QS = {s : QuestForm => Str} ;
Imp = {s : Number => Str} ;
@@ -100,5 +102,6 @@ lincat
ListS = {s1 : Str ; s2 : Str} ;
ListAP = {s1,s2 : AForm => Str ; p : Bool} ;
ListNP = {s1,s2 : NPForm => Str ; a : Agr} ;
ListAdv = {s1 : Str ; s2 : Str} ;
} ;

View File

@@ -1,4 +1,4 @@
concrete CountryEng of Country = open ResourceEng, NewParadigmsEng in {
concrete CountryEng of Country = open ResourceEng, ParadigmsEng in {
lincat
Country = PN ;

View File

@@ -0,0 +1,22 @@
--# -path=.:../abstract:../../prelude
concrete LangEng of Lang =
RulesEng,
ClauseEng,
StructuralEng,
BasicEng,
TimeEng,
CountryEng
** open Prelude, ResourceEng, ParadigmsEng in {
lin
AdvDate d = prefixSS "on" d ;
AdvTime t = prefixSS "at" t ;
NWeekday w = w ;
PNWeekday w = nounPN w ;
PNCountry x = x ;
ANationality x = x ;
NLanguage x = x ;
}

View File

@@ -1,413 +0,0 @@
--# -path=.:../abstract:../../prelude
--1 English Lexical Paradigms UNDER RECONSTRUCTION!
--
-- Aarne Ranta 2003
--
-- This is an API to the user of the resource grammar
-- for adding lexical items. It gives functions for forming
-- expressions of open categories: nouns, adjectives, verbs.
--
-- Closed categories (determiners, pronouns, conjunctions) are
-- accessed through the resource syntax API, $Structural.gf$.
--
-- The main difference with $MorphoEng.gf$ is that the types
-- referred to are compiled resource grammar types. We have moreover
-- had the design principle of always having existing forms, rather
-- than stems, as string arguments of the paradigms.
--
-- The structure of functions for each word class $C$ is the following:
-- first we give a handful of patterns that aim to cover all
-- regular cases. Then we give a worst-case function $mkC$, which serves as an
-- escape to construct the most irregular words of type $C$.
-- However, this function should only seldom be needed: we have a
-- separate module $IrregularEng$, which covers all irregularly inflected
-- words.
--
-- The following modules are presupposed:
resource NewParadigmsEng = open (Predef=Predef), Prelude, SyntaxEng, ResourceEng in {
--2 Parameters
--
-- To abstract over gender names, we define the following identifiers.
oper
Gender : Type ;
human : Gender ;
nonhuman : Gender ;
masculine : Gender ;
feminite : Gender ;
-- To abstract over number names, we define the following.
Number : Type ;
singular : Number ;
plural : Number ;
-- To abstract over case names, we define the following.
Case : Type ;
nominative : Case ;
genitive : Case ;
-- Prepositions used in many-argument functions are just strings.
Preposition : Type = Str ;
--2 Nouns
-- Worst case: give all four forms and the semantic gender.
mkN : (man,men,man's,men's : Str) -> N ;
-- The regular function captures the variants for nouns ending with
-- "s","sh","x","z" or "y": "kiss - kisses", "flash - flashes";
-- "fly - flies" (but "toy - toys"),
regN : Str -> N ;
-- In practice the worst case is just: give singular and plural nominative.
mk2N : (man,men : Str) -> N ;
-- All nouns created by the previous functions are marked as
-- $nonhuman$. If you want a $human$ noun, wrap it with the following
-- function:
genderN : Gender -> N -> N ;
--3 Compound nouns
--
-- All the functions above work quite as well to form compound nouns,
-- such as "baby boom".
--3 Relational nouns
--
-- Relational nouns ("daughter of x") need a preposition.
mkN2 : N -> Preposition -> N2 ;
-- The most common preposition is "of", and the following is a
-- shortcut for regular, $nonhuman$ relational nouns with "of".
regN2 : Str -> N2 ;
-- Use the function $mkPreposition$ or see the section on prepositions below to
-- form other prepositions.
--
-- Three-place relational nouns ("the connection from x to y") need two prepositions.
mkN3 : N -> Preposition -> Preposition -> N3 ;
--3 Relational common noun phrases
--
-- In some cases, you may want to make a complex $CN$ into a
-- relational noun (e.g. "the old town hall of").
cnN2 : CN -> Preposition -> N2 ;
cnN3 : CN -> Preposition -> Preposition -> N3 ;
--
--3 Proper names and noun phrases
--
-- Proper names, with a regular genitive, are formed as follows
regPN : Str -> Gender -> PN ; -- John, John's
-- To form a noun phrase that can also be plural and have an irregular
-- genitive, you can use the worst-case function.
mkNP : Str -> Str -> Number -> Gender -> NP ;
--2 Adjectives
-- Non-comparison one-place adjectives need two forms: one for
-- the adjectival and one for the adverbial form ("free - freely")
mkA : (free,freely : Str) -> A ;
-- For regular adjectives, the adverbial form is derived. This holds
-- even for cases with the variation "happy - happily".
regA : Str -> A ;
--3 Two-place adjectives
--
-- Two-place adjectives need a preposition for their second argument.
mkA2 : A -> Preposition -> A2 ;
-- Comparison adjectives may two more forms.
mkADeg : (good,better,best,well : Str) -> ADeg ;
-- The regular pattern recognizes two common variations:
-- "-e" ("rude" - "ruder" - "rudest") and
-- "-y" ("happy - happier - happiest - happily")
regADeg : Str -> ADeg ; -- long, longer, longest
-- However, the duplication of the final consonant is nor predicted,
-- but a separate pattern is used:
duplADeg : Str -> ADeg ; -- fat, fatter, fattest
-- If comparison is formed by "more, "most", as in general for
-- long adjective, the following pattern is used:
compoundADeg : A -> ADeg ; -- -/more/most ridiculous
-- From a given $ADeg$, it is possible to get back to $A$.
adegA : ADeg -> A ;
--2 Adverbs
-- Adverbs are not inflected. Most lexical ones have position
-- after the verb. Some can be preverbal (e.g. "always").
mkAdv : Str -> Adv ;
mkAdV : Str -> AdV ;
-- Adverbs modifying adjectives and sentences can also be formed.
mkAdA : Str -> AdA ;
--2 Prepositions
--
-- A preposition is just a string.
mkPreposition : Str -> Preposition ;
--2 Verbs
--
-- Except for "be", the worst case needs five forms: the infinitive and
-- the third person singular present, the past indicative, and the
-- past and present participles.
mkV : (go, goes, went, gone, going : Str) -> V ;
-- The regular verb function recognizes the special cases where the last
-- character is "y" ("cry - cries" but "buy - buys") or "s", "sh", "x", "z"
-- ("fix - fixes", etc).
regV : Str -> V ;
-- The following variant duplicates the last letter in the forms like
-- "rip - ripped - ripping".
regDuplV : Str -> V ;
-- There is an extensive list of irregular verbs in the module $IrregularEng$.
-- In practice, it is enough to give three forms,
-- e.g. "drink - drank - drunk", with a variant indicating consonant
-- duplication in the present participle.
irregV : (drink, drank, drunk : Str) -> V ;
irregDuplV : (get, got, gotten : Str) -> V ;
--3 Verbs with a particle.
--
-- The particle, such as in "switch on", is given as a string.
partV : V -> Str -> V ;
--3 Two-place verbs
--
-- Two-place verbs need a preposition, except the special case with direct object.
-- (transitive verbs). Notice that a particle comes from the $V$.
mkV2 : V -> Preposition -> V2 ;
dirV2 : V -> V2 ;
--3 Three-place verbs
--
-- Three-place (ditransitive) verbs need two prepositions, of which
-- the first one or both can be absent.
mkV3 : V -> Str -> Str -> V3 ; -- speak, with, about
dirV3 : V -> Str -> V3 ; -- give,_,to
dirdirV3 : V -> V3 ; -- give,_,_
--3 Other complement patterns
--
-- Verbs and adjectives can take complements such as sentences,
-- questions, verb phrases, and adjectives.
mkV0 : V -> V0 ;
mkVS : V -> VS ;
mkV2S : V -> Str -> V2S ;
mkVV : V -> VV ;
mkV2V : V -> Str -> Str -> V2V ;
mkVA : V -> VA ;
mkV2A : V -> Str -> V2A ;
mkVQ : V -> VQ ;
mkV2Q : V -> Str -> V2Q ;
mkAS : A -> AS ;
mkA2S : A -> Str -> A2S ;
mkAV : A -> AV ;
mkA2V : A -> Str -> A2V ;
--2 Definitions of paradigms
--
-- The definitions should not bother the user of the API. So they are
-- hidden from the document.
--.
Gender = SyntaxEng.Gender ;
Number = SyntaxEng.Number ;
Case = SyntaxEng.Case ;
human = Masc ;
nonhuman = Neutr ;
masculine = Masc ;
feminine = Fem ;
singular = Sg ;
plural = Pl ;
nominative = Nom ;
genitive = Gen ;
regN = \ray ->
let
ra = Predef.tk 1 ray ;
y = Predef.dp 1 ray ;
r = Predef.tk 2 ray ;
ay = Predef.dp 2 ray ;
rays =
case y of {
"y" => y2ie ray "s" ;
"s" => ray + "es" ;
"z" => ray + "es" ;
"x" => ray + "es" ;
_ => case ay of {
"sh" => ray + "es" ;
"ch" => ray + "es" ;
_ => ray + "s"
}
}
in
mk2N ray rays ;
mk2N = \man,men ->
let mens = case last men of {
"s" => men + "'" ;
_ => men + "'s"
}
in
mkN man men (man + "'s") mens ;
mkN = \man,men,man's,men's ->
mkNoun man men man's men's ** {g = Neutr ; lock_N = <>} ;
genderN g man = {s = man.s ; g = g ; lock_N = <>} ;
mkN2 = \n,p -> UseN n ** {lock_N2 = <> ; s2 = p} ;
regN2 n = mkN2 (regN n) (mkPreposition "of") ;
mkN3 = \n,p,q -> UseN n ** {lock_N3 = <> ; s2 = p ; s3 = q} ;
cnN2 = \n,p -> n ** {lock_N2 = <> ; s2 = p} ;
cnN3 = \n,p,q -> n ** {lock_N3 = <> ; s2 = p ; s3 = q} ;
regPN n g = nameReg n g ** {lock_PN = <>} ;
mkNP x y n g = {s = table {GenP => x ; _ => y} ; a = toAgr n P3 g ;
lock_NP = <>} ;
mkA a b = mkAdjective a b ** {lock_A = <>} ;
regA a = regAdjective a ** {lock_A = <>} ;
mkA2 a p = a ** {s2 = p ; lock_A2 = <>} ;
mkADeg a b c d = mkAdjDegrWorst a b c c d d ** {lock_ADeg = <>} ;
regADeg happy =
let
happ = init happy ;
y = last happy ;
happie = case y of {
"y" => happ + "ie" ;
"e" => happy ;
_ => happy + "e"
} ;
happily = case y of {
"y" => happ + "ily" ;
_ => happy + "ly"
} ;
in mkADeg happy happily (happie + "r") (happie + "st") ;
duplADeg fat = mkADeg fat
(fat + "ly") (fat + last fat + "er") (fat + last fat + "est") ;
compoundADeg a = let ad = (a.s ! AAdj) in
mkADeg ad (a.s ! AAdv) ("more" ++ ad) ("most" ++ ad) ;
adegA a = {s = a.s ! Pos ; lock_A = <>} ;
mkAdv x = ss x ** {lock_Adv = <>} ;
mkAdV x = ss x ** {lock_AdV = <>} ;
mkAdA x = ss x ** {lock_AdA = <>} ;
mkPreposition p = p ;
mkV a b c d e = mkVerbP3worst a b c d e ** {s1 = [] ; lock_V = <>} ;
regV cry =
let
cr = init cry ;
y = last cry ;
cries = (regN cry).s ! Pl ! Nom ; -- !
crie = init cries ;
cried = case last crie of {
"e" => crie + "d" ;
_ => crie + "ed"
} ;
crying = case y of {
"e" => cr + "ing" ;
_ => cry + "ing"
}
in mkV cry cries cried cried crying ;
regDuplV fit =
let fitt = fit + last fit in
mkV fit (fit + "s") (fitt + "ed") (fitt + "ed") (fitt + "ing") ;
irregV x y z = mkVerbIrreg x y z ** {s1 = [] ; lock_V = <>} ;
irregDuplV fit y z =
let
fitting = (regDuplV fit).s ! PresPart
in
mkV fit (fit + "s") y z fitting ;
partV v p = {s = v.s ; s1 = p ; lock_V = <>} ;
mkV2 v p = v ** {s = v.s ; s1 = v.s1 ; s3 = p ; lock_V2 = <>} ;
dirV2 v = mkV2 v [] ;
mkV3 v p q = v ** {s = v.s ; s1 = v.s1 ; s3 = p ; s4 = q ; lock_V3 = <>} ;
dirV3 v p = mkV3 v [] p ;
dirdirV3 v = dirV3 v [] ;
mkV0 v = v ** {lock_V0 = <>} ;
mkVS v = v ** {lock_VS = <>} ;
mkV2S v p = mkV2 v p ** {lock_V2S = <>} ;
mkVV v = v ** {isAux = False ; lock_VV = <>} ;
mkV2V v p t = mkV2 v p ** {s4 = t ; lock_V2V = <>} ;
mkVA v = v ** {lock_VA = <>} ;
mkV2A v p = mkV2 v p ** {lock_V2A = <>} ;
mkVQ v = v ** {lock_VQ = <>} ;
mkV2Q v p = mkV2 v p ** {lock_V2Q = <>} ;
mkAS v = v ** {lock_AS = <>} ;
mkA2S v p = mkA2 v p ** {lock_A2S = <>} ;
mkAV v = v ** {lock_AV = <>} ;
mkA2V v p = mkA2 v p ** {lock_A2V = <>} ;
} ;

View File

@@ -0,0 +1,301 @@
--# -path=.:../abstract:../../prelude
--1 English Lexical Paradigms
--
-- Aarne Ranta 2003
--
-- This is an API to the user of the resource grammar
-- for adding lexical items. It give shortcuts for forming
-- expressions of basic categories: nouns, adjectives, verbs.
--
-- Closed categories (determiners, pronouns, conjunctions) are
-- accessed through the resource syntax API, $Structural.gf$.
--
-- The main difference with $MorphoEng.gf$ is that the types
-- referred to are compiled resource grammar types. We have moreover
-- had the design principle of always having existing forms, rather
-- than stems, as string
-- arguments of the paradigms.
--
-- The following modules are presupposed:
resource OldParadigmsEng = open (Predef=Predef), Prelude, SyntaxEng, ResourceEng in {
--2 Parameters
--
-- To abstract over gender names, we define the following identifiers.
oper
Gender : Type ;
human : Gender ;
nonhuman : Gender ;
-- To abstract over number names, we define the following.
Number : Type ;
singular : Number ;
plural : Number ;
-- To abstract over case names, we define the following.
Case : Type ;
nominative : Case ;
genitive : Case ;
--2 Nouns
-- Worst case: give all four forms and the semantic gender.
-- In practice the worst case is just: give singular and plural nominative.
oper
mkN : (man,men,man's,men's : Str) -> Gender -> N ;
nMan : (man,men : Str) -> Gender -> N ;
-- Regular nouns, nouns ending with "s", "y", or "o", and nouns with the same
-- plural form as the singular.
nReg : Str -> Gender -> N ; -- dog, dogs
nKiss : Str -> Gender -> N ; -- kiss, kisses
nFly : Str -> Gender -> N ; -- fly, flies
nHero : Str -> Gender -> N ; -- hero, heroes (= nKiss !)
nSheep : Str -> Gender -> N ; -- sheep, sheep
-- These use general heuristics, that recognizes the last letter. *N.B* it
-- does not get right with "boy", "rush", since it only looks at one letter.
nHuman : Str -> N ; -- gambler/actress/nanny
nNonhuman : Str -> N ; -- dog/kiss/fly
-- Nouns used as functions need a preposition. The most common is "of".
mkN2 : N -> Preposition -> N2 ;
funHuman : Str -> N2 ; -- the father/mistress/daddy of
funNonhuman : Str -> N2 ; -- the successor/address/copy of
-- Proper names, with their regular genitive.
pnReg : (John : Str) -> PN ; -- John, John's
-- The most common cases on the higher-level category $CN$ have shortcuts.
-- The regular "y"/"s" variation is taken into account.
cnNonhuman : Str -> CN ;
cnHuman : Str -> CN ;
npReg : Str -> NP ;
-- In some cases, you may want to make a complex $CN$ into a function.
mkN2CN : CN -> Preposition -> N2 ;
funOfCN : CN -> N2 ;
--2 Adjectives
-- Non-comparison one-place adjectives just have one form.
mkA : (even : Str) -> A ;
-- Two-place adjectives need a preposition as second argument.
mkA2 : (divisible, by : Str) -> A2 ;
-- Comparison adjectives have three forms. The common irregular
-- cases are ones ending with "y" and a consonant that is duplicated;
-- the "y" ending is recognized by the function $aReg$.
mkADeg : (good,better,best : Str) -> ADeg ;
aReg : (long : Str) -> ADeg ; -- long, longer, longest
aFat : (fat : Str) -> ADeg ; -- fat, fatter, fattest
aRidiculous : (ridiculous : Str) -> ADeg ; -- -/more/most ridiculous
-- On higher level, there are adjectival phrases. The most common case is
-- just to use a one-place adjective.
apReg : Str -> AP ;
--2 Adverbs
-- Adverbs are not inflected. Most lexical ones have position not
-- before the verb. Some can be preverbal (e.g. "always").
mkAdv : Str -> Adv ;
mkAdvPre : Str -> Adv ;
-- Adverbs modifying adjectives and sentences can also be formed.
mkAdA : Str -> AdA ;
mkAdC : Str -> AdC ;
-- Prepositional phrases are another productive form of adverbials.
mkPP : Str -> NP -> Adv ;
--2 Verbs
--
-- The fragment now has all verb forms, except the gerund/present participle.
-- Except for "be", the worst case needs four forms: the infinitive and
-- the third person singular present, the past indicative, and the past participle.
mkV : (go, goes, went, gone : Str) -> V ;
vReg : (walk : Str) -> V ; -- walk, walks
vKiss : (kiss : Str) -> V ; -- kiss, kisses
vFly : (fly : Str) -> V ; -- fly, flies
vGo : (go : Str) -> V ; -- go, goes (= vKiss !)
-- This generic function recognizes the special cases where the last
-- character is "y", "s", or "z". It is not right for "finish" and "convey".
vGen : Str -> V ; -- walk/kiss/fly
-- The verbs "be" and "have" are special.
vBe : V ;
vHave : V ;
-- Verbs with a particle.
vPart : (go, goes, went, gone, up : Str) -> V ;
vPartReg : (get, up : Str) -> V ;
-- Two-place verbs, and the special case with direct object.
-- Notice that a particle can already be included in $V$.
mkV2 : V -> Str -> V2 ; -- look for, kill
tvGen : (look, for : Str) -> V2 ; -- look for, talk about
tvDir : V -> V2 ; -- switch off
tvGenDir : (kill : Str) -> V2 ; -- kill
-- Regular two-place verbs with a particle.
tvPartReg : Str -> Str -> Str -> V2 ; -- get, along, with
-- Ditransitive verbs.
mkV3 : V -> Str -> Str -> V3 ; -- speak, with, about
v3Dir : V -> Str -> V3 ; -- give,_,to
v3DirDir : V -> V3 ; -- give,_,_
-- The definitions should not bother the user of the API. So they are
-- hidden from the document.
--.
Gender = SyntaxEng.Gender ;
Number = SyntaxEng.Number ;
Case = SyntaxEng.Case ;
human = Masc ;
nonhuman = Neutr ;
singular = Sg ;
plural = Pl ;
nominative = Nom ;
genitive = Nom ;
mkN = \man,men,man's,men's,g ->
mkNoun man men man's men's ** {g = g ; lock_N = <>} ;
nReg a g = addGenN nounReg a g ;
nKiss n g = addGenN nounS n g ;
nFly = \fly -> addGenN nounY (Predef.tk 1 fly) ;
nMan = \man,men -> mkN man men (man + "'s") (men + "'s") ;
nHero = nKiss ;
nSheep = \sheep -> nMan sheep sheep ;
nHuman = \s -> nGen s human ;
nNonhuman = \s -> nGen s nonhuman ;
nGen : Str -> Gender -> N = \fly,g -> let {
fl = Predef.tk 1 fly ;
y = Predef.dp 1 fly ;
eqy = ifTok (Str -> Gender -> N) y
} in
eqy "y" nFly (
eqy "s" nKiss (
eqy "z" nKiss (
nReg))) fly g ;
mkN2 = \n,p -> n ** {lock_N2 = <> ; s2 = p} ;
funNonhuman = \s -> mkN2 (nNonhuman s) "of" ;
funHuman = \s -> mkN2 (nHuman s) "of" ;
pnReg n = nameReg n human ** {lock_PN = <>} ;
cnNonhuman = \s -> UseN (nGen s nonhuman) ;
cnHuman = \s -> UseN (nGen s human) ;
npReg = \s -> UsePN (pnReg s) ;
mkN2CN = \n,p -> n ** {lock_N2 = <> ; s2 = p} ;
funOfCN = \n -> mkN2CN n "of" ;
addGenN : (Str -> CommonNoun) -> Str -> Gender -> N = \f ->
\s,g -> f s ** {g = g ; lock_N = <>} ;
mkA a = regAdjective a ** {lock_A = <>} ;
mkA2 = \s,p -> regAdjective s ** {s2 = p} ** {lock_A2 = <>} ;
mkADeg a b c = adjDegrIrreg a b c ** {lock_ADeg = <>} ;
aReg a = adjDegrReg a ** {lock_ADeg = <>} ;
aFat = \fat -> let {fatt = fat + Predef.dp 1 fat} in
mkADeg fat (fatt + "er") (fatt + "est") ;
aRidiculous a = adjDegrLong a ** {lock_ADeg = <>} ;
apReg = \s -> UseA (mkA s) ;
aGen : Str -> ADeg = \s -> case last s of {
"y" => mkADeg s (init s + "ier") (init s + "iest") ;
"e" => mkADeg s (s + "r") (s + "st") ;
_ => aReg s
} ;
mkAdv a = ss a ** {lock_Adv = <>} ;
mkAdvPre a = ss a ** {lock_Adv = <>} ;
mkPP x y = prepPhrase x y ** {lock_Adv = <>} ;
mkAdA a = ss a ** {lock_AdA = <>} ;
mkAdC a = ss a ** {lock_AdC = <>} ;
mkV = \go,goes,went,gone -> verbNoPart (mkVerbP3 go goes went gone) **
{lock_V = <>} ;
vReg = \walk -> mkV walk (walk + "s") (walk + "ed") (walk + "ed") ;
vKiss = \kiss -> mkV kiss (kiss + "es") (kiss + "ed") (kiss + "ed") ;
vFly = \cry -> let {cr = Predef.tk 1 cry} in
mkV cry (cr + "ies") (cr + "ied") (cr + "ied") ;
vGo = vKiss ;
vGen = \fly -> let {
fl = Predef.tk 1 fly ;
y = Predef.dp 1 fly ;
eqy = ifTok (Str -> V) y
} in
eqy "y" vFly (
eqy "s" vKiss (
eqy "z" vKiss (
vReg))) fly ;
vPart = \go, goes, went, gone, up ->
verbPart (mkVerbP3 go goes went gone) up ** {lock_V = <>} ;
vPartReg = \get, up ->
verbPart (vGen get) up ** {lock_V = <>} ;
mkV2 = \v,p -> v ** {lock_V2 = <> ; s3 = p} ;
tvPartReg = \get, along, to -> mkV2 (vPartReg get along) to ;
vBe = verbBe ** {s1 = [] ; lock_V = <>} ;
vHave = verbP3Have ** {s1 = [] ; lock_V = <>} ;
tvGen = \s,p -> mkV2 (vGen s) p ;
tvDir = \v -> mkV2 v [] ;
tvGenDir = \s -> tvDir (vGen s) ;
mkV3 x y z = mkDitransVerb x y z ** {lock_V3 = <>} ;
v3Dir x y = mkV3 x [] y ;
v3DirDir x = v3Dir x [] ;
-- these are used in the generated lexicon
noun : Str -> N = nNonhuman ;
verb2 : Str -> Str -> V2 = \v -> mkV2 (vGen v) ;
verb3 : Str -> Str -> Str -> V3 = \v -> mkV3 (vGen v) ;
} ;

View File

@@ -1,12 +1,12 @@
--# -path=.:../abstract:../../prelude
--1 English Lexical Paradigms
--1 English Lexical Paradigms UNDER RECONSTRUCTION!
--
-- Aarne Ranta 2003
--
-- This is an API to the user of the resource grammar
-- for adding lexical items. It give shortcuts for forming
-- expressions of basic categories: nouns, adjectives, verbs.
-- for adding lexical items. It gives functions for forming
-- expressions of open categories: nouns, adjectives, verbs.
--
-- Closed categories (determiners, pronouns, conjunctions) are
-- accessed through the resource syntax API, $Structural.gf$.
@@ -14,9 +14,16 @@
-- The main difference with $MorphoEng.gf$ is that the types
-- referred to are compiled resource grammar types. We have moreover
-- had the design principle of always having existing forms, rather
-- than stems, as string
-- arguments of the paradigms.
-- than stems, as string arguments of the paradigms.
--
-- The structure of functions for each word class $C$ is the following:
-- first we give a handful of patterns that aim to cover all
-- regular cases. Then we give a worst-case function $mkC$, which serves as an
-- escape to construct the most irregular words of type $C$.
-- However, this function should only seldom be needed: we have a
-- separate module $IrregularEng$, which covers all irregularly inflected
-- words.
--
-- The following modules are presupposed:
resource ParadigmsEng = open (Predef=Predef), Prelude, SyntaxEng, ResourceEng in {
@@ -28,159 +35,237 @@ resource ParadigmsEng = open (Predef=Predef), Prelude, SyntaxEng, ResourceEng in
oper
Gender : Type ;
human : Gender ;
nonhuman : Gender ;
human : Gender ;
nonhuman : Gender ;
masculine : Gender ;
feminite : Gender ;
-- To abstract over number names, we define the following.
Number : Type ;
singular : Number ;
plural : Number ;
-- To abstract over case names, we define the following.
Case : Type ;
nominative : Case ;
genitive : Case ;
-- Prepositions used in many-argument functions are just strings.
Preposition : Type = Str ;
--2 Nouns
-- Worst case: give all four forms and the semantic gender.
mkN : (man,men,man's,men's : Str) -> N ;
-- The regular function captures the variants for nouns ending with
-- "s","sh","x","z" or "y": "kiss - kisses", "flash - flashes";
-- "fly - flies" (but "toy - toys"),
regN : Str -> N ;
-- In practice the worst case is just: give singular and plural nominative.
oper
mkN : (man,men,man's,men's : Str) -> Gender -> N ;
nMan : (man,men : Str) -> Gender -> N ;
mk2N : (man,men : Str) -> N ;
-- Regular nouns, nouns ending with "s", "y", or "o", and nouns with the same
-- plural form as the singular.
-- All nouns created by the previous functions are marked as
-- $nonhuman$. If you want a $human$ noun, wrap it with the following
-- function:
nReg : Str -> Gender -> N ; -- dog, dogs
nKiss : Str -> Gender -> N ; -- kiss, kisses
nFly : Str -> Gender -> N ; -- fly, flies
nHero : Str -> Gender -> N ; -- hero, heroes (= nKiss !)
nSheep : Str -> Gender -> N ; -- sheep, sheep
-- These use general heuristics, that recognizes the last letter. *N.B* it
-- does not get right with "boy", "rush", since it only looks at one letter.
genderN : Gender -> N -> N ;
nHuman : Str -> N ; -- gambler/actress/nanny
nNonhuman : Str -> N ; -- dog/kiss/fly
--3 Compound nouns
--
-- All the functions above work quite as well to form compound nouns,
-- such as "baby boom".
-- Nouns used as functions need a preposition. The most common is "of".
--3 Relational nouns
--
-- Relational nouns ("daughter of x") need a preposition.
mkN2 : N -> Preposition -> N2 ;
funHuman : Str -> N2 ; -- the father/mistress/daddy of
funNonhuman : Str -> N2 ; -- the successor/address/copy of
-- The most common preposition is "of", and the following is a
-- shortcut for regular, $nonhuman$ relational nouns with "of".
-- Proper names, with their regular genitive.
regN2 : Str -> N2 ;
pnReg : (John : Str) -> PN ; -- John, John's
-- Use the function $mkPreposition$ or see the section on prepositions below to
-- form other prepositions.
--
-- Three-place relational nouns ("the connection from x to y") need two prepositions.
-- The most common cases on the higher-level category $CN$ have shortcuts.
-- The regular "y"/"s" variation is taken into account.
mkN3 : N -> Preposition -> Preposition -> N3 ;
cnNonhuman : Str -> CN ;
cnHuman : Str -> CN ;
npReg : Str -> NP ;
-- In some cases, you may want to make a complex $CN$ into a function.
--3 Relational common noun phrases
--
-- In some cases, you may want to make a complex $CN$ into a
-- relational noun (e.g. "the old town hall of").
mkN2CN : CN -> Preposition -> N2 ;
funOfCN : CN -> N2 ;
cnN2 : CN -> Preposition -> N2 ;
cnN3 : CN -> Preposition -> Preposition -> N3 ;
--
--3 Proper names and noun phrases
--
-- Proper names, with a regular genitive, are formed as follows
regPN : Str -> Gender -> PN ; -- John, John's
-- Sometimes you can reuse a common noun as a proper name, e.g. "Bank".
nounPN : N -> PN ;
-- To form a noun phrase that can also be plural and have an irregular
-- genitive, you can use the worst-case function.
mkNP : Str -> Str -> Number -> Gender -> NP ;
--2 Adjectives
-- Non-comparison one-place adjectives just have one form.
-- Non-comparison one-place adjectives need two forms: one for
-- the adjectival and one for the adverbial form ("free - freely")
mkA : (even : Str) -> A ;
mkA : (free,freely : Str) -> A ;
-- For regular adjectives, the adverbial form is derived. This holds
-- even for cases with the variation "happy - happily".
regA : Str -> A ;
-- Two-place adjectives need a preposition as second argument.
--3 Two-place adjectives
--
-- Two-place adjectives need a preposition for their second argument.
mkA2 : (divisible, by : Str) -> A2 ;
mkA2 : A -> Preposition -> A2 ;
-- Comparison adjectives have three forms. The common irregular
-- cases are ones ending with "y" and a consonant that is duplicated;
-- the "y" ending is recognized by the function $aReg$.
-- Comparison adjectives may two more forms.
mkADeg : (good,better,best : Str) -> ADeg ;
mkADeg : (good,better,best,well : Str) -> ADeg ;
aReg : (long : Str) -> ADeg ; -- long, longer, longest
aFat : (fat : Str) -> ADeg ; -- fat, fatter, fattest
aRidiculous : (ridiculous : Str) -> ADeg ; -- -/more/most ridiculous
-- The regular pattern recognizes two common variations:
-- "-e" ("rude" - "ruder" - "rudest") and
-- "-y" ("happy - happier - happiest - happily")
-- On higher level, there are adjectival phrases. The most common case is
-- just to use a one-place adjective.
regADeg : Str -> ADeg ; -- long, longer, longest
-- However, the duplication of the final consonant is nor predicted,
-- but a separate pattern is used:
duplADeg : Str -> ADeg ; -- fat, fatter, fattest
-- If comparison is formed by "more, "most", as in general for
-- long adjective, the following pattern is used:
compoundADeg : A -> ADeg ; -- -/more/most ridiculous
-- From a given $ADeg$, it is possible to get back to $A$.
adegA : ADeg -> A ;
apReg : Str -> AP ;
--2 Adverbs
-- Adverbs are not inflected. Most lexical ones have position not
-- before the verb. Some can be preverbal (e.g. "always").
-- Adverbs are not inflected. Most lexical ones have position
-- after the verb. Some can be preverbal (e.g. "always").
mkAdv : Str -> Adv ;
mkAdvPre : Str -> Adv ;
mkAdv : Str -> Adv ;
mkAdV : Str -> AdV ;
-- Adverbs modifying adjectives and sentences can also be formed.
mkAdA : Str -> AdA ;
mkAdC : Str -> AdC ;
-- Prepositional phrases are another productive form of adverbials.
--2 Prepositions
--
-- A preposition is just a string.
mkPP : Str -> NP -> Adv ;
mkPreposition : Str -> Preposition ;
--2 Verbs
--
-- The fragment now has all verb forms, except the gerund/present participle.
-- Except for "be", the worst case needs four forms: the infinitive and
-- the third person singular present, the past indicative, and the past participle.
-- Except for "be", the worst case needs five forms: the infinitive and
-- the third person singular present, the past indicative, and the
-- past and present participles.
mkV : (go, goes, went, gone : Str) -> V ;
mkV : (go, goes, went, gone, going : Str) -> V ;
vReg : (walk : Str) -> V ; -- walk, walks
vKiss : (kiss : Str) -> V ; -- kiss, kisses
vFly : (fly : Str) -> V ; -- fly, flies
vGo : (go : Str) -> V ; -- go, goes (= vKiss !)
-- The regular verb function recognizes the special cases where the last
-- character is "y" ("cry - cries" but "buy - buys") or "s", "sh", "x", "z"
-- ("fix - fixes", etc).
-- This generic function recognizes the special cases where the last
-- character is "y", "s", or "z". It is not right for "finish" and "convey".
regV : Str -> V ;
vGen : Str -> V ; -- walk/kiss/fly
-- The following variant duplicates the last letter in the forms like
-- "rip - ripped - ripping".
-- The verbs "be" and "have" are special.
regDuplV : Str -> V ;
vBe : V ;
vHave : V ;
-- There is an extensive list of irregular verbs in the module $IrregularEng$.
-- In practice, it is enough to give three forms,
-- e.g. "drink - drank - drunk", with a variant indicating consonant
-- duplication in the present participle.
-- Verbs with a particle.
irregV : (drink, drank, drunk : Str) -> V ;
irregDuplV : (get, got, gotten : Str) -> V ;
vPart : (go, goes, went, gone, up : Str) -> V ;
vPartReg : (get, up : Str) -> V ;
-- Two-place verbs, and the special case with direct object.
-- Notice that a particle can already be included in $V$.
--3 Verbs with a particle.
--
-- The particle, such as in "switch on", is given as a string.
mkV2 : V -> Str -> V2 ; -- look for, kill
partV : V -> Str -> V ;
tvGen : (look, for : Str) -> V2 ; -- look for, talk about
tvDir : V -> V2 ; -- switch off
tvGenDir : (kill : Str) -> V2 ; -- kill
--3 Two-place verbs
--
-- Two-place verbs need a preposition, except the special case with direct object.
-- (transitive verbs). Notice that a particle comes from the $V$.
-- Regular two-place verbs with a particle.
mkV2 : V -> Preposition -> V2 ;
tvPartReg : Str -> Str -> Str -> V2 ; -- get, along, with
dirV2 : V -> V2 ;
-- Ditransitive verbs.
--3 Three-place verbs
--
-- Three-place (ditransitive) verbs need two prepositions, of which
-- the first one or both can be absent.
mkV3 : V -> Str -> Str -> V3 ; -- speak, with, about
v3Dir : V -> Str -> V3 ; -- give,_,to
v3DirDir : V -> V3 ; -- give,_,_
dirV3 : V -> Str -> V3 ; -- give,_,to
dirdirV3 : V -> V3 ; -- give,_,_
--3 Other complement patterns
--
-- Verbs and adjectives can take complements such as sentences,
-- questions, verb phrases, and adjectives.
mkV0 : V -> V0 ;
mkVS : V -> VS ;
mkV2S : V -> Str -> V2S ;
mkVV : V -> VV ;
mkV2V : V -> Str -> Str -> V2V ;
mkVA : V -> VA ;
mkV2A : V -> Str -> V2A ;
mkVQ : V -> VQ ;
mkV2Q : V -> Str -> V2Q ;
mkAS : A -> AS ;
mkA2S : A -> Str -> A2S ;
mkAV : A -> AV ;
mkA2V : A -> Str -> A2V ;
--2 Definitions of paradigms
--
-- The definitions should not bother the user of the API. So they are
-- hidden from the document.
--.
@@ -190,112 +275,144 @@ oper
Case = SyntaxEng.Case ;
human = Masc ;
nonhuman = Neutr ;
masculine = Masc ;
feminine = Fem ;
singular = Sg ;
plural = Pl ;
nominative = Nom ;
genitive = Nom ;
genitive = Gen ;
mkN = \man,men,man's,men's,g ->
mkNoun man men man's men's ** {g = g ; lock_N = <>} ;
nReg a g = addGenN nounReg a g ;
nKiss n g = addGenN nounS n g ;
nFly = \fly -> addGenN nounY (Predef.tk 1 fly) ;
nMan = \man,men -> mkN man men (man + "'s") (men + "'s") ;
nHero = nKiss ;
nSheep = \sheep -> nMan sheep sheep ;
regN = \ray ->
let
ra = Predef.tk 1 ray ;
y = Predef.dp 1 ray ;
r = Predef.tk 2 ray ;
ay = Predef.dp 2 ray ;
rays =
case y of {
"y" => y2ie ray "s" ;
"s" => ray + "es" ;
"z" => ray + "es" ;
"x" => ray + "es" ;
_ => case ay of {
"sh" => ray + "es" ;
"ch" => ray + "es" ;
_ => ray + "s"
}
}
in
mk2N ray rays ;
nHuman = \s -> nGen s human ;
nNonhuman = \s -> nGen s nonhuman ;
mk2N = \man,men ->
let mens = case last men of {
"s" => men + "'" ;
_ => men + "'s"
}
in
mkN man men (man + "'s") mens ;
nGen : Str -> Gender -> N = \fly,g -> let {
fl = Predef.tk 1 fly ;
y = Predef.dp 1 fly ;
eqy = ifTok (Str -> Gender -> N) y
} in
eqy "y" nFly (
eqy "s" nKiss (
eqy "z" nKiss (
nReg))) fly g ;
mkN = \man,men,man's,men's ->
mkNoun man men man's men's ** {g = Neutr ; lock_N = <>} ;
mkN2 = \n,p -> n ** {lock_N2 = <> ; s2 = p} ;
funNonhuman = \s -> mkN2 (nNonhuman s) "of" ;
funHuman = \s -> mkN2 (nHuman s) "of" ;
genderN g man = {s = man.s ; g = g ; lock_N = <>} ;
pnReg n = nameReg n human ** {lock_PN = <>} ;
mkN2 = \n,p -> UseN n ** {lock_N2 = <> ; s2 = p} ;
regN2 n = mkN2 (regN n) (mkPreposition "of") ;
mkN3 = \n,p,q -> UseN n ** {lock_N3 = <> ; s2 = p ; s3 = q} ;
cnN2 = \n,p -> n ** {lock_N2 = <> ; s2 = p} ;
cnN3 = \n,p,q -> n ** {lock_N3 = <> ; s2 = p ; s3 = q} ;
cnNonhuman = \s -> UseN (nGen s nonhuman) ;
cnHuman = \s -> UseN (nGen s human) ;
npReg = \s -> UsePN (pnReg s) ;
regPN n g = nameReg n g ** {lock_PN = <>} ;
nounPN n = {s = n.s ! singular ; g = n.g ; lock_PN = <>} ;
mkNP x y n g = {s = table {GenP => x ; _ => y} ; a = toAgr n P3 g ;
lock_NP = <>} ;
mkN2CN = \n,p -> n ** {lock_N2 = <> ; s2 = p} ;
funOfCN = \n -> mkN2CN n "of" ;
mkA a b = mkAdjective a b ** {lock_A = <>} ;
regA a = regAdjective a ** {lock_A = <>} ;
addGenN : (Str -> CommonNoun) -> Str -> Gender -> N = \f ->
\s,g -> f s ** {g = g ; lock_N = <>} ;
mkA2 a p = a ** {s2 = p ; lock_A2 = <>} ;
mkA a = regAdjective a ** {lock_A = <>} ;
mkA2 = \s,p -> regAdjective s ** {s2 = p} ** {lock_A2 = <>} ;
mkADeg a b c = adjDegrIrreg a b c ** {lock_ADeg = <>} ;
aReg a = adjDegrReg a ** {lock_ADeg = <>} ;
aFat = \fat -> let {fatt = fat + Predef.dp 1 fat} in
mkADeg fat (fatt + "er") (fatt + "est") ;
aRidiculous a = adjDegrLong a ** {lock_ADeg = <>} ;
apReg = \s -> UseA (mkA s) ;
mkADeg a b c d = mkAdjDegrWorst a b c c d d ** {lock_ADeg = <>} ;
aGen : Str -> ADeg = \s -> case last s of {
"y" => mkADeg s (init s + "ier") (init s + "iest") ;
"e" => mkADeg s (s + "r") (s + "st") ;
_ => aReg s
} ;
regADeg happy =
let
happ = init happy ;
y = last happy ;
happie = case y of {
"y" => happ + "ie" ;
"e" => happy ;
_ => happy + "e"
} ;
happily = case y of {
"y" => happ + "ily" ;
_ => happy + "ly"
} ;
in mkADeg happy happily (happie + "r") (happie + "st") ;
mkAdv a = ss a ** {lock_Adv = <>} ;
mkAdvPre a = ss a ** {lock_Adv = <>} ;
mkPP x y = prepPhrase x y ** {lock_Adv = <>} ;
mkAdA a = ss a ** {lock_AdA = <>} ;
mkAdC a = ss a ** {lock_AdC = <>} ;
duplADeg fat = mkADeg fat
(fat + "ly") (fat + last fat + "er") (fat + last fat + "est") ;
compoundADeg a = let ad = (a.s ! AAdj) in
mkADeg ad (a.s ! AAdv) ("more" ++ ad) ("most" ++ ad) ;
adegA a = {s = a.s ! Pos ; lock_A = <>} ;
mkV = \go,goes,went,gone -> verbNoPart (mkVerbP3 go goes went gone) **
{lock_V = <>} ;
vReg = \walk -> mkV walk (walk + "s") (walk + "ed") (walk + "ed") ;
vKiss = \kiss -> mkV kiss (kiss + "es") (kiss + "ed") (kiss + "ed") ;
vFly = \cry -> let {cr = Predef.tk 1 cry} in
mkV cry (cr + "ies") (cr + "ied") (cr + "ied") ;
vGo = vKiss ;
mkAdv x = ss x ** {lock_Adv = <>} ;
mkAdV x = ss x ** {lock_AdV = <>} ;
mkAdA x = ss x ** {lock_AdA = <>} ;
vGen = \fly -> let {
fl = Predef.tk 1 fly ;
y = Predef.dp 1 fly ;
eqy = ifTok (Str -> V) y
} in
eqy "y" vFly (
eqy "s" vKiss (
eqy "z" vKiss (
vReg))) fly ;
mkPreposition p = p ;
vPart = \go, goes, went, gone, up ->
verbPart (mkVerbP3 go goes went gone) up ** {lock_V = <>} ;
vPartReg = \get, up ->
verbPart (vGen get) up ** {lock_V = <>} ;
mkV a b c d e = mkVerbP3worst a b c d e ** {s1 = [] ; lock_V = <>} ;
mkV2 = \v,p -> v ** {lock_V2 = <> ; s3 = p} ;
tvPartReg = \get, along, to -> mkV2 (vPartReg get along) to ;
regV cry =
let
cr = init cry ;
y = last cry ;
cries = (regN cry).s ! Pl ! Nom ; -- !
crie = init cries ;
cried = case last crie of {
"e" => crie + "d" ;
_ => crie + "ed"
} ;
crying = case y of {
"e" => cr + "ing" ;
_ => cry + "ing"
}
in mkV cry cries cried cried crying ;
vBe = verbBe ** {s1 = [] ; lock_V = <>} ;
vHave = verbP3Have ** {s1 = [] ; lock_V = <>} ;
regDuplV fit =
let fitt = fit + last fit in
mkV fit (fit + "s") (fitt + "ed") (fitt + "ed") (fitt + "ing") ;
tvGen = \s,p -> mkV2 (vGen s) p ;
tvDir = \v -> mkV2 v [] ;
tvGenDir = \s -> tvDir (vGen s) ;
irregV x y z = mkVerbIrreg x y z ** {s1 = [] ; lock_V = <>} ;
mkV3 x y z = mkDitransVerb x y z ** {lock_V3 = <>} ;
v3Dir x y = mkV3 x [] y ;
v3DirDir x = v3Dir x [] ;
irregDuplV fit y z =
let
fitting = (regDuplV fit).s ! PresPart
in
mkV fit (fit + "s") y z fitting ;
-- these are used in the generated lexicon
noun : Str -> N = nNonhuman ;
partV v p = {s = v.s ; s1 = p ; lock_V = <>} ;
verb2 : Str -> Str -> V2 = \v -> mkV2 (vGen v) ;
verb3 : Str -> Str -> Str -> V3 = \v -> mkV3 (vGen v) ;
mkV2 v p = v ** {s = v.s ; s1 = v.s1 ; s3 = p ; lock_V2 = <>} ;
dirV2 v = mkV2 v [] ;
mkV3 v p q = v ** {s = v.s ; s1 = v.s1 ; s3 = p ; s4 = q ; lock_V3 = <>} ;
dirV3 v p = mkV3 v [] p ;
dirdirV3 v = dirV3 v [] ;
mkV0 v = v ** {lock_V0 = <>} ;
mkVS v = v ** {lock_VS = <>} ;
mkV2S v p = mkV2 v p ** {lock_V2S = <>} ;
mkVV v = v ** {isAux = False ; lock_VV = <>} ;
mkV2V v p t = mkV2 v p ** {s4 = t ; lock_V2V = <>} ;
mkVA v = v ** {lock_VA = <>} ;
mkV2A v p = mkV2 v p ** {lock_V2A = <>} ;
mkVQ v = v ** {lock_VQ = <>} ;
mkV2Q v p = mkV2 v p ** {lock_V2Q = <>} ;
mkAS v = v ** {lock_AS = <>} ;
mkA2S v p = mkA2 v p ** {lock_A2S = <>} ;
mkAV v = v ** {lock_AV = <>} ;
mkA2V v p = mkA2 v p ** {lock_A2V = <>} ;
} ;

View File

@@ -26,6 +26,8 @@ flags
lexer=text ;
unlexer=text ;
optimize=all ;
lin
UseN = noun2CommNounPhrase ;
UsePN = nameNounPhrase ;
@@ -44,6 +46,8 @@ lin
DefNumNP = defNounPhraseNum plural ;
DetNP = detNounPhrase ;
NDetNP = numDetNounPhrase ;
NDetNum = justNumDetNounPhrase ;
MassNP = detNounPhrase (mkDeterminer Sg []) ;
AppN2 = appFunComm ;
@@ -109,6 +113,8 @@ lin
PrepNP p = prepPhrase p.s ; ---
AdvCN = advCommNounPhrase ;
AdvAP = advAdjPhrase ;
AdvAdv = cc2 ;
--3 Sentences and relative clauses
--
@@ -126,13 +132,8 @@ lin
--3 Questions and imperatives
--
WhoOne = intPronWho singular ;
WhoMany = intPronWho plural ;
WhatOne = intPronWhat singular ;
WhatMany = intPronWhat plural ;
IDetCN d n = nounPhraseInt (detNounPhrase d n) ;
FunIP = funIntPron ;
NounIPOne = nounIntPron singular ;
NounIPMany = nounIntPron plural ;
QuestCl = questClause ;
IntSlash = intSlash ;
@@ -147,6 +148,9 @@ lin
ImperMany = imperUtterance plural ;
AdvCl = advClause ;
AdvVP = advVerbPhrase ;
AdCPhr = advSentence ;
AdvPhr = advSentence ;
@@ -169,6 +173,11 @@ lin
ConjNP = conjunctNounPhrase ;
ConjDNP = conjunctDistrNounPhrase ;
TwoAdv = twoSentence ;
ConsAdv = consSentence ;
ConjAdv = conjunctSentence ;
ConjDAdv = conjunctDistrSentence ;
SubjS = subjunctSentence ;
SubjImper = subjunctImperative ;
SubjQS = subjunctQuestion ;

View File

@@ -6,106 +6,95 @@
--
concrete StructuralEng of Structural =
CategoriesEng, NumeralsEng ** open Prelude, SyntaxEng in {
lin
INP = pronNounPhrase pronI ;
ThouNP = pronNounPhrase pronYouSg ;
HeNP = pronNounPhrase pronHe ;
SheNP = pronNounPhrase pronShe ;
ItNP = pronNounPhrase pronIt ;
WeNumNP n = pronNounPhrase (pronWithNum pronWe n) ;
YeNumNP n = pronNounPhrase (pronWithNum pronYouPl n) ;
YouNP = pronNounPhrase pronYouSg ;
TheyNP = pronNounPhrase pronThey ;
TheyFemNP = pronNounPhrase pronThey ;
EveryDet = everyDet ;
AllMassDet = mkDeterminer Sg "all" ; --- all the missing
AllNumDet = mkDeterminerNum Pl "all" ;
WhichDet = whichDet ;
WhichNumDet = mkDeterminerNum Pl "which" ;
flags optimize=all ;
lin
UseNumeral i = {s = table {Nom => i.s ; Gen => i.s ++ "'s"}} ; ---
MostsDet = mostDet ;
MostDet = mkDeterminer Sg "most" ;
SomeDet = mkDeterminer Sg "some" ;
SomeNumDet = mkDeterminerNum Pl "some" ;
AnyDet = mkDeterminer Sg "any" ;
AnyNumDet = mkDeterminerNum Pl "any" ;
NoDet = mkDeterminer Sg "no" ;
NoNumDet = mkDeterminerNum Pl "no" ;
ManyDet = mkDeterminer Pl "many" ;
HowManyDet = mkDeterminer Pl ["how many"] ;
MuchDet = mkDeterminer Sg ["a lot of"] ; ---
ThisDet = mkDeterminer Sg "this" ;
TheseNumDet = mkDeterminerNum Pl "these" ;
ThatDet = mkDeterminer Sg "that" ;
ThoseNumDet = mkDeterminerNum Pl "those" ;
ThisNP = nameNounPhrase (nameReg "this" Neutr) ;
ThatNP = nameNounPhrase (nameReg "that" Neutr) ;
TheseNumNP n = nameNounPhrasePl {s = \\c => "these" ++ n.s ! c ; g =
Neutr} ;
ThoseNumNP n = nameNounPhrasePl {s = \\c => "those" ++ n.s ! c ; g =
Neutr} ;
above_Prep = ss "above" ;
after_Prep = ss "after" ;
all8mass_Det = mkDeterminer Sg "all" ; --- all the missing
all_NDet = mkDeterminerNum "all" ;
almost_Adv = ss "almost" ;
although_Subj = ss "although" ;
and_Conj = ss "and" ** {n = Pl} ;
because_Subj = ss "because" ;
before_Prep = ss "before" ;
behind_Prep = ss "behind" ;
between_Prep = ss "between" ;
both_AndConjD = sd2 "both" "and" ** {n = Pl} ;
by8agent_Prep = ss "by" ;
by8means_Prep = ss "by" ;
can8know_VV = vvCan ;
can_VV = vvCan ;
during_Prep = ss "during" ;
either8or_ConjD = sd2 "either" "or" ** {n = Sg} ;
everybody_NP = nameNounPhrase (nameReg "everybody" human) ;
every_Det = everyDet ;
everything_NP = nameNounPhrase (nameReg "everything" Neutr) ;
everywhere_Adv = ss "everywhere" ;
from_Prep = ss "from" ;
he_NP = pronNounPhrase pronHe ;
how_IAdv = ss "how" ;
how8many_IDet = mkDeterminer Pl ["how many"] ;
if_Subj = ss "if" ;
in8front_Prep = ss ["in front of"] ;
i_NP = pronNounPhrase pronI ;
in_Prep = ss "in" ;
it_NP = pronNounPhrase pronIt ;
many_Det = mkDeterminer Pl "many" ;
most_Det = mkDeterminer Sg "most" ;
most8many_Det = mostDet ;
much_Det = mkDeterminer Sg ["a lot of"] ; ---
must_VV = vvMust ;
EverybodyNP = nameNounPhrase (nameReg "everybody" human) ;
SomebodyNP = nameNounPhrase (nameReg "somebody" human) ;
NobodyNP = nameNounPhrase (nameReg "nobody" human) ;
EverythingNP = nameNounPhrase (nameReg "everything" Neutr) ;
SomethingNP = nameNounPhrase (nameReg "something" Neutr) ;
NothingNP = nameNounPhrase (nameReg "nothing" Neutr) ;
CanVV = vvCan ;
CanKnowVV = vvCan ;
MustVV = vvMust ;
WantVV = verbNoPart (regVerbP3 "want") ** {isAux = False} ;
HowIAdv = ss "how" ;
WhenIAdv = ss "when" ;
WhereIAdv = ss "where" ;
WhyIAdv = ss "why" ;
EverywhereNP = ss "everywhere" ;
SomewhereNP = ss "somewhere" ;
NowhereNP = ss "nowhere" ;
AndConj = ss "and" ** {n = Pl} ;
OrConj = ss "or" ** {n = Sg} ;
BothAnd = sd2 "both" "and" ** {n = Pl} ;
EitherOr = sd2 "either" "or" ** {n = Sg} ;
NeitherNor = sd2 "neither" "nor" ** {n = Sg} ;
IfSubj = ss "if" ;
WhenSubj = ss "when" ;
AlthoughSubj = ss "although" ;
PhrYes = ss "Yes." ;
PhrNo = ss "No." ;
VeryAdv = ss "very" ;
TooAdv = ss "too" ;
AlmostAdv = ss "almost" ;
QuiteAdv = ss "quite" ;
OtherwiseAdv = ss "otherwise" ;
ThereforeAdv = ss "therefore" ;
InPrep = ss "in" ;
OnPrep = ss "on" ;
ToPrep = ss "to" ;
ThroughPrep = ss "through" ;
AbovePrep = ss "above" ;
UnderPrep = ss "under" ;
InFrontPrep = ss ["in front of"] ;
BehindPrep = ss "behind" ;
BetweenPrep = ss "between" ;
FromPrep = ss "from" ;
BeforePrep = ss "before" ;
DuringPrep = ss "during" ;
AfterPrep = ss "after" ;
WithPrep = ss "with" ;
WithoutPrep = ss "without" ;
ByMeansPrep = ss "by" ;
PossessPrep = ss "of" ;
PartPrep = ss "of" ;
AgentPrep = ss "by" ;
no_Phr = ss "No." ;
on_Prep = ss "on" ;
or_Conj = ss "or" ** {n = Sg} ;
otherwise_Adv = ss "otherwise" ;
part_Prep = ss "of" ;
possess_Prep = ss "of" ;
quite_Adv = ss "quite" ;
she_NP = pronNounPhrase pronShe ;
so_Adv = ss "so" ;
somebody_NP = nameNounPhrase (nameReg "somebody" human) ;
some_Det = mkDeterminer Sg "some" ;
some_NDet = mkDeterminerNum "some" ;
something_NP = nameNounPhrase (nameReg "something" Neutr) ;
somewhere_Adv = ss "somewhere" ;
that_Det = mkDeterminer Sg "that" ;
that_NP = nameNounPhrase (nameReg "that" Neutr) ;
therefore_Adv = ss "therefore" ;
these_NDet = mkDeterminerNum "these" ;
they8fem_NP = pronNounPhrase pronThey ;
they_NP = pronNounPhrase pronThey ;
this_Det = mkDeterminer Sg "this" ;
this_NP = nameNounPhrase (nameReg "this" Neutr) ;
those_NDet = mkDeterminerNum "those" ;
thou_NP = pronNounPhrase pronYouSg ;
through_Prep = ss "through" ;
too_Adv = ss "too" ;
to_Prep = ss "to" ;
under_Prep = ss "under" ;
very_Adv = ss "very" ;
want_VV = verbNoPart (regVerbP3 "want") ** {isAux = False} ;
we_NP = pronNounPhrase pronWe ;
what8many_IP = intPronWhat plural ;
what8one_IP = intPronWhat singular ;
when_IAdv = ss "when" ;
when_Subj = ss "when" ;
where_IAdv = ss "where" ;
which8many_IDet = mkDeterminer Pl ["which"] ;
which8one_IDet = mkDeterminer Sg ["which"] ;
who8many_IP = intPronWho plural ;
who8one_IP = intPronWho singular ;
why_IAdv = ss "why" ;
without_Prep = ss "without" ;
with_Prep = ss "with" ;
ye_NP = pronNounPhrase pronYouPl ;
you_NP = pronNounPhrase pronYouSg ;
yes_Phr = ss "Yes." ;
}

View File

@@ -11,6 +11,8 @@
resource SyntaxEng = MorphoEng ** open Prelude, (CO = Coordination) in {
flags optimize=parametrize ;
--2 Common Nouns
--
-- Simple common nouns are defined as the type $CommNoun$ in $morpho.Deu.gf$.
@@ -89,33 +91,44 @@ oper
-- Determiners are inflected according to the nouns they determine.
-- The determiner is not inflected.
Determiner : Type = {s : Str ; n : Number} ;
Determiner : Type = {s : Str ; n : Number} ;
DeterminerNum : Type = {s : Str} ;
detNounPhrase : Determiner -> CommNounPhrase -> NounPhrase = \every, man ->
{s = \\c => every.s ++ man.s ! every.n ! toCase c ;
a = toAgr every.n P3 man.g
} ;
mkDeterminer : Number -> Str -> Determiner = \n,the ->
mkDeterminerNum n the noNum ;
numDetNounPhrase : DeterminerNum -> Numeral -> CommNounPhrase -> NounPhrase =
\all, six, men ->
{s = \\c => all.s ++ six.s ! Nom ++ men.s ! Pl ! toCase c ;
a = toAgr Pl P3 men.g
} ;
justNumDetNounPhrase : DeterminerNum -> Numeral -> NounPhrase =
\all, six ->
{s = \\c => all.s ++ six.s ! toCase c ;
a = toAgr Pl P3 Neutr --- gender does not matter
} ;
mkDeterminerNum : Number -> Str -> Numeral -> Determiner = \n,det,two ->
{s = det ++ two.s ! Nom ;
mkDeterminer : Number -> Str -> Determiner = \n,the ->
{s = the ;
n = n
} ;
mkDeterminerNum : Str -> DeterminerNum = mkDeterminer Pl ;
everyDet = mkDeterminer Sg "every" ;
allDet = mkDeterminerNum Pl "all" ;
allDet = mkDeterminerNum "all" ;
mostDet = mkDeterminer Pl "most" ;
aDet = mkDeterminer Sg artIndef ;
plDet = mkDeterminerNum Pl [] ;
plDet = mkDeterminerNum [] ;
theSgDet = mkDeterminer Sg "the" ;
thePlDet = mkDeterminerNum Pl "the" ;
thePlDet = mkDeterminerNum "the" ;
anySgDet = mkDeterminer Sg "any" ;
anyPlDet = mkDeterminerNum Pl "any" ;
anyPlDet = mkDeterminerNum "any" ;
whichSgDet = mkDeterminer Sg "which" ;
whichPlDet = mkDeterminerNum Pl "which" ;
whichPlDet = mkDeterminerNum "which" ;
whichDet = whichSgDet ; --- API
@@ -687,6 +700,12 @@ oper
isAux = sings.isAux
} ;
advVerbPhrase : VerbPhrase -> Adverb -> VerbPhrase = \sing, well ->
{
s = \\b,a => sing.s ! b ! a ++ well.s ;
s1 = sing.s1
} ;
advAdjPhrase : SS -> AdjPhrase -> AdjPhrase = \very, good ->
{s = \\a => very.s ++ good.s ! a ;
p = good.p
@@ -1164,6 +1183,9 @@ oper
-- Wh-questions are of two kinds: ones that are like $NP - VP$ sentences,
-- others that are line $S/NP - NP$ sentences.
nounPhraseInt : NounPhrase -> IntPron = \who ->
{s = who.s} ** fromAgr who.a ;
intNounPhrase : IntPron -> NounPhrase = \who ->
{s = who.s ; a = toAgr who.n P3 who.g} ;

View File

@@ -1,7 +1,7 @@
--# -path=.:../abstract:../../prelude
concrete TestResourceEng of TestResource = RulesEng, ClauseEng, StructuralEng **
open Prelude, SyntaxEng, ParadigmsEng in {
open Prelude, SyntaxEng, OldParadigmsEng in {
flags startcat=Phr ; lexer=textlit ; parser=chart ; unlexer=text ;

View File

@@ -1,3 +1,31 @@
concrete TimeEng of Time = {
concrete TimeEng of Time = NumeralsEng **
open Prelude, ResourceEng, ParadigmsEng in {
lincat
Date = SS ;
Weekday = N ;
Hour = SS ;
Minute = SS ;
Time = SS ;
lin
DayDate day = ss (day.s ! singular ! nominative) ;
DayTimeDate day time = ss (day.s ! singular ! nominative ++ "at" ++ time.s) ;
FormalTime = infixSS ["hundred and"] ;
PastTime h m = ss (m.s ++ "past" ++ h.s) ;
ToTime h m = ss (m.s ++ "to" ++ h.s) ;
ExactTime h = ss (h.s ++ "sharp") ;
NumHour n = n ;
NumMinute n = n ;
monday = regN "Monday" ;
tuesday = regN "Tuesday" ;
wednesday = regN "Wednesday" ;
thursday = regN "Thursday" ;
friday = regN "Friday" ;
saturday = regN "Saturday" ;
sunday = regN "Sunday" ;
} ;