GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-14 07:19:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

PredFin and NDTransFin finally working

Browse Source
This commit is contained in:
aarne
2014-02-09 20:16:29 +00:00
parent bcabc34527
commit 063fe069af
8 changed files with 252 additions and 121 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
lib/src/experimental/LiftFin.gf
View File

@@ -1,40 +1,38 @@
concrete LiftFin of Lift =
RGLBaseFin - [Pol,Tense]
,PredFin
** open ResFin,
StemFin,
PredInstanceFin,
PredInstanceFin,
Prelude in {
--flags literal=Symb ;
oper
vliftV : SVerb1 -> PrVerb = PredInstanceFin.liftV ;
lin
LiftV v = vliftV v ;
LiftV2 v = vliftV v ** {c1 = v.c2} ;
LiftVS v = vliftV v ;
LiftVQ v = vliftV v ;
LiftVA v = vliftV v ** {c1 = v.c2} ;
LiftVN v = vliftV v ** {c1 = v.c2} ;
LiftVV v = vliftV v ** {vvType = v.vi} ;
LiftV v = liftV v ;
LiftV2 v = liftV v ** {c1 = v.c2} ;
LiftVS v = liftV v ;
LiftVQ v = liftV v ;
LiftVA v = liftV v ** {c1 = v.c2} ;
LiftVN v = liftV v ** {c1 = v.c2} ;
LiftVV v = liftV v ** {vvType = v.vi} ;
LiftV3 v = vliftV v ** {c1 = v.c2 ; c2 = v.c3} ;
LiftV3 v = liftV v ** {c1 = v.c2 ; c2 = v.c3} ;
LiftV2S v = vliftV v ** {c1 = v.c2} ;
LiftV2Q v = vliftV v ** {c1 = v.c2} ;
LiftV2V v = vliftV v ** {c1 = v.c2 ; vvType = v.vi} ;
LiftV2A v = vliftV v ** {c1 = v.c2 ; c2 = v.c3} ;
LiftV2N v = vliftV v ** {c1 = v.c2 ; c2 = v.c3} ;
LiftV2S v = liftV v ** {c1 = v.c2} ;
LiftV2Q v = liftV v ** {c1 = v.c2} ;
LiftV2V v = liftV v ** {c1 = v.c2 ; vvType = v.vi} ;
LiftV2A v = liftV v ** {c1 = v.c2 ; c2 = v.c3} ;
LiftV2N v = liftV v ** {c1 = v.c2 ; c2 = v.c3} ;
LiftAP ap = {s = \\a => ap.s ! False ! NCase (complNumAgr a) Nom ; c1,c2 = noComplCase ; obj1 = \\_ => []} ; --- Part in Pl
---- LiftA2 ap = {s = \\a => ap.s ! AF (APosit (agr2aformpos a)) Nom ; c1 = ap.c2.s ; c2 = noComplCase ; obj1 = \\_ => []} ; --- isPre
LiftCN cn = {s = \\n => cn.s ! NCase n Nom ; c1,c2 = noComplCase ; obj1 = \\_ => []} ;
---- LiftN2 cn = {s = \\n => cn.s ! n ! specDet DIndef ! Nom ; c1 = cn.c2.s ; c2 = [] ; obj1 = \\_ => []} ;
LiftA2,LiftN2,AppAPCN = variants {} ; ---- for functor use
{-
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
@@ -50,11 +48,9 @@ lin
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} ;
-}
LiftAdv a = a ** {isAdV = False ; c1 = noComplCase} ;
LiftAdV a = a ** {isAdV = True ; c1 = noComplCase} ;
LiftPrep p = {s = [] ; isAdV = False ; c1 = p} ;
}

20
lib/src/experimental/NDPred.gf
View File

@@ -11,6 +11,10 @@ cat
PrVP_none ; PrVP_np ; PrVP_v ; PrVP_s ; PrVP_q ; PrVP_a ; PrVP_n ;
PrVP_np_np ; PrVP_np_v ; PrVP_np_s ; PrVP_np_q ; PrVP_np_a ; PrVP_np_n ;
--< PrVPI Arg ; -- infinitive VP
PrVPI_none ;
PrVPI_np ;
--< VPC Arg ; -- conjunction of VP
VPC_none ;
VPC_np ;
@@ -92,9 +96,9 @@ fun
ComplVS_none : PrVP_s -> PrCl_none -> PrVP_none ;
ComplVS_np : PrVP_s -> PrCl_np -> PrVP_np ;
--< ComplVV : (a : Arg) -> PrVP aV -> PrVP a -> PrVP a ; -- she wants to sleep
ComplVV_none : PrVP_v -> PrVP_none -> PrVP_none ;
ComplVV_np : PrVP_v -> PrVP_np -> PrVP_np ;
--< ComplVV : (a : Arg) -> PrVP aV -> PrVPI a -> PrVP a ; -- she wants to sleep
ComplVV_none : PrVP_v -> PrVPI_none -> PrVP_none ;
ComplVV_np : PrVP_v -> PrVPI_np -> PrVP_np ;
--< ComplVQ : (a : Arg) -> PrVP aQ -> PrQCl a -> PrVP a ; -- she wonders who is here
ComplVQ_none : PrVP_q -> PrQCl_none -> PrVP_none ;
@@ -111,9 +115,9 @@ fun
--< SlashV2S : (a : Arg) -> PrVP (aNP aS) -> PrCl a -> PrVP (aNP a) ; -- she tells X that I am here
SlashV2S_none : PrVP_np_s -> PrCl_none -> PrVP_np ;
--< SlashV2V : (a : Arg) -> PrVP (aNP aV) -> PrVP a -> PrVP (aNP a) ; -- she forces X to sleep
SlashV2V_none : PrVP_np_v -> PrVP_none -> PrVP_np ;
SlashV2V_np : PrVP_np_v -> PrVP_np -> PrVP_np_np ;
--< SlashV2V : (a : Arg) -> PrVP (aNP aV) -> PrVPI a -> PrVP (aNP a) ; -- she forces X to sleep
SlashV2V_none : PrVP_np_v -> PrVPI_none -> PrVP_np ;
SlashV2V_np : PrVP_np_v -> PrVPI_np -> PrVP_np_np ;
--< SlashV2A : (a : Arg) -> PrVP (aNP aA) -> PrAP a -> PrVP (aNP a) ; -- she makes X crazy
SlashV2A_none : PrVP_np_a -> PrAP_none -> PrVP_np ;
@@ -139,6 +143,10 @@ fun
--< UseNP : Ant -> Tense -> Pol -> NP -> PrVP aNone ; -- she is the person
UseNP_none : Ant -> Tense -> Pol -> NP -> PrVP_none ;
--< InfVP : (a : Arg) -> PrVP a -> PrVPI a ;
InfVP_none : PrVP_none -> PrVPI_none ;
InfVP_np : PrVP_np -> PrVPI_np ;
--< PredVP : (a : Arg) -> NP -> PrVP a -> PrCl a ;
PredVP_none : NP -> PrVP_none -> PrCl_none ;
PredVP_np : NP -> PrVP_np -> PrCl_np ;

4
lib/src/experimental/NDPredFunctor.gf
View File

@@ -21,6 +21,8 @@ lincat
PrVP_none, PrVP_np, PrVP_v, PrVP_s, PrVP_q, PrVP_a, PrVP_n,
PrVP_np_np, PrVP_np_v, PrVP_np_s, PrVP_np_q, PrVP_np_a, PrVP_np_n = Pred.PrVP ;
PrVPI_none, PrVPI_np = Pred.PrVPI ;
PrCl_none, PrCl_np = Pred.PrCl ;
PrQCl_none, PrQCl_np = Pred.PrQCl ;
@@ -114,6 +116,8 @@ lin
ReflVP2_np
= Pred.ReflVP2 Pred.aNone ;
InfVP_none, InfVP_np
= Pred.InfVP Pred.aNone ;
PredVP_none, PredVP_np
= Pred.PredVP Pred.aNone ;

7
lib/src/experimental/Pred.gf
View File

@@ -4,6 +4,7 @@ cat
Arg ;
PrV Arg ;
PrVP Arg ;
PrVPI Arg ;
VPC Arg ; -- conjunction of VP
Tense ;
Pol ;
@@ -28,17 +29,19 @@ fun
ComplV2 : (a : Arg) -> PrVP (aNP a) -> NP -> PrVP a ; -- she loves him
ComplVS : (a : Arg) -> PrVP aS -> PrCl a -> PrVP a ; -- she says that I am here
ComplVV : (a : Arg) -> PrVP aV -> PrVP a -> PrVP a ; -- she wants to sleep
ComplVV : (a : Arg) -> PrVP aV -> PrVPI a -> PrVP a ; -- she wants to sleep
ComplVQ : (a : Arg) -> PrVP aQ -> PrQCl a -> PrVP a ; -- she wonders who is here
ComplVA : (a : Arg) -> PrVP aA -> PrAP a -> PrVP a ; -- she becomes old
ComplVN : (a : Arg) -> PrVP aN -> PrCN a -> PrVP a ; -- she becomes a professor
SlashV3 : (a : Arg) -> PrVP (aNP (aNP a)) -> NP -> PrVP (aNP a) ; -- she shows X to him
SlashV2S : (a : Arg) -> PrVP (aNP aS) -> PrCl a -> PrVP (aNP a) ; -- she tells X that I am here
SlashV2V : (a : Arg) -> PrVP (aNP aV) -> PrVP a -> PrVP (aNP a) ; -- she forces X to sleep
SlashV2V : (a : Arg) -> PrVP (aNP aV) -> PrVPI a -> PrVP (aNP a) ; -- she forces X to sleep
SlashV2A : (a : Arg) -> PrVP (aNP aA) -> PrAP a -> PrVP (aNP a) ; -- she makes X crazy
SlashV2N : (a : Arg) -> PrVP (aNP aN) -> PrCN a -> PrVP (aNP a) ; -- she makes X a professor
SlashV2Q : (a : Arg) -> PrVP (aNP aA) -> PrQCl a -> PrVP (aNP a) ; -- she asks X who is here
InfVP : (a : Arg) -> PrVP a -> PrVPI a ; -- to love X
UseAP : (a : Arg) -> Ant -> Tense -> Pol -> PrAP a -> PrVP a ; -- she is married to X
UseAdv : (a : Arg) -> Ant -> Tense -> Pol -> PrAdv a -> PrVP a ; -- she is in X
UseCN : (a : Arg) -> Ant -> Tense -> Pol -> PrCN a -> PrVP a ; -- she is a member of X

89
lib/src/experimental/PredFin.gf
View File

@@ -1,16 +1,83 @@
--# -path=.:../finnish/stemmed:../finnish:../common:alltenses
concrete PredFin of Pred =
CatFin [Ant,NP,Utt,IP,IAdv,Conj] **
PredFunctor
- [StartVPC, ContVPC
---- ,AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N
]
with
(PredInterface = PredInstanceFin)
- [
UseVPC,StartVPC,ContVPC
** {
,PresPartAP
,PastPartAP,AgentPastPartAP
,PassUseV, AgentPassUseV
lin
StartVPC, ContVPC
---- , AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N
= variants {} ; ---- just to make it compile as instance of Pred
}
,UseV --
,UseCN --
,UseAP --
,QuestVP --
,PredVP --
,ComplV2 --
,ReflVP2,ReflVP --
]
with
(PredInterface = PredInstanceFin) ** open PredInstanceFin, ResFin in {
lin
UseV x a t p verb = initPrVerbPhraseV a t p verb ;
ComplV2 x vp np = vp ** {
obj1 = \\_ => appCompl True Pos vp.c1 np ;
} ;
PredVP x np vp = vp ** {
subj : Str = appSubjCase vp.sc np ;
verb : {fin,inf : Str} = vp.v ! np.a ;
obj1 : Str = vp.obj1 ! np.a ;
obj2 : Str = vp.obj2 ! np.a ;
c3 : Compl = noComplCase ;
} ;
UseAP x a t p ap = useCopula a t p ** {
c1 = ap.c1 ;
c2 = ap.c2 ;
obj1 = \\a => ap.s ! agr2aagr a ;
} ;
UseCN x a t p cn = useCopula a t p ** {
c1 = cn.c1 ;
c2 = cn.c2 ;
obj1 = \\a => cn.s ! agr2nagr a ;
} ;
ReflVP x vp = vp ** {
obj1 = \\a => (reflPron a).s ! vp.c1.c ; ---- prep
} ;
ReflVP2 x vp = vp ** {
obj2 = \\a => (reflPron a).s ! vp.c2.c ; ---- prep
} ;
QuestVP x ip vp =
let
ipa = ipagr2agr ip.n
in vp ** {
foc = ip.s ! subjCase ; ---- appSubjCase ip
focType = FocSubj ;
subj = [] ;
verb : {fin,inf : Str} = vp.v ! ipa ;
obj1 : Str = vp.obj1 ! ipa ;
obj2 : Str = vp.obj2 ! ipa ;
c3 : Compl = noComplCase ;
qforms = \\_ => <[],[]> ;
} ;
UseVPC,StartVPC,ContVPC
,PresPartAP
,PastPartAP,AgentPastPartAP
,PassUseV, AgentPassUseV
= variants {} ;
}

17
lib/src/experimental/PredFunctor.gf
View File

@@ -21,6 +21,8 @@ lincat
PrQCl = PrQuestionClause ;
PrVPI = {s : PredInterface.VVType => Agr => Str} ;
VPC = {
v : VAgr => Str ;
inf : Agr => Str ;
@@ -128,7 +130,7 @@ lin
ComplVQ x vp qcl = addExtVP vp (questSubordCl qcl) ; ---- question form
ComplVV x vp vpo = addObj2VP vp (\\a => infVP vp.vvtype a vpo) ;
ComplVV x vp vpo = addObj2VP vp (\\a => vpo.s ! vp.vvtype ! a) ;
ComplVA x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm
@@ -140,7 +142,7 @@ lin
SlashV2Q x vp cl = addExtVP vp (questSubordCl cl) ; ---- question form
SlashV2V x vp vpo = addObj2VP vp (\\a => infVP vp.vvtype a (lin VP vpo)) ;
SlashV2V x vp vpo = addObj2VP vp (\\a => vpo.s ! vp.vvtype ! a) ;
SlashV2A x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm
@@ -154,14 +156,16 @@ lin
obj2 = <\\a => reflPron a, vp.obj2.p2> ; --- subj/obj control doesn't matter any more
} ;
InfVP x vp = {s = \\vvt,a => infVP vvt a vp} ;
PredVP x np vp = vp ** {
v = vp.v ! agr2vagr np.a ;
v = applyVerb vp (agr2vagr np.a) ;
subj = np.s ! subjCase ;
adj = vp.adj ! np.a ;
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 ;
qforms = qformsVP vp (agr2vagr np.a) ;
} ;
SlashClNP x cl np = cl ** { -- Cl ::= Cl/NP NP
@@ -177,7 +181,7 @@ lin
let
ipa = ipagr2agr ip.n
in {
v = vp.v ! ipagr2vagr ip.n ;
v = applyVerb vp (ipagr2vagr ip.n) ;
foc = ip.s ! subjCase ; -- who (loves her)
focType = FocSubj ;
subj = [] ;
@@ -188,10 +192,9 @@ lin
adv = vp.adv ;
adV = vp.adV ;
ext = vp.ext ;
qforms = vp.qforms ! ipagr2vagr ip.n ;
qforms = qformsVP vp (ipagr2vagr ip.n) ;
} ;
QuestSlash x ip cl =
let
prep = cl.c3 ;

177
lib/src/experimental/PredInstanceFin.gf
View File

@@ -1,8 +1,9 @@
instance PredInstanceFin of
PredInterface - [
NounPhrase,
NounPhrase,
PrVerb, initPrVerb,
PrVerbPhrase, initPrVerbPhrase, initPrVerbPhraseV, useCopula
PrVerbPhrase, initPrVerbPhrase, initPrVerbPhraseV, useCopula, linrefPrVP, qformsVP, applyVerb, addObj2VP,
PrClause, initPrClause
] =
open ResFin, (P = ParadigmsFin), (S = StemFin), (X = ParamX), Prelude in {
@@ -14,70 +15,103 @@ oper
PrVerb = StemFin.SVerb1 ** {
c1 : ComplCase ;
c2 : ComplCase ;
isSubjectControl : Bool ;
vtype : VType ;
vvtype : VVType ;
} ;
initPrVerb : PrVerb = {
s = \\_ => [] ;
sc = subjCase ;
sc = SCNom ;
h = Back ;
p = [] ;
c1,c2 = noComplCase ; isSubjectControl = True ; vtype = defaultVType ; vvtype = vvInfinitive
c1,c2 = noComplCase ; isSubjectControl = True ; vtype = Act ; vvtype = vvInfinitive
} ;
PrVerbPhrase = {
v : S.SVerb1 ;
atp : {a : Anteriority ; t : STense ; p : Polarity ; as,ts,ps : Str} ;
vtype : VType ;
c1 : ComplCase ;
c2 : ComplCase ;
part : Str ; -- (look) up
adj : Agr => Str ;
obj1 : (Agr => Str) * Agr ; -- agr for object control
obj2 : (Agr => Str) * Bool ; -- subject control = True
vvtype : VVType ; -- type of VP complement
adv : Str ;
adV : Str ;
ext : Str
v : Agr => {fin,inf : Str} ;
inf : VVType => Str ;
obj1 : Agr => Str ; -- Bool => Polarity => Agr => Str ; -- talo/talon/taloa
obj2 : Agr => Str ; -- Bool => Polarity => Agr => Str ; -- talo/talon/taloa
adv : Str ; -- Polarity => Str ; -- ainakin/ainakaan
adV : Str ; -- Polarity => Str ; -- ainakin/ainakaan
ext : Str ;
isNeg : Bool ; -- True if some complement is negative
isPass : Bool ; -- True if the verb is rendered in the passive
vvtype : VVType ;
sc : SubjCase ;
h : Harmony ;
c1 : Compl ;
c2 : Compl ;
qforms : VAgr => Str * Str ;
} ;
initPrVerbPhrase : PrVerbPhrase = {
v : S.SVerb1 = initPrVerb ;
atp = {a = Simul ; t = Pres ; p = Pos ; as,ts,ps = []} ;
vtype = defaultVType ;
c1 : ComplCase = noComplCase ;
c2 : ComplCase = noComplCase ;
part : Str = [] ; -- (look) up
adj : Agr => Str = noObj ;
obj1 : (Agr => Str) * Agr = <\\_ => [], defaultAgr> ; -- agr for object control
obj2 : (Agr => Str) * Bool = <\\_ => [], True>; -- subject control = True
vvtype : VVType = vvInfinitive ; -- type of VP complement
adv : Str = [] ;
v : Agr => {fin,inf : Str} = \\_ => {fin,inf = []} ;
inf : VVType => Str = \\vtt => [] ;
obj1 : Agr => Str = \\_ => [] ;
obj2 : Agr => Str = \\_ => [] ;
adv : Str = [] ;
adV : Str = [] ;
ext : Str = [] ;
isNeg : Bool = True ;
isPass : Bool = False ;
c1 : Compl = noComplCase ;
c2 : Compl = noComplCase ;
vvtype = defaultVVType ;
sc = SCNom ;
h = Back ;
qforms : VAgr => Str * Str = \\_ => <[],[]> -- special Eng for introducing "do" in questions
} ;
initPrVerbPhraseV :
{s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerb -> PrVerbPhrase =
\a,t,p,v -> initPrVerbPhrase ** {
v : S.SVerb1 = v ;
atp = {a = a.a ; t = t.t ; p = p.p ; as = a.s ; ts = t.s ; ps = p.s} ;
vtype = v.vtype ;
c1 = v.c1 ;
c2 = v.c2 ;
part = v.p ;
obj1 = <case isRefl v of {True => \\a => reflPron a ; _ => \\_ => []}, defaultAgr> ; ---- not used, just default value
obj2 = <noObj, v.isSubjectControl> ;
vvtype = v.vvtype ;
adV = negAdV p ; --- just p.s in Fin
\a,t,p,verb ->
initPrVerbPhrase ** {
v : Agr => {fin,inf : Str} = case verb.sc of {
SCNom => \\agr => finV (a.s ++ t.s ++ p.s) t.t a.a p.p Act agr (lin PrV verb) ;
_ => \\_ => finV (a.s ++ t.s ++ p.s) t.t a.a p.p Act defaultAgr (lin PrV verb)
} ;
inf : VVType => Str = \\vtt => infV (a.s ++ p.s) a.a p.p Act (lin PrV verb) vtt ;
obj1 : Agr => Str = \\_ => [] ;
obj2 : Agr => Str = \\_ => [] ;
adv : Str = [] ;
adV : Str = [] ;
ext : Str = [] ;
isNeg : Bool = True ;
isPass : Bool = False ;
c1 : Compl = verb.c1 ;
c2 : Compl = verb.c2 ;
vvtype = verb.vvtype ;
sc = verb.sc ;
h = case a.a of {Anter => Back ; _ => verb.h} ;
} ;
useCopula : {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerbPhrase =
\a,t,p -> initPrVerbPhraseV a t p (liftV P.olla_V) ;
linrefPrVP : PrVerbPhrase -> Str = \_ -> "verbphrase" ; ----
PrClause = {
subj : Str ;
verb : {fin,inf : Str} ;
obj1 : Str ;
obj2 : Str ;
adv : Str ;
adV : Str ;
ext : Str ;
h : Harmony ;
c3 : Compl ;
} ;
initPrClause : PrClause = {
subj : Str = [] ;
verb : {fin,inf : Str} = {fin,inf = []} ;
obj1 : Str = [] ;
obj2 : Str = [] ;
adv : Str = [] ;
adV : Str = [] ;
ext : Str = [] ;
h : Harmony = Back ;
c3 : Compl = noComplCase ;
} ;
---------------------
-- parameters -------
@@ -88,7 +122,7 @@ oper
Case = ResFin.Case ;
NPCase = ResFin.NPForm ;
VForm = S.SVForm ;
VVType = ResFin.InfForm ;
VVType = ResFin.VVType ;
VType = Voice ; ----
Gender = Unit ; ----
@@ -101,13 +135,14 @@ oper
passive = Pass ;
defaultVType = Act ;
defaultVVType = VVInf ;
subjCase : NPCase = ResFin.NPCase Nom ;
objCase : NPCase = NPAcc ;
ComplCase = ResFin.Compl ; -- preposition
agentCase : ComplCase = P.postGenPrep "toimesta" ;
strComplCase : ComplCase -> Str = \c -> c.s ! False ;
strComplCase : ComplCase -> Str = \c -> c.s.p1 ++ c.s.p2 ;
appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> appCompl True Pos p np ;
noComplCase : ComplCase = P.postGenPrep [] ; ----
@@ -137,7 +172,7 @@ oper
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 ;
vvInfinitive : VVType = VVInf ;
isRefl : PrVerb -> Bool = \_ -> False ; ----
@@ -149,36 +184,39 @@ oper
oper
reflPron : Agr -> Str = \a -> (ResFin.reflPron a).s ! NPAcc ; ---- case
infVP : VVType -> Agr -> PrVerbPhrase -> Str = \vt, a, pvp ->
let
ipol = pvp.atp.p ;
sc = pvp.v.sc ;
pol = Pos ; ----
agr = a ;
vi = vt ;
vp0 : S.VP = {
s = pvp.v ;
s2 = \\b,p,agr => pvp.obj1.p1 ! agr ++ pvp.obj2.p1 ! agr ;
adv = \\_ => pvp.adV ++ pvp.adv ;
ext = pvp.ext ;
vptyp = {isNeg = False ; isPass = case pvp.vtype of {Pass => True ; _ => False}} ;
}
finV : Str -> STense -> Anteriority -> Polarity -> SVoice -> Agr -> PrVerb -> {fin,inf : 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} ;
in
S.infVPGen -- : Polarity -> NPForm -> Polarity -> Agr -> VP -> InfForm -> Str =
ipol sc pol agr vp0 vi ;
{fin = sta ++ ovps.fin ; inf = ovps.inf} ;
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 ;
infV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str =
\sa,a,pol,o,v,vvt ->
let
vt = Inf1 ; ----vvtype2inform vvt
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 ;
questCl : PrQuestionClause -> Str = \cl -> cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
infVP : VVType -> Agr -> PrVerbPhrase -> Str = \vvt,agr,vp ->
vp.inf ! vvt ++ vp.adV ++ vp.obj1 ! agr ++ vp.obj2 ! agr ++ vp.adv ++ vp.ext ;
declCl : PrClause -> Str = \cl ->
cl.subj ++ cl.verb.fin ++ cl.adV ++ cl.verb.inf ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ;
declSubordCl : PrClause -> Str = declCl ;
declInvCl : PrClause -> Str = declCl ; ---
questCl : PrQuestionClause -> Str = \cl ->
cl.verb.fin ++ Predef.BIND ++ "ko" ++ cl.subj ++ cl.adV ++ cl.verb.inf ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ;
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
--- restCl : PrClause -> Str = \cl -> cl.v.p3 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ++ cl.c3.s.p1 ++ cl.c3.s.p2 ; ---- c3
negAdV : {s : Str ; p : Polarity} -> Str = \p -> p.s ;
@@ -204,8 +242,11 @@ oper
noObj : Agr => Str = \\_ => [] ;
applyVerb : PrVerbPhrase -> VAgr -> {inf,fin : Str}
= \vp,agr -> vp.v ! agr ;
addObj2VP : PrVerbPhrase -> (Agr => Str) -> PrVerbPhrase = \vp,obj -> vp ** {
obj2 = <\\a => vp.obj2.p1 ! a ++ obj ! a, vp.obj2.p2> ;
obj2 = \\a => vp.obj2 ! a ++ obj ! a ;
} ;
addExtVP : PrVerbPhrase -> Str -> PrVerbPhrase = \vp,ext -> vp ** {
@@ -223,4 +264,8 @@ oper
qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str =
\sta,t,a,p,agr -> <[],[]> ;
qformsVP : PrVerbPhrase -> VAgr -> Str * Str
= \vp,vagr -> <[],[]> ;
}

5
lib/src/experimental/PredInterface.gf
View File

@@ -84,10 +84,15 @@ oper
isRefl : PrVerb -> Bool ;
applyVerb : PrVerbPhrase -> VAgr -> Str * Str * Str
= \vp,a -> vp.v ! a ;
--- only needed in Eng because of do questions
qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str ;
qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str ;
qformsVP : PrVerbPhrase -> VAgr -> Str * Str
= \vp,vagr -> vp.qforms ! vagr ;
-------------------------------
--- type synonyms