mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
factored out linrefs to opers in PredInterface
This commit is contained in:
@@ -43,20 +43,12 @@ lincat
|
||||
linref
|
||||
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
|
||||
= \vp ->
|
||||
let
|
||||
agr = defaultAgr ;
|
||||
vagr = agr2vagr agr ;
|
||||
verb = vp.v ! vagr ;
|
||||
in
|
||||
verb.p1 ++ verb.p2 ++ vp.adV ++ verb.p3 ++ vp.part ++
|
||||
vp.adj ! agr ++ vp.obj1.p1 ! agr ++ vp.obj2.p1 ! agr ++ vp.adv ++ vp.ext ;
|
||||
|
||||
PrCl_none, PrCl_np = \cl -> declCl cl ;
|
||||
PrQCl_none, PrQCl_np = \qcl -> questCl qcl ;
|
||||
PrAdv_none, PrAdv_np = \adv -> strComplCase adv.c1 ++ adv.s ;
|
||||
PrAP_none, PrAP_np = \ap -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ;
|
||||
PrCN_none, PrCN_np = \cn -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ;
|
||||
= linrefPrVP ;
|
||||
PrCl_none, PrCl_np = linrefPrCl ;
|
||||
PrQCl_none, PrQCl_np = linrefPrQCl ;
|
||||
PrAdv_none, PrAdv_np = linrefPrAdv ;
|
||||
---- PrAP_none, PrAP_np = \ap -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ;
|
||||
---- PrCN_none, PrCN_np = \cn -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ;
|
||||
|
||||
----------------------------
|
||||
--- linearization rules ----
|
||||
|
||||
@@ -1,18 +1,16 @@
|
||||
concrete PredFin of Pred =
|
||||
CatFin [Ant,NP,Utt,IP,IAdv,Conj] **
|
||||
-- PredFunctor [NP,Pol,Tense,Ant,Arg, PPos, TPres, ASimul, aNone,
|
||||
-- PrV,PrVP,PrCl,PrS,UseV,PredVP,UseCl]
|
||||
-- - [StartVPC, ContVPC, ---- need generalization
|
||||
-- AgentPassUseV,AgentPastPartAP] ---- moreover slow
|
||||
|
||||
PredFunctor -
|
||||
[StartVPC, ContVPC, AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N]
|
||||
with
|
||||
PredFunctor
|
||||
- [StartVPC, ContVPC
|
||||
---- ,AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N
|
||||
]
|
||||
with
|
||||
(PredInterface = PredInstanceFin)
|
||||
|
||||
** {
|
||||
|
||||
lin
|
||||
StartVPC, ContVPC, AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N
|
||||
StartVPC, ContVPC
|
||||
---- , AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N
|
||||
= variants {} ; ---- just to make it compile as instance of Pred
|
||||
}
|
||||
|
||||
@@ -35,8 +35,8 @@ lincat
|
||||
s1 : Str ;
|
||||
} ;
|
||||
|
||||
PrAdv = {s : Str ; isAdV : Bool ; c1 : ComplCase} ;
|
||||
PrS = {s : Str} ;
|
||||
PrAdv = PrAdverb ;
|
||||
PrS = {s : Str} ;
|
||||
|
||||
PrAP = {
|
||||
s : AAgr => Str ;
|
||||
@@ -53,20 +53,10 @@ lincat
|
||||
-- reference linearizations for chunking
|
||||
|
||||
linref
|
||||
PrVP = \vp ->
|
||||
let
|
||||
agr = defaultAgr ;
|
||||
vagr = agr2vagr agr ;
|
||||
verb = vp.v ! vagr ;
|
||||
in
|
||||
verb.p1 ++ verb.p2 ++ vp.adV ++ verb.p3 ++ vp.part ++
|
||||
vp.adj ! agr ++ vp.obj1.p1 ! agr ++ vp.obj2.p1 ! agr ++ vp.adv ++ vp.ext ;
|
||||
|
||||
PrCl = \cl -> declCl cl ;
|
||||
PrQCl = \qcl -> questCl qcl ;
|
||||
PrAdv = \adv -> strComplCase adv.c1 ++ adv.s ;
|
||||
PrAP = \ap -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ;
|
||||
PrCN = \cn -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ;
|
||||
PrVP = linrefPrVP ;
|
||||
PrCl = linrefPrCl ;
|
||||
PrQCl = linrefPrQCl ;
|
||||
PrAdv = linrefPrAdv ;
|
||||
|
||||
----------------------------
|
||||
--- linearization rules ----
|
||||
|
||||
@@ -1,7 +1,8 @@
|
||||
instance PredInstanceFin of
|
||||
PredInterface - [
|
||||
NounPhrase,
|
||||
PrVerb, initPrVerb
|
||||
PrVerb, initPrVerb,
|
||||
PrVerbPhrase, initPrVerbPhrase, initPrVerbPhraseV, useCopula
|
||||
] =
|
||||
open ResFin, (P = ParadigmsFin), (S = StemFin), (X = ParamX), Prelude in {
|
||||
|
||||
@@ -9,6 +10,7 @@ instance PredInstanceFin of
|
||||
|
||||
oper
|
||||
NounPhrase = ResFin.NP ;
|
||||
|
||||
PrVerb = StemFin.SVerb1 ** {
|
||||
c1 : ComplCase ;
|
||||
c2 : ComplCase ;
|
||||
@@ -17,6 +19,66 @@ oper
|
||||
vvtype : VVType ;
|
||||
} ;
|
||||
|
||||
initPrVerb : PrVerb = {
|
||||
s = \\_ => [] ;
|
||||
sc = subjCase ;
|
||||
h = Back ;
|
||||
p = [] ;
|
||||
c1,c2 = noComplCase ; isSubjectControl = True ; vtype = defaultVType ; 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
|
||||
} ;
|
||||
|
||||
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 = [] ;
|
||||
adV : Str = [] ;
|
||||
ext : Str = [] ;
|
||||
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
|
||||
} ;
|
||||
|
||||
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) ;
|
||||
|
||||
|
||||
---------------------
|
||||
-- parameters -------
|
||||
---------------------
|
||||
@@ -26,8 +88,8 @@ oper
|
||||
Case = ResFin.Case ;
|
||||
NPCase = ResFin.NPForm ;
|
||||
VForm = S.SVForm ;
|
||||
VVType = Unit ; ----ResFin.InfForm ;
|
||||
VType = Unit ; ----
|
||||
VVType = ResFin.InfForm ;
|
||||
VType = Voice ; ----
|
||||
Gender = Unit ; ----
|
||||
|
||||
VAgr = Agr ;
|
||||
@@ -38,7 +100,7 @@ oper
|
||||
active = Act ;
|
||||
passive = Pass ;
|
||||
|
||||
defaultVType = UUnit ;
|
||||
defaultVType = Act ;
|
||||
|
||||
subjCase : NPCase = ResFin.NPCase Nom ;
|
||||
objCase : NPCase = NPAcc ;
|
||||
@@ -75,7 +137,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 = UUnit ; ---- vvInfinitive : VVType = Inf1 ;
|
||||
vvInfinitive : VVType = Inf1 ;
|
||||
|
||||
isRefl : PrVerb -> Bool = \_ -> False ; ----
|
||||
|
||||
@@ -87,16 +149,23 @@ oper
|
||||
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}
|
||||
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}} ;
|
||||
}
|
||||
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
|
||||
|
||||
S.infVPGen -- : Polarity -> NPForm -> Polarity -> Agr -> VP -> InfForm -> Str =
|
||||
ipol sc pol agr vp0 vi ;
|
||||
|
||||
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 ;
|
||||
@@ -147,14 +216,6 @@ oper
|
||||
|
||||
liftV : S.SVerb1 -> PrVerb = \v -> initPrVerb ** v ;
|
||||
|
||||
initPrVerb : PrVerb = {
|
||||
s = \\_ => [] ;
|
||||
sc = subjCase ;
|
||||
h = Back ;
|
||||
p = [] ;
|
||||
c1,c2 = noComplCase ; isSubjectControl = True ; vtype = defaultVType ; vvtype = vvInfinitive
|
||||
} ;
|
||||
|
||||
--- junk
|
||||
|
||||
qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str =
|
||||
@@ -162,5 +223,4 @@ oper
|
||||
qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str =
|
||||
\sta,t,a,p,agr -> <[],[]> ;
|
||||
|
||||
|
||||
}
|
||||
@@ -186,6 +186,24 @@ oper
|
||||
focType : FocusType ; --- if already filled, then use other place: who loves *who*
|
||||
} ;
|
||||
|
||||
PrAdverb = {s : Str ; isAdV : Bool ; c1 : ComplCase} ;
|
||||
|
||||
linrefPrVP : PrVerbPhrase -> Str = \vp ->
|
||||
let
|
||||
agr = defaultAgr ;
|
||||
vagr = agr2vagr agr ;
|
||||
verb = vp.v ! vagr ;
|
||||
in
|
||||
verb.p1 ++ verb.p2 ++ vp.adV ++ verb.p3 ++ vp.part ++
|
||||
vp.adj ! agr ++ vp.obj1.p1 ! agr ++ vp.obj2.p1 ! agr ++ vp.adv ++ vp.ext ;
|
||||
|
||||
linrefPrCl : PrClause -> Str = \cl -> declCl cl ;
|
||||
linrefPrQCl : PrQuestionClause -> Str = \qcl -> questCl qcl ;
|
||||
linrefPrAdv : PrAdverb -> Str = \adv -> strComplCase adv.c1 ++ adv.s ;
|
||||
---- linrefPrAP = \ap -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ;
|
||||
---- linrefPrCN = \cn -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ;
|
||||
|
||||
|
||||
---------------------------
|
||||
---- concrete syntax opers
|
||||
---------------------------
|
||||
|
||||
Reference in New Issue
Block a user