-- stem-based morphology, with just the minimum number of concatenative stems resource StemFin = open MorphoFin, Prelude in { flags coding = utf8 ; oper -- other classes not treated below are POS tagged when the grammar is used with Omorfi tagPOS : Str -> Str -> Str = \_,s -> s ; tagFeature : Str -> Str -> Str -> Str = \s,_,_ -> s ; oper SNForm : Type = Predef.Ints 10 ; SNoun : Type = {s : SNForm => Str ; h : Harmony} ; nforms2snoun : NForms -> SNoun = \nf -> { s = table { 0 => nf ! 0 ; -- ukko 1 => Predef.tk 1 (nf ! 1) ; -- uko(n) 2 => nf ! 2 ; -- ukkoa 3 => Predef.tk 2 (nf ! 3) ; -- ukkona 4 => Predef.tk 1 (nf ! 4) ; -- ukkoo(n) 5 => Predef.tk 1 (nf ! 5) ; -- ukkoje(n) 6 => nf ! 6 ; -- ukkoja 7 => Predef.tk 2 (nf ! 7) ; -- ukkoi(na) 8 => Predef.tk 3 (nf ! 8) ; -- ukoi(ssa) 9 => Predef.tk 1 (nf ! 9) ; -- ukkoihi(n) 10 => nf ! 10 -- ukko(-) } ; h = aHarmony (last (nf ! 2)) ; } ; snoun2nounBind : SNoun -> Noun = snoun2noun True ; snoun2nounSep : SNoun -> Noun = snoun2noun False ; snoun2noun : Bool -> SNoun -> Noun = \b,sn -> let plus = plusIf b ; f = sn.s ; ukko = f ! 0 ; uko = f ! 1 ; ukkoa = f ! 2 ; ukko_ = f ! 3 ; ukkoo = f ! 4 ; ukkoje = f ! 5 ; ukkoja = f ! 6 ; ukkoi = f ! 7 ; ukoi = f ! 8 ; ukkoihi = f ! 9 ; ukkos_ = f ! 10 ; a = harmonyA sn.h ; in {s = table { NCase Sg Nom => ukko ; NCase Sg Gen => plus uko "n" ; NCase Sg Part => ukkoa ; NCase Sg Transl => plus uko "ksi" ; NCase Sg Ess => plus ukko_ ("n" + a) ; NCase Sg Iness => plus uko ("ss" + a) ; NCase Sg Elat => plus uko ("st" + a) ; NCase Sg Illat => plus ukkoo "n" ; NCase Sg Adess => plus uko ("ll" + a) ; NCase Sg Ablat => plus uko ("lt" + a) ; NCase Sg Allat => plus uko "lle" ; NCase Sg Abess => plus uko ("tt" + a) ; NCase Pl Nom => plus uko "t" ; NCase Pl Gen => plus ukkoje "n" ; NCase Pl Part => ukkoja ; NCase Pl Transl => plus ukoi "ksi" ; NCase Pl Ess => plus ukkoi ("n" + a) ; NCase Pl Iness => plus ukoi ("ss" + a) ; NCase Pl Elat => plus ukoi ("st" + a) ; NCase Pl Illat => plus ukkoihi "n" ; NCase Pl Adess => plus ukoi ("ll" + a) ; NCase Pl Ablat => plus ukoi ("lt" + a) ; NCase Pl Allat => plus ukoi "lle" ; NCase Pl Abess => plus ukoi ("tt" + a) ; NComit => plus ukkoi "ne" ; NInstruct => plus ukoi "n" ; NPossNom _ => ukko_ ; NPossGen Sg => ukko_ ; NPossGen Pl => ukkoje ; NPossTransl Sg => plus uko "kse" ; NPossTransl Pl => plus ukoi "kse" ; NPossIllat Sg => ukkoo ; NPossIllat Pl => ukkoihi ; NCompound => ukkos_ } ; h = sn.h ; lock_N = <> } ; snoun2np : Number -> SNoun -> NPForm => Str = \n,sn -> \\c => (snoun2nounSep sn).s ! NCase n (npform2case n c) ; noun2snoun : Noun -> SNoun = \n -> nforms2snoun (n2nforms n) ; aHarmony : Str -> Harmony = \a -> case a of {"a" => Back ; _ => Front} ; harmonyA : Harmony -> Str = harmonyV "a" "ä" ; 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 param SAForm = SAN SNForm | SAAdv ; oper SAdj = {s : SAForm => Str ; h : Harmony} ; SAdjFull = {s : Degree => SAForm => Str ; h : Harmony} ; sAdjFull2nforms : Degree -> SAdjFull -> NForm => Str = \d,a -> (snoun2nounSep {s = \\nc => a.s ! d ! sAN nc ; h = a.h}).s ; snoun2sadj : SNoun -> SAdj = snoun2sadjComp True ; snoun2sadjComp : Bool -> SNoun -> SAdj = \isPos,tuore -> let tuoree = tuore.s ! 1 ; tuoreesti = tuoree + "sti" ; tuoreemmin = init tuoree ; in {s = table { SAN f => tuore.s ! f ; SAAdv => if_then_Str isPos tuoreesti tuoreemmin } ; 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 -- SVForm : Type = Predef.Ints 13 ; -- easier to understand, better error msgs param SVForm = SVInf | SVps1 | SVps3 | SVpp3 | SVip2 | SVpas | SVis1 | SVis3 | SVcon | SVppa | SVppp | SVppg | SVpot | SVpac ; oper SVerb : Type = {s : SVForm => Str ; h : Harmony} ; ollaSVerbForms : SVForm => Str = table SVForm ["oll";"ole";"on";"o";"olk";"olla";"oli";"oli";"olisi";"oll";"olt";"ollu";"liene";"ole"] ; -- used in Cat SVerb1 = {s : SVForm => Str ; sc : SubjCase ; h : Harmony ; p : Str} ; sverb2verbBind : SVerb -> Verb = sverb2verb True ; sverb2verbSep : SVerb -> Verb = sverb2verb False ; vforms2sverb : VForms -> SVerb = \vf -> { s = table { SVInf => Predef.tk 1 (vf ! 0) ; -- tull(a) SVps1 => Predef.tk 1 (vf ! 1) ; -- tule(n) SVps3 => (vf ! 2) ; -- tulee SVpp3 => Predef.tk 3 (vf ! 3) ; -- tule(vat) SVip2 => Predef.tk 2 (vf ! 4) ; -- tulk(aa) SVpas => Predef.tk 2 (vf ! 5) ; -- tulla(an) SVis1 => Predef.tk 1 (vf ! 6) ; -- tuli(n) SVis3 => (vf ! 7) ; -- tuli SVcon => (vf ! 8) ; -- tulisi SVppa => Predef.tk 2 (vf ! 9) ; -- tull(ut) SVppp => Predef.tk 1 (vf ! 10) ; -- tult(u) SVppg => weakGrade (vf ! 10) ; -- tullu(n) SVpot => Predef.tk 1 (vf ! 11) ; -- tulle(e) SVpac => Predef.tk 3 (vf ! 3) -- tule(va) } ; h = aHarmony (last (vf ! 0)) ; } ; sverb2verb : Bool -> SVerb -> Verb = \b,sverb -> let plus = plusIf b ; vh = sverb.s ; tull = vh ! SVInf ; -- tull(a) tule_ = vh ! SVps1 ; -- tule(n) tulee = vh ! SVps3 ; tule__ = vh ! SVpp3 ; -- tule(vat) tulk_ = vh ! SVip2 ; -- tulk(aa) tulla_ = vh ! SVpas ; -- tulla(an) tuli_ = vh ! SVis1 ; -- tuli(n) tuli = vh ! SVis3 ; tulisi = vh ! SVcon ; tull_ = vh ! SVppa ; -- tull(ut) tult_ = vh ! SVppp ; tullu__ = vh ! SVppg ; -- tullu(n) tulle_ = vh ! SVpot ; -- tulle(e) tule___ = vh ! SVpac ; -- tule(va) a = harmonyA sverb.h ; o = harmonyV "o" "ö" sverb.h ; u = harmonyV "u" "y" sverb.h ; tulla = plus tull a ; tulko = plus tulk_ o ; tulkoo = plus tulko o ; tullee = plus tull_ "ee" ; tulle = plus tull_ "e" ; tullu_ = plus tull_ u ; tullut = plus tullu_ "t" ; tullun = plus tullu_ "n" ; tultu = plus tult_ u ; tulev = plus tule___ "v" ; tuleva = plus tule___ ("v" + a) ; tulem = plus tule___ "m" ; tulema = plus tule___ ("m" + a) ; tultav = plus tult_ (a + "v") ; tultava = plus tult_ (a + "v" + a) ; tullutN : Noun = snoun2noun b { s = table SNForm [ tullut ; tullee ; plus tullut ("t" + a) ; tullee ; -- essive stem; ("n" + a) is added in snoun2noun plus tullee "see" ; plus tulle "ide" ; plus tulle ("it" + a) ; plus tulle "i" ; plus tulle "i" ; plus tulle "isii" ; tullut ] ; h = sverb.h } ; tultuN : Noun = snoun2noun b { s = table SNForm [ tultu ; tullu__ ; plus tultu a ; tultu ; -- essive stem; ("n" + a) is added in snoun2noun plus tultu u ; plus tultu "je" ; plus tultu ("j" + a) ; plus tultu "i" ; plus tullu__ "i" ; plus tultu "ihi" ; tultu ] ; h = sverb.h } ; tulevaN : Noun = snoun2noun b { s = table SNForm [ tuleva ; tuleva ; plus tuleva a ; tuleva ; -- essive stem; ("n" + a) is added in snoun2noun plus tuleva a ; plus tulev "ie" ; plus tulev ("i" + a) ; plus tulev "i" ; plus tulev "i" ; plus tulev "ii" ; tuleva ] ; h = sverb.h } ; tultavaN : Noun = snoun2noun b { s = table SNForm [ tultava ; tultava ; plus tultava a ; tultava ; -- essive stem ; ("n" + a) is added in snoun2noun plus tultava a ; plus tultav "ie" ; plus tultav ("i" + a) ; plus tultav "i" ; plus tultav "i" ; plus tultav "ii" ; tuleva ] ; h = sverb.h } ; tulemaN : Noun = snoun2noun b { s = table SNForm [ tulema ; tulema ; plus tulema a ; tulema ; plus tulema a ; plus tulem "ie" ; plus tulem ("i" + a) ; plus tulem "i" ; plus tulem "i" ; plus tulem "ii" ; tulema ] ; h = sverb.h } ; vat = "v" + a + "t" in {s = table { Inf Inf1 => tulla ; Inf Inf1Long => plus tulla "kse" ; Inf Inf2Iness => plus tull ("ess" + a) ; Inf Inf2Instr => plus tull "en" ; Inf Inf2InessPass => plus tult_ (a + "ess" + a) ; Inf Inf3Iness => plus tulema ("ss" + a) ; Inf Inf3Elat => plus tulema ("st" + a) ; Inf Inf3Illat => plus tulema (a + "n") ; Inf Inf3Adess => plus tulema ("ll" + a) ; Inf Inf3Abess => plus tulema ("tt" + a) ; Inf Inf3Instr => plus tulema "n" ; Inf Inf3InstrPass => plus tult_ (a + "m" + a + "n") ; Inf Inf4Nom => plus tule__ "minen" ; Inf Inf4Part => plus tule__ ("mist" + a) ; Inf Inf5 => plus tulema ("isill" + a) ; Inf InfPresPart => plus tuleva "n" ; Inf InfPresPartAgr => tuleva ; Presn Sg P1 => plus tule_ "n" ; Presn Sg P2 => plus tule_ "t" ; Presn Sg P3 => tulee ; Presn Pl P1 => plus tule_ "mme" ; Presn Pl P2 => plus tule_ "tte" ; Presn Pl P3 => plus tule__ vat ; Impf Sg P1 => plus tuli_ "n" ; --# notpresent Impf Sg P2 => plus tuli_ "t" ; --# notpresent Impf Sg P3 => tuli ; --# notpresent Impf Pl P1 => plus tuli_ "mme" ; --# notpresent Impf Pl P2 => plus tuli_ "tte" ; --# notpresent Impf Pl P3 => plus tuli vat ; --# notpresent Condit Sg P1 => plus tulisi "n" ; --# notpresent Condit Sg P2 => plus tulisi "t" ; --# notpresent Condit Sg P3 => tulisi ; --# notpresent Condit Pl P1 => plus tulisi "mme" ; --# notpresent Condit Pl P2 => plus tulisi "tte" ; --# notpresent Condit Pl P3 => plus tulisi vat ; --# notpresent Potent Sg P1 => plus tulle_ "n" ; --# notpresent Potent Sg P2 => plus tulle_ "t" ; --# notpresent Potent Sg P3 => plus tulle_ "e" ; --# notpresent Potent Pl P1 => plus tulle_ "mme" ; --# notpresent Potent Pl P2 => plus tulle_ "tte" ; --# notpresent Potent Pl P3 => plus tulle_ vat ; --# notpresent PotentNeg => tulle_ ; --# notpresent Imper Sg => tule_ ; Imper Pl => plus tulk_ (a + a) ; ImperP3 Sg => plus tulkoo "n" ; ImperP3 Pl => plus tulkoo "t" ; ImperP1Pl => plus tulk_ (a + a + "mme") ; ImpNegPl => tulko ; PassPresn True => plus tulla_ (a + "n") ; PassPresn False => tulla_ ; PassImpf True => plus tult_ ("iin") ; --# notpresent PassImpf False => tultu ; --# notpresent PassCondit True => plus tult_ (a + "isiin") ; --# notpresent PassCondit False => plus tult_ (a + "isi") ; --# notpresent PassPotent True => plus tult_ (a + "neen") ; --# notpresent PassPotent False => plus tult_ (a + "ne") ; --# notpresent PassImper True => plus tult_ (a + "k" + o + o + "n") ; PassImper False => plus tult_ (a + "k" + o) ; PresPartAct (AN n) => tulevaN.s ! n ; PresPartAct AAdv => plus tuleva "sti" ; PresPartPass (AN n) => tultavaN.s ! n ; PresPartPass AAdv => plus tultava "sti" ; PastPartAct (AN n) => tullutN.s ! n ; PastPartAct AAdv => plus tullee "sti" ; PastPartPass (AN n) => tultuN.s ! n ; PastPartPass AAdv => plus tullu__ "sti" ; AgentPart (AN n) => tulemaN.s ! n ; AgentPart AAdv => plus tulema "sti" } ; sc = SCNom ; lock_V = <> } ; predSV : SVerb1 -> VP = predV ; -- word formation functions sverb2snoun : SVerb1 -> SNoun = \v -> -- syöminen let teke = v.s ! SVpac in { s = table { 0 => partPlus teke "minen" ; 1 => partPlus teke "mise" ; 2 => partPlus teke "mista" ; ---- vh 3 => partPlus teke "mise" ; 4 => partPlus teke "misee" ; 5 => partPlus teke "miste" ; 6 => partPlus teke "misia" ; ---- vh 7 => partPlus teke "misi" ; 8 => partPlus teke "misi" ; 9 => partPlus teke "misii" ; 10 => partPlus teke "mis" } ; h = v.h } ; sverb2nounPresPartAct : SVerb1 -> SNoun = \v -> -- syövä let teke = v.s ! SVpac in { s = table { 0 => partPlus teke "va" ; 1 => partPlus teke "va" ; 2 => partPlus teke "vaa" ; ---- vh 3 => partPlus teke "va" ; ---- vh 4 => partPlus teke "vaa" ; 5 => partPlus teke "vie" ; 6 => partPlus teke "via" ; ---- vh 7 => partPlus teke "vi" ; 8 => partPlus teke "vi" ; 9 => partPlus teke "vii" ; 10 => partPlus teke "va" } ; h = v.h } ; sverb2nounPresPartPass : SVerb1 -> SNoun = \v -> -- syötävä let a = harmonyA v.h in nforms2snoun (dLava (partPlus (v.s ! SVppp) (partPlus "t" (partPlus a (partPlus "v" a))))) ; dLava : Str -> NForms = \s -> dUkko s (s + "n") ; --- to use these at run time in ParseFin partPlus = glue ; -- auxiliary plusIf : Bool -> Str -> Str -> Str = \b,x,y -> case b of { True => x + y ; False => glue x y } ; -- for Symbol addStemEnding : Str -> SPN = \i -> { s = \\c => i ++ bindColonIfS c ++ case c of { 0 => "" ; 1 => "i" ; 2 => "ia" ; 3 => "i" ; 4 => "ii" ; 5 => "ie" ; 6 => "ia" ; 7 => "i" ; 8 => "i" ; 9 => "ihi" ; 10 => "" } ; h = Back ---- } ; bindIfS : SNForm -> Str = \c -> case c of { 0 | 10 => [] ; _ => BIND } ; bindColonIfS : SNForm -> Str = \c -> case c of { 0 | 10 => [] ; _ => BIND ++ ":" ++ BIND } ; ----------------------------------------------------------------------- ---- a hack to make VerbFin compile accurately for library (in ../), ---- and in a simplified way for ParseFin (here) slashV2VNP : (SVerb1 ** {c2 : Compl ; vi : VVType}) -> (NP ** {isNeg : Bool}) -> (VP ** {c2 : Compl}) -> (VP ** {c2 : Compl}) = \v, np, vp -> { s = v ; s2 = \\fin,b,a => appCompl fin b v.c2 np ++ v.s ! SVInf ; ---- infVP v.sc b a vp v.vi ; -- ignoring Acc variation and pre/postposition and proper inf form ext = [] ; adv = \\_ => v.p ; vptyp = vp.vptyp ; -- ignoring np.isNeg c2 = vp.c2 } ; -------------------------------- ---- VP now stemming-dependent. AR 7/12/2013 VP = { s : SVerb1 ; s2 : Bool => Polarity => Agr => Str ; -- talo/talon/taloa adv : Polarity => Str ; -- ainakin/ainakaan ext : Str ; vptyp : {isNeg : Bool ; isPass : Bool} ;-- True if some complement is negative, and if the verb is rendered in the passive } ; defaultVPTyp = {isNeg = False ; isPass = False} ; predV : SVerb1 -> VP = \verb -> { s = verb ; s2 = \\_,_,_ => [] ; adv = \\_ => verb.p ; -- the particle of the verb ext = [] ; vptyp = defaultVPTyp ; } ; old_VP = { s : VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ; s2 : Bool => Polarity => Agr => Str ; -- talo/talon/taloa adv : Polarity => Str ; -- ainakin/ainakaan ext : Str ; sc : SubjCase ; isNeg : Bool ; -- True if some complement is negative h : Harmony } ; vp2old_vp : VP -> old_VP = \vp -> let verb = sverb2verbSep vp.s ; sverb : VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} = \\vi,ant,b,agr0 => let agr = verbAgr agr0 ; verbs = verb.s ; part : Str = case vi of { VIPass _ => verbs ! PastPartPass (AN (NCase agr.n Nom)) ; _ => verbs ! PastPartAct (AN (NCase agr.n Nom)) } ; eiv : Str = case agr of { {n = Sg ; p = P1} => "en" ; {n = Sg ; p = P2} => "et" ; {n = Sg ; p = P3} => "ei" ; {n = Pl ; p = P1} => "emme" ; {n = Pl ; p = P2} => "ette" ; {n = Pl ; p = P3} => "eivät" } ; einegole : Str * Str * Str = case of { => ; => ; --# notpresent => ; --# notpresent => ; --# notpresent => ; --# notpresent => <"älä", verbs ! Imper Sg, "ole"> ; => <"älkää", verbs ! ImpNegPl, "olko"> ; => <"ei", verbs ! PassPresn False, "ole"> ; => <"ei", verbs ! PassPresn False, "ole"> ; --# notpresent => <"ei", verbs ! PassCondit False, "olisi"> ; --# notpresent => <"ei", verbs ! PassImpf False, "ollut"> ; --# notpresent => <"ei", verbs ! Inf i, "olla"> ---- } ; ei : Str = einegole.p1 ; neg : Str = einegole.p2 ; ole : Str = einegole.p3 ; olla : VForm => Str = table { PassPresn True => verbOlla.s ! Presn Sg P3 ; PassImpf True => verbOlla.s ! Impf Sg P3 ; --# notpresent PassCondit True => verbOlla.s ! Condit Sg P3 ; --# notpresent vf => verbOlla.s ! vf } ; vf : Str -> Str -> {fin, inf : Str} = \x,y -> {fin = x ; inf = y} ; mkvf : VForm -> {fin, inf : Str} = \p -> case of { => vf (verbs ! p) [] ; => vf (olla ! p) part ; --# notpresent => vf ei (ole ++ part) ; --# notpresent => vf ei neg } ; passPol = case b of {Pos => True ; Neg => False} ; in case vi of { VIFin Past => mkvf (Impf agr.n agr.p) ; --# notpresent VIFin Cond => mkvf (Condit agr.n agr.p) ; --# notpresent VIFin Fut => mkvf (Presn agr.n agr.p) ; --# notpresent VIFin Pres => mkvf (Presn agr.n agr.p) ; VIImper => mkvf (Imper agr.n) ; VIPass Past => mkvf (PassImpf passPol) ; --# notpresent VIPass Cond => mkvf (PassCondit passPol) ; --# notpresent VIPass Fut => mkvf (PassPresn passPol) ; --# notpresent VIPass Pres => mkvf (PassPresn passPol) ; VIInf i => mkvf (Inf i) } in { s = case vp.vptyp.isPass of { True => \\vif,ant,pol,agr => case vif of { VIFin t => sverb ! VIPass t ! ant ! pol ! agr ; _ => sverb ! vif ! ant ! pol ! agr } ; _ => sverb } ; s2 = vp.s2 ; adv = vp.adv ; -- the particle of the verb ext = vp.ext ; sc = vp.s.sc ; h = vp.s.h ; isNeg = vp.vptyp.isNeg } ; insertObj : (Bool => Polarity => Agr => Str) -> VP -> VP = \obj,vp -> { s = vp.s ; s2 = \\fin,b,a => vp.s2 ! fin ! b ! a ++ obj ! fin ! b ! a ; adv = vp.adv ; ext = vp.ext ; sc = vp.sc ; h = vp.h ; vptyp = vp.vptyp } ; 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 ; adv = vp.adv ; ext = vp.ext ; vptyp = {isNeg = orB vp.vptyp.isNeg isNeg ; isPass = vp.vptyp.isPass} ; } ; insertAdv : (Polarity => Str) -> VP -> VP = \adv,vp -> { s = vp.s ; s2 = vp.s2 ; ext = vp.ext ; adv = \\b => vp.adv ! b ++ adv ! b ; sc = vp.sc ; h = vp.h ; vptyp = vp.vptyp --- missään } ; passVP : VP -> Compl -> VP = \vp,pr -> { s = {s = vp.s.s ; h = vp.s.h ; p = vp.s.p ; sc = npform2subjcase pr.c} ; -- minusta pidetään s2 = \\b,p,a => pr.s.p1 ++ vp.s2 ! b ! p ! a ++ pr.s.p2 ; ---- possessive suffix ext = vp.ext ; adv = vp.adv ; vptyp = {isNeg = vp.vptyp.isNeg ; isPass = True} ; } ; insertExtrapos : Str -> VP -> VP = \obj,vp -> { s = vp.s ; s2 = vp.s2 ; ext = vp.ext ++ obj ; adv = vp.adv ; sc = vp.sc ; h = vp.h ; vptyp = vp.vptyp } ; mkClausePol : Bool -> (Polarity -> Str) -> Agr -> VP -> Clause = \isNeg,sub,agr,vp -> { s = \\t,a,b => let pol = case isNeg of { True => Neg ; _ => b } ; c = (mkClausePlus sub agr vp).s ! t ! a ! pol in table { SDecl => c.subj ++ c.fin ++ 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 = \sub,agr,vp -> { 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.h ++ c.subj ++ c.inf ++ c.compl ++ c.adv ++ c.ext } } ; mkClausePlus : (Polarity -> Str) -> Agr -> VP -> ClausePlus = \sub,agr,vp0 -> let vp = vp2old_vp vp0 in { s = \\t,a,b => let agrfin = case vp.sc of { SCNom => ; _ => -- minun täytyy, minulla on } ; verb = vp.s ! VIFin t ! a ! b ! agrfin.p1 ; in {subj = sub b ; fin = verb.fin ; inf = verb.inf ; compl = vp.s2 ! agrfin.p2 ! b ! agr ; adv = vp.adv ! b ; ext = vp.ext ; h = selectPart vp0 a b } } ; selectPart : VP -> Anteriority -> Polarity -> Harmony = \vp,a,p -> case p of { Neg => Front ; -- eikö tule _ => case a of { Anter => Back ; -- onko mennyt --# notpresent _ => vp.s.h -- tuleeko, meneekö } } ; -- the first Polarity is VP-internal, the second comes form the main verb: -- ([main] tahdon | en tahdo) ([internal] nukkua | olla nukkumatta) infVPGen : Polarity -> SubjCase -> Polarity -> Agr -> VP -> InfForm -> Str = \ipol,sc,pol,agr,vp0,vi -> let vp = vp2old_vp vp0 ; fin = case sc of { -- subject case SCNom => True ; -- minä tahdon nähdä auton _ => False -- minun täytyy nähdä auto } ; verb = case ipol of { Pos => ; -- nähdä/näkemään Neg => <(vp2old_vp (predV vpVerbOlla)).s ! VIInf vi ! Simul ! Pos ! agr, (vp.s ! VIInf Inf3Abess ! Simul ! Pos ! agr).fin> -- olla/olemaan näkemättä } ; vph = vp.h ; poss = case vi of { InfPresPartAgr => possSuffixGen vph agr ; -- toivon nukkuva + ni _ => [] } ; compl = vp.s2 ! fin ! pol ! agr ++ vp.adv ! pol ++ vp.ext -- compl. case propagated in verb.p1.fin ++ verb.p1.inf ++ poss ++ verb.p2 ++ compl ; infVP : SubjCase -> Polarity -> Agr -> VP -> InfForm -> Str = infVPGen Pos ; vpVerbOlla : SVerb1 = { s = ollaSVerbForms ; sc = SCNom ; h = Back ; lock_V = <> ; p = [] } ; }