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 cad49a225d
commit eaed41caaa
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 lin
PositA a = { PositA a = {
s = \\_ => a.s ! AAdj Posit ; s = \\_ => a.s ! AAdj Posit Nom ;
isPre = True isPre = True
} ; } ;
ComparA a np = { ComparA a np = {
s = \\_ => a.s ! AAdj Compar ++ "than" ++ np.s ! Nom ; s = \\_ => a.s ! AAdj Compar Nom ++ "than" ++ np.s ! Nom ;
isPre = False isPre = False
} ; } ;
UseComparA a = { UseComparA a = {
s = \\_ => a.s ! AAdj Compar ; s = \\_ => a.s ! AAdj Compar Nom ;
isPre = True isPre = True
} ; } ;
AdjOrd ord = { AdjOrd ord = {
s = \\_ => ord.s ; s = \\_ => ord.s ! Nom ;
isPre = True isPre = True
} ; } ;
@@ -26,12 +26,12 @@ concrete AdjectiveEng of Adjective = CatEng ** open ResEng, Prelude in {
} ; } ;
ComplA2 a np = { 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 isPre = False
} ; } ;
ReflA2 a = { 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 isPre = False
} ; } ;
@@ -46,7 +46,7 @@ concrete AdjectiveEng of Adjective = CatEng ** open ResEng, Prelude in {
} ; } ;
UseA2 a = { UseA2 a = {
s = \\_ => a.s ! AAdj Posit ; s = \\_ => a.s ! AAdj Posit Nom ;
isPre = True 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} ; NP = {s : Case => Str ; a : Agr} ;
Pron = {s : Case => Str ; sp : Case => Str ; a : Agr} ; Pron = {s : Case => Str ; sp : Case => Str ; a : Agr} ;
Det = {s : Str ; sp : Case => Str ; n : Number} ; Det = {s : Str ; sp : Case => Str ; n : Number} ;
Predet, Ord = {s : Str} ; Predet = {s : Str} ;
Num = {s : Str ; n : Number ; hasCard : Bool} ; Ord = { s : Case => Str } ;
Card = {s : Str ; n : Number} ; Num = {s : Case => Str ; n : Number ; hasCard : Bool} ;
Card = {s : Case => Str ; n : Number} ;
Quant = {s : Bool => Number => Str ; sp : Bool => Number => Case => Str} ; Quant = {s : Bool => Number => Str ; sp : Bool => Number => Case => Str} ;
-- Numeral -- Numeral
Numeral = {s : CardOrd => Str ; n : Number} ; Numeral = {s : CardOrd => Case => Str ; n : Number} ;
Digits = {s : CardOrd => Str ; n : Number ; tail : DTail} ; Digits = {s : CardOrd => Case => Str ; n : Number ; tail : DTail} ;
-- Structural -- Structural

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

@@ -224,8 +224,8 @@ lin
stop_V = regDuplV "stop" ; stop_V = regDuplV "stop" ;
jump_V = regV "jump" ; jump_V = regV "jump" ;
left_Ord = ss "left" ; left_Ord = mkOrd "left" ;
right_Ord = ss "right" ; right_Ord = mkOrd "right" ;
far_Adv = mkAdv "far" ; far_Adv = mkAdv "far" ;
correct_A = (regA "correct") ; correct_A = (regA "correct") ;
dry_A = regA "dry" ; 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 ; sp = regGenitiveS s ;
n = n} ; 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 --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 = { DetQuant quant num = {
s = quant.s ! num.hasCard ! num.n ++ num.s ; s = quant.s ! num.hasCard ! num.n ++ num.s ! Nom;
sp = \\c => quant.sp ! num.hasCard ! num.n ! c ++ num.s ; 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 n = num.n
} ; } ;
DetQuantOrd quant num ord = { DetQuantOrd quant num ord = {
s = quant.s ! num.hasCard ! num.n ++ 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 ! c ++ num.s ++ ord.s ; sp = \\c => quant.sp ! num.hasCard ! num.n ! Nom ++ num.s ! Nom ++ ord.s ! c ;
n = num.n n = num.n
} ; } ;
@@ -53,8 +56,8 @@ concrete NounEng of Noun = CatEng ** open MorphoEng, ResEng, Prelude in {
sp = \\_,_ => p.sp sp = \\_,_ => p.sp
} ; } ;
NumSg = {s = []; n = Sg ; hasCard = False} ; NumSg = {s = \\c => []; n = Sg ; hasCard = False} ;
NumPl = {s = []; n = Pl ; hasCard = False} ; NumPl = {s = \\c => []; n = Pl ; hasCard = False} ;
---b NoOrd = {s = []} ; ---b NoOrd = {s = []} ;
NumCard n = n ** {hasCard = True} ; 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} ; NumNumeral numeral = {s = numeral.s ! NCard; n = numeral.n} ;
OrdNumeral numeral = {s = numeral.s ! NOrd} ; 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 = { DefArt = {
s = \\hasCard,n => artDef ; 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 { concrete NumeralEng of Numeral = CatEng ** open ResEng in {
lincat lincat
Digit = {s : DForm => CardOrd => Str} ; Digit = {s : DForm => CardOrd => Case => Str} ;
Sub10 = {s : DForm => CardOrd => Str ; n : Number} ; Sub10 = {s : DForm => CardOrd => Case => Str ; n : Number} ;
Sub100 = {s : CardOrd => Str ; n : Number} ; Sub100 = {s : CardOrd => Case => Str ; n : Number} ;
Sub1000 = {s : CardOrd => Str ; n : Number} ; Sub1000 = {s : CardOrd => Case => Str ; n : Number} ;
Sub1000000 = {s : CardOrd => Str ; n : Number} ; Sub1000000 = {s : CardOrd => Case => Str ; n : Number} ;
lin num x = x ; lin num x = x ;
lin n2 = let two = mkNum "two" "twelve" "twenty" "second" in lin n2 = let two = mkNum "two" "twelve" "twenty" "second" in
{s = \\f,c => case <f,c> of { {s = \\f,o => case <f,o> of {
<teen,NOrd> => "twelfth" ; <teen,NOrd> => regGenitiveS "twelfth" ;
_ => two.s ! f ! c _ => 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 pot0as1 n = {s = n.s ! unit} ** {n = n.n} ;
lin pot1 d = {s = d.s ! ten} ** {n = Pl} ; lin pot1 d = {s = d.s ! ten} ** {n = Pl} ;
lin pot1plus d e = { 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 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 = { 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 pot2as3 n = n ;
lin pot3 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 = { 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 -- numerals as sequences of digits
@@ -51,7 +51,7 @@ lin pot3plus n m = {
IDig d = d ** {tail = T1} ; IDig d = d ** {tail = T1} ;
IIDig d i = { 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 ; n = Pl ;
tail = inc i.tail tail = inc i.tail
} ; } ;
@@ -83,13 +83,13 @@ lin pot3plus n m = {
mkDig : Str -> TDigit = \c -> mk2Dig c (c + "th") ; mkDig : Str -> TDigit = \c -> mk2Dig c (c + "th") ;
mk3Dig : Str -> Str -> Number -> TDigit = \c,o,n -> { mk3Dig : Str -> Str -> Number -> TDigit = \c,o,n -> {
s = table {NCard => c ; NOrd => o} ; s = table {NCard => regGenitiveS c ; NOrd => regGenitiveS o} ;
n = n n = n
} ; } ;
TDigit = { TDigit = {
n : Number ; 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 ; mkQuant : (no_sg, no_pl, none_sg, non_pl : Str) -> Quant ;
} ; } ;
mkOrd : Str -> Ord ;
--2 Adjectives --2 Adjectives
mkA : overload { mkA : overload {
@@ -408,6 +410,8 @@ mkSubj : Str -> Subj = \s -> {s = s ; lock_Subj = <>} ;
lock_Quant = <> lock_Quant = <>
} ; } ;
mkOrd : Str -> Ord = \x -> { s = regGenitiveS x; lock_Ord = <> };
mk2A a b = mkAdjective a a a b ** {lock_A = <>} ; mk2A a b = mkAdjective a a a b ** {lock_A = <>} ;
regA a = case a of { regA a = case a of {
_ + ("a" | "e" | "i" | "o" | "u" | "y") + ? + _ + _ + ("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") ; (fat + last fat + "er") (fat + last fat + "est") (fat + "ly") ;
compoundADeg a = 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) ; in mkADeg ad ("more" ++ ad) ("most" ++ ad) (a.s ! AAdv) ;
adegA a = a ; adegA a = a ;
@@ -570,7 +574,7 @@ mkSubj : Str -> Subj = \s -> {s = s ; lock_Subj = <>} ;
compoundA = compoundADeg ; compoundA = compoundADeg ;
simpleA a = simpleA a =
let ad = (a.s ! AAdj Posit) let ad = (a.s ! AAdj Posit Nom)
in regADeg ad ; in regADeg ad ;
prepA2 : A -> Prep -> A2 ; 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 = { IdetQuant idet num = {
s = idet.s ! num.n ++ num.s ; s = idet.s ! num.n ++ num.s ! Nom ;
n = num.n 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$ --2 For $Adjective$
AForm = AAdj Degree | AAdv ; AForm = AAdj Degree Case | AAdv ;
--2 For $Relative$ --2 For $Relative$
@@ -123,10 +123,10 @@ resource ResEng = ParamX ** open Prelude in {
mkAdjective : (_,_,_,_ : Str) -> {s : AForm => Str} = mkAdjective : (_,_,_,_ : Str) -> {s : AForm => Str} =
\good,better,best,well -> { \good,better,best,well -> {
s = table { s = table {
AAdj Posit => good ; AAdj Posit c => (regGenitiveS good) ! c ;
AAdj Compar => better ; AAdj Compar c => (regGenitiveS better) ! c ;
AAdj Superl => best ; AAdj Superl c => (regGenitiveS best) ! c ;
AAdv => well AAdv => well
} }
} ; } ;
@@ -161,6 +161,15 @@ resource ResEng = ParamX ** open Prelude in {
regNP : Str -> Number -> {s : Case => Str ; a : Agr} = \that,n -> regNP : Str -> Number -> {s : Case => Str ; a : Agr} = \that,n ->
mkNP that that (that + "'s") n P3 Neutr ; 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. -- We have just a heuristic definition of the indefinite article.
-- There are lots of exceptions: consonantic "e" ("euphemism"), consonantic -- There are lots of exceptions: consonantic "e" ("euphemism"), consonantic
-- "o" ("one-sided"), vocalic "u" ("umbrella"). -- "o" ("one-sided"), vocalic "u" ("umbrella").
@@ -420,23 +429,24 @@ resource ResEng = ParamX ** open Prelude in {
-- For $Numeral$. -- 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 -> \two, twelve, twenty, second ->
{s = table { {s = table {
unit => table {NCard => two ; NOrd => second} ; unit => table {NCard => regGenitiveS two ; NOrd => regGenitiveS second} ;
teen => \\c => mkCard c twelve ; teen => \\c => mkCard c twelve ;
ten => \\c => mkCard c twenty 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) ; \six -> mkNum six (six + "teen") (six + "ty") (regOrd six) ;
regCardOrd : Str -> {s : CardOrd => Str} = \ten -> regCardOrd : Str -> {s : CardOrd => Case => Str} = \ten ->
{s = table {NCard => ten ; NOrd => regOrd ten}} ; {s = table {NCard => regGenitiveS ten ;
NOrd => regGenitiveS (regOrd ten)} } ;
mkCard : CardOrd -> Str -> Str = \c,ten -> mkCard : CardOrd -> Str -> Case => Str = \o,ten ->
(regCardOrd ten).s ! c ; (regCardOrd ten).s ! o ;
regOrd : Str -> Str = \ten -> regOrd : Str -> Str = \ten ->
case last ten of { 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 { concrete SymbolEng of Symbol = CatEng ** open Prelude, ResEng in {
lin lin
SymbPN i = {s = \\c => i.s ; g = Neutr} ; --- c SymbPN i = {s = addGenitiveS i.s ; g = Neutr} ;
IntPN i = {s = \\c => i.s ; g = Neutr} ; --- c IntPN i = {s = addGenitiveS i.s ; g = Neutr} ;
FloatPN i = {s = \\c => i.s ; g = Neutr} ; --- c FloatPN i = {s = addGenitiveS i.s ; g = Neutr} ;
NumPN i = {s = \\c => i.s ; g = Neutr} ; --- c NumPN i = {s = i.s ; g = Neutr} ;
CNIntNP cn i = { 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 a = agrgP3 Sg cn.g
} ; } ;
CNSymbNP det cn xs = { 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 a = agrgP3 det.n cn.g
} ; } ;
CNNumNP cn i = { 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 a = agrgP3 Sg cn.g
} ; } ;
SymbS sy = sy ; SymbS sy = sy ;
SymbNum sy = {s = sy.s ; n = Pl ; hasCard = True} ; SymbNum sy = { s = addGenitiveS sy.s ; n = Pl ; hasCard = True } ;
SymbOrd sy = {s = sy.s ++ "th"} ; SymbOrd sy = { s = addGenitiveS (sy.s ++ "th")} ;
lincat lincat
Symb, [Symb] = SS ; Symb, [Symb] = SS ;
lin lin
MkSymb s = s ; MkSymb s = s ;
BaseSymb = infixSS "and" ; BaseSymb = infixSS "and" ;
ConsSymb = infixSS "," ; 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 } ;
} }