diff --git a/lib/src/experimental/LiftFin.gf b/lib/src/experimental/LiftFin.gf new file mode 100644 index 000000000..44a6d22ce --- /dev/null +++ b/lib/src/experimental/LiftFin.gf @@ -0,0 +1,60 @@ +concrete LiftFin of Lift = + RGLBaseFin - [Pol,Tense] + ,PredFin + + ** open ResFin, + PredInstanceFin, + Prelude in { + +--flags literal=Symb ; + +{- +oper + liftV = PredInstanceFin.liftV ; + +lin + LiftV v = liftV v ; + LiftV2 v = : PrVerb> ** {c1 = v.c2.s} ; + LiftVS v = liftV v ; + LiftVQ v = liftV v ; + LiftVA v = liftV v ; ---- c1? + LiftVN v = liftV v ; ---- c1? + LiftVV v = : PrVerb> ** {c1 = v.c2.s} ; + + LiftV3 v = : PrVerb> ** {c1 = v.c2.s ; c2 = v.c3.s} ; + + LiftV2S v = : PrVerb> ** {c1 = v.c2.s} ; + LiftV2Q v = : PrVerb> ** {c1 = v.c2.s} ; + LiftV2V v = : PrVerb> ** {c1 = v.c2.s ; c2 = v.c3.s} ; + LiftV2A v = : PrVerb> ** {c1 = v.c2.s} ; + LiftV2N v = : PrVerb> ** {c1 = v.c2.s} ; + + LiftAP ap = {s = \\a => ap.s ! agr2aformpos a ; c1,c2 = [] ; obj1 = \\_ => []} ; --- isPre + LiftA2 ap = {s = \\a => ap.s ! AF (APosit (agr2aformpos a)) Nom ; c1 = ap.c2.s ; c2 = [] ; obj1 = \\_ => []} ; --- isPre + + LiftCN cn = {s = \\n => cn.s ! n ! DIndef ! Nom ; c1,c2 = [] ; obj1 = \\_ => []} ; + LiftN2 cn = {s = \\n => cn.s ! n ! specDet DIndef ! Nom ; c1 = cn.c2.s ; c2 = [] ; obj1 = \\_ => []} ; + + AppAPCN ap cn = + {s = \\n,d,c => + let + agr = {n = n ; g = cn.g ; p = P3} + in (cn.s ! n ! d ! c) ++ (ap.s ! agr ++ ap.obj1 ! agr) ; -- flicka älskad av alla + g = cn.g ; + isMod = True + } + | {s = \\n,d,c => + let + agr = {n = n ; g = cn.g ; p = P3} + in (ap.obj1 ! agr ++ ap.s ! agr) ++ (cn.s ! n ! d ! c) ; -- av alla älskad flicka + g = cn.g ; + isMod = True + } ; + + LiftAdv a = a ** {isAdV = False ; c1 = []} ; + LiftAdV a = a ** {isAdV = True ; c1 = []} ; + LiftPrep p = {s = [] ; isAdV = False ; c1 = p.s} ; +-} + +} + diff --git a/lib/src/experimental/NDLiftFin.gf b/lib/src/experimental/NDLiftFin.gf new file mode 100644 index 000000000..d348cdebc --- /dev/null +++ b/lib/src/experimental/NDLiftFin.gf @@ -0,0 +1,5 @@ +concrete NDLiftFin of NDLift = + RGLBaseFin - [Pol,Tense] + ,NDPredFin + + ** NDLiftFunctor with (Lift = LiftFin) ; diff --git a/lib/src/experimental/NDPredFin.gf b/lib/src/experimental/NDPredFin.gf new file mode 100644 index 000000000..0d51ba2fc --- /dev/null +++ b/lib/src/experimental/NDPredFin.gf @@ -0,0 +1,6 @@ +concrete NDPredFin of Pred = + CatFin [Ant,NP,Utt,IP,IAdv,Conj] ** + NDPredFunctor + with + (PredInterface = PredInstanceFin), + (Pred = PredFin) ; diff --git a/lib/src/experimental/NDTransFin.gf b/lib/src/experimental/NDTransFin.gf new file mode 100644 index 000000000..f3c437766 --- /dev/null +++ b/lib/src/experimental/NDTransFin.gf @@ -0,0 +1,14 @@ +--# -path=.:../finnish/stemmed:../finnish:../translator:alltenses + +concrete NDTransFin of NDTrans = + NDLiftFin + ,ExtensionsFin [CN,NP,AdA,AdV,CompoundCN,AdAdV,UttAdV,ApposNP] + ,DictionaryFin - [Pol,Tense] + + ** { + +flags + literal=Symb ; + +} + diff --git a/lib/src/experimental/PredFin.gf b/lib/src/experimental/PredFin.gf new file mode 100644 index 000000000..2ceaacf90 --- /dev/null +++ b/lib/src/experimental/PredFin.gf @@ -0,0 +1,12 @@ +concrete PredFin of Pred = + CatFin [Ant,NP,Utt,IP,IAdv,Conj] ** + PredFunctor - [StartVPC, ContVPC, ---- need generalization + AgentPassUseV,AgentPastPartAP] ---- moreover slow + with + (PredInterface = PredInstanceFin) + + ** { + +lin StartVPC, ContVPC, AgentPassUseV, AgentPastPartAP = variants {} ; ---- just to make it compile as instance of Pred + +} diff --git a/lib/src/experimental/PredFunctor.gf b/lib/src/experimental/PredFunctor.gf index 6c305df45..0fd88ef99 100644 --- a/lib/src/experimental/PredFunctor.gf +++ b/lib/src/experimental/PredFunctor.gf @@ -33,7 +33,7 @@ lincat c3 : ComplCase ; } ; - PrAdv = {s : Str ; isAdV : Bool ; c1 : Str} ; + PrAdv = {s : Str ; isAdV : Bool ; c1 : ComplCase} ; PrS = {s : Str} ; PrAP = { @@ -62,7 +62,7 @@ linref PrCl = \cl -> declCl cl ; PrQCl = \qcl -> questCl qcl ; - PrAdv = \adv -> adv.c1 ++ adv.s ; + PrAdv = \adv -> strComplCase adv.c1 ++ adv.s ; PrAP = \ap -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ; PrCN = \cn -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ; @@ -197,8 +197,8 @@ lin v = vp.v ! agr2vagr np.a ; subj = np.s ! subjCase ; adj = vp.adj ! np.a ; - obj1 = vp.part ++ vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase ---- place of part depends on obj - obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => np.a ; False => vp.obj1.p2}) ; ---- apply complCase + obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase ---- place of part depends on obj + obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => np.a ; False => vp.obj1.p2}) ; ---- apply complCase c3 = noComplCase ; -- for one more prep to build ClSlash qforms = vp.qforms ! agr2vagr np.a ; } ; @@ -221,8 +221,8 @@ lin focType = FocSubj ; subj = [] ; adj = vp.adj ! ipa ; - obj1 = vp.part ++ vp.c1 ++ vp.obj1.p1 ! ipa ; ---- appComplCase - obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => ipa ; False => vp.obj1.p2}) ; ---- appComplCase + obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! ipa ; ---- appComplCase + obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => ipa ; False => vp.obj1.p2}) ; ---- appComplCase c3 = noComplCase ; -- for one more prep to build ClSlash ---- ever needed for QCl? adv = vp.adv ; adV = vp.adV ; @@ -237,7 +237,7 @@ lin ips = ip.s ! objCase ; -- in Cl/NP, c3 is the only prep ---- appComplCase for ip focobj = case cl.focType of { NoFoc => ; -- put ip object to focus if there is no focus yet - t => <[], prep ++ ips, t,noComplCase> -- put ip object in situ if there already is a focus + t => <[], strComplCase prep ++ ips, t,noComplCase> -- put ip object in situ if there already is a focus } ; in cl ** { -- preposition stranding @@ -310,8 +310,8 @@ lin w.c1 ++ w.obj1.p1 ! vpa ++ w.c2 ++ w.obj2.p1 ! vpa ++ w.adv ++ w.ext ; inf = \\a => infVP v.vvtype a v ++ c.s2 ++ infVP w.vvtype a w ; - c1 = [] ; ---- w.c1 ? --- the full story is to unify v and w... - c2 = [] ; ---- w.c2 ? + c1 = noComplCase ; ---- w.c1 ? --- the full story is to unify v and w... + c2 = noComplCase ; ---- w.c2 ? } ; ContVPC x v w = { ---- some loss of quality seems inevitable @@ -327,8 +327,8 @@ lin wv ; inf = \\a => infVP v.vvtype a v ++ "," ++ w.inf ! a ; - c1 = [] ; ---- w.c1 ? --- the full story is to unify v and w... - c2 = [] ; ---- w.c2 ? + c1 = noComplCase ; ---- w.c1 ? --- the full story is to unify v and w... + c2 = noComplCase ; ---- w.c2 ? } ; UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable @@ -370,6 +370,6 @@ lin qforms = <[],[]> ; ---- qforms } ; - ComplAdv x p np = {s = p.c1 ++ np.s ! objCase ; isAdV = p.isAdV ; c1 = []} ; + ComplAdv x p np = {s = appComplCase p.c1 np ; isAdV = p.isAdV ; c1 = noComplCase} ; } \ No newline at end of file diff --git a/lib/src/experimental/PredInstanceEng.gf b/lib/src/experimental/PredInstanceEng.gf index 694480161..844b9f220 100644 --- a/lib/src/experimental/PredInstanceEng.gf +++ b/lib/src/experimental/PredInstanceEng.gf @@ -34,6 +34,7 @@ oper appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> p ++ np.s ! objCase ; noComplCase : ComplCase = [] ; + strComplCase : ComplCase -> Str = \c -> c ; noObj : Agr => Str = \\_ => [] ; diff --git a/lib/src/experimental/PredInstanceFin.gf b/lib/src/experimental/PredInstanceFin.gf new file mode 100644 index 000000000..2bd7df74c --- /dev/null +++ b/lib/src/experimental/PredInstanceFin.gf @@ -0,0 +1,153 @@ +instance PredInstanceFin of PredInterface - [NounPhrase,PrVerb] = + open ResFin, (P = ParadigmsFin), (S = StemFin), (X = ParamX), Prelude in { + +-- overrides + +oper + NounPhrase = ResFin.NP ; + PrVerb = StemFin.SVerb1 ** { + c1 : ComplCase ; + c2 : ComplCase ; + isSubjectControl : Bool ; + vtype : VType ; + vvtype : VVType ; + } ; + +--------------------- +-- parameters ------- +--------------------- + +oper + Agr = ResFin.Agr ; + Case = ResFin.Case ; + NPCase = ResFin.NPForm ; + VForm = S.SVForm ; + VVType = ResFin.InfForm ; + VType = Unit ; ---- + Gender = Unit ; ---- + + VAgr = Agr ; + + SVoice = Voice ; + +oper + active = Act ; + passive = Pass ; + + subjCase : NPCase = ResFin.NPCase Nom ; + objCase : NPCase = NPAcc ; + + ComplCase = ResFin.Compl ; -- preposition + agentCase : ComplCase = P.postGenPrep "toimesta" ; + strComplCase : ComplCase -> Str = \c -> c.s ! False ; + + appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> appCompl True Pos p np ; + noComplCase : ComplCase = P.postGenPrep [] ; ---- + + noObj : Agr => Str = \\_ => [] ; + + NAgr = Number ; + IPAgr = Number ; --- two separate fields in RGL + + defaultAgr : Agr = Ag Sg P3 ; + +-- omitting rich Agr information + agr2vagr : Agr -> VAgr = \a -> a ; + + agr2aagr : Agr -> AAgr = \a -> a ; + + agr2nagr : Agr -> NAgr = \a -> case a of {Ag n _ => n ; AgPol => Sg} ; -- minä olen pomo / te olette pomoja / te olette pomo + +-- restoring full Agr + ipagr2agr : IPAgr -> Agr = \a -> Ag a P3 ; + + ipagr2vagr : IPAgr -> VAgr = \n -> Ag n P3 ; + +--- this is only needed in VPC formation + vagr2agr : VAgr -> Agr = \a -> a ; + + vPastPart : PrVerb -> AAgr -> Str = \v,a -> (S.sverb2verbSep v).s ! PastPartPass (AN (NCase Sg Part)) ; ---- case + vPresPart : PrVerb -> AAgr -> Str = \v,a -> (S.sverb2verbSep v).s ! PresPartAct (AN (NCase Sg Part)) ; ---- case + + vvInfinitive : VVType = Inf1 ; + + isRefl : PrVerb -> Bool = \_ -> False ; ---- + + +------------------ +--- opers -------- +------------------ + +oper + reflPron : Agr -> Str = \a -> (ResFin.reflPron a).s ! NPAcc ; ---- case + + infVP : VVType -> Agr -> PrVerbPhrase -> Str = \vt, a,vp -> + let + a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2} + in + vp.adV ++ vp.inf ! vt ++ + vp.adj ! a ++ vp.obj1.p1 ! a ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ; + + qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str = + \sta,t,a,p,agr,v -> <[],[]> ; ----- not needed in Finnish + + + declCl : PrClause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ; + declSubordCl : PrClause -> Str = \cl -> cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl ; + declInvCl : PrClause -> Str = \cl -> cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ; + + questCl : PrQuestionClause -> Str = \cl -> cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ; + + questSubordCl : PrQuestionClause -> Str = questCl ; + + that_Compl : Str = "että" ; + + -- this part is usually the same in all reconfigurations + restCl : PrClause -> Str = \cl -> cl.v.p3 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ++ cl.c3.s ! False ; ---- c3 + + negAdV : {s : Str ; p : Polarity} -> Str = \p -> p.s ; + + tenseV : Str -> STense -> Anteriority -> Polarity -> SVoice -> VAgr -> PrVerb -> Str * Str * Str = + \sta,t,a,pol,o,agr,v -> + let + ovps = (S.vp2old_vp (S.predV v)).s ! VIFin t ! a ! pol ! agr ; -- VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ; + act = Act + in + ; + + tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str = + \sa,a,pol,o,v,vt -> + let + ovps = (S.vp2old_vp (S.predV v)).s ! VIInf vt ! a ! pol ! defaultAgr ; -- VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ; + in + sa ++ ovps.fin ++ ovps.inf ; + + tenseCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = + \s,t,a,p,agr -> tenseV s t a p Act agr (liftV P.olla_V) ; + tenseInfCopula : Str -> Anteriority -> Polarity -> VVType -> Str = + \s,a,p,vt -> tenseInfV s a p Act (liftV P.olla_V) vt ; + + noObj : Agr => Str = \\_ => [] ; + + addObj2VP : PrVerbPhrase -> (Agr => Str) -> PrVerbPhrase = \vp,obj -> vp ** { + obj2 = <\\a => vp.obj2.p1 ! a ++ obj ! a, vp.obj2.p2> ; + } ; + + addExtVP : PrVerbPhrase -> Str -> PrVerbPhrase = \vp,ext -> vp ** { + ext = ext ; + } ; + + not_Str : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "inte"} ; + + liftV : S.SVerb1 -> PrVerb = \v -> + v ** {c1,c2 = noComplCase ; isSubjectControl = False ; vtype = UUnit ; vvtype = vvInfinitive} ; + +--- junk + + qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str = + \sta,t,a,p,agr,v -> <[],[]> ; + qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str = + \sta,t,a,p,agr -> <[],[]> ; + + +} \ No newline at end of file diff --git a/lib/src/experimental/PredInstanceSwe.gf b/lib/src/experimental/PredInstanceSwe.gf index 15489520c..a61036ab9 100644 --- a/lib/src/experimental/PredInstanceSwe.gf +++ b/lib/src/experimental/PredInstanceSwe.gf @@ -30,6 +30,7 @@ oper appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> p ++ np.s ! objCase ; noComplCase : ComplCase = [] ; + strComplCase : ComplCase -> Str = \c -> c ; noObj : Agr => Str = \\_ => [] ; diff --git a/lib/src/experimental/PredInterface.gf b/lib/src/experimental/PredInterface.gf index 12bbfca0e..3ce489d5d 100644 --- a/lib/src/experimental/PredInterface.gf +++ b/lib/src/experimental/PredInterface.gf @@ -46,7 +46,7 @@ oper ComplCase : Type ; -- e.g. preposition agentCase : ComplCase ; - + strComplCase : ComplCase -> Str ; NounPhrase : Type = {s : NPCase => Str ; a : Agr} ; @@ -173,8 +173,8 @@ oper \a,t,p -> { v = \\agr => tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; inf = \\vt => tenseInfCopula a.s a.a p.p vt ; - c1 = [] ; - c2 = [] ; + c1 = noComplCase ; + c2 = noComplCase ; part = [] ; adj = \\_ => [] ; obj1 = ; diff --git a/lib/src/experimental/RGLBaseFin.gf b/lib/src/experimental/RGLBaseFin.gf new file mode 100644 index 000000000..2413d7642 --- /dev/null +++ b/lib/src/experimental/RGLBaseFin.gf @@ -0,0 +1,20 @@ +concrete RGLBaseFin of RGLBase = + +-- modules in Grammar, excluding Structural, Verb, Sentence, Question +---- Tense, + NounFin - [PPartNP], -- to be generalized + AdjectiveFin, + NumeralFin, + ConjunctionFin, + AdverbFin, + PhraseFin - [UttS], +---- Sentence, +---- Question, + RelativeFin, +---- Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP], ---- why only these? + + SymbolFin [PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP] ; ---- why only these? + +---- Construction, +---- Extensions, +---- Documentation ; diff --git a/lib/src/experimental/TestFin.gf b/lib/src/experimental/TestFin.gf new file mode 100644 index 000000000..f6b244a60 --- /dev/null +++ b/lib/src/experimental/TestFin.gf @@ -0,0 +1,8 @@ +--# -path=.:../finnish/stemmed:../finnish:../common:alltenses + +concrete TestFin of Test = + LiftFin - [MkSymb] + ,LexiconFin - [Pol,Tense] + ,StructuralFin - [Pol,Tense] + ; +