From 7a446f5cd1e6da9869ba09c2771995a4f9b77870 Mon Sep 17 00:00:00 2001 From: aarne Date: Tue, 6 Aug 2013 21:36:12 +0000 Subject: [PATCH] refactored Fin so that the stemmed and the unstemmed versions share all code except StemFin. It is chosen by setting the path; a functor solution would be purer, but it feels like overkill. --- lib/src/finnish/AdjectiveFin.gf | 27 +- lib/src/finnish/AdverbFin.gf | 10 +- lib/src/finnish/CatFin.gf | 30 +- lib/src/finnish/ExtraFin.gf | 67 +- lib/src/finnish/IdiomFin.gf | 6 +- lib/src/finnish/LexiconFin.gf | 8 +- lib/src/finnish/MorphoFin.gf | 2 +- lib/src/finnish/NounFin.gf | 35 +- lib/src/finnish/NumeralFin.gf | 33 +- lib/src/finnish/ParadigmsFin.gf | 251 +++++--- lib/src/finnish/QuestionFin.gf | 2 +- lib/src/finnish/ResFin.gf | 62 +- lib/src/finnish/SentenceFin.gf | 6 +- lib/src/finnish/StructuralFin.gf | 36 +- lib/src/finnish/SymbolFin.gf | 10 +- lib/src/finnish/VerbFin.gf | 56 +- lib/src/finnish/stemmed/AdjectiveFin.gf | 57 -- lib/src/finnish/stemmed/AdverbFin.gf | 23 - lib/src/finnish/stemmed/AllFin.gf | 6 - lib/src/finnish/stemmed/CatFin.gf | 99 --- lib/src/finnish/stemmed/ExtraFin.gf | 232 ------- lib/src/finnish/stemmed/LangFin.gf | 11 - lib/src/finnish/stemmed/LexiconFin.gf | 388 ----------- lib/src/finnish/stemmed/NounFin.gf | 265 -------- lib/src/finnish/stemmed/NumeralFin.gf | 188 ------ lib/src/finnish/stemmed/ParadigmsFin.gf | 783 ----------------------- lib/src/finnish/stemmed/ParseFin.gf | 2 +- lib/src/finnish/stemmed/SentenceFin.gf | 69 -- lib/src/finnish/stemmed/StemFin.gf | 50 +- lib/src/finnish/stemmed/StructuralFin.gf | 315 --------- lib/src/finnish/stemmed/SymbolFin.gf | 44 -- lib/src/finnish/stemmed/VerbFin.gf | 147 ----- 32 files changed, 417 insertions(+), 2903 deletions(-) delete mode 100644 lib/src/finnish/stemmed/AdjectiveFin.gf delete mode 100644 lib/src/finnish/stemmed/AdverbFin.gf delete mode 100644 lib/src/finnish/stemmed/AllFin.gf delete mode 100644 lib/src/finnish/stemmed/CatFin.gf delete mode 100644 lib/src/finnish/stemmed/ExtraFin.gf delete mode 100644 lib/src/finnish/stemmed/LangFin.gf delete mode 100644 lib/src/finnish/stemmed/LexiconFin.gf delete mode 100644 lib/src/finnish/stemmed/NounFin.gf delete mode 100644 lib/src/finnish/stemmed/NumeralFin.gf delete mode 100644 lib/src/finnish/stemmed/ParadigmsFin.gf delete mode 100644 lib/src/finnish/stemmed/SentenceFin.gf delete mode 100644 lib/src/finnish/stemmed/StructuralFin.gf delete mode 100644 lib/src/finnish/stemmed/SymbolFin.gf delete mode 100644 lib/src/finnish/stemmed/VerbFin.gf diff --git a/lib/src/finnish/AdjectiveFin.gf b/lib/src/finnish/AdjectiveFin.gf index ee6bc58dd..44a79bd75 100644 --- a/lib/src/finnish/AdjectiveFin.gf +++ b/lib/src/finnish/AdjectiveFin.gf @@ -1,23 +1,24 @@ -concrete AdjectiveFin of Adjective = CatFin ** open ResFin, Prelude in { +concrete AdjectiveFin of Adjective = CatFin ** open ResFin, StemFin, Prelude in { flags optimize=all_subs ; -- gfc size from 2864336 to 6786 - i.e. factor 422 lin PositA a = { - s = \\_,nf => a.s ! Posit ! AN nf + s = \\_ => (snoun2nounSep {s = \\f => a.s ! Posit ! sAN f ; h = a.h}).s } ; - ComparA a np = { + ComparA a np = + let acomp = (snoun2nounSep {s = \\f => a.s ! Posit ! sAN f ; h = a.h}).s in { s = \\isMod,af => case isMod of { - True => np.s ! NPCase Part ++ a.s ! Compar ! AN af ; -- minua isompi - _ => a.s ! Compar ! AN af ++ "kuin" ++ np.s ! NPCase Nom -- isompi kuin minä + True => np.s ! NPCase Part ++ acomp ! af ; -- minua isompi + _ => acomp ! af ++ "kuin" ++ np.s ! NPCase Nom -- isompi kuin minä } } ; CAdvAP ad ap np = { s = \\m,af => ad.s ++ ap.s ! m ! af ++ ad.p ++ np.s ! NPCase Nom } ; UseComparA a = { - s = \\_,nf => a.s ! Compar ! AN nf ; + s = \\_ => (snoun2nounSep {s = \\f => a.s ! Compar ! sAN f ; h = a.h}).s } ; -- $SuperlA$ belongs to determiner syntax in $Noun$. @@ -26,15 +27,15 @@ concrete AdjectiveFin of Adjective = CatFin ** open ResFin, Prelude in { } ; - ComplA2 adj np = { + ComplA2 a np = { s = \\isMod,af => - preOrPost isMod (appCompl True Pos adj.c2 np) (adj.s ! Posit ! AN af) + preOrPost isMod (appCompl True Pos a.c2 np) ((snoun2nounSep {s = \\f => a.s ! Posit ! sAN f ; h = a.h}).s ! af) } ; - ReflA2 adj = { + ReflA2 a = { s = \\isMod,af => preOrPost isMod - (appCompl True Pos adj.c2 (reflPron (agrP3 Sg))) (adj.s ! Posit ! AN af) + (appCompl True Pos a.c2 (reflPron (agrP3 Sg))) ((snoun2nounSep {s = \\f => a.s ! Posit ! sAN f ; h = a.h}).s ! af) } ; SentAP ap sc = { @@ -45,8 +46,12 @@ concrete AdjectiveFin of Adjective = CatFin ** open ResFin, Prelude in { s = \\b,af => ada.s ++ ap.s ! b ! af } ; + AdvAP ap adv = { + s = \\b,af => adv.s ++ ap.s ! b ! af -- luonnostaan vaalea + } ; + UseA2 a = { - s = \\_,nf => a.s ! Posit ! AN nf + s = \\_ => (snoun2nounSep {s = \\f => a.s ! Posit ! sAN f ; h = a.h}).s } ; } diff --git a/lib/src/finnish/AdverbFin.gf b/lib/src/finnish/AdverbFin.gf index d5934062f..bd9225b76 100644 --- a/lib/src/finnish/AdverbFin.gf +++ b/lib/src/finnish/AdverbFin.gf @@ -1,19 +1,19 @@ -concrete AdverbFin of Adverb = CatFin ** open ResFin, Prelude in { +concrete AdverbFin of Adverb = CatFin ** open ResFin, Prelude, StemFin in { lin - PositAdvAdj a = {s = a.s ! Posit ! AAdv} ; + PositAdvAdj a = {s = a.s ! Posit ! sAAdv} ; ComparAdvAdj cadv a np = { - s = cadv.s ++ a.s ! Posit ! AAdv ++ cadv.p ++ np.s ! NPCase Nom + s = cadv.s ++ a.s ! Posit ! sAAdv ++ cadv.p ++ np.s ! NPCase Nom } ; ComparAdvAdjS cadv a s = { - s = cadv.s ++ a.s ! Posit ! AAdv ++ cadv.p ++ s.s + s = cadv.s ++ a.s ! Posit ! sAAdv ++ cadv.p ++ s.s } ; PrepNP prep np = {s = preOrPost prep.isPre prep.s (np.s ! prep.c)} ; AdAdv = cc2 ; - PositAdAAdj a = {s = a.s ! Posit ! AN (NCase Sg Gen)} ; -- älyttömän + PositAdAAdj a = {s = sANGen (a.s ! Posit)} ; -- älyttömän SubjS = cc2 ; ----b AdvSC s = s ; diff --git a/lib/src/finnish/CatFin.gf b/lib/src/finnish/CatFin.gf index 63daffe0a..162cdad44 100644 --- a/lib/src/finnish/CatFin.gf +++ b/lib/src/finnish/CatFin.gf @@ -1,4 +1,4 @@ -concrete CatFin of Cat = CommonX ** open ResFin, Prelude in { +concrete CatFin of Cat = CommonX ** open ResFin, StemFin, Prelude in { flags optimize=all_subs ; @@ -48,7 +48,7 @@ concrete CatFin of Cat = CommonX ** open ResFin, Prelude in { -- The $Bool$ tells if a possessive suffix is attached, which affects the case. CN = {s : NForm => Str ; h : Harmony} ; - Pron = {s : NPForm => Str ; a : Agr} ; + Pron = {s : NPForm => Str ; a : Agr ; hasPoss : Bool} ; NP = {s : NPForm => Str ; a : Agr ; isPron : Bool ; isNeg : Bool} ; Det = { s1 : Case => Str ; -- minun kolme @@ -81,21 +81,19 @@ concrete CatFin of Cat = CommonX ** open ResFin, Prelude in { -- Open lexical classes, e.g. Lexicon - V, VS, VQ = Verb1 ; -- = {s : VForm => Str ; sc : Case} ; - V2, VA, V2Q, V2S = Verb1 ** {c2 : Compl} ; - V2A = Verb1 ** {c2, c3 : Compl} ; - VV = Verb1 ** {vi : InfForm} ; ---- infinitive form - V2V = Verb1 ** {c2 : Compl ; vi : InfForm} ; ---- infinitive form - V3 = Verb1 ** {c2, c3 : Compl} ; + V, VS, VQ = SVerb1 ; + V2, VA, V2Q, V2S = SVerb1 ** {c2 : Compl} ; + V2A = SVerb1 ** {c2, c3 : Compl} ; + VV = SVerb1 ** {vi : InfForm} ; ---- infinitive form + V2V = SVerb1 ** {c2 : Compl ; vi : InfForm} ; ---- infinitive form + V3 = SVerb1 ** {c2, c3 : Compl} ; - A = {s : Degree => AForm => Str} ; - A2 = {s : Degree => AForm => Str ; c2 : Compl} ; + A = {s : Degree => SAForm => Str ; h : Harmony} ; + A2 = {s : Degree => SAForm => Str ; h : Harmony ; c2 : Compl} ; - N = {s : NForm => Str ; h : Harmony} ; - N2 = {s : NForm => Str ; h: Harmony} ** {c2 : Compl ; isPre : Bool} ; - N3 = {s : NForm => Str ; h: Harmony} ** {c2,c3 : Compl ; isPre,isPre2 : Bool} ; - PN = {s : Case => Str} ; - -oper Verb1 = {s : VForm => Str ; sc : NPForm ; qp : Bool ; p : Str} ; + N = SNoun ; + N2 = SNoun ** {c2 : Compl ; isPre : Bool} ; + N3 = SNoun ** {c2,c3 : Compl ; isPre,isPre2 : Bool} ; + PN = SPN ; } diff --git a/lib/src/finnish/ExtraFin.gf b/lib/src/finnish/ExtraFin.gf index c99a9613a..da5cf2393 100644 --- a/lib/src/finnish/ExtraFin.gf +++ b/lib/src/finnish/ExtraFin.gf @@ -1,7 +1,7 @@ --# -path=.:abstract:common:prelude concrete ExtraFin of ExtraFinAbs = CatFin ** - open ResFin, MorphoFin, Coordination, Prelude, NounFin, StructuralFin, (R = ParamX) in { + open ResFin, MorphoFin, Coordination, Prelude, NounFin, StructuralFin, StemFin, (R = ParamX) in { lin GenNP np = { @@ -15,46 +15,46 @@ concrete ExtraFin of ExtraFinAbs = CatFin ** GenIP ip = {s = \\_,_ => ip.s ! NPCase Gen} ; + GenCN n1 n2 = {s = \\nf => n1.s ! NPCase Gen ++ n2.s ! nf ; + h = n2.h } ; + GenRP num cn = { s = \\n,c => let k = npform2case num.n c in relPron ! n ! Gen ++ cn.s ! NCase num.n k ; a = RNoAg --- a = RAg (agrP3 num.n) } ; - GenCN n1 n2 = {s = \\nf => n1.s ! NPCase Gen ++ n2.s ! nf ; - h = n2.h } ; - lincat - VPI = {s : Str} ; - [VPI] = {s1,s2 : Str} ; + VPI = {s : InfForm => Str} ; + [VPI] = {s1,s2 : InfForm => Str} ; lin - BaseVPI = twoSS ; - ConsVPI = consrSS comma ; + BaseVPI = twoTable InfForm ; + ConsVPI = consrTable InfForm comma ; - MkVPI vp = {s = infVP (NPCase Nom) Pos (agrP3 Sg) vp Inf1} ; - ConjVPI = conjunctDistrSS ; + MkVPI vp = {s = \\i => infVP (NPCase Nom) Pos (agrP3 Sg) vp i} ; + ConjVPI = conjunctDistrTable InfForm ; ComplVPIVV vv vpi = - insertObj (\\_,_,_ => vpi.s) (predV vv) ; + insertObj (\\_,_,_ => vpi.s ! vv.vi) (predSV vv) ; lincat VPS = { s : Agr => Str ; sc : NPForm ; --- can be different for diff parts - qp : Bool -- True = back vowel --- can be different for diff parts + h : Harmony --- can be different for diff parts } ; [VPS] = { s1,s2 : Agr => Str ; - sc : NPForm ; --- take the first: minä osaan kutoa ja täytyy virkata - qp : Bool --- take the first: osaanko minä kutoa ja käyn koulua + sc : NPForm ; --- take the first: minä osaan kutoa ja täytyy virkata + h : Harmony --- take the first: osaanko minä kutoa ja käyn koulua } ; lin - BaseVPS x y = twoTable Agr x y ** {sc = x.sc ; qp = x.qp} ; - ConsVPS x y = consrTable Agr comma x y ** {sc = x.sc ; qp = x.qp} ; + BaseVPS x y = twoTable Agr x y ** {sc = x.sc ; h = x.h} ; + ConsVPS x y = consrTable Agr comma x y ** {sc = x.sc ; h = x.h} ; ConjVPS conj ss = conjunctDistrTable Agr conj ss ** { - sc = ss.sc ; qp = ss.qp + sc = ss.sc ; h = ss.h } ; MkVPS t p vp = { -- Temp -> Pol -> VP -> VPS ; @@ -66,7 +66,7 @@ concrete ExtraFin of ExtraFinAbs = CatFin ** vp.adv ! p.p ++ vp.ext ; sc = vp.sc ; - qp = vp.qp + h = vp.h } ; PredVPS np vps = { -- NP -> VPS -> S ; @@ -75,7 +75,7 @@ concrete ExtraFin of ExtraFinAbs = CatFin ** AdvExistNP adv np = mkClause (\_ -> adv.s) np.a (insertObj - (\\_,b,_ => np.s ! NPCase Nom) (predV (verbOlla ** {sc = NPCase Nom ; qp = True ; p = []}))) ; + (\\_,b,_ => np.s ! NPCase Nom) (predV (verbOlla ** {sc = NPCase Nom ; h = Back ; p = []}))) ; RelExistNP prep rp np = { s = \\t,ant,bo,ag => @@ -86,7 +86,7 @@ concrete ExtraFin of ExtraFinAbs = CatFin ** np.a (insertObj (\\_,b,_ => np.s ! NPCase Nom) - (predV (verbOlla ** {sc = NPCase Nom ; qp = True ; p = []}))) ; + (predV (verbOlla ** {sc = NPCase Nom ; h = Back ; p = []}))) ; in cl.s ! t ! ant ! bo ! SDecl ; c = NPCase Nom @@ -94,18 +94,18 @@ concrete ExtraFin of ExtraFinAbs = CatFin ** AdvPredNP adv v np = mkClause (\_ -> adv.s) np.a (insertObj - (\\_,b,_ => subjForm np v.sc b) (predV v)) ; + (\\_,b,_ => subjForm np v.sc b) (predSV v)) ; ICompExistNP adv np = let cl = mkClause (\_ -> adv.s ! np.a) np.a (insertObj - (\\_,b,_ => np.s ! NPCase Nom) (predV (verbOlla ** {sc = NPCase Nom ; qp = True ; p = []}))) ; + (\\_,b,_ => np.s ! NPCase Nom) (predV (verbOlla ** {sc = NPCase Nom ; h = Back ; p = []}))) ; in { s = \\t,a,p => cl.s ! t ! a ! p ! SDecl } ; IAdvPredNP iadv v np = let cl = mkClause (\_ -> iadv.s) np.a (insertObj - (\\_,b,_ => np.s ! v.sc) (predV v)) ; + (\\_,b,_ => np.s ! v.sc) (predSV v)) ; in { s = \\t,a,p => cl.s ! t ! a ! p ! SDecl } ; @@ -124,7 +124,7 @@ concrete ExtraFin of ExtraFinAbs = CatFin ** acn = DetCN (DetQuant IndefArt NumSg) cn in { s = table { - NPCase Nom | NPAcc => acn.s ! NPCase Part ; + NPCase Nom | NPAcc => acn.s ! NPCase ResFin.Part ; c => acn.s ! c } ; a = acn.a ; @@ -134,7 +134,7 @@ concrete ExtraFin of ExtraFinAbs = CatFin ** vai_Conj = {s1 = [] ; s2 = "vai" ; n = Sg} ; CompPartAP ap = { - s = \\agr => ap.s ! False ! NCase (complNumAgr agr) Part + s = \\agr => ap.s ! False ! NCase (complNumAgr agr) ResFin.Part } ; ---- copied from VerbFin.CompAP, should be shared @@ -144,7 +144,7 @@ concrete ExtraFin of ExtraFinAbs = CatFin ** n = complNumAgr agr ; c = case n of { Sg => Nom ; -- minä olen iso ; te olette iso - Pl => Part -- me olemme isoja ; te olette isoja + Pl => ResFin.Part -- me olemme isoja ; te olette isoja } --- definiteness of NP ? in "kuinka" ++ ap.s ! False ! (NCase n c) } ; @@ -154,7 +154,8 @@ concrete ExtraFin of ExtraFinAbs = CatFin ** ProDrop p = { s = table {NPCase (Nom) => [] ; c => p.s ! c} ; ---- drop Gen only works in adjectival position: "autoni", but not in "ø täytyy mennä" - a = p.a + a = p.a ; + hasPoss = p.hasPoss ; } ; ProDropPoss p = { @@ -170,38 +171,38 @@ concrete ExtraFin of ExtraFinAbs = CatFin ** lincat ClPlus, ClPlusObj, ClPlusAdv = ClausePlus ; - Part = {s : Bool => Str} ; + Part = {s : Harmony => Str} ; lin S_SVO part t p clp = let cl = clp.s ! t.t ! t.a ! p.p ; - pa = part.s ! True ---- + pa = part.s ! Back ---- in {s = t.s ++ p.s ++ cl.subj ++ pa ++ cl.fin ++ cl.inf ++ cl.compl ++ cl.adv ++ cl.ext} ; S_OSV part t p clp = let cl = clp.s ! t.t ! t.a ! p.p ; - pa = part.s ! True ---- + pa = part.s ! Back ---- in {s = t.s ++ p.s ++ cl.compl ++ pa ++ cl.subj ++ cl.fin ++ cl.inf ++ cl.adv ++ cl.ext} ; S_VSO part t p clp = let cl = clp.s ! t.t ! t.a ! p.p ; - pa = part.s ! cl.qp + pa = part.s ! cl.h in {s = t.s ++ p.s ++ cl.fin ++ pa ++ cl.subj ++ cl.inf ++ cl.compl ++ cl.adv ++ cl.ext} ; S_ASV part t p clp = let cl = clp.s ! t.t ! t.a ! p.p ; - pa = part.s ! cl.qp + pa = part.s ! cl.h in {s = t.s ++ p.s ++ cl.adv ++ pa ++ cl.subj ++ cl.fin ++ cl.inf ++ cl.compl ++ cl.ext} ; S_OVS part t p clp = let cl = clp.s ! t.t ! t.a ! p.p ; - pa = part.s ! True ---- + pa = part.s ! Back ---- in {s = t.s ++ p.s ++ cl.compl ++ pa ++ cl.fin ++ cl.inf ++ cl.subj ++ cl.adv ++ cl.ext} ; diff --git a/lib/src/finnish/IdiomFin.gf b/lib/src/finnish/IdiomFin.gf index a492e9b40..e485e5d3d 100644 --- a/lib/src/finnish/IdiomFin.gf +++ b/lib/src/finnish/IdiomFin.gf @@ -46,7 +46,7 @@ concrete IdiomFin of Idiom = CatFin ** adv = vp.adv ; ext = vp.ext ; sc = vp.sc ; - qp = vp.qp ; + h = vp.h ; isNeg = vp.isNeg } ; @@ -60,7 +60,7 @@ concrete IdiomFin of Idiom = CatFin ** adv = vp.adv ; ext = vp.ext ; sc = vp.sc ; - qp = vp.qp ; isNeg = vp.isNeg + h = vp.h ; isNeg = vp.isNeg } ; -- This gives "otetaan oluet" instead of "ottakaamme oluet". @@ -74,7 +74,7 @@ concrete IdiomFin of Idiom = CatFin ** } ; oper - olla = verbOlla ** {sc = NPCase Nom ; qp = True ; p = []} ; + olla = verbOlla ** {sc = NPCase Nom ; h = Back ; p = []} ; noSubj : Polarity -> Str = \_ -> [] ; } diff --git a/lib/src/finnish/LexiconFin.gf b/lib/src/finnish/LexiconFin.gf index 0b73cecb2..aab8d8b6c 100644 --- a/lib/src/finnish/LexiconFin.gf +++ b/lib/src/finnish/LexiconFin.gf @@ -1,6 +1,6 @@ --# -path=.:prelude -concrete LexiconFin of Lexicon = CatFin ** open MorphoFin, ParadigmsFin in { +concrete LexiconFin of Lexicon = CatFin ** open MorphoFin, StemFin, ParadigmsFin in { flags optimize=values ; @@ -240,8 +240,8 @@ lin put_V2 = mkV2 (mkV "panna") ; stop_V = mkV "pysähtyä" ; jump_V = mkV "hypätä" ; - left_Ord = mkOrd (mkN "vasen") ; - right_Ord = mkOrd (mkN "oikea") ; + left_Ord = mkOrd (snoun2nounBind (mkN "vasen")) ; + right_Ord = mkOrd (snoun2nounBind (mkN "oikea")) ; far_Adv = mkAdv "kaukana" ; correct_A = mkA "oikea" ; dry_A = mkA (mkN "kuiva") "kuivempi" "kuivin" ; @@ -381,7 +381,7 @@ lin uncertain_A = mkA "epävarma" ; oper - mkOrd : N -> Ord ; + mkOrd : Noun -> Ord ; mkOrd x = {s = x.s ; lock_Ord = <> } ; cpartitive = casePrep partitive ; diff --git a/lib/src/finnish/MorphoFin.gf b/lib/src/finnish/MorphoFin.gf index c8050000e..d3ef73597 100644 --- a/lib/src/finnish/MorphoFin.gf +++ b/lib/src/finnish/MorphoFin.gf @@ -382,7 +382,7 @@ resource MorphoFin = ResFin ** open Prelude in { 10 => ukko_ -- the compound form, e.g. nais- } ; - Noun = {s : NForm => Str; h : Harmony; lock_N : {}} ; + Noun = {s : NForm => Str; h : Harmony} ; nForms2N : NForms -> Noun = \f -> let diff --git a/lib/src/finnish/NounFin.gf b/lib/src/finnish/NounFin.gf index 34b57d337..a91bdeef6 100644 --- a/lib/src/finnish/NounFin.gf +++ b/lib/src/finnish/NounFin.gf @@ -1,6 +1,4 @@ -concrete NounFin of Noun = CatFin ** open ResFin, MorphoFin, Prelude in { - - flags optimize=all_subs ; +concrete NounFin of Noun = CatFin ** open ResFin, MorphoFin, StemFin, Prelude in { lin @@ -58,7 +56,7 @@ concrete NounFin of Noun = CatFin ** open ResFin, MorphoFin, Prelude in { } ; UsePN pn = { - s = \\c => pn.s ! npform2case Sg c ; + s = snoun2np Sg pn ; a = agrP3 Sg ; isPron = False ; isNeg = False } ; @@ -72,7 +70,7 @@ concrete NounFin of Noun = CatFin ** open ResFin, MorphoFin, Prelude in { } ; PPartNP np v2 = { - s = \\c => np.s ! c ++ v2.s ! PastPartPass (AN (NCase (complNumAgr np.a) Ess)) ; + s = \\c => np.s ! c ++ (sverb2verbSep v2).s ! PastPartPass (AN (NCase (complNumAgr np.a) Ess)) ; a = np.a ; isPron = np.isPron ; -- minun täällä - ni isNeg = np.isNeg @@ -87,7 +85,7 @@ concrete NounFin of Noun = CatFin ** open ResFin, MorphoFin, Prelude in { DetQuantOrd quant num ord = { s1 = \\c => quant.s1 ! num.n ! c ++ num.s ! Sg ! c ++ ord.s ! NCase num.n c ; - sp = \\c => quant.sp ! num.n ! c ++ num.s ! Sg ! c ++ ord.s ! NCase num.n c ; + sp = \\c => quant.s1 ! num.n ! c ++ num.s ! Sg ! c ++ ord.s ! NCase num.n c ; s2 = quant.s2 ; n = num.n ; isNum = num.isNum ; @@ -111,10 +109,13 @@ concrete NounFin of Noun = CatFin ** open ResFin, MorphoFin, Prelude in { PossPron p = { s1,sp = \\_,_ => p.s ! NPCase Gen ; - s2 = table {Front => BIND ++ possSuffixFront p.a ; - Back => BIND ++ possSuffix p.a } ; + s2 = case p.hasPoss of { + True => table {Front => BIND ++ possSuffixFront p.a ; + Back => BIND ++ possSuffix p.a } ; + False => \\_ => [] + } ; isNum = False ; - isPoss = True ; + isPoss = p.hasPoss ; isDef = True ; --- "minun kolme autoani ovat" ; thus "...on" is missing isNeg = False } ; @@ -128,20 +129,20 @@ concrete NounFin of Noun = CatFin ** open ResFin, MorphoFin, Prelude in { s = \\n,c => numeral.s ! NCard (NCase n c) ; n = numeral.n } ; - OrdDigits numeral = {s = \\nc => numeral.s ! NOrd nc} ; + OrdDigits numeral = {s = \\f => numeral.s ! NOrd f} ; NumNumeral numeral = { s = \\n,c => numeral.s ! NCard (NCase n c) ; n = numeral.n } ; - OrdNumeral numeral = {s = \\nc => numeral.s ! NOrd nc} ; + OrdNumeral numeral = {s = \\f => numeral.s ! NOrd f} ; AdNum adn num = { s = \\n,c => adn.s ++ num.s ! n ! c ; n = num.n } ; - OrdSuperl a = {s = \\nc => a.s ! Superl ! AN nc} ; + OrdSuperl a = snoun2nounSep {s = \\nc => a.s ! Superl ! sAN nc ; h = a.h} ; DefArt = { s1 = \\_,_ => [] ; @@ -171,18 +172,18 @@ concrete NounFin of Noun = CatFin ** open ResFin, MorphoFin, Prelude in { isPron = False ; isNeg = False } ; - UseN n = n ; + UseN n = snoun2nounSep n ; - UseN2 n = n ; + UseN2 n = snoun2nounSep n ; Use2N3 f = { - s = f.s ; + s = (snoun2nounSep f).s ; c2 = f.c2 ; h = f.h ; isPre = f.isPre } ; Use3N3 f = { - s = f.s ; + s = (snoun2nounSep f).s ; c2 = f.c3 ; h = f.h ; isPre = f.isPre2 @@ -192,7 +193,7 @@ concrete NounFin of Noun = CatFin ** open ResFin, MorphoFin, Prelude in { --- If a possessive suffix is added here it goes after the complements... ComplN2 f x = { - s = \\nf => preOrPost f.isPre (f.s ! nf) (appCompl True Pos f.c2 x) ; + s = \\nf => preOrPost f.isPre ((snoun2nounSep f).s ! nf) (appCompl True Pos f.c2 x) ; h = f.h } ; ComplN3 f x = { s = \\nf => preOrPost f.isPre (f.s ! nf) (appCompl True Pos f.c2 x) ; diff --git a/lib/src/finnish/NumeralFin.gf b/lib/src/finnish/NumeralFin.gf index a98482711..7f052c8fb 100644 --- a/lib/src/finnish/NumeralFin.gf +++ b/lib/src/finnish/NumeralFin.gf @@ -1,4 +1,4 @@ -concrete NumeralFin of Numeral = CatFin [Numeral,Digits] ** open Prelude, ParadigmsFin, MorphoFin in { +concrete NumeralFin of Numeral = CatFin [Numeral,Digits] ** open Prelude, ParadigmsFin, MorphoFin, StemFin in { -- Notice: possessive forms are not used. They get wrong, since every -- part is made to agree in them. @@ -12,14 +12,17 @@ lincat lin num x = x ; - n2 = kaksi_toinenN ; + n2 = co + (nhn (mkSubst "a" "kaksi" "kahde" "kahte" "kahta" "kahteen" "kaksi" "kaksi" + "kaksien" "kaksia" "kaksiin")) + (ordN "a" "kahdes") ; --- toinen n3 = co (nhn (mkSubst "a" "kolme" "kolme" "kolme" "kolmea" "kolmeen" "kolmi" "kolmi" "kolmien" "kolmia" "kolmiin")) (ordN "a" "kolmas") ; - n4 = co (mkN "neljä") (ordN "ä" "neljäs") ; - n5 = co (mkN "viisi" "viiden" "viisiä") (ordN "ä" "viides") ; - n6 = co (mkN "kuusi" "kuuden" "kuusia") (ordN "a" "kuudes") ; + n4 = co (snoun2nounBind (mkN "neljä")) (ordN "ä" "neljäs") ; + n5 = co (snoun2nounBind (mkN "viisi" "viiden" "viisiä")) (ordN "ä" "viides") ; + n6 = co (snoun2nounBind (mkN "kuusi" "kuuden" "kuusia")) (ordN "a" "kuudes") ; n7 = co (nhn (mkSubst "ä" "seitsemän" "seitsemä" "seitsemä" "seitsemää" "seitsemään" "seitsemi" "seitsemi" "seitsemien" "seitsemiä" @@ -80,7 +83,7 @@ oper } } ; - nBIND : Number -> Str = \n -> case n of {Sg => [] ; _ => BIND} ; -- no BIND after silent 1 + nBIND : MorphoFin.Number -> Str = \n -> case n of {Sg => [] ; _ => BIND} ; -- no BIND after silent 1 -- Too much trouble to infer vowel, cf. "kuudes" vs. "viides". @@ -89,10 +92,10 @@ oper let sada = init sadas in - mkN + snoun2nounBind (mkN sadas (sada + "nnen") (sada + "tt" + a) (sada + "nten" + a) (sada + "nteen") (sada + "nsien") (sada + "nsi" + a) (sada + "nsin" + a) - (sada + "nsiss" + a) (sada + "nsiin") ; + (sada + "nsiss" + a) (sada + "nsiin")) ; param NumPlace = NumIndep | NumAttr ; @@ -101,26 +104,22 @@ oper yksiN = co (nhn (mkSubst "ä" "yksi" "yhde" "yhte" "yhtä" "yhteen" "yksi" "yksi" "yksien" "yksiä" "yksiin")) - (ordN "ä" "yhdes") ; ---- ensimmäinen + (ordN "ä" "yhdes") ; -- yhdestoista yksi_ensiN = co (nhn (mkSubst "ä" "yksi" "yhde" "yhte" "yhtä" "yhteen" "yksi" "yksi" "yksien" "yksiä" "yksiin")) - (mkN "ensimmäinen") ; -- ensimmäinen ---- sadasensimmäinentuhannes - kaksi_toinenN = co - (nhn (mkSubst "a" "kaksi" "kahde" "kahte" "kahta" "kahteen" "kaksi" "kaksi" - "kaksien" "kaksia" "kaksiin")) - (mkN "toinen") ; + (snoun2nounBind (mkN "ensimmäinen")) ; -- ensimmäinen ---- sadasensimmäinentuhannes kymmenenN = co (nhn (mkSubst "ä" "kymmenen" "kymmene" "kymmene" "kymmentä" "kymmeneen" "kymmeni" "kymmeni" "kymmenien" "kymmeniä" "kymmeniin")) (ordN "ä" "kymmenes") ; sataN = co - (mkN "sata") + (snoun2nounBind (mkN "sata")) (ordN "a" "sadas") ; tuhatN = co - (mkN "tuhat" "tuhannen" "tuhatta" "ruhantena" "tuhanteen" - "tuhansien" "tuhansia" "tuhansina" "tuhansissa" "tuhansiin") + (snoun2nounBind (mkN "tuhat" "tuhannen" "tuhatta" "ruhantena" "tuhanteen" + "tuhansien" "tuhansia" "tuhansina" "tuhansissa" "tuhansiin")) (ordN "a" "tuhannes") ; kymmentaN = diff --git a/lib/src/finnish/ParadigmsFin.gf b/lib/src/finnish/ParadigmsFin.gf index d3ab3b5de..668b4b49b 100644 --- a/lib/src/finnish/ParadigmsFin.gf +++ b/lib/src/finnish/ParadigmsFin.gf @@ -25,7 +25,7 @@ resource ParadigmsFin = open (Predef=Predef), Prelude, MorphoFin, - CatFin + CatFin, StemFin in { flags optimize=noexpand ; @@ -57,8 +57,11 @@ oper allative : Case ; -- e.g. "talolle" infFirst : InfForm ; -- e.g. "tehdä" - infElat : InfForm ; -- e.g. "tekemästä" + infIness : InfForm ; -- e.g. "tekemässä" + infElat : InfForm ; -- e.g. "tekemästä" infIllat : InfForm ; -- e.g. "tekemään" + infPresPart : InfForm ; -- e.g. "tekevän" + infPresPartAgr : InfForm ; -- e.g. "tekevänsä" -- The following type is used for defining *rection*, i.e. complements -- of many-place verbs and adjective. A complement can be defined by @@ -69,6 +72,20 @@ oper postGenPrep : Str -> Prep ; -- genitive postposition, e.g. "takana" casePrep : Case -> Prep ; -- just case, e.g. adessive + mkPrep = overload { + mkPrep : Case -> Prep + = casePrep ; + mkPrep : Str -> Prep + = postGenPrep ; + mkPrep : Case -> Str -> Prep + = postPrep ; + mkPrep : Str -> Case -> Prep + = \s,c -> prePrep c s ; + } ; + + accusative : Prep + = {c = NPAcc ; s = [] ; isPre = True ; lock_Prep = <>} ; + NK : Type ; -- Noun from DictFin (Kotus) AK : Type ; -- Adjective from DictFin (Kotus) VK : Type ; -- Verb from DictFin (Kotus) @@ -103,12 +120,22 @@ oper mkN : (pika : Str) -> (juna : N) -> N ; -- compound with invariable prefix mkN : (oma : N) -> (tunto : N) -> N ; -- compound with inflecting prefix mkN : NK -> N ; -- noun from DictFin (Kotus) + mkN : V -> N ; -- verbal noun: "tekeminen" } ; -- Some nouns are regular except for the singular nominative (e.g. "mies"). exceptNomN : N -> Str -> N ; +-- Nouns where the parts are separate (should perhaps be treated as CN) + + separateN = overload { + separateN : Str -> N -> N + = \s,n -> mkN (s + "_") n ; + separateN : N -> N -> N + = \oma, asunto -> lin N {s = \\c => oma.s ! c + "_" + asunto.s ! c ; h = asunto.h} ; + } ; + -- Nouns used as functions need a case, of which the default is -- the genitive. @@ -146,9 +173,14 @@ oper -- Two-place adjectives need a case for the second argument. - mkA2 : A -> Prep -> A2 -- e.g. "jaollinen" casePrep adessive - = \a,p -> a ** {c2 = p ; lock_A2 = <>}; - + mkA2 = overload { + mkA2 : Str -> A2 -- e.g. "vihainen" (jollekin) + = \s -> mkA s ** {c2 = mkPrep "allative" ; lock_A2 = <>} ; + mkA2 : Str -> Prep -> A2 -- e.g. "jaollinen" (mkPrep adessive) + = \a,p -> mkA a ** {c2 = p ; lock_A2 = <>} ; + mkA2 : A -> Prep -> A2 -- e.g. "jaollinen" (mkPrep adessive) + = \a,p -> a ** {c2 = p ; lock_A2 = <>} ; + } ; --2 Verbs @@ -165,6 +197,7 @@ oper mkV : (huutaa,dan,taa,tavat,takaa,detaan,sin,si,sisi,tanut,dettu,tanee : Str) -> V ; -- worst-case verb mkV : VK -> V ; -- verb from DictFin (Kotus) mkV : V -> Str -> V ; -- hakata päälle (particle verb) + mkV : Str -> V -> V ; -- laimin+lyödä (prefixed verb) } ; -- All the patterns above have $nominative$ as subject case. @@ -176,6 +209,8 @@ oper vOlla : V ; -- the verb "be" + olla_V : V + = vOlla ; --3 Two-place verbs -- @@ -186,6 +221,7 @@ oper mkV2 : overload { mkV2 : Str -> V2 ; -- predictable direct transitive + mkV2 : Str -> Case -> V2 ; -- predictable with another case mkV2 : V -> V2 ; -- direct transitive mkV2 : V -> Case -> V2 ; -- complement just case mkV2 : V -> Prep -> V2 ; -- complement pre/postposition @@ -198,7 +234,15 @@ oper -- Three-place (ditransitive) verbs need two prepositions, of which -- the first one or both can be absent. - mkV3 : V -> Prep -> Prep -> V3 ; -- e.g. puhua, allative, elative + mkV3 = overload { + mkV3 : Str -> V3 + = \s -> dirdirV3 (mkV s) ; + mkV3 : V -> V3 + = \v -> dirdirV3 v ; + mkV3 : V -> Prep -> Prep -> V3 -- e.g. puhua, allative, elative + = \v,p,q -> v ** {c2 = p ; c3 = q ; lock_V3 = <>} ; + } ; + dirV3 : V -> Case -> V3 ; -- siirtää, (accusative), illative dirdirV3 : V -> V3 ; -- antaa, (accusative), (allative) @@ -208,12 +252,39 @@ oper -- Verbs and adjectives can take complements such as sentences, -- questions, verb phrases, and adjectives. +mkVV = overload { + mkVV : Str -> VV -- e.g. "yrittää" (puhua) + = \s -> mkVVf (mkV s) infFirst ; + mkVV : V -> VV -- e.g. "alkaa" (puhua) + = \v -> mkVVf v infFirst ; + mkVV : Str -> InfForm -> VV -- e.g. "ruveta" (puhumaan) + = \s,i -> mkVVf (mkV s) i ; + mkVV : V -> InfForm -> VV -- e.g. "lakata" (puhumasta) + = \v,i -> mkVVf v i ; + } ; + +mkVS = overload { + mkVS : Str -> VS -- e.g. "väittää" + = \s -> lin VS (mk1V s) ; + mkVS : V -> VS -- e.g. "sanoa" + = \v -> lin VS v ; + } ; + + mkV2V = overload { + mkV2V : Str -> V2V + = \s -> mkV2Vf (mkV s) (casePrep partitive) infIllat ; ---- + mkV2V : V -> V2V + = \v -> mkV2Vf v (casePrep partitive) infIllat ; ---- + mkV2V : V -> Prep -> V2V -- e.g. "käskeä" genitive + = \v,p -> mkV2Vf v p infIllat ; + mkV2Vf : V -> Prep -> InfForm -> V2V -- e.g. "kieltää" partitive infElatv + = \v,p,f -> mk2V2 v p ** {vi = f ; lock_V2V = <>} ; + } ; + mkV0 : V -> V0 ; --% - mkVS : V -> VS ; + mkV2S : V -> Prep -> V2S ; -- e.g. "sanoa" allative - mkVV : V -> VV ; -- e.g. "alkaa" mkVVf : V -> InfForm -> VV ; -- e.g. "ruveta" infIllat - mkV2V : V -> Prep -> V2V ; -- e.g. "käskeä" genitive mkV2Vf : V -> Prep -> InfForm -> V2V ; -- e.g. "kieltää" partitive infElat mkVA : V -> Prep -> VA ; -- e.g. "maistua" ablative mkV2A : V -> Prep -> Prep -> V2A ; -- e.g. "maalata" accusative translative @@ -221,9 +292,9 @@ oper mkV2Q : V -> Prep -> V2Q ; -- e.g. "kysyä" ablative mkAS : A -> AS ; --% - mkA2S : A -> Prep -> A2S ; --% +--- mkA2S : A -> Prep -> A2S ; --% mkAV : A -> AV ; --% - mkA2V : A -> Prep -> A2V ; --% +--- mkA2V : A -> Prep -> A2V ; --% -- Notice: categories $AS, A2S, AV, A2V$ are just $A$, -- and the second argument is given @@ -233,8 +304,42 @@ oper V0 : Type ; --% AS, A2S, AV, A2V : Type ; --% +--2 Structural categories + + mkAdV : Str -> AdV + = \s -> lin AdV (ss s) ; + mkAdA : Str -> AdA + = \s -> lin AdA (ss s) ; + mkAdN : Str -> AdN + = \s -> lin AdN (ss s) ; + mkPConj : Str -> PConj + = \s -> lin PConj (ss s) ; + mkSubj : Str -> Subj + = \s -> lin Subj (ss s) ; + + mkPredet : Str -> Predet -- invariable Predet, such as "vain" + = \s -> lin Predet {s = \\_,_ => s} ; + + mkConj = overload { + mkConj : Str -> Conj + = \y -> {s1 = [] ; s2 = y ; n = Pl ; lock_Conj = <>} ; + mkConj : Str -> Str -> Conj + = \x,y -> {s1 = x ; s2 = y ; n = Pl ; lock_Conj = <>} ; + mkConj : Str -> Str -> Number -> Conj + = \x,y,n -> {s1 = x ; s2 = y ; n = n ; lock_Conj = <>} ; + } ; + + mkDet = overload { + mkDet : Number -> N -> Det + = \nu,noun -> MorphoFin.mkDet nu (snoun2nounBind noun) ; + mkDet : (isNeg : Bool) -> Number -> N -> Det -- use this with True to create a negative determiner + = \isNeg,nu,noun -> MorphoFin.mkDetPol isNeg nu (snoun2nounBind noun) ; + mkDet : (isNeg : Bool) -> Number -> N -> Case -> Det -- paljon + False + partitive, ei yhtään + True + partitive + = \isNeg,nu,noun,_ -> MorphoFin.mkDetPol isNeg nu (snoun2nounBind noun) ; + } ; + --. --- The definitions should not bother the user of the API. So they are +-- THE definitions should not bother the user of the API. So they are -- hidden from the document. Case = MorphoFin.Case ; @@ -255,7 +360,7 @@ oper ablative = Ablat ; allative = Allat ; - infFirst = Inf1 ; infElat = Inf3Elat ; infIllat = Inf3Illat ; + infFirst = Inf1 ; infElat = Inf3Elat ; infIllat = Inf3Illat ; infIness = Inf3Iness ; infPresPart = InfPresPart ; infPresPartAgr = InfPresPartAgr ; prePrep : Case -> Str -> Prep = \c,p -> {c = NPCase c ; s = p ; isPre = True ; lock_Prep = <>} ; @@ -275,42 +380,36 @@ oper mkN = overload { mkN : (talo : Str) -> N = mk1N ; - -- \s -> nForms2N (nForms1 s) ; + -- \s -> nforms2snoun (nForms1 s) ; mkN : (talo,talon : Str) -> N = mk2N ; - -- \s,t -> nForms2N (nForms2 s t) ; + -- \s,t -> nforms2snoun (nForms2 s t) ; mkN : (talo,talon,taloja : Str) -> N = mk3N ; - -- \s,t,u -> nForms2N (nForms3 s t u) ; + -- \s,t,u -> nforms2snoun (nForms3 s t u) ; mkN : (talo,talon,taloja,taloa : Str) -> N = mk4N ; - -- \s,t,u,v -> nForms2N (nForms4 s t u v) ; + -- \s,t,u,v -> nforms2snoun (nForms4 s t u v) ; mkN : (talo,talon,taloa,talona,taloon,talojen,taloja,taloina,taloissa,taloihin : Str) -> N = mk10N ; mkN : (sora : Str) -> (tie : N) -> N = mkStrN ; mkN : (oma,tunto : N) -> N = mkNN ; - mkN : (sana : NK) -> N = \w -> nForms2N w.s ; + mkN : (sana : NK) -> N = \w -> nforms2snoun w.s ; + mkN : V -> N = \w -> sverb2snoun w ; } ; - exceptNomN : N -> Str -> N = \noun,nom -> lin N { - s = table { - NCase Sg Nom => nom ; - f => noun.s ! f - } ; - h = noun.h - } ; + exceptNomN : N -> Str -> N = \noun,nom -> lin N (exceptNomSNoun noun nom) ; +---- mk1A : Str -> A = \jalo -> aForms2A (nforms2aforms (nForms1 jalo)) ; +---- mkNA : N -> A = snoun2sadj ; - mk1A : Str -> A = \jalo -> aForms2A (nforms2aforms (nForms1 jalo)) ; - mkNA : N -> A = \suuri -> aForms2A (nforms2aforms (n2nforms suuri)) ; - - mk1N : (talo : Str) -> N = \s -> nForms2N (nForms1 s) ; - mk2N : (talo,talon : Str) -> N = \s,t -> nForms2N (nForms2 s t) ; - mk3N : (talo,talon,taloja : Str) -> N = \s,t,u -> nForms2N (nForms3 s t u) ; + mk1N : (talo : Str) -> N = \s -> lin N (nforms2snoun (nForms1 s)) ; + mk2N : (talo,talon : Str) -> N = \s,t -> nforms2snoun (nForms2 s t) ; + mk3N : (talo,talon,taloja : Str) -> N = \s,t,u -> nforms2snoun (nForms3 s t u) ; mk4N : (talo,talon,taloa,taloja : Str) -> N = \s,t,u,v -> - nForms2N (nForms4 s t u v) ; + nforms2snoun (nForms4 s t u v) ; mk10N : (talo,talon,taloa,talona,taloon,talojen,taloja,taloina,taloissa,taloihin : Str) -> N = \a,b,c,d,e,f,g,h,i,j -> - nForms2N (nForms10 a b c d e f g h i j) ; + lin N (nforms2snoun (nForms10 a b c d e f g h i j)) ; mkStrN : Str -> N -> N = \sora,tie -> { s = \\c => sora + tie.s ! c ; @@ -470,59 +569,45 @@ oper mkPN = overload { mkPN : Str -> PN = mkPN_1 ; - mkPN : N -> PN = \s -> {s = \\c => s.s ! NCase Sg c ; lock_PN = <>} ; + mkPN : N -> PN = \s -> lin PN (snoun2spn s) ; } ; - mkPN_1 : Str -> PN = \s -> {s = \\c => (mk1N s).s ! NCase Sg c ; lock_PN = <>} ; + mkPN_1 : Str -> PN = \s -> lin PN (snoun2spn (mk1N s)) ; -- adjectives mkA = overload { mkA : Str -> A = mkA_1 ; mkA : N -> A = \n -> noun2adjDeg n ** {lock_A = <>} ; - mkA : N -> (kivempaa,kivinta : Str) -> A = regAdjective ; - mkA : (sana : AK) -> A = \w -> noun2adjDeg (nForms2N w.s) ; + mkA : N -> (kivempaa,kivinta : Str) -> A = \n -> regAdjective n ; + mkA : (sana : AK) -> A = \w -> noun2adjDeg (nforms2snoun w.s) ; - mkA : (hyva,parempi,paras : N) -> (hyvin,paremmin,parhaiten : Str) -> A = \h,p,ps,hn,pn,ph -> lin A { - s = table { - Posit => table { - AN nf => h.s ! nf ; - AAdv => hn - } ; - Compar => table { - AN nf => p.s ! nf ; - AAdv => pn - } ; - Superl => table { - AN nf => ps.s ! nf ; - AAdv => ph - } - } - } ; - } ; + mkA : (hyva,parempi,paras : N) -> (hyvin,paremmin,parhaiten : Str) -> A + = \h,p,ps,hn,pn,ph -> lin A (mkAdj h p ps hn pn ph) ; + } ; - mkA_1 : Str -> A = \x -> noun2adjDeg (mk1N x) ** {lock_A = <>} ; + mkA_1 : Str -> A = \x -> lin A (noun2adjDeg (mk1N x)) ; -- auxiliaries - mkAdjective : (_,_,_ : Adj) -> A = \hyva,parempi,paras -> + mkAdjective : (_,_,_ : SAdj) -> A = \hyva,parempi,paras -> {s = table { Posit => hyva.s ; Compar => parempi.s ; Superl => paras.s } ; + h = hyva.h ; ---- different for parempi, paras lock_A = <> } ; - regAdjective : Noun -> Str -> Str -> A = \kiva, kivempi, kivin -> + regAdjective : SNoun -> Str -> Str -> A = \kiva, kivempi, kivin -> mkAdjective - (noun2adj kiva) - (noun2adjComp False (nForms2N (dSuurempi kivempi))) - (noun2adjComp False (nForms2N (dSuurin kivin))) ; - noun2adjDeg : Noun -> Adjective = \suuri -> + (snoun2sadj kiva) + (snoun2sadjComp False (nforms2snoun (dSuurempi kivempi))) + (snoun2sadjComp False (nforms2snoun (dSuurin kivin))) ; + noun2adjDeg : SNoun -> A = \suuri -> regAdjective suuri - (init (suuri.s ! NCase Sg Gen) + "mpi") ---- to check - (suuri.s ! NInstruct) ; ---- - + (snoun2compar suuri) + (snoun2superl suuri) ; @@ -535,21 +620,22 @@ oper mkV : ( huutaa,huudan,huutaa,huutavat,huutakaa,huudetaan, huusin,huusi,huusisi,huutanut,huudettu,huutanee : Str) -> V = mk12V ; - mkV : (sana : VK) -> V = \w -> vforms2V w.s ** {sc = NPCase Nom ; lock_V = <> ; p = []} ; - mkV : V -> Str -> V = \w,p -> vforms2V w.s ** {sc = NPCase Nom ; lock_V = <> ; p = p} ; + mkV : (sana : VK) -> V = \w -> vforms2sverb w.s ** {sc = NPCase Nom ; lock_V = <> ; p = []} ; + mkV : V -> Str -> V = \w,p -> {s = w.s ; sc = w.sc ; lock_V = <> ; h = w.h ; p = p} ; + mkV : Str -> V -> V = \s,v -> {s = \\f => s + v.s ! f ; sc = v.sc ; lock_V = <> ; h = v.h ; p = v.p} ; } ; mk1V : Str -> V = \s -> - let vfs = vforms2V (vForms1 s) in + let vfs = vforms2sverb (vForms1 s) in vfs ** {sc = NPCase Nom ; lock_V = <> ; p = []} ; mk2V : (_,_ : Str) -> V = \x,y -> - let vfs = vforms2V (vForms2 x y) in vfs ** {sc = NPCase Nom ; lock_V = <> ; p = []} ; + let vfs = vforms2sverb (vForms2 x y) in vfs ** {sc = NPCase Nom ; lock_V = <> ; p = []} ; mk3V : (huutaa,huudan,huusi : Str) -> V = \x,_,y -> mk2V x y ; ---- mk12V : ( huutaa,huudan,huutaa,huutavat,huutakaa,huudetaan, huusin,huusi,huusisi,huutanut,huudettu,huutanee : Str) -> V = \a,b,c,d,e,f,g,h,i,j,k,l -> - vforms2V (vForms12 a b c d e f g h i j k l) ** {sc = NPCase Nom ; lock_V = <> ; p = []} ; + vforms2sverb (vForms12 a b c d e f g h i j k l) ** {sc = NPCase Nom ; lock_V = <> ; p = []} ; vForms1 : Str -> VForms = \ottaa -> let @@ -612,9 +698,11 @@ oper - caseV c v = {s = v.s ; sc = NPCase c ; qp = v.qp ; lock_V = <> ; p = v.p} ; + caseV c v = {s = v.s ; sc = NPCase c ; h = v.h ; lock_V = <> ; p = v.p} ; - vOlla = verbOlla ** {sc = NPCase Nom ; qp = True ; lock_V = <> ; p = []} ; ---- lieneekö + vOlla = { + s = table SVForm ["olla";"ole";"on";"o";"olk";"olla";"oli";"oli";"olisi";"oll";"oltu";"ollu";"liene";"ole"] ; + sc = NPCase Nom ; h = Back ; lock_V = <> ; p = []} ; ---- lieneekö mk2V2 : V -> Prep -> V2 = \v,c -> v ** {c2 = c ; lock_V2 = <>} ; caseV2 : V -> Case -> V2 = \v,c -> mk2V2 v (casePrep c) ; @@ -627,22 +715,21 @@ oper mkV2 = overload { mkV2 : Str -> V2 = \s -> dirV2 (mk1V s) ; + mkV2 : Str -> Case -> V2 = \s -> caseV2 (mk1V s) ; mkV2 : V -> V2 = dirV2 ; mkV2 : V -> Case -> V2 = caseV2 ; mkV2 : V -> Prep -> V2 = mk2V2 ; - mkV2 : VK -> V2 = \w -> dirV2 (vforms2V w.s ** {sc = NPCase Nom ; lock_V = <> ; p = []}) ; + mkV2 : VK -> V2 = \w -> dirV2 (vforms2sverb w.s ** {sc = NPCase Nom ; lock_V = <> ; p = []}) ; } ; mk2V2 : V -> Prep -> V2 ; caseV2 : V -> Case -> V2 ; dirV2 : V -> V2 ; - mkV3 v p q = v ** {c2 = p ; c3 = q ; lock_V3 = <>} ; - dirV3 v p = mkV3 v accPrep (casePrep p) ; + dirV3 v p = v ** {c2 = accPrep ; c3 = casePrep p ; lock_V3 = <>} ; dirdirV3 v = dirV3 v allative ; - mkVS v = v ** {lock_VS = <>} ; - mkVV v = mkVVf v infFirst ; + mkVVf v f = v ** {vi = f ; lock_VV = <>} ; mkVQ v = v ** {lock_VQ = <>} ; @@ -651,17 +738,23 @@ oper A2V : Type = A2 ; mkV0 v = v ** {lock_V = <>} ; + mkV2Sbare : V -> V2S = \v -> mkV2S v (casePrep allative) ; ---- + mkV2S v p = mk2V2 v p ** {lock_V2S = <>} ; - mkV2V v p = mkV2Vf v p infIllat ; + mkV2Vbare : V -> V2V = \v -> mkV2Vf v (casePrep partitive) infIllat ; ---- +-- mkV2V v p = mkV2Vf v p infIllat ; mkV2Vf v p f = mk2V2 v p ** {vi = f ; lock_V2V = <>} ; + mkVAbare : V -> VA = \v -> mkVA v (casePrep partitive) ; ---- mkVA v p = v ** {c2 = p ; lock_VA = <>} ; + mkV2Abare : V -> V2A = \v -> mkV2A v (casePrep partitive) (casePrep translative) ; mkV2A v p q = v ** {c2 = p ; c3 = q ; lock_V2A = <>} ; + mkV2Qbare : V -> V2Q = \v -> mkV2Q v (casePrep ablative) ; ---- mkV2Q v p = mk2V2 v p ** {lock_V2Q = <>} ; mkAS v = v ** {lock_A = <>} ; - mkA2S v p = mkA2 v p ** {lock_A = <>} ; +--- mkA2S v p = mkA2 p ** {lock_A = <>} ; mkAV v = v ** {lock_A = <>} ; - mkA2V v p = mkA2 v p ** {lock_A2 = <>} ; +--- mkA2V v p = mkA2 p ** {lock_A2 = <>} ; } ; diff --git a/lib/src/finnish/QuestionFin.gf b/lib/src/finnish/QuestionFin.gf index fa35a37c2..dd736cf4c 100644 --- a/lib/src/finnish/QuestionFin.gf +++ b/lib/src/finnish/QuestionFin.gf @@ -31,7 +31,7 @@ concrete QuestionFin of Question = CatFin ** open ResFin, Prelude in { QuestIComp icomp np = { s = \\t,a,p => let - vp = predV (verbOlla ** {sc = NPCase Nom ; qp = True ; p = []}) ; + vp = predV (verbOlla ** {sc = NPCase Nom ; h = Back ; p = []}) ; cl = mkClause (subjForm np vp.sc) np.a vp ; in icomp.s ! np.a ++ cl.s ! t ! a ! p ! SDecl diff --git a/lib/src/finnish/ResFin.gf b/lib/src/finnish/ResFin.gf index 20337464a..e51ee19cc 100644 --- a/lib/src/finnish/ResFin.gf +++ b/lib/src/finnish/ResFin.gf @@ -61,7 +61,7 @@ param AForm = AN NForm | AAdv ; oper - Adjective : Type = {s : Degree => AForm => Str; lock_A : {}} ; + Adjective : Type = {s : Degree => AForm => Str} ; --2 Noun phrases -- @@ -204,10 +204,10 @@ oper ext : Str ; sc : NPForm ; isNeg : Bool ; -- True if some complement is negative - qp : Bool -- True = back vowel + h : Harmony } ; - predV : (Verb ** {sc : NPForm ; qp : Bool ; p : Str}) -> VP = \verb -> { + predV : (Verb ** {sc : NPForm ; h : Harmony ; p : Str}) -> VP = \verb -> { s = \\vi,ant,b,agr0 => let @@ -280,7 +280,7 @@ oper adv = \\_ => verb.p ; -- the particle of the verb ext = [] ; sc = verb.sc ; - qp = verb.qp ; + h = verb.h ; isNeg = False } ; @@ -290,17 +290,17 @@ oper adv = vp.adv ; ext = vp.ext ; sc = vp.sc ; - qp = vp.qp ; + h = vp.h ; isNeg = vp.isNeg } ; - insertObjPre : Bool -> (Bool => Polarity => Agr => Str) -> VP -> VP = \isNeg, obj,vp -> { + insertObjPre : Bool -> (Bool -> Polarity -> Agr -> Str) -> VP -> VP = \isNeg, obj,vp -> { s = vp.s ; - s2 = \\fin,b,a => obj ! fin ! b ! a ++ vp.s2 ! fin ! b ! a ; + s2 = \\fin,b,a => obj fin b a ++ vp.s2 ! fin ! b ! a ; adv = vp.adv ; ext = vp.ext ; sc = vp.sc ; - qp = vp.qp ; + h = vp.h ; isNeg = orB vp.isNeg isNeg } ; @@ -310,7 +310,7 @@ oper ext = vp.ext ; adv = \\b => vp.adv ! b ++ adv ! b ; sc = vp.sc ; - qp = vp.qp ; + h = vp.h ; isNeg = vp.isNeg --- missään } ; @@ -320,7 +320,7 @@ oper ext = vp.ext ++ obj ; adv = vp.adv ; sc = vp.sc ; - qp = vp.qp ; + h = vp.h ; isNeg = vp.isNeg } ; @@ -331,7 +331,7 @@ oper } ; ClausePlus : Type = { - s : Tense => Anteriority => Polarity => {subj,fin,inf,compl,adv,ext : Str ; qp : Bool} + s : Tense => Anteriority => Polarity => {subj,fin,inf,compl,adv,ext : Str ; h : Harmony} } ; mkClausePol : Bool -> (Polarity -> Str) -> Agr -> VP -> Clause = @@ -346,7 +346,7 @@ oper in table { SDecl => c.subj ++ c.fin ++ c.inf ++ c.compl ++ c.adv ++ c.ext ; - SQuest => c.fin ++ BIND ++ questPart c.qp ++ c.subj ++ c.inf ++ c.compl ++ c.adv ++ c.ext + SQuest => c.fin ++ BIND ++ questPart c.h ++ c.subj ++ c.inf ++ c.compl ++ c.adv ++ c.ext } } ; mkClause : (Polarity -> Str) -> Agr -> VP -> Clause = @@ -354,7 +354,7 @@ oper s = \\t,a,b => let c = (mkClausePlus sub agr vp).s ! t ! a ! b in table { SDecl => c.subj ++ c.fin ++ c.inf ++ c.compl ++ c.adv ++ c.ext ; - SQuest => c.fin ++ BIND ++ questPart c.qp ++ c.subj ++ c.inf ++ c.compl ++ c.adv ++ c.ext + SQuest => c.fin ++ BIND ++ questPart c.h ++ c.subj ++ c.inf ++ c.compl ++ c.adv ++ c.ext } } ; @@ -373,7 +373,7 @@ oper compl = vp.s2 ! agrfin.p2 ! b ! agr ; adv = vp.adv ! b ; ext = vp.ext ; - qp = selectPart vp a b + h = selectPart vp a b } } ; @@ -383,10 +383,10 @@ oper c = cl.s ! t ! a ! b in case p of { - 0 => {subj = c.subj ++ kin b True ; fin = c.fin ; inf = c.inf ; -- Jussikin nukkuu - compl = c.compl ; adv = c.adv ; ext = c.ext ; qp = c.qp} ; - 1 => {subj = c.subj ; fin = c.fin ++ kin b c.qp ; inf = c.inf ; -- Jussi nukkuukin - compl = c.compl ; adv = c.adv ; ext = c.ext ; qp = c.qp} + 0 => {subj = c.subj ++ kin b Back ; fin = c.fin ; inf = c.inf ; -- Jussikin nukkuu + compl = c.compl ; adv = c.adv ; ext = c.ext ; h = c.h} ; + 1 => {subj = c.subj ; fin = c.fin ++ kin b c.h ; inf = c.inf ; -- Jussi nukkuukin + compl = c.compl ; adv = c.adv ; ext = c.ext ; h = c.h} } } ; @@ -395,20 +395,20 @@ oper s = \\t,a,b => let c = cl.s ! t ! a ! b ; - co = obj ! b ++ if_then_Str ifKin (kin b True) [] ; + co = obj ! b ++ if_then_Str ifKin (kin b Back) [] ; in case p of { 0 => {subj = c.subj ; fin = c.fin ; inf = c.inf ; - compl = co ; adv = c.compl ++ c.adv ; ext = c.ext ; qp = c.qp} ; -- Jussi juo maitoakin + compl = co ; adv = c.compl ++ c.adv ; ext = c.ext ; h = c.h} ; -- Jussi juo maitoakin 1 => {subj = c.subj ; fin = c.fin ; inf = c.inf ; - compl = c.compl ; adv = co ; ext = c.adv ++ c.ext ; qp = c.qp} -- Jussi nukkuu nytkin + compl = c.compl ; adv = co ; ext = c.adv ++ c.ext ; h = c.h} -- Jussi nukkuu nytkin } } ; - kin : Polarity -> Bool -> Str = + kin : Polarity -> Harmony -> Str = \p,b -> case p of {Pos => (mkPart "kin" "kin").s ! b ; Neg => (mkPart "kaan" "kään").s ! b} ; - mkPart : Str -> Str -> {s : Bool => Str} = \ko,koe -> - {s = table {True => glueTok ko ; False => glueTok koe}} ; + mkPart : Str -> Str -> {s : Harmony => Str} = \ko,koe -> + {s = table {Back => glueTok ko ; Front => glueTok koe}} ; glueTok : Str -> Str = \s -> "&+" ++ s ; @@ -418,14 +418,14 @@ oper subjForm : NP -> NPForm -> Polarity -> Str = \np,sc,b -> appCompl False b {s = [] ; c = sc ; isPre = True} np ; - questPart : Bool -> Str = \b -> if_then_Str b "ko" "kö" ; + questPart : Harmony -> Str = \b -> case b of {Back => "ko" ; _ => "kö"} ; - selectPart : VP -> Anteriority -> Polarity -> Bool = \vp,a,p -> + selectPart : VP -> Anteriority -> Polarity -> Harmony = \vp,a,p -> case p of { - Neg => False ; -- eikö tule + Neg => Front ; -- eikö tule _ => case a of { - Anter => True ; -- onko mennyt --# notpresent - _ => vp.qp -- tuleeko, meneekö + Anter => Back ; -- onko mennyt --# notpresent + _ => vp.h -- tuleeko, meneekö } } ; @@ -440,10 +440,10 @@ oper } ; verb = case ipol of { Pos => ; -- nähdä/näkemään - Neg => <(predV (verbOlla ** {sc = NPCase Nom ; qp = True ; p = []})).s ! VIInf vi ! Simul ! Pos ! agr, + Neg => <(predV (verbOlla ** {sc = NPCase Nom ; h = Back ; p = []})).s ! VIInf vi ! Simul ! Pos ! agr, (vp.s ! VIInf Inf3Abess ! Simul ! Pos ! agr).fin> -- olla/olemaan näkemättä } ; - vph = case vp.qp of {True => Back ; False => Front} ; + vph = vp.h ; poss = case vi of { InfPresPartAgr => possSuffixGen vph agr ; -- toivon nukkuva + ni _ => [] diff --git a/lib/src/finnish/SentenceFin.gf b/lib/src/finnish/SentenceFin.gf index d869bfdb8..a4d46b5b1 100644 --- a/lib/src/finnish/SentenceFin.gf +++ b/lib/src/finnish/SentenceFin.gf @@ -1,4 +1,4 @@ -concrete SentenceFin of Sentence = CatFin ** open Prelude, ResFin in { +concrete SentenceFin of Sentence = CatFin ** open Prelude, ResFin, StemFin in { flags optimize=all_subs ; @@ -38,7 +38,7 @@ concrete SentenceFin of Sentence = CatFin ** open Prelude, ResFin in { s = \\t,a,p => (mkClause (subjForm np vs.sc) np.a (insertExtrapos ("että" ++ slash.s) - (predV vs)) + (predSV vs)) ).s ! t ! a ! p ! SDecl ; c2 = slash.c2 } ; @@ -64,4 +64,6 @@ concrete SentenceFin of Sentence = CatFin ** open Prelude, ResFin in { RelS s r = {s = s.s ++ "," ++ r.s ! agrP3 Sg} ; ---- mikä + SSubjS a subj b = {s = a.s ++ "," ++ subj.s ++ b.s} ; + } diff --git a/lib/src/finnish/StructuralFin.gf b/lib/src/finnish/StructuralFin.gf index 08bcee37d..173fb1f8d 100644 --- a/lib/src/finnish/StructuralFin.gf +++ b/lib/src/finnish/StructuralFin.gf @@ -1,5 +1,5 @@ concrete StructuralFin of Structural = CatFin ** - open MorphoFin, ParadigmsFin, (X = ConstructX), MakeStructuralFin, Prelude in { + open MorphoFin, ParadigmsFin, (X = ConstructX), StemFin, Prelude in { flags optimize=all ; @@ -9,7 +9,7 @@ concrete StructuralFin of Structural = CatFin ** all_Predet = {s = \\n,c => let - kaiket = caseTable n (mkN "kaikki" "kaiken" "kaikkia") + kaiket = caseTable n (snoun2nounBind (mkN "kaikki" "kaiken" "kaikkena")) in case npform2case n c of { Nom => "kaikki" ; @@ -32,12 +32,12 @@ concrete StructuralFin of Structural = CatFin ** can_VV = mkVV (mkV "voida" "voi") ; during_Prep = postGenPrep "aikana" ; either7or_DConj = sd2 "joko" "tai" ** {n = Sg} ; - everybody_NP = makeNP (mkN "jokainen") Sg ; - every_Det = mkDet Sg (mkN "jokainen") ; - everything_NP = makeNP (((mkN "kaikki" "kaiken" "kaikkena")) ** + everybody_NP = makeNP (snoun2nounBind (mkN "jokainen")) Sg ; + every_Det = MorphoFin.mkDet Sg (snoun2nounBind (mkN "jokainen")) ; + everything_NP = makeNP (((snoun2nounBind (mkN "kaikki" "kaiken" "kaikkena"))) ** {lock_N = <>}) Sg ; everywhere_Adv = ss "kaikkialla" ; - few_Det = mkDet Sg (mkN "harva") ; + few_Det = MorphoFin.mkDet Sg (snoun2nounBind (mkN "harva")) ; --- first_Ord = {s = \\n,c => (mkN "ensimmäinen").s ! NCase n c} ; for_Prep = casePrep allative ; from_Prep = casePrep elative ; @@ -48,7 +48,7 @@ concrete StructuralFin of Structural = CatFin ** how_IAdv = ss "miten" ; how8much_IAdv = ss "kuinka paljon" ; how8many_IDet = - {s = \\c => "kuinka" ++ (mkN "moni" "monia").s ! NCase Sg c ; n = Sg ; isNum = False} ; + {s = \\c => "kuinka" ++ (snoun2nounBind (mkN "moni" "monia")).s ! NCase Sg c ; n = Sg ; isNum = False} ; if_Subj = ss "jos" ; in8front_Prep = postGenPrep "edessä" ; i_Pron = mkPronoun "minä" "minun" "minua" "minuna" "minuun" Sg P1 ; @@ -56,17 +56,17 @@ concrete StructuralFin of Structural = CatFin ** it_Pron = { s = \\c => pronSe.s ! npform2case Sg c ; a = agrP3 Sg ; - isPron = False + hasPoss = False } ; less_CAdv = X.mkCAdv "vähemmän" "kuin" ; - many_Det = mkDet Sg (mkN "moni" "monia") ; + many_Det = MorphoFin.mkDet Sg (snoun2nounBind (mkN "moni" "monia")) ; more_CAdv = X.mkCAdv "enemmän" "kuin" ; most_Predet = {s = \\n,c => (nForms2N (dSuurin "useinta")).s ! NCase n (npform2case n c)} ; - much_Det = mkDet Sg {s = \\_ => "paljon" ; h = Back} ; --Harmony not relevant, it's just a CommonNoun + much_Det = MorphoFin.mkDet Sg {s = \\_ => "paljon" ; h = Back} ; --Harmony not relevant, it's just a CommonNoun must_VV = mkVV (caseV genitive (mkV "täytyä")) ; no_Utt = ss "ei" ; on_Prep = casePrep adessive ; ---- one_Quant = mkDet Sg DEPREC +--- one_Quant = MorphoFin.mkDet Sg DEPREC only_Predet = {s = \\_,_ => "vain"} ; or_Conj = {s1 = [] ; s2 = "tai" ; n = Sg} ; otherwise_PConj = ss "muuten" ; @@ -82,12 +82,12 @@ concrete StructuralFin of Structural = CatFin ** isPron = False ; isNeg = False } ; someSg_Det = heavyDet { - s1 = jokinPron ! Sg ; + s1 = jokuPron ! Sg ; s2 = \\_ => [] ; isNum,isPoss = False ; isDef = True ; isNeg = False ; n = Sg } ; somePl_Det = heavyDet { - s1 = jokinPron ! Pl ; + s1 = jokuPron ! Pl ; s2 = \\_ => [] ; isNum,isPoss = False ; isNeg = False ; isDef = True ; n = Pl ; isNeg = False } ; @@ -162,12 +162,12 @@ concrete StructuralFin of Structural = CatFin ** youPl_Pron = mkPronoun "te" "teidän" "teitä" "teinä" "teihin" Pl P2 ; youPol_Pron = let p = mkPronoun "te" "teidän" "teitä" "teinä" "teihin" Pl P2 in - {s = p.s ; a = AgPol} ; + {s = p.s ; a = AgPol ; hasPoss = True} ; oper jokuPron : MorphoFin.Number => (MorphoFin.Case) => Str = let - kui = mkN "kuu" + kui = snoun2nounBind (mkN "kuu") in table { Sg => table { @@ -196,7 +196,7 @@ oper mikaInt : MorphoFin.Number => (MorphoFin.Case) => Str = let { - mi = mkN "mi" + mi = snoun2nounBind (mkN "mi") } in table { Sg => table { @@ -217,8 +217,8 @@ oper kukaInt : MorphoFin.Number => (MorphoFin.Case) => Str = let - kuka = mkN "kuka" "kenen" "ketä" "kenä" "keneen" - "keiden" "keitä" "keinä" "keissä" "keihin" ; + kuka = snoun2nounBind (mkN "kuka" "kenen" "ketä" "kenä" "keneen" + "keiden" "keitä" "keinä" "keissä" "keihin") ; in table { Sg => table { diff --git a/lib/src/finnish/SymbolFin.gf b/lib/src/finnish/SymbolFin.gf index d3c5d9c4b..7714e8c07 100644 --- a/lib/src/finnish/SymbolFin.gf +++ b/lib/src/finnish/SymbolFin.gf @@ -1,12 +1,12 @@ --# -path=.:../abstract:../common -concrete SymbolFin of Symbol = CatFin ** open Prelude, NounFin, ResFin, MorphoFin in { +concrete SymbolFin of Symbol = CatFin ** open Prelude, NounFin, ResFin, MorphoFin, StemFin in { lin - SymbPN i = {s = \\c => i.s ++ bindIf c ++ defaultCaseEnding c} ; --- c - IntPN i = {s = \\c => i.s ++ bindColonIf c ++ defaultCaseEnding c} ; --- c - FloatPN i = {s = \\c => i.s ++ bindColonIf c ++ defaultCaseEnding c} ; --- c - NumPN i = {s = \\c => i.s!Sg!Nom } ; --- c + SymbPN i = addStemEnding i.s ; + IntPN i = addStemEnding i.s ; + FloatPN i = addStemEnding i.s ; + NumPN i = {s = \\c => i.s!Sg!Nom ; h = Back} ; --- c CNIntNP cn i = { s = \\c => cn.s ! NCase Sg (npform2case Sg c) ++ i.s ; diff --git a/lib/src/finnish/VerbFin.gf b/lib/src/finnish/VerbFin.gf index 0129a8589..3e8560b9f 100644 --- a/lib/src/finnish/VerbFin.gf +++ b/lib/src/finnish/VerbFin.gf @@ -1,79 +1,79 @@ --1 Verb Phrases in Finnish -concrete VerbFin of Verb = CatFin ** open Prelude, ResFin in { +concrete VerbFin of Verb = CatFin ** open Prelude, ResFin, StemFin in { flags optimize=all_subs ; lin - UseV = predV ; + UseV = predSV ; - SlashV2a v = predV v ** {c2 = v.c2} ; + SlashV2a v = predSV v ** {c2 = v.c2} ; Slash2V3 v np = insertObj - (\\fin,b,_ => appCompl fin b v.c2 np) (predV v) ** {c2 = v.c3} ; + (\\fin,b,_ => appCompl fin b v.c2 np) (predSV v) ** {c2 = v.c3} ; Slash3V3 v np = insertObj - (\\fin,b,_ => appCompl fin b v.c3 np) (predV v) ** {c2 = v.c2} ; + (\\fin,b,_ => appCompl fin b v.c3 np) (predSV v) ** {c2 = v.c2} ; ComplVV v vp = insertObj (\\_,b,a => infVP v.sc b a vp v.vi) - (predV {s = v.s ; + (predSV {s = v.s ; sc = case vp.sc of { NPCase Nom => v.sc ; -- minun täytyy pestä auto c => c -- minulla täytyy olla auto } ; - qp = v.qp ; p = v.p + h = v.h ; p = v.p } ) ; - ComplVS v s = insertExtrapos (etta_Conj ++ s.s) (predV v) ; - ComplVQ v q = insertExtrapos ( q.s) (predV v) ; + ComplVS v s = insertExtrapos ("," ++ etta_Conj ++ s.s) (predSV v) ; + ComplVQ v q = insertExtrapos ("," ++ q.s) (predSV v) ; ComplVA v ap = insertObj (\\_,b,agr => let n = (complNumAgr agr) in ap.s ! False ! (NCase n (npform2case n v.c2.c))) --- v.cs.s ignored - (predV v) ; + (predSV v) ; SlashV2S v s = - insertExtrapos (etta_Conj ++ s.s) (predV v) ** {c2 = v.c2} ; + insertExtrapos ("," ++ etta_Conj ++ s.s) (predSV v) ** {c2 = v.c2} ; SlashV2Q v q = - insertExtrapos (q.s) (predV v) ** {c2 = v.c2} ; + insertExtrapos ("," ++ q.s) (predSV v) ** {c2 = v.c2} ; SlashV2V v vp = - insertObj (\\_,b,a => infVP v.sc b a vp v.vi) (predV v) ** {c2 = v.c2} ; - ---- different infinitives + insertObj (\\_,b,a => infVP v.sc b a vp v.vi) (predSV v) ** {c2 = v.c2} ; SlashV2A v ap = insertObj (\\fin,b,_ => ap.s ! False ! (NCase Sg (npform2case Sg v.c3.c))) ----agr to obj - (predV v) ** {c2 = v.c2} ; + (predSV v) ** {c2 = v.c2} ; - ComplSlash vp np = insertObjPre np.isNeg (\\fin,b,_ => appCompl fin b vp.c2 np) vp ; + ComplSlash vp np = insertObjPre np.isNeg (\fin,b,_ -> appCompl fin b vp.c2 np) vp ; UseComp comp = - insertObj (\\_,_ => comp.s) (predV (verbOlla ** {sc = NPCase Nom ; qp = True ; p = []})) ; + insertObj (\\_,_ => comp.s) (predV (verbOlla ** {sc = NPCase Nom ; h = Back ; p = []})) ; - UseCopula = predV (verbOlla ** {sc = NPCase Nom ; qp = True ; p = []}) ; + UseCopula = predV (verbOlla ** {sc = NPCase Nom ; h = Back ; p = []}) ; SlashVV v vp = insertObj (\\_,b,a => infVP v.sc b a vp v.vi) - (predV {s = v.s ; + (predSV {s = v.s ; sc = case vp.sc of { NPCase Nom => v.sc ; -- minun täytyy pestä auto c => c -- minulla täytyy olla auto } ; - qp = v.qp ; p = v.p + h = v.h ; p = v.p } ) ** {c2 = vp.c2} ; ---- correct ?? - +-- { ---- 153543936 (210912,312) SlashV2VNP v np vp = insertObjPre np.isNeg - (\\fin,b,a => appCompl True b v.c2 np ++ ---- fin -> stack overflow + (\fin,b,a -> appCompl fin b v.c2 np ++ ---- compilation to pgf takes too long 6/8/2013 infVP v.sc b a vp v.vi) - (predV v) ** {c2 = vp.c2} ; + (predSV v) ** {c2 = vp.c2} ; +---- } AdvVP vp adv = insertAdv (\\_ => adv.s) vp ; @@ -83,9 +83,9 @@ concrete VerbFin of Verb = CatFin ** open Prelude, ResFin in { AdVVPSlash adv vps = insertAdv (\\_ => adv.s) vps ** {c2 = vps.c2} ; - ReflVP v = insertObjPre False (\\fin,b,agr => appCompl fin b v.c2 (reflPron agr)) v ; + ReflVP v = insertObjPre False (\fin,b,agr -> appCompl fin b v.c2 (reflPron agr)) v ; - PassV2 v = let vp = predV v in { + PassV2 v = let vp = predSV v in { s = \\vif,ant,pol,agr => case vif of { VIFin t => vp.s ! VIPass t ! ant ! pol ! agr ; _ => vp.s ! vif ! ant ! pol ! agr @@ -93,10 +93,10 @@ concrete VerbFin of Verb = CatFin ** open Prelude, ResFin in { s2 = \\_,_,_ => [] ; adv = \\_ => [] ; ext = [] ; - qp = v.qp ; + h = vp.h ; isNeg = False ; - sc = v.c2.c -- minut valitaan ; minua rakastetaan ; minulle kuiskataan - } ; ---- talon valitaan: should be marked like inf. + sc = v.c2.c ; -- minut valitaan ; minua rakastetaan ; minulle kuiskataan + } ; ---- talon valitaan: should be marked like inf. ----b UseVS, UseVQ = \v -> v ** {c2 = {s = [] ; c = NPAcc ; isPre = True}} ; diff --git a/lib/src/finnish/stemmed/AdjectiveFin.gf b/lib/src/finnish/stemmed/AdjectiveFin.gf deleted file mode 100644 index 7759cff3c..000000000 --- a/lib/src/finnish/stemmed/AdjectiveFin.gf +++ /dev/null @@ -1,57 +0,0 @@ -concrete AdjectiveFin of Adjective = CatFin ** open ResFin, StemFin, Prelude in { - - flags optimize=all_subs ; -- gfc size from 2864336 to 6786 - i.e. factor 422 - - lin - - PositA a = { - s = \\_ => (snoun2nounSep {s = \\f => a.s ! Posit ! SAN f ; h = a.h}).s - } ; - ComparA a np = - let acomp = (snoun2nounSep {s = \\f => a.s ! Posit ! SAN f ; h = a.h}).s in { - s = \\isMod,af => case isMod of { - True => np.s ! NPCase Part ++ acomp ! af ; -- minua isompi - _ => acomp ! af ++ "kuin" ++ np.s ! NPCase Nom -- isompi kuin minä - } - } ; - CAdvAP ad ap np = { - s = \\m,af => ad.s ++ ap.s ! m ! af ++ ad.p ++ np.s ! NPCase Nom - } ; - UseComparA a = { - s = \\_ => (snoun2nounSep {s = \\f => a.s ! Compar ! SAN f ; h = a.h}).s - } ; - --- $SuperlA$ belongs to determiner syntax in $Noun$. - AdjOrd ord = { - s = \\_ => ord.s - } ; - - - ComplA2 a np = { - s = \\isMod,af => - preOrPost isMod (appCompl True Pos a.c2 np) ((snoun2nounSep {s = \\f => a.s ! Posit ! SAN f ; h = a.h}).s ! af) - } ; - - ReflA2 a = { - s = \\isMod,af => - preOrPost isMod - (appCompl True Pos a.c2 (reflPron (agrP3 Sg))) ((snoun2nounSep {s = \\f => a.s ! Posit ! SAN f ; h = a.h}).s ! af) - } ; - - SentAP ap sc = { - s = \\b,a => ap.s ! b ! a ++ sc.s - } ; - - AdAP ada ap = { - s = \\b,af => ada.s ++ ap.s ! b ! af - } ; - - AdvAP ap adv = { - s = \\b,af => adv.s ++ ap.s ! b ! af -- luonnostaan vaalea - } ; - - UseA2 a = { - s = \\_ => (snoun2nounSep {s = \\f => a.s ! Posit ! SAN f ; h = a.h}).s - } ; - -} diff --git a/lib/src/finnish/stemmed/AdverbFin.gf b/lib/src/finnish/stemmed/AdverbFin.gf deleted file mode 100644 index 3eb439b13..000000000 --- a/lib/src/finnish/stemmed/AdverbFin.gf +++ /dev/null @@ -1,23 +0,0 @@ -concrete AdverbFin of Adverb = CatFin ** open ResFin, Prelude, StemFin in { - - lin - PositAdvAdj a = {s = a.s ! Posit ! SAAdv} ; - ComparAdvAdj cadv a np = { - s = cadv.s ++ a.s ! Posit ! SAAdv ++ cadv.p ++ np.s ! NPCase Nom - } ; - ComparAdvAdjS cadv a s = { - s = cadv.s ++ a.s ! Posit ! SAAdv ++ cadv.p ++ s.s - } ; - - PrepNP prep np = {s = preOrPost prep.isPre prep.s (np.s ! prep.c)} ; - - AdAdv = cc2 ; - - PositAdAAdj a = {s = glue (a.s ! Posit ! SAN 1) "n"} ; -- älyttömän - - SubjS = cc2 ; -----b AdvSC s = s ; - - AdnCAdv cadv = {s = cadv.s ++ "kuin"} ; - -} diff --git a/lib/src/finnish/stemmed/AllFin.gf b/lib/src/finnish/stemmed/AllFin.gf deleted file mode 100644 index 0d3f47011..000000000 --- a/lib/src/finnish/stemmed/AllFin.gf +++ /dev/null @@ -1,6 +0,0 @@ ---# -path=.:../abstract:../common:prelude - -concrete AllFin of AllFinAbs = - LangFin - [SlashV2VNP,SlashVV, TFut], ---- to speed up linking; to remove spurious parses - ExtraFin - [ProDrop, ProDropPoss, S_OSV, S_VSO, S_ASV] -- to exclude spurious parses - ** {} ; diff --git a/lib/src/finnish/stemmed/CatFin.gf b/lib/src/finnish/stemmed/CatFin.gf deleted file mode 100644 index ce8125370..000000000 --- a/lib/src/finnish/stemmed/CatFin.gf +++ /dev/null @@ -1,99 +0,0 @@ -concrete CatFin of Cat = CommonX ** open ResFin, StemFin, Prelude in { - - flags optimize=all_subs ; - - lincat - --- Tensed/Untensed - - S = {s : Str} ; - QS = {s : Str} ; - RS = {s : Agr => Str ; c : NPForm} ; - SSlash = {s : Str ; c2 : Compl} ; - --- Sentence - - Cl = {s : ResFin.Tense => Anteriority => Polarity => SType => Str} ; - ClSlash = {s : ResFin.Tense => Anteriority => Polarity => Str ; c2 : Compl} ; - Imp = {s : Polarity => Agr => Str} ; - --- Question - - QCl = {s : ResFin.Tense => Anteriority => Polarity => Str} ; - IP = {s : NPForm => Str ; n : Number} ; - IComp = {s : Agr => Str} ; - IDet = {s : Case => Str ; n : Number ; isNum : Bool} ; - IQuant = {s : Number => Case => Str} ; - --- Relative - - RCl = {s : ResFin.Tense => Anteriority => Polarity => Agr => Str ; c : NPForm} ; - RP = {s : Number => NPForm => Str ; a : RAgr} ; - --- Verb - - VP = ResFin.VP ; - VPSlash = ResFin.VP ** {c2 : Compl} ; - Comp = {s : Agr => Str} ; - --- Adjective - --- The $Bool$ tells whether usage is modifying (as opposed to --- predicative), e.g. "x on suurempi kuin y" vs. "y:tä suurempi luku". - - AP = {s : Bool => NForm => Str} ; - --- Noun - --- The $Bool$ tells if a possessive suffix is attached, which affects the case. - - CN = {s : NForm => Str ; h : Harmony} ; - Pron = {s : NPForm => Str ; a : Agr ; hasPoss : Bool} ; - NP = {s : NPForm => Str ; a : Agr ; isPron : Bool ; isNeg : Bool} ; - Det = { - s1 : Case => Str ; -- minun kolme - s2 : Harmony => Str ; -- -ni (Front for -nsä, Back for -nsa) - sp : Case => Str ; -- se (substantival form) - n : Number ; -- Pl (agreement feature for verb) - isNum : Bool ; -- True (a numeral is present) - isPoss : Bool ; -- True (a possessive suffix is present) - isDef : Bool ; -- True (verb agrees in Pl, Nom is not Part) - isNeg : Bool -- False (only True for "mikään", "kukaan") - } ; ----- QuantSg, QuantPl = {s1 : Case => Str ; s2 : Str ; isPoss, isDef : Bool} ; - Ord = {s : NForm => Str} ; - Predet = {s : Number => NPForm => Str} ; - Quant = {s1,sp : Number => Case => Str ; s2 : Harmony => Str ; isPoss : Bool ; isDef : Bool ; isNeg : Bool} ; - Card = {s : Number => Case => Str ; n : Number} ; - Num = {s : Number => Case => Str ; isNum : Bool ; n : Number} ; - --- Numeral - - Numeral = {s : CardOrd => Str ; n : Number} ; - Digits = {s : CardOrd => Str ; n : Number} ; - --- Structural - - Conj = {s1,s2 : Str ; n : Number} ; -----b DConj = {s1,s2 : Str ; n : Number} ; - Subj = {s : Str} ; - Prep = Compl ; - --- Open lexical classes, e.g. Lexicon - - V, VS, VQ = SVerb1 ; - V2, VA, V2Q, V2S = SVerb1 ** {c2 : Compl} ; - V2A = SVerb1 ** {c2, c3 : Compl} ; - VV = SVerb1 ** {vi : InfForm} ; ---- infinitive form - V2V = SVerb1 ** {c2 : Compl ; vi : InfForm} ; ---- infinitive form - V3 = SVerb1 ** {c2, c3 : Compl} ; - - A = {s : Degree => SAForm => Str ; h : Harmony} ; - A2 = {s : Degree => SAForm => Str ; h : Harmony ; c2 : Compl} ; - - N = SNoun ; - N2 = SNoun ** {c2 : Compl ; isPre : Bool} ; - N3 = SNoun ** {c2,c3 : Compl ; isPre,isPre2 : Bool} ; - PN = SNoun ; - -} diff --git a/lib/src/finnish/stemmed/ExtraFin.gf b/lib/src/finnish/stemmed/ExtraFin.gf deleted file mode 100644 index 04ed6f6f3..000000000 --- a/lib/src/finnish/stemmed/ExtraFin.gf +++ /dev/null @@ -1,232 +0,0 @@ ---# -path=.:abstract:common:prelude - -concrete ExtraFin of ExtraFinAbs = CatFin ** - open ResFin, MorphoFin, Coordination, Prelude, NounFin, StructuralFin, StemFin, (R = ParamX) in { - - lin - GenNP np = { - s1,sp = \\_,_ => np.s ! NPCase Gen ; - s2 = \\_ => [] ; - isNum = False ; - isPoss = False ; - isDef = True ; --- "Jussin kolme autoa ovat" ; thus "...on" is missing - isNeg = False - } ; - - GenIP ip = {s = \\_,_ => ip.s ! NPCase Gen} ; - - GenCN n1 n2 = {s = \\nf => n1.s ! NPCase Gen ++ n2.s ! nf ; - h = n2.h } ; - - GenRP num cn = { - s = \\n,c => let k = (npform2case num.n c) in "jonka" ++ num.s ! Sg ! k ++ cn.s ! NCase num.n k ; - a = RAg (agrP3 num.n) ; - } ; - - lincat - VPI = {s : InfForm => Str} ; - [VPI] = {s1,s2 : InfForm => Str} ; - lin - BaseVPI = twoTable InfForm ; - ConsVPI = consrTable InfForm comma ; - - MkVPI vp = {s = \\i => infVP (NPCase Nom) Pos (agrP3 Sg) vp i} ; - ConjVPI = conjunctDistrTable InfForm ; - ComplVPIVV vv vpi = - insertObj (\\_,_,_ => vpi.s ! vv.vi) (predSV vv) ; - - lincat - VPS = { - s : Agr => Str ; - sc : NPForm ; --- can be different for diff parts - qp : Bool -- True = back vowel --- can be different for diff parts - } ; - - [VPS] = { - s1,s2 : Agr => Str ; - sc : NPForm ; --- take the first: minä osaan kutoa ja täytyy virkata - qp : Bool --- take the first: osaanko minä kutoa ja käyn koulua - } ; - - lin - BaseVPS x y = twoTable Agr x y ** {sc = x.sc ; qp = x.qp} ; - ConsVPS x y = consrTable Agr comma x y ** {sc = x.sc ; qp = x.qp} ; - - ConjVPS conj ss = conjunctDistrTable Agr conj ss ** { - sc = ss.sc ; qp = ss.qp - } ; - - MkVPS t p vp = { -- Temp -> Pol -> VP -> VPS ; - s = \\a => let vps = vp.s ! VIFin t.t ! t.a ! p.p ! a - in - t.s ++ p.s ++ - vps.fin ++ vps.inf ++ - vp.s2 ! True ! p.p ! a ++ - vp.adv ! p.p ++ - vp.ext ; - sc = vp.sc ; - qp = vp.qp - } ; - - PredVPS np vps = { -- NP -> VPS -> S ; - s = subjForm np vps.sc Pos ++ vps.s ! np.a - } ; - - AdvExistNP adv np = - mkClause (\_ -> adv.s) np.a (insertObj - (\\_,b,_ => np.s ! NPCase Nom) (predV (verbOlla ** {sc = NPCase Nom ; qp = True ; p = []}))) ; - - RelExistNP prep rp np = { - s = \\t,ant,bo,ag => - let - n = complNumAgr ag ; - cl = mkClause - (\_ -> appCompl True Pos prep (rp2np n rp)) - np.a - (insertObj - (\\_,b,_ => np.s ! NPCase Nom) - (predV (verbOlla ** {sc = NPCase Nom ; qp = True ; p = []}))) ; - in - cl.s ! t ! ant ! bo ! SDecl ; - c = NPCase Nom - } ; - - AdvPredNP adv v np = - mkClause (\_ -> adv.s) np.a (insertObj - (\\_,b,_ => subjForm np v.sc b) (predSV v)) ; - - ICompExistNP adv np = - let cl = mkClause (\_ -> adv.s ! np.a) np.a (insertObj - (\\_,b,_ => np.s ! NPCase Nom) (predV (verbOlla ** {sc = NPCase Nom ; qp = True ; p = []}))) ; - in { - s = \\t,a,p => cl.s ! t ! a ! p ! SDecl - } ; - - IAdvPredNP iadv v np = - let cl = mkClause (\_ -> iadv.s) np.a (insertObj - (\\_,b,_ => np.s ! v.sc) (predSV v)) ; - in { - s = \\t,a,p => cl.s ! t ! a ! p ! SDecl - } ; - --- i_implicPron = mkPronoun [] "minun" "minua" "minuna" "minuun" Sg P1 ; - whatPart_IP = { - s = table { - NPCase Nom | NPAcc => "mitä" ; - c => whatSg_IP.s ! c - } ; - n = Sg - } ; - - PartCN cn = - let - acn = DetCN (DetQuant IndefArt NumSg) cn - in { - s = table { - NPCase Nom | NPAcc => acn.s ! NPCase ResFin.Part ; - c => acn.s ! c - } ; - a = acn.a ; - isPron = False ; isNeg = False - } ; - - vai_Conj = {s1 = [] ; s2 = "vai" ; n = Sg} ; - - CompPartAP ap = { - s = \\agr => ap.s ! False ! NCase (complNumAgr agr) ResFin.Part - } ; - ----- copied from VerbFin.CompAP, should be shared - ICompAP ap = { - s = \\agr => - let - n = complNumAgr agr ; - c = case n of { - Sg => Nom ; -- minä olen iso ; te olette iso - Pl => ResFin.Part -- me olemme isoja ; te olette isoja - } --- definiteness of NP ? - in "kuinka" ++ ap.s ! False ! (NCase n c) - } ; - - IAdvAdv adv = {s = "kuinka" ++ adv.s} ; - - ProDrop p = { - s = table {NPCase (Nom) => [] ; c => p.s ! c} ; - ---- drop Gen only works in adjectival position: "autoni", but not in "ø täytyy mennä" - a = p.a ; - hasPoss = p.hasPoss ; - } ; - - ProDropPoss p = { - s1 = \\_,_ => [] ; - sp = \\_,_ => p.s ! NPCase Gen ; - s2 = table {Front => BIND ++ possSuffixFront p.a ; - Back => BIND ++ possSuffix p.a } ; - isNum = False ; - isPoss = True ; - isDef = True ; --- "minun kolme autoani ovat" ; thus "...on" is missing - isNeg = False - } ; - - lincat - ClPlus, ClPlusObj, ClPlusAdv = ClausePlus ; - Part = {s : Bool => Str} ; - - lin - S_SVO part t p clp = - let - cl = clp.s ! t.t ! t.a ! p.p ; - pa = part.s ! True ---- - in - {s = t.s ++ p.s ++ cl.subj ++ pa ++ cl.fin ++ cl.inf ++ cl.compl ++ cl.adv ++ cl.ext} ; - S_OSV part t p clp = - let - cl = clp.s ! t.t ! t.a ! p.p ; - pa = part.s ! True ---- - in - {s = t.s ++ p.s ++ cl.compl ++ pa ++ cl.subj ++ cl.fin ++ cl.inf ++ cl.adv ++ cl.ext} ; - S_VSO part t p clp = - let - cl = clp.s ! t.t ! t.a ! p.p ; - pa = part.s ! cl.qp - in - {s = t.s ++ p.s ++ cl.fin ++ pa ++ cl.subj ++ cl.inf ++ cl.compl ++ cl.adv ++ cl.ext} ; - S_ASV part t p clp = - let - cl = clp.s ! t.t ! t.a ! p.p ; - pa = part.s ! cl.qp - in - {s = t.s ++ p.s ++ cl.adv ++ pa ++ cl.subj ++ cl.fin ++ cl.inf ++ cl.compl ++ cl.ext} ; - - S_OVS part t p clp = - let - cl = clp.s ! t.t ! t.a ! p.p ; - pa = part.s ! True ---- - in - {s = t.s ++ p.s ++ cl.compl ++ pa ++ cl.fin ++ cl.inf ++ cl.subj ++ cl.adv ++ cl.ext} ; - - PredClPlus np vp = mkClausePlus (subjForm np vp.sc) np.a vp ; - PredClPlusFocSubj np vp = insertKinClausePlus 0 (mkClausePlus (subjForm np vp.sc) np.a vp) ; - PredClPlusFocVerb np vp = insertKinClausePlus 1 (mkClausePlus (subjForm np vp.sc) np.a vp) ; - PredClPlusObj np vps obj = - insertObjClausePlus 0 False (\\b => appCompl True b vps.c2 obj) (mkClausePlus (subjForm np vps.sc) np.a vps) ; - PredClPlusFocObj np vps obj = - insertObjClausePlus 0 True (\\b => appCompl True b vps.c2 obj) (mkClausePlus (subjForm np vps.sc) np.a vps) ; - PredClPlusAdv np vp adv = - insertObjClausePlus 1 False (\\_ => adv.s) (mkClausePlus (subjForm np vp.sc) np.a vp) ; - PredClPlusFocAdv np vp adv = - insertObjClausePlus 1 True (\\_ => adv.s) (mkClausePlus (subjForm np vp.sc) np.a vp) ; - - ClPlusWithObj c = c ; - ClPlusWithAdv c = c ; - - noPart = {s = \\_ => []} ; - han_Part = mkPart "han" "hän" ; - pa_Part = mkPart "pa" "pä" ; - pas_Part = mkPart "pas" "päs" ; - ko_Part = mkPart "ko" "kö" ; - kos_Part = mkPart "kos" "kös" ; - kohan_Part = mkPart "kohan" "köhän" ; - pahan_Part = mkPart "pahan" "pähän" ; - -} diff --git a/lib/src/finnish/stemmed/LangFin.gf b/lib/src/finnish/stemmed/LangFin.gf deleted file mode 100644 index 5f1e7d1e9..000000000 --- a/lib/src/finnish/stemmed/LangFin.gf +++ /dev/null @@ -1,11 +0,0 @@ ---# -path=.:..:../../abstract:../../common - -concrete LangFin of Lang = --- GrammarFin - [SlashV2VNP,SlashVV], ---- to speed up compilation - GrammarFin, - LexiconFin - ** { - -flags startcat = Phr ; unlexer = text ; lexer = finnish ; - -} ; diff --git a/lib/src/finnish/stemmed/LexiconFin.gf b/lib/src/finnish/stemmed/LexiconFin.gf deleted file mode 100644 index aab8d8b6c..000000000 --- a/lib/src/finnish/stemmed/LexiconFin.gf +++ /dev/null @@ -1,388 +0,0 @@ ---# -path=.:prelude - -concrete LexiconFin of Lexicon = CatFin ** open MorphoFin, StemFin, ParadigmsFin in { - -flags - optimize=values ; - - -lin - airplane_N = mkN "lentokone" ; - answer_V2S = mkV2 (mkV "vastata") (casePrep allative) ; - apartment_N = mkN "asunto" ; - apple_N = mkN "omena" ; --- omenia, not omenoita - art_N = mkN "taide" ; - ask_V2Q = mkV2 (mkV "kysyä") (casePrep ablative) ; - baby_N = mkN "vauva" ; - bad_A = mkA (mkN "paha") "pahempi" "pahin" ; - bank_N = mkN "pankki" ; - beautiful_A = mkA (mkN "kaunis") "kauniimpi" "kaunein" ; - become_VA = mkVA (mkV "tulla") (casePrep translative) ; - beer_N = mkN "olut" "oluita" ; - beg_V2V = mkV2V (mk2V "pyytää" "pyysi") (casePrep partitive) ; - big_A = mkA (mkN "suuri" "suuria") "suurempi" "suurin" ; - bike_N = mkN "polku" (mkN "pyörä") ; - bird_N = mkN "lintu" ; - black_A = mkA (mkN "musta") "mustempi" "mustin" ; - blue_A = mkA (mkN "sininen") "sinisempi" "sinisin" ; - boat_N = mkN "vene" ; - book_N = mkN "kirja" ; - boot_N = mkN "saapas" ; - boss_N = mkN "pomo" ; - boy_N = mkN "poika" "pojan" "poikia" ; - bread_N = mkN "leipä" ; - break_V2 = mkV2 (mkV "rikkoa") ; - broad_A = mkA (mkN "leveä") "leveämpi" "levein" ; - brother_N2 = mkN2 ( - mkN "veli" "veljen" "veljenä" "veljeä" "veljeen" - "veljinä" "veljissä" "veljien" "veljiä" "veljiin") ; - brown_A = mkA (mkN "ruskea") "ruskeampi" "ruskein" ; - butter_N = mk3N "voi" "voin" "voita" ; ---- errors in Part - buy_V2 = mkV2 (mkV "ostaa") ; - camera_N = mkN "kamera" ; - cap_N = mkN "lakki" ; - car_N = mkN "auto" "auton" "autoja" ; -- mkN: audon - carpet_N = mkN "matto" ; - cat_N = mkN "kissa" ; - ceiling_N = mkN "katto" ; - chair_N = mkN "tuoli" ; - cheese_N = mkN "juusto" ; - child_N = mkN "lapsi" "lapsen" "lasta" "lapsena" "lapseen" - "lasten" "lapsia" "lapsina" "lapsissa" "lapsiin" ; - church_N = mkN "kirkko" ; - city_N = mkN "kaupunki" ; - clean_A = mkA (mkN "puhdas") ; - clever_A = mkA (mkN "viisas") ; - close_V2 = mkV2 (mkV "sulkea") ; - coat_N = mkN "takki" ; - cold_A = mkA (mkN "kylmä") "kylmempi" "kylmin" ; - come_V = mkV "tulla" ; - computer_N = mkN "tietokone" ; - country_N = mkN "maa" ; - cousin_N = mkN "serkku" ; - cow_N = mkN "lehmä" ; - die_V = mkV "kuolla" ; - dirty_A = mkA (mkN "likainen") "likaisempi" "likaisin" ; - distance_N3 = mkN3 (mkN "etäisyys") (casePrep elative) (casePrep illative) ; - doctor_N = mk2N "tohtori" "tohtoreita" ; - dog_N = mkN "koira" ; - door_N = mkN "ovi" "ovia" ; - drink_V2 = mkV2 (mkV "juoda") (casePrep partitive) ; - easy_A2V = mkA2 (mkA (mkN "helppo") "helpompi" "helpoin") - (casePrep allative) ; - eat_V2 = mkV2 (mkV "syödä") (casePrep partitive) ; - empty_A = mkA (mkN "tyhjä") "tyhjempi" "tyhjin" ; - enemy_N = mkN "vihollinen" ; - factory_N = mkN "tehdas" ; - father_N2 = mkN2 (mkN "isä") ; - fear_VS = mkVS (mk2V "pelätä" "pelkäsi") ; - find_V2 = mkV2 (mk2V "löytää" "löysi") ; - fish_N = mkN "kala" ; - floor_N = mk2N "lattia" "lattioita" ; - forget_V2 = mkV2 (mkV "unohtaa") ; - fridge_N = mkN "jääkaappi" ; - friend_N = mkN "ystävä" ; - fruit_N = mkN "hedelmä" ; - fun_AV = mkAV (mkA (mkN "hauska") "hauskempi" "hauskin") ; - garden_N = mkN "puutarha" "puutarhan" "puutarhoja" ; - girl_N = mkN "tyttö" ; - glove_N = mkN "käsine" ; - gold_N = mkN "kulta" ; - good_A = mkA (mkN "hyvä") "parempi" "parhain" ; --- paras - go_V = mkV "mennä" ; - green_A = mkA (mkN "vihreä") "vihreämpi" "vihrein" ; - harbour_N = mkN "satama" "sataman" "satamia" ; - hate_V2 = mkV2 (mkV "vihata") cpartitive ; - hat_N = mkN "hattu" ; - hear_V2 = mkV2 (mkV "kuulla") ; - hill_N = mkN "kukkula" ; - hope_VS = mkVS (mkV "toivoa") ; - horse_N = mkN "hevonen" ; - hot_A = mkA (mkN "kuuma") "kuumempi" "kuumin" ; - house_N = mkN "talo" ; - important_A = mkA (mkN "tärkeä") "tärkeämpi" "tärkein" ; - industry_N = mkN "teollisuus" ; - iron_N = mkN "rauta" ; - king_N = mkN "kuningas" ; - know_VS = mkVS (mkV "tietää" "tiesi") ; - know_VQ = mkVQ (mkV "tietää" "tiesi") ; - know_V2 = mkV2 (mkV "tuntea" "tunsi") ; - lake_N = mkN "järvi" "järviä" ; - lamp_N = mkN "lamppu" ; - learn_V2 = - mkV2 (mk12V "oppia" "opin" "oppii" "oppivat" "oppikaa" "opitaan" - "opin" "oppi" "oppisi" "oppinut" "opittu" "opitun") ; - leather_N = mkN "nahka" ; --- nahan - leave_V2 = mkV2 (mkV "jättää") ; - like_V2 = mkV2 (mkV "pitää") elative ; - listen_V2 = mkV2 (mkV "kuunnella" "kuunteli") partitive ; - live_V = mkV "elää" ; - long_A = mkA (mkN "pitkä") "pitempi" "pisin" ; - lose_V2 = mkV2 (mkV "hävitä" "hävisi") ; --- hukata - love_N = mk3N "rakkaus" "rakkauden" "rakkauksia" ; - love_V2 = mkV2 (mkV "rakastaa") partitive ; - man_N = mkN "mies" "miehen" "miestä" "miehenä" "mieheen" - "miesten" "miehiä" "miehinä" "miehissä" "miehiin" ; - married_A2 = mkA2 (mkA "avioitunut") (postPrep genitive "kanssa") ; ---- infl - meat_N = mkN "liha" ; - milk_N = mkN "maito" ; - moon_N = mkN "kuu" ; - mother_N2 = mkN2 (mkN "äiti") ; - mountain_N = mkN "vuori" "vuoria" ; - music_N = mkN "musiikki" ; - narrow_A = mkA (mkN "kapea") "kapeampi" "kapein" ; - new_A = mkA (mk3N "uusi" "uuden" "uusia") "uudempi" "uusin" ; - newspaper_N = mkN "sanoma" (mkN "lehti" "lehtiä") ; --- for correct vowel harmony - oil_N = mkN "öljy" ; - old_A = mkA (mkN "vanha") "vanhempi" "vanhin" ; - open_V2 = mkV2 (mkV "avata" "avasi") ; - paint_V2A = mkV2A (mkV "maalata") accPrep (casePrep translative) ; - paper_N = mk2N "paperi" "papereita" ; - paris_PN = mkPN (mkN "Pariisi") ; - peace_N = mkN "rauha" ; - pen_N = mkN "kynä" ; - planet_N = mkN "planeetta" ; - plastic_N = mkN "muovi" ; - play_V2 = mkV2 (mkV "pelata") cpartitive ; --- leikkiä, soittaa - policeman_N = mkN "poliisi" ; - priest_N = mkN "pappi" ; - probable_AS = mkAS --- for vowel harmony - (mkA (mkN "todennäköinen") "tonennäköisempi" "todennäköisin") ; ---- sta - queen_N = mkN "kuningatar" ; - radio_N = mk2N "radio" "radioita" ; - rain_V0 = mkV0 (mk2V "sataa" "satoi") ; - read_V2 = mkV2 (mkV "lukea") ; - red_A = mkA "punainen" ; - religion_N = mkN "uskonto" ; - restaurant_N = mkN "ravintola" ; - river_N = mkN "joki" "jokia" ; - rock_N = mk2N "kallio" "kallioita" ; - roof_N = mkN "katto" ; - rubber_N = mkN "kumi" ; - run_V = mk2V "juosta" "juoksi" ; - say_VS = mkVS (mkV "sanoa") ; - school_N = mkN "koulu" ; - science_N = mkN "tiede" ; - sea_N = mkN "meri" "meren" "meriä" "merta" ; - seek_V2 = mkV2 (mkV "etsiä") cpartitive ; - see_V2 = mkV2 ( - mk12V "nähdä" "näen" "näkee" "näkevät" "nähkää" "nähdään" - "näin" "näki" "näkisi" "nähnyt" "nähty" "nähdyn") ; - sell_V3 = mkV3 (mkV "myydä") accPrep (casePrep allative) ; - send_V3 = mkV3 (mkV "lähettää") accPrep (casePrep allative) ; - sheep_N = mkN "lammas" ; - ship_N = mkN "laiva" ; - shirt_N = mkN "paita" ; - shoe_N = mkN "kenkä" ; - shop_N = mkN "kauppa" ; - short_A = mkA (mkN "lyhyt" "lyhyitä") ; - silver_N = mkN "hopea" ; - sister_N = mkN "sisko" ; - sleep_V = mkV "nukkua" ; - small_A = mkA (mk2N "pieni" "pieniä") "pienempi" "pienin" ; - snake_N = mkN "käärme" ; - sock_N = mkN "sukka" ; - speak_V2 = mkV2 (mkV "puhua") cpartitive ; - star_N = mkN "tähti" "tähtiä" ; - steel_N = mkN "teräs" ; - stone_N = mkN "kivi" "kiviä" ; - stove_N = mk3N "liesi" "lieden" "liesiä" ; - student_N = mk2N "opiskelija" "opiskelijoita" ; - stupid_A = mkA "tyhmä" ; - sun_N = mkN "aurinko" ; - switch8off_V2 = mkV2 (mkV "sammuttaa") ; --- - switch8on_V2 = mkV2 (mkV "sytyttää") ; --- - table_N = mkN "pöytä" ; - talk_V3 = mkV3 (mkV "puhua") (casePrep allative) (casePrep elative) ; - teacher_N = mkN "opettaja" ; - teach_V2 = mkV2 (mkV "opettaa") ; - television_N = mk2N "televisio" "televisioita" ; - thick_A = mkA "paksu" ; - thin_A = mkA (mkN "ohut" "ohuita") ; - train_N = mkN "juna" ; - travel_V = mkV "matkustaa" ; - tree_N = mkN "puu" ; - ---- trousers_N = mkN "trousers" ; - ugly_A = mkA (mkN "ruma") "rumempi" "rumin" ; - understand_V2 = mkV2 (mkV "ymmärtää" "ymmärrän" "ymmärsi") ; - university_N = mkN "yliopisto" ; - village_N = mkN "kylä" ; - wait_V2 = mkV2 (mkV "odottaa") partitive ; - walk_V = mkV "kävellä" "käveli" ; - warm_A = mkA - (mkN "lämmin" "lämpimän" "lämmintä" "lämpimänä" "lämpimään" - "lämpiminä" "lämpimiä" "lämpimien" "lämpimissä" "lämpimiin" - ) - "lämpimämpi" "lämpimin" ; - war_N = mkN "sota" ; - watch_V2 = mkV2 (mkV "katsella") cpartitive ; - water_N = mk3N "vesi" "veden" "vesiä" ; - white_A = mkA "valkoinen" ; - window_N = mk2N "ikkuna" "ikkunoita" ; - wine_N = mkN "viini" ; - win_V2 = mkV2 (mkV "voittaa") ; - woman_N = mkN "nainen" ; - wonder_VQ = mkVQ (mkV "ihmetellä") ; - wood_N = mkN "puu" ; - write_V2 = mkV2 (mkV "kirjoittaa") ; - yellow_A = mkA "keltainen" ; - young_A = mkA (mkN "nuori" "nuoria") "nuorempi" "nuorin" ; - - do_V2 = mkV2 ( - mkV "tehdä" "teen" "tekee" "tekevät" "tehkää" "tehdään" - "tein" "teki" "tekisi" "tehnyt" "tehty" "tehdyn") ; - - now_Adv = mkAdv "nyt" ; - already_Adv = mkAdv "jo" ; - song_N = mkN "laulu" ; - add_V3 = mkV3 (mkV "lisätä") accPrep (casePrep illative) ; - number_N = mk2N "numero" "numeroita" ; - put_V2 = mkV2 (mkV "panna") ; - stop_V = mkV "pysähtyä" ; - jump_V = mkV "hypätä" ; - left_Ord = mkOrd (snoun2nounBind (mkN "vasen")) ; - right_Ord = mkOrd (snoun2nounBind (mkN "oikea")) ; - far_Adv = mkAdv "kaukana" ; - correct_A = mkA "oikea" ; - dry_A = mkA (mkN "kuiva") "kuivempi" "kuivin" ; - dull_A = mkA (mkN "tylsä") "tylsempi" "tylsin" ; - full_A = mkA (mk3N "täysi" "täyden" "täysiä") "täydempi" "täysin" ; - heavy_A = mkA "raskas" ; - near_A = mkA (mkN "läheinen") "läheisempi" "lähin" ; - rotten_A = mkA "mätä" ; - round_A = mkA "pyöreä" ; - sharp_A = mkA "terävä" ; - smooth_A = mkA "sileä" ; - straight_A = mkA (mkN "suora") "suorempi" "suorin" ; - wet_A = mkA (mkN "märkä") "märempi" "märin" ; - wide_A = mkA "leveä" ; - animal_N = mk3N "eläin" "eläimen" "eläimiä" ; - ashes_N = mkN "tuhka" ; - back_N = mkN "selkä" ; - bark_N = mkN "kaarna" ; - belly_N = mkN "vatsa" ; - blood_N = mkN "veri" "veren" "veriä" "verta" ; - bone_N = mkN "luu" ; - breast_N = mkN "rinta" ; - cloud_N = mk2N "pilvi" "pilviä" ; - day_N = mkN "päivä" ; - dust_N = mkN "pöly" ; - ear_N = mkN "korva" ; - earth_N = mkN "maa" ; - egg_N = mkN "muna" ; - eye_N = mkN "silmä" ; - fat_N = mkN "rasva" ; - feather_N = mk3N "höyhen" "höyhenen" "höyheniä" ; - fingernail_N = mk3N "kynsi" "kynnen" "kynsiä" ; - fire_N = mk2N "tuli" "tulia" ; - flower_N = mkN "kukka" ; - fog_N = mkN "sumu" ; - foot_N = mkN "jalka" ; - forest_N = mkN "metsä" ; - grass_N = mkN "ruoho" ; - guts_N = mkN "sisälmys" ; --- suoli - hair_N = mkN "hius" ; - hand_N = mk3N "käsi" "käden" "käsiä" ; - head_N = mkN "pää" ; - heart_N = mkN "sydän" "sydämen" "sydäntä" "sydämenä" "sydämeen" - "sydänten" "sydämiä" "sydäminä" "sydämissä" "sydämiin" ; - horn_N = mk2N "sarvi" "sarvia" ; - husband_N = mkN "mies" "miehen" "miestä" "miehenä" "mieheen" - "miesten" "miehiä" "miehinä" "miehissä" "miehiin" ; - ice_N = mkN "jää" ; - knee_N = mk2N "polvi" "polvia" ; - leaf_N = mk2N "lehti" "lehtiä" ; - leg_N = mkN "jalka" ; --- sääri - liver_N = mkN "maksa" ; - louse_N = mkN "lude" ; - mouth_N = mkN "suu" ; - name_N = mk2N "nimi" "nimiä" ; - neck_N = mkN "niska" ; - night_N = mkN "yö" ; - nose_N = mkN "nenä" ; - person_N = mkN "henkilö" ; - rain_N = mkN "sade" ; - road_N = mkN "tie" ; - root_N = mk2N "juuri" "juuria" ; - rope_N = mk3N "köysi" "köyden" "köysiä" ; - salt_N = mkN "suola" ; - sand_N = mkN "hiekka" ; - seed_N = mkN "siemen" ; - skin_N = mkN "nahka" ; - sky_N = mk3N "taivas" "taivaan" "taivaita" ; - smoke_N = mkN "savu" ; - snow_N = mkN "lumi" "lumen" "lumia" "lunta" ; - stick_N = mkN "keppi" ; - tail_N = mkN "häntä" ; - tongue_N = mk2N "kieli" "kieliä" ; - tooth_N = mkN "hammas" ; - wife_N = mkN "vaimo" ; - wind_N = mk2N "tuuli" "tuulia" ; - wing_N = mk2N "siipi" "siipiä" ; - worm_N = mkN "mato" ; - year_N = mk3N "vuosi" "vuoden" "vuosia" ; - bite_V2 = mkV2 (mkV "purra") ; - blow_V = mkV "puhaltaa" ; - burn_V = mkV "palaa" ; - count_V2 = mkV2 (mkV "laskea") ; - cut_V2 = mkV2 (mk2V "leikata" "leikkasi") ; - dig_V = mkV "kaivaa" ; - fall_V = mkV "pudota" "putoan" "putosi" ; - fear_V2 = mkV2 (mkV "pelätä" "pelkään" "pelkäsi") cpartitive ; - fight_V2 = mkV2 (mkV "taistella") (postPrep partitive "vastaan") ; - float_V = mkV "kellua" ; - flow_V = mkV "virrata" "virtaan" "virtasi" ; - fly_V = mkV "lentää" ; - freeze_V = mkV "jäätyä" ; - give_V3 = mkV3 (mkV "antaa" "annan" "antoi") accPrep (casePrep allative) ; - hit_V2 = mkV2 (mkV "lyödä") cpartitive ; - hold_V2 = mkV2 (mkV "pitää") cpartitive ; - hunt_V2 = mkV2 (mkV "metsästää") cpartitive ; - kill_V2 = mkV2 (mkV "tappaa") ; - laugh_V = mkV "nauraa" "nauroi" ; - lie_V = mkV "maata" "makasi" ; - play_V = mkV "pelata" ; - pull_V2 = mkV2 (mkV "vetää") ; - push_V2 = mkV2 (mkV "työntää") ; - rub_V2 = mkV2 (mkV "hieroa") cpartitive ; - scratch_V2 = mkV2 (mkV "raapia") cpartitive ; - sew_V = mkV "ommella" ; - sing_V = mkV "laulaa" ; - sit_V = mkV "istua" ; - smell_V = mk2V "haista" "haisi" ; - spit_V = mkV "sylkeä" ; - split_V2 = mkV2 (mk2V "halkaista" "halkaisi") ; - squeeze_V2 = mkV2 (mkV "puristaa") cpartitive ; - stab_V2 = mkV2 (mkV "pistää") cpartitive ; - stand_V = mk12V "seistä" "seison" "seisoo" "seisovat" "seiskää" "seistään" - "seisoin" "seisoi" "seisoisi" "seissyt" "seisty" "seistyn" ; --- *seisoivät - suck_V2 = mkV2 (mkV "imeä") cpartitive ; - swell_V = mkV "turvota" "turposi" ; - swim_V = mkV "uida" "uin" "ui" ; - think_V = mkV "ajatella" "ajattelen" "ajatteli" ; - throw_V2 = mkV2 (mkV "heittää") ; - tie_V2 = mkV2 (mkV "sitoa") ; - turn_V = mkV "kääntyä" ; - vomit_V = mkV "oksentaa" ; - wash_V2 = mkV2 (mkV "pestä") ; - wipe_V2 = mkV2 (mkV "pyyhkiä") ; - - breathe_V = mkV "hengittää" ; - - grammar_N = mkN "kielioppi" ; - language_N = mk2N "kieli" "kieliä" ; - rule_N = mkN "sääntö" ; - - john_PN = mkPN "Jussi" ; - question_N = mkN "kysymys" ; - ready_A = mkA (mkN "valmis") ; - reason_N = mkN "syy" ; - today_Adv = mkAdv "tänään" ; - uncertain_A = mkA "epävarma" ; - - oper - mkOrd : Noun -> Ord ; - mkOrd x = {s = x.s ; lock_Ord = <> } ; - cpartitive = casePrep partitive ; - -} ; diff --git a/lib/src/finnish/stemmed/NounFin.gf b/lib/src/finnish/stemmed/NounFin.gf deleted file mode 100644 index 8d09035c7..000000000 --- a/lib/src/finnish/stemmed/NounFin.gf +++ /dev/null @@ -1,265 +0,0 @@ ---# -path=.:..:../../abstract:../../common - -concrete NounFin of Noun = CatFin ** open ResFin, MorphoFin, StemFin, Prelude in { - - flags optimize=all_subs ; - - lin - --- The $Number$ is subtle: "nuo autot", "nuo kolme autoa" are both plural --- for verb agreement, but the noun form is singular in the latter. - - DetCN det cn = - let - n : Number = case det.isNum of { - True => Sg ; - _ => det.n - } ; - ncase : NPForm -> Case * NForm = \c -> - let k = npform2case n c - in - case of { - <_, NPAcc, True,_,_> => ; -- myin kolme kytkintä(ni) - <_, NPCase Nom, True,_,_> => ; -- kolme kytkintä(ni) on - <_, _, True,False,_> => ; -- kolmeksi kytkimeksi - => ; -- myin kytkimiä - <_, NPAcc, _,True,_> => ; -- myin kytkime+ni - <_, NPCase Nom,_,True,_> => ; -- kytkime+ni on/ovat... - <_, NPCase Gen,_,True,_> => ; -- kytkime+ni vika - <_, NPCase Transl,_,True,_> => ; -- kytkim(e|i)kse+ni - <_, NPCase Illat,_,True,_> => ; -- kytkim(ee|ii)+ni - - _ => -- kytkin, kytkimen,... - } - in { - s = \\c => let - k = ncase c ; - in - det.s1 ! k.p1 ++ cn.s ! k.p2 ++ det.s2 ! cn.h ; - a = agrP3 (case of { - => Sg ; -- kolme kytkintä on - _ => det.n - }) ; - isPron = False ; isNeg = det.isNeg - } ; - - DetNP det = - let - n : Number = case det.isNum of { - True => Sg ; - _ => det.n - } ; - in { - s = \\c => let k = npform2case n c in - det.sp ! k ; -- det.s2 is possessive suffix - a = agrP3 (case det.isDef of { - False => Sg ; -- autoja menee; kolme autoa menee - _ => det.n - }) ; - isPron = False ; isNeg = det.isNeg - } ; - - UsePN pn = { - s = snoun2np Sg pn ; ---\\c => (snoun2nounSep pn).s ! NCase Sg (npform2case Sg c) ; - a = agrP3 Sg ; - isPron = False ; isNeg = False - } ; - UsePron p = p ** {isPron = True ; isNeg = False} ; - - PredetNP pred np = { - s = \\c => pred.s ! complNumAgr np.a ! c ++ np.s ! c ; - a = np.a ; - isPron = np.isPron ; -- kaikki minun - ni - isNeg = np.isNeg - } ; - - PPartNP np v2 = { - s = \\c => np.s ! c ++ (sverb2verbSep v2).s ! PastPartPass (AN (NCase (complNumAgr np.a) Ess)) ; - a = np.a ; - isPron = np.isPron ; -- minun täällä - ni - isNeg = np.isNeg - } ; - - AdvNP np adv = { - s = \\c => np.s ! c ++ adv.s ; - a = np.a ; - isPron = np.isPron ; -- minun täällä - ni - isNeg = np.isNeg - } ; - - DetQuantOrd quant num ord = { - s1 = \\c => quant.s1 ! num.n ! c ++ num.s ! Sg ! c ++ ord.s ! NCase num.n c ; - sp = \\c => quant.s1 ! num.n ! c ++ num.s ! Sg ! c ++ ord.s ! NCase num.n c ; - s2 = quant.s2 ; - n = num.n ; - isNum = num.isNum ; - isPoss = quant.isPoss ; - isDef = quant.isDef ; - isNeg = quant.isNeg - } ; - - DetQuant quant num = { - s1 = \\c => quant.s1 ! num.n ! c ++ num.s ! Sg ! c ; - sp = \\c => case num.isNum of { - True => quant.s1 ! num.n ! c ++ num.s ! Sg ! c ; -- 0 kolme with Indef - False => quant.sp ! num.n ! c ++ num.s ! Sg ! c -- yksi 0 - } ; - s2 = quant.s2 ; - n = num.n ; - isNum = num.isNum ; -- case num.n of {Sg => False ; _ => True} ; - isPoss = quant.isPoss ; - isDef = quant.isDef ; isNeg = quant.isNeg - } ; - - PossPron p = { - s1,sp = \\_,_ => p.s ! NPCase Gen ; - s2 = case p.hasPoss of { - True => table {Front => BIND ++ possSuffixFront p.a ; - Back => BIND ++ possSuffix p.a } ; - False => \\_ => [] - } ; - isNum = False ; - isPoss = p.hasPoss ; - isDef = True ; --- "minun kolme autoani ovat" ; thus "...on" is missing - isNeg = False - } ; - - NumSg = {s = \\_,_ => [] ; isNum = False ; n = Sg} ; - NumPl = {s = \\_,_ => [] ; isNum = False ; n = Pl} ; - - NumCard n = n ** {isNum = case n.n of {Sg => False ; _ => True}} ; -- yksi talo/kaksi taloa - - NumDigits numeral = { - s = \\n,c => numeral.s ! NCard (NCase n c) ; - n = numeral.n - } ; - OrdDigits numeral = {s = \\f => numeral.s ! NOrd f} ; - - NumNumeral numeral = { - s = \\n,c => numeral.s ! NCard (NCase n c) ; - n = numeral.n - } ; - OrdNumeral numeral = {s = \\f => numeral.s ! NOrd f} ; - - AdNum adn num = { - s = \\n,c => adn.s ++ num.s ! n ! c ; - n = num.n - } ; - - OrdSuperl a = snoun2nounSep {s = \\nc => a.s ! Superl ! SAN nc ; h = a.h} ; - - DefArt = { - s1 = \\_,_ => [] ; - sp = table {Sg => pronSe.s ; Pl => pronNe.s} ; - s2 = \\_ => [] ; - isNum,isPoss,isNeg = False ; - isDef = True -- autot ovat - } ; - - IndefArt = { - s1 = \\_,_ => [] ; -- Nom is Part in Pl: use isDef in DetCN - sp = \\n,c => - (nhn (mkSubst "ä" "yksi" "yhde" "yhte" "yhtä" "yhteen" "yksi" "yksi" - "yksien" "yksiä" "yksiin")).s ! NCase n c ; - s2 = \\_ => [] ; - isNum,isPoss,isDef,isNeg = False -- autoja on - } ; - - MassNP cn = - let - n : Number = Sg ; - ncase : Case -> NForm = \c -> NCase n c ; - in { - s = \\c => let k = npform2case n c in - cn.s ! ncase k ; - a = agrP3 Sg ; - isPron = False ; isNeg = False - } ; - - UseN n = snoun2nounSep n ; - - UseN2 n = snoun2nounSep n ; - - Use2N3 f = { - s = (snoun2nounSep f).s ; - c2 = f.c2 ; - h = f.h ; - isPre = f.isPre - } ; - Use3N3 f = { - s = (snoun2nounSep f).s ; - c2 = f.c3 ; - h = f.h ; - isPre = f.isPre2 - } ; - - ---- If a possessive suffix is added here it goes after the complements... - - ComplN2 f x = { - s = \\nf => preOrPost f.isPre ((snoun2nounSep f).s ! nf) (appCompl True Pos f.c2 x) ; - h = f.h } ; - ComplN3 f x = { - s = \\nf => preOrPost f.isPre (f.s ! nf) (appCompl True Pos f.c2 x) ; - c2 = f.c3 ; - h = f.h ; - isPre = f.isPre2 - } ; - - AdjCN ap cn = { - s = \\nf => ap.s ! True ! (n2nform nf) ++ cn.s ! nf ; - h = cn.h } ; - - RelCN cn rs = {s = \\nf => cn.s ! nf ++ rs.s ! agrP3 (numN nf) ; - h = cn.h } ; - - RelNP np rs = { - s = \\c => np.s ! c ++ "," ++ rs.s ! np.a ; - a = np.a ; - isPron = np.isPron ; ---- correct ? - isNeg = np.isNeg - } ; - - AdvCN cn ad = {s = \\nf => cn.s ! nf ++ ad.s ; - h = cn.h} ; - - SentCN cn sc = {s = \\nf=> cn.s ! nf ++ sc.s; - h = cn.h } ; - - ApposCN cn np = {s = \\nf=> cn.s ! nf ++ np.s ! NPCase Nom ; - h = cn.h } ; --- luvun x - - PossNP cn np = {s = \\nf => np.s ! NPCase Gen ++ cn.s ! nf ; - h = cn.h - } ; - - PartNP cn np = {s = \\nf => cn.s ! nf ++ np.s ! NPCase Part ; - h = cn.h ---- gives "lasin viiniänsa" ; should be "lasinsa viiniä" - } ; - - - CountNP det np = - let - n : Number = case det.isNum of { - True => Sg ; - _ => det.n - } ; - in { - s = \\c => let k = npform2case n c in - det.sp ! k ++ np.s ! NPCase Elat ; -- cf DetNP above - a = agrP3 (case det.isDef of { - False => Sg ; -- autoja menee; kolme autoa menee - _ => det.n - }) ; - isPron = False ; isNeg = det.isNeg - } ; - - - oper - numN : NForm -> Number = \nf -> case nf of { - NCase n _ => n ; - _ => Sg --- - } ; - - -} diff --git a/lib/src/finnish/stemmed/NumeralFin.gf b/lib/src/finnish/stemmed/NumeralFin.gf deleted file mode 100644 index 7f052c8fb..000000000 --- a/lib/src/finnish/stemmed/NumeralFin.gf +++ /dev/null @@ -1,188 +0,0 @@ -concrete NumeralFin of Numeral = CatFin [Numeral,Digits] ** open Prelude, ParadigmsFin, MorphoFin, StemFin in { - --- Notice: possessive forms are not used. They get wrong, since every --- part is made to agree in them. - -flags optimize = all_subs ; - -lincat - Sub1000000 = {s : CardOrd => Str ; n : MorphoFin.Number} ; - Digit = {s : CardOrd => Str} ; - Sub10, Sub100, Sub1000 = {s : NumPlace => CardOrd => Str ; n : MorphoFin.Number} ; - -lin - num x = x ; - n2 = co - (nhn (mkSubst "a" "kaksi" "kahde" "kahte" "kahta" "kahteen" "kaksi" "kaksi" - "kaksien" "kaksia" "kaksiin")) - (ordN "a" "kahdes") ; --- toinen - n3 = co - (nhn (mkSubst "a" "kolme" "kolme" "kolme" "kolmea" "kolmeen" "kolmi" "kolmi" - "kolmien" "kolmia" "kolmiin")) - (ordN "a" "kolmas") ; - n4 = co (snoun2nounBind (mkN "neljä")) (ordN "ä" "neljäs") ; - n5 = co (snoun2nounBind (mkN "viisi" "viiden" "viisiä")) (ordN "ä" "viides") ; - n6 = co (snoun2nounBind (mkN "kuusi" "kuuden" "kuusia")) (ordN "a" "kuudes") ; - n7 = co - (nhn (mkSubst "ä" "seitsemän" "seitsemä" "seitsemä" "seitsemää" - "seitsemään" "seitsemi" "seitsemi" "seitsemien" "seitsemiä" - "seitsemiin")) - (ordN "ä" "seitsemäs") ; - n8 = co - (nhn (mkSubst "a" "kahdeksan" "kahdeksa" "kahdeksa" "kahdeksaa" - "kahdeksaan" "kahdeksi" "kahdeksi" "kahdeksien" "kahdeksia" - "kahdeksiin")) - (ordN "a" "kahdeksas") ; - n9 = co - (nhn (mkSubst "ä" "yhdeksän" "yhdeksä" "yhdeksä" "yhdeksää" - "yhdeksään" "yhdeksi" "yhdeksi" "yhdeksien" "yhdeksiä" "yhdeksiin")) - (ordN "ä" "yhdeksäs") ; - - pot01 = - {s = table { - NumAttr => \\_ => [] ; - NumIndep => yksi_ensiN.s - } ; - n = Sg - } ; - pot0 d = {n = Pl ; s = \\_ => d.s} ; - pot110 = - {s = \\_ => kymmenenN.s ; - n = Pl - } ; - - pot111 = {n = Pl ; s = \\_,c => yksiN.s ! c ++ BIND ++ "toista"} ; ---- yhdes - pot1to19 d = {n = Pl ; s = \\_,c => d.s ! c ++ BIND ++ "toista"} ; - pot0as1 n = n ; - - pot1 d = {n = Pl ; s = \\_,c => d.s ! c ++ BIND ++ kymmentaN.s ! c} ; - pot1plus d e = { - n = Pl ; - s = \\_,c => d.s ! c ++ BIND ++ kymmentaN.s ! c ++ BIND ++ e.s ! NumIndep ! c - } ; - pot1as2 n = n ; - pot2 d = {n = Pl ; s = \\_,c => d.s ! NumAttr ! c ++ nBIND d.n ++ sataaN.s ! d.n ! c} ; ---- - pot2plus d e = { - n = Pl ; - s = \\_,c => d.s ! NumAttr ! c ++ nBIND d.n ++ sataaN.s ! d.n ! c ++ - BIND ++ e.s ! NumIndep ! c - } ; - pot2as3 n = {n = n.n ; s = n.s ! NumIndep} ; - pot3 d = {n = Pl ; s = \\c => d.s ! NumAttr ! c ++ nBIND d.n ++ tuhattaN.s ! d.n ! c} ; ---- - pot3plus d e = { - n = Pl ; - s = \\c => d.s ! NumAttr ! c ++ nBIND d.n ++ tuhattaN.s ! d.n ! c ++ e.s ! NumIndep ! c - } ; - -oper --- co : (c,o : {s : NForm => Str}) -> {s : CardOrd => Str} = \c,o -> { - co : (c,o : CommonNoun) -> {s : CardOrd => Str} = \c,o -> { - s = table { - NCard nf => c.s ! nf ; - NOrd nf => o.s ! nf - } - } ; - - nBIND : MorphoFin.Number -> Str = \n -> case n of {Sg => [] ; _ => BIND} ; -- no BIND after silent 1 - --- Too much trouble to infer vowel, cf. "kuudes" vs. "viides". - --- ordN : Str -> Str -> {s : NForm => Str} = \a,sadas -> - ordN : Str -> Str -> CommonNoun = \a,sadas -> - let - sada = init sadas - in - snoun2nounBind (mkN - sadas (sada + "nnen") (sada + "tt" + a) (sada + "nten" + a) (sada + "nteen") - (sada + "nsien") (sada + "nsi" + a) (sada + "nsin" + a) - (sada + "nsiss" + a) (sada + "nsiin")) ; - -param - NumPlace = NumIndep | NumAttr ; - -oper - yksiN = co - (nhn (mkSubst "ä" "yksi" "yhde" "yhte" "yhtä" "yhteen" "yksi" "yksi" - "yksien" "yksiä" "yksiin")) - (ordN "ä" "yhdes") ; -- yhdestoista - yksi_ensiN = co - (nhn (mkSubst "ä" "yksi" "yhde" "yhte" "yhtä" "yhteen" "yksi" "yksi" - "yksien" "yksiä" "yksiin")) - (snoun2nounBind (mkN "ensimmäinen")) ; -- ensimmäinen ---- sadasensimmäinentuhannes - kymmenenN = co - (nhn (mkSubst "ä" "kymmenen" "kymmene" "kymmene" "kymmentä" - "kymmeneen" "kymmeni" "kymmeni" "kymmenien" "kymmeniä" "kymmeniin")) - (ordN "ä" "kymmenes") ; - sataN = co - (snoun2nounBind (mkN "sata")) - (ordN "a" "sadas") ; - - tuhatN = co - (snoun2nounBind (mkN "tuhat" "tuhannen" "tuhatta" "ruhantena" "tuhanteen" - "tuhansien" "tuhansia" "tuhansina" "tuhansissa" "tuhansiin")) - (ordN "a" "tuhannes") ; - - kymmentaN = - {s = table { - NCard (NCase Sg Nom) => "kymmentä" ; - k => kymmenenN.s ! k - } - } ; - - sataaN : {s : MorphoFin.Number => CardOrd => Str} = {s = table { - Sg => sataN.s ; - Pl => table { - NCard (NCase Sg Nom) => "sataa" ; - k => sataN.s ! k - } - } - } ; - - tuhattaN = {s = table { - Sg => tuhatN.s ; - Pl => table { - NCard (NCase Sg Nom) => "tuhatta" ; - k => tuhatN.s ! k - } - } - } ; - - - lincat - Dig = TDigit ; - - lin - IDig d = d ; - - IIDig d i = { - s = \\o => d.s ! NCard (NCase Sg Nom) ++ i.s ! o ; - n = Pl - } ; - - D_0 = mkDig "0" ; - D_1 = mk3Dig "1" "1." MorphoFin.Sg ; - D_2 = mkDig "2" ; - D_3 = mkDig "3" ; - D_4 = mkDig "4" ; - D_5 = mkDig "5" ; - D_6 = mkDig "6" ; - D_7 = mkDig "7" ; - D_8 = mkDig "8" ; - D_9 = mkDig "9" ; - - oper - mk2Dig : Str -> Str -> TDigit = \c,o -> mk3Dig c o MorphoFin.Pl ; - mkDig : Str -> TDigit = \c -> mk2Dig c (c + ".") ; - - mk3Dig : Str -> Str -> MorphoFin.Number -> TDigit = \c,o,n -> { - s = table {NCard _ => c ; NOrd _ => o} ; - n = n - } ; - - TDigit = { - n : MorphoFin.Number ; - s : CardOrd => Str - } ; - -} - diff --git a/lib/src/finnish/stemmed/ParadigmsFin.gf b/lib/src/finnish/stemmed/ParadigmsFin.gf deleted file mode 100644 index 26dca5545..000000000 --- a/lib/src/finnish/stemmed/ParadigmsFin.gf +++ /dev/null @@ -1,783 +0,0 @@ ---# -path=.:../abstract:../common:../../prelude - ---1 Finnish Lexical Paradigms --- --- Aarne Ranta 2003--2008 --- --- 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 and $Structural.gf$. --- --- The main difference with $MorphoFin.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: --- there is a polymorphic constructor $mkC$, which takes one or --- a few arguments. In Finnish, one argument is enough in 80-90% of --- cases in average. - -resource ParadigmsFin = open - (Predef=Predef), - Prelude, - MorphoFin, - CatFin, StemFin - in { - - flags optimize=noexpand ; - ---2 Parameters --- --- To abstract over gender, number, and (some) case names, --- we define the following identifiers. The application programmer --- should always use these constants instead of the constructors --- defined in $ResFin$. - -oper - Number : Type ; - - singular : Number ; - plural : Number ; - - Case : Type ; - nominative : Case ; -- e.g. "talo" - genitive : Case ; -- e.g. "talon" - partitive : Case ; -- e.g. "taloa" - essive : Case ; -- e.g. "talona" - translative : Case ; -- e.g. "taloksi" - inessive : Case ; -- e.g. "talossa" - elative : Case ; -- e.g. "talosta" - illative : Case ; -- e.g. "taloon" - adessive : Case ; -- e.g. "talolla" - ablative : Case ; -- e.g. "talolta" - allative : Case ; -- e.g. "talolle" - - infFirst : InfForm ; -- e.g. "tehdä" - infIness : InfForm ; -- e.g. "tekemässä" - infElat : InfForm ; -- e.g. "tekemästä" - infIllat : InfForm ; -- e.g. "tekemään" - infPresPart : InfForm ; -- e.g. "tekevän" - infPresPartAgr : InfForm ; -- e.g. "tekevänsä" - --- The following type is used for defining *rection*, i.e. complements --- of many-place verbs and adjective. A complement can be defined by --- just a case, or a pre/postposition and a case. - - prePrep : Case -> Str -> Prep ; -- preposition, e.g. partitive "ilman" - postPrep : Case -> Str -> Prep ; -- postposition, e.g. genitive "takana" - postGenPrep : Str -> Prep ; -- genitive postposition, e.g. "takana" - casePrep : Case -> Prep ; -- just case, e.g. adessive - - mkPrep = overload { - mkPrep : Case -> Prep - = casePrep ; - mkPrep : Str -> Prep - = postGenPrep ; - mkPrep : Case -> Str -> Prep - = postPrep ; - mkPrep : Str -> Case -> Prep - = \s,c -> prePrep c s ; - } ; - - accusative : Prep - = {c = NPAcc ; s = [] ; isPre = True ; lock_Prep = <>} ; - - NK : Type ; -- Noun from DictFin (Kotus) - AK : Type ; -- Adjective from DictFin (Kotus) - VK : Type ; -- Verb from DictFin (Kotus) - AdvK : Type ; -- Adverb from DictFin (Kotus) - ---2 Nouns - --- The worst case gives ten forms. --- In practice just a couple of forms are needed to define the different --- stems, vowel alternation, and vowel harmony. - -oper - --- The regular noun heuristic takes just one form (singular --- nominative) and analyses it to pick the correct paradigm. --- It does automatic grade alternation, and is hence not usable --- for words like "auto" (whose genitive would become "audon"). --- --- If the one-argument paradigm does not give the correct result, one can try and give --- two or three forms. Most notably, the two-argument variant is used --- for nouns like "kivi - kiviä", which would otherwise become like --- "rivi - rivejä". Three arguments are used e.g. for --- "auto - auton - autoja", which would otherwise become --- "auto - audon". - - mkN : overload { - mkN : (kukko : Str) -> N ; -- predictable nouns, covers 82% - mkN : (savi,savia : Str) -> N ; -- different pl.part - mkN : (vesi,veden,vesiä : Str) -> N ; -- also different sg.gen - mkN : (vesi,veden,vesiä,vettä : Str) -> N ; -- also different sg.part - mkN : (olo,n,a,na,oon,jen,ja,ina,issa,ihin : Str) -> N ; -- worst case, 10 forms - mkN : (pika : Str) -> (juna : N) -> N ; -- compound with invariable prefix - mkN : (oma : N) -> (tunto : N) -> N ; -- compound with inflecting prefix - mkN : NK -> N ; -- noun from DictFin (Kotus) - mkN : V -> N ; -- verbal noun: "tekeminen" - } ; - --- Some nouns are regular except for the singular nominative (e.g. "mies"). - - exceptNomN : N -> Str -> N ; - --- Nouns where the parts are separate (should perhaps be treated as CN) - - separateN = overload { - separateN : Str -> N -> N - = \s,n -> mkN (s + "_") n ; - separateN : N -> N -> N - = \oma, asunto -> lin N {s = \\c => oma.s ! c + "_" + asunto.s ! c ; h = asunto.h} ; - } ; - --- Nouns used as functions need a case, of which the default is --- the genitive. - - mkN2 : overload { - mkN2 : N -> N2 ; -- relational noun with genitive - mkN2 : N -> Prep -> N2 -- relational noun another prep. - } ; - - mkN3 : N -> Prep -> Prep -> N3 ; -- relation with two complements - --- Proper names can be formed by using declensions for nouns. --- The plural forms are filtered away by the compiler. - - mkPN : overload { - mkPN : Str -> PN ; -- predictable noun made into name - mkPN : N -> PN -- any noun made into name - } ; - ---2 Adjectives - --- Non-comparison one-place adjectives are just like nouns. --- The regular adjectives are based on $regN$ in the positive. --- Comparison adjectives have three forms. --- The comparative and the superlative --- are always inflected in the same way, so the nominative of them is actually --- enough (except for the superlative "paras" of "hyvä"). - - mkA : overload { - mkA : Str -> A ; -- regular noun made into adjective - mkA : N -> A ; -- any noun made into adjective - mkA : N -> (kivempi,kivin : Str) -> A ; -- deviating comparison forms - mkA : (hyva,prmpi,pras : N) -> (hyvin,pmmin,prhten : Str) -> A ; -- worst case adj - mkA : AK -> A ; -- adjective from DictFin (Kotus) - } ; - --- Two-place adjectives need a case for the second argument. - - mkA2 = overload { - mkA2 : Str -> A2 -- e.g. "vihainen" (jollekin) - = \s -> mkA s ** {c2 = mkPrep "allative" ; lock_A2 = <>} ; - mkA2 : Str -> Prep -> A2 -- e.g. "jaollinen" (mkPrep adessive) - = \a,p -> mkA a ** {c2 = p ; lock_A2 = <>} ; - mkA2 : A -> Prep -> A2 -- e.g. "jaollinen" (mkPrep adessive) - = \a,p -> a ** {c2 = p ; lock_A2 = <>} ; - } ; - - ---2 Verbs --- --- The grammar does not cover the potential mood and some nominal --- forms. One way to see the coverage is to linearize a verb to --- a table. --- The worst case needs twelve forms, as shown in the following. - - mkV : overload { - mkV : (huutaa : Str) -> V ; -- predictable verbs, covers 90% - mkV : (huutaa,huusi : Str) -> V ; -- deviating past 3sg - mkV : (huutaa,huudan,huusi : Str) -> V ; -- also deviating pres. 1sg - mkV : (huutaa,dan,taa,tavat,takaa,detaan,sin,si,sisi,tanut,dettu,tanee : Str) -> V ; -- worst-case verb - mkV : VK -> V ; -- verb from DictFin (Kotus) - mkV : V -> Str -> V ; -- hakata päälle (particle verb) - mkV : Str -> V -> V ; -- laimin+lyödä (prefixed verb) - } ; - --- All the patterns above have $nominative$ as subject case. --- If another case is wanted, use the following. - - caseV : Case -> V -> V ; -- deviating subj. case, e.g. genitive "täytyä" - --- The verbs "be" is special. - - vOlla : V ; -- the verb "be" - - olla_V : V - = vOlla ; - ---3 Two-place verbs --- --- Two-place verbs need an object case, and can have a pre- or postposition. --- The default is direct (accusative) object. There is also a special case --- with case only. The string-only argument case yields a regular verb with --- accusative object. - - mkV2 : overload { - mkV2 : Str -> V2 ; -- predictable direct transitive - mkV2 : Str -> Case -> V2 ; -- predictable with another case - mkV2 : V -> V2 ; -- direct transitive - mkV2 : V -> Case -> V2 ; -- complement just case - mkV2 : V -> Prep -> V2 ; -- complement pre/postposition - mkV2 : VK -> V2 ; -- direct transitive of Kotus verb - } ; - - ---3 Three-place verbs --- --- Three-place (ditransitive) verbs need two prepositions, of which --- the first one or both can be absent. - - mkV3 = overload { - mkV3 : Str -> V3 - = \s -> dirdirV3 (mkV s) ; - mkV3 : V -> V3 - = \v -> dirdirV3 v ; - mkV3 : V -> Prep -> Prep -> V3 -- e.g. puhua, allative, elative - = \v,p,q -> v ** {c2 = p ; c3 = q ; lock_V3 = <>} ; - } ; - - dirV3 : V -> Case -> V3 ; -- siirtää, (accusative), illative - dirdirV3 : V -> V3 ; -- antaa, (accusative), (allative) - - ---3 Other complement patterns --- --- Verbs and adjectives can take complements such as sentences, --- questions, verb phrases, and adjectives. - -mkVV = overload { - mkVV : Str -> VV -- e.g. "yrittää" (puhua) - = \s -> mkVVf (mkV s) infFirst ; - mkVV : V -> VV -- e.g. "alkaa" (puhua) - = \v -> mkVVf v infFirst ; - mkVV : Str -> InfForm -> VV -- e.g. "ruveta" (puhumaan) - = \s,i -> mkVVf (mkV s) i ; - mkVV : V -> InfForm -> VV -- e.g. "lakata" (puhumasta) - = \v,i -> mkVVf v i ; - } ; - -mkVS = overload { - mkVS : Str -> VS -- e.g. "väittää" - = \s -> lin VS (mk1V s) ; - mkVS : V -> VS -- e.g. "sanoa" - = \v -> lin VS v ; - } ; - - mkV2V = overload { - mkV2V : Str -> V2V - = \s -> mkV2Vf (mkV s) (casePrep partitive) infIllat ; ---- - mkV2V : V -> V2V - = \v -> mkV2Vf v (casePrep partitive) infIllat ; ---- - mkV2V : V -> Prep -> V2V -- e.g. "käskeä" genitive - = \v,p -> mkV2Vf v p infIllat ; - mkV2Vf : V -> Prep -> InfForm -> V2V -- e.g. "kieltää" partitive infElatv - = \v,p,f -> mk2V2 v p ** {vi = f ; lock_V2V = <>} ; - } ; - - mkV0 : V -> V0 ; --% - - mkV2S : V -> Prep -> V2S ; -- e.g. "sanoa" allative - mkVVf : V -> InfForm -> VV ; -- e.g. "ruveta" infIllat - mkV2Vf : V -> Prep -> InfForm -> V2V ; -- e.g. "kieltää" partitive infElat - mkVA : V -> Prep -> VA ; -- e.g. "maistua" ablative - mkV2A : V -> Prep -> Prep -> V2A ; -- e.g. "maalata" accusative translative - mkVQ : V -> VQ ; - mkV2Q : V -> Prep -> V2Q ; -- e.g. "kysyä" ablative - - mkAS : A -> AS ; --% ---- mkA2S : A -> Prep -> A2S ; --% - mkAV : A -> AV ; --% ---- mkA2V : A -> Prep -> A2V ; --% - --- Notice: categories $AS, A2S, AV, A2V$ are just $A$, --- and the second argument is given --- as an adverb. Likewise --- $V0$ is just $V$. - - V0 : Type ; --% - AS, A2S, AV, A2V : Type ; --% - ---2 Structural categories - - mkAdV : Str -> AdV - = \s -> lin AdV (ss s) ; - mkAdA : Str -> AdA - = \s -> lin AdA (ss s) ; - mkAdN : Str -> AdN - = \s -> lin AdN (ss s) ; - mkPConj : Str -> PConj - = \s -> lin PConj (ss s) ; - mkSubj : Str -> Subj - = \s -> lin Subj (ss s) ; - - mkPredet : Str -> Predet -- invariable Predet, such as "vain" - = \s -> lin Predet {s = \\_,_ => s} ; - - mkConj = overload { - mkConj : Str -> Conj - = \y -> {s1 = [] ; s2 = y ; n = Pl ; lock_Conj = <>} ; - mkConj : Str -> Str -> Conj - = \x,y -> {s1 = x ; s2 = y ; n = Pl ; lock_Conj = <>} ; - mkConj : Str -> Str -> Number -> Conj - = \x,y,n -> {s1 = x ; s2 = y ; n = n ; lock_Conj = <>} ; - } ; - - mkDet = overload { - mkDet : Number -> N -> Det - = \nu,noun -> MorphoFin.mkDet nu (snoun2nounBind noun) ; - mkDet : (isNeg : Bool) -> Number -> N -> Det -- use this with True to create a negative determiner - = \isNeg,nu,noun -> MorphoFin.mkDetPol isNeg nu (snoun2nounBind noun) ; - mkDet : (isNeg : Bool) -> Number -> N -> Case -> Det -- paljon + False + partitive, ei yhtään + True + partitive - = \isNeg,nu,noun,_ -> MorphoFin.mkDetPol isNeg nu (snoun2nounBind noun) ; - } ; - ---. --- THE definitions should not bother the user of the API. So they are --- hidden from the document. - - Case = MorphoFin.Case ; - Number = MorphoFin.Number ; - - singular = Sg ; - plural = Pl ; - - nominative = Nom ; - genitive = Gen ; - partitive = Part ; - translative = Transl ; - inessive = Iness ; - essive = Ess ; - elative = Elat ; - illative = Illat ; - adessive = Adess ; - ablative = Ablat ; - allative = Allat ; - - infFirst = Inf1 ; infElat = Inf3Elat ; infIllat = Inf3Illat ; infIness = Inf3Iness ; infPresPart = InfPresPart ; infPresPartAgr = InfPresPartAgr ; - - prePrep : Case -> Str -> Prep = - \c,p -> {c = NPCase c ; s = p ; isPre = True ; lock_Prep = <>} ; - postPrep : Case -> Str -> Prep = - \c,p -> {c = NPCase c ; s = p ; isPre = False ; lock_Prep = <>} ; - postGenPrep p = { - c = NPCase genitive ; s = p ; isPre = False ; lock_Prep = <>} ; - casePrep : Case -> Prep = - \c -> {c = NPCase c ; s = [] ; isPre = True ; lock_Prep = <>} ; - accPrep = {c = NPAcc ; s = [] ; isPre = True ; lock_Prep = <>} ; - - NK = {s : NForms ; lock_NK : {}} ; - AK = {s : NForms ; lock_AK : {}} ; - VK = {s : VForms ; lock_VK : {}} ; - AdvK = {s : Str ; lock_AdvK : {}} ; - - - mkN = overload { - mkN : (talo : Str) -> N = mk1N ; - -- \s -> nforms2snoun (nForms1 s) ; - mkN : (talo,talon : Str) -> N = mk2N ; - -- \s,t -> nforms2snoun (nForms2 s t) ; - mkN : (talo,talon,taloja : Str) -> N = mk3N ; - -- \s,t,u -> nforms2snoun (nForms3 s t u) ; - mkN : (talo,talon,taloja,taloa : Str) -> N = mk4N ; - -- \s,t,u,v -> nforms2snoun (nForms4 s t u v) ; - mkN : - (talo,talon,taloa,talona,taloon,talojen,taloja,taloina,taloissa,taloihin - : Str) -> N = mk10N ; - mkN : (sora : Str) -> (tie : N) -> N = mkStrN ; - mkN : (oma,tunto : N) -> N = mkNN ; - mkN : (sana : NK) -> N = \w -> nforms2snoun w.s ; - mkN : V -> N = \w -> sverb2snoun w ; - } ; - - exceptNomN : N -> Str -> N = \noun,nom -> lin N { - s = table { - 0 => nom ; - f => noun.s ! f - } ; - h = noun.h - } ; - - ----- mk1A : Str -> A = \jalo -> aForms2A (nforms2aforms (nForms1 jalo)) ; ----- mkNA : N -> A = snoun2sadj ; - - mk1N : (talo : Str) -> N = \s -> lin N (nforms2snoun (nForms1 s)) ; - mk2N : (talo,talon : Str) -> N = \s,t -> nforms2snoun (nForms2 s t) ; - mk3N : (talo,talon,taloja : Str) -> N = \s,t,u -> nforms2snoun (nForms3 s t u) ; - mk4N : (talo,talon,taloa,taloja : Str) -> N = \s,t,u,v -> - nforms2snoun (nForms4 s t u v) ; - mk10N : - (talo,talon,taloa,talona,taloon,talojen,taloja,taloina,taloissa,taloihin - : Str) -> N = \a,b,c,d,e,f,g,h,i,j -> - lin N (nforms2snoun (nForms10 a b c d e f g h i j)) ; - - mkStrN : Str -> N -> N = \sora,tie -> { - s = \\c => sora + tie.s ! c ; - h = tie.h ; - lock_N = <> - } ; - mkNN : N -> N -> N = \oma,tunto -> { - s = \\c => oma.s ! c + tunto.s ! c ; - h = tunto.h ; - lock_N = <> - } ; ---- TODO: oma in possessive suffix forms - - nForms1 : Str -> NForms = \ukko -> - let - ukk = init ukko ; - uko = weakGrade ukko ; - ukon = uko + "n" ; - o = case last ukko of {"ä" => "ö" ; "a" => "o"} ; -- only used then - renka = strongGrade (init ukko) ; - rake = strongGrade ukko ; - in - case ukko of { - _ + "nen" => dNainen ukko ; - _ + ("aa" | "ee" | "ii" | "oo" | "uu" | "yy" |"ää"|"öö") => dPuu ukko ; - _ + ("ai" | "ei" | "oi" | "ui" | "yi" | "äi" | "öi") => dPuu ukko ; - _ + ("ie" | "uo" | "yö") => dSuo ukko ; - _ + ("ea" | "eä") => dKorkea ukko ; - _ + "is" => dKaunis ukko ; - _ + ("i" | "u") + "n" => dLiitin ukko (renka + "men") ; - _ + ("ton" | "tön") => dOnneton ukko ; - _ + "e" => dRae ukko (rake + "en") ; - _ + ("ut" | "yt") => dOttanut ukko ; - _ + ("as" | "äs") => dRae ukko (renka + last renka + "n") ; - _ + ("uus" | "yys" | "eus" | "eys") => dLujuus ukko ; - _ + "s" => dJalas ukko ; - --- {- heuristics for 3-syllable nouns ending a/ä - _ + ("a" | "e" | "i" | "o" | "u" | "y" | "ä" | "ö") + ? + - _ + "i" + ? + a@("a" | "ä") => - dSilakka ukko (ukko + "n") (ukk + o + "it" + a) ; -- pesijä - _ + ("a" | "e" | "i" | "o" | "u" | "y" | "ä" | "ö") + ? + _ + - ("a" | "e" | "o" | "u" | "y" | "ä" | "ö") + - ("l" | "r" | "n") + a@("a" | "ä") => - dSilakka ukko (ukko + "n") (ukk + o + "it" + a) ; -- sarana, omena - _ + ("a" | "e" | "i" | "o" | "u" | "y" | "ä" | "ö") + ? + _ + - ("a" | "e" | "i" | "o" | "u" | "y" | "ä" | "ö") + - ("n" | "k" | "s") + "k" + a@("a" | "ä") => - dSilakka ukko (uko + "n") (init uko + o + "it" + a) ; -- silakka - _ + ("a" | "e" | "i" | "o" | "u" | "y" | "ä" | "ö") + ? + _ + - ("a" | "e" | "i" | "o" | "u" | "y" | "ä" | "ö") + - ("n" | "t" | "s") + "t" + a@("a" | "ä") => - dSilakka ukko (uko + "n") (ukk + o + "j" + a) ; -- yhdyntä (but not isäntä) - _ + ("a" | "e" | "i" | "o" | "u") + ? + _ + - ("a" | "e" | "o" | "u") + ? + "a" => - dSilakka ukko (ukko + "n") (ukk + "ia") ; -- asema, johtaja --- -} - _ + "i" +o@("o"|"ö") => dSilakka ukko (ukko+"n") (ukko+"it"+getHarmony o); - _ + "i" + "a" => dSilakka ukko (ukko + "n") (ukk + "oita") ; - _ + "i" + "ä" => dSilakka ukko (ukko + "n") (ukk + "öitä") ; - _ + ("a" | "o" | "u" | "y" | "ä" | "ö") => dUkko ukko ukon ; - _ + "i" => dPaatti ukko ukon ; - _ + ("ar" | "är") => dPiennar ukko (renka + "ren") ; - _ + "e" + ("l" | "n") => dPiennar ukko (ukko + "en") ; - _ => dUnix ukko - } ; - - - nForms2 : (_,_ : Str) -> NForms = \ukko,ukkoja -> - let - ukot = nForms1 ukko ; - ukon = weakGrade ukko + "n" ; - in - case of { - <_, _ + ":" + ? + ("a" | "ä")> => dSDP ukko ; - <_ + "ea", _ + "oita"> => - dSilakka ukko ukon ukkoja ; -- idea, but not korkea - <_ + ("aa" | "ee" | "ii" | "oo" | "uu" | "yy" | "ää" | "öö" | - "ie" | "uo" | "yö" | "ea" | "eä" | - "ia" | "iä" | "io" | "iö"), _ + ("a" | "ä")> => - nForms1 ukko ; --- to protect --- how to get "dioja"? - <_ + ("a" | "ä" | "o" | "ö"), _ + ("a" | "ä")> => - dSilakka ukko ukon ukkoja ; - => - dArpi ukko (init (weakGrade ukko) + "en") ; - <_ + "i", _ + ("eita" | "eitä")> => - dTohtori ukko ; - <_ + ("ut" | "yt"),_ + ("uita" | "yitä")> => dRae ukko (init ukko + "en") ; - <_ + "e", nuk + ("eja" | "ejä")> => - dNukke ukko ukon ; - <_ + "s", _ + "ksi" + ?> => dJalas ukko ; - <_ + ("l" | "n" | "r" | "s"), _ + ("eja" | "ejä")> => dUnix ukko ; - <_, _ + ("a" | "ä")> => ukot ; - _ => - Predef.error - (["last argument should end in a/ä, not"] ++ ukkoja) - } ; - - nForms3 : (_,_,_ : Str) -> NForms = \ukko,ukon,ukkoja -> - let - ukk = init ukko ; - ukot = nForms2 ukko ukkoja ; - in - case of { - <_, _ + ":n"> => dSDP ukko ; - <_ + ("aa" | "ee" | "ii" | "oo" | "uu" | "yy" | "ää" | "öö" | - "ie" | "uo" | "yö" | "ea" | "eä" | - "ia" | "iä" | "io" | "iö" | "ja" | "jä"), _ + "n"> => - ukot ; --- to protect - <_ + ("a" | "o" | "u" | "y" | "ä" | "ö"), _ + "n"> => - dSilakka ukko ukon ukkoja ; -- auto,auton - <_ + "mpi", _ + ("emman" | "emmän")> => dSuurempi ukko ; - <_ + "in", _ + ("imman" | "immän")> => dSuurin ukko ; - => - dRae ukko ukon ; - => - dRae ukko ukon ; - => dRae ukko ukon ; - => dArpi ukko ukon ; - <_ + ("us" | "ys"), _ + "den"> => dLujuus ukko ; - <_, _ + "n"> => ukot ; - _ => - Predef.error (["second argument should end in n, not"] ++ ukon) - } ; - - nForms4 : (_,_,_,_ : Str) -> NForms = \ukko,ukon,ukkoja,ukkoa -> - let - ukot = nForms3 ukko ukon ukkoja ; - in - case of { - <_,_ + "n", _ + ("a" | "ä"), _ + ("a" | "ä")> => - table { - 2 => ukkoa ; - n => ukot ! n - } ; - _ => - Predef.error - (["last arguments should end in n, a/ä, and a/ä, not"] ++ - ukon ++ ukkoja ++ ukkoa) - } ; - - mkN2 = overload { - mkN2 : N -> N2 = \n -> mmkN2 n (casePrep genitive) ; - mkN2 : N -> Prep -> N2 = mmkN2 - } ; - - mmkN2 : N -> Prep -> N2 = \n,c -> n ** {c2 = c ; isPre = mkIsPre c ; lock_N2 = <>} ; - mkN3 = \n,c,e -> n ** {c2 = c ; c3 = e ; - isPre = mkIsPre c ; -- matka Lontoosta Pariisiin - isPre2 = mkIsPre e ; -- Suomen voitto Ruotsista - lock_N3 = <> - } ; - - mkIsPre : Prep -> Bool = \p -> case p.c of { - NPCase Gen => notB p.isPre ; -- Jussin veli (prep is , isPre becomes False) - _ => True -- syyte Jussia vastaan, puhe Jussin puolesta - } ; - - mkPN = overload { - mkPN : Str -> PN = mkPN_1 ; - mkPN : N -> PN = \s -> lin PN s ; - } ; - - mkPN_1 : Str -> PN = \s -> lin PN (mk1N s) ; - --- adjectives - - mkA = overload { - mkA : Str -> A = mkA_1 ; - mkA : N -> A = \n -> noun2adjDeg n ** {lock_A = <>} ; - mkA : N -> (kivempaa,kivinta : Str) -> A = \n -> regAdjective n ; - mkA : (sana : AK) -> A = \w -> noun2adjDeg (nforms2snoun w.s) ; - - mkA : (hyva,parempi,paras : N) -> (hyvin,paremmin,parhaiten : Str) -> A = \h,p,ps,hn,pn,ph -> lin A { - s = table { - Posit => table { - SAN nf => h.s ! nf ; - SAAdv => hn - } ; - Compar => table { - SAN nf => p.s ! nf ; - SAAdv => pn - } ; - Superl => table { - SAN nf => ps.s ! nf ; - SAAdv => ph - } - } ; - h = h.h - } ; - } ; - - mkA_1 : Str -> A = \x -> lin A (noun2adjDeg (mk1N x)) ; - --- auxiliaries - mkAdjective : (_,_,_ : SAdj) -> A = \hyva,parempi,paras -> - {s = table { - Posit => hyva.s ; - Compar => parempi.s ; - Superl => paras.s - } ; - h = hyva.h ; ---- different for parempi, paras - lock_A = <> - } ; - regAdjective : SNoun -> Str -> Str -> A = \kiva, kivempi, kivin -> - mkAdjective - (snoun2sadj kiva) - (snoun2sadjComp False (nforms2snoun (dSuurempi kivempi))) - (snoun2sadjComp False (nforms2snoun (dSuurin kivin))) ; - noun2adjDeg : SNoun -> A = \suuri -> - regAdjective - suuri - (suuri.s ! 1 + "mpi") ---- to check - (suuri.s ! 8 + "n") ; ---- - - - - --- verbs - - mkV = overload { - mkV : (huutaa : Str) -> V = mk1V ; - mkV : (huutaa,huusi : Str) -> V = mk2V ; - mkV : (huutaa,huudan,huusi : Str) -> V = mk3V ; - mkV : ( - huutaa,huudan,huutaa,huutavat,huutakaa,huudetaan, - huusin,huusi,huusisi,huutanut,huudettu,huutanee : Str) -> V = mk12V ; - mkV : (sana : VK) -> V = \w -> vforms2sverb w.s ** {sc = NPCase Nom ; lock_V = <> ; p = []} ; - mkV : V -> Str -> V = \w,p -> {s = w.s ; sc = w.sc ; lock_V = <> ; h = w.h ; p = p} ; - mkV : Str -> V -> V = \s,v -> {s = \\f => s + v.s ! f ; sc = v.sc ; lock_V = <> ; h = v.h ; p = v.p} ; - } ; - - mk1V : Str -> V = \s -> - let vfs = vforms2sverb (vForms1 s) in - vfs ** {sc = NPCase Nom ; lock_V = <> ; p = []} ; - mk2V : (_,_ : Str) -> V = \x,y -> - let vfs = vforms2sverb (vForms2 x y) in vfs ** {sc = NPCase Nom ; lock_V = <> ; p = []} ; - mk3V : (huutaa,huudan,huusi : Str) -> V = \x,_,y -> mk2V x y ; ---- - mk12V : ( - huutaa,huudan,huutaa,huutavat,huutakaa,huudetaan, - huusin,huusi,huusisi,huutanut,huudettu,huutanee : Str) -> V = - \a,b,c,d,e,f,g,h,i,j,k,l -> - vforms2sverb (vForms12 a b c d e f g h i j k l) ** {sc = NPCase Nom ; lock_V = <> ; p = []} ; - - vForms1 : Str -> VForms = \ottaa -> - let - a = last ottaa ; - otta = init ottaa ; - ott = init otta ; - ots = init ott + "s" ; - ota = weakGrade otta ; - otin = init (strongGrade (init ott)) + "elin" ; - ot = init ota ; - in - case ottaa of { - _ + ("e" | "i" | "o" | "u" | "y" | "ö") + ("a" | "ä") => - cHukkua ottaa (ota + "n") ; - _ + ("l" | "n" | "r") + ("taa" | "tää") => - cOttaa ottaa (ota + "n") (ots + "in") (ots + "i") ; - ("" | ?) + ("a" | "e" | "i" | "o" | "u") + ? + _ + - ("a" | "e" | "i" | "o" | "u") + _ + "aa" => - cOttaa ottaa (ota + "n") (ot + "in") (ott + "i") ; - ("" | ?) + ("a" | "e" | "i") + _ + "aa" => - cOttaa ottaa (ota + "n") (ot + "oin") (ott + "oi") ; - _ + ("aa" | "ää") => - cOttaa ottaa (ota + "n") (ot + "in") (ott + "i") ; - _ + ("ella" | "ellä") => - cKuunnella ottaa otin ; - _ + ("osta" | "östä") => - cJuosta ottaa (init ott + "ksen") ; - _ + ("st" | "nn" | "ll" | "rr") + ("a" | "ä") => - cJuosta ottaa (ott + "en") ; - _ + ("ita" | "itä") => - cHarkita ottaa ; - _ + ("eta" | "etä" | "ota" | "ata" | "uta" | "ytä" | "ätä" | "ötä") => - cPudota ottaa (strongGrade ott + "si") ; - _ + ("da" | "dä") => - cJuoda ottaa ; - _ => Predef.error (["expected infinitive, found"] ++ ottaa) - } ; - - vForms2 : (_,_ : Str) -> VForms = \huutaa,huusi -> - let - huuda = weakGrade (init huutaa) ; - huusin = weakGrade huusi + "n" ; - autoin = weakGrade (init huusi) + "in" ; - in - case of { - <_ + ("taa" | "tää"), _ + ("oi" | "öi")> => - cOttaa huutaa (huuda + "n") autoin huusi ; - <_ + ("aa" | "ää"), _ + "i"> => - cOttaa huutaa (huuda + "n") huusin huusi ; - <_ + ("eta" | "etä"), _ + "eni"> => - cValjeta huutaa huusi ; - <_ + ("sta" | "stä"), _ + "si"> => - vForms1 huutaa ; -- pestä, halkaista - <_ + ("ta" | "tä"), _ + "si"> => - cPudota huutaa huusi ; - <_ + ("lla" | "llä"), _ + "li"> => - cKuunnella huutaa huusin ; - _ => vForms1 huutaa - } ; - - - - caseV c v = {s = v.s ; sc = NPCase c ; h = v.h ; lock_V = <> ; p = v.p} ; - - vOlla = { - s = table SVForm ["olla";"ole";"on";"o";"olk";"olla";"oli";"oli";"olisi";"oll";"oltu";"ollu";"liene";"ole"] ; - sc = NPCase Nom ; h = Back ; lock_V = <> ; p = []} ; ---- lieneekö - - mk2V2 : V -> Prep -> V2 = \v,c -> v ** {c2 = c ; lock_V2 = <>} ; - caseV2 : V -> Case -> V2 = \v,c -> mk2V2 v (casePrep c) ; - dirV2 v = mk2V2 v accPrep ; - - mkAdv = overload { - mkAdv : Str -> Adv = \s -> {s = s ; lock_Adv = <>} ; - mkAdv : AdvK -> Adv = \s -> {s = s.s ; lock_Adv = <>} ; - } ; - - mkV2 = overload { - mkV2 : Str -> V2 = \s -> dirV2 (mk1V s) ; - mkV2 : Str -> Case -> V2 = \s -> caseV2 (mk1V s) ; - mkV2 : V -> V2 = dirV2 ; - mkV2 : V -> Case -> V2 = caseV2 ; - mkV2 : V -> Prep -> V2 = mk2V2 ; - mkV2 : VK -> V2 = \w -> dirV2 (vforms2sverb w.s ** {sc = NPCase Nom ; lock_V = <> ; p = []}) ; - } ; - - mk2V2 : V -> Prep -> V2 ; - caseV2 : V -> Case -> V2 ; - dirV2 : V -> V2 ; - - dirV3 v p = v ** {c2 = accPrep ; c3 = casePrep p ; lock_V3 = <>} ; - dirdirV3 v = dirV3 v allative ; - - - mkVVf v f = v ** {vi = f ; lock_VV = <>} ; - mkVQ v = v ** {lock_VQ = <>} ; - - V0 : Type = V ; - AS, A2S, AV : Type = A ; - A2V : Type = A2 ; - - mkV0 v = v ** {lock_V = <>} ; - mkV2Sbare : V -> V2S = \v -> mkV2S v (casePrep allative) ; ---- - - mkV2S v p = mk2V2 v p ** {lock_V2S = <>} ; - mkV2Vbare : V -> V2V = \v -> mkV2Vf v (casePrep partitive) infIllat ; ---- --- mkV2V v p = mkV2Vf v p infIllat ; - mkV2Vf v p f = mk2V2 v p ** {vi = f ; lock_V2V = <>} ; - - mkVAbare : V -> VA = \v -> mkVA v (casePrep partitive) ; ---- - mkVA v p = v ** {c2 = p ; lock_VA = <>} ; - mkV2Abare : V -> V2A = \v -> mkV2A v (casePrep partitive) (casePrep translative) ; - mkV2A v p q = v ** {c2 = p ; c3 = q ; lock_V2A = <>} ; - mkV2Qbare : V -> V2Q = \v -> mkV2Q v (casePrep ablative) ; ---- - mkV2Q v p = mk2V2 v p ** {lock_V2Q = <>} ; - - mkAS v = v ** {lock_A = <>} ; ---- mkA2S v p = mkA2 p ** {lock_A = <>} ; - mkAV v = v ** {lock_A = <>} ; ---- mkA2V v p = mkA2 p ** {lock_A2 = <>} ; - -} ; diff --git a/lib/src/finnish/stemmed/ParseFin.gf b/lib/src/finnish/stemmed/ParseFin.gf index f15e14809..9d0add4d3 100644 --- a/lib/src/finnish/stemmed/ParseFin.gf +++ b/lib/src/finnish/stemmed/ParseFin.gf @@ -66,7 +66,7 @@ oper s2 = vp.s2 ; adv = vp.adv ; ext = vp.ext ; - qp = vp.qp ; + h = vp.h ; isNeg = vp.isNeg ; sc = case vp.c2.c of {NPCase Nom => NPAcc ; c => c} } ; diff --git a/lib/src/finnish/stemmed/SentenceFin.gf b/lib/src/finnish/stemmed/SentenceFin.gf deleted file mode 100644 index a4d46b5b1..000000000 --- a/lib/src/finnish/stemmed/SentenceFin.gf +++ /dev/null @@ -1,69 +0,0 @@ -concrete SentenceFin of Sentence = CatFin ** open Prelude, ResFin, StemFin in { - - flags optimize=all_subs ; - - lin - - PredVP np vp = mkClausePol (orB np.isNeg vp.isNeg) (subjForm np vp.sc) np.a vp ; - - PredSCVP sc vp = mkClause (\_ -> sc.s) (agrP3 Sg) vp ; - - ImpVP vp = { - s = \\pol,agr => - let - verb = vp.s ! VIImper ! Simul ! pol ! agr ; - compl = vp.s2 ! False ! pol ! agr ++ vp.ext --- False = like inf (osta auto) - in - verb.fin ++ verb.inf ++ compl ; - } ; - --- The object case is formed at the use site of $c2$, in $Relative$ and $Question$. - - SlashVP np vp = { - s = \\t,a,p => (mkClause (subjForm np vp.sc) np.a vp).s ! t ! a ! p ! SDecl ; - c2 = vp.c2 - } ; - - AdvSlash slash adv = { - s = \\t,a,b => slash.s ! t ! a ! b ++ adv.s ; - c2 = slash.c2 - } ; - - SlashPrep cl prep = { - s = \\t,a,p => cl.s ! t ! a ! p ! SDecl ; - c2 = prep - } ; - - SlashVS np vs slash = { - s = \\t,a,p => - (mkClause (subjForm np vs.sc) np.a - (insertExtrapos ("että" ++ slash.s) - (predSV vs)) - ).s ! t ! a ! p ! SDecl ; - c2 = slash.c2 - } ; - - - EmbedS s = {s = etta_Conj ++ s.s} ; - EmbedQS qs = {s = qs.s} ; - EmbedVP vp = {s = infVP (NPCase Nom) Pos (agrP3 Sg) vp Inf1} ; --- case,pol,agr,infform - - UseCl t p cl = {s = t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p ! SDecl} ; - UseQCl t p cl = {s = t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p} ; - UseRCl t p cl = { - s = \\r => t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p ! r ; - c = cl.c - } ; - UseSlash t p cl = { - s = t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p ; - c2 = cl.c2 - } ; - - AdvS a s = {s = a.s ++ s.s} ; - ExtAdvS a s = {s = a.s ++ "," ++ s.s} ; - - RelS s r = {s = s.s ++ "," ++ r.s ! agrP3 Sg} ; ---- mikä - - SSubjS a subj b = {s = a.s ++ "," ++ subj.s ++ b.s} ; - -} diff --git a/lib/src/finnish/stemmed/StemFin.gf b/lib/src/finnish/stemmed/StemFin.gf index b58ccc8f9..70a66c94b 100644 --- a/lib/src/finnish/stemmed/StemFin.gf +++ b/lib/src/finnish/stemmed/StemFin.gf @@ -105,6 +105,18 @@ oper harmonyV : Str -> Str -> Harmony -> Str = \u,y,h -> case h of {Back => u ; Front => y} ; + SPN : Type = SNoun ; + + snoun2spn : SNoun -> SPN = \n -> n ; + + exceptNomSNoun : SNoun -> Str -> SNoun = \noun,nom -> { + s = table { + 0 => nom ; + f => noun.s ! f + } ; + h = noun.h + } ; + -- Adjectives --- could be made more compact by pressing comparison forms down to a few @@ -128,6 +140,33 @@ oper h = tuore.h } ; + sAN : SNForm -> SAForm = \n -> SAN n ; + sAAdv : SAForm = SAAdv ; + + sANGen : (SAForm => Str) -> Str = \a -> glue (a ! SAN 1) "n" ; + + mkAdj : (hyva,parempi,paras : SNoun) -> (hyvin,paremmin,parhaiten : Str) -> {s : Degree => SAForm => Str ; h : Harmony} = \h,p,ps,hn,pn,ph -> { + s = table { + Posit => table { + SAN nf => h.s ! nf ; + SAAdv => hn + } ; + Compar => table { + SAN nf => p.s ! nf ; + SAAdv => pn + } ; + Superl => table { + SAN nf => ps.s ! nf ; + SAAdv => ph + } + } ; + h = h.h + } ; + + snoun2compar : SNoun -> Str = \n -> (n.s ! 1 + "mpi") ; ---- to check + snoun2superl : SNoun -> Str = \n -> (n.s ! 8 + "n") ; ---- + + -- verbs @@ -283,8 +322,7 @@ oper } ; predSV : SVerb1 -> VP = \sv -> - predV (sverb2verbSep sv ** {p = sv.p ; sc = sv.sc ; qp = case sv.h of {Back => True ; Front => False}}) ; --- (Verb ** {sc : NPForm ; qp : Bool ; p : Str}) -> VP = \verb -> { + predV (sverb2verbSep sv ** {p = sv.p ; sc = sv.sc ; h = sv.h}) ; -- word formation functions @@ -343,7 +381,8 @@ oper -- for Symbol - defaultStemEnding : SNForm -> Str = \c -> case c of { + addStemEnding : Str -> SPN = \i -> { + s = \\c => i ++ bindColonIfS c ++ case c of { 0 => "" ; 1 => "i" ; 2 => "ia" ; @@ -355,7 +394,10 @@ oper 8 => "i" ; 9 => "ihi" ; 10 => "" - } ; + } ; + h = Back ---- + } ; + bindIfS : SNForm -> Str = \c -> case c of { 0 | 10 => [] ; _ => BIND diff --git a/lib/src/finnish/stemmed/StructuralFin.gf b/lib/src/finnish/stemmed/StructuralFin.gf deleted file mode 100644 index 173fb1f8d..000000000 --- a/lib/src/finnish/stemmed/StructuralFin.gf +++ /dev/null @@ -1,315 +0,0 @@ -concrete StructuralFin of Structural = CatFin ** - open MorphoFin, ParadigmsFin, (X = ConstructX), StemFin, Prelude in { - - flags optimize=all ; - - lin - above_Prep = postGenPrep "yläpuolella" ; - after_Prep = postGenPrep "jälkeen" ; - - all_Predet = {s = \\n,c => - let - kaiket = caseTable n (snoun2nounBind (mkN "kaikki" "kaiken" "kaikkena")) - in - case npform2case n c of { - Nom => "kaikki" ; - k => kaiket ! k - } - } ; - almost_AdA, almost_AdN = ss "melkein" ; - although_Subj = ss "vaikka" ; - always_AdV = ss "aina" ; - and_Conj = {s1 = [] ; s2 = "ja" ; n = Pl} ; - because_Subj = ss "koska" ; - before_Prep = prePrep partitive "ennen" ; - behind_Prep = postGenPrep "takana" ; - between_Prep = postGenPrep "välissä" ; - both7and_DConj = sd2 "sekä" "että" ** {n = Pl} ; - but_PConj = ss "mutta" ; - by8agent_Prep = postGenPrep "toimesta" ; - by8means_Prep = casePrep adessive ; - can8know_VV = mkVV (mkV "osata" "osasi") ; - can_VV = mkVV (mkV "voida" "voi") ; - during_Prep = postGenPrep "aikana" ; - either7or_DConj = sd2 "joko" "tai" ** {n = Sg} ; - everybody_NP = makeNP (snoun2nounBind (mkN "jokainen")) Sg ; - every_Det = MorphoFin.mkDet Sg (snoun2nounBind (mkN "jokainen")) ; - everything_NP = makeNP (((snoun2nounBind (mkN "kaikki" "kaiken" "kaikkena"))) ** - {lock_N = <>}) Sg ; - everywhere_Adv = ss "kaikkialla" ; - few_Det = MorphoFin.mkDet Sg (snoun2nounBind (mkN "harva")) ; ---- first_Ord = {s = \\n,c => (mkN "ensimmäinen").s ! NCase n c} ; - for_Prep = casePrep allative ; - from_Prep = casePrep elative ; - he_Pron = mkPronoun "hän" "hänen" "häntä" "hänenä" "häneen" Sg P3 ; - here_Adv = ss "täällä" ; - here7to_Adv = ss "tänne" ; - here7from_Adv = ss "täältä" ; - how_IAdv = ss "miten" ; - how8much_IAdv = ss "kuinka paljon" ; - how8many_IDet = - {s = \\c => "kuinka" ++ (snoun2nounBind (mkN "moni" "monia")).s ! NCase Sg c ; n = Sg ; isNum = False} ; - if_Subj = ss "jos" ; - in8front_Prep = postGenPrep "edessä" ; - i_Pron = mkPronoun "minä" "minun" "minua" "minuna" "minuun" Sg P1 ; - in_Prep = casePrep inessive ; - it_Pron = { - s = \\c => pronSe.s ! npform2case Sg c ; - a = agrP3 Sg ; - hasPoss = False - } ; - less_CAdv = X.mkCAdv "vähemmän" "kuin" ; - many_Det = MorphoFin.mkDet Sg (snoun2nounBind (mkN "moni" "monia")) ; - more_CAdv = X.mkCAdv "enemmän" "kuin" ; - most_Predet = {s = \\n,c => (nForms2N (dSuurin "useinta")).s ! NCase n (npform2case n c)} ; - much_Det = MorphoFin.mkDet Sg {s = \\_ => "paljon" ; h = Back} ; --Harmony not relevant, it's just a CommonNoun - must_VV = mkVV (caseV genitive (mkV "täytyä")) ; - no_Utt = ss "ei" ; - on_Prep = casePrep adessive ; ---- one_Quant = MorphoFin.mkDet Sg DEPREC - only_Predet = {s = \\_,_ => "vain"} ; - or_Conj = {s1 = [] ; s2 = "tai" ; n = Sg} ; - otherwise_PConj = ss "muuten" ; - part_Prep = casePrep partitive ; - please_Voc = ss ["ole hyvä"] ; --- number - possess_Prep = casePrep genitive ; - quite_Adv = ss "melko" ; - she_Pron = mkPronoun "hän" "hänen" "häntä" "hänenä" "häneen" Sg P3 ; - so_AdA = ss "niin" ; - somebody_NP = { - s = \\c => jokuPron ! Sg ! npform2case Sg c ; - a = agrP3 Sg ; - isPron = False ; isNeg = False - } ; - someSg_Det = heavyDet { - s1 = jokuPron ! Sg ; - s2 = \\_ => [] ; - isNum,isPoss = False ; isDef = True ; isNeg = False ; n = Sg - } ; - somePl_Det = heavyDet { - s1 = jokuPron ! Pl ; - s2 = \\_ => [] ; isNum,isPoss = False ; isNeg = False ; isDef = True ; - n = Pl ; isNeg = False - } ; - something_NP = { - s = \\c => jokinPron ! Sg ! npform2case Sg c ; - a = agrP3 Sg ; - isPron = False ; isNeg = False ; isNeg = False - } ; - somewhere_Adv = ss "jossain" ; - that_Quant = heavyQuant { - s1 = table (MorphoFin.Number) { - Sg => table (MorphoFin.Case) { - c => (mkPronoun "tuo" "tuon" "tuota" "tuona" "tuohon" Sg P3).s ! NPCase c - } ; - Pl => table (MorphoFin.Case) { - c => (mkPronoun "nuo" "noiden" "noita" "noina" "noihin" Sg P3).s ! NPCase c - } - } ; - s2 = \\_ => [] ; isNum,isPoss = False ; isDef = True ; isNeg = False - } ; - that_Subj = ss "että" ; - there_Adv = ss "siellä" ; --- tuolla - there7to_Adv = ss "sinne" ; - there7from_Adv = ss "sieltä" ; - therefore_PConj = ss "siksi" ; - they_Pron = mkPronoun "he" "heidän" "heitä" "heinä" "heihin" Pl P3 ; --- ne - this_Quant = heavyQuant { - s1 = table (MorphoFin.Number) { - Sg => table (MorphoFin.Case) { - c => (mkPronoun "tämä" "tämän" "tätä" "tänä" "tähän" Sg P3).s ! NPCase c - } ; - Pl => table (MorphoFin.Case) { - c => (mkPronoun "nämä" "näiden" "näitä" "näinä" "näihin" Sg P3).s ! NPCase c - } - } ; - s2 = \\_ => [] ; isNum,isPoss = False ; isDef = True ; isNeg = False - } ; - through_Prep = postGenPrep "kautta" ; - too_AdA = ss "liian" ; - to_Prep = casePrep illative ; --- allative - under_Prep = postGenPrep "alla" ; - very_AdA = ss "erittäin" ; - want_VV = mkVV (mkV "tahtoa") ; - we_Pron = mkPronoun "me" "meidän" "meitä" "meinä" "meihin" Pl P1 ; - whatPl_IP = { - s = table {NPAcc => "mitkä" ; c => mikaInt ! Pl ! npform2case Pl c} ; - n = Pl - } ; - whatSg_IP = { - s = \\c => mikaInt ! Sg ! npform2case Sg c ; - n = Sg - } ; - when_IAdv = ss "milloin" ; - when_Subj = ss "kun" ; - where_IAdv = ss "missä" ; - which_IQuant = { - s = mikaInt - } ; - whoSg_IP = { - s = table {NPAcc => "kenet" ; c => kukaInt ! Sg ! npform2case Sg c} ; - n = Sg - } ; - whoPl_IP = { - s = table {NPAcc => "ketkä" ; c => kukaInt ! Pl ! npform2case Pl c} ; - n = Pl - } ; - why_IAdv = ss "miksi" ; - without_Prep = prePrep partitive "ilman" ; - with_Prep = postGenPrep "kanssa" ; - yes_Utt = ss "kyllä" ; - youSg_Pron = mkPronoun "sinä" "sinun" "sinua" "sinuna" "sinuun" Sg P2 ; - youPl_Pron = mkPronoun "te" "teidän" "teitä" "teinä" "teihin" Pl P2 ; - youPol_Pron = - let p = mkPronoun "te" "teidän" "teitä" "teinä" "teihin" Pl P2 in - {s = p.s ; a = AgPol ; hasPoss = True} ; - -oper - jokuPron : MorphoFin.Number => (MorphoFin.Case) => Str = - let - kui = snoun2nounBind (mkN "kuu") - in - table { - Sg => table { - Nom => "joku" ; - Gen => "jonkun" ; - c => relPron ! Sg ! c + "ku" + Predef.drop 3 (kui.s ! NCase Sg c) - } ; - Pl => table { - Nom => "jotkut" ; - c => relPron ! Pl ! c + kui.s ! NCase Pl c - } - } ; - - jokinPron : MorphoFin.Number => (MorphoFin.Case) => Str = - table { - Sg => table { - Nom => "jokin" ; - Gen => "jonkin" ; - c => relPron ! Sg ! c + "kin" - } ; - Pl => table { - Nom => "jotkin" ; - c => relPron ! Pl ! c + "kin" - } - } ; - - mikaInt : MorphoFin.Number => (MorphoFin.Case) => Str = - let { - mi = snoun2nounBind (mkN "mi") - } in - table { - Sg => table { - Nom => "mikä" ; - Gen => "minkä" ; - Part => "mitä" ; - Illat => "mihin" ; - c => mi.s ! NCase Sg c - } ; - Pl => table { - Nom => "mitkä" ; - Gen => "minkä" ; - Part => "mitä" ; - Illat => "mihin" ; - c => mi.s ! NCase Sg c - } - } ; - - kukaInt : MorphoFin.Number => (MorphoFin.Case) => Str = - let - kuka = snoun2nounBind (mkN "kuka" "kenen" "ketä" "kenä" "keneen" - "keiden" "keitä" "keinä" "keissä" "keihin") ; - in - table { - Sg => table { - c => kuka.s ! NCase Sg c - } ; - Pl => table { - Nom => "ketkä" ; - c => kuka.s ! NCase Pl c - } - } ; - mikaanPron : MorphoFin.Number => (MorphoFin.Case) => Str = \\n,c => - case of { - => "mikään" ; - <_,Part> => "mitään" ; - => "minkään" ; - => "mitkään" ; - => "mittenkään" ; - <_,Ess> => "minään" ; - <_,Iness> => "missään" ; - <_,Elat> => "mistään" ; - <_,Adess> => "millään" ; - <_,Ablat> => "miltään" ; - _ => mikaInt ! n ! c + "kään" - } ; - - kukaanPron : MorphoFin.Number => (MorphoFin.Case) => Str = - table { - Sg => table { - Nom => "kukaan" ; - Part => "ketään" ; - Ess => "kenään" ; - Iness => "kessään" ; - Elat => "kestään" ; - Illat => "kehenkään" ; - Adess => "kellään" ; - Ablat => "keltään" ; - c => kukaInt ! Sg ! c + "kään" - } ; - Pl => table { - Nom => "ketkään" ; - Part => "keitään" ; - Ess => "keinään" ; - Iness => "keissään" ; - Elat => "keistään" ; - Adess => "keillään" ; - Ablat => "keiltään" ; - c => kukaInt ! Pl ! c + "kään" - } - } ; - - -oper - makeNP : N -> MorphoFin.Number -> CatFin.NP ; - makeNP noun num = { - s = \\c => noun.s ! NCase num (npform2case num c) ; - a = agrP3 num ; - isPron, isNeg = False ; - lock_NP = <> - } ; - -lin - not_Predet = {s = \\_,_ => "ei"} ; - - no_Quant = heavyQuant { - s1 = \\n,c => mikaanPron ! n ! c ; -- requires negative or question polarity - s2 = \\_ => [] ; isNum,isPoss = False ; isDef = True ; isNeg = True - } ; - - if_then_Conj = {s1 = "jos" ; s2 = "niin" ; n = Sg} ; - nobody_NP = { - s = \\c => kukaanPron ! Sg ! npform2case Sg c ; -- requires negative or question polarity - a = agrP3 Sg ; - isPron = False ; isNeg = True - } ; - - nothing_NP = { - s = \\c => mikaanPron ! Sg ! npform2case Sg c ; --- requires negative or question polarity - a = agrP3 Sg ; - isPron = False ; isNeg = True - } ; - - at_least_AdN = ss "vähintään" ; - at_most_AdN = ss "enintään" ; - - as_CAdv = X.mkCAdv "yhtä" "kuin" ; - - except_Prep = postPrep partitive "lukuunottamatta" ; - - have_V2 = mkV2 (caseV adessive vOlla) ; - - lin language_title_Utt = ss "suomi" ; - -} - diff --git a/lib/src/finnish/stemmed/SymbolFin.gf b/lib/src/finnish/stemmed/SymbolFin.gf deleted file mode 100644 index 09e426c5c..000000000 --- a/lib/src/finnish/stemmed/SymbolFin.gf +++ /dev/null @@ -1,44 +0,0 @@ ---# -path=.:../abstract:../common - -concrete SymbolFin of Symbol = CatFin ** open Prelude, NounFin, ResFin, MorphoFin, StemFin in { - -lin - SymbPN i = {s = \\c => i.s ++ bindColonIfS c ++ defaultStemEnding c ; h = Back} ; --- c - IntPN i = {s = \\c => i.s ++ bindColonIfS c ++ defaultStemEnding c ; h = Back} ; --- c - FloatPN i = {s = \\c => i.s ++ bindColonIfS c ++ defaultStemEnding c ; h = Back} ; --- c - NumPN i = {s = \\c => i.s!Sg!Nom ; h = Back} ; --- c - - CNIntNP cn i = { - s = \\c => cn.s ! NCase Sg (npform2case Sg c) ++ i.s ; - a = agrP3 Sg ; - isPron = False ; isNeg = False - } ; - CNSymbNP det cn xs = let detcn = NounFin.DetCN det cn in { - s = \\c => detcn.s ! c ++ xs.s ; - a = detcn.a ; - isPron = False ; isNeg = False - } ; - CNNumNP cn i = { - s = \\c => cn.s ! NCase Sg (npform2case Sg c) ++ i.s ! Sg ! Nom ; - a = agrP3 Sg ; - isPron = False ; isNeg = False - } ; - - SymbS sy = sy ; - - SymbNum n = {s = \\_,_ => n.s ; isNum = True ; n = Pl} ; - SymbOrd n = {s = \\_ => n.s ++ "."} ; - -lincat - - Symb, [Symb] = SS ; - -lin - - MkSymb s = s ; - - BaseSymb = infixSS "ja" ; - ConsSymb = infixSS "," ; - -} - diff --git a/lib/src/finnish/stemmed/VerbFin.gf b/lib/src/finnish/stemmed/VerbFin.gf deleted file mode 100644 index aef2535fd..000000000 --- a/lib/src/finnish/stemmed/VerbFin.gf +++ /dev/null @@ -1,147 +0,0 @@ ---1 Verb Phrases in Finnish - -concrete VerbFin of Verb = CatFin ** open Prelude, ResFin, StemFin in { - - flags optimize=all_subs ; - - lin - UseV = predSV ; - - SlashV2a v = predSV v ** {c2 = v.c2} ; - - Slash2V3 v np = - insertObj - (\\fin,b,_ => appCompl fin b v.c2 np) (predSV v) ** {c2 = v.c3} ; - Slash3V3 v np = - insertObj - (\\fin,b,_ => appCompl fin b v.c3 np) (predSV v) ** {c2 = v.c2} ; - - ComplVV v vp = - insertObj - (\\_,b,a => infVP v.sc b a vp v.vi) - (predSV {s = v.s ; - sc = case vp.sc of { - NPCase Nom => v.sc ; -- minun täytyy pestä auto - c => c -- minulla täytyy olla auto - } ; - h = v.h ; p = v.p - } - ) ; - - ComplVS v s = insertExtrapos ("," ++ etta_Conj ++ s.s) (predSV v) ; - ComplVQ v q = insertExtrapos ("," ++ q.s) (predSV v) ; - ComplVA v ap = - insertObj - (\\_,b,agr => - let n = (complNumAgr agr) in - ap.s ! False ! (NCase n (npform2case n v.c2.c))) --- v.cs.s ignored - (predSV v) ; - - SlashV2S v s = - insertExtrapos ("," ++ etta_Conj ++ s.s) (predSV v) ** {c2 = v.c2} ; - SlashV2Q v q = - insertExtrapos ("," ++ q.s) (predSV v) ** {c2 = v.c2} ; - SlashV2V v vp = - insertObj (\\_,b,a => infVP v.sc b a vp v.vi) (predSV v) ** {c2 = v.c2} ; - SlashV2A v ap = - insertObj - (\\fin,b,_ => - ap.s ! False ! (NCase Sg (npform2case Sg v.c3.c))) ----agr to obj - (predSV v) ** {c2 = v.c2} ; - - ComplSlash vp np = insertObjPre np.isNeg (\\fin,b,_ => appCompl fin b vp.c2 np) vp ; - - UseComp comp = - insertObj (\\_,_ => comp.s) (predV (verbOlla ** {sc = NPCase Nom ; qp = True ; p = []})) ; - - UseCopula = predV (verbOlla ** {sc = NPCase Nom ; qp = True ; p = []}) ; - - SlashVV v vp = - insertObj - (\\_,b,a => infVP v.sc b a vp v.vi) - (predSV {s = v.s ; - sc = case vp.sc of { - NPCase Nom => v.sc ; -- minun täytyy pestä auto - c => c -- minulla täytyy olla auto - } ; - h = v.h ; p = v.p - } - ) ** {c2 = vp.c2} ; ---- correct ?? -{---- 153543936 (210912,312) - SlashV2VNP v np vp = - insertObjPre np.isNeg - (\\fin,b,a => appCompl True b v.c2 np ++ ---- fin -> stack overflow - infVP v.sc b a vp v.vi) - (predSV v) ** {c2 = vp.c2} ; -----} - - AdvVP vp adv = insertAdv (\\_ => adv.s) vp ; - - AdVVP adv vp = insertAdv (\\_ => adv.s) vp ; - - AdvVPSlash vps adv = insertAdv (\\_ => adv.s) vps ** {c2 = vps.c2} ; - - AdVVPSlash adv vps = insertAdv (\\_ => adv.s) vps ** {c2 = vps.c2} ; - - ReflVP v = insertObjPre False (\\fin,b,agr => appCompl fin b v.c2 (reflPron agr)) v ; - - PassV2 v = let vp = predSV v in { - s = \\vif,ant,pol,agr => case vif of { - VIFin t => vp.s ! VIPass t ! ant ! pol ! agr ; - _ => vp.s ! vif ! ant ! pol ! agr - } ; - s2 = \\_,_,_ => [] ; - adv = \\_ => [] ; - ext = [] ; - qp = vp.qp ; - isNeg = False ; - sc = v.c2.c ; -- minut valitaan ; minua rakastetaan ; minulle kuiskataan - } ; ---- talon valitaan: should be marked like inf. - -----b UseVS, UseVQ = \v -> v ** {c2 = {s = [] ; c = NPAcc ; isPre = True}} ; - - CompAP ap = { - s = \\agr => - let - n = complNumAgr agr ; - c = case n of { - Sg => Nom ; -- minä olen iso ; te olette iso - Pl => Part -- me olemme isoja ; te olette isoja - } --- definiteness of NP ? - in ap.s ! False ! (NCase n c) - } ; - CompCN cn = { - s = \\agr => - let - n = complNumAgr agr ; - c = case n of { - Sg => Nom ; -- minä olen iso ; te olette iso - Pl => Part -- me olemme isoja ; te olette isoja - } --- definiteness of NP ? - in cn.s ! (NCase n c) - } ; - CompNP np = {s = \\_ => np.s ! NPCase Nom} ; - CompAdv a = {s = \\_ => a.s} ; - - VPSlashPrep vp prep = vp ** {c2 = prep} ; -} - - ---2 The object case --- --- The rules involved are ComplV2 and ComplVV above. --- The work is done jointly in ResFin.infVP and appCompl. --- Cases to test: l -table (to see negated forms) ---``` --- minun täytyy ostaa auto --- PredVP (UsePron i_Pron) (ComplVV must_VV --- (ComplV2 buy_V2 (DetCN (DetSg (SgQuant DefArt) NoOrd) (UseN car_N)))) --- minä tahdon ostaa auton --- PredVP (UsePron i_Pron) (ComplVV want_VV --- (ComplV2 buy_V2 (DetCN (DetSg (SgQuant DefArt) NoOrd) (UseN car_N)))) --- minulla täytyy olla auto --- PredVP (UsePron i_Pron) (ComplVV must_VV --- (ComplV2 have_V2 (DetCN (DetSg (SgQuant DefArt) NoOrd) (UseN car_N)))) ---``` --- Unfortunately, there is no nice way to say "I want to have a car". --- (Other than the paraphrases "I want a car" or "I want to own a car".)