msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Added case inflection to English numerals and adjectives, in order to get genitive forms of stand-alone determiners that use Num or Ord right.

Browse Source
This commit is contained in:
bjorn
2008-11-19 13:11:45 +00:00
parent 288ffd290a
commit 0c538bf80b
10 changed files with 86 additions and 72 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
next-lib/src/english/AdjectiveEng.gf
View File

@@ -3,20 +3,20 @@ concrete AdjectiveEng of Adjective = CatEng ** open ResEng, Prelude in {
lin
PositA a = {
s = \\_ => a.s ! AAdj Posit ;
s = \\_ => a.s ! AAdj Posit Nom ;
isPre = True
} ;
ComparA a np = {
s = \\_ => a.s ! AAdj Compar ++ "than" ++ np.s ! Nom ;
s = \\_ => a.s ! AAdj Compar Nom ++ "than" ++ np.s ! Nom ;
isPre = False
} ;
UseComparA a = {
s = \\_ => a.s ! AAdj Compar ;
s = \\_ => a.s ! AAdj Compar Nom ;
isPre = True
} ;
AdjOrd ord = {
s = \\_ => ord.s ;
s = \\_ => ord.s ! Nom ;
isPre = True
} ;
@@ -26,12 +26,12 @@ concrete AdjectiveEng of Adjective = CatEng ** open ResEng, Prelude in {
} ;
ComplA2 a np = {
s = \\_ => a.s ! AAdj Posit ++ a.c2 ++ np.s ! Acc ;
s = \\_ => a.s ! AAdj Posit Nom ++ a.c2 ++ np.s ! Acc ;
isPre = False
} ;
ReflA2 a = {
s = \\ag => a.s ! AAdj Posit ++ a.c2 ++ reflPron ! ag ;
s = \\ag => a.s ! AAdj Posit Nom ++ a.c2 ++ reflPron ! ag ;
isPre = False
} ;
@@ -46,7 +46,7 @@ concrete AdjectiveEng of Adjective = CatEng ** open ResEng, Prelude in {
} ;
UseA2 a = {
s = \\_ => a.s ! AAdj Posit ;
s = \\_ => a.s ! AAdj Posit Nom ;
isPre = True
} ;

11
next-lib/src/english/CatEng.gf
View File

@@ -52,15 +52,16 @@ concrete CatEng of Cat = CommonX ** open ResEng, Prelude in {
NP = {s : Case => Str ; a : Agr} ;
Pron = {s : Case => Str ; sp : Case => Str ; a : Agr} ;
Det = {s : Str ; sp : Case => Str ; n : Number} ;
Predet, Ord = {s : Str} ;
Num = {s : Str ; n : Number ; hasCard : Bool} ;
Card = {s : Str ; n : Number} ;
Predet = {s : Str} ;
Ord = { s : Case => Str } ;
Num = {s : Case => Str ; n : Number ; hasCard : Bool} ;
Card = {s : Case => Str ; n : Number} ;
Quant = {s : Bool => Number => Str ; sp : Bool => Number => Case => Str} ;
-- Numeral
Numeral = {s : CardOrd => Str ; n : Number} ;
Digits = {s : CardOrd => Str ; n : Number ; tail : DTail} ;
Numeral = {s : CardOrd => Case => Str ; n : Number} ;
Digits = {s : CardOrd => Case => Str ; n : Number ; tail : DTail} ;
-- Structural

4
next-lib/src/english/LexiconEng.gf
View File

@@ -224,8 +224,8 @@ lin
stop_V = regDuplV "stop" ;
jump_V = regV "jump" ;
left_Ord = ss "left" ;
right_Ord = ss "right" ;
left_Ord = mkOrd "left" ;
right_Ord = mkOrd "right" ;
far_Adv = mkAdv "far" ;
correct_A = (regA "correct") ;
dry_A = regA "dry" ;

9
next-lib/src/english/MorphoEng.gf
View File

@@ -21,15 +21,6 @@ resource MorphoEng = open Prelude, (Predef=Predef), ResEng in {
sp = regGenitiveS s ;
n = n} ;
regGenitiveS : Str -> Case => Str = \s ->
table { Gen => genitiveS s; _ => s } ;
genitiveS : Str -> Str = \dog ->
case last dog of {
"s" => dog + "'" ;
_ => dog + "'s"
};
--2 Pronouns

19
next-lib/src/english/NounEng.gf
View File

@@ -32,14 +32,17 @@ concrete NounEng of Noun = CatEng ** open MorphoEng, ResEng, Prelude in {
} ;
DetQuant quant num = {
s = quant.s ! num.hasCard ! num.n ++ num.s ;
sp = \\c => quant.sp ! num.hasCard ! num.n ! c ++ num.s ;
s = quant.s ! num.hasCard ! num.n ++ num.s ! Nom;
sp = \\c => case num.hasCard of {
False => quant.sp ! num.hasCard ! num.n ! c ++ num.s ! Nom ;
True => quant.sp ! num.hasCard ! num.n ! Nom ++ num.s ! c
} ;
n = num.n
} ;
DetQuantOrd quant num ord = {
s = quant.s ! num.hasCard ! num.n ++ num.s ++ ord.s ;
sp = \\c => quant.sp ! num.hasCard ! num.n ! c ++ num.s ++ ord.s ;
s = quant.s ! num.hasCard ! num.n ++ num.s ! Nom ++ ord.s ! Nom;
sp = \\c => quant.sp ! num.hasCard ! num.n ! Nom ++ num.s ! Nom ++ ord.s ! c ;
n = num.n
} ;
@@ -53,8 +56,8 @@ concrete NounEng of Noun = CatEng ** open MorphoEng, ResEng, Prelude in {
sp = \\_,_ => p.sp
} ;
NumSg = {s = []; n = Sg ; hasCard = False} ;
NumPl = {s = []; n = Pl ; hasCard = False} ;
NumSg = {s = \\c => []; n = Sg ; hasCard = False} ;
NumPl = {s = \\c => []; n = Pl ; hasCard = False} ;
---b NoOrd = {s = []} ;
NumCard n = n ** {hasCard = True} ;
@@ -65,9 +68,9 @@ concrete NounEng of Noun = CatEng ** open MorphoEng, ResEng, Prelude in {
NumNumeral numeral = {s = numeral.s ! NCard; n = numeral.n} ;
OrdNumeral numeral = {s = numeral.s ! NOrd} ;
AdNum adn num = {s = adn.s ++ num.s ; n = num.n} ;
AdNum adn num = {s = \\c => adn.s ++ num.s!c ; n = num.n} ;
OrdSuperl a = {s = a.s ! AAdj Superl} ;
OrdSuperl a = {s = \\c => a.s ! AAdj Superl c } ;
DefArt = {
s = \\hasCard,n => artDef ;

32
next-lib/src/english/NumeralEng.gf
View File

@@ -1,17 +1,17 @@
concrete NumeralEng of Numeral = CatEng ** open ResEng in {
lincat
Digit = {s : DForm => CardOrd => Str} ;
Sub10 = {s : DForm => CardOrd => Str ; n : Number} ;
Sub100 = {s : CardOrd => Str ; n : Number} ;
Sub1000 = {s : CardOrd => Str ; n : Number} ;
Sub1000000 = {s : CardOrd => Str ; n : Number} ;
Digit = {s : DForm => CardOrd => Case => Str} ;
Sub10 = {s : DForm => CardOrd => Case => Str ; n : Number} ;
Sub100 = {s : CardOrd => Case => Str ; n : Number} ;
Sub1000 = {s : CardOrd => Case => Str ; n : Number} ;
Sub1000000 = {s : CardOrd => Case => Str ; n : Number} ;
lin num x = x ;
lin n2 = let two = mkNum "two" "twelve" "twenty" "second" in
{s = \\f,c => case <f,c> of {
<teen,NOrd> => "twelfth" ;
_ => two.s ! f ! c
{s = \\f,o => case <f,o> of {
<teen,NOrd> => regGenitiveS "twelfth" ;
_ => two.s ! f ! o
}
} ;
@@ -31,16 +31,16 @@ lin pot1to19 d = {s = d.s ! teen} ** {n = Pl} ;
lin pot0as1 n = {s = n.s ! unit} ** {n = n.n} ;
lin pot1 d = {s = d.s ! ten} ** {n = Pl} ;
lin pot1plus d e = {
s = \\c => d.s ! ten ! NCard ++ "-" ++ e.s ! unit ! c ; n = Pl} ;
s = \\o,c => d.s ! ten ! NCard ! Nom ++ "-" ++ e.s ! unit ! o ! c ; n = Pl} ;
lin pot1as2 n = n ;
lin pot2 d = {s = \\c => d.s ! unit ! NCard ++ mkCard c "hundred"} ** {n = Pl} ;
lin pot2 d = {s = \\o,c => d.s ! unit ! NCard ! Nom ++ mkCard o "hundred" ! c} ** {n = Pl} ;
lin pot2plus d e = {
s = \\c => d.s ! unit ! NCard ++ "hundred" ++ "and" ++ e.s ! c ; n = Pl} ;
s = \\o,c => d.s ! unit ! NCard ! Nom ++ "hundred" ++ "and" ++ e.s ! o ! c ; n = Pl} ;
lin pot2as3 n = n ;
lin pot3 n = {
s = \\c => n.s ! NCard ++ mkCard c "thousand" ; n = Pl} ;
s = \\o,c => n.s ! NCard ! Nom ++ mkCard o "thousand" ! c ; n = Pl} ;
lin pot3plus n m = {
s = \\c => n.s ! NCard ++ "thousand" ++ m.s ! c ; n = Pl} ;
s = \\o,c => n.s ! NCard ! Nom ++ "thousand" ++ m.s ! o ! c; n = Pl} ;
-- numerals as sequences of digits
@@ -51,7 +51,7 @@ lin pot3plus n m = {
IDig d = d ** {tail = T1} ;
IIDig d i = {
s = \\o => d.s ! NCard ++ commaIf i.tail ++ i.s ! o ;
s = \\o,c => d.s ! NCard ! Nom ++ commaIf i.tail ++ i.s ! o ! c ;
n = Pl ;
tail = inc i.tail
} ;
@@ -83,13 +83,13 @@ lin pot3plus n m = {
mkDig : Str -> TDigit = \c -> mk2Dig c (c + "th") ;
mk3Dig : Str -> Str -> Number -> TDigit = \c,o,n -> {
s = table {NCard => c ; NOrd => o} ;
s = table {NCard => regGenitiveS c ; NOrd => regGenitiveS o} ;
n = n
} ;
TDigit = {
n : Number ;
s : CardOrd => Str
s : CardOrd => Case => Str
} ;
}

8
next-lib/src/english/ParadigmsEng.gf
View File

@@ -135,6 +135,8 @@ oper
mkQuant : (no_sg, no_pl, none_sg, non_pl : Str) -> Quant ;
} ;
mkOrd : Str -> Ord ;
--2 Adjectives
mkA : overload {
@@ -408,6 +410,8 @@ mkSubj : Str -> Subj = \s -> {s = s ; lock_Subj = <>} ;
lock_Quant = <>
} ;
mkOrd : Str -> Ord = \x -> { s = regGenitiveS x; lock_Ord = <> };
mk2A a b = mkAdjective a a a b ** {lock_A = <>} ;
regA a = case a of {
_ + ("a" | "e" | "i" | "o" | "u" | "y") + ? + _ +
@@ -442,7 +446,7 @@ mkSubj : Str -> Subj = \s -> {s = s ; lock_Subj = <>} ;
(fat + last fat + "er") (fat + last fat + "est") (fat + "ly") ;
compoundADeg a =
let ad = (a.s ! AAdj Posit)
let ad = (a.s ! AAdj Posit Nom)
in mkADeg ad ("more" ++ ad) ("most" ++ ad) (a.s ! AAdv) ;
adegA a = a ;
@@ -570,7 +574,7 @@ mkSubj : Str -> Subj = \s -> {s = s ; lock_Subj = <>} ;
compoundA = compoundADeg ;
simpleA a =
let ad = (a.s ! AAdj Posit)
let ad = (a.s ! AAdj Posit Nom)
in regADeg ad ;
prepA2 : A -> Prep -> A2 ;

2
next-lib/src/english/QuestionEng.gf
View File

@@ -45,7 +45,7 @@ concrete QuestionEng of Question = CatEng ** open ResEng, Prelude in {
} ;
IdetQuant idet num = {
s = idet.s ! num.n ++ num.s ;
s = idet.s ! num.n ++ num.s ! Nom ;
n = num.n
} ;

34
next-lib/src/english/ResEng.gf
View File

@@ -59,7 +59,7 @@ resource ResEng = ParamX ** open Prelude in {
--2 For $Adjective$
AForm = AAdj Degree | AAdv ;
AForm = AAdj Degree Case | AAdv ;
--2 For $Relative$
@@ -123,10 +123,10 @@ resource ResEng = ParamX ** open Prelude in {
mkAdjective : (_,_,_,_ : Str) -> {s : AForm => Str} =
\good,better,best,well -> {
s = table {
AAdj Posit => good ;
AAdj Compar => better ;
AAdj Superl => best ;
AAdv => well
AAdj Posit c => (regGenitiveS good) ! c ;
AAdj Compar c => (regGenitiveS better) ! c ;
AAdj Superl c => (regGenitiveS best) ! c ;
AAdv => well
}
} ;
@@ -161,6 +161,15 @@ resource ResEng = ParamX ** open Prelude in {
regNP : Str -> Number -> {s : Case => Str ; a : Agr} = \that,n ->
mkNP that that (that + "'s") n P3 Neutr ;
regGenitiveS : Str -> Case => Str = \s ->
table { Gen => genitiveS s; _ => s } ;
genitiveS : Str -> Str = \dog ->
case last dog of {
"s" => dog + "'" ;
_ => dog + "'s"
};
-- We have just a heuristic definition of the indefinite article.
-- There are lots of exceptions: consonantic "e" ("euphemism"), consonantic
-- "o" ("one-sided"), vocalic "u" ("umbrella").
@@ -420,23 +429,24 @@ resource ResEng = ParamX ** open Prelude in {
-- For $Numeral$.
mkNum : Str -> Str -> Str -> Str -> {s : DForm => CardOrd => Str} =
mkNum : Str -> Str -> Str -> Str -> {s : DForm => CardOrd => Case => Str} =
\two, twelve, twenty, second ->
{s = table {
unit => table {NCard => two ; NOrd => second} ;
unit => table {NCard => regGenitiveS two ; NOrd => regGenitiveS second} ;
teen => \\c => mkCard c twelve ;
ten => \\c => mkCard c twenty
}
} ;
regNum : Str -> {s : DForm => CardOrd => Str} =
regNum : Str -> {s : DForm => CardOrd => Case => Str} =
\six -> mkNum six (six + "teen") (six + "ty") (regOrd six) ;
regCardOrd : Str -> {s : CardOrd => Str} = \ten ->
{s = table {NCard => ten ; NOrd => regOrd ten}} ;
regCardOrd : Str -> {s : CardOrd => Case => Str} = \ten ->
{s = table {NCard => regGenitiveS ten ;
NOrd => regGenitiveS (regOrd ten)} } ;
mkCard : CardOrd -> Str -> Str = \c,ten ->
(regCardOrd ten).s ! c ;
mkCard : CardOrd -> Str -> Case => Str = \o,ten ->
(regCardOrd ten).s ! o ;
regOrd : Str -> Str = \ten ->
case last ten of {

25
next-lib/src/english/SymbolEng.gf
View File

@@ -3,37 +3,42 @@
concrete SymbolEng of Symbol = CatEng ** open Prelude, ResEng in {
lin
SymbPN i = {s = \\c => i.s ; g = Neutr} ; --- c
IntPN i = {s = \\c => i.s ; g = Neutr} ; --- c
FloatPN i = {s = \\c => i.s ; g = Neutr} ; --- c
NumPN i = {s = \\c => i.s ; g = Neutr} ; --- c
SymbPN i = {s = addGenitiveS i.s ; g = Neutr} ;
IntPN i = {s = addGenitiveS i.s ; g = Neutr} ;
FloatPN i = {s = addGenitiveS i.s ; g = Neutr} ;
NumPN i = {s = i.s ; g = Neutr} ;
CNIntNP cn i = {
s = \\c => (cn.s ! Sg ! Nom ++ i.s) ;
s = \\c => cn.s ! Sg ! Nom ++ (addGenitiveS i.s) ! c ;
a = agrgP3 Sg cn.g
} ;
CNSymbNP det cn xs = {
s = \\c => det.s ++ cn.s ! det.n ! c ++ xs.s ;
s = \\c => det.s ++ cn.s ! det.n ! Nom ++ (addGenitiveS xs.s) ! c ;
a = agrgP3 det.n cn.g
} ;
CNNumNP cn i = {
s = \\c => (cn.s ! Sg ! Nom ++ i.s) ;
s = \\c => cn.s ! Sg ! Nom ++ i.s ! c ;
a = agrgP3 Sg cn.g
} ;
SymbS sy = sy ;
SymbNum sy = {s = sy.s ; n = Pl ; hasCard = True} ;
SymbOrd sy = {s = sy.s ++ "th"} ;
SymbNum sy = { s = addGenitiveS sy.s ; n = Pl ; hasCard = True } ;
SymbOrd sy = { s = addGenitiveS (sy.s ++ "th")} ;
lincat
Symb, [Symb] = SS ;
lin
MkSymb s = s ;
BaseSymb = infixSS "and" ;
ConsSymb = infixSS "," ;
oper
-- Note: this results in a space before 's, but there's
-- not mauch we can do about that.
addGenitiveS : Str -> Case => Str = \s ->
table { Gen => s ++ "'s"; _ => s } ;
}