diff --git a/next-lib/src/english/AdjectiveEng.gf b/next-lib/src/english/AdjectiveEng.gf index a060860dd..94b8501ed 100644 --- a/next-lib/src/english/AdjectiveEng.gf +++ b/next-lib/src/english/AdjectiveEng.gf @@ -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 } ; diff --git a/next-lib/src/english/CatEng.gf b/next-lib/src/english/CatEng.gf index 9b79f8e36..a9de8bbef 100644 --- a/next-lib/src/english/CatEng.gf +++ b/next-lib/src/english/CatEng.gf @@ -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 diff --git a/next-lib/src/english/LexiconEng.gf b/next-lib/src/english/LexiconEng.gf index 301f0d683..310899ebc 100644 --- a/next-lib/src/english/LexiconEng.gf +++ b/next-lib/src/english/LexiconEng.gf @@ -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" ; diff --git a/next-lib/src/english/MorphoEng.gf b/next-lib/src/english/MorphoEng.gf index 2025312df..437a0646f 100644 --- a/next-lib/src/english/MorphoEng.gf +++ b/next-lib/src/english/MorphoEng.gf @@ -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 diff --git a/next-lib/src/english/NounEng.gf b/next-lib/src/english/NounEng.gf index 391fb782f..31fe24659 100644 --- a/next-lib/src/english/NounEng.gf +++ b/next-lib/src/english/NounEng.gf @@ -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 ; diff --git a/next-lib/src/english/NumeralEng.gf b/next-lib/src/english/NumeralEng.gf index 2f7c8e553..ff41a4a70 100644 --- a/next-lib/src/english/NumeralEng.gf +++ b/next-lib/src/english/NumeralEng.gf @@ -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 of { - => "twelfth" ; - _ => two.s ! f ! c + {s = \\f,o => case of { + => 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 } ; } diff --git a/next-lib/src/english/ParadigmsEng.gf b/next-lib/src/english/ParadigmsEng.gf index c6c9ba4db..705c15189 100644 --- a/next-lib/src/english/ParadigmsEng.gf +++ b/next-lib/src/english/ParadigmsEng.gf @@ -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 ; diff --git a/next-lib/src/english/QuestionEng.gf b/next-lib/src/english/QuestionEng.gf index 2fc894932..0fce813d4 100644 --- a/next-lib/src/english/QuestionEng.gf +++ b/next-lib/src/english/QuestionEng.gf @@ -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 } ; diff --git a/next-lib/src/english/ResEng.gf b/next-lib/src/english/ResEng.gf index f53ea21eb..d59143d52 100644 --- a/next-lib/src/english/ResEng.gf +++ b/next-lib/src/english/ResEng.gf @@ -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 { diff --git a/next-lib/src/english/SymbolEng.gf b/next-lib/src/english/SymbolEng.gf index 6092902c9..b3425c90a 100644 --- a/next-lib/src/english/SymbolEng.gf +++ b/next-lib/src/english/SymbolEng.gf @@ -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 } ; + }