forked from GitHub/gf-core
some refactoring, and experiments with Fin which is still too big in pgf
This commit is contained in:
@@ -3,32 +3,32 @@ concrete LiftFin of Lift =
|
||||
,PredFin
|
||||
|
||||
** open ResFin,
|
||||
StemFin,
|
||||
PredInstanceFin,
|
||||
Prelude in {
|
||||
|
||||
--flags literal=Symb ;
|
||||
|
||||
{-
|
||||
oper
|
||||
liftV = PredInstanceFin.liftV ;
|
||||
vliftV : SVerb1 -> PrVerb = PredInstanceFin.liftV ;
|
||||
|
||||
lin
|
||||
LiftV v = liftV v ;
|
||||
LiftV2 v = <liftV <v : Verb> : 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 = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
|
||||
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} ;
|
||||
|
||||
LiftV3 v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s ; c2 = v.c3.s} ;
|
||||
|
||||
LiftV2S v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
|
||||
LiftV2Q v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
|
||||
LiftV2V v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s ; c2 = v.c3.s} ;
|
||||
LiftV2A v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
|
||||
LiftV2N v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
|
||||
LiftV3 v = vliftV 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} ;
|
||||
{-
|
||||
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
|
||||
|
||||
|
||||
@@ -54,7 +54,7 @@ linref
|
||||
|
||||
PrCl_none, PrCl_np = \cl -> declCl cl ;
|
||||
PrQCl_none, PrQCl_np = \qcl -> questCl qcl ;
|
||||
PrAdv_none, PrAdv_np = \adv -> adv.c1 ++ adv.s ;
|
||||
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 ;
|
||||
|
||||
|
||||
@@ -1,12 +1,18 @@
|
||||
concrete PredFin of Pred =
|
||||
CatFin [Ant,NP,Utt,IP,IAdv,Conj] **
|
||||
PredFunctor - [StartVPC, ContVPC, ---- need generalization
|
||||
AgentPassUseV,AgentPastPartAP] ---- moreover slow
|
||||
-- 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
|
||||
(PredInterface = PredInstanceFin)
|
||||
|
||||
** {
|
||||
|
||||
lin StartVPC, ContVPC, AgentPassUseV, AgentPastPartAP = variants {} ; ---- just to make it compile as instance of Pred
|
||||
|
||||
lin
|
||||
StartVPC, ContVPC, AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N
|
||||
= variants {} ; ---- just to make it compile as instance of Pred
|
||||
}
|
||||
|
||||
@@ -25,12 +25,14 @@ lincat
|
||||
v : VAgr => Str ;
|
||||
inf : Agr => Str ;
|
||||
c1 : ComplCase ;
|
||||
c2 : ComplCase
|
||||
c2 : ComplCase ;
|
||||
s1 : Str ; -- storing both in both-and
|
||||
} ;
|
||||
|
||||
ClC = {
|
||||
s : Str ;
|
||||
c3 : ComplCase ;
|
||||
s1 : Str ;
|
||||
} ;
|
||||
|
||||
PrAdv = {s : Str ; isAdV : Bool ; c1 : ComplCase} ;
|
||||
@@ -88,51 +90,20 @@ lin
|
||||
aNone, aS, aV, aA, aQ, aN = {s = []} ;
|
||||
aNP a = a ;
|
||||
|
||||
UseV x a t p v = {
|
||||
v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p active agr v ;
|
||||
inf = \\vt => tenseInfV a.s a.a p.p active v vt ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
part = v.p ;
|
||||
adj = noObj ;
|
||||
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 Eng
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v ;
|
||||
} ;
|
||||
UseV x a t p v = initPrVerbPhraseV a t p v ;
|
||||
|
||||
PassUseV x a t p v = {
|
||||
PassUseV x a t p v = initPrVerbPhraseV a t p v ** {
|
||||
v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p passive agr v ;
|
||||
inf = \\vt => tenseInfV a.s a.a p.p passive v vt ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
part = v.p ;
|
||||
adj = noObj ;
|
||||
obj1 = <noObj, defaultAgr> ; ---- not used, just default value
|
||||
obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
|
||||
vvtype = v.vvtype ;
|
||||
adV = negAdV p ;
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
|
||||
} ;
|
||||
|
||||
AgentPassUseV x a t p v np = {
|
||||
AgentPassUseV x a t p v np = initPrVerbPhraseV a t p v ** {
|
||||
v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p passive agr v ;
|
||||
inf = \\vt => tenseInfV a.s a.a p.p passive v vt ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
part = v.p ;
|
||||
adj = \\a => [] ;
|
||||
obj1 = <noObj, defaultAgr> ;
|
||||
obj2 = <noObj, True> ;
|
||||
vvtype = v.vvtype ;
|
||||
adV = negAdV p ;
|
||||
obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
|
||||
adv = appComplCase agentCase np ;
|
||||
ext = [] ;
|
||||
qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
|
||||
} ;
|
||||
|
||||
@@ -312,6 +283,7 @@ lin
|
||||
infVP v.vvtype a v ++ c.s2 ++ infVP w.vvtype a w ;
|
||||
c1 = noComplCase ; ---- w.c1 ? --- the full story is to unify v and w...
|
||||
c2 = noComplCase ; ---- w.c2 ?
|
||||
s1 = c.s1 ;
|
||||
} ;
|
||||
|
||||
ContVPC x v w = { ---- some loss of quality seems inevitable
|
||||
@@ -329,45 +301,32 @@ lin
|
||||
infVP v.vvtype a v ++ "," ++ w.inf ! a ;
|
||||
c1 = noComplCase ; ---- w.c1 ? --- the full story is to unify v and w...
|
||||
c2 = noComplCase ; ---- w.c2 ?
|
||||
s1 = w.s1 ;
|
||||
} ;
|
||||
|
||||
UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable
|
||||
v = \\a => <[], [], vpc.v ! a> ;
|
||||
UseVPC x vpc = initPrVerbPhrase ** { ---- big loss of quality (overgeneration) seems inevitable
|
||||
v = \\a => <[], [], vpc.s1 ++ vpc.v ! a> ;
|
||||
inf = \\_ => vpc.inf ! defaultAgr ; ---- agreement
|
||||
c1 = vpc.c1 ;
|
||||
c2 = vpc.c2 ;
|
||||
part = [] ;
|
||||
adj = \\a => [] ;
|
||||
obj1 = <noObj, defaultAgr> ;
|
||||
obj2 = <noObj,True> ;
|
||||
vvtype = vvInfinitive ; ----
|
||||
adv,adV = [] ;
|
||||
ext = [] ;
|
||||
qforms = \\a => <"do", vpc.inf ! defaultAgr> ; ---- do/does/did
|
||||
} ;
|
||||
|
||||
StartClC x c a b = {
|
||||
s = declCl a ++ c.s2 ++ declCl b ;
|
||||
c3 = b.c3 ; ----
|
||||
s1 = c.s1 ;
|
||||
} ;
|
||||
|
||||
ContClC x a b = {
|
||||
s = declCl a ++ "," ++ b.s ;
|
||||
c3 = b.c3 ; ----
|
||||
s1 = b.s1 ;
|
||||
} ;
|
||||
|
||||
UseClC x cl = {
|
||||
subj = [] ;
|
||||
v = <[],[],cl.s> ; ----
|
||||
inf = [] ;
|
||||
adj = [] ;
|
||||
obj1 = [] ;
|
||||
obj2 = [] ;
|
||||
adV = [] ;
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
UseClC x cl = initPrClause ** {
|
||||
v = <[],[], cl.s1 ++ cl.s> ; ----
|
||||
c3 = cl.c3 ;
|
||||
qforms = <[],[]> ; ---- qforms
|
||||
} ;
|
||||
|
||||
ComplAdv x p np = {s = appComplCase p.c1 np ; isAdV = p.isAdV ; c1 = noComplCase} ;
|
||||
|
||||
@@ -23,6 +23,8 @@ oper
|
||||
active : SVoice = Act ;
|
||||
passive : SVoice = Pass ;
|
||||
|
||||
defaultVType : VType = VTAct ;
|
||||
|
||||
subjCase : NPCase = NCase Nom ;
|
||||
objCase : NPCase = NPAcc ;
|
||||
|
||||
|
||||
@@ -1,5 +1,9 @@
|
||||
instance PredInstanceFin of PredInterface - [NounPhrase,PrVerb] =
|
||||
open ResFin, (P = ParadigmsFin), (S = StemFin), (X = ParamX), Prelude in {
|
||||
instance PredInstanceFin of
|
||||
PredInterface - [
|
||||
NounPhrase,
|
||||
PrVerb, initPrVerb
|
||||
] =
|
||||
open ResFin, (P = ParadigmsFin), (S = StemFin), (X = ParamX), Prelude in {
|
||||
|
||||
-- overrides
|
||||
|
||||
@@ -22,7 +26,7 @@ oper
|
||||
Case = ResFin.Case ;
|
||||
NPCase = ResFin.NPForm ;
|
||||
VForm = S.SVForm ;
|
||||
VVType = ResFin.InfForm ;
|
||||
VVType = Unit ; ----ResFin.InfForm ;
|
||||
VType = Unit ; ----
|
||||
Gender = Unit ; ----
|
||||
|
||||
@@ -34,6 +38,8 @@ oper
|
||||
active = Act ;
|
||||
passive = Pass ;
|
||||
|
||||
defaultVType = UUnit ;
|
||||
|
||||
subjCase : NPCase = ResFin.NPCase Nom ;
|
||||
objCase : NPCase = NPAcc ;
|
||||
|
||||
@@ -69,7 +75,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 = UUnit ; ---- vvInfinitive : VVType = Inf1 ;
|
||||
|
||||
isRefl : PrVerb -> Bool = \_ -> False ; ----
|
||||
|
||||
@@ -117,7 +123,7 @@ oper
|
||||
|
||||
tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str =
|
||||
\sa,a,pol,o,v,vt ->
|
||||
let
|
||||
let vt = Inf1 ; ----
|
||||
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 ;
|
||||
@@ -139,8 +145,15 @@ oper
|
||||
|
||||
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} ;
|
||||
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
|
||||
|
||||
|
||||
@@ -21,6 +21,8 @@ oper
|
||||
active = CommonScand.Act ;
|
||||
passive = CommonScand.Pass ;
|
||||
|
||||
defaultVType = VAct ;
|
||||
|
||||
subjCase : NPCase = NPNom ;
|
||||
objCase : NPCase = NPAcc ;
|
||||
|
||||
|
||||
@@ -41,6 +41,8 @@ oper
|
||||
active : SVoice ;
|
||||
passive : SVoice ;
|
||||
|
||||
defaultVType : VType ;
|
||||
|
||||
subjCase : NPCase ;
|
||||
objCase : NPCase ;
|
||||
|
||||
@@ -102,6 +104,16 @@ oper
|
||||
vvtype : VVType ;
|
||||
} ;
|
||||
|
||||
initPrVerb : PrVerb = {
|
||||
s = \\_ => [] ;
|
||||
p = [] ;
|
||||
c1 = noComplCase ;
|
||||
c2 = noComplCase ;
|
||||
isSubjectControl = True ;
|
||||
vtype = defaultVType ;
|
||||
vvtype = vvInfinitive ;
|
||||
} ;
|
||||
|
||||
PrVerbPhrase = {
|
||||
v : VAgr => Str * Str * Str ; -- would,have,slept
|
||||
inf : VVType => Str ; -- (not) ((to)(sleep|have slept) | (sleeping|having slept)
|
||||
@@ -117,6 +129,37 @@ oper
|
||||
ext : Str ;
|
||||
qforms : VAgr => Str * Str -- special Eng for introducing "do" in questions
|
||||
} ;
|
||||
|
||||
initPrVerbPhrase : PrVerbPhrase = {
|
||||
v : VAgr => Str * Str * Str = \\_ => <[],[],[]> ;
|
||||
inf : VVType => Str = \\_ => [] ;
|
||||
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 = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p active agr v ;
|
||||
inf = \\vt => tenseInfV a.s a.a p.p active v vt ;
|
||||
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 Eng
|
||||
qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v ;
|
||||
} ;
|
||||
|
||||
PrClause = {
|
||||
v : Str * Str * Str ;
|
||||
@@ -129,6 +172,15 @@ oper
|
||||
qforms : Str * Str
|
||||
} ;
|
||||
|
||||
initPrClause : PrClause = {
|
||||
v : Str * Str * Str = <[],[],[]> ;
|
||||
adj,obj1,obj2 : Str = [] ;
|
||||
adv,adV,ext : Str = [] ;
|
||||
subj : Str = [] ;
|
||||
c3 : ComplCase = noComplCase ; -- for a slashed adjunct, not belonging to the verb valency
|
||||
qforms : Str * Str = <[],[]>
|
||||
} ;
|
||||
|
||||
PrQuestionClause = PrClause ** {
|
||||
foc : Str ; -- the focal position at the beginning: *who* does she love
|
||||
focType : FocusType ; --- if already filled, then use other place: who loves *who*
|
||||
@@ -170,19 +222,10 @@ oper
|
||||
not_Str : Polarity -> Str ;
|
||||
|
||||
useCopula : {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerbPhrase =
|
||||
\a,t,p -> {
|
||||
\a,t,p -> initPrVerbPhrase ** {
|
||||
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 = noComplCase ;
|
||||
c2 = noComplCase ;
|
||||
part = [] ;
|
||||
adj = \\_ => [] ;
|
||||
obj1 = <noObj,defaultAgr> ;
|
||||
obj2 = <noObj, True> ;
|
||||
vvtype = vvInfinitive ;
|
||||
adV = negAdV p ;
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
|
||||
} ;
|
||||
|
||||
|
||||
Reference in New Issue
Block a user