msyds/gf-rgl
1
0
Fork 0
forked from GitHub/gf-rgl
Code Pull Requests Activity

Moved src/experimental and src/parametric to a branch 'experimental'

Browse Source
This commit is contained in:
Inari Listenmaa
2020-06-05 22:02:44 +02:00
parent c493a476dc
commit c686004c4a
75 changed files with 0 additions and 76505 deletions
Download Patch File Download Diff File Expand all files Collapse all files

91
src/experimental/Chunk.gf
View File

@@ -1,91 +0,0 @@
abstract Chunk = RGLBase - [Pol,Tense], NDPred ** {
cat
Chunks ;
Chunk ;
fun
OneChunk : Chunk -> Chunks ;
PlusChunk : Chunk -> Chunks -> Chunks ;
ChunkPhr : Chunks -> Phr ;
fun
AP_Chunk : AP -> Chunk ;
AdA_Chunk : AdA -> Chunk ;
Adv_Chunk : Adv -> Chunk ;
AdV_Chunk : AdV -> Chunk ;
AdN_Chunk : AdN -> Chunk ;
Cl_Chunk : PrCl_none -> Chunk ;
Cl_np_Chunk : PrCl_np -> Chunk ;
QCl_Chunk : PrQCl_none -> Chunk ;
QCl_np_Chunk : PrQCl_np -> Chunk ;
CN_Pl_Chunk : CN -> Chunk ;
CN_Sg_Chunk : CN -> Chunk ;
CN_Pl_Gen_Chunk : CN -> Chunk ;
CN_Sg_Gen_Chunk : CN -> Chunk ;
Conj_Chunk : Conj -> Chunk ;
IAdv_Chunk : IAdv -> Chunk ;
IP_Chunk : IP -> Chunk ;
NP_Nom_Chunk : NP -> Chunk ;
NP_Acc_Chunk : NP -> Chunk ;
NP_Gen_Chunk : NP -> Chunk ;
Numeral_Nom_Chunk : Numeral -> Chunk ;
Numeral_Gen_Chunk : Numeral -> Chunk ;
Ord_Nom_Chunk : Ord -> Chunk ;
Ord_Gen_Chunk : Ord -> Chunk ;
Predet_Chunk : Predet -> Chunk ;
Prep_Chunk : Prep -> Chunk ;
RP_Nom_Chunk : RP -> Chunk ;
RP_Gen_Chunk : RP -> Chunk ;
RP_Acc_Chunk : RP -> Chunk ;
Subj_Chunk : Subj -> Chunk ;
VP_none_Chunk, VP_none_inf_Chunk : PrVP_none -> Chunk ;
VP_np_Chunk, VP_np_inf_Chunk : PrVP_np -> Chunk ;
VP_s_Chunk, VP_s_inf_Chunk : PrVP_s -> Chunk ;
VP_v_Chunk, VP_v_inf_Chunk : PrVP_v -> Chunk ;
VP_a_Chunk, VP_a_inf_Chunk : PrVP_a -> Chunk ;
VP_q_Chunk, VP_q_inf_Chunk : PrVP_q -> Chunk ;
VP_np_np_Chunk, VP_np_np_inf_Chunk : PrVP_np_np -> Chunk ;
VP_np_s_Chunk, VP_np_s_inf_Chunk : PrVP_np_s -> Chunk ;
VP_np_v_Chunk, VP_np_v_inf_Chunk : PrVP_np_v -> Chunk ;
VP_np_q_Chunk, VP_np_q_inf_Chunk : PrVP_np_q -> Chunk ;
VP_np_a_Chunk, VP_np_a_inf_Chunk : PrVP_np_a -> Chunk ;
V_none_prespart_Chunk, V_none_pastpart_Chunk : PrV_none -> Chunk ;
V_np_prespart_Chunk, V_np_pastpart_Chunk : PrV_np -> Chunk ;
V_s_prespart_Chunk, V_s_pastpart_Chunk : PrV_s -> Chunk ;
V_v_prespart_Chunk, V_v_pastpart_Chunk : PrV_v -> Chunk ;
V_q_prespart_Chunk, V_q_pastpart_Chunk : PrV_q -> Chunk ;
V_a_prespart_Chunk, V_a_pastpart_Chunk : PrV_q -> Chunk ;
V_np_np_prespart_Chunk, V_np_np_pastpart_Chunk : PrV_np_np -> Chunk ;
V_np_s_prespart_Chunk, V_np_s_pastpart_Chunk : PrV_np_s -> Chunk ;
V_np_v_prespart_Chunk, V_np_v_pastpart_Chunk : PrV_np_v -> Chunk ;
V_np_q_prespart_Chunk, V_np_q_pastpart_Chunk : PrV_np_q -> Chunk ;
V_np_a_prespart_Chunk, V_np_a_pastpart_Chunk : PrV_np_q -> Chunk ;
refl_SgP1_Chunk,
refl_SgP2_Chunk,
refl_SgP3_Chunk,
refl_PlP1_Chunk,
refl_PlP2_Chunk,
refl_PlP3_Chunk : Chunk ;
neg_Chunk : Chunk ;
copula_Chunk : Chunk ;
copula_neg_Chunk : Chunk ;
copula_inf_Chunk : Chunk ;
past_copula_Chunk : Chunk ;
past_copula_neg_Chunk : Chunk ;
future_Chunk : Chunk ;
future_neg_Chunk : Chunk ;
cond_Chunk : Chunk ;
cond_neg_Chunk : Chunk ;
perfect_Chunk : Chunk ;
perfect_neg_Chunk : Chunk ;
past_perfect_Chunk : Chunk ;
past_perfect_neg_Chunk : Chunk ;
}

128
src/experimental/ChunkChi.gf
View File

@@ -1,128 +0,0 @@
concrete ChunkChi of Chunk =
RGLBaseChi - [Pol,Tense,Ant],
NDPredChi
** open (PI=PredInstanceChi), ResChi, Prelude in {
lincat
Chunks = {s : Str} ;
Chunk = {s : Str};
lin
OneChunk c = c ;
PlusChunk c cs = cc2 c cs ;
ChunkPhr c = ss ("*" ++ c.s) | c ;
lin
AP_Chunk ap = ap ;
AdA_Chunk ada = ada ;
Adv_Chunk adv = adv ;
AdV_Chunk adv = adv ;
AdN_Chunk adn = adn ;
Cl_Chunk, Cl_np_Chunk = \cl -> ss (PI.declCl cl) ;
QCl_Chunk, QCl_np_Chunk = \cl -> ss (PI.questCl cl) ;
CN_Pl_Chunk cn = cn ;
CN_Sg_Chunk cn = cn ;
CN_Pl_Gen_Chunk cn = ss (cn.s ++ de_s) ;
CN_Sg_Gen_Chunk cn = ss (cn.s ++ de_s) ;
Conj_Chunk conj = ss (conj.s ! CSent).s2 ;
IAdv_Chunk iadv = iadv ;
IP_Chunk ip = ip ;
NP_Nom_Chunk np = np ;
NP_Acc_Chunk np = np ;
NP_Gen_Chunk np = ss (np.s ++ de_s) ;
Numeral_Nom_Chunk num = ss (num.s ++ ge_s) ;
Numeral_Gen_Chunk num = ss (num.s ++ ge_s ++ de_s) ;
Ord_Nom_Chunk ord = ord ;
Ord_Gen_Chunk ord = ord ;
Predet_Chunk predet = predet ;
Prep_Chunk prep = ss (prep.prepPre ++ prep.prepPost) ;
RP_Nom_Chunk rp = rp ;
RP_Acc_Chunk rp = rp ;
RP_Gen_Chunk rp = ss (rp.s ++ de_s) ;
Subj_Chunk subj = ss (subj.prePart ++ subj.sufPart) ;
VP_none_Chunk,
VP_np_Chunk,
VP_s_Chunk,
VP_v_Chunk,
VP_a_Chunk,
VP_q_Chunk,
VP_np_np_Chunk,
VP_np_s_Chunk,
VP_np_a_Chunk,
VP_np_q_Chunk,
VP_np_v_Chunk
= \vp ->
let verb = vp.v ! PI.UUnit
in ss (
verb.p1 ++ vp.adV ++ vp.adv ++ verb.p2 ++ verb.p3 ++ vp.part ++
vp.adj ! PI.UUnit ++ vp.obj1.p1 ! PI.UUnit ++ vp.obj2.p1 ! PI.UUnit ++ vp.ext
) ;
VP_none_inf_Chunk,
VP_np_inf_Chunk,
VP_s_inf_Chunk,
VP_a_inf_Chunk,
VP_q_inf_Chunk,
VP_v_inf_Chunk,
VP_np_np_inf_Chunk,
VP_np_s_inf_Chunk,
VP_np_a_inf_Chunk,
VP_np_q_inf_Chunk,
VP_np_v_inf_Chunk
= \vp -> ss (PI.infVP PI.UUnit PI.UUnit vp) ;
V_none_prespart_Chunk,
V_np_prespart_Chunk,
V_s_prespart_Chunk,
V_a_prespart_Chunk,
V_q_prespart_Chunk,
V_v_prespart_Chunk,
V_np_np_prespart_Chunk,
V_np_s_prespart_Chunk,
V_np_a_prespart_Chunk,
V_np_q_prespart_Chunk,
V_np_v_prespart_Chunk
= \v -> ss (PI.vPresPart v PI.defaultAgr) ;
V_none_pastpart_Chunk,
V_np_pastpart_Chunk,
V_s_pastpart_Chunk,
V_a_pastpart_Chunk,
V_q_pastpart_Chunk,
V_v_pastpart_Chunk,
V_np_np_pastpart_Chunk,
V_np_s_pastpart_Chunk,
V_np_a_pastpart_Chunk,
V_np_q_pastpart_Chunk,
V_np_v_pastpart_Chunk
= \v -> ss (PI.vPastPart v PI.defaultAgr) ;
copula_inf_Chunk = ss "att vara" | ss "vara" ;
refl_SgP1_Chunk = ss reflPron ;
refl_SgP2_Chunk = ss reflPron ;
refl_SgP3_Chunk = ss reflPron ;
refl_PlP1_Chunk = ss reflPron ;
refl_PlP2_Chunk = ss reflPron ;
refl_PlP3_Chunk = ss reflPron ;
neg_Chunk = ss neg_s ;
copula_Chunk = ss copula_s ;
copula_neg_Chunk = ss (neg_s ++ copula_s) ;
past_copula_Chunk = ss "了" ;
past_copula_neg_Chunk = ss (neg_s ++ copula_s ++ "了") ;
future_Chunk = ss copula_s ; ----
future_neg_Chunk = ss (neg_s ++ copula_s) ;
cond_Chunk = ss copula_s ; ----
cond_neg_Chunk = ss (neg_s ++ copula_s) ;
perfect_Chunk = ss "了" ;
perfect_neg_Chunk = ss (neg_s ++ copula_s ++ "了") ;
past_perfect_Chunk = ss "了" ;
past_perfect_neg_Chunk = ss (neg_s ++ copula_s ++ "了") ;
}

138
src/experimental/ChunkEng.gf
View File

@@ -1,138 +0,0 @@
concrete ChunkEng of Chunk =
RGLBaseEng - [Pol,Tense],
NDPredEng
** open (PI=PredInstanceEng), ResEng, Prelude in {
lincat
Chunks = {s : Str} ;
Chunk = {s : Str};
lin
OneChunk c = c ;
PlusChunk c cs = cc2 c cs ;
ChunkPhr c = ss ("*" ++ c.s) | c ;
lin
AP_Chunk ap = allAgrSS (\a -> ap.s ! a) ;
AdA_Chunk ada = ada ;
Adv_Chunk adv = adv ;
AdV_Chunk adv = adv ;
AdN_Chunk adn = adn ;
Cl_Chunk, Cl_np_Chunk = \cl -> ss (PI.declCl cl) ;
QCl_Chunk, QCl_np_Chunk = \cl -> ss (PI.questCl cl) ;
CN_Pl_Chunk cn = ss (cn.s ! Pl ! Nom) ;
CN_Sg_Chunk cn = ss (cn.s ! Sg ! Nom) ;
CN_Pl_Gen_Chunk cn = ss (cn.s ! Pl ! Gen) ;
CN_Sg_Gen_Chunk cn = ss (cn.s ! Sg ! Gen) ;
Conj_Chunk conj = ss conj.s2 ;
IAdv_Chunk iadv = iadv ;
IP_Chunk ip = ss (ip.s ! NCase Nom) ;
NP_Nom_Chunk np = ss (np.s ! NCase Nom) ;
NP_Acc_Chunk np = ss (np.s ! NPAcc) ;
NP_Gen_Chunk np = ss (np.s ! NCase Gen) | ss (np.s ! NPNomPoss) ;
Numeral_Nom_Chunk num = ss (num.s ! NCard ! Nom) ;
Numeral_Gen_Chunk num = ss (num.s ! NCard ! Gen) ;
Ord_Nom_Chunk ord = ss (ord.s ! Nom) ;
Ord_Gen_Chunk ord = ss (ord.s ! Gen) ;
Predet_Chunk predet = predet ;
Prep_Chunk prep = prep ;
RP_Nom_Chunk rp = ss (rp.s ! RC Neutr (NCase Nom)) ;
RP_Acc_Chunk rp = ss (rp.s ! RPrep Masc) ; ----
RP_Gen_Chunk rp = ss (rp.s ! RC Neutr (NCase Gen)) ;
Subj_Chunk subj = subj ;
VP_none_Chunk,
VP_np_Chunk,
VP_s_Chunk,
VP_v_Chunk,
VP_a_Chunk,
VP_q_Chunk,
VP_np_np_Chunk,
VP_np_s_Chunk,
VP_np_a_Chunk,
VP_np_q_Chunk,
VP_np_v_Chunk
= \vp ->
let verb = vp.v ! (PI.VASgP1 | PI.VASgP3 | PI.VAPl)
in
allAgrSS (\a ->
verb.p1 ++ verb.p2 ++ vp.adV ++ verb.p3 ++ vp.part ++
vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a ++ vp.adv ++ vp.ext
) ;
VP_none_inf_Chunk,
VP_np_inf_Chunk,
VP_s_inf_Chunk,
VP_a_inf_Chunk,
VP_q_inf_Chunk,
VP_v_inf_Chunk,
VP_np_np_inf_Chunk,
VP_np_s_inf_Chunk,
VP_np_a_inf_Chunk,
VP_np_q_inf_Chunk,
VP_np_v_inf_Chunk
= \vp -> allAgrSS (\a -> PI.infVP (VVInf | VVAux) a vp) ;
V_none_prespart_Chunk,
V_np_prespart_Chunk,
V_s_prespart_Chunk,
V_a_prespart_Chunk,
V_q_prespart_Chunk,
V_v_prespart_Chunk,
V_np_np_prespart_Chunk,
V_np_s_prespart_Chunk,
V_np_a_prespart_Chunk,
V_np_q_prespart_Chunk,
V_np_v_prespart_Chunk
= \v -> ss (PI.vPresPart v PI.defaultAgr) ;
V_none_pastpart_Chunk,
V_np_pastpart_Chunk,
V_s_pastpart_Chunk,
V_a_pastpart_Chunk,
V_q_pastpart_Chunk,
V_v_pastpart_Chunk,
V_np_np_pastpart_Chunk,
V_np_s_pastpart_Chunk,
V_np_a_pastpart_Chunk,
V_np_q_pastpart_Chunk,
V_np_v_pastpart_Chunk
= \v -> ss (PI.vPastPart v PI.defaultAgr) ;
copula_inf_Chunk = ss "to be" | ss "be" ;
refl_SgP1_Chunk = ss "myself" ;
refl_SgP2_Chunk = ss "yourself" ;
refl_SgP3_Chunk = ss "himself" | ss "herself" | ss "itself" ;
refl_PlP1_Chunk = ss "ourselves" ;
refl_PlP2_Chunk = ss "yourselves" ;
refl_PlP3_Chunk = ss "themselves" ;
neg_Chunk = ss "not" | ss "doesn't" | ss "don't" ;
copula_Chunk = ss "is" | ss "are" | ss "am" ;
copula_neg_Chunk = ss "isn't" | ss "aren't" ;
past_copula_Chunk = ss "was" | ss "were" ;
past_copula_neg_Chunk = ss "wasn't" | ss "weren't" ;
future_Chunk = ss "will" ;
future_neg_Chunk = ss "won't" ;
cond_Chunk = ss "would" ;
cond_neg_Chunk = ss "wouldn't" ;
perfect_Chunk = ss "has" | ss "have" ;
perfect_neg_Chunk = ss "hasn't" | ss "haven't" ;
past_perfect_Chunk = ss "had" ;
past_perfect_neg_Chunk = ss "hadn't" ;
oper
allAgrSS : (Agr -> Str) -> SS = \f ->
ss (f (AgP3Sg Masc)) ;
---- | ss (f (AgP3Sg Fem)) | ss (f (AgP3Sg Neutr)) |
---- ss (f (AgP1 Sg)) | ss (f (AgP1 Pl)) | ss (f (AgP2 Sg)) | ss (f (AgP2 Pl)) |
---- ss (f (AgP3Pl)) ;
}

139
src/experimental/ChunkFin.gf
View File

@@ -1,139 +0,0 @@
--# -path=.:../finnish/stemmed:../finnish:../api:../translator:alltenses
concrete ChunkFin of Chunk =
RGLBaseFin - [Pol,Tense],
NDPredFin
** open (PI=PredInstanceFin), ResFin, StemFin, Prelude in {
lincat
Chunks = {s : Str} ;
Chunk = {s : Str};
lin
OneChunk c = c ;
PlusChunk c cs = cc2 c cs ;
ChunkPhr c = ss ("*" ++ c.s) | c ;
lin
AP_Chunk ap = ss (ap.s ! True ! NCase Sg Nom) ; ---- other agr
AdA_Chunk ada = ada ;
Adv_Chunk adv = adv ;
AdV_Chunk adv = adv ;
AdN_Chunk adn = adn ;
Cl_Chunk, Cl_np_Chunk = \cl -> ss (PI.declCl cl) ;
QCl_Chunk, QCl_np_Chunk = \cl -> ss (PI.questCl cl) ;
CN_Pl_Chunk cn = ss (cn.s ! NCase Pl Nom) ;
CN_Sg_Chunk cn = ss (cn.s ! NCase Sg Nom) ;
CN_Pl_Gen_Chunk cn = ss (cn.s ! NCase Pl Gen) ;
CN_Sg_Gen_Chunk cn = ss (cn.s ! NCase Sg Gen) ;
Conj_Chunk conj = ss conj.s2 ;
IAdv_Chunk iadv = iadv ;
IP_Chunk ip = ss (ip.s ! NPCase Nom) ;
NP_Nom_Chunk np = ss (np.s ! NPCase Nom) ;
NP_Acc_Chunk np = ss (np.s ! NPAcc) ;
NP_Gen_Chunk np = ss (np.s ! NPCase Gen) ;
Numeral_Nom_Chunk num = ss (num.s ! NCard (NCase Sg Nom)) ;
Numeral_Gen_Chunk num = ss (num.s ! NCard (NCase Sg Gen)) ;
Ord_Nom_Chunk ord = ss (ord.s ! NCase Sg Nom) ;
Ord_Gen_Chunk ord = ss (ord.s ! NCase Sg Gen) ;
Predet_Chunk predet = ss (predet.s ! Sg ! NPCase Nom) ;
Prep_Chunk prep = ss (prep.s.p1 ++ prep.s.p2) ;
RP_Nom_Chunk rp = ss (rp.s ! Sg ! NPCase Nom) ;
RP_Acc_Chunk rp = ss (rp.s ! Sg ! NPAcc) ;
RP_Gen_Chunk rp = ss (rp.s ! Sg ! NPCase Gen) ;
Subj_Chunk subj = subj ;
VP_none_Chunk,
VP_np_Chunk,
VP_s_Chunk,
VP_v_Chunk,
VP_a_Chunk,
VP_q_Chunk,
VP_np_np_Chunk,
VP_np_s_Chunk,
VP_np_a_Chunk,
VP_np_q_Chunk,
VP_np_v_Chunk
= \vp ->
let verb = vp.v ! PI.defaultAgr ;
in
allAgrSS (\a ->
verb.fin ++ vp.adV ++ verb.inf ++
vp.adj ! a ++ vp.obj1 ! a ++ vp.obj2 ! a ++ vp.adv ++ vp.ext
) ;
VP_none_inf_Chunk,
VP_np_inf_Chunk,
VP_s_inf_Chunk,
VP_a_inf_Chunk,
VP_q_inf_Chunk,
VP_v_inf_Chunk,
VP_np_np_inf_Chunk,
VP_np_s_inf_Chunk,
VP_np_a_inf_Chunk,
VP_np_q_inf_Chunk,
VP_np_v_inf_Chunk
= \vp -> allAgrSS (\a -> PI.infVP PI.vvInfinitive a vp) ;
V_none_prespart_Chunk,
V_np_prespart_Chunk,
V_s_prespart_Chunk,
V_a_prespart_Chunk,
V_q_prespart_Chunk,
V_v_prespart_Chunk,
V_np_np_prespart_Chunk,
V_np_s_prespart_Chunk,
V_np_a_prespart_Chunk,
V_np_q_prespart_Chunk,
V_np_v_prespart_Chunk
= \v -> ss (PI.vPresPart v PI.defaultAgr) ;
V_none_pastpart_Chunk,
V_np_pastpart_Chunk,
V_s_pastpart_Chunk,
V_a_pastpart_Chunk,
V_q_pastpart_Chunk,
V_v_pastpart_Chunk,
V_np_np_pastpart_Chunk,
V_np_s_pastpart_Chunk,
V_np_a_pastpart_Chunk,
V_np_q_pastpart_Chunk,
V_np_v_pastpart_Chunk
= \v -> ss (PI.vPastPart v PI.defaultAgr) ;
copula_inf_Chunk = ss "olla" ;
refl_SgP1_Chunk = ss "itseni" ;
refl_SgP2_Chunk = ss "itsesi" ;
refl_SgP3_Chunk = ss "itse" ;
refl_PlP1_Chunk = ss "itsemme" ;
refl_PlP2_Chunk = ss "itsenne" ;
refl_PlP3_Chunk = ss "itsensä" ;
neg_Chunk = ss "ei" ;
copula_Chunk = ss "on" ;
copula_neg_Chunk = ss "ei ole" ;
past_copula_Chunk = ss "oli" ;
past_copula_neg_Chunk = ss "ei ollut" ;
future_Chunk = ss "tulee" ;
future_neg_Chunk = ss "ei tule" ;
cond_Chunk = ss "olisi" ;
cond_neg_Chunk = ss "ei olisi" ;
perfect_Chunk = ss "on" ;
perfect_neg_Chunk = ss "ei ole" ;
past_perfect_Chunk = ss "oli" ;
past_perfect_neg_Chunk = ss "ei ollut" ;
oper
allAgrSS : (Agr -> Str) -> SS = \f ->
ss (f PI.defaultAgr) ;
---- | ss (f (AgP3Sg Fem)) | ss (f (AgP3Sg Neutr)) |
---- ss (f (AgP1 Sg)) | ss (f (AgP1 Pl)) | ss (f (AgP2 Sg)) | ss (f (AgP2 Pl)) |
---- ss (f (AgP3Pl)) ;
}

137
src/experimental/ChunkSwe.gf
View File

@@ -1,137 +0,0 @@
concrete ChunkSwe of Chunk =
RGLBaseSwe - [Pol,Tense],
NDPredSwe
** open (PI=PredInstanceSwe), CommonScand, ResSwe, Prelude in {
lincat
Chunks = {s : Str} ;
Chunk = {s : Str};
lin
OneChunk c = c ;
PlusChunk c cs = cc2 c cs ;
ChunkPhr c = ss ("*" ++ c.s) | c ;
lin
AP_Chunk ap = ss (ap.s ! (Strong (GSg Utr))) ; ---- other agr
AdA_Chunk ada = ada ;
Adv_Chunk adv = adv ;
AdV_Chunk adv = adv ;
AdN_Chunk adn = adn ;
Cl_Chunk, Cl_np_Chunk = \cl -> ss (PI.declCl cl) ;
QCl_Chunk, QCl_np_Chunk = \cl -> ss (PI.questCl cl) ;
CN_Pl_Chunk cn = ss (cn.s ! Pl ! DIndef ! Nom) ;
CN_Sg_Chunk cn = ss (cn.s ! Sg ! DIndef ! Nom) ;
CN_Pl_Gen_Chunk cn = ss (cn.s ! Pl ! DIndef ! Gen) ;
CN_Sg_Gen_Chunk cn = ss (cn.s ! Sg ! DIndef ! Gen) ;
Conj_Chunk conj = ss conj.s2 ;
IAdv_Chunk iadv = iadv ;
IP_Chunk ip = ss (ip.s ! NPNom) ;
NP_Nom_Chunk np = ss (np.s ! NPNom) ;
NP_Acc_Chunk np = ss (np.s ! NPAcc) ;
NP_Gen_Chunk np = ss (np.s ! NPPoss (GSg Utr) Nom) ;
Numeral_Nom_Chunk num = ss (num.s ! NCard Utr) ;
Numeral_Gen_Chunk num = ss (num.s ! NCard Utr) ;
Ord_Nom_Chunk ord = ord ;
Ord_Gen_Chunk ord = ord ;
Predet_Chunk predet = ss (predet.s ! Utr ! Sg) ;
Prep_Chunk prep = prep ;
RP_Nom_Chunk rp = ss (rp.s ! Utr ! Sg ! RNom) ;
RP_Acc_Chunk rp = ss (rp.s ! Utr ! Sg ! RNom) ;
RP_Gen_Chunk rp = ss (rp.s ! Utr ! Sg ! RGen) ;
Subj_Chunk subj = subj ;
VP_none_Chunk,
VP_np_Chunk,
VP_s_Chunk,
VP_v_Chunk,
VP_a_Chunk,
VP_q_Chunk,
VP_np_np_Chunk,
VP_np_s_Chunk,
VP_np_a_Chunk,
VP_np_q_Chunk,
VP_np_v_Chunk
= \vp ->
let verb = vp.v ! PI.UUnit
in
allAgrSS (\a ->
verb.p1 ++ verb.p2 ++ vp.adV ++ verb.p3 ++ vp.part ++
vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a ++ vp.adv ++ vp.ext
) ;
VP_none_inf_Chunk,
VP_np_inf_Chunk,
VP_s_inf_Chunk,
VP_a_inf_Chunk,
VP_q_inf_Chunk,
VP_v_inf_Chunk,
VP_np_np_inf_Chunk,
VP_np_s_inf_Chunk,
VP_np_a_inf_Chunk,
VP_np_q_inf_Chunk,
VP_np_v_inf_Chunk
= \vp -> allAgrSS (\a -> PI.infVP PI.UUnit a vp) ;
V_none_prespart_Chunk,
V_np_prespart_Chunk,
V_s_prespart_Chunk,
V_a_prespart_Chunk,
V_q_prespart_Chunk,
V_v_prespart_Chunk,
V_np_np_prespart_Chunk,
V_np_s_prespart_Chunk,
V_np_a_prespart_Chunk,
V_np_q_prespart_Chunk,
V_np_v_prespart_Chunk
= \v -> ss (PI.vPresPart v PI.defaultAgr) ;
V_none_pastpart_Chunk,
V_np_pastpart_Chunk,
V_s_pastpart_Chunk,
V_a_pastpart_Chunk,
V_q_pastpart_Chunk,
V_v_pastpart_Chunk,
V_np_np_pastpart_Chunk,
V_np_s_pastpart_Chunk,
V_np_a_pastpart_Chunk,
V_np_q_pastpart_Chunk,
V_np_v_pastpart_Chunk
= \v -> ss (PI.vPastPart v PI.defaultAgr) ;
copula_inf_Chunk = ss "att vara" | ss "vara" ;
refl_SgP1_Chunk = ss "mig själv" ;
refl_SgP2_Chunk = ss "dig själv" ;
refl_SgP3_Chunk = ss "sig själv" ;
refl_PlP1_Chunk = ss "oss själva" ;
refl_PlP2_Chunk = ss "er själva" ;
refl_PlP3_Chunk = ss "sig själva" ;
neg_Chunk = ss "inte" ;
copula_Chunk = ss "är" ;
copula_neg_Chunk = ss "är inte" ;
past_copula_Chunk = ss "var" ;
past_copula_neg_Chunk = ss "var inte" ;
future_Chunk = ss "ska" | ss "skall" ;
future_neg_Chunk = ss "ska inte" | ss "skall inte" ;
cond_Chunk = ss "skulle" ;
cond_neg_Chunk = ss "skulle inte" ;
perfect_Chunk = ss "har" ;
perfect_neg_Chunk = ss "har inte" ;
past_perfect_Chunk = ss "hade" ;
past_perfect_neg_Chunk = ss "hade inte" ;
oper
allAgrSS : (Agr -> Str) -> SS = \f ->
ss (f PI.defaultAgr) ;
---- | ss (f (AgP3Sg Fem)) | ss (f (AgP3Sg Neutr)) |
---- ss (f (AgP1 Sg)) | ss (f (AgP1 Pl)) | ss (f (AgP2 Sg)) | ss (f (AgP2 Pl)) |
---- ss (f (AgP3Pl)) ;
}

32
src/experimental/Lift.gf
View File

@@ -1,32 +0,0 @@
abstract Lift =
RGLBase - [Pol,Tense]
,Pred
** {
fun
LiftV : V -> PrV aNone ;
LiftV2 : V2 -> PrV (aNP aNone) ;
LiftVS : VS -> PrV aS ;
LiftVQ : VQ -> PrV aQ ;
LiftVV : VV -> PrV aV ;
LiftVA : VA -> PrV aA ;
LiftVN : VA -> PrV aN ; ----
LiftV3 : V3 -> PrV (aNP (aNP aNone)) ;
LiftV2S : V2S -> PrV (aNP aS) ;
LiftV2Q : V2Q -> PrV (aNP aQ) ;
LiftV2V : V2V -> PrV (aNP aV) ;
LiftV2A : V2A -> PrV (aNP aA) ;
LiftV2N : V2A -> PrV (aNP aN) ; ----
LiftAP : AP -> PrAP aNone ;
LiftA2 : A2 -> PrAP (aNP aNone) ;
LiftCN : CN -> PrCN aNone ;
LiftN2 : N2 -> PrCN (aNP aNone) ;
AppAPCN : PrAP aNone -> CN -> CN ;
LiftAdv : Adv -> PrAdv aNone ;
LiftAdV : AdV -> PrAdv aNone ;
LiftPrep : Prep -> PrAdv (aNP aNone) ;
}

42
src/experimental/LiftChi.gf
View File

@@ -1,42 +0,0 @@
concrete LiftChi of Lift =
RGLBaseChi - [Pol,Tense,Ant]
,PredChi
** open CommonScand, ResChi, PredInstanceChi, Prelude in {
--flags literal=Symb ;
oper
liftV = PredInstanceChi.liftV ;
lin
LiftV v = liftV v ;
LiftV2 v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2} ;
LiftVS v = liftV v ;
LiftVQ v = liftV v ;
LiftVA v = liftV v ; ---- c1?
LiftVN v = liftV v ; ---- c1?
LiftVV v = liftV v ;
LiftV3 v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2 ; c2 = v.c3} ;
LiftV2S v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2} ;
LiftV2Q v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2} ;
LiftV2V v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2 ; c2 = v.c3} ;
LiftV2A v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2} ;
LiftV2N v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2} ;
LiftAP ap = {s = \\a => ap.s ; c1,c2 = noComplCase ; obj1 = \\_ => []} ; --- monosyl
LiftA2 ap = {s = \\a => ap.s ; c1 = ap.c2 ; c2 = noComplCase ; obj1 = \\_ => []} ; --- isPre
LiftCN cn = {s = \\n => cn.s ; c1,c2 = noComplCase ; obj1 = \\_ => []} ;
LiftN2 cn = {s = \\n => cn.s ; c1 = cn.c2 ; c2 = noComplCase ; obj1 = \\_ => []} ;
AppAPCN ap cn = {s = ap.s ! UUnit ++ cn.s ; c = cn.c} ; ----
LiftAdv a = {advType = a.advType ; prepPre = a.s ; prepPost = []} ;
LiftAdV a = {advType = ATTime ; prepPre = a.s ; prepPost = []} ; ---- the first adv place
LiftPrep p = p ;
}

46
src/experimental/LiftEng.gf
View File

@@ -1,46 +0,0 @@
concrete LiftEng of Lift =
RGLBaseEng - [Pol,Tense]
,PredEng
** open ResEng, PredInstanceEng, Prelude, (Pr = PredEng) in {
--flags literal=Symb ;
oper
liftV : ResEng.Verb -> Pr.PrV = \v -> lin PrV {
s = table {VVF f => v.s ! f ; VVPresNeg | VVPastNeg => v.s ! VInf} ; ---- only used for Aux
p = v.p ;
c1,c2 = [] ; isSubjectControl = True ; vtype = VTAct ; vvtype = VVInf
} ;
lin
LiftV v = liftV v ;
LiftV2 v = liftV v ** {c1 = v.c2} ;
LiftVS v = liftV v ;
LiftVQ v = liftV v ;
LiftVA v = liftV v ; ---- c1?
LiftVN v = liftV v ; ---- c1?
LiftVV v = {s = v.s ; p = v.p ; c1,c2 = [] ; isSubjectControl = True ;
vtype = case v.typ of {VVAux => VTAux ; _ => VTAct} ; vvtype = v.typ} ; ---- c1? ---- VVF
LiftV3 v = liftV 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 ; c2 = v.c3 ; isSubjectControl = False ; vvtype = v.typ} ; ---- subj control should be defined in V2V
LiftV2A v = liftV v ** {c1 = v.c2} ;
LiftV2N v = liftV v ** {c1 = v.c2} ;
LiftAP ap = {s = \\a => ap.s ! a ; c1,c2 = [] ; obj1 = \\_ => []} ; --- isPre
LiftA2 a = {s = \\_ => a.s ! AAdj Posit Nom ; c1 = a.c2 ; c2 = [] ; obj1 = \\_ => []} ; --- isPre
LiftCN cn = {s = \\n => cn.s ! n ! Nom ; c1,c2 = [] ; obj1 = \\_ => []} ;
LiftN2 cn = {s = \\n => cn.s ! n ! Nom ; c1 = cn.c2 ; c2 = [] ; obj1 = \\_ => []} ;
AppAPCN ap cn = {s = \\n,c => cn.s ! n ! c ++ ap.s ! agrgP3 n cn.g ++ ap.obj1 ! agrgP3 n cn.g ; g = cn.g}
| {s = \\n,c => ap.s ! agrgP3 n cn.g ++ ap.obj1 ! agrgP3 n cn.g ++ cn.s ! n ! c ; g = cn.g} ; ---- isPre
LiftAdv a = a ** {isAdV = False ; c1 = []} ;
LiftAdV a = a ** {isAdV = True ; c1 = []} ;
LiftPrep p = {s = [] ; isAdV = False ; c1 = p.s} ;
}

56
src/experimental/LiftFin.gf
View File

@@ -1,56 +0,0 @@
concrete LiftFin of Lift =
RGLBaseFin - [Pol,Tense]
,PredFin
** open ResFin,
StemFin,
PredInstanceFin,
Prelude in {
--flags literal=Symb ;
lin
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 = liftV 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
{-
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 = noComplCase} ;
LiftAdV a = a ** {isAdV = True ; c1 = noComplCase} ;
LiftPrep p = {s = [] ; isAdV = False ; c1 = p} ;
}

56
src/experimental/LiftSwe.gf
View File

@@ -1,56 +0,0 @@
concrete LiftSwe of Lift =
RGLBaseSwe - [Pol,Tense]
,PredSwe
** open CommonScand, ResSwe, PredInstanceSwe, Prelude in {
--flags literal=Symb ;
oper
liftV = PredInstanceSwe.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} ;
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} ;
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} ;
}

9
src/experimental/Makefile
View File

@@ -1,9 +0,0 @@
all: translator
translator:
gf -s -make -literal=Symb -probs=NDPredTrans.probs -name=TransEngSwe NDTransEng.gf NDTransSwe.gf
bigtranslator:
gf -s -make -literal=Symb -probs=NDPredTrans.probs -name=TransEngChiFinSwe NDTransEng.gf NDTransSwe.gf NDTransChi.gf NDTransFin.gf +RTS -K200M
midtranslator:
gf -s -make -literal=Symb -probs=NDPredTrans.probs -name=TransEngChiSwe NDTransEng.gf NDTransSwe.gf NDTransChi.gf +RTS -K200M

35
src/experimental/NDLift.gf
View File

@@ -1,35 +0,0 @@
abstract NDLift =
RGLBase - [Pol,Tense]
,NDPred
** {
fun
LiftV : V -> PrV_none ;
LiftV2 : V2 -> PrV_np ;
LiftVS : VS -> PrV_s ;
LiftVQ : VQ -> PrV_q ;
LiftVV : VV -> PrV_v ;
LiftVA : VA -> PrV_a ;
LiftVN : VA -> PrV_n ; ----
LiftV3 : V3 -> PrV_np_np ;
LiftV2S : V2S -> PrV_np_s ;
LiftV2Q : V2Q -> PrV_np_q ;
LiftV2V : V2V -> PrV_np_v ;
LiftV2A : V2A -> PrV_np_a ;
LiftV2N : V2A -> PrV_np_n ; ----
LiftAP : AP -> PrAP_none ;
LiftA2 : A2 -> PrAP_np ;
LiftCN : CN -> PrCN_none ;
LiftN2 : N2 -> PrCN_np ;
AppAPCN : PrAP_none -> CN -> CN ;
LiftAdv : Adv -> PrAdv_none ;
LiftAdV : AdV -> PrAdv_none ;
LiftPrep : Prep -> PrAdv_np ;
}

5
src/experimental/NDLiftChi.gf
View File

@@ -1,5 +0,0 @@
concrete NDLiftChi of NDLift =
RGLBaseChi - [Pol,Tense,Ant]
,NDPredChi
** NDLiftFunctor with (Lift = LiftChi) ;

5
src/experimental/NDLiftEng.gf
View File

@@ -1,5 +0,0 @@
concrete NDLiftEng of NDLift =
RGLBaseEng - [Pol,Tense]
,NDPredEng
** NDLiftFunctor with (Lift = LiftEng) ;

5
src/experimental/NDLiftFin.gf
View File

@@ -1,5 +0,0 @@
concrete NDLiftFin of NDLift =
RGLBaseFin - [Pol,Tense]
,NDPredFin
** NDLiftFunctor with (Lift = LiftFin) ;

34
src/experimental/NDLiftFunctor.gf
View File

@@ -1,34 +0,0 @@
incomplete concrete NDLiftFunctor of NDLift =
RGLBase - [Pol,Tense]
,NDPred
** open Lift in {
lin
LiftV = Lift.LiftV ;
LiftV2 = Lift.LiftV2 ;
LiftVS = Lift.LiftVS ;
LiftVQ = Lift.LiftVQ ;
LiftVV = Lift.LiftVV ;
LiftVA = Lift.LiftVA ;
LiftVN = Lift.LiftVN ;
LiftV3 = Lift.LiftV3 ;
LiftV2S = Lift.LiftV2S ;
LiftV2Q = Lift.LiftV2Q ;
LiftV2V = Lift.LiftV2V ;
LiftV2A = Lift.LiftV2A ;
LiftV2N = Lift.LiftV2N ;
LiftAP = Lift.LiftAP ;
LiftA2 = Lift.LiftA2 ;
LiftCN = Lift.LiftCN ;
LiftN2 = Lift.LiftN2 ;
AppAPCN = Lift.AppAPCN ;
LiftAdv = Lift.LiftAdv ;
LiftAdV = Lift.LiftAdV ;
LiftPrep = Lift.LiftPrep ;
}

5
src/experimental/NDLiftSwe.gf
View File

@@ -1,5 +0,0 @@
concrete NDLiftSwe of NDLift =
RGLBaseSwe - [Pol,Tense]
,NDPredSwe
** NDLiftFunctor with (Lift = LiftSwe) ;

292
src/experimental/NDPred.gf
View File

@@ -1,292 +0,0 @@
abstract NDPred = Cat [Ant,NP,Utt,IP,IAdv,IComp,Conj,RS,RP] ** {
cat
--< Arg ;
--< PrV Arg ;
PrV_none ; PrV_np ; PrV_v ; PrV_s ; PrV_q ; PrV_a ; PrV_n ;
PrV_np_np ; PrV_np_v ; PrV_np_s ; PrV_np_q ; PrV_np_a ; PrV_np_n ;
--< PrVP Arg ;
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 ;
Tense ;
Pol ;
--< PrCl Arg ;
PrCl_none ;
PrCl_np ;
--< ClC Arg ; -- conjunction of Cl
ClC_none ;
ClC_np ;
--< PrQCl Arg ;
PrQCl_none ;
PrQCl_np ;
--< PrAdv Arg ;
PrAdv_none ;
PrAdv_np ;
PrS ;
--< PrAP Arg ;
PrAP_none ;
PrAP_np ;
--< PrCN Arg ; -- the country he became the president of
PrCN_none ;
PrCN_np ;
fun
--< aNone, aS, aV, aQ, aA, aN : Arg ;
--< aNP : Arg -> Arg ;
TPres, TPast, TFut, TCond : Tense ;
PPos, PNeg : Pol ;
ASimul, AAnter : Ant ;
--< UseV : (a : Arg) -> Ant -> Tense -> Pol -> PrV a -> PrVP a ;
UseV_none : Ant -> Tense -> Pol -> PrV_none -> PrVP_none ;
UseV_np : Ant -> Tense -> Pol -> PrV_np -> PrVP_np ;
UseV_v : Ant -> Tense -> Pol -> PrV_v -> PrVP_v ;
UseV_s : Ant -> Tense -> Pol -> PrV_s -> PrVP_s ;
UseV_a : Ant -> Tense -> Pol -> PrV_a -> PrVP_a ;
UseV_q : Ant -> Tense -> Pol -> PrV_q -> PrVP_q ;
UseV_n : Ant -> Tense -> Pol -> PrV_v -> PrVP_n ;
UseV_np_np : Ant -> Tense -> Pol -> PrV_np_np -> PrVP_np_np ;
UseV_np_v : Ant -> Tense -> Pol -> PrV_np_v -> PrVP_np_v ;
UseV_np_s : Ant -> Tense -> Pol -> PrV_np_s -> PrVP_np_s ;
UseV_np_a : Ant -> Tense -> Pol -> PrV_np_a -> PrVP_np_a ;
UseV_np_q : Ant -> Tense -> Pol -> PrV_np_q -> PrVP_np_q ;
UseV_np_n : Ant -> Tense -> Pol -> PrV_np_n -> PrVP_np_n ;
--< PassUseV : (a : Arg) -> Ant -> Tense -> Pol -> PrV (aNP a) -> PrVP a ;
PassUseV_none : Ant -> Tense -> Pol -> PrV_np -> PrVP_none ;
PassUseV_np : Ant -> Tense -> Pol -> PrV_np_np -> PrVP_np ;
PassUseV_v : Ant -> Tense -> Pol -> PrV_np_v -> PrVP_v ;
PassUseV_s : Ant -> Tense -> Pol -> PrV_np_s -> PrVP_s ;
PassUseV_a : Ant -> Tense -> Pol -> PrV_np_a -> PrVP_a ;
PassUseV_q : Ant -> Tense -> Pol -> PrV_np_q -> PrVP_q ;
PassUseV_n : Ant -> Tense -> Pol -> PrV_np_n -> PrVP_n ;
--< AgentPassUseV : (a : Arg) -> Ant -> Tense -> Pol -> PrV (aNP a) -> NP -> PrVP a ;
AgentPassUseV_none : Ant -> Tense -> Pol -> PrV_np -> NP -> PrVP_none ;
AgentPassUseV_np : Ant -> Tense -> Pol -> PrV_np_np -> NP -> PrVP_np ;
AgentPassUseV_v : Ant -> Tense -> Pol -> PrV_np_v -> NP -> PrVP_v ;
AgentPassUseV_s : Ant -> Tense -> Pol -> PrV_np_s -> NP -> PrVP_s ;
AgentPassUseV_a : Ant -> Tense -> Pol -> PrV_np_a -> NP -> PrVP_a ;
AgentPassUseV_q : Ant -> Tense -> Pol -> PrV_np_q -> NP -> PrVP_q ;
AgentPassUseV_n : Ant -> Tense -> Pol -> PrV_np_n -> NP -> PrVP_n ;
--< ComplV2 : (a : Arg) -> PrVP (aNP a) -> NP -> PrVP a ; -- she loves him
ComplV2_none : PrVP_np -> NP -> PrVP_none ;
--< ComplVS : (a : Arg) -> PrVP aS -> PrCl a -> PrVP a ; -- she says that I am here
ComplVS_none : PrVP_s -> PrCl_none -> PrVP_none ;
ComplVS_np : PrVP_s -> PrCl_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 ;
--< ComplVA : (a : Arg) -> PrVP aA -> PrAP a -> PrVP a ; -- she becomes old
ComplVA_none : PrVP_a -> PrAP_none -> PrVP_none ;
--< ComplVN : (a : Arg) -> PrVP aN -> PrCN a -> PrVP a ; -- she becomes a professor
ComplVN_none : PrVP_n -> PrCN_none -> PrVP_none ;
--< SlashV3 : (a : Arg) -> PrVP (aNP (aNP a)) -> NP -> PrVP (aNP a) ; -- she shows X to him
SlashV3_none : PrVP_np_np -> NP -> PrVP_np ;
--< 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) -> 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 ;
--< SlashV2N : (a : Arg) -> PrVP (aNP aN) -> PrCN a -> PrVP (aNP a) ; -- she makes X a professor
SlashV2N_none : PrVP_np_n -> PrCN_none -> PrVP_np ;
--< SlashV2Q : (a : Arg) -> PrVP (aNP aA) -> PrQCl a -> PrVP (aNP a) ; -- she asks X who is here
SlashV2Q_none : PrVP_np_q -> PrQCl_none -> PrVP_np ;
--< UseAP : (a : Arg) -> Ant -> Tense -> Pol -> PrAP a -> PrVP a ; -- she is married to X
UseAP_none : Ant -> Tense -> Pol -> PrAP_none -> PrVP_none ;
UseAP_np : Ant -> Tense -> Pol -> PrAP_np -> PrVP_np ;
--< UseAdv : (a : Arg) -> Ant -> Tense -> Pol -> PrAdv a -> PrVP a ; -- she is in X
UseAdv_none : Ant -> Tense -> Pol -> PrAdv_none -> PrVP_none ;
UseAdv_np : Ant -> Tense -> Pol -> PrAdv_np -> PrVP_np ;
--< UseCN : (a : Arg) -> Ant -> Tense -> Pol -> PrCN a -> PrVP a ; -- she is a member of X
UseCN_none : Ant -> Tense -> Pol -> PrCN_none -> PrVP_none ;
UseCN_np : Ant -> Tense -> Pol -> PrCN_np -> PrVP_np ;
-- the following are only for aNone
UseNP_none : Ant -> Tense -> Pol -> NP -> PrVP_none ;
UseS_none : Ant -> Tense -> Pol -> PrCl_none -> PrVP_none ; -- the fact is that she sleeps
UseQ_none : Ant -> Tense -> Pol -> PrQCl_none -> PrVP_none ; -- the question is who sleeps
UseVP_none : Ant -> Tense -> Pol -> PrVPI_none -> PrVP_none ; -- the goal is to sleep
--< 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 ;
--< SlashClNP : (a : Arg) -> PrCl (aNP a) -> NP -> PrCl a ; -- slash consumption: hon tittar på + oss
SlashClNP_none : PrCl_np -> NP -> PrCl_none ;
--< ReflVP : (a : Arg) -> PrVP (aNP a) -> PrVP a ; -- refl on first position (direct object)
ReflVP_none : PrVP_np -> PrVP_none ;
ReflVP_np : PrVP_np_np -> PrVP_np ;
ReflVP_v : PrVP_np_v -> PrVP_v ;
ReflVP_s : PrVP_np_s -> PrVP_s ;
ReflVP_q : PrVP_np_q -> PrVP_q ;
ReflVP_a : PrVP_np_a -> PrVP_a ;
ReflVP_n : PrVP_np_n -> PrVP_n ;
--< ReflVP2 : (a : Arg) -> PrVP (aNP (aNP a)) -> PrVP (aNP a) ; -- refl on second position (indirect object)
ReflVP2_np : PrVP_np_np -> PrVP_np ;
--< QuestVP : (a : Arg) -> IP -> PrVP a -> PrQCl a ;
QuestVP_none : IP -> PrVP_none -> PrQCl_none ;
--< QuestSlash : (a : Arg) -> IP -> PrQCl (aNP a) -> PrQCl a ;
QuestSlash_none : IP -> PrQCl_np -> PrQCl_none ;
--< QuestCl : (a : Arg) -> PrCl a -> PrQCl a ;
QuestCl_none : PrCl_none -> PrQCl_none ;
QuestCl_np : PrCl_np -> PrQCl_np ;
--< QuestIAdv : (a : Arg) -> IAdv -> PrCl a -> PrQCl a ;
QuestIAdv_none : IAdv -> PrCl_none -> PrQCl_none ;
QuestIComp_none : Ant -> Tense -> Pol -> IComp -> NP -> PrQCl_none ; -- where is she
--< UseCl : PrCl aNone -> PrS ;
UseCl_none : PrCl_none -> PrS ;
--< UseQCl : PrQCl aNone -> PrS ;
UseQCl_none : PrQCl_none -> PrS ;
--< UseAdvCl : PrAdv aNone -> PrCl aNone -> PrS ; -- lift adv to front
UseAdvCl_none : PrAdv_none -> PrCl_none -> PrS ;
UttPrS : PrS -> Utt ;
--< AdvCl : (a : Arg) -> PrAdv a -> PrCl aNone -> PrCl a ;
AdvCl_none : PrAdv_none -> PrCl_none -> PrCl_none ;
AdvCl_np : PrAdv_np -> PrCl_none -> PrCl_np ;
--< AdvQCl : (a : Arg) -> PrAdv a -> PrQCl aNone -> PrQCl a ;
AdvQCl_none : PrAdv_none -> PrQCl_none -> PrQCl_none ;
AdvQCl_np : PrAdv_np -> PrQCl_none -> PrQCl_np ;
-- relatives: just one of each
RelCl_none : PrCl_none -> RS ;
RelVP_none : RP -> PrVP_none -> RS ;
RelSlash_none : RP -> PrCl_np -> RS ;
-- imperatives: just one of each
PrImpSg : PrVP_none -> Utt ;
PrImpPl : PrVP_none -> Utt ;
-- participles as adjectives
--< PresPartAP : (a : Arg) -> PrV a -> PrAP a ;
PresPartAP_none : PrV_none -> PrAP_none ;
PresPartAP_np : PrV_np -> PrAP_np ;
--< PastPartAP : (a : Arg) -> PrV (aNP a) -> PrAP a ;
PastPartAP_none : PrV_np -> PrAP_none ;
--< AgentPastPartAP : (a : Arg) -> PrV (aNP a) -> NP -> PrAP a ;
AgentPastPartAP_none : PrV_np -> NP -> PrAP_none ;
-- for aNone only
NomVPNP_none : PrVPI_none -> NP ; -- translating a document
--< ByVP : (a : Arg) -> PrVP a -> PrVPI aNone -> PrVP a ; -- by translating a document
ByVP_none : PrVP_none -> PrVPI_none -> PrVP_none ;
--< WhenVP : (a : Arg) -> PrVP a -> PrVPI aNone -> PrVP a ; -- when translating a document
WhenVP_none : PrVP_none -> PrVPI_none -> PrVP_none ;
--< BeforeVP : (a : Arg) -> PrVP a -> PrVPI aNone -> PrVP a ; -- before translating a document
BeforeVP_none : PrVP_none -> PrVPI_none -> PrVP_none ;
--< AfterVP : (a : Arg) -> PrVP a -> PrVPI aNone -> PrVP a ; -- after translating a document
AfterVP_none : PrVP_none -> PrVPI_none -> PrVP_none ;
--< InOrderVP : (a : Arg) -> PrVP a -> PrVPI aNone -> PrVP a ; -- in order to translate a document
InOrderVP_none : PrVP_none -> PrVPI_none -> PrVP_none ;
--< WithoutVP : (a : Arg) -> PrVP a -> PrVPI aNone -> PrVP a ; -- without translating a document
WithoutVP_none : PrVP_none -> PrVPI_none -> PrVP_none ;
-- PrVP coordination
--< StartVPC : (a : Arg) -> Conj -> PrVP a -> PrVP a -> VPC a ;
StartVPC_none : Conj -> PrVP_none -> PrVP_none -> VPC_none ;
StartVPC_np : Conj -> PrVP_np -> PrVP_np -> VPC_np ;
---- ...
--< ContVPC : (a : Arg) -> PrVP a -> VPC a -> VPC a ;
ContVPC_none : PrVP_none -> VPC_none -> VPC_none ;
ContVPC_np : PrVP_np -> VPC_np -> VPC_np ;
---- ...
--< UseVPC : (a : Arg) -> VPC a -> PrVP a ;
UseVPC_none : VPC_none -> PrVP_none ;
UseVPC_np : VPC_np -> PrVP_np ;
-- clause coordination, including "she loves and we look at (her)"
--< StartClC : (a : Arg) -> Conj -> PrCl a -> PrCl a -> ClC a ;
StartClC_none : Conj -> PrCl_none -> PrCl_none -> ClC_none ;
StartClC_np : Conj -> PrCl_np -> PrCl_np -> ClC_np ;
--< ContClC : (a : Arg) -> PrCl a -> ClC a -> ClC a ;
ContClC_none : PrCl_none -> ClC_none -> ClC_none ;
ContClC_np : PrCl_np -> ClC_np -> ClC_np ;
--< UseClC : (a : Arg) -> ClC a -> PrCl a ;
UseClC_none : ClC_none -> PrCl_none ;
UseClC_np : ClC_np -> PrCl_np ;
--< ComplAdv : (a : Arg) -> PrAdv (aNP a) -> NP -> PrAdv a ; -- typically: formation of preposition phrase
ComplAdv_none : PrAdv_np -> NP -> PrAdv_none ;
--< SubjUttPreS : Subj -> PrCl aNone -> PrCl aNone -> Utt ;
SubjUttPreS : Subj -> PrCl_none -> PrCl_none -> Utt ;
--< SubjUttPreQ : Subj -> PrCl aNone -> PrQCl aNone -> Utt ;
SubjUttPreQ : Subj -> PrCl_none -> PrQCl_none -> Utt ;
--< SubjUttPost : Subj -> PrCl aNone -> Utt -> Utt ;
SubjUttPost : Subj -> PrCl_none -> Utt -> Utt ;
}

10
src/experimental/NDPredChi.gf
View File

@@ -1,10 +0,0 @@
concrete NDPredChi of NDPred =
CatChi [NP,Utt,IP,IAdv,IComp,Conj,RS,RP,Subj] **
NDPredFunctor
with
(PredInterface = PredInstanceChi),
(Pred = PredChi) ** open PredChi in {
lincat Ant = PredChi.Ant ;
}

5
src/experimental/NDPredEng.gf
View File

@@ -1,5 +0,0 @@
concrete NDPredEng of NDPred =
CatEng [Ant,NP,Utt,IP,IAdv,IComp,Conj,RS,RP,Subj] **
NDPredFunctor with
(PredInterface = PredInstanceEng),
(Pred = PredEng) ;

6
src/experimental/NDPredFin.gf
View File

@@ -1,6 +0,0 @@
concrete NDPredFin of NDPred =
CatFin [Ant,NP,Utt,IP,IAdv,IComp,Conj,Subj,RS,RP] **
NDPredFunctor
with
(PredInterface = PredInstanceFin),
(Pred = PredFin) ;

226
src/experimental/NDPredFunctor.gf
View File

@@ -1,226 +0,0 @@
incomplete concrete NDPredFunctor of NDPred =
Cat [Ant,NP,Utt,IP,IAdv,Conj,RS,RP,Subj] **
open
PredInterface,
Pred,
ParamX,
Prelude
in {
------------------------------------
-- lincats
-------------------------------------
lincat
Tense = Pred.Tense ;
Pol = Pred.Pol ;
PrV_none, PrV_np, PrV_v, PrV_s, PrV_q, PrV_a, PrV_n,
PrV_np_np, PrV_np_v, PrV_np_s, PrV_np_q, PrV_np_a, PrV_np_n = Pred.PrV ;
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 ;
VPC_none, VPC_np = Pred.VPC ;
ClC_none, ClC_np = Pred.ClC ;
PrAdv_none, PrAdv_np = Pred.PrAdv ;
PrS = Pred.PrS ;
PrAP_none, PrAP_np = Pred.PrAP ;
PrCN_none, PrCN_np = Pred.PrCN ;
-- reference linearizations for chunking
---- should be by functor as well
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
= 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 ----
----------------------------
lin
-- standard general
TPres = Pred.TPres ;
TPast = Pred.TPast ;
TFut = Pred.TFut ;
TCond = Pred.TCond ;
ASimul = Pred.ASimul ;
AAnter = Pred.AAnter ;
PPos = Pred.PPos ;
PNeg = Pred.PNeg ;
UseV_none, UseV_np, UseV_v, UseV_s, UseV_q, UseV_a, UseV_n, UseV_np_np, UseV_np_v, UseV_np_s, UseV_np_q, UseV_np_a, UseV_np_n
= Pred.UseV Pred.aNone ;
PassUseV_none, PassUseV_np, PassUseV_v, PassUseV_s, PassUseV_q, PassUseV_a, PassUseV_n
= Pred.PassUseV Pred.aNone ;
AgentPassUseV_none, AgentPassUseV_np, AgentPassUseV_v, AgentPassUseV_s, AgentPassUseV_q, AgentPassUseV_a, AgentPassUseV_n
= Pred.AgentPassUseV Pred.aNone ;
UseAP_none, UseAP_np
= Pred.UseAP Pred.aNone ;
UseCN_none, UseCN_np
= Pred.UseCN Pred.aNone ;
UseAdv_none, UseAdv_np
= Pred.UseAdv Pred.aNone ;
UseNP_none
= Pred.UseNP ;
UseS_none
= Pred.UseS ;
UseQ_none
= Pred.UseQ ;
UseVP_none
= Pred.UseVP ;
ComplV2_none
= Pred.ComplV2 Pred.aNone ;
ComplVV_none, ComplVV_np
= Pred.ComplVV Pred.aNone ;
ComplVS_none, ComplVS_np
= Pred.ComplVS Pred.aNone ;
ComplVA_none
= Pred.ComplVA Pred.aNone ;
ComplVQ_none
= Pred.ComplVQ Pred.aNone ;
ComplVN_none
= Pred.ComplVN Pred.aNone ;
SlashV3_none
= Pred.SlashV3 Pred.aNone ;
SlashV2V_none, SlashV2V_np
= Pred.SlashV2V Pred.aNone ;
SlashV2S_none
= Pred.SlashV2S Pred.aNone ;
SlashV2Q_none
= Pred.SlashV2Q Pred.aNone ;
SlashV2A_none
= Pred.SlashV2A Pred.aNone ;
SlashV2N_none
= Pred.SlashV2N Pred.aNone ;
ReflVP_none, ReflVP_np, ReflVP_v, ReflVP_s, ReflVP_q, ReflVP_a, ReflVP_n
= Pred.ReflVP Pred.aNone ;
ReflVP2_np
= Pred.ReflVP2 Pred.aNone ;
InfVP_none, InfVP_np
= Pred.InfVP Pred.aNone ;
PredVP_none, PredVP_np
= Pred.PredVP Pred.aNone ;
SlashClNP_none
= Pred.SlashClNP Pred.aNone ;
QuestCl_none, QuestCl_np
= Pred.QuestCl Pred.aNone ;
QuestIAdv_none
= Pred.QuestIAdv Pred.aNone ;
QuestIComp_none
= Pred.QuestIComp ;
QuestVP_none
= Pred.QuestVP Pred.aNone ;
QuestSlash_none
= Pred.QuestSlash Pred.aNone ;
UseCl_none
= Pred.UseCl ;
UseQCl_none
= Pred.UseQCl ;
UseAdvCl_none
= Pred.UseAdvCl ;
UttPrS
= Pred.UttPrS ;
AdvCl_none, AdvCl_np
= Pred.AdvCl Pred.aNone ;
AdvQCl_none, AdvQCl_np
= Pred.AdvQCl Pred.aNone ;
---- RelCl_none
---- = Pred.RelCl Pred.aNone ;
RelVP_none
= Pred.RelVP ;
RelSlash_none
= Pred.RelSlash ;
PrImpSg
= Pred.PrImpSg ;
PrImpPl
= Pred.PrImpPl ;
PresPartAP_none, PresPartAP_np
= Pred.PresPartAP Pred.aNone ;
PastPartAP_none
= Pred.PastPartAP Pred.aNone ;
AgentPastPartAP_none
= Pred.AgentPastPartAP Pred.aNone ;
NomVPNP_none
= Pred.NomVPNP ;
ByVP_none
= Pred.ByVP Pred.aNone ;
WhenVP_none
= Pred.WhenVP Pred.aNone ;
BeforeVP_none
= Pred.BeforeVP Pred.aNone ;
AfterVP_none
= Pred.AfterVP Pred.aNone ;
InOrderVP_none
= Pred.InOrderVP Pred.aNone ;
WithoutVP_none
= Pred.WithoutVP Pred.aNone ;
StartVPC_none, StartVPC_np
= Pred.StartVPC Pred.aNone ;
ContVPC_none, ContVPC_np
= Pred.ContVPC Pred.aNone ;
UseVPC_none, UseVPC_np
= Pred.UseVPC Pred.aNone ;
StartClC_none, StartClC_np
= Pred.StartClC Pred.aNone ;
ContClC_none, ContClC_np
= Pred.ContClC Pred.aNone ;
UseClC_none, UseClC_np
= Pred.UseClC Pred.aNone ;
ComplAdv_none
= Pred.ComplAdv Pred.aNone ;
SubjUttPreS
= Pred.SubjUttPreS ;
SubjUttPreQ
= Pred.SubjUttPreQ ;
SubjUttPost
= Pred.SubjUttPost ;
}

5
src/experimental/NDPredSwe.gf
View File

@@ -1,5 +0,0 @@
concrete NDPredSwe of NDPred =
CatSwe [Ant,NP,Utt,IP,IAdv,IComp,Conj,RS,RP,Subj] **
NDPredFunctor with
(PredInterface = PredInstanceSwe),
(Pred = PredSwe) ;

65318
src/experimental/NDPredTrans.probs
View File

File diff suppressed because it is too large Load Diff

25
src/experimental/NDTrans.gf
View File

@@ -1,25 +0,0 @@
--# -path=.:../translator
abstract NDTrans =
NDLift
,Extensions [CN,NP,AdA,AdV,CompoundCN,AdAdV,UttAdV,ApposNP]
,Documentation - [Pol,Tense]
,Dictionary - [Pol,Tense]
,Chunk
** {
flags
startcat = TransUnit ;
-- heuristic_search_factor=0.60;
-- meta_prob=1.0e-5;
-- meta_token_prob=1.1965149246222233e-9;
cat
TransUnit ;
fun
SFullstop : Phr -> TransUnit ;
SQuestmark : Phr -> TransUnit ;
SExclmark : Phr -> TransUnit ;
SUnmarked : Phr -> TransUnit ;
}

23
src/experimental/NDTransChi.gf
View File

@@ -1,23 +0,0 @@
--# -path=.:../translator
concrete NDTransChi of NDTrans =
NDLiftChi
,ExtensionsChi [CN,NP,AdA,AdV,CompoundCN,AdAdV,UttAdV,ApposNP]
,DictionaryChi - [Pol,Tense,Ant]
,DocumentationChi - [Pol,Tense,Ant]
,ChunkChi
** open ResChi, PredInstanceChi, (Pr=PredChi), Prelude in {
flags
literal=Symb ;
lincat
TransUnit = {s : Str} ;
lin
SFullstop p = {s = p.s ++ fullstop_s} ;
SQuestmark p = {s = p.s ++ questmark_s} ;
SExclmark p = {s = p.s ++ exclmark_s} ;
SUnmarked p = {s = p.s} ;
}

23
src/experimental/NDTransEng.gf
View File

@@ -1,23 +0,0 @@
--# -path=.:../translator
concrete NDTransEng of NDTrans =
NDLiftEng
,ExtensionsEng [CN,NP,AdA,AdV,CompoundCN,AdAdV,UttAdV,ApposNP]
,DictionaryEng - [Pol,Tense]
,DocumentationEng - [Pol,Tense]
,ChunkEng
** open ResEng, PredInstanceEng, Prelude, (Pr = PredEng) in {
flags
literal=Symb ;
lincat
TransUnit = {s : Str} ;
lin
SFullstop p = {s = p.s ++ "."} ;
SQuestmark p = {s = p.s ++ "?"} ;
SExclmark p = {s = p.s ++ "!"} ;
SUnmarked p = {s = p.s} ;
}

25
src/experimental/NDTransFin.gf
View File

@@ -1,25 +0,0 @@
--# -path=.:../finnish/stemmed:../finnish:../api:../translator:alltenses
concrete NDTransFin of NDTrans =
NDLiftFin
,ExtensionsFin [CN,NP,AdA,AdV,CompoundCN,AdAdV,UttAdV,ApposNP]
,DictionaryFin - [Pol,Tense]
,ChunkFin
,DocumentationFin - [Pol,Tense]
** {
flags
literal=Symb ;
lincat
TransUnit = {s : Str} ;
lin
SFullstop p = {s = p.s ++ "."} ;
SQuestmark p = {s = p.s ++ "?"} ;
SExclmark p = {s = p.s ++ "!"} ;
SUnmarked p = {s = p.s} ;
}

24
src/experimental/NDTransSwe.gf
View File

@@ -1,24 +0,0 @@
--# -path=.:../translator
concrete NDTransSwe of NDTrans =
NDLiftSwe
,ExtensionsSwe [CN,NP,AdA,AdV,CompoundCN,AdAdV,UttAdV,ApposNP]
,DictionarySwe - [Pol,Tense]
,DocumentationSwe - [Pol,Tense]
,ChunkSwe
** open CommonScand, ResSwe, PredInstanceSwe, (Pr=PredSwe), Prelude in {
flags
literal=Symb ;
lincat
TransUnit = {s : Str} ;
lin
SFullstop p = {s = p.s ++ "."} ;
SQuestmark p = {s = p.s ++ "?"} ;
SExclmark p = {s = p.s ++ "!"} ;
SUnmarked p = {s = p.s} ;
}

125
src/experimental/Pred.gf
View File

@@ -1,125 +0,0 @@
abstract Pred = Cat [Ant,NP,Utt,IP,IAdv,Conj,RS,RP,Subj] ** {
cat
Arg ;
PrV Arg ;
PrVP Arg ;
PrVPI Arg ;
VPC Arg ; -- conjunction of VP
Tense ;
Pol ;
PrCl Arg ;
ClC Arg ; -- conjunction of Cl
PrQCl Arg ;
PrAdv Arg ;
PrS ;
PrAP Arg ;
PrCN Arg ; -- the country he became the president of
fun
aNone, aS, aV, aQ, aA, aN : Arg ;
aNP : Arg -> Arg ;
TPres, TPast, TFut, TCond : Tense ;
PPos, PNeg : Pol ;
ASimul, AAnter : Ant ;
UseV : (a : Arg) -> Ant -> Tense -> Pol -> PrV a -> PrVP a ;
PassUseV : (a : Arg) -> Ant -> Tense -> Pol -> PrV (aNP a) -> PrVP a ;
AgentPassUseV : (a : Arg) -> Ant -> Tense -> Pol -> PrV (aNP a) -> NP -> PrVP a ;
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 -> 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) -> 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
UseNP : Ant -> Tense -> Pol -> NP -> PrVP aNone ; -- she is the person
UseS : Ant -> Tense -> Pol -> PrCl aNone -> PrVP aNone ; -- the fact is that she sleeps
UseQ : Ant -> Tense -> Pol -> PrQCl aNone -> PrVP aNone ; -- the question is who sleeps
UseVP : Ant -> Tense -> Pol -> PrVPI aNone -> PrVP aNone ; -- the goal is to sleep
PredVP : (a : Arg) -> NP -> PrVP a -> PrCl a ;
SlashClNP : (a : Arg) -> PrCl (aNP a) -> NP -> PrCl a ; -- slash consumption: hon tittar på + oss
ReflVP : (a : Arg) -> PrVP (aNP a) -> PrVP a ; -- refl on first position (direct object)
ReflVP2 : (a : Arg) -> PrVP (aNP (aNP a)) -> PrVP (aNP a) ; -- refl on second position (indirect object)
QuestVP : (a : Arg) -> IP -> PrVP a -> PrQCl a ;
QuestSlash : (a : Arg) -> IP -> PrQCl (aNP a) -> PrQCl a ;
QuestCl : (a : Arg) -> PrCl a -> PrQCl a ;
QuestIAdv : (a : Arg) -> IAdv -> PrCl a -> PrQCl a ;
QuestIComp : Ant -> Tense -> Pol -> IComp -> NP -> PrQCl aNone ; -- where is she
UseCl : PrCl aNone -> PrS ;
UseQCl : PrQCl aNone -> PrS ; -- deprecate QS
UseAdvCl : PrAdv aNone -> PrCl aNone -> PrS ; -- lift adv to front
UttPrS : PrS -> Utt ;
AdvCl : (a : Arg) -> PrAdv a -> PrCl aNone -> PrCl a ;
AdvQCl : (a : Arg) -> PrAdv a -> PrQCl aNone -> PrQCl a ;
-- relatives
RelCl : PrCl aNone -> RS ;
RelVP : RP -> PrVP aNone -> RS ;
RelSlash : RP -> PrCl (aNP aNone) -> RS ;
-- imperatives
PrImpSg : PrVP aNone -> Utt ;
PrImpPl : PrVP aNone -> Utt ;
-- participles as adjectives
PresPartAP : (a : Arg) -> PrV a -> PrAP a ;
PastPartAP : (a : Arg) -> PrV (aNP a) -> PrAP a ;
AgentPastPartAP : (a : Arg) -> PrV (aNP a) -> NP -> PrAP a ;
-- nominalization
NomVPNP : PrVPI aNone -> NP ; -- translating a document
-- other uses of VP's
ByVP : (a : Arg) -> PrVP a -> PrVPI aNone -> PrVP a ; -- by translating a document
WhenVP : (a : Arg) -> PrVP a -> PrVPI aNone -> PrVP a ; -- when translating a document
BeforeVP : (a : Arg) -> PrVP a -> PrVPI aNone -> PrVP a ; -- before translating a document
AfterVP : (a : Arg) -> PrVP a -> PrVPI aNone -> PrVP a ; -- after translating a document
InOrderVP : (a : Arg) -> PrVP a -> PrVPI aNone -> PrVP a ; -- in order to translate a document
WithoutVP : (a : Arg) -> PrVP a -> PrVPI aNone -> PrVP a ; -- without translating a document
-- PrVP coordination
StartVPC : (a : Arg) -> Conj -> PrVP a -> PrVP a -> VPC a ;
ContVPC : (a : Arg) -> PrVP a -> VPC a -> VPC a ;
UseVPC : (a : Arg) -> VPC a -> PrVP a ;
-- clause coordination, including "she loves and we look at (her)"
StartClC : (a : Arg) -> Conj -> PrCl a -> PrCl a -> ClC a ;
ContClC : (a : Arg) -> PrCl a -> ClC a -> ClC a ;
UseClC : (a : Arg) -> ClC a -> PrCl a ;
ComplAdv : (a : Arg) -> PrAdv (aNP a) -> NP -> PrAdv a ; -- typically: formation of preposition phrase
-- subjunction ; we want to preserve the order in translation
-- Pre is more specialized to make inverted S order
---- Imp to do
SubjUttPreS : Subj -> PrCl aNone -> PrCl aNone -> Utt ;
SubjUttPreQ : Subj -> PrCl aNone -> PrQCl aNone -> Utt ;
SubjUttPost : Subj -> PrCl aNone -> Utt -> Utt ;
}

184
src/experimental/PredChi.gf
View File

@@ -1,184 +0,0 @@
concrete PredChi of Pred =
CatChi [NP,Utt,IP,IAdv,IComp,Conj,RP,RS,Imp,Subj] **
PredFunctor - [UseNP,ComplV2,SlashV3,ContVPC, StartVPC, StartClC,
RelVP, RelSlash, QuestVP, QuestSlash, QuestIComp,PredVP,
SubjUttPreS, SubjUttPreQ, SubjUttPost,
UseAdv, ComplAdv, UseAdvCl, AdvQCl, AdvCl
]
with
(PredInterface = PredInstanceChi) ** open ResChi, (P = ParadigmsChi), TenseX in {
lincat
Ant = {s : Str ; a : PredInstanceChi.Anteriority} ;
lin
UseNP a t p np = useCopula a t p ** {
adj = \\a => np.s
} ;
UseAdv x a t p adv =
let verb = case adv.advType of {
ATPlace True => liftV noVerb ;
_ => liftV zai_V
}
in initPrVerbPhraseV a t p verb ** {
adv = adv.prepPre ++ adv.prepPost ;
} ;
ComplAdv x p np = {prepPre = appComplCase p np ; prepPost = [] ; advType = p.advType} ;
UseAdvCl adv cl = {s = adv.prepPre ++ adv.prepPost ++ declInvCl cl} ;
AdvCl, AdvQCl = \x,adv,cl ->
let advs = adv.prepPre ++ adv.prepPost in
case adv.advType of {
ATManner => cl ** {obj1 = deVAdv_s ++ advs ++ cl.obj1} ; -- he sleeps *well*
ATPlace True => cl ** {adv = cl.adv ++ advs} ; -- he today *in the house* sleeps
ATPlace False => cl ** {adv = cl.adv ++ zai_V.s ++ advs} ; -- he today *here* sleeps
ATTime | _ => cl ** {adv = advs ++ cl.adv} -- he *today* here sleeps ---- also: **today** he here sleeps
} ;
ComplV2 x vp np = vp ** {
obj1 : (Agr => Str) * Agr = <\\a => appObjCase np, UUnit>
} ;
SlashV3 x vp np = addObj2VP vp (\\a => np.s) ;
RelVP rp vp =
let
rpa = UUnit ;
cl : PrClause = vp ** {
v = applyVerb vp (agr2vagr rpa) ;
subj = rp.s ;
adj = vp.adj ! rpa ;
obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! rpa ; ---- apply complCase ---- place of part depends on obj
obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => rpa ; False => vp.obj1.p2}) ; ---- apply complCase
c3 = noComplCase ; -- for one more prep to build ClSlash
}
in {s = declCl cl ; c = subjCase} ;
RelSlash rp cl = {
s = rp.s ++ declCl cl ; ---- rp case
c = objCase
} ;
PredVP x np vp =
let npa = UUnit in
vp ** {
v = applyVerb vp (agr2vagr npa) ;
subj = appSubjCase np ;
adj = vp.adj ! npa ;
obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! npa ; ---- apply complCase ---- place of part depends on obj
obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! npa ;
c3 = vp.c1 ; -- in case there is any free slot left ---- could be c2
} ;
StartVPC x c v w = { ---- some loss of quality seems inevitable
v = \\a =>
let
vv = v.v ! a ;
wv = w.v ! a ;
vpa = vagr2agr a ;
in
vv.p1 ++ v.adV ++ vv.p2 ++ vv.p3 ++ v.adj ! vpa ++
appPrep v.c1 (v.obj1.p1 ! vpa) ++ appPrep v.c2 (v.obj2.p1 ! vpa) ++ v.adv ++ v.ext
++ (c.s ! CPhr CVPhrase).s2 ++
wv.p1 ++ w.adV ++ wv.p2 ++ wv.p3 ++ w.adj ! vpa ++ ---- appComplCase
appPrep w.c1 (w.obj1.p1 ! vpa) ++ appPrep w.c2 (w.obj2.p1 ! vpa) ++ w.adv ++ w.ext ;
inf = \\a,vt =>
infVP vt a v ++ (c.s ! CPhr CVPhrase).s2 ++ infVP vt a w ;
imp = \\i =>
impVP i v ++ (c.s ! CPhr CVPhrase).s2 ++ impVP i w ;
c1 = noComplCase ; ---- w.c1 ? --- the full story is to unify v and w...
c2 = noComplCase ; ---- w.c2 ?
s1 = (c.s ! CPhr CVPhrase).s1 ;
} ;
ContVPC x v w = { ---- some loss of quality seems inevitable
v = \\a =>
let
vv = v.v ! a ;
wv = w.v ! a ;
vpa = vagr2agr a ;
in
vv.p1 ++ v.adV ++ vv.p2 ++ vv.p3 ++ v.adj ! vpa ++
appPrep v.c1 (v.obj1.p1 ! vpa) ++ appPrep v.c2 (v.obj2.p1 ! vpa) ++ v.adv ++ v.ext ---- appComplCase
++ "," ++
wv ;
inf = \\a,vt =>
infVP vt a v ++ "," ++ w.inf ! a ! vt ;
imp = \\i =>
impVP i v ++ "," ++ w.imp ! i ;
c1 = noComplCase ; ---- w.c1 ? --- the full story is to unify v and w...
c2 = noComplCase ; ---- w.c2 ?
s1 = w.s1 ;
} ;
StartClC x c a b = {
s = declCl a ++ (c.s ! CSent).s2 ++ declCl b ;
c3 = b.c3 ; ----
s1 = (c.s ! CSent).s1 ;
} ;
QuestVP x ip vp =
let
ipa = ipagr2agr UUnit
in {
v = applyVerb vp UUnit ;
foc = ip.s ;
focType = FocSubj ;
subj = [] ;
adj = vp.adj ! ipa ;
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 ;
ext = vp.ext ;
} ;
QuestSlash x ip cl =
let
prep = cl.c3 ;
ips = ip.s ; -- in Cl/NP, c3 is the only prep ---- appComplCase for ip
focobj = case cl.focType of {
NoFoc => <ips, [], FocObj,prep> ; -- put ip object to focus if there is no focus yet
t => <[], strComplCase prep ++ ips, t,noComplCase> -- put ip object in situ if there already is a focus
} ;
in
cl ** { -- preposition stranding
foc = focobj.p1 ;
focType = focobj.p3 ;
obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field?
c3 = focobj.p4 ;
} ;
QuestIComp a t p icomp np =
let vagr = UUnit in
initPrClause ** {
v = tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ;
subj = appSubjCase np ;
adV = negAdV p ;
foc = icomp.s ;
focType = FocObj ;
} ;
NomVPNP vp = ss (vp.s ! UUnit ! UUnit) ;----
SubjUttPreS subj cl s = ss (subj.prePart ++ declSubordCl cl ++ subj.sufPart ++ declInvCl s) ;
SubjUttPreQ subj cl q = ss (subj.prePart ++ declSubordCl cl ++ subj.sufPart ++ questCl q) ;
SubjUttPost subj cl utt = ss (utt.s ++ subj.prePart ++ declSubordCl cl ++ subj.sufPart) ;
---- todo
AfterVP,
BeforeVP,
ByVP,
InOrderVP,
WhenVP,
WithoutVP
= variants {} ;
}

135
src/experimental/PredEng.gf
View File

@@ -1,135 +0,0 @@
concrete PredEng of Pred =
CatEng [Ant,NP,Utt,IP,IAdv,IComp,Conj,RP,RS,Subj] **
PredFunctor - [
-- for all these, special qforms added in Eng
PassUseV,
AgentPassUseV,
UseVPC,
PredVP,
QuestVP,
RelVP,
UseCN, -- insert article
UseCl, -- for contracted forms
QuestIComp ---- IComp has no parameters in Eng
]
with
(PredInterface = PredInstanceEng)
** open PredInstanceEng, (R = ResEng) in {
-- overrides
lin
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 ;
vc = \\agr => tenseVContracted (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 ;
obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
} ;
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 ;
v = \\agr => tenseVContracted (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 ;
obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
adv = appComplCase agentCase np ;
qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
} ;
UseCN x a t p cn = useCopula a t p ** {
c1 = cn.c1 ;
c2 = cn.c2 ;
adj = \\a => case agr2nagr a of {Sg => R.artIndef ++ cn.s ! Sg ; Pl => cn.s ! Pl} ;
obj1 = <cn.obj1, defaultAgr> ;
} ;
PredVP x np vp = vp ** {
v = applyVerb vp (agr2vagr np.a) ;
vc = vp.vc ! (agr2vagr np.a) ;
subj = appSubjCase np ;
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 = vp.c1 ; -- in case there is any free slot left ---- could be c2
qforms = qformsVP vp (agr2vagr np.a) ;
} ;
QuestVP x ip vp =
let
ipa = ipagr2agr ip.n
in {
v = applyVerb vp (ipagr2vagr ip.n) ;
vc = vp.vc ! (ipagr2vagr ip.n) ;
foc = ip.s ! subjCase ;
focType = FocSubj ;
subj = [] ;
adj = vp.adj ! ipa ;
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 ;
ext = vp.ext ;
qforms = qformsVP vp (ipagr2vagr ip.n) ;
} ;
UseCl cl = {s = declCl cl}
| {s = declClContracted cl} ;
RelVP rp vp =
let
cl : Agr -> PrClause = \a ->
let rpa = rpagr2agr rp.a a in
vp ** {
v = applyVerb vp (agr2vagr rpa) ;
vc = vp.vc ! (agr2vagr rpa) ;
subj = rp.s ! subjRPCase a ;
adj = vp.adj ! rpa ;
obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! rpa ; ---- apply complCase ---- place of part depends on obj
obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => rpa ; False => vp.obj1.p2}) ; ---- apply complCase
c3 = noComplCase ; -- for one more prep to build ClSlash
qforms = qformsVP vp (agr2vagr rpa) ;
}
in {s = \\a => declCl (cl a) ; c = subjCase} ;
UseVPC x vpc = initPrVerbPhrase ** { ---- big loss of quality (overgeneration) seems inevitable
v = \\a => <[], [], vpc.s1 ++ vpc.v ! a> ;
inf = \\vt => vpc.inf ! defaultAgr ! vt ; ---- agr
imp = vpc.imp ;
c1 = vpc.c1 ;
c2 = vpc.c2 ;
qforms = \\a => <"do", vpc.inf ! defaultAgr ! vvInfinitive> ; ---- do/does/did
} ;
lin
QuestIComp a t p icomp np =
let vagr = (agr2vagr np.a) in
initPrClause ** {
v = tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ;
vc = tenseCopulaC (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ;
subj = np.s ! subjCase ;
foc = icomp.s ;
focType = FocObj ;
qforms = qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ;
} ;
-- not in functor anyway
NomVPNP vpi = {
s = \\c => vpi.s ! R.VVPresPart ! defaultAgr ;
a = defaultAgr
} ;
ByVP x vp vpi = vp ** {adv = "by" ++ vpi.s ! R.VVPresPart ! defaultAgr} ; ---- agr
WhenVP x vp vpi = vp ** {adv = "when" ++ vpi.s ! R.VVPresPart ! defaultAgr} ; ---- agr
BeforeVP x vp vpi = vp ** {adv = "before" ++ vpi.s ! R.VVPresPart ! defaultAgr} ; ---- agr
AfterVP x vp vpi = vp ** {adv = "after" ++ vpi.s ! R.VVPresPart ! defaultAgr} ; ---- agr
InOrderVP x vp vpi = vp ** {adv = "in order" ++ vpi.s ! R.VVInf ! defaultAgr} ; ---- agr
WithoutVP x vp vpi = vp ** {adv = "without" ++ vpi.s ! R.VVPresPart ! defaultAgr} ; ---- agr
}

243
src/experimental/PredFin.gf
View File

@@ -1,243 +0,0 @@
--# -path=.:../finnish/stemmed:../finnish:../common:alltenses
concrete PredFin of Pred =
CatFin [Ant,NP,Utt,IP,IAdv,IComp,Conj,Subj,RP,RS] **
PredFunctor
- [
-- overridden
UseV
,UseAP
,UseNP
,UseCN
,QuestVP
,PredVP
,ComplV2
,ReflVP2
,ReflVP
,RelVP
,RelSlash
,QuestIComp
,PassUseV
,PresPartAP
,PastPartAP
,AgentPastPartAP
,AgentPassUseV
,UseVPC
,StartVPC
,ContVPC
,ComplVV
,SlashV2V
]
with
(PredInterface = PredInstanceFin) ** open PredInstanceFin, (S = StemFin), ResFin in {
lin
ComplVV x vp vpo = addObj2VP vp (\\a => vpo.s ! VPIVV vp.vvtype ! a) ;
SlashV2V x vp vpo = addObj2VP vp (\\a => vpo.s ! VPIVV vp.vvtype ! a) ;
UseV x a t p verb = initPrVerbPhraseV a t p verb ;
UseAP x a t p ap = useCopula a t p ** {
c1 = ap.c1 ;
c2 = ap.c2 ;
adj = \\a => ap.s ! agr2aagr a ;
} ;
UseNP a t p np = useCopula a t p ** {
adj = \\a => np.s ! subjCase ;
} ;
UseCN x a t p cn = useCopula a t p ** {
c1 = cn.c1 ;
c2 = cn.c2 ;
adj = \\a => cn.s ! agr2nagr a ;
} ;
ComplV2 x vp np = vp ** {
obj1 = \\_ => appCompl True Pos vp.c1 np ; ---- True,Pos ?
} ;
PredVP x np vp = vp ** {
subj : Str = appSubjCase vp.sc np ;
verb : {fin,inf : Str} = vp.v ! np.a ;
adj : Str = vp.adj ! np.a ;
obj1 : Str = vp.obj1 ! np.a ;
obj2 : Str = vp.obj2 ! np.a ;
c3 : Compl = vp.c1 ; ---- could be c2
} ;
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 ;
adj : Str = vp.adj ! ipa ;
obj1 : Str = vp.obj1 ! ipa ;
obj2 : Str = vp.obj2 ! ipa ;
c3 : Compl = noComplCase ;
qforms = \\_ => <[],[]> ;
} ;
QuestIComp a t p icomp np =
let
vagr = (agr2vagr np.a)
in
initPrClause ** {
v = tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ;
subj = np.s ! subjCase ;
foc = icomp.s ! np.a ;
focType = FocObj ;
qforms = qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ;
} ;
RelVP rp vp =
let
cl : Agr -> PrClause = \a ->
let
rpa = rpagr2agr rp.a a ;
rnp = {s = rp.s ! (complNumAgr rpa) ; a = rpa ; isPron = False}
in
vp ** {
v = applyVerb vp (agr2vagr rpa) ;
subj : Str = appSubjCase vp.sc rnp ;
verb : {fin,inf : Str} = vp.v ! rpa ;
adj : Str = vp.adj ! rpa ;
obj1 : Str = vp.obj1 ! rpa ;
obj2 : Str = vp.obj2 ! rpa ;
c3 : Compl = noComplCase ;
}
in {s = \\a => declCl (cl a) ; c = subjCase} ; ---- case
RelSlash rp cl = {
s = \\a =>
let
rpa = rpagr2agr rp.a a ;
rnp = appCompl True Pos cl.c3 {s = rp.s ! (complNumAgr rpa) ; a = rpa ; isPron = False}
in
rnp ++ declCl cl ;
c = objCase ---- case
} ;
NomVPNP vpi = {
s = \\c => vpi.s ! vvInfinitive ! defaultAgr ;
isNeg = False ; ----
isPron = False ; ----
a = defaultAgr
} ;
PassUseV x a t p verb = initPrVerbPhraseV a t p verb ** {
v : Agr => {fin,inf : Str} = case verb.sc of {
SCNom => \\agr => finV (a.s ++ t.s ++ p.s) t.t a.a p.p Pass agr (lin PrV verb) ;
_ => \\_ => finV (a.s ++ t.s ++ p.s) t.t a.a p.p Pass defaultAgr (lin PrV verb)
} ;
inf : VPIType => Str = \\vtt => tenseInfV (a.s ++ p.s) a.a p.p Pass (lin PrV verb) vtt ; ---- still Act
imp : ImpType => Str = \\it => imperativeV p.s p.p it (lin PrV verb) ; ---- still Act
isPass : Bool = True ;
c1 : Compl = noComplCase ;
c2 : Compl = verb.c2 ;
vvtype = verb.vvtype ;
sc = npform2subjcase verb.c1.c ;
h = case a.a of {Anter => Back ; _ => verb.h} ;
} ;
AgentPassUseV x a t p verb np = initPrVerbPhraseV a t p verb ** {
sc = npform2subjcase verb.c1.c ;
obj1 = \\a => appSubjCase verb.sc np ;
} ;
PresPartAP x v = {
s = \\a => vPresPart v a ;
c1 = v.c1 ; -- looking at her
c2 = v.c2 ;
obj1 = noObj ;
} ;
PastPartAP x v = {
s = \\a => vPastPart v a ;
c1 = v.c1 ; -- looking at her
c2 = v.c2 ;
obj1 = noObj ;
} ;
AgentPastPartAP x v np = {
s = \\a => (S.sverb2verbSep v).s ! AgentPart (aForm a) ;
c1 = v.c1 ;
c2 = v.c2 ;
obj1 = \\_ => appComplCase agentCase np ; ---- addObj
} ;
StartVPC x c v w = { ---- some loss of quality seems inevitable
v = \\a =>
let
vv = v.v ! a ;
wv = w.v ! a ;
vpa = vagr2agr a ;
in
vv.fin ++ v.adV ++ vv.inf ++ v.adj ! vpa ++
v.obj1 ! vpa ++ v.obj2 ! vpa ++ v.adv ++ v.ext
++ c.s2 ++
wv.fin ++ w.adV ++ wv.inf ++ w.adj ! vpa ++
w.obj1 ! vpa ++ w.obj2 ! vpa ++ w.adv ++ w.ext ;
inf = \\a,vt =>
infVP vt a v ++ c.s2 ++ infVP vt a w ;
imp = \\i =>
impVP i v ++ c.s2 ++ impVP i 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
v = \\a =>
let
vv = v.v ! a ;
wv = w.v ! a ;
vpa = vagr2agr a ;
in
vv.fin ++ v.adV ++ vv.inf ++ v.adj ! vpa ++
v.obj1 ! vpa ++ v.obj2 ! vpa ++ v.adv ++ v.ext
++ "," ++
wv ;
inf = \\a,vt =>
infVP vt a v ++ "," ++ w.inf ! a ! vt ;
imp = \\i =>
impVP i v ++ "," ++ w.imp ! i ;
c1 = noComplCase ; ---- w.c1 ? --- the full story is to unify v and w...
c2 = noComplCase ; ---- w.c2 ?
s1 = w.s1 ;
} ;
UseVPC x vpc = initPrVerbPhrase ** { ---- big loss of quality (overgeneration) seems inevitable
v = \\a => {fin = vpc.s1 ++ vpc.v ! a ; inf = []} ;
inf = \\vt => vpc.inf ! defaultAgr ! vt ; ---- agr
imp = vpc.imp ;
c1 = vpc.c1 ;
c2 = vpc.c2 ;
} ;
ByVP x vp vpi = vp ** {adv = vpi.s ! VPIInf3Adess ! defaultAgr} ; -- tekemällä
WhenVP x vp vpi = vp ** {adv = vpi.s ! VPIInf2Iness ! defaultAgr} ; -- tehdessä ---- agr
BeforeVP x vp vpi = vp ** {adv = "ennen" ++ vpi.s ! VPIInf4Part ! defaultAgr} ; -- ennen tekemistä
InOrderVP x vp vpi = vp ** {adv = vpi.s ! VPIInf1Long ! defaultAgr} ; -- tehdäkseen ---- agr
WithoutVP x vp vpi = vp ** {adv = vpi.s ! VPIInf3Abess ! defaultAgr} ; -- tekemättä
AfterVP -- tehtyä
= variants {} ;
}

372
src/experimental/PredFunctor.gf
View File

@@ -1,372 +0,0 @@
incomplete concrete PredFunctor of Pred = Cat [Ant,NP,Utt,IP,IAdv,IComp,Conj,RP,RS,Subj,Imp] **
open
PredInterface,
ParamX,
Prelude
in {
------------------------------------
-- lincats
-------------------------------------
lincat
Tense = {s : Str ; t : PredInterface.STense} ;
Pol = {s : Str ; p : PredInterface.Polarity} ;
Arg = {s : Str} ;
PrV = PrVerb ;
PrVP = PrVerbPhrase ;
PrCl = PrClause ;
PrQCl = PrQuestionClause ;
PrVPI = {s : PredInterface.VVType => Agr => Str} ;
VPC = {
v : VAgr => Str ;
inf : Agr => PredInterface.VVType => Str ;
imp : ImpType => Str ;
c1 : ComplCase ;
c2 : ComplCase ;
s1 : Str ; -- storing both in both-and
} ;
ClC = {
s : Str ;
c3 : ComplCase ;
s1 : Str ;
} ;
PrAdv = PrAdverb ;
PrS = {s : Str} ;
PrAP = {
s : AAgr => Str ;
c1, c2 : ComplCase ;
obj1 : Agr => Str
} ;
PrCN = {
s : NAgr => Str ;
c1, c2 : ComplCase ;
obj1 : Agr => Str
} ;
-- reference linearizations for chunking
linref
PrVP = linrefPrVP ;
PrCl = linrefPrCl ;
PrQCl = linrefPrQCl ;
PrAdv = linrefPrAdv ;
----------------------------
--- linearization rules ----
----------------------------
lin
-- standard general
TPres = {s = [] ; t = Pres} ;
TPast = {s = [] ; t = Past} ;
TFut = {s = [] ; t = Fut} ;
TCond = {s = [] ; t = Cond} ;
ASimul = {s = [] ; a = Simul} ;
AAnter = {s = [] ; a = Anter} ;
PPos = {s = [] ; p = Pos} ;
PNeg = {s = [] ; p = Neg} ;
-- predication specific
aNone, aS, aV, aA, aQ, aN = {s = []} ;
aNP a = a ;
UseV x a t p v = initPrVerbPhraseV 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 ;
obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
} ;
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 ;
obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
adv = appComplCase agentCase np ;
} ;
UseAP x a t p ap = useCopula a t p ** {
c1 = ap.c1 ;
c2 = ap.c2 ;
adj = \\a => ap.s ! agr2aagr a ;
obj1 = <ap.obj1, defaultAgr> ;
} ;
UseCN x a t p cn = useCopula a t p ** {
c1 = cn.c1 ;
c2 = cn.c2 ;
adj = \\a => cn.s ! agr2nagr a ;
obj1 = <cn.obj1, defaultAgr> ;
} ;
UseAdv x a t p adv = useCopula a t p ** {
c1 = adv.c1 ;
adj = \\a => adv.s ;
} ;
UseNP a t p np = useCopula a t p ** {
adj = \\a => appSubjCase np ;
} ;
UseS a t p cl = addExtVP (useCopula a t p) (that_Compl ++ declSubordCl cl) ; ---- sentence form
UseQ a t p cl = addExtVP (useCopula a t p) (questSubordCl cl) ;
UseVP a t p vp = addExtVP (useCopula a t p) (vp.s ! vvInfinitive ! defaultAgr) ;
ComplV2 x vp np = vp ** {
obj1 = <\\a => appObjCase np, np.a> -- np.a for object control
} ;
ComplVS x vp cl = addExtVP vp (that_Compl ++ declSubordCl cl) ; ---- sentence form
ComplVQ x vp qcl = addExtVP vp (questSubordCl qcl) ; ---- question form
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
ComplVN x vp cn = addObj2VP vp (\\a => cn.s ! agr2nagr a ++ cn.obj1 ! a) ; ---- cnForm
SlashV3 x vp np = addObj2VP vp (\\a => appObjCase np) ; -- control is preserved
SlashV2S x vp cl = addExtVP vp (that_Compl ++ declSubordCl cl) ; ---- sentence form
SlashV2Q x vp cl = addExtVP vp (questSubordCl cl) ; ---- question form
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
SlashV2N x vp cn = addObj2VP vp (\\a => cn.s ! agr2nagr a ++ cn.obj1 ! a) ; ---- cn form
ReflVP x vp = vp ** {
obj1 = <\\a => reflPron a, defaultAgr> ; --- defaultAgr will not be used but subj.a instead
} ;
ReflVP2 x vp = vp ** {
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 = applyVerb vp (agr2vagr np.a) ;
subj = appSubjCase np ;
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 = vp.c1 ; -- in case there is any free slot left ---- could be c2
} ;
SlashClNP x cl np = cl ** { -- Cl ::= Cl/NP NP
obj2 = cl.obj2 ++ appComplCase cl.c3 np ; ---- again, adv just added
c3 = noComplCase ; -- complCase has been consumed
} ;
QuestCl x cl = cl ** {foc = [] ; focType = NoFoc} ; -- NoFoc implies verb first: does she love us
QuestIAdv x iadv cl = cl ** {foc = iadv.s ; focType = FocObj} ; -- FocObj implies Foc + V + Subj: why does she love us
QuestVP x ip vp =
let
ipa = ipagr2agr ip.n
in {
v = applyVerb vp (ipagr2vagr ip.n) ;
foc = ip.s ! subjCase ;
focType = FocSubj ;
subj = [] ;
adj = vp.adj ! ipa ;
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 ;
ext = vp.ext ;
} ;
QuestSlash x ip cl =
let
prep = cl.c3 ;
ips = ip.s ! objCase ; -- in Cl/NP, c3 is the only prep ---- appComplCase for ip
focobj = case cl.focType of {
NoFoc => <ips, [], FocObj,prep> ; -- put ip object to focus if there is no focus yet
t => <[], strComplCase prep ++ ips, t,noComplCase> -- put ip object in situ if there already is a focus
} ;
in
cl ** { -- preposition stranding
foc = focobj.p1 ;
focType = focobj.p3 ;
obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field?
c3 = focobj.p4 ;
} ;
{-
---- this is giving four records instead of two AR 5/2/2014
|
cl ** { -- pied piping
foc = focobj.p4 ++ focobj.p1 ;
focType = focobj.p3 ;
obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field?
c3 = noComplCase ;
} ;
-}
QuestIComp a t p icomp np =
let vagr = (agr2vagr np.a) in
initPrClause ** {
v = tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ;
subj = appSubjCase np ;
adV = negAdV p ;
foc = icomp.s ! agr2icagr np.a ;
focType = FocObj ;
} ;
RelVP rp vp =
let
cl : Agr -> PrClause = \a ->
let rpa = rpagr2agr rp.a a in
vp ** {
v = applyVerb vp (agr2vagr rpa) ;
subj = rp.s ! subjRPCase a ;
adj = vp.adj ! rpa ;
obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! rpa ; ---- apply complCase ---- place of part depends on obj
obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => rpa ; False => vp.obj1.p2}) ; ---- apply complCase
c3 = noComplCase ; -- for one more prep to build ClSlash
}
in {s = \\a => declCl (cl a) ; c = subjCase} ;
RelSlash rp cl = {
s = \\a => rp.s ! subjRPCase (rpagr2agr rp.a a) ++ declCl cl ; ---- rp case
c = objCase
} ;
PrImpSg vp = {s = impVP Sg vp} ;
PrImpPl vp = {s = impVP Pl vp} ;
UseCl cl = {s = declCl cl} ;
UseQCl cl = {s = questCl cl} ;
UseAdvCl adv cl = {s = adv.s ++ declInvCl cl} ;
UttPrS s = s ;
AdvCl x a cl = case a.isAdV of {
True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ;
False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1}
} ;
AdvQCl x a cl = case a.isAdV of {
True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ;
False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1}
} ;
PresPartAP x v = {
s = \\a => vPresPart v a ;
c1 = v.c1 ; -- looking at her
c2 = v.c2 ;
obj1 = noObj ;
} ;
PastPartAP x v = {
s = \\a => vPastPart v a ;
c1 = v.c1 ;
c2 = v.c2 ;
obj1 = noObj ;
} ;
AgentPastPartAP x v np = {
s = \\a => vPastPart v a ;
c1 = v.c1 ;
c2 = v.c2 ;
obj1 = \\_ => appComplCase agentCase np ; ---- addObj
} ;
StartVPC x c v w = { ---- some loss of quality seems inevitable
v = \\a =>
let
vv = v.v ! a ;
wv = w.v ! a ;
vpa = vagr2agr a ;
in
vv.p1 ++ v.adV ++ vv.p2 ++ vv.p3 ++ v.adj ! vpa ++
v.c1 ++ v.obj1.p1 ! vpa ++ v.c2 ++ v.obj2.p1 ! vpa ++ v.adv ++ v.ext ---- appComplCase
++ c.s2 ++
wv.p1 ++ w.adV ++ wv.p2 ++ wv.p3 ++ w.adj ! vpa ++ ---- appComplCase
w.c1 ++ w.obj1.p1 ! vpa ++ w.c2 ++ w.obj2.p1 ! vpa ++ w.adv ++ w.ext ;
inf = \\a,vt =>
infVP vt a v ++ c.s2 ++ infVP vt a w ;
imp = \\i =>
impVP i v ++ c.s2 ++ impVP i 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
v = \\a =>
let
vv = v.v ! a ;
wv = w.v ! a ;
vpa = vagr2agr a ;
in
vv.p1 ++ v.adV ++ vv.p2 ++ vv.p3 ++ v.adj ! vpa ++
v.c1 ++ v.obj1.p1 ! vpa ++ v.c2 ++ v.obj2.p1 ! vpa ++ v.adv ++ v.ext ---- appComplCase
++ "," ++
wv ;
inf = \\a,vt =>
infVP vt a v ++ "," ++ w.inf ! a ! vt ;
imp = \\i =>
impVP i v ++ "," ++ w.imp ! i ;
c1 = noComplCase ; ---- w.c1 ? --- the full story is to unify v and w...
c2 = noComplCase ; ---- w.c2 ?
s1 = w.s1 ;
} ;
UseVPC x vpc = initPrVerbPhrase ** { ---- big loss of quality (overgeneration) seems inevitable
v = \\a => <[], [], vpc.s1 ++ vpc.v ! a> ;
inf = \\vt => vpc.inf ! defaultAgr ! vt ; ---- agr
imp = vpc.imp ;
c1 = vpc.c1 ;
c2 = vpc.c2 ;
} ;
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 = initPrClause ** {
v = <[],[], cl.s1 ++ cl.s> ; ----
c3 = cl.c3 ;
} ;
ComplAdv x p np = {s = appComplCase p.c1 np ; isAdV = p.isAdV ; c1 = noComplCase} ;
SubjUttPreS subj cl s = ss (subj.s ++ declSubordCl cl ++ ("," | []) ++ declInvCl s) ;
SubjUttPreQ subj cl q = ss (subj.s ++ declSubordCl cl ++ ("," | []) ++ questCl q) ;
SubjUttPost subj cl utt = ss (utt.s ++ ("," | []) ++ subj.s ++ declSubordCl cl) ;
}

188
src/experimental/PredInstanceChi.gf
View File

@@ -1,188 +0,0 @@
instance PredInstanceChi of
PredInterface - [PrVerb,initPrVerb,NounPhrase,appSubjCase,appObjCase,PrAdverb,linrefPrAdv] =
open ResChi, (P = ParadigmsChi), (X = ParamX), (S = SyntaxChi), Prelude in {
-- overrides
oper
PrVerb = {
s : ResChi.Verb ;
p : Str ; -- verb particle
c1 : ComplCase ;
c2 : ComplCase ;
hasPrep : Bool ;
isSubjectControl : Bool ; --- junk in Chi
vtype : VType ;
vvtype : VVType ;
} ;
NounPhrase = {s : Str} ;
appSubjCase : NounPhrase -> Str = \np -> np.s ;
appObjCase : NounPhrase -> Str = \np -> np.s ;
PrAdverb = Preposition ;
linrefPrAdv : PrAdverb -> Str = \adv -> adv.prepPre ++ adv.prepPost ;
---------------------
-- parameters -------
---------------------
oper
Gender = Unit ;
Agr = Unit ;
Case = Unit ;
NPCase = Unit ;
VForm = Unit ; ----
VVType = Unit ; ----
VType = Unit ; ----
VAgr = Unit ;
SVoice = CVoice ;
param CVoice = CAct | CPass ;
oper
active = CAct ;
passive = CPass ;
defaultVType = UUnit ; ----
subjCase = UUnit ;
objCase = UUnit ;
agentCase : ComplCase = S.by8agent_Prep ;
ComplCase = Preposition ;
appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> appPrep p np.s ; ---- advType
noComplCase : ComplCase = P.mkPrep [] ;
strComplCase : ComplCase -> Str = \c -> c.prepPre ++ c.prepPost ;
noObj : Agr => Str = \\_ => [] ;
RPCase = Unit ;
subjRPCase : Agr -> RPCase = \a -> UUnit ;
NAgr = Unit ;
IPAgr = Unit ;
RPAgr = Unit ;
ICAgr = Unit ;
defaultAgr : Agr = UUnit ;
-- omitting rich Agr information
agr2vagr : Agr -> VAgr = \a -> a ;
agr2aagr : Agr -> AAgr = \a -> a ;
agr2icagr : Agr -> ICAgr = \a -> a ;
agr2nagr : Agr -> NAgr = \a -> a ;
-- restoring full Agr
ipagr2agr : IPAgr -> Agr = \a -> a ;
ipagr2vagr : IPAgr -> VAgr = \n -> n ;
rpagr2agr : RPAgr -> Agr -> Agr = \ra,a -> a ;
--- this is only needed in VPC formation
vagr2agr : VAgr -> Agr = \a -> defaultAgr ;
vPastPart : PrVerb -> AAgr -> Str = \v,a -> v.s.s ; ----
vPresPart : PrVerb -> AAgr -> Str = \v,a -> v.s.s ; ----
vvInfinitive : VVType = UUnit ; ----
isRefl : PrVerb -> Bool = \v -> False ; ----
------------------
--- opers --------
------------------
oper
reflPron : Agr -> Str = \a -> (ResChi.mkNP ResChi.reflPron).s ;
infVP : VVType -> Agr -> PrVerbPhrase -> Str = \vt, a,vp ->
vp.adV ++ vp.adv ++ ---- adv order
vp.inf ! UUnit ++
vp.adj ! a ++ appPrep vp.c1 (vp.obj1.p1 ! a) ++ appPrep vp.c2 (vp.obj2.p1 ! a) ++ vp.ext ;
impVP : Number -> PrVerbPhrase -> Str = \n,vp ->
infVP UUnit UUnit vp ;
declCl : PrClause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.adv ++ cl.v.p2 ++ restCl cl ;
declSubordCl : PrClause -> Str = declCl ;
declInvCl : PrClause -> Str = declCl ;
questCl : PrQuestionClause -> Str = \cl ->
cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.adv ++ cl.v.p2 ++ restCl cl ++ question_s ; ---- plus redupl
questSubordCl : PrQuestionClause -> Str = questCl ;
that_Compl : Str = say_s ;
-- this part is usually the same in all reconfigurations
restCl : PrClause -> Str = \cl -> cl.v.p3 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.ext ; ---- c3
negAdV : {s : Str ; p : Polarity} -> Str = \p -> p.s ; ---- not used in negation formation ++ not_Str p.p ;
not_Str = \p -> case p of {Pos => [] ; Neg => neg_s} ;
tenseV : Str -> STense -> Anteriority -> Polarity -> SVoice -> VAgr -> PrVerb -> Str * Str * Str =
\sta,t,a,p,o,_,v ->
let
bu_neg = not_Str p ;
vneg = case p of {Pos => [] ; Neg => v.s.neg} ;
pass = case o of {CAct => [] ; CPass => passive_s}
in case <t,a> of {
<X.Past,_> => <sta ++ pass, bu_neg, v.s.s ++ v.s.pp> ;
<_,X.Anter> => <sta ++ pass, bu_neg, v.s.s ++ v.s.pp> ;
_ => <sta ++ pass, vneg, v.s.s>
} ; ---- other aspects
tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str = \sa,a,p,o,v,_ -> ---- vvtype
let tv = tenseV sa X.Pres a p o UUnit v
in tv.p1 ++ tv.p2 ++ tv.p3 ;
imperativeV : Str -> Polarity -> ImpType -> PrVerb -> Str = \s,p,it,v ->
tenseInfV s X.Simul p CAct v UUnit ;
tenseCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str =
\s,t,a,p,agr -> tenseV s t a p CAct agr (liftV copula) ;
tenseInfCopula : Str -> Anteriority -> Polarity -> VVType -> Str =
\s,a,p,vt -> tenseInfV s a p CAct (liftV copula) vt ;
tenseImpCopula : Str -> Polarity -> ImpType -> Str =
\s,p,n -> imperativeV s p n (liftV copula) ;
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 ;
} ;
liftV : Verb -> PrVerb = \v ->
{s = v ; p = [] ; c1,c2 = P.mkPrep [] ; isSubjectControl = False ; vtype = UUnit ; vvtype = UUnit ; hasPrep = False} ;
--- 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 -> <[],[]> ;
}

455
src/experimental/PredInstanceEng.gf
View File

@@ -1,455 +0,0 @@
instance PredInstanceEng of PredInterface - [
PrVerbPhrase, PrClause,
initPrVerbPhrase, initPrVerbPhraseV, initPrClause,
useCopula, questCl, linrefPrQCl
] =
open ResEng, (X = ParamX), Prelude in {
----- overrides ----------------
oper
-- add contracted verb forms and forms for question
PrVerbPhrase = BasePrVerbPhrase ** {vc : VAgr => Str * Str * Str ; qforms : VAgr => Str * Str} ;
PrClause = BasePrClause ** {vc : Str * Str * Str ; qforms : Str * Str} ;
initPrVerbPhrase : PrVerbPhrase = initBasePrVerbPhrase ** {
vc : VAgr => Str * Str * Str = \\_ => <[],[],[]> ;
qforms = \\agr => <[],[]> ;
} ;
initPrVerbPhraseV :
{s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerb -> PrVerbPhrase =
\a,t,p,v -> initBasePrVerbPhraseV a t p v ** {
vc = \\agr => tenseVContracted (a.s ++ t.s ++ p.s) t.t a.a p.p active agr v ;
qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v
} ;
initPrClause : PrClause = initBasePrClause ** {
vc = <[],[],[]> ;
qforms = <[],[]> ;
} ;
useCopula : {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} ->
PrVerbPhrase =
\a,t,p -> initPrVerbPhrase ** {
v = \\agr => tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
vc = \\agr => tenseCopulaC (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
inf = \\vt => tenseInfCopula a.s a.a p.p vt ;
imp = \\n => tenseImpCopula p.s p.p n ;
adV = negAdV p ;
qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
} ;
questCl : PrQuestionClause -> Str = \cl -> case cl.focType of {
NoFoc => cl.foc ++ cl.qforms.p1 ++ cl.subj ++ cl.adV ++ cl.qforms.p2 ++ restCl cl ; -- does she sleep
FocObj => cl.foc ++ cl.qforms.p1 ++ cl.subj ++ cl.adV ++ cl.qforms.p2 ++ restCl cl ; -- who does she love
FocSubj => cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl -- who loves her
} ;
linrefPrQCl : PrQuestionClause -> Str = \qcl -> questCl qcl ;
---------------------
-- parameters -------
---------------------
oper
Gender = ResEng.Gender ;
Agr = ResEng.Agr ;
Case = ResEng.Case ;
NPCase = ResEng.NPCase ;
VForm = ResEng.VVForm ; ---- VVForm to get contracted aux verbs
VVType = ResEng.VVType ;
SVoice = Voice ;
VAgr = EVAgr ;
VType = EVType ;
param --- have to do this clumsy way because param P and oper P : PType don't unify
EVAgr = VASgP1 | VASgP3 | VAPl ;
EVType = VTAct | VTRefl | VTAux ;
oper
active : SVoice = Act ;
passive : SVoice = Pass ;
defaultVType : VType = VTAct ;
subjCase : NPCase = NCase Nom ;
objCase : NPCase = NPAcc ;
agentCase : ComplCase = "by" ;
ComplCase = Str ; -- preposition
NounPhrase = {s : NPCase => Str ; a : Agr} ;
appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> p ++ np.s ! objCase ;
noComplCase : ComplCase = [] ;
strComplCase : ComplCase -> Str = \c -> c ;
noObj : Agr => Str = \\_ => [] ;
RPCase = ResEng.RCase ;
subjRPCase : Agr -> RPCase = \a -> RC (fromAgr a).g npNom ;
NAgr = Number ;
IPAgr = Number ;
RPAgr = ResEng.RAgr ;
ICAgr = Unit ;
defaultAgr : Agr = AgP3Sg Neutr ;
-- omitting rich Agr information
agr2vagr : Agr -> VAgr = \a -> case a of {
AgP1 Sg => VASgP1 ;
AgP3Sg _ => VASgP3 ;
_ => VAPl
} ;
agr2aagr : Agr -> AAgr = \a -> a ;
agr2nagr : Agr -> NAgr = \a -> case a of {
AgP1 n => n ;
AgP2 n => n ;
AgP3Sg _ => Sg ;
AgP3Pl _ => Pl
} ;
agr2icagr : Agr -> ICAgr = \a -> UUnit ;
-- restoring full Agr
ipagr2agr : IPAgr -> Agr = \n -> case n of {
Sg => AgP3Sg Neutr ; ---- gender
Pl => AgP3Pl Neutr
} ;
ipagr2vagr : IPAgr -> VAgr = \n -> case n of {
Sg => VASgP3 ;
Pl => VAPl
} ;
rpagr2agr : RPAgr -> Agr -> Agr = \ra,a -> case ra of {
RAg ag => ag ;
RNoAg => a
} ;
--- this is only needed in VPC formation
vagr2agr : VAgr -> Agr = \a -> case a of {
VASgP1 => AgP1 Sg ;
VASgP3 => AgP3Sg Neutr ;
VAPl => AgP3Pl Neutr
} ;
vPastPart : PrVerb -> AAgr -> Str = \v,_ -> v.s ! VVF VPPart ;
vPresPart : PrVerb -> AAgr -> Str = \v,_ -> v.s ! VVF VPresPart ;
vvInfinitive : VVType = VVInf ;
isRefl : PrVerb -> Bool = \v -> case v.vtype of {VTRefl => True ; _ => False} ;
-----------------------
-- concrete opers
-----------------------
oper
reflPron : Agr -> Str = \a -> ResEng.reflPron ! a ;
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.part ++
vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ;
impVP : Number -> PrVerbPhrase -> Str = \n,vp ->
let
a = AgP2 n
in
vp.adV ++ vp.imp ! n ++ vp.part ++
vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a ++ vp.adv ++ vp.ext ;
qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str =
\sta,t,a,p,agr,v ->
let
verb = tenseActV sta t a Neg agr v ;
averb = tenseActV sta t a p agr v
in case <v.vtype, t, a> of {
<VTAct|VTRefl, Pres|Past, Simul> => case p of {
Pos => < verb.p1, verb.p3> ; -- does , sleep
Neg => < verb.p1, verb.p2> -- does , not sleep ---- TODO: doesn't , sleep
} ;
_ => <averb.p1, averb.p2>
} ;
qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str =
\sta,t,a,p,agr ->
let verb = be_AuxL sta t a p agr
in <verb.p1, verb.p2> ; -- is , not ---- TODO isn't ,
tenseCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \s,t,a,p,agr ->
be_AuxL s t a p agr ;
tenseCopulaC : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \s,t,a,p,agr ->
be_AuxC s t a p agr ;
tenseInfCopula : Str -> Anteriority -> Polarity -> VVType -> Str = \s,a,p,vt ->
tenseInfV s a p Act be_V vt ;
tenseImpCopula : Str -> Polarity -> ImpType -> Str = \s,p,n ->
imperativeV s p n be_V ;
tenseV : Str -> STense -> Anteriority -> Polarity -> SVoice -> VAgr -> PrVerb -> Str * Str * Str =
\sta,t,a,p,o,agr,v ->
case o of {
Act => tenseActV sta t a p agr v ;
Pass => tensePassV sta t a p agr v
} ;
---- leaving out these variants makes compilation time go down from 900ms to 300ms.
---- parsing time of "she sleeps" goes down from 300ms to 60ms. 4/2/2014
tenseVContracted : Str -> STense -> Anteriority -> Polarity -> SVoice -> VAgr -> PrVerb -> Str * Str * Str =
\sta,t,a,p,o,agr,v ->
case o of {
Act => tenseActVContracted sta t a p agr v ;
Pass => tensePassVContracted sta t a p agr v
} ;
tenseActV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str * Str = \sta,t,a,p,agr,v ->
let vt : ResEng.VForm = case <t,agr> of {
<Pres,VASgP3> => VPres ;
<Past|Cond,_ > => VPast ;
_ => VInf
} ;
in
case <t,a> of {
<Pres|Past, Simul> =>
case v.vtype of {
VTAux => case t of {
Pres => <sta ++ v.s ! VVF VPres, not_Str p, []> ; -- can I/she/we
_ => <sta ++ v.s ! VVF vt, not_Str p, []> -- could ...
} ;
_ => case p of {
Pos => <[], sta ++ v.s ! VVF vt, []> ; -- this is the deviating case
Neg => <do_Aux vt Pos, not_Str p, sta ++ v.s ! VVF VInf>
}
} ;
<Pres|Past, Anter> => <have_Aux vt Pos, not_Str p, sta ++ v.s ! VVF VPPart> ;
<Fut|Cond, Simul> => <will_Aux vt Pos, not_Str p, sta ++ v.s ! VVF VInf> ;
<Fut|Cond, Anter> => <will_Aux vt Pos, not_Str p ++ have_Aux VInf Pos, sta ++ v.s ! VVF VPPart>
} ;
tenseActVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str * Str = \sta,t,a,p,agr,v ->
let vt : ResEng.VForm * VVForm = case <t,agr> of {
<Pres,VASgP3> => <VPres, VVPresNeg> ;
<Past|Cond,_ > => <VPast, VVPastNeg> ;
_ => <VInf, VVF VInf>
} ;
in
case <t,a> of {
<Pres|Past, Simul> =>
case v.vtype of {
VTAux => case p of {
Pos => <sta ++ v.s ! VVF vt.p1, [], []> ;
Neg => <sta ++ v.s ! vt.p2, [], []>
} ;
_ => case p of {
Pos => <[], sta ++ v.s ! VVF vt.p1, []> ; -- this is the deviating case
Neg => <do_Aux vt.p1 p, [], sta ++ v.s ! VVF VInf>
}
} ;
<Pres|Past, Anter> => <have_AuxC vt.p1 p, [], sta ++ v.s ! VVF VPPart> ;
---- | <have_AuxC vt.p1 Pos, not_Str p, sta ++ v.s ! VVF VPPart> ;
<Fut|Cond, Simul> => <will_AuxC vt.p1 p, [], sta ++ v.s ! VVF VInf> ;
---- | <will_AuxC vt.p1 Pos, not_Str p, sta ++ v.s ! VVF VInf> ;
<Fut|Cond, Anter> => <will_AuxC vt.p1 p, have_Aux VInf Pos, sta ++ v.s ! VVF VPPart>
---- | <will_AuxC vt.p1 Pos, not_Str p ++ have_Aux VInf Pos, sta ++ v.s ! VVF VPPart>
} ;
tensePassV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str * Str = \sta,t,a,p,agr,v ->
let
be = be_AuxL sta t a p agr ;
done = v.s ! VVF VPPart
in
<be.p1, be.p2, be.p3 ++ done> ;
tensePassVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str * Str = \sta,t,a,p,agr,v ->
let
be = be_AuxC sta t a p agr ;
done = v.s ! VVF VPPart
in
<be.p1, be.p2, be.p3 ++ done> ;
tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str = \sa,a,p,o,v,vt ->
let
not = case p of {Pos => [] ; Neg => "not"} ;
in
case vt of {
VVInf =>
case a of {
Simul => not ++ "to" ++ sa ++ v.s ! VVF VInf ; -- (she wants) (not) to sleep
Anter => not ++ "to" ++ have_Aux VInf Pos ++ sa ++ v.s ! VVF VPPart -- (she wants) (not) to have slept
} ;
VVAux =>
case a of {
Simul => not ++ sa ++ v.s ! VVF VInf ; -- (she must) (not) sleep
Anter => not ++ have_Aux VInf Pos ++ sa ++ v.s ! VVF VPPart -- (she must) (not) have slept
} ;
VVPresPart =>
case a of {
Simul => not ++ sa ++ v.s ! VVF VPresPart ; -- (she starts) (not) sleeping
Anter => not ++ "having" ++ sa ++ v.s ! VVF VPPart -- (she starts) (not) having slept
}
} ;
imperativeV : Str -> Polarity -> ImpType -> PrVerb -> Str = \s,p,it,v ->
s ++ case p of {
Pos => v.s ! VVF VInf ;
Neg => ("do not" | "don't") ++ v.s ! VVF VInf
} ;
----- dangerous variants for PMCFG generation - keep apart as long as possible
be_Aux : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr ->
be_AuxL sta t a p agr ;
be_AuxL : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr ->
let
beV = tenseActV sta t a p agr be_V
in
case <t,a,p,agr> of {
<Pres,Simul,Pos,VASgP3> => <"is" ++ sta, [], []> ;
<Pres,Simul,Pos,VASgP1> => <"am" ++ sta, [], []> ;
<Pres,Simul,Pos,VAPl> => <"are" ++ sta, [], []> ;
<Pres,Simul,Neg,VASgP3> => <"is" ++ sta, "not", []> ;
<Pres,Simul,Neg,VASgP1> => <"am" ++ sta, "not", []> ;
<Pres,Simul,Neg,VAPl> => <"are" ++ sta, "not", []> ;
<Past,Simul,Pos,VAPl> => <"were" ++ sta, [], []> ;
<Past,Simul,Neg,VAPl> => <"were" ++ sta, "not", []> ;
<Past,Simul,Neg,_> => <"was" ++ sta, "not", []> ;
_ => beV
} ;
be_AuxC : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr ->
let
beV = tenseActVContracted sta t a p agr be_V
in
case <t,a,p,agr> of {
<Pres,Simul,Pos,VASgP3> => <Predef.BIND ++ "'s" ++ sta, [], []> ;
<Pres,Simul,Pos,VASgP1> => <Predef.BIND ++ "'m" ++ sta, [], []> ;
<Pres,Simul,Pos,VAPl> => <Predef.BIND ++ "'re" ++ sta, [], []> ;
<Pres,Simul,Neg,VASgP3> => ---- <Predef.BIND ++ "'s" ++ sta, "not", []>
<"isn't" ++ sta, [], []> ;
<Pres,Simul,Neg,VASgP1> => <Predef.BIND ++ "'m" ++ sta, "not", []> ;
<Pres,Simul,Neg,VAPl> => ---- <Predef.BIND ++ "'re" ++ sta, "not", []>
<"aren't" ++ sta, [], []> ;
<Past,Simul,Pos,VAPl> => <"were" ++ sta, [], []> ;
<Past,Simul,Neg,VAPl> => <"weren't" ++ sta, [], []> ;
<Past,Simul,Neg,_> => <"wasn't" ++ sta, [], []> ;
_ => beV
} ;
declCl : PrClause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
declSubordCl : PrClause -> Str = declCl ;
declInvCl : PrClause -> Str = declCl ;
declClContracted : PrClause -> Str = \cl -> cl.subj ++ cl.vc.p1 ++ cl.adV ++ cl.vc.p2 ++ restCl cl ; -- contracted forms
questSubordCl : PrQuestionClause -> Str = \cl ->
let
rest = cl.subj ++ cl.adV ++ cl.v.p1 ++ cl.v.p2 ++ restCl cl
in case cl.focType of {
NoFoc => "if" ++ cl.foc ++ rest ; -- if she sleeps
FocObj => cl.foc ++ rest ; -- who she loves / why she sleeps
FocSubj => cl.foc ++ rest -- who loves her
} ;
--- 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 ;
that_Compl : Str = "that" | [] ;
-- 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 ;
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 ;
} ;
oper
be_V : PrVerb = {
s = table {
VVF VInf => "be" ;
VVF VPres => "is" ;
VVF VPast => "was" ;
VVF VPPart => "been" ;
VVF VPresPart => "being" ;
VVPresNeg => "isn't" ;
VVPastNeg => "wasn't"
} ;
p,c1,c2 = [] ; vtype = VTAux ; vvtype = VVInf ; isSubjectControl = False
} ;
negAdV : {s : Str ; p : Polarity} -> Str = \p -> p.s ;
oper
---- have to split the tables to two to get reasonable PMCFG generation
will_Aux : ResEng.VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf|VPres, Pos> => varAux "will" "ll" ;
<VInf|VPres, Neg> => "won't" ;
<VPast|_ , Pos> => varAux "would" "d" ;
<VPast|_ , Neg> => "wouldn't"
} ;
will_AuxC : ResEng.VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf|VPres, Pos> => varAuxC "will" "ll" ;
<VInf|VPres, Neg> => "won't" ;
<VPast|_ , Pos> => varAuxC "would" "d" ;
<VPast|_ , Neg> => "wouldn't"
} ;
have_Aux : ResEng.VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf, Pos> => varAux "have" "ve" ; --- slightly overgenerating if used in infinitive
<VInf, Neg> => "haven't" ;
<VPres, Pos> => varAux "has" "s" ;
<VPres, Neg> => "hasn't" ;
<VPast|_ , Pos> => varAux "had" "d" ;
<VPast|_ , Neg> => "hadn't"
} ;
have_AuxC : ResEng.VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf, Pos> => varAuxC "have" "ve" ; --- slightly overgenerating if used in infinitive
<VInf, Neg> => "haven't" ;
<VPres, Pos> => varAuxC "has" "s" ;
<VPres, Neg> => "hasn't" ;
<VPast|_ , Pos> => varAuxC "had" "d" ;
<VPast|_ , Neg> => "hadn't"
} ;
do_Aux : ResEng.VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf, Pos> => "do" ;
<VInf, Neg> => "don't" ;
<VPres, Pos> => "does" ;
<VPres, Neg> => "doesn't" ;
<VPast|_ , Pos> => "did" ;
<VPast|_ , Neg> => "didn't"
} ;
varAux : Str -> Str -> Str = \long,short -> long ; ----| Predef.BIND ++ ("'" + short) ;
varAuxC : Str -> Str -> Str = \long,short -> Predef.BIND ++ ("'" + short) ;
not_Str : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "not"} ;
}

335
src/experimental/PredInstanceFin.gf
View File

@@ -1,335 +0,0 @@
instance PredInstanceFin of
PredInterface - [
NounPhrase,
PrVerb, initPrVerb,
PrVerbPhrase, initPrVerbPhrase, initPrVerbPhraseV, useCopula, linrefPrVP, qformsVP, applyVerb, addObj2VP,
initBasePrVerbPhrase, initBasePrVerbPhraseV,
PrClause, initPrClause
] =
open ResFin, (P = ParadigmsFin), (S = StemFin), (X = ParamX), Prelude in {
-- overrides
oper
NounPhrase = ResFin.NP ;
PrVerb = StemFin.SVerb1 ** {
c1 : ComplCase ;
c2 : ComplCase ;
vvtype : ResFin.VVType ;
} ;
initPrVerb : PrVerb = {
s = \\_ => [] ;
sc = SCNom ;
h = Back ;
p = [] ;
c1,c2 = noComplCase ; isSubjectControl = True ; vtype = Act ; vvtype = VVInf ;
} ;
PrVerbPhrase = {
v : Agr => {fin,inf : Str} ;
inf : VPIType => Str ;
imp : ImpType => Str ;
adj : Agr => 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 : ResFin.VVType ;
sc : SubjCase ;
h : Harmony ;
c1 : Compl ;
c2 : Compl ;
qforms : VAgr => Str * Str ;
} ;
initPrVerbPhrase : PrVerbPhrase = {
v : Agr => {fin,inf : Str} = \\_ => {fin,inf = []} ;
inf : VPIType => Str = \\vtt => [] ;
imp : ImpType => Str = \\_ => [] ;
adj : Agr => Str = \\_ => [] ;
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 = VVInf ;
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,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 : VPIType => Str = \\vtt => tenseInfV (a.s ++ p.s) a.a p.p Act (lin PrV verb) vtt ;
imp : ImpType => Str = \\it => imperativeV p.s p.p it (lin PrV verb) ;
adj : Agr => Str = \\_ => [] ;
obj1 : Agr => Str = \\_ => [] ;
obj2 : Agr => Str = \\_ => [] ;
adv : Str = [] ;
adV : Str = [] ;
ext : Str = [] ;
isNeg : Bool = False ;
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} ;
adj : 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 = []} ;
adj : Str = [] ;
obj1 : Str = [] ;
obj2 : Str = [] ;
adv : Str = [] ;
adV : Str = [] ;
ext : Str = [] ;
h : Harmony = Back ;
c3 : Compl = noComplCase ;
} ;
---------------------
-- parameters -------
---------------------
oper
Agr = ResFin.Agr ;
Case = ResFin.Case ;
NPCase = ResFin.NPForm ;
VForm = S.SVForm ;
VVType = VPIType ;
VType = Voice ; ----
Gender = Unit ; ----
VAgr = Agr ;
SVoice = Voice ;
oper
active = Act ;
passive = Pass ;
defaultVType = Act ;
defaultVVType = vvInfinitive ;
subjCase : NPCase = ResFin.NPCase Nom ;
objCase : NPCase = NPAcc ;
ComplCase = ResFin.Compl ; -- preposition
agentCase : ComplCase = P.postGenPrep "toimesta" ;
strComplCase : ComplCase -> Str = \c -> c.s.p1 ++ c.s.p2 ;
appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> appCompl True Pos p np ;
noComplCase : ComplCase = P.accPrep ; ----
noObj : Agr => Str = \\_ => [] ;
RPCase = NPCase ;
subjRPCase : Agr -> RPCase = \a -> subjCase ;
NAgr = Number ;
IPAgr = Number ; --- two separate fields in RGL
RPAgr = ResFin.RAgr ;
ICAgr = Agr ;
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
agr2icagr : Agr -> ICAgr = \a -> a ;
-- restoring full Agr
ipagr2agr : IPAgr -> Agr = \a -> Ag a P3 ;
ipagr2vagr : IPAgr -> VAgr = \n -> Ag n P3 ;
rpagr2agr : RPAgr -> Agr -> Agr = \ra,a -> case ra of {
RAg ag => ag ;
RNoAg => a
} ;
--- this is only needed in VPC formation
vagr2agr : VAgr -> Agr = \a -> a ;
vPastPart : PrVerb -> AAgr -> Str = \v,a -> (S.sverb2verbSep v).s ! PastPartPass (aForm a) ;
vPresPart : PrVerb -> AAgr -> Str = \v,a -> (S.sverb2verbSep v).s ! PresPartAct (aForm a) ;
-- predicative adjective form
aForm : AAgr -> AForm = \a -> case a of {
Ag Pl _ => AN (NCase Pl Part) ;
_ => AN (NCase Sg Nom)
} ;
---- TODO: case system of PrAP
vvInfinitive : VVType = VPIVV VVInf ;
isRefl : PrVerb -> Bool = \_ -> False ; ----
-- the forms outside VPIVV to be used in adverbials such as "tekemällä"
param
VPIType = VPIVV (ResFin.VVType)
| VPIInf3Adess | VPIInf3Abess | VPIInf2Iness | VPIInf1Long {- | VPIPastPartPassPart -} | VPIInf4Part ;
-- tekemällä, tekemättä, tehdessä, tehdäkseen, tehtyään, tekemistä
------------------
--- opers --------
------------------
oper
reflPron : Agr -> Str = \a -> (ResFin.reflPron a).s ! NPAcc ; ---- case
finV : Str -> STense -> Anteriority -> Polarity -> SVoice -> Agr -> PrVerb -> {fin,inf : Str} =
\sta,t,a,pol,o,agr,v ->
let
vit = case o of {Act => VIFin t ; Pass => VIPass t} ;
ovps = (S.vp2old_vp (S.predV v)).s ! vit ! a ! pol ! agr ; -- VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ;
in
{fin = sta ++ ovps.fin ; inf = ovps.inf} ;
infV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VPIType -> Str =
\sa,a,pol,o,v,vvt ->
let
vt = case vvt of {
VPIVV vi => VIInf (vvtype2infform vi) ;
VPIInf3Adess => VIInf Inf3Adess ;
VPIInf3Abess => VIInf Inf3Abess ;
VPIInf2Iness => VIInf Inf2Iness ;
VPIInf1Long => VIInf Inf1Long ;
---- VPIPastPartPassPart => PastPartPass (AN (NCase Sg Part)) ;
VPIInf4Part => VIInf Inf4Part
} ;
ovps = (S.vp2old_vp (S.predV v)).s ! vt ! a ! pol ! defaultAgr ; -- VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ;
in
sa ++ ovps.fin ++ ovps.inf ;
tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str = infV ;
{-
\sa,a,pol,o,v,vt ->
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 ;
-}
infVP : VVType -> Agr -> PrVerbPhrase -> Str = \vvt,agr,vp ->
vp.inf ! vvt ++ vp.adV ++ vp.adj ! agr ++ vp.obj1 ! agr ++ vp.obj2 ! agr ++ vp.adv ++ vp.ext ;
impVP : Number -> PrVerbPhrase -> Str = \n,vp ->
let agr = Ag n P2 in
vp.imp ! n ++ vp.adV ++ vp.adj ! agr ++ 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.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ;
declSubordCl : PrClause -> Str = declCl ;
declInvCl : PrClause -> Str = declCl ; ---
questCl : PrQuestionClause -> Str = \cl ->
let
ko = case cl.h of {Back => "ko" ; Front => "kö"}
in
case cl.focType of {
NoFoc => cl.verb.fin ++ Predef.BIND ++ ko ++
cl.subj ++ cl.adV ++ cl.verb.inf ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ;
_ => cl.foc ++ cl.subj ++ cl.verb.fin ++
cl.adV ++ cl.verb.inf ++ cl.adj ++ 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.p1 ++ cl.c3.s.p2 ; ---- 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
vit = case o of {Act => VIFin t ; Pass => VIPass t} ;
ovps = (S.vp2old_vp (S.predV v)).s ! vit ! a ! pol ! agr ; -- VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ;
in
<sta ++ ovps.fin, ovps.inf, []> ;
imperativeV : Str -> Polarity -> ImpType -> PrVerb -> Str = \s,p,it,v ->
let
ovps = (S.vp2old_vp (S.predV v)).s ! VIImper ! Simul ! p ! Ag it P2 ;
in
s ++ 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 ;
tenseImpCopula : Str -> Polarity -> ImpType -> Str =
\s,p,it -> imperativeV s p it (liftV P.olla_V) ;
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 ! a ++ obj ! a ;
} ;
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 -> initPrVerb ** v ;
--- 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 -> <[],[]> ;
qformsVP : PrVerbPhrase -> VAgr -> Str * Str
= \vp,vagr -> <[],[]> ;
}

186
src/experimental/PredInstanceSwe.gf
View File

@@ -1,186 +0,0 @@
instance PredInstanceSwe of PredInterface = open CommonScand, ResSwe, (P = ParadigmsSwe), (X = ParamX), Prelude in {
---------------------
-- parameters -------
---------------------
oper
Gender = CommonScand.Gender ;
Agr = CommonScand.Agr ;
Case = CommonScand.Case ;
NPCase = CommonScand.NPForm ;
VForm = CommonScand.VForm ;
VVType = Unit ; -----
VType = CommonScand.VType ;
VAgr = Unit ;
SVoice = CommonScand.Voice ;
oper
active = CommonScand.Act ;
passive = CommonScand.Pass ;
defaultVType = VAct ;
subjCase : NPCase = NPNom ;
objCase : NPCase = NPAcc ;
agentCase : ComplCase = "av" ;
ComplCase = Str ; -- preposition
appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> p ++ np.s ! objCase ;
noComplCase : ComplCase = [] ;
strComplCase : ComplCase -> Str = \c -> c ;
noObj : Agr => Str = \\_ => [] ;
RPCase = CommonScand.RCase ;
subjRPCase : Agr -> RPCase = \a -> RNom ;
NAgr = Number ; --- only Indef Nom forms are needed here
IPAgr = Number ; ----{g : Gender ; n : Number} ; --- two separate fields in RGL
RPAgr = RAgr ;
ICAgr = AFormPos ;
defaultAgr : Agr = {g = Utr ; n = Sg ; p = P3} ;
-- omitting rich Agr information
agr2vagr : Agr -> VAgr = \a -> UUnit ;
agr2aagr : Agr -> AAgr = \a -> a ;
agr2icagr : Agr -> ICAgr = agr2aformpos ;
--- could use this?
agr2aformpos : Agr -> AFormPos = \a ->
case a.n of {
Sg => Strong (GSg a.g) ;
Pl => Strong GPl
} ;
agr2nagr : Agr -> NAgr = \a -> a.n ;
-- restoring full Agr
ipagr2agr : IPAgr -> Agr = \a -> {g = Utr ; n = a ; p = P3} ; ----
ipagr2vagr : IPAgr -> VAgr = \n -> UUnit ;
rpagr2agr : RPAgr -> Agr -> Agr = \ra,a -> case ra of {
RAg g n p => {g = g ; n = n ; p = p} ;
RNoAg => a
} ;
--- this is only needed in VPC formation
vagr2agr : VAgr -> Agr = \a -> defaultAgr ;
vPastPart : PrVerb -> AAgr -> Str = \v,a -> v.s ! VI (VPtPret (agr2aformpos a) Nom) ;
vPresPart : PrVerb -> AAgr -> Str = \v,a -> v.s ! VI (VPtPres Sg Indef Nom) ;
vvInfinitive : VVType = UUnit ; ----
isRefl : PrVerb -> Bool = \v -> case v.vtype of {VRefl => True ; _ => False} ;
------------------
--- opers --------
------------------
oper
reflPron : Agr -> Str = ResSwe.reflPron ;
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 ! UUnit ++
vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ;
impVP : Number -> PrVerbPhrase -> Str = \n,vp ->
let
a = {g = Utr ; n = n ; p = P2}
in
vp.imp ! n ++ vp.part ++ ---- AdV contains inte
vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a ++ vp.adv ++ vp.ext ;
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 = \cl ->
let
rest = cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl
in case cl.focType of {
NoFoc => "om" ++ cl.foc ++ rest ; -- om hon sover
FocObj => cl.foc ++ rest ; -- vem älskar hon / varför hon sover
FocSubj => cl.foc ++ "som" ++ rest -- vem som älskar henne
} ;
that_Compl : Str = "att" | [] ;
-- 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 ;
negAdV : {s : Str ; p : Polarity} -> Str = \p -> p.s ++ case p.p of {Pos => [] ; Neg => inte_Str} ;
tenseV : Str -> STense -> Anteriority -> Polarity -> SVoice -> VAgr -> PrVerb -> Str * Str * Str = --- Polarity, VAgr not needed in Swe
\sta,t,a,_,o,_,v ->
let act = CommonScand.Act in
case <t,a> of { --- sta dummy s field of Ant and Tense
<Pres,Simul> => <sta ++ v.s ! VF (VPres o), [], []> ;
<Past,Simul> => <sta ++ v.s ! VF (VPret o), [], []> ;
<Fut, Simul> => <skola_V.s ! VF (VPres act), [], sta ++ v.s ! VI (VInfin o)> ;
<Cond,Simul> => <skola_V.s ! VF (VPret act), [], sta ++ v.s ! VI (VInfin o)> ;
<Pres,Anter> => <hava_V.s ! VF (VPres act), [], sta ++ v.s ! VI (VSupin o)> ;
<Past,Anter> => <hava_V.s ! VF (VPret act), [], sta ++ v.s ! VI (VSupin o)> ;
<Fut, Anter> => <skola_V.s ! VF (VPres act), hava_V.s ! VI (VInfin act), sta ++ v.s ! VI (VSupin o)> ;
<Cond,Anter> => <skola_V.s ! VF (VPret act), hava_V.s ! VI (VInfin act), sta ++ v.s ! VI (VSupin o)>
} ;
tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str = \sa,a,_,o,v,_ -> ---- vvtype
case a of {
Simul => sa ++ v.s ! VI (VInfin o) ; -- hon vill sova
Anter => hava_V.s ! VI (VInfin CommonScand.Act) ++ sa ++ v.s ! VI (VSupin o) -- hon vill (ha) sovit ---- discont?
} ;
imperativeV : Str -> Polarity -> ImpType -> PrVerb -> Str = \s,p,it,v ->
s ++ case p of {
Pos => v.s ! VF (VImper CommonScand.Act) ; ---- deponents
Neg => v.s ! VF (VImper CommonScand.Act) ++ inte_Str
} ;
tenseCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str =
\s,t,a,p,_ -> tenseV s t a p CommonScand.Act UUnit (liftV be_V) ;
tenseInfCopula : Str -> Anteriority -> Polarity -> VVType -> Str =
\s,a,p,vt -> tenseInfV s a p CommonScand.Act (liftV be_V) vt ;
tenseImpCopula : Str -> Polarity -> ImpType -> Str =
\s,p,n -> imperativeV s p n (liftV be_V) ;
hava_V : Verb = P.mkV "ha" "har" "ha" "hade" "haft" "havd" ; -- havd not used
be_V : Verb = P.mkV "vara" "är" "var" "var" "varit" "varen" ; -- varen not used
skola_V : Verb = P.mkV "skola" ("ska" | "skall") "ska" "skulle" "skolat" "skolad" ; ---- not used but ska and skulle
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_Str} ;
inte_Str = "inte" | "icke" | "ej" ;
liftV : Verb -> PrVerb = \v ->
{s = v.s ; p = v.part ; c1,c2 = [] ; isSubjectControl = True ; vtype = v.vtype ; vvtype = vvInfinitive} ; ---- vvtype
}

278
src/experimental/PredInterface.gf
View File

@@ -1,278 +0,0 @@
interface PredInterface = open Prelude, (X = ParamX) in {
---------------------
-- parameters -------
---------------------
-- standard usually general
oper
Number : PType = X.Number ;
Person : PType = X.Person ;
Anteriority : PType = X.Anteriority ;
Polarity : PType = X.Polarity ;
STense : PType = X.Tense ;
SVoice : PType ;
ImpType : PType = Number ;
param
Voice = Act | Pass ; --- should be in ParamX
Unit = UUnit ; --- should be in Prelude
-- this works for typical "wh movement" languages
FocusType = NoFoc | FocSubj | FocObj ; -- sover hon/om hon sover, vem älskar hon/vem hon älskar, vem sover/vem som sover
-- language-dependent
oper
Gender : PType ;
Agr : PType ; -- full agreement, inherent in NP
Case : PType ; -- case of CN
NPCase : PType ; -- full case of NP
VForm : PType ; -- inflection form of V
VVType : PType ; -- infinitive form required by VV
-- language dependent
VAgr : PType ; -- agr features that a verb form depends on
VType : PType ; -- reflexive, auxiliary, deponent,...
oper
active : SVoice ;
passive : SVoice ;
defaultVType : VType ;
subjCase : NPCase ;
objCase : NPCase ;
ComplCase : Type ; -- e.g. preposition
agentCase : ComplCase ;
strComplCase : ComplCase -> Str ;
NounPhrase : Type = {s : NPCase => Str ; a : Agr} ;
appComplCase : ComplCase -> NounPhrase -> Str ;
noComplCase : ComplCase ;
appSubjCase : NounPhrase -> Str = \np -> np.s ! subjCase ;
appObjCase : NounPhrase -> Str = \np -> np.s ! objCase ;
noObj : Agr => Str = \\_ => [] ;
RPCase : PType ;
subjRPCase : Agr -> RPCase ;
NAgr : PType ;
AAgr = Agr ; -- because of reflexives: "happy with itself"
IPAgr : PType ; -- agreement of IP
RPAgr : PType ; -- agreement of RP
ICAgr : PType ; -- agreement to IComp
defaultAgr : Agr ;
-- omitting parts of Agr information
agr2vagr : Agr -> VAgr ;
agr2aagr : Agr -> AAgr ;
agr2nagr : Agr -> NAgr ;
agr2icagr : Agr -> ICAgr ;
-- restoring full Agr
ipagr2agr : IPAgr -> Agr ;
ipagr2vagr : IPAgr -> VAgr ;
rpagr2agr : RPAgr -> Agr -> Agr ; -- the agr can come from the RP itself or from above
--- this is only needed in VPC formation
vagr2agr : VAgr -> Agr ;
-- participles as adjectives
vPastPart : PrVerb -> AAgr -> Str ;
vPresPart : PrVerb -> AAgr -> Str ;
vvInfinitive : VVType ;
isRefl : PrVerb -> Bool ;
applyVerb : PrVerbPhrase -> VAgr -> Str * Str * Str
= \vp,a -> vp.v ! a ;
-------------------------------
--- type synonyms
-------------------------------
oper
PrVerb = BasePrVerb ;
PrVerbPhrase = BasePrVerbPhrase ;
PrClause = BasePrClause ;
PrQuestionClause = BasePrQuestionClause ;
initPrVerb = initBasePrVerb ;
initPrVerbPhrase = initBasePrVerbPhrase ;
initPrVerbPhraseV = initBasePrVerbPhraseV ;
initPrClause = initBasePrClause ;
BasePrVerb = {
s : VForm => Str ;
p : Str ; -- verb particle
c1 : ComplCase ;
c2 : ComplCase ;
isSubjectControl : Bool ;
vtype : VType ;
vvtype : VVType ;
} ;
initBasePrVerb : BasePrVerb = {
s = \\_ => [] ;
p = [] ;
c1 = noComplCase ;
c2 = noComplCase ;
isSubjectControl = True ;
vtype = defaultVType ;
vvtype = vvInfinitive ;
} ;
BasePrVerbPhrase = {
v : VAgr => Str * Str * Str ; -- would,have,slept
inf : VVType => Str ; -- (not) ((to)(sleep|have slept) | (sleeping|having slept)
imp : ImpType => Str ;
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 ;
} ;
initBasePrVerbPhrase : BasePrVerbPhrase = {
v : VAgr => Str * Str * Str = \\_ => <[],[],[]> ;
inf : VVType => Str = \\_ => [] ;
imp : ImpType => 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 = [] ;
} ;
initBasePrVerbPhraseV :
{s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerb -> BasePrVerbPhrase =
\a,t,p,v -> initBasePrVerbPhrase ** {
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 ;
imp = \\it => imperativeV p.s p.p it v ;
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
} ;
BasePrClause = {
v : Str * Str * Str ;
adj,obj1,obj2 : Str ;
adv : Str ;
adV : Str ;
ext : Str ;
subj : Str ;
c3 : ComplCase ; -- for a slashed adjunct, not belonging to the verb valency
} ;
initBasePrClause : BasePrClause = {
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
} ;
BasePrQuestionClause = 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*
} ;
PrAdverb = {s : Str ; isAdV : Bool ; c1 : ComplCase} ;
useCopula : {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} ->
PrVerbPhrase =
\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 ;
imp = \\n => tenseImpCopula p.s p.p n ;
adV = negAdV p ;
} ;
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
---------------------------
oper
reflPron : Agr -> Str ;
infVP : VVType -> Agr -> PrVerbPhrase -> Str ;
impVP : Number -> PrVerbPhrase -> Str ;
tenseV : Str -> STense -> Anteriority -> Polarity -> SVoice -> VAgr -> PrVerb -> Str * Str * Str ;
tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str ;
imperativeV : Str -> Polarity -> ImpType -> PrVerb -> Str ;
tenseCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str ;
tenseInfCopula : Str -> Anteriority -> Polarity -> VVType -> Str ;
tenseImpCopula : Str -> Polarity -> ImpType -> Str ;
declCl : PrClause -> Str ;
declSubordCl : PrClause -> Str ;
declInvCl : PrClause -> Str ;
questCl : PrQuestionClause -> Str ;
questSubordCl : PrQuestionClause -> Str ;
that_Compl : 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 ;
}

42
src/experimental/PredSwe.gf
View File

@@ -1,42 +0,0 @@
concrete PredSwe of Pred =
CatSwe [Ant,NP,Utt,IP,IAdv,IComp,Conj,RP,RS,Imp,Subj] **
PredFunctor - [RelVP,RelSlash] ---- incompatible arity: to be fixed in RGL
with
(PredInterface = PredInstanceSwe)
** open ResSwe, CommonScand in {
lin
RelVP rp vp =
let
cl : Agr -> RCase -> PrClause = \a,c ->
let rpa = rpagr2agr rp.a a in
vp ** {
v = applyVerb vp (agr2vagr rpa) ;
subj = rp.s ! a.g ! a.n ! subjRPCase a ;
adj = vp.adj ! rpa ;
obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! rpa ; ---- apply complCase ---- place of part depends on obj
obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => rpa ; False => vp.obj1.p2}) ; ---- apply complCase
c3 = noComplCase ; -- for one more prep to build ClSlash
}
in {s = \\a,c => declCl (cl a c) ; c = subjCase} ;
RelSlash rp cl = {
s = \\a,c => rp.s ! a.g ! a.n ! subjRPCase (rpagr2agr rp.a a) ++ declCl cl ; ---- rp case
c = objCase
} ;
NomVPNP vpi = {
s = \\c => "att" ++ vpi.s ! vvInfinitive ! defaultAgr ;
a = defaultAgr ** {g = Neutr} ;
} ;
ByVP x vp vpi = vp ** {adv = "genom att" ++ vpi.s ! vvInfinitive ! defaultAgr} ; ---- agr
WhenVP x vp vpi = vp ** {adv = "vid att" ++ vpi.s ! vvInfinitive ! defaultAgr} ; ---- agr ----
BeforeVP x vp vpi = vp ** {adv = "innan att" ++ vpi.s ! vvInfinitive ! defaultAgr} ; ---- agr ----
AfterVP x vp vpi = vp ** {adv = "efter att" ++ vpi.s ! vvInfinitive ! defaultAgr} ; ---- agr
InOrderVP x vp vpi = vp ** {adv = "för att" ++ vpi.s ! vvInfinitive ! defaultAgr} ; ---- agr
WithoutVP x vp vpi = vp ** {adv = "utan att" ++ vpi.s ! vvInfinitive ! defaultAgr} ; ---- agr
}

20
src/experimental/RGLBase.gf
View File

@@ -1,20 +0,0 @@
abstract RGLBase =
-- modules in Grammar, excluding Structural, Verb, Sentence, Question
---- Tense,
Noun - [PPartNP], -- to be generalized
Adjective,
Numeral,
Conjunction,
Adverb,
Phrase,
---- Sentence,
Question - [QuestCl,QuestVP,QuestSlash,QuestIAdv,QuestIComp],
Relative - [RelCl,RelVP,RelSlash],
---- Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP], ---- why only these?
Symbol [PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP] ; ---- why only these?
---- Construction,
---- Extensions,
---- Documentation ;

20
src/experimental/RGLBaseBul.gf
View File

@@ -1,20 +0,0 @@
concrete RGLBaseBul of RGLBase =
-- modules in Grammar, excluding Structural, Verb, Sentence, Question
TenseX - [CAdv,IAdv,TTAnt],
NounBul - [PPartNP], -- to be generalized
AdjectiveBul,
NumeralBul,
ConjunctionBul,
AdverbBul,
PhraseBul,
---- Sentence,
QuestionBul - [QuestCl,QuestVP,QuestSlash,QuestIAdv,QuestIComp],
RelativeBul - [RelCl,RelVP,RelSlash],
---- Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP], ---- why only these?
SymbolBul [PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP] ; ---- why only these?
---- Construction,
---- Extensions,
---- Documentation ;

20
src/experimental/RGLBaseChi.gf
View File

@@ -1,20 +0,0 @@
concrete RGLBaseChi of RGLBase =
-- modules in Grammar, excluding Structural, Verb, Sentence, Question
---- Tense,
NounChi - [PPartNP], -- to be generalized
AdjectiveChi,
NumeralChi,
ConjunctionChi,
AdverbChi,
PhraseChi,
---- Sentence,
QuestionChi - [QuestCl,QuestVP,QuestSlash,QuestIAdv,QuestIComp],
RelativeChi - [RelCl,RelVP,RelSlash],
---- Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP], ---- why only these?
SymbolChi [PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP] ; ---- why only these?
---- Construction,
---- Extensions,
---- Documentation ;

20
src/experimental/RGLBaseEng.gf
View File

@@ -1,20 +0,0 @@
concrete RGLBaseEng of RGLBase =
-- modules in Grammar, excluding Structural, Verb, Sentence, Question
---- Tense,
NounEng - [PPartNP], -- to be generalized
AdjectiveEng,
NumeralEng,
ConjunctionEng,
AdverbEng,
PhraseEng,
---- Sentence,
QuestionEng - [QuestCl,QuestVP,QuestSlash,QuestIAdv,QuestIComp],
RelativeEng - [RelCl,RelVP,RelSlash],
---- Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP], ---- why only these?
SymbolEng [PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP] ; ---- why only these?
---- Construction,
---- Extensions,
---- Documentation ;

20
src/experimental/RGLBaseFin.gf
View File

@@ -1,20 +0,0 @@
concrete RGLBaseFin of RGLBase =
-- modules in Grammar, excluding Structural, Verb, Sentence, Question
---- Tense,
NounFin - [PPartNP], -- to be generalized
AdjectiveFin,
NumeralFin,
ConjunctionFin,
AdverbFin,
PhraseFin,
---- Sentence,
QuestionFin - [QuestCl,QuestVP,QuestSlash,QuestIAdv,QuestIComp],
RelativeFin - [RelCl,RelVP,RelSlash],
---- 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 ;

20
src/experimental/RGLBaseFre.gf
View File

@@ -1,20 +0,0 @@
concrete RGLBaseFre of RGLBase =
-- modules in Grammar, excluding Structural, Verb, Sentence, Question
TenseFre - [TTAnt],
NounFre - [PPartNP], -- to be generalized
AdjectiveFre,
NumeralFre,
ConjunctionFre,
AdverbFre,
PhraseFre,
---- Sentence,
QuestionFre - [QuestCl,QuestVP,QuestSlash,QuestIAdv,QuestIComp],
RelativeFre - [RelCl,RelVP,RelSlash],
---- Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP], ---- why only these?
SymbolFre [PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP] ; ---- why only these?
---- Construction,
---- Extensions,
---- Documentation ;

20
src/experimental/RGLBaseGer.gf
View File

@@ -1,20 +0,0 @@
concrete RGLBaseGer of RGLBase =
-- modules in Grammar, excluding Structural, Verb, Sentence, Question
TenseGer - [TTAnt],
NounGer - [PPartNP], -- to be generalized
AdjectiveGer,
NumeralGer,
ConjunctionGer,
AdverbGer,
PhraseGer,
---- Sentence,
QuestionGer - [QuestCl,QuestVP,QuestSlash,QuestIAdv,QuestIComp],
RelativeGer - [RelCl,RelVP,RelSlash],
---- Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP], ---- why only these?
SymbolGer [PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP] ; ---- why only these?
---- Construction,
---- Extensions,
---- Documentation ;

21
src/experimental/RGLBaseHin.gf
View File

@@ -1,21 +0,0 @@
concrete RGLBaseHin of RGLBase =
-- modules in Grammar, excluding Structural, Verb, Sentence, Question
---- Tense,
TenseX - [TTAnt,Adv,AdN,SC],
NounHin - [PPartNP], -- to be generalized
AdjectiveHin,
NumeralHin,
ConjunctionHin,
AdverbHin,
PhraseHin,
---- Sentence,
QuestionHin - [QuestCl,QuestVP,QuestSlash,QuestIAdv,QuestIComp],
RelativeHin - [RelCl,RelVP,RelSlash],
---- Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP], ---- why only these?
SymbolHin [PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP] ; ---- why only these?
---- Construction,
---- Extensions,
---- Documentation ;

20
src/experimental/RGLBaseIta.gf
View File

@@ -1,20 +0,0 @@
concrete RGLBaseIta of RGLBase =
-- modules in Grammar, excluding Structural, Verb, Sentence, Question
TenseIta - [TTAnt],
NounIta - [PPartNP], -- to be generalized
AdjectiveIta,
NumeralIta,
ConjunctionIta,
AdverbIta,
PhraseIta,
---- Sentence,
QuestionIta - [QuestCl,QuestVP,QuestSlash,QuestIAdv,QuestIComp],
RelativeIta - [RelCl,RelVP,RelSlash],
---- Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP], ---- why only these?
SymbolIta [PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP] ; ---- why only these?
---- Construction,
---- Extensions,
---- Documentation ;

20
src/experimental/RGLBaseSpa.gf
View File

@@ -1,20 +0,0 @@
concrete RGLBaseSpa of RGLBase =
-- modules in Grammar, excluding Structural, Verb, Sentence, Question
TenseSpa - [TTAnt],
NounSpa - [PPartNP], -- to be generalized
AdjectiveSpa,
NumeralSpa,
ConjunctionSpa,
AdverbSpa,
PhraseSpa,
---- Sentence,
QuestionSpa - [QuestCl,QuestVP,QuestSlash,QuestIAdv,QuestIComp],
RelativeSpa - [RelCl,RelVP,RelSlash],
---- Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP], ---- why only these?
SymbolSpa [PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP] ; ---- why only these?
---- Construction,
---- Extensions,
---- Documentation ;

20
src/experimental/RGLBaseSwe.gf
View File

@@ -1,20 +0,0 @@
concrete RGLBaseSwe of RGLBase =
-- modules in Grammar, excluding Structural, Verb, Sentence, Question
---- Tense,
NounSwe - [PPartNP], -- to be generalized
AdjectiveSwe,
NumeralSwe,
ConjunctionSwe,
AdverbSwe,
PhraseSwe,
---- Sentence,
QuestionSwe - [QuestCl,QuestVP,QuestSlash,QuestIAdv,QuestIComp],
RelativeSwe - [RelCl,RelVP,RelSlash],
---- Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP], ---- why only these?
SymbolSwe [PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP] ; ---- why only these?
---- Construction,
---- Extensions,
---- Documentation ;

230
src/experimental/SmallNDPredFunctor.gf
View File

@@ -1,230 +0,0 @@
incomplete concrete NDPredFunctor of NDPred =
Cat [Ant,NP,Utt,IP,IAdv,Conj,RS,RP,Subj] **
open
PredInterface,
Pred,
ParamX,
Prelude
in {
------------------------------------
-- lincats
-------------------------------------
lincat
Tense = Pred.Tense ;
Pol = Pred.Pol ;
PrV_none, PrV_np, PrV_v, PrV_s, PrV_q, PrV_a, PrV_n,
PrV_np_np, PrV_np_v, PrV_np_s, PrV_np_q, PrV_np_a, PrV_np_n = Pred.PrV ;
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 ;
VPC_none, VPC_np = Pred.VPC ;
ClC_none, ClC_np = Pred.ClC ;
PrAdv_none, PrAdv_np = Pred.PrAdv ;
PrS = Pred.PrS ;
PrAP_none, PrAP_np = Pred.PrAP ;
PrCN_none, PrCN_np = Pred.PrCN ;
-- reference linearizations for chunking
---- should be by functor as well
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
= 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 ----
----------------------------
lin
-- standard general
TPres = Pred.TPres ;
TPast = Pred.TPast ;
TFut = Pred.TFut ;
TCond = Pred.TCond ;
ASimul = Pred.ASimul ;
AAnter = Pred.AAnter ;
PPos = Pred.PPos ;
PNeg = Pred.PNeg ;
UseV_none, UseV_np, UseV_v, UseV_s, UseV_q, UseV_a, UseV_n, UseV_np_np, UseV_np_v, UseV_np_s, UseV_np_q, UseV_np_a, UseV_np_n
= Pred.UseV Pred.aNone ;
{-
PassUseV_none, PassUseV_np, PassUseV_v, PassUseV_s, PassUseV_q, PassUseV_a, PassUseV_n
= Pred.PassUseV Pred.aNone ;
AgentPassUseV_none, AgentPassUseV_np, AgentPassUseV_v, AgentPassUseV_s, AgentPassUseV_q, AgentPassUseV_a, AgentPassUseV_n
= Pred.AgentPassUseV Pred.aNone ;
-}
UseAP_none, UseAP_np
= Pred.UseAP Pred.aNone ;
UseCN_none, UseCN_np
= Pred.UseCN Pred.aNone ;
UseAdv_none, UseAdv_np
= Pred.UseAdv Pred.aNone ;
UseNP_none
= Pred.UseNP ;
{-
UseS_none
= Pred.UseS ;
UseQ_none
= Pred.UseQ ;
UseVP_none
= Pred.UseVP ;
-}
ComplV2_none
= Pred.ComplV2 Pred.aNone ;
{-
ComplVV_none, ComplVV_np
= Pred.ComplVV Pred.aNone ;
ComplVS_none, ComplVS_np
= Pred.ComplVS Pred.aNone ;
ComplVA_none
= Pred.ComplVA Pred.aNone ;
ComplVQ_none
= Pred.ComplVQ Pred.aNone ;
ComplVN_none
= Pred.ComplVN Pred.aNone ;
SlashV3_none
= Pred.SlashV3 Pred.aNone ;
SlashV2V_none, SlashV2V_np
= Pred.SlashV2V Pred.aNone ;
SlashV2S_none
= Pred.SlashV2S Pred.aNone ;
SlashV2Q_none
= Pred.SlashV2Q Pred.aNone ;
SlashV2A_none
= Pred.SlashV2A Pred.aNone ;
SlashV2N_none
= Pred.SlashV2N Pred.aNone ;
ReflVP_none, ReflVP_np, ReflVP_v, ReflVP_s, ReflVP_q, ReflVP_a, ReflVP_n
= Pred.ReflVP Pred.aNone ;
ReflVP2_np
= Pred.ReflVP2 Pred.aNone ;
InfVP_none, InfVP_np
= Pred.InfVP Pred.aNone ;
-}
PredVP_none, PredVP_np
= Pred.PredVP Pred.aNone ;
{-
SlashClNP_none
= Pred.SlashClNP Pred.aNone ;
-}
QuestCl_none, QuestCl_np
= Pred.QuestCl Pred.aNone ;
QuestIAdv_none
= Pred.QuestIAdv Pred.aNone ;
QuestIComp_none
= Pred.QuestIComp ;
QuestVP_none
= Pred.QuestVP Pred.aNone ;
{-
QuestSlash_none
= Pred.QuestSlash Pred.aNone ;
UseCl_none
= Pred.UseCl ;
UseQCl_none
= Pred.UseQCl ;
UseAdvCl_none
= Pred.UseAdvCl ;
-}
UttPrS
= Pred.UttPrS ;
AdvCl_none, AdvCl_np
= Pred.AdvCl Pred.aNone ;
{-
AdvQCl_none, AdvQCl_np
= Pred.AdvQCl Pred.aNone ;
---- RelCl_none
---- = Pred.RelCl Pred.aNone ;
RelVP_none
= Pred.RelVP ;
RelSlash_none
= Pred.RelSlash ;
PrImpSg
= Pred.PrImpSg ;
PrImpPl
= Pred.PrImpPl ;
PresPartAP_none, PresPartAP_np
= Pred.PresPartAP Pred.aNone ;
PastPartAP_none
= Pred.PastPartAP Pred.aNone ;
AgentPastPartAP_none
= Pred.AgentPastPartAP Pred.aNone ;
NomVPNP_none
= Pred.NomVPNP ;
ByVP_none
= Pred.ByVP Pred.aNone ;
WhenVP_none
= Pred.WhenVP Pred.aNone ;
BeforeVP_none
= Pred.BeforeVP Pred.aNone ;
AfterVP_none
= Pred.AfterVP Pred.aNone ;
InOrderVP_none
= Pred.InOrderVP Pred.aNone ;
WithoutVP_none
= Pred.WithoutVP Pred.aNone ;
StartVPC_none, StartVPC_np
= Pred.StartVPC Pred.aNone ;
ContVPC_none, ContVPC_np
= Pred.ContVPC Pred.aNone ;
UseVPC_none, UseVPC_np
= Pred.UseVPC Pred.aNone ;
StartClC_none, StartClC_np
= Pred.StartClC Pred.aNone ;
ContClC_none, ContClC_np
= Pred.ContClC Pred.aNone ;
UseClC_none, UseClC_np
= Pred.UseClC Pred.aNone ;
ComplAdv_none
= Pred.ComplAdv Pred.aNone ;
SubjUttPreS
= Pred.SubjUttPreS ;
SubjUttPreQ
= Pred.SubjUttPreQ ;
SubjUttPost
= Pred.SubjUttPost ;
-}
}

12
src/experimental/Test.gf
View File

@@ -1,12 +0,0 @@
abstract Test =
Lift - [MkSymb]
,Lexicon - [Pol,Tense]
,Structural - [Pol,Tense]
** {
flags
startcat=Phr;
-- heuristic_search_factor=0.60;
-- meta_prob=1.0e-5;
-- meta_token_prob=1.1965149246222233e-9;
}

12
src/experimental/TestChi.gf
View File

@@ -1,12 +0,0 @@
concrete TestChi of Test =
LiftChi - [MkSymb]
,LexiconChi - [Pol,Tense,Ant]
,StructuralChi - [Pol,Tense,Ant]
** open ResChi, PredInstanceChi, Prelude in {
--flags literal=Symb ;
}

9
src/experimental/TestEng.gf
View File

@@ -1,9 +0,0 @@
concrete TestEng of Test =
LiftEng - [MkSymb]
,LexiconEng - [Pol,Tense]
,StructuralEng - [Pol,Tense]
** open ResEng, PredInstanceEng, Prelude, (Pr = PredEng) in {
--flags literal=Symb ;
}

8
src/experimental/TestFin.gf
View File

@@ -1,8 +0,0 @@
--# -path=.:../finnish/stemmed:../finnish:../common:alltenses
concrete TestFin of Test =
LiftFin - [MkSymb]
,LexiconFin - [Pol,Tense]
,StructuralFin - [Pol,Tense]
;

12
src/experimental/TestSwe.gf
View File

@@ -1,12 +0,0 @@
concrete TestSwe of Test =
LiftSwe - [MkSymb]
,LexiconSwe - [Pol,Tense]
,StructuralSwe - [Pol,Tense]
** open CommonScand, ResSwe, PredInstanceSwe, Prelude in {
--flags literal=Symb ;
}

142
src/experimental/alternatives/Predication.gf
View File

@@ -1,142 +0,0 @@
abstract Predication = {
flags
startcat = Utt ;
cat
Arg ;
V Arg ;
VP Arg ;
VPC Arg ; -- conjunction of VP
Ant ;
Tense ;
Pol ;
Cl Arg ;
ClC Arg ; -- conjunction of Cl
QCl Arg ;
NP ;
Adv Arg ; -- preposition is Adv aNP
S ;
Utt ;
AP Arg ;
CN Arg ; -- the country he became the president of
IP ;
Conj ;
IAdv ;
fun
aNone, aS, aV, aQ, aA, aN : Arg ;
aNP : Arg -> Arg ;
TPres, TPast, TFut, TCond : Tense ;
PPos, PNeg : Pol ;
ASimul, AAnter : Ant ;
UseV : Ant -> Tense -> Pol -> (a : Arg) -> V a -> VP a ;
PassUseV : Ant -> Tense -> Pol -> (a : Arg) -> V (aNP a) -> VP a ;
AgentPassUseV : Ant -> Tense -> Pol -> (a : Arg) -> V (aNP a) -> NP -> VP a ;
SlashV2 : (a : Arg) -> VP (aNP a) -> NP -> VP a ; -- consuming first NP
SlashV3 : (a : Arg) -> VP (aNP (aNP a)) -> NP -> VP (aNP a) ; -- consuming second NP
ComplVS : (a : Arg) -> VP aS -> Cl a -> VP a ;
ComplVV : (a : Arg) -> VP aV -> VP a -> VP a ;
ComplVQ : (a : Arg) -> VP aQ -> QCl a -> VP a ;
ComplVA : (a : Arg) -> VP aA -> AP a -> VP a ;
ComplVN : (a : Arg) -> VP aN -> CN a -> VP a ;
SlashV2S : (a : Arg) -> VP (aNP aS) -> Cl a -> VP (aNP a) ; -- a:Arg gives slash propagation, SlashVS
SlashV2V : (a : Arg) -> VP (aNP aV) -> VP a -> VP (aNP a) ;
SlashV2A : (a : Arg) -> VP (aNP aA) -> AP a -> VP (aNP a) ;
SlashV2N : (a : Arg) -> VP (aNP aN) -> CN a -> VP (aNP a) ;
SlashV2Q : (a : Arg) -> VP (aNP aA) -> QCl a -> VP (aNP a) ;
UseAP : Ant -> Tense -> Pol -> (a : Arg) -> AP a -> VP a ;
PredVP : (a : Arg) -> NP -> VP a -> Cl a ;
SlashClNP : (a : Arg) -> Cl (aNP a) -> NP -> Cl a ; -- slash consumption: hon tittar på + oss
ReflVP : (a : Arg) -> VP (aNP a) -> VP a ; -- refl on first position (direct object)
ReflVP2 : (a : Arg) -> VP (aNP (aNP a)) -> VP (aNP a) ; -- refl on second position (indirect object)
QuestVP : (a : Arg) -> IP -> VP a -> QCl a ;
QuestSlash : (a : Arg) -> IP -> QCl (aNP a) -> QCl a ;
QuestCl : (a : Arg) -> Cl a -> QCl a ;
QuestIAdv : (a : Arg) -> IAdv -> Cl a -> QCl a ;
UseCl : Cl aNone -> S ;
UseQCl : QCl aNone -> S ; -- deprecate QS
UseAdvCl : Adv aNone -> Cl aNone -> S ; -- lift adv to front
UttS : S -> Utt ;
-- when to add adverbs
---- AdvVP : Adv -> (a : Arg) -> VP a -> VP a ; ---- these create many ambiguities
---- "hon tvingar oss att sova idag": 196 parses, 13s. With AdvVP restricted to top level: 32 parses, 7s
---- with AdvCl, just 16 parses, 0.2 s
AdvCl : (a : Arg) -> Adv a -> Cl aNone -> Cl a ;
AdvQCl : (a : Arg) -> Adv a -> QCl aNone -> QCl a ;
-- participles as adjectives
PresPartAP : (a : Arg) -> V a -> AP a ;
PastPartAP : (a : Arg) -> V (aNP a) -> AP a ;
AgentPastPartAP : (a : Arg) -> V (aNP a) -> NP -> AP a ;
-- VP coordination
StartVPC : Conj -> (a : Arg) -> VP a -> VP a -> VPC a ;
ContVPC : (a : Arg) -> VP a -> VPC a -> VPC a ;
UseVPC : (a : Arg) -> VPC a -> VP a ;
-- clause coordination, including "she loves and we look at (her)"
StartClC : Conj -> (a : Arg) -> Cl a -> Cl a -> ClC a ;
ContClC : (a : Arg) -> Cl a -> ClC a -> ClC a ;
UseClC : (a : Arg) -> ClC a -> Cl a ;
ComplAdv : (a : Arg) -> Adv (aNP a) -> NP -> Adv a ; -- typically: formation of preposition phrase
--------------- from now on, to be inherited from standard RGL; here just for test purposes
-- lexicon
sleep_V : V aNone ;
walk_V : V aNone ;
love_V2 : V (aNP aNone) ;
look_V2 : V (aNP aNone) ;
believe_VS : V aS ;
tell_V2S : V (aNP aS) ;
prefer_V3 : V (aNP (aNP aNone)) ;
want_VV : V aV ;
force_V2V : V (aNP aV) ;
promise_V2V : V (aNP aV) ;
wonder_VQ : V aQ ;
become_VA : V aA ;
become_VN : V aN ;
make_V2A : V (aNP aA) ;
ask_V2Q : V (aNP aQ) ;
promote_V2N : V (aNP aN) ;
old_A : AP aNone ;
married_A2 : AP (aNP aNone) ; -- married to her
eager_AV : AP aV ; -- eager to sleep
easy_A2V : AP (aNP aV) ; -- easy for him to sleep
professor_N : CN aNone ;
manager_N2 : CN (aNP aNone) ; -- manager of X
she_NP : NP ;
we_NP : NP ;
today_Adv : Adv aNone ;
always_AdV : Adv aNone ;
who_IP : IP ;
with_Prep : Adv (aNP aNone) ;
and_Conj : Conj ;
why_IAdv : IAdv ;
}

766
src/experimental/alternatives/PredicationEng.gf
View File

@@ -1,766 +0,0 @@
concrete PredicationEng of Predication = open Prelude in {
-- English predication, based on Swedish
-- two principles:
-- - keep records discontinuous as long as possible (last step from Cl to S)
-- - select from tables as soon as possible (first step from V to VP)
-- a question: would it make sense to make this into a functor?
---------------------
-- parameters -------
---------------------
-- standard general
param
Number = Sg | Pl ;
Person = P1 | P2 | P3 ;
Anteriority = Simul | Anter ;
Polarity = Pos | Neg ;
STense = Pres | Past | Fut | Cond ;
Voice = Act | Pass ;
Unit = UUnit ;
-- predication specific
FocusType = NoFoc | FocSubj | FocObj ; -- sover hon/om hon sover, vem älskar hon/vem hon älskar, vem sover/vem som sover
-- standard English
Gender = Neutr | Masc | Fem ;
Agr = AgP1 Number | AgP2 Number | AgP3Sg Gender | AgP3Pl ;
Case = Nom | Acc ;
NPCase = NCase Case | NPAcc | NPNomPoss ;
VForm = VInf | VPres | VPast | VPPart | VPresPart ;
-- language dependent
VAgr = VASgP1 | VASgP3 | VAPl ;
oper
subjCase : NPCase = NCase Nom ;
objCase : NPCase = NPAcc ;
agentCase : ComplCase = "by" ;
ComplCase = Str ; -- preposition
appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> p ++ np.s ! objCase ;
noComplCase : ComplCase = [] ;
prepComplCase : Preposition -> ComplCase = \p -> p.s ;
noObj : Agr => Str = \\_ => [] ;
NAgr = Number ;
AAgr = Unit ;
IPAgr = Number ;
defaultAgr : Agr = AgP3Sg Neutr ;
-- omitting rich Agr information
agr2vagr : Agr -> VAgr = \a -> case a of {
AgP1 Sg => VASgP1 ;
AgP3Sg _ => VASgP3 ;
_ => VAPl
} ;
agr2aagr : Agr -> AAgr = \n -> UUnit ;
agr2nagr : Agr -> NAgr = \a -> case a of {
AgP1 n => n ;
AgP2 n => n ;
AgP3Sg _ => Sg ;
AgP3Pl => Pl
} ;
-- restoring full Agr
ipagr2agr : IPAgr -> Agr = \n -> case n of {
Sg => AgP3Sg Neutr ; ---- gender
Pl => AgP3Pl
} ;
ipagr2vagr : IPAgr -> VAgr = \n -> case n of {
Sg => VASgP3 ;
Pl => VAPl
} ;
--- this is only needed in VPC formation
vagr2agr : VAgr -> Agr = \a -> case a of {
VASgP1 => AgP1 Sg ;
VASgP3 => AgP3Sg Neutr ;
VAPl => AgP3Pl
} ;
vPastPart : AAgr -> VForm = \_ -> VPPart ;
vPresPart : AAgr -> VForm = \_ -> VPresPart ;
------------------------------------
-- lincats
-------------------------------------
-- standard general
lincat
Tense = {s : Str ; t : STense} ;
Ant = {s : Str ; a : Anteriority} ;
Pol = {s : Str ; p : Polarity} ;
Utt = {s : Str} ;
IAdv = {s : Str} ;
-- predication-specific
Arg = {s : Str} ;
V = {
v : VForm => Str ;
p : Str ; -- verb particle
c1 : ComplCase ;
c2 : ComplCase ;
isSubjectControl : Bool ;
isAux : Bool ;
isRefl : Bool ;
} ;
oper
VerbPhrase = {
v : VAgr => Str * Str * Str ; -- would,have,slept
inf : Str * Str ; -- have,slept
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
adv : Str ;
adV : Str ;
ext : Str ;
qforms : VAgr => Str * Str -- special Eng for introducing "do" in questions
} ;
Clause = {
v : Str * Str * Str ;
inf : Str * Str ;
adj,obj1,obj2 : Str ;
adv : Str ;
adV : Str ;
ext : Str ;
subj : Str ;
c3 : ComplCase ; -- for a slashed adjunct, not belonging to the verb valency
qforms : Str * Str
} ;
lincat
VP = VerbPhrase ;
Cl = Clause ;
QCl = Clause ** {
foc : Str ; -- the focal position at the beginning: *who* does she love
focType : FocusType ; --- if already filled, then use other place: who loves *who*
} ;
VPC = {
v : VAgr => Str ;
inf : Agr => Str ;
c1 : ComplCase ;
c2 : ComplCase
} ;
ClC = {
s : Str ;
c3 : ComplCase ;
} ;
Adv = {s : Str ; isAdV : Bool ; c1 : ComplCase} ;
S = {s : Str} ;
AP = {
s : AAgr => Str ;
c1, c2 : ComplCase ;
obj1 : Agr => Str
} ;
CN = {
s : NAgr => Str ;
c1, c2 : ComplCase ;
obj1 : Agr => Str
} ;
-- language specific
NP = NounPhrase ;
IP = {s : NPCase => Str ; n : IPAgr} ; ---- n : Number in Eng
Conj = {s1,s2 : Str ; n : Number} ;
oper
NounPhrase = {s : NPCase => Str ; a : Agr} ;
Preposition = {s : Str} ;
----------------------------
--- linearization rules ----
----------------------------
-- standard general
lin
TPres = {s = [] ; t = Pres} ;
TPast = {s = [] ; t = Past} ;
TFut = {s = [] ; t = Fut} ;
TCond = {s = [] ; t = Cond} ;
ASimul = {s = [] ; a = Simul} ;
AAnter = {s = [] ; a = Anter} ;
PPos = {s = [] ; p = Pos} ;
PNeg = {s = [] ; p = Neg} ;
-- predication specific
aNone, aS, aV, aA, aQ, aN = {s = []} ;
aNP a = a ;
UseV a t p _ v = {
v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Act agr v ;
inf = tenseInfV a.s a.a p.p Act v ;
c1 = v.c1 ;
c2 = v.c2 ;
part = v.p ;
adj = noObj ;
obj1 = <case v.isRefl of {True => \\a => reflPron ! a ; False => \\_ => []}, defaultAgr> ; ---- not used, just default value
obj2 = <noObj, v.isSubjectControl> ;
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 ;
} ;
PassUseV a t p _ v = {
v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Pass agr v ;
inf = tenseInfV a.s a.a p.p Pass v ;
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"
adV = negAdV p ;
adv = [] ;
ext = [] ;
qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
} ;
AgentPassUseV a t p _ v np = {
v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Pass agr v ;
inf = tenseInfV a.s a.a p.p Pass v ;
c1 = v.c1 ;
c2 = v.c2 ;
part = v.p ;
adj = \\a => [] ;
obj1 = <noObj, defaultAgr> ;
obj2 = <noObj, True> ;
adV = negAdV p ;
adv = appComplCase agentCase np ;
ext = [] ;
qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
} ;
UseAP a t p _ ap = {
v = \\agr => be_Aux (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
inf = tenseInfV a.s a.a p.p Act be_V ;
c1 = ap.c1 ;
c2 = ap.c2 ;
part = [] ;
adj = \\a => ap.s ! agr2aagr a ;
obj1 = <ap.obj1, defaultAgr> ;
obj2 = <noObj, True> ; --- there are no A3's
adV = negAdV p ;
adv = [] ;
ext = [] ;
qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
} ;
SlashV2 x vp np = vp ** {
obj1 : (Agr => Str) * Agr = <\\a => np.s ! objCase, np.a> -- np.a for object control
} ;
SlashV3 x vp np = addObj2VP vp (\\a => np.s ! objCase) ; -- control is preserved
ComplVS x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form
ComplVQ x vp qcl = addExtVP vp (questSubordCl qcl) ; ---- question form
ComplVV x vp vpo = addObj2VP vp (\\a => infVP a vpo) ; ---- infForm
ComplVA x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm
ComplVN x vp cn = addObj2VP vp (\\a => cn.s ! agr2nagr a ++ cn.obj1 ! a) ; ---- cnForm
SlashV2S x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form
SlashV2Q x vp cl = addExtVP vp (questSubordCl (lin QCl cl)) ; ---- question form
SlashV2V x vp vpo = addObj2VP vp (\\a => infVP a (lin VP vpo)) ; ---- infForm
SlashV2A x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm
SlashV2N x vp cn = addObj2VP vp (\\a => cn.s ! agr2nagr a ++ cn.obj1 ! a) ; ---- cn form
ReflVP x vp = vp ** {
obj1 : (Agr => Str) * Agr = <\\a => reflPron ! a, defaultAgr> ; --- defaultAgr will not be used but subj.a instead
} ;
ReflVP2 x vp = vp ** {
obj2 : (Agr => Str) * Bool = <\\a => reflPron ! a, vp.obj2.p2> ; --- subj/obj control doesn't matter any more
} ;
PredVP x np vp = vp ** {
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
c3 = noComplCase ; -- for one more prep to build ClSlash
qforms = vp.qforms ! agr2vagr np.a ;
} ;
PrepCl p x cl = cl ** { -- Cl/NP ::= Cl PP/NP
c3 = prepComplCase p ;
} ;
SlashClNP x cl np = cl ** { -- Cl ::= Cl/NP NP
adv = cl.adv ++ appComplCase cl.c3 np ; ---- again, adv just added
c3 = noComplCase ; -- complCase has been consumed
} ;
-- QCl ::= Cl by just adding focus field
QuestCl x cl = cl ** {foc = [] ; focType = NoFoc} ; -- NoFoc implies verb first: does she love us
QuestIAdv x iadv cl = cl ** {foc = iadv.s ; focType = FocObj} ; -- FocObj implies Foc + V + Subj: why does she love us
QuestVP x ip vp = let ipa = ipagr2agr ip.n in
vp ** {
v = vp.v ! ipagr2vagr ip.n ;
foc = ip.s ! subjCase ; -- who (loves her)
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
c3 = noComplCase ; -- for one more prep to build ClSlash ---- ever needed for QCl?
qforms = vp.qforms ! ipagr2vagr ip.n ;
} ;
QuestSlash x ip cl =
let
prep = cl.c3 ;
ips = ip.s ! objCase ; -- in Cl/NP, c3 is the only prep ---- appComplCase for ip
focobj = case cl.focType of {
NoFoc => <ips, [], FocObj,prep> ; -- 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
} ;
in
cl ** { -- preposition stranding
foc = focobj.p1 ;
focType = focobj.p3 ;
obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field?
c3 = focobj.p4 ;
} ;
{-
---- this is giving four records instead of two AR 5/2/2014
|
cl ** { -- pied piping
foc = focobj.p4 ++ focobj.p1 ;
focType = focobj.p3 ;
obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field?
c3 = noComplCase ;
} ;
-}
UseCl cl = {s = declCl cl} ;
UseQCl cl = {s = questCl cl} ;
UseAdvCl adv cl = {s = adv.s ++ declInvCl cl} ;
UttS s = s ;
AdvCl x a cl = case a.isAdV of {
True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ;
False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1}
} ;
AdvQCl x a cl = case a.isAdV of {
True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ;
False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1}
} ;
PresPartAP x v = {
s = \\a => v.v ! vPresPart a ;
c1 = v.c1 ; -- looking at her
c2 = v.c2 ;
obj1 = noObj ;
} ;
PastPartAP x v = {
s = \\a => v.v ! vPastPart a ;
c1 = v.c1 ;
c2 = v.c2 ;
obj1 = noObj ;
} ;
AgentPastPartAP x v np = {
s = \\a => v.v ! vPastPart a ;
c1 = v.c1 ;
c2 = v.c2 ;
obj1 = \\_ => appComplCase agentCase np ; ---- addObj
} ;
StartVPC c x v w = { ---- some loss of quality seems inevitable
v = \\a =>
let
vv = v.v ! a ;
wv = w.v ! a ;
vpa = vagr2agr a ;
in
vv.p1 ++ v.adV ++ vv.p2 ++ vv.p3 ++ v.adj ! vpa ++
v.c1 ++ v.obj1.p1 ! vpa ++ v.c2 ++ v.obj2.p1 ! vpa ++ v.adv ++ v.ext ---- appComplCase
++ c.s2 ++
wv.p1 ++ w.adV ++ wv.p2 ++ wv.p3 ++ w.adj ! vpa ++ ---- appComplCase
w.c1 ++ w.obj1.p1 ! vpa ++ w.c2 ++ w.obj2.p1 ! vpa ++ w.adv ++ w.ext ;
inf = \\a =>
infVP a (lin VP v) ++ c.s2 ++ infVP a (lin VP w) ;
c1 = [] ; ---- w.c1 ? --- the full story is to unify v and w...
c2 = [] ; ---- w.c2 ?
} ;
UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable
v = \\a => <[], [], vpc.v ! a> ;
inf = <[], vpc.inf ! defaultAgr> ; ---- agreement
c1 = vpc.c1 ;
c2 = vpc.c2 ;
part = [] ;
adj = \\a => [] ;
obj1 = <noObj, defaultAgr> ;
obj2 = <noObj,True> ;
adv,adV = [] ;
ext = [] ;
qforms = \\a => <"do", vpc.inf ! defaultAgr> ; ---- do/does/did
} ;
StartClC c x a b = {
s = declCl (lin Cl a) ++ c.s2 ++ declCl (lin Cl b) ;
c3 = b.c3 ; ----
} ;
UseClC x cl = {
subj = [] ;
v = <[],[],cl.s> ; ----
inf = <[],[]> ;
adj = [] ;
obj1 = [] ;
obj2 = [] ;
adV = [] ;
adv = [] ;
ext = [] ;
c3 = cl.c3 ;
qforms = <[],[]> ; ---- qforms
} ;
ComplAdv x p np = {s = p.c1 ++ np.s ! objCase ; isAdV = p.isAdV ; c1 = []} ;
---- the following may become parameters for a functor
oper
be_V : V = lin V {v = mkVerb "be" "is" "was" "been" "being" ; p,c1,c2 = [] ; isAux = True ; isSubjectControl,isRefl = False} ;
negAdV : Pol -> Str = \p -> p.s ;
reflPron : Agr => Str = table {
AgP1 Sg => "myself" ;
AgP2 Sg => "yourself" ;
AgP3Sg Masc => "himself" ;
AgP3Sg Fem => "herself" ;
AgP3Sg Neutr => "itself" ;
AgP1 Pl => "ourselves" ;
AgP2 Pl => "yourselves" ;
AgP3Pl => "themselves"
} ;
infVP : Agr -> VP -> Str = \a,vp ->
let
a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2}
in
vp.adV ++ vp.inf.p1 ++ vp.inf.p2 ++ vp.part ++
vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ;
qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str =
\sta,t,a,p,agr,v ->
let
verb = tenseActV sta t a Neg agr v ;
averb = tenseActV sta t a p agr v
in case <v.isAux, t, a> of {
<False,Pres|Past,Simul> => case p of {
Pos => < verb.p1, verb.p3> ; -- does , sleep
Neg => < verb.p1, verb.p2> -- does , not sleep ---- TODO: doesn't , sleep
} ;
_ => <averb.p1, averb.p2>
} ;
qformsBe : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str =
\sta,t,a,p,agr ->
let verb = be_AuxL sta t a p agr
in <verb.p1, verb.p2> ; -- is , not ---- TODO isn't ,
tenseV : Str -> STense -> Anteriority -> Polarity -> Voice -> VAgr -> V -> Str * Str * Str =
\sta,t,a,p,o,agr,v ->
case o of {
Act => tenseActV sta t a p agr v ;
Pass => tensePassV sta t a p agr v
} {-
| ---- leaving out these variants makes compilation time go down from 900ms to 300ms.
---- parsing time of "she sleeps" goes down from 300ms to 60ms. 4/2/2014
case o of {
Act => tenseActVContracted sta t a p agr v ;
Pass => tensePassVContracted sta t a p agr v
-} ;
tenseActV : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str * Str = \sta,t,a,p,agr,v ->
let vt : VForm = case <t,agr> of {
<Pres,VASgP3> => VPres ;
<Past|Cond,_ > => VPast ;
_ => VInf
} ;
in
case <t,a> of {
<Pres|Past, Simul> =>
case v.isAux of {
True => <sta ++ v.v ! vt, [], []> ;
False => case p of {
Pos => <[], sta ++ v.v ! vt, []> ; -- this is the deviating case
Neg => <do_Aux vt Pos, not_Str p, sta ++ v.v ! VInf>
}
} ;
<Pres|Past, Anter> => <have_Aux vt Pos, not_Str p, sta ++ v.v ! VPPart> ;
<Fut|Cond, Simul> => <will_Aux vt Pos, not_Str p, sta ++ v.v ! VInf> ;
<Fut|Cond, Anter> => <will_Aux vt Pos, not_Str p ++ have_Aux VInf Pos, sta ++ v.v ! VPPart>
} ;
tenseActVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str * Str = \sta,t,a,p,agr,v ->
let vt : VForm = case <t,agr> of {
<Pres,VASgP3> => VPres ;
<Past|Cond,_ > => VPast ;
_ => VInf
} ;
in
case <t,a> of {
<Pres|Past, Simul> =>
case v.isAux of {
True => <sta ++ v.v ! vt, [], []> ;
False => case p of {
Pos => <[], sta ++ v.v ! vt, []> ; -- this is the deviating case
Neg => <do_Aux vt p, [], sta ++ v.v ! VInf>
}
} ;
<Pres|Past, Anter> => <have_AuxC vt p, [], sta ++ v.v ! VPPart>
| <have_AuxC vt Pos, not_Str p, sta ++ v.v ! VPPart> ;
<Fut|Cond, Simul> => <will_AuxC vt p, [], sta ++ v.v ! VInf>
| <will_AuxC vt Pos, not_Str p, sta ++ v.v ! VInf> ;
<Fut|Cond, Anter> => <will_AuxC vt p, have_Aux VInf Pos, sta ++ v.v ! VPPart>
| <will_AuxC vt Pos, not_Str p ++ have_Aux VInf Pos, sta ++ v.v ! VPPart>
} ;
tensePassV : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str * Str = \sta,t,a,p,agr,v ->
let
be = be_AuxL sta t a p agr ;
done = v.v ! VPPart
in
<be.p1, be.p2, be.p3 ++ done> ;
tensePassVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str * Str = \sta,t,a,p,agr,v ->
let
be = be_AuxC sta t a p agr ;
done = v.v ! VPPart
in
<be.p1, be.p2, be.p3 ++ done> ;
tenseInfV : Str -> Anteriority -> Polarity -> Voice -> V -> Str * Str = \sa,a,p,o,v ->
case a of {
Simul => <[], sa ++ v.v ! VInf> ; -- (she wants to) sleep
Anter => <have_Aux VInf Pos, sa ++ v.v ! VPPart> -- (she wants to) have slept
} ;
----- dangerous variants for PMCFG generation - keep apart as long as possible
be_Aux : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr ->
be_AuxL sta t a p agr | be_AuxC sta t a p agr ;
be_AuxL : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr ->
let
beV = tenseActV sta t a p agr be_V
in
case <t,a,p,agr> of {
<Pres,Simul,Pos,VASgP3> => <"is" ++ sta, [], []> ;
<Pres,Simul,Pos,VASgP1> => <"am" ++ sta, [], []> ;
<Pres,Simul,Pos,VAPl> => <"are" ++ sta, [], []> ;
<Pres,Simul,Neg,VASgP3> => <"is" ++ sta, "not", []> ;
<Pres,Simul,Neg,VASgP1> => <"am" ++ sta, "not", []> ;
<Pres,Simul,Neg,VAPl> => <"are" ++ sta, "not", []> ;
<Past,Simul,Pos,VAPl> => <"were" ++ sta, [], []> ;
<Past,Simul,Neg,VAPl> => <"were" ++ sta, "not", []> ;
<Past,Simul,Neg,_> => <"was" ++ sta, "not", []> ;
_ => beV
} ;
be_AuxC : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr ->
let
beV = tenseActVContracted sta t a p agr be_V
in
case <t,a,p,agr> of {
<Pres,Simul,Pos,VASgP3> => <Predef.BIND ++ "'s" ++ sta, [], []> ;
<Pres,Simul,Pos,VASgP1> => <Predef.BIND ++ "'m" ++ sta, [], []> ;
<Pres,Simul,Pos,VAPl> => <Predef.BIND ++ "'re" ++ sta, [], []> ;
<Pres,Simul,Neg,VASgP3> => <Predef.BIND ++ "'s" ++ sta, "not", []>
| <"isn't" ++ sta, [], []> ;
<Pres,Simul,Neg,VASgP1> => <Predef.BIND ++ "'m" ++ sta, "not", []> ;
<Pres,Simul,Neg,VAPl> => <Predef.BIND ++ "'re" ++ sta, "not", []>
| <"aren't" ++ sta, [], []> ;
<Past,Simul,Pos,VAPl> => <"were" ++ sta, [], []> ;
<Past,Simul,Neg,VAPl> => <"weren't" ++ sta, [], []> ;
<Past,Simul,Neg,_> => <"wasn't" ++ sta, [], []> ;
_ => beV
} ;
declCl : Clause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
declSubordCl : Clause -> Str = declCl ;
declInvCl : Clause -> Str = declCl ;
questCl : QCl -> Str = \cl -> case cl.focType of {
NoFoc => cl.foc ++ cl.qforms.p1 ++ cl.subj ++ cl.adV ++ cl.qforms.p2 ++ restCl cl ; -- does she sleep
FocObj => cl.foc ++ cl.qforms.p1 ++ cl.subj ++ cl.adV ++ cl.qforms.p2 ++ restCl cl ; -- who does she love
FocSubj => cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl -- who loves her
} ;
questSubordCl : QCl -> Str = \cl ->
let
rest = cl.subj ++ cl.adV ++ cl.v.p1 ++ cl.v.p2 ++ restCl cl
in case cl.focType of {
NoFoc => "if" ++ cl.foc ++ rest ; -- om she sleeps
FocObj => cl.foc ++ rest ; -- who she loves / why she sleeps
FocSubj => cl.foc ++ rest -- who loves her
} ;
that_Compl : Str = "that" | [] ;
-- this part is usually the same in all reconfigurations
restCl : Clause -> Str = \cl -> cl.v.p3 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ++ cl.c3 ;
addObj2VP : VerbPhrase -> (Agr => Str) -> VerbPhrase = \vp,obj -> vp ** {
obj2 = <\\a => vp.obj2.p1 ! a ++ obj ! a, vp.obj2.p2> ;
} ;
addExtVP : VerbPhrase -> Str -> VerbPhrase = \vp,ext -> vp ** {
ext = ext ;
} ;
---- the lexicon is just for testing: use standard Eng lexicon and morphology instead
lin
sleep_V = mkV "sleep" "slept" "slept" [] [] ;
walk_V = mkV "walk" ;
love_V2 = mkV "love" ;
look_V2 = mkV "look" "at" [] ;
believe_VS = mkV "believe" ;
tell_V2S = mkV "tell" "told" "told" [] [] ;
prefer_V3 = mkV "prefer" [] "to" ;
want_VV = mkV "want" [] "to" ;
force_V2V = mkV "force" [] "to" ;
--- promise_V2V = mkV "promise" [] "to" ** {isSubjectControl = True} ;
wonder_VQ = mkV "wonder" ;
become_VA = mkV "become" "became" "become" [] [] ;
become_VN = mkV "become" "became" "become" [] [] ;
make_V2A = mkV "make" "made" "made" [] [] ;
promote_V2N = mkV "promote" [] "to" ;
ask_V2Q = mkV "ask" ;
old_A = {s = \\_ => "old" ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ;
married_A2 = {s = \\_ => "married" ; c1 = "to" ; c2 = [] ; obj1 = \\_ => []} ;
eager_AV = {s = \\_ => "eager" ; c1 = [] ; c2 = "to" ; obj1 = \\_ => []} ;
easy_A2V = {s = \\_ => "easy" ; c1 = "for" ; c2 = "to" ; obj1 = \\_ => []} ;
professor_N = {s = table {Sg => "professor" ; Pl => "professors"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ;
manager_N2 = {s = table {Sg => "manager" ; Pl => "managers"} ; c1 = "for" ; c2 = [] ; obj1 = \\_ => []} ;
she_NP = {s = table {NCase Nom => "she" ; _ => "her"} ; a = AgP3Sg Fem} ;
we_NP = {s = table {NCase Nom => "we" ; _ => "us"} ; a = AgP1 Pl} ;
today_Adv = {s = "today" ; isAdV = False ; c1 = []} ;
always_AdV = {s = "always" ; isAdV = True ; c1 = []} ;
who_IP = {s = \\_ => "who" ; n = Sg} ;
with_Prep = {s = [] ; c1 = "with" ; isAdV = False} ;
and_Conj = {s1 = [] ; s2 = "and" ; n = Pl} ;
why_IAdv = {s = "why"} ;
oper
mkV = overload {
mkV : Str -> V = \s -> lin V {v = mkVerb s (s + "s") (edV s) (edV s) (ingV s) ; p,c1,c2 = [] ; isAux,isSubjectControl,isRefl = False} ;
mkV : Str -> Str -> Str -> V = \s,p,q -> lin V {v = mkVerb s (s + "s") (edV s) (edV s) (ingV s) ; p = [] ; c1 = p ; c2 = q ; isAux,isSubjectControl,isRefl = False} ;
mkV : Str -> Str -> Str -> Str -> Str -> V = \s,t,u,p,q -> lin V {v = mkVerb s (s + "s") t u (ingV s) ; p = [] ; c1 = p ; c2 = q ; isAux,isSubjectControl,isRefl = False} ;
} ;
mkVerb : Str -> Str -> Str -> Str -> Str -> VForm => Str = \go,goes,went,gone,going -> table {
VInf => go ;
VPres => goes ;
VPast => went ;
VPPart => gone ;
VPresPart => going
} ;
edV : Str -> Str = \s -> case s of {us + "e" => us ; _ => s} + "ed" ;
ingV : Str -> Str = \s -> case s of {us + "e" => us ; _ => s} + "ing" ;
---- have to split the tables to two to get reasonable PMCFG generation
will_Aux : VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf|VPres, Pos> => varAux "will" "ll" ;
<VInf|VPres, Neg> => "won't" ;
<VPast|_ , Pos> => varAux "would" "d" ;
<VPast|_ , Neg> => "wouldn't"
} ;
will_AuxC : VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf|VPres, Pos> => varAuxC "will" "ll" ;
<VInf|VPres, Neg> => "won't" ;
<VPast|_ , Pos> => varAuxC "would" "d" ;
<VPast|_ , Neg> => "wouldn't"
} ;
have_Aux : VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf, Pos> => varAux "have" "ve" ; --- slightly overgenerating if used in infinitive
<VInf, Neg> => "haven't" ;
<VPres, Pos> => varAux "has" "s" ;
<VPres, Neg> => "hasn't" ;
<VPast|_ , Pos> => varAux "had" "d" ;
<VPast|_ , Neg> => "hadn't"
} ;
have_AuxC : VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf, Pos> => varAuxC "have" "ve" ; --- slightly overgenerating if used in infinitive
<VInf, Neg> => "haven't" ;
<VPres, Pos> => varAuxC "has" "s" ;
<VPres, Neg> => "hasn't" ;
<VPast|_ , Pos> => varAuxC "had" "d" ;
<VPast|_ , Neg> => "hadn't"
} ;
do_Aux : VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf, Pos> => "do" ;
<VInf, Neg> => "don't" ;
<VPres, Pos> => "does" ;
<VPres, Neg> => "doesn't" ;
<VPast|_ , Pos> => "did" ;
<VPast|_ , Neg> => "didn't"
} ;
varAux : Str -> Str -> Str = \long,short -> long ; ----| Predef.BIND ++ ("'" + short) ;
varAuxC : Str -> Str -> Str = \long,short -> Predef.BIND ++ ("'" + short) ;
not_Str : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "not"} ;
}

697
src/experimental/alternatives/PredicationSwO.gf
View File

@@ -1,697 +0,0 @@
concrete PredicationSwO of Predication = open Prelude in {
-- Swedish predication: simpler and purer than English.
-- two principles:
-- - keep records discontinuous as long as possible (last step from Cl to S)
-- - select from tables as soon as possible (first step from V to VP)
-- a question: would it make sense to make this into a functor?
param
Agr = Sg | Pl ;
Case = Nom | Acc ;
STense = Pres | Past | Perf | Fut ;
Anteriority = Simul | Anter ;
Polarity = Pos | Neg ;
VTense = VInf | VPres | VPret | VSup ;
VForm = TV Voice VTense | PastPart Agr | PresPart ;
Voice = Act | Pass ;
FocusType = NoFoc | FocSubj | FocObj ; -- sover hon/om hon sover, vem älskar hon/vem hon älskar, vem sover/vem som sover
oper
defaultAgr = Sg ;
ComplCase = Str ; -- preposition
lincat
Arg = {s : Str} ;
V = {
v : VForm => Str ;
c1 : ComplCase ;
c2 : ComplCase ;
isSubjectControl : Bool ;
} ;
VP = {
v : Str * Str * Str ; -- ska,ha,sovit
inf : Str * Str ; -- ha,sovit
c1 : ComplCase ;
c2 : ComplCase ;
adj : Agr => Str ;
obj1 : (Agr => Str) * Agr ;
obj2 : (Agr => Str) * Bool ; -- subject control = True
adv : Str ;
adV : Str ;
ext : Str
} ;
oper Clause = {
v : Str * Str * Str ;
inf : Str * Str ;
adj,obj1,obj2 : Str ;
adv : Str ;
adV : Str ;
ext : Str ;
subj : Str ;
c3 : ComplCase -- for a slashed adjunct, not belonging to the verb valency
} ;
lincat
Cl = Clause ;
QCl = Clause ** {
foc : Str ; -- the focal position at the beginning, e.g. *vem* älskar hon
focType : FocusType ; --- if already filled, then use other place: vem älskar *vem*
} ;
VPC = {
v : Agr => Str ;
inf : Agr => Str ;
c1 : ComplCase ;
c2 : ComplCase
} ;
ClC = {
s : Str ;
c3 : ComplCase ;
} ;
Tense = {s : Str ; t : STense} ;
Ant = {s : Str ; a : Anteriority} ;
Pol = {s : Str ; p : Polarity} ;
NP = {s : Case => Str ; a : Agr} ;
Adv = {s : Str} ;
AdV = {s : Str} ;
S = {s : Str} ;
Utt = {s : Str} ;
AP = {
s : Agr => Str ;
c1, c2 : ComplCase ;
obj1 :
Agr => Str
} ;
CN = {
s : Agr => Str ;
c1, c2 : ComplCase ;
obj1 :
Agr => Str
} ;
IP = {s : Str ; a : Agr} ;
Prep = {s : Str} ;
Conj = {s : Str} ;
IAdv = {s : Str} ;
lin
aNone, aS, aV, aA, aQ, aN = {s = []} ;
aNP a = a ;
TPres = {s = [] ; t = Pres} ;
TPast = {s = [] ; t = Past} ;
TFut = {s = [] ; t = Fut} ;
TCond = {s = [] ; t = Perf} ;
ASimul = {s = [] ; a = Simul} ;
AAnter = {s = [] ; a = Anter} ;
PPos = {s = [] ; p = Pos} ;
PNeg = {s = [] ; p = Neg} ;
UseV a t p _ v = {
v = tenseV (a.s ++ t.s) t.t a.a Act v ;
inf = tenseInfV a.s a.a Act v ;
c1 = v.c1 ;
c2 = v.c2 ;
adj = noObj ;
obj1 = <noObj, defaultAgr> ; ---- not used, just default value
obj2 = <noObj, v.isSubjectControl> ;
adV = p.s ++ neg p.p ;
adv = [] ;
ext = [] ;
} ;
PassUseV a t p _ v = {
v = tenseV (a.s ++ t.s) t.t a.a Pass v ;
inf = tenseInfV a.s a.a Pass v ;
c1 = v.c1 ;
c2 = v.c2 ;
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"
adV = p.s ++ neg p.p ;
adv = [] ;
ext = [] ;
} ;
AgentPassUseV a t p _ v np = {
v = tenseV (a.s ++ t.s) t.t a.a Pass v ;
inf = tenseInfV a.s a.a Pass v ;
c1 = v.c1 ;
c2 = v.c2 ;
adj = \\a => [] ;
obj1 = <noObj, defaultAgr> ;
obj2 = <noObj, True> ;
adV = p.s ++ neg p.p ;
adv = appComplCase agentCase np ; ---- add a specific field for agent?
ext = [] ;
} ;
UseAP a t p _ ap = {
v = tenseV (a.s ++ t.s) t.t a.a Act be_V ;
inf = tenseInfV a.s a.a Act be_V ;
c1 = ap.c1 ;
c2 = ap.c2 ;
adj = \\a => ap.s ! a ;
obj1 = <ap.obj1, defaultAgr> ;
obj2 = <noObj, True> ; --- there are no A3's
adV = p.s ++ neg p.p ;
adv = [] ;
ext = [] ;
} ;
SlashV2 x vp np = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ; ---- should be consumed now
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = <\\a => np.s ! Acc, np.a> ; -- np.a for object control ---- Acc to be abstracted
obj2 = vp.obj2 ;
adv = vp.adv ;
adV = vp.adV ;
ext = vp.ext ;
} ;
SlashV3 x vp np = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ; ---- should be consumed now
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = <\\a => np.s ! Acc, vp.obj2.p2> ; -- control is preserved ---- Acc to be abstracted
adv = vp.adv ;
adV = vp.adV ;
ext = vp.ext ;
} ;
ComplVS x vp cl = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = vp.obj1 ; ---- consumed
obj2 = vp.obj2 ;
adV = vp.adV ;
adv = vp.adv ;
ext = that_Compl ++ declSubordCl (lin Cl cl) ; ---- sentence form
} ;
ComplVQ x vp qcl = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = vp.obj1 ; ---- consumed
obj2 = vp.obj2 ;
adV = vp.adV ;
adv = vp.adv ;
ext = questSubordCl qcl ; ---- question form
} ;
ComplVV x vp vpo = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = <\\a => infVP a vpo, vp.obj2.p2> ; ---- infForm
adV = vp.adV ;
adv = vp.adv ;
ext = vp.ext ;
} ;
ComplVA x vp ap = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ; ---- consumed
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = <\\a => ap.s ! a ++ ap.obj1 ! a, vp.obj2.p2> ; ---- adjForm
adV = vp.adV ;
adv = vp.adv ;
ext = vp.ext ;
} ;
ComplVN x vp cn = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ; ---- consumed
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = <\\a => cn.s ! a ++ cn.obj1 ! a, vp.obj2.p2> ; ---- cnForm
adV = vp.adV ;
adv = vp.adv ;
ext = vp.ext ;
} ;
SlashV2S x vp cl = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ; ---- consumed
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = vp.obj2 ;
adV = vp.adV ;
adv = vp.adv ;
ext = that_Compl ++ declSubordCl (lin Cl cl) ; ---- sentence form
} ;
SlashV2Q x vp cl = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ; ---- consumed
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = vp.obj2 ;
adV = vp.adV ;
adv = vp.adv ;
ext = questSubordCl (lin QCl cl) ; ---- question form
} ;
SlashV2V x vp vpo = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ; ---- consumed
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = <\\a => infVP a (lin VP vpo), vp.obj2.p2> ; ---- infForm
adV = vp.adV ;
adv = vp.adv ;
ext = vp.ext ;
} ;
SlashV2A x vp ap = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ; ---- consumed
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = <\\a => ap.s ! a ++ ap.obj1 ! a, vp.obj2.p2> ; ---- adjForm
adV = vp.adV ;
adv = vp.adv ;
ext = vp.ext ;
} ;
SlashV2N x vp cn = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ; ---- consumed
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = <\\a => cn.s ! a ++ cn.obj1 ! a, vp.obj2.p2> ; ---- cn form
adV = vp.adV ;
adv = vp.adv ;
ext = vp.ext ;
} ;
ReflVP x vp = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ; ---- consumed
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = <\\a => reflPron a, defaultAgr> ; --- hack: defaultAgr will not be used but subj.a instead
obj2 = vp.obj2 ;
adV = vp.adV ;
adv = vp.adv ;
ext = vp.ext ;
} ;
ReflVP2 x vp = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ; ---- consumed
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = <\\a => reflPron a, vp.obj2.p2> ; --- subj/obj control doesn't matter any more
adV = vp.adV ;
adv = vp.adv ;
ext = vp.ext ;
} ;
PredVP x np vp = {
subj = np.s ! Nom ;
v = vp.v ;
inf = vp.inf ;
adj = vp.adj ! np.a ;
obj1 = vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase
obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => np.a ; False => vp.obj1.p2}) ; ---- apply complCase
adV = vp.adV ;
adv = vp.adv ;
ext = vp.ext ;
c3 = noComplCase ; -- for one more prep to build ClSlash
} ;
PrepCl p x cl = { -- Cl/NP ::= Cl PP/NP
subj = cl.subj ;
v = cl.v ;
inf = cl.inf ;
adj = cl.adj ;
obj1 = cl.obj1 ;
obj2 = cl.obj2 ;
adV = cl.adV ;
adv = cl.adv ;
ext = cl.ext ;
c3 = prepComplCase p ;
} ;
SlashClNP x cl np = { -- Cl ::= Cl/NP NP
subj = cl.subj ;
v = cl.v ;
inf = cl.inf ;
adj = cl.adj ;
obj1 = cl.obj1 ;
obj2 = cl.obj2 ;
adV = cl.adV ;
adv = cl.adv ++ appComplCase cl.c3 np ; ---- again, adv just added
ext = cl.ext ;
c3 = noComplCase ; -- complCase has been consumed
} ;
-- QCl ::= Cl by just adding focus field
QuestCl x cl = cl ** {foc = [] ; focType = NoFoc} ; -- NoFoc implies verb first: älskar hon oss
QuestIAdv x iadv cl = cl ** {foc = iadv.s ; focType = FocObj} ; -- FocObj implies Foc + V + Subj: varför älskar hon oss
QuestVP x ip vp = {
foc = ip.s ; -- vem älskar henne
focType = FocSubj ;
subj = [] ;
v = vp.v ;
inf = vp.inf ;
adj = vp.adj ! ip.a ;
obj1 = vp.c1 ++ vp.obj1.p1 ! ip.a ; ---- appComplCase
obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => ip.a ; False => vp.obj1.p2}) ; ---- appComplCase
adV = vp.adV ;
adv = vp.adv ;
ext = vp.ext ;
c3 = noComplCase ; -- for one more prep to build ClSlash ---- ever needed for QCl?
} ;
QuestSlash x ip cl =
let
ips = cl.c3 ++ ip.s ; -- in Cl/NP, c3 is the only prep ---- appComplCase for ip
focobj = case cl.focType of {
NoFoc => <ips, [], FocObj> ; -- put ip object to focus if there is no focus yet
t => <[], ips, t> -- put ip object in situ if there already is a focus
} ;
in {
foc = focobj.p1 ;
focType = focobj.p3 ;
subj = cl.subj ;
v = cl.v ;
inf = cl.inf ;
adj = cl.adj ;
obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field?
obj2 = cl.obj2 ; ---- slash to this part? maybe with one more value of focType?
adV = cl.adV ;
adv = cl.adv ;
ext = cl.ext ;
c3 = noComplCase ;
} ;
UseCl cl = {s = declCl cl} ;
UseQCl cl = {s = questCl cl} ;
UttS s = s ;
AdvCl a x cl = {
subj = cl.subj ;
v = cl.v ;
inf = cl.inf ;
adj = cl.adj ;
obj1 = cl.obj1 ;
obj2 = cl.obj2 ;
adV = cl.adV ;
adv = cl.adv ++ a.s ;
ext = cl.ext ;
c3 = cl.c3 ;
} ;
AdVCl a x cl = {
subj = cl.subj ;
v = cl.v ;
inf = cl.inf ;
adj = cl.adj ;
obj1 = cl.obj1 ;
obj2 = cl.obj2 ;
adV = cl.adV ++ a.s ;
adv = cl.adv ;
ext = cl.ext ;
c3 = cl.c3 ;
} ;
{-
AdvVP adv x vp = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = vp.obj2 ;
adV = vp.adV ;
adv = vp.adv ++ adv.s ; ---- all adverbs become one field - how to front one of them?
ext = vp.ext ;
} ;
AdVVP adv _ vp = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = vp.obj2 ;
adV = vp.adV ++ adv.s ; ---- all adV's become one field - how to front one of them?
adv = vp.adv ;
ext = vp.ext ;
} ;
-}
PresPartAP x v = {
s = \\a => v.v ! PresPart ;
c1 = v.c1 ; -- tittande på henne
c2 = v.c2 ;
obj1 = noObj ;
} ;
PastPartAP x v = {
s = \\a => v.v ! PastPart a ;
c1 = v.c1 ;
c2 = v.c2 ;
obj1 = noObj ;
} ;
AgentPastPartAP x v np = {
s = \\a => v.v ! PastPart a ;
c1 = v.c1 ;
c2 = v.c2 ;
obj1 = \\_ => appComplCase agentCase np ; ---- addObj
} ;
StartVPC c x v w = { ---- some loss of quality seems inevitable
v = \\a =>
v.v.p1 ++ v.adV ++ v.v.p2 ++ v.v.p3 ++ v.adj ! a ++
v.c1 ++ v.obj1.p1 ! a ++ v.c2 ++ v.obj2.p1 ! a ++ v.adv ++ v.ext ---- appComplCase
++ c.s ++
w.v.p1 ++ w.adV ++ w.v.p2 ++ w.v.p3 ++ w.adj ! a ++ ---- appComplCase
w.c1 ++ w.obj1.p1 ! a ++ w.c2 ++ w.obj2.p1 ! a ++ w.adv ++ w.ext ;
inf = \\a =>
infVP a (lin VP v) ++ c.s ++ infVP a (lin VP w) ;
c1 = [] ; ---- w.c1 ? --- the full story is to unify v and w...
c2 = [] ; ---- w.c2 ?
} ;
UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable
v = <[], [], vpc.v ! defaultAgr> ; ---- agreement
inf = <[], vpc.inf ! defaultAgr> ; ---- agreement
c1 = vpc.c1 ;
c2 = vpc.c2 ;
adj = \\a => [] ;
obj1 = <noObj, defaultAgr> ;
obj2 = <noObj,True> ;
adv,adV = [] ;
ext = [] ;
} ;
StartClC c x a b = {
s = declCl (lin Cl a) ++ c.s ++ declCl (lin Cl b) ;
c3 = b.c3 ; ----
} ;
UseClC x cl = {
subj = [] ;
v = <[],[],cl.s> ; ----
inf = <[],[]> ;
adj = [] ;
obj1 = [] ;
obj2 = [] ;
adV = [] ;
adv = [] ;
ext = [] ;
c3 = cl.c3 ;
} ;
---- the lexicon is just for testing: use standard Swe lexicon and morphology instead
sleep_V = mkV "sova" "sover" "sov" "sovit" "soven" "sovna" ;
walk_V = mkV "gå" "går" "gick" "gått" "gången" "gångna" ;
love_V2 = mkV "älska" "älskar" "älskade" "älskat" "älskad" "älskade" ;
look_V2 = mkV "titta" "tittar" "tittade" "tittat" "tittad" "tittade" "på" [] ;
believe_VS = mkV "tro" "tror" "trodde" "trott" "trodd" "trodda" ;
tell_V2S = mkV "berätta" "berättar" "berättade" "berättat" "berättad" "berättade" "för" [] ;
prefer_V3 = mkV "föredra" "föredrar" "föredrog" "föredragit" "föredragen" "föredragna" [] "framför" ;
want_VV = mkV "vilja" "vill" "ville" "velat" "velad" "velade" ;
force_V2V = let tvinga : V = mkV "tvinga" "tvingar" "tvingade" "tvingat" "tvingad" "tvingade" in
{v = tvinga.v ; c1 = [] ; c2 = "att" ; isSubjectControl = False} ;
promise_V2V = mkV "lova" "lovar" "lovade" "lovat" "lovad" "lovade" [] "att" ;
wonder_VQ = mkV "undra" "undrar" "undrade" "undrat" "undrad" "undrade" ;
become_VA = mkV "bli" "blir" "blev" "blivit" "bliven" "blivna" ;
become_VN = mkV "bli" "blir" "blev" "blivit" "bliven" "blivna" ;
make_V2A = let gora : V = mkV "göra" "gör" "gjorde" "gjort" "gjord" "gjorda" in
{v = table {TV Pass VPres => "görs" ; f => gora.v ! f} ; c1 = [] ; c2 = [] ; isSubjectControl = False} ;
promote_V2N = let befordra : V = mkV "befordra" "befordrar" "befordrade" "befordrat" "befordrad" "befordrade"
in {v = befordra.v ; c1 = [] ; c2 = "till" ; isSubjectControl = False} ; ---- ? de befordrade dem till chefer för sig/dem
ask_V2Q = mkV "fråga" "frågar" "frågade" "frågat" "frågad" "frågade" ;
old_A = {s = table {Sg => "gammal" ; Pl => "gamla"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ;
married_A2 = {s = table {Sg => "gift" ; Pl => "gifta"} ; c1 = "med" ; c2 = [] ; obj1 = \\_ => []} ;
eager_AV = {s = table {Sg => "ivrig" ; Pl => "ivriga"} ; c1 = [] ; c2 = "att" ; obj1 = \\_ => []} ;
easy_A2V = {s = table {Sg => "lätt" ; Pl => "lätta"} ; c1 = "för" ; c2 = "att" ; obj1 = \\_ => []} ;
professor_N = {s = table {Sg => "professor" ; Pl => "professorer"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ;
manager_N2 = {s = table {Sg => "chef" ; Pl => "chefer"} ; c1 = "för" ; c2 = [] ; obj1 = \\_ => []} ;
she_NP = {s = table {Nom => "hon" ; Acc => "henne"} ; a = Sg} ;
we_NP = {s = table {Nom => "vi" ; Acc => "oss"} ; a = Pl} ;
today_Adv = {s = "idag"} ;
always_AdV = {s = "alltid"} ;
who_IP = {s = "vem" ; a = Sg} ;
PrepNP p np = {s = p.s ++ np.s ! Acc} ;
with_Prep = {s = "med"} ;
and_Conj = {s = "och"} ;
why_IAdv = {s = "varför"} ;
oper
mkV = overload {
mkV : (x,y,z,u,v,w : Str) -> V = \x,y,z,u,v,w ->
lin V {
v = table {
TV Act VInf => x ; TV Act VPres => y ; TV Act VPret => z ; TV Act VSup => u ;
TV Pass VInf => x + "s" ; TV Pass VPres => init y + "s" ; TV Pass VPret => z + "s" ; TV Pass VSup => u + "s" ;
PastPart Sg => v ; PastPart Pl => w ; PresPart => x + "nde"
} ;
c1 = [] ; c2 = [] ; isSubjectControl = True} ;
mkV : (x,y,z,u,v,w : Str) -> Str -> Str -> V = \x,y,z,u,v,w,p,q ->
lin V {
v = table {
TV Act VInf => x ; TV Act VPres => y ; TV Act VPret => z ; TV Act VSup => u ;
TV Pass VInf => x + "s" ; TV Pass VPres => init y + "s" ; TV Pass VPret => z + "s" ; TV Pass VSup => u + "s" ;
PastPart Sg => v ; PastPart Pl => w ; PresPart => x + "nde"
} ;
c1 = p ; c2 = q ; isSubjectControl = True} ;
} ;
be_V : V = mkV "vara" "är" "var" "varit" "varen" "varna" ;
have_V : V = mkV "ha" "har" "hade" "haft" "havd" "havda" ;
shall_V : V = mkV "skola" "ska" "skulle" "skolat" "skolad" "skolade" ;
---- the following may become parameters for a functor
neg : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "inte"} ;
reflPron : Agr -> Str = \a -> case a of {Sg => "sig" ; Pl => "oss"} ;
infVP : Agr -> VP -> Str = \a,vp ->
let
a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2}
in
vp.adV ++ (vp.inf.p1 | []) ++ vp.inf.p2 ++ ---- *hon tvingar oss att sovit
vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ;
tenseV : Str -> STense -> Anteriority -> Voice -> V -> Str * Str * Str = \sta,t,a,o,v -> case <t,a> of { --- sta dummy s field of Ant and Tense
<Pres,Simul> => <sta ++ v.v ! TV o VPres, [], []> ;
<Past,Simul> => <sta ++ v.v ! TV o VPret, [], []> ;
<Fut, Simul> => <shall_V.v ! TV Act VPres, [], sta ++ v.v ! TV o VInf> ;
<Cond,Simul> => <shall_V.v ! TV Act VPret, [], sta ++ v.v ! TV o VInf> ;
<Pres,Anter> => <[], have_V.v ! TV Act VPres, sta ++ v.v ! TV o VSup> ;
<Past,Anter> => <[], have_V.v ! TV Act VPret, sta ++ v.v ! TV o VSup> ;
<Fut, Anter> => <shall_V.v ! TV Act VPres, have_V.v ! TV Act VInf, sta ++ v.v ! TV o VSup> ;
<Cond,Anter> => <shall_V.v ! TV Act VPret, have_V.v ! TV Act VInf, sta ++ v.v ! TV o VSup>
} ;
tenseInfV : Str -> Anteriority -> Voice -> V -> Str * Str = \sa,a,o,v ->
case a of {
Simul => <[], sa ++ v.v ! TV o VInf> ; -- hon vill sova
Anter => <have_V.v ! TV Act VInf, sa ++ v.v ! TV o VSup> -- hon vill (ha) sovit
} ;
declCl : Clause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
declSubordCl : Clause -> Str = \cl -> cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl ;
declInvCl : Clause -> Str = \cl -> cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
questCl : QCl -> Str = \cl -> cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
questSubordCl : QCl -> Str = \cl ->
let
rest = cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl
in case cl.focType of {
NoFoc => "om" ++ cl.foc ++ rest ; -- om hon sover
FocObj => cl.foc ++ rest ; -- vem älskar hon / varför hon sover
FocSubj => cl.foc ++ "som" ++ rest -- vem som älskar henne
} ;
that_Compl : Str = "att" | [] ;
-- this part is usually the same in all reconfigurations
restCl : Clause -> Str = \cl -> cl.v.p3 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ++ cl.c3 ;
agentCase : ComplCase = "av" ;
appComplCase : ComplCase -> NP -> Str = \p,np -> p ++ np.s ! Acc ;
noComplCase : ComplCase = [] ;
prepComplCase : Prep -> ComplCase = \p -> p.s ;
noObj : Agr => Str = \\_ => [] ;
}

492
src/experimental/alternatives/PredicationSwe.gf
View File

@@ -1,492 +0,0 @@
concrete PredicationSwe of Predication = open Prelude in {
-- Swedish predication: simpler and purer than English.
-- two principles:
-- - keep records discontinuous as long as possible (last step from Cl to S)
-- - select from tables as soon as possible (first step from V to VP)
-- a question: would it make sense to make this into a functor?
param
Agr = Sg | Pl ;
Case = Nom | Acc ;
STense = Pres | Past | Perf | Fut ;
Anteriority = Simul | Anter ;
Polarity = Pos | Neg ;
VTense = VInf | VPres | VPret | VSup ;
VForm = TV Voice VTense | PastPart Agr | PresPart ;
Voice = Act | Pass ;
FocusType = NoFoc | FocSubj | FocObj ; -- sover hon/om hon sover, vem älskar hon/vem hon älskar, vem sover/vem som sover
oper
defaultAgr = Sg ;
ComplCase = Str ; -- preposition
objCase = Acc ;
lincat
Arg = {s : Str} ;
V = {
v : VForm => Str ;
c1 : ComplCase ;
c2 : ComplCase ;
isSubjectControl : Bool ;
} ;
VP = {
v : Str * Str * Str ; -- ska,ha,sovit
inf : Str * Str ; -- ha,sovit
c1 : ComplCase ;
c2 : ComplCase ;
adj : Agr => Str ;
obj1 : (Agr => Str) * Agr ;
obj2 : (Agr => Str) * Bool ; -- subject control = True
adv : Str ;
adV : Str ;
ext : Str
} ;
oper Clause = {
v : Str * Str * Str ;
inf : Str * Str ;
adj,obj1,obj2 : Str ;
adv : Str ;
adV : Str ;
ext : Str ;
subj : Str ;
c3 : ComplCase -- for a slashed adjunct, not belonging to the verb valency
} ;
lincat
Cl = Clause ;
QCl = Clause ** {
foc : Str ; -- the focal position at the beginning, e.g. *vem* älskar hon
focType : FocusType ; --- if already filled, then use other place: vem älskar *vem*
} ;
VPC = {
v : Agr => Str ;
inf : Agr => Str ;
c1 : ComplCase ;
c2 : ComplCase
} ;
ClC = {
s : Str ;
c3 : ComplCase ;
} ;
Tense = {s : Str ; t : STense} ;
Ant = {s : Str ; a : Anteriority} ;
Pol = {s : Str ; p : Polarity} ;
NP = {s : Case => Str ; a : Agr} ;
Adv = {s : Str ; isAdV : Bool ; c1 : ComplCase} ;
S = {s : Str} ;
Utt = {s : Str} ;
AP = {
s : Agr => Str ;
c1, c2 : ComplCase ;
obj1 :
Agr => Str
} ;
CN = {
s : Agr => Str ;
c1, c2 : ComplCase ;
obj1 :
Agr => Str
} ;
IP = {s : Str ; a : Agr} ;
Conj = {s : Str} ;
IAdv = {s : Str} ;
lin
aNone, aS, aV, aA, aQ, aN = {s = []} ;
aNP a = a ;
TPres = {s = [] ; t = Pres} ;
TPast = {s = [] ; t = Past} ;
TFut = {s = [] ; t = Fut} ;
TCond = {s = [] ; t = Perf} ;
ASimul = {s = [] ; a = Simul} ;
AAnter = {s = [] ; a = Anter} ;
PPos = {s = [] ; p = Pos} ;
PNeg = {s = [] ; p = Neg} ;
UseV a t p _ v = {
v = tenseV (a.s ++ t.s) t.t a.a Act v ;
inf = tenseInfV a.s a.a Act v ;
c1 = v.c1 ;
c2 = v.c2 ;
adj = noObj ;
obj1 = <noObj, defaultAgr> ; ---- not used, just default value
obj2 = <noObj, v.isSubjectControl> ;
adV = p.s ++ neg p.p ;
adv = [] ;
ext = [] ;
} ;
PassUseV a t p _ v = {
v = tenseV (a.s ++ t.s) t.t a.a Pass v ;
inf = tenseInfV a.s a.a Pass v ;
c1 = v.c1 ;
c2 = v.c2 ;
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"
adV = p.s ++ neg p.p ;
adv = [] ;
ext = [] ;
} ;
AgentPassUseV a t p _ v np = {
v = tenseV (a.s ++ t.s) t.t a.a Pass v ;
inf = tenseInfV a.s a.a Pass v ;
c1 = v.c1 ;
c2 = v.c2 ;
adj = \\a => [] ;
obj1 = <noObj, defaultAgr> ;
obj2 = <noObj, True> ;
adV = p.s ++ neg p.p ;
adv = appComplCase agentCase np ; ---- add a specific field for agent?
ext = [] ;
} ;
UseAP a t p _ ap = {
v = tenseV (a.s ++ t.s) t.t a.a Act be_V ;
inf = tenseInfV a.s a.a Act be_V ;
c1 = ap.c1 ;
c2 = ap.c2 ;
adj = \\a => ap.s ! a ;
obj1 = <ap.obj1, defaultAgr> ;
obj2 = <noObj, True> ; --- there are no A3's
adV = p.s ++ neg p.p ;
adv = [] ;
ext = [] ;
} ;
SlashV2 x vp np = vp ** {
obj1 : (Agr => Str) * Agr = <\\a => np.s ! Acc, np.a> -- np.a for object control ---- Acc to be abstracted
} ;
SlashV3 x vp np = addObj2VP vp (\\a => np.s ! Acc) ; -- control is preserved ---- Acc to be abstracted
ComplVS x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form
ComplVQ x vp qcl = addExtVP vp (questSubordCl qcl) ; ---- question form
ComplVV x vp vpo = addObj2VP vp (\\a => infVP a vpo) ; ---- infForm
ComplVA x vp ap = addObj2VP vp (\\a => ap.s ! a ++ ap.obj1 ! a) ; ---- adjForm
ComplVN x vp cn = addObj2VP vp (\\a => cn.s ! a ++ cn.obj1 ! a) ; ---- cnForm
SlashV2S x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form
SlashV2Q x vp cl = addExtVP vp (questSubordCl (lin QCl cl)) ; ---- question form
SlashV2V x vp vpo = addObj2VP vp (\\a => infVP a (lin VP vpo)) ; ---- infForm
SlashV2A x vp ap = addObj2VP vp (\\a => ap.s ! a ++ ap.obj1 ! a) ; ---- adjForm
SlashV2N x vp cn = addObj2VP vp (\\a => cn.s ! a ++ cn.obj1 ! a) ; ---- cn form
ReflVP x vp = vp ** {
obj1 : (Agr => Str) * Agr = <\\a => reflPron a, defaultAgr> ; --- hack: defaultAgr will not be used but subj.a instead
} ;
ReflVP2 x vp = vp ** {
obj2 : (Agr => Str) * Bool = <\\a => reflPron a, vp.obj2.p2> ; --- subj/obj control doesn't matter any more
} ;
PredVP x np vp = vp ** {
subj = np.s ! Nom ;
adj = vp.adj ! np.a ;
obj1 = vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase
obj2 = 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
} ;
SlashClNP x cl np = cl ** { -- Cl ::= Cl/NP NP
adv = cl.adv ++ appComplCase cl.c3 np ; ---- again, adv just added
c3 = noComplCase ; -- complCase has been consumed
} ;
-- QCl ::= Cl by just adding focus field
QuestCl x cl = cl ** {foc = [] ; focType = NoFoc} ; -- NoFoc implies verb first: älskar hon oss
QuestIAdv x iadv cl = cl ** {foc = iadv.s ; focType = FocObj} ; -- FocObj implies Foc + V + Subj: varför älskar hon oss
QuestVP x ip vp = vp ** {
foc = ip.s ; -- vem älskar henne
focType = FocSubj ;
subj = [] ;
adj = vp.adj ! ip.a ;
obj1 = vp.c1 ++ vp.obj1.p1 ! ip.a ; ---- appComplCase
obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => ip.a ; False => vp.obj1.p2}) ; ---- appComplCase
c3 = noComplCase ; -- for one more prep to build ClSlash ---- ever needed for QCl?
} ;
QuestSlash x ip cl =
let
prep = cl.c3 ;
ips = ip.s ; -- in Cl/NP, c3 is the only prep ---- appComplCase for ip
focobj = case cl.focType of {
NoFoc => <ips, [], FocObj,prep> ; -- 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
} ;
in
cl ** { -- preposition stranding
foc = focobj.p1 ;
focType = focobj.p3 ;
obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field?
c3 = focobj.p4 ;
} ;
{-
---- this is giving four records instead of two AR 5/2/2014
|
cl ** { -- pied piping
foc = focobj.p4 ++ focobj.p1 ;
focType = focobj.p3 ;
obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field?
c3 = noComplCase ;
} ;
-}
UseCl cl = {s = declCl cl} ;
UseQCl cl = {s = questCl cl} ;
UseAdvCl adv cl = {s = adv.s ++ declInvCl cl} ;
UttS s = s ;
AdvCl x a cl = case a.isAdV of {
True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ;
False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1}
} ;
AdvQCl x a cl = case a.isAdV of {
True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ;
False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1}
} ;
PresPartAP x v = {
s = \\a => v.v ! PresPart ;
c1 = v.c1 ; -- tittande på henne
c2 = v.c2 ;
obj1 = noObj ;
} ;
PastPartAP x v = {
s = \\a => v.v ! PastPart a ;
c1 = v.c1 ;
c2 = v.c2 ;
obj1 = noObj ;
} ;
AgentPastPartAP x v np = {
s = \\a => v.v ! PastPart a ;
c1 = v.c1 ;
c2 = v.c2 ;
obj1 = \\_ => appComplCase agentCase np ; ---- addObj
} ;
StartVPC c x v w = { ---- some loss of quality seems inevitable
v = \\a =>
v.v.p1 ++ v.adV ++ v.v.p2 ++ v.v.p3 ++ v.adj ! a ++
v.c1 ++ v.obj1.p1 ! a ++ v.c2 ++ v.obj2.p1 ! a ++ v.adv ++ v.ext ---- appComplCase
++ c.s ++
w.v.p1 ++ w.adV ++ w.v.p2 ++ w.v.p3 ++ w.adj ! a ++ ---- appComplCase
w.c1 ++ w.obj1.p1 ! a ++ w.c2 ++ w.obj2.p1 ! a ++ w.adv ++ w.ext ;
inf = \\a =>
infVP a (lin VP v) ++ c.s ++ infVP a (lin VP w) ;
c1 = [] ; ---- w.c1 ? --- the full story is to unify v and w...
c2 = [] ; ---- w.c2 ?
} ;
UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable
v = <[], [], vpc.v ! defaultAgr> ; ---- agreement
inf = <[], vpc.inf ! defaultAgr> ; ---- agreement
c1 = vpc.c1 ;
c2 = vpc.c2 ;
adj = \\a => [] ;
obj1 = <noObj, defaultAgr> ;
obj2 = <noObj,True> ;
adv,adV = [] ;
ext = [] ;
} ;
StartClC c x a b = {
s = declCl (lin Cl a) ++ c.s ++ declCl (lin Cl b) ;
c3 = b.c3 ; ----
} ;
UseClC x cl = {
subj = [] ;
v = <[],[],cl.s> ; ----
inf = <[],[]> ;
adj = [] ;
obj1 = [] ;
obj2 = [] ;
adV = [] ;
adv = [] ;
ext = [] ;
c3 = cl.c3 ;
} ;
ComplAdv x p np = {s = p.c1 ++ np.s ! objCase ; isAdV = p.isAdV ; c1 = []} ;
---- the following may become parameters for a functor
oper
be_V : V = mkV "vara" "är" "var" "varit" "varen" "varna" ;
neg : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "inte"} ;
reflPron : Agr -> Str = \a -> case a of {Sg => "sig" ; Pl => "oss"} ;
infVP : Agr -> VP -> Str = \a,vp ->
let
a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2}
in
vp.adV ++ (vp.inf.p1 | []) ++ vp.inf.p2 ++ ---- *hon tvingar oss att sovit
vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ;
tenseV : Str -> STense -> Anteriority -> Voice -> V -> Str * Str * Str = \sta,t,a,o,v -> case <t,a> of { --- sta dummy s field of Ant and Tense
<Pres,Simul> => <sta ++ v.v ! TV o VPres, [], []> ;
<Past,Simul> => <sta ++ v.v ! TV o VPret, [], []> ;
<Fut, Simul> => <shall_V.v ! TV Act VPres, [], sta ++ v.v ! TV o VInf> ;
<Cond,Simul> => <shall_V.v ! TV Act VPret, [], sta ++ v.v ! TV o VInf> ;
<Pres,Anter> => <have_V.v ! TV Act VPres, [], sta ++ v.v ! TV o VSup> ;
<Past,Anter> => <have_V.v ! TV Act VPret, [], sta ++ v.v ! TV o VSup> ;
<Fut, Anter> => <shall_V.v ! TV Act VPres, have_V.v ! TV Act VInf, sta ++ v.v ! TV o VSup> ;
<Cond,Anter> => <shall_V.v ! TV Act VPret, have_V.v ! TV Act VInf, sta ++ v.v ! TV o VSup>
} ;
tenseInfV : Str -> Anteriority -> Voice -> V -> Str * Str = \sa,a,o,v ->
case a of {
Simul => <[], sa ++ v.v ! TV o VInf> ; -- hon vill sova
Anter => <have_V.v ! TV Act VInf, sa ++ v.v ! TV o VSup> -- hon vill (ha) sovit
} ;
declCl : Clause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
declSubordCl : Clause -> Str = \cl -> cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl ;
declInvCl : Clause -> Str = \cl -> cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
questCl : QCl -> Str = \cl -> cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
questSubordCl : QCl -> Str = \cl ->
let
rest = cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl
in case cl.focType of {
NoFoc => "om" ++ cl.foc ++ rest ; -- om hon sover
FocObj => cl.foc ++ rest ; -- vem älskar hon / varför hon sover
FocSubj => cl.foc ++ "som" ++ rest -- vem som älskar henne
} ;
that_Compl : Str = "att" | [] ;
-- this part is usually the same in all reconfigurations
restCl : Clause -> Str = \cl -> cl.v.p3 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ++ cl.c3 ;
agentCase : ComplCase = "av" ;
appComplCase : ComplCase -> NP -> Str = \p,np -> p ++ np.s ! Acc ;
noComplCase : ComplCase = [] ;
prepComplCase : {s : Str} -> ComplCase = \p -> p.s ;
noObj : Agr => Str = \\_ => [] ;
addObj2VP : VP -> (Agr => Str) -> VP = \vp,obj -> vp ** {
obj2 = <\\a => vp.obj2.p1 ! a ++ obj ! a, vp.obj2.p2> ;
} ;
addExtVP : VP -> Str -> VP = \vp,ext -> vp ** {
ext = ext ;
} ;
---- the lexicon is just for testing: use standard Swe lexicon and morphology instead
lin
sleep_V = mkV "sova" "sover" "sov" "sovit" "soven" "sovna" ;
walk_V = mkV "gå" "går" "gick" "gått" "gången" "gångna" ;
love_V2 = mkV "älska" "älskar" "älskade" "älskat" "älskad" "älskade" ;
look_V2 = mkV "titta" "tittar" "tittade" "tittat" "tittad" "tittade" "på" [] ;
believe_VS = mkV "tro" "tror" "trodde" "trott" "trodd" "trodda" ;
tell_V2S = mkV "berätta" "berättar" "berättade" "berättat" "berättad" "berättade" "för" [] ;
prefer_V3 = mkV "föredra" "föredrar" "föredrog" "föredragit" "föredragen" "föredragna" [] "framför" ;
want_VV = mkV "vilja" "vill" "ville" "velat" "velad" "velade" ;
force_V2V = let tvinga : V = mkV "tvinga" "tvingar" "tvingade" "tvingat" "tvingad" "tvingade" in
{v = tvinga.v ; c1 = [] ; c2 = "att" ; isSubjectControl = False} ;
promise_V2V = mkV "lova" "lovar" "lovade" "lovat" "lovad" "lovade" [] "att" ;
wonder_VQ = mkV "undra" "undrar" "undrade" "undrat" "undrad" "undrade" ;
become_VA = mkV "bli" "blir" "blev" "blivit" "bliven" "blivna" ;
become_VN = mkV "bli" "blir" "blev" "blivit" "bliven" "blivna" ;
make_V2A = let gora : V = mkV "göra" "gör" "gjorde" "gjort" "gjord" "gjorda" in
{v = table {TV Pass VPres => "görs" ; f => gora.v ! f} ; c1 = [] ; c2 = [] ; isSubjectControl = False} ;
promote_V2N = let befordra : V = mkV "befordra" "befordrar" "befordrade" "befordrat" "befordrad" "befordrade"
in {v = befordra.v ; c1 = [] ; c2 = "till" ; isSubjectControl = False} ; ---- ? de befordrade dem till chefer för sig/dem
ask_V2Q = mkV "fråga" "frågar" "frågade" "frågat" "frågad" "frågade" ;
old_A = {s = table {Sg => "gammal" ; Pl => "gamla"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ;
married_A2 = {s = table {Sg => "gift" ; Pl => "gifta"} ; c1 = "med" ; c2 = [] ; obj1 = \\_ => []} ;
eager_AV = {s = table {Sg => "ivrig" ; Pl => "ivriga"} ; c1 = [] ; c2 = "att" ; obj1 = \\_ => []} ;
easy_A2V = {s = table {Sg => "lätt" ; Pl => "lätta"} ; c1 = "för" ; c2 = "att" ; obj1 = \\_ => []} ;
professor_N = {s = table {Sg => "professor" ; Pl => "professorer"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ;
manager_N2 = {s = table {Sg => "chef" ; Pl => "chefer"} ; c1 = "för" ; c2 = [] ; obj1 = \\_ => []} ;
she_NP = {s = table {Nom => "hon" ; Acc => "henne"} ; a = Sg} ;
we_NP = {s = table {Nom => "vi" ; Acc => "oss"} ; a = Pl} ;
today_Adv = {s = "idag" ; isAdV = False ; c1 = []} ;
always_AdV = {s = "alltid" ; isAdV = True ; c1 = []} ;
who_IP = {s = "vem" ; a = Sg} ;
PrepNP p np = {s = p.s ++ np.s ! Acc ; isAdV = False} ;
with_Prep = {s = [] ; isAdV = False ; c1 = "med"} ;
and_Conj = {s = "och"} ;
why_IAdv = {s = "varför"} ;
oper
mkV = overload {
mkV : (x,y,z,u,v,w : Str) -> V = \x,y,z,u,v,w ->
lin V {
v = table {
TV Act VInf => x ; TV Act VPres => y ; TV Act VPret => z ; TV Act VSup => u ;
TV Pass VInf => x + "s" ; TV Pass VPres => init y + "s" ; TV Pass VPret => z + "s" ; TV Pass VSup => u + "s" ;
PastPart Sg => v ; PastPart Pl => w ; PresPart => x + "nde"
} ;
c1 = [] ; c2 = [] ; isSubjectControl = True} ;
mkV : (x,y,z,u,v,w : Str) -> Str -> Str -> V = \x,y,z,u,v,w,p,q ->
lin V {
v = table {
TV Act VInf => x ; TV Act VPres => y ; TV Act VPret => z ; TV Act VSup => u ;
TV Pass VInf => x + "s" ; TV Pass VPres => init y + "s" ; TV Pass VPret => z + "s" ; TV Pass VSup => u + "s" ;
PastPart Sg => v ; PastPart Pl => w ; PresPart => x + "nde"
} ;
c1 = p ; c2 = q ; isSubjectControl = True} ;
} ;
have_V : V = mkV "ha" "har" "hade" "haft" "havd" "havda" ;
shall_V : V = mkV "skola" "ska" "skulle" "skolat" "skolad" "skolade" ;
}

38
src/experimental/alternatives/Trans.gf
View File

@@ -1,38 +0,0 @@
--# -path=.:../translator
abstract Trans =
RGLBase - [Pol,Tense]
,Pred
,Dictionary - [Pol,Tense]
** {
flags
startcat=Phr;
heuristic_search_factor=0.60;
meta_prob=1.0e-5;
meta_token_prob=1.1965149246222233e-9;
fun
LiftV : V -> PrV aNone ;
LiftV2 : V2 -> PrV (aNP aNone) ;
LiftVS : VS -> PrV aS ;
LiftVQ : VQ -> PrV aQ ;
LiftVV : VV -> PrV aV ;
LiftVA : VA -> PrV aA ;
LiftVN : VA -> PrV aN ; ----
LiftV3 : V3 -> PrV (aNP (aNP aNone)) ;
LiftV2S : V2S -> PrV (aNP aS) ;
LiftV2Q : V2Q -> PrV (aNP aQ) ;
LiftV2V : V2V -> PrV (aNP aV) ;
LiftV2A : V2A -> PrV (aNP aA) ;
LiftV2N : V2A -> PrV (aNP aN) ; ----
LiftAP : AP -> PrAP aNone ;
LiftCN : CN -> PrCN aNone ;
LiftAdv : Adv -> PrAdv aNone ;
LiftAdV : Adv -> PrAdv aNone ;
LiftPrep : Prep -> PrAdv (aNP aNone) ;
}

41
src/experimental/alternatives/TransEng.gf
View File

@@ -1,41 +0,0 @@
--# -path=.:../translator
concrete TransEng of Trans =
RGLBaseEng - [Pol,Tense]
,PredEng
,DictionaryEng - [Pol,Tense]
** open ResEng, PredInstanceEng, Prelude, (Pr = PredEng) in {
flags
literal=Symb ;
oper
liftV : ResEng.Verb -> Pr.PrV = \v -> lin PrV {s = v.s ; p = v.p ; c1,c2 = [] ; isSubjectControl = False ; vtype = VTAct ; vvtype = VVInf} ;
lin
LiftV v = liftV v ;
LiftV2 v = liftV v ** {c1 = v.c2} ;
LiftVS v = liftV v ;
LiftVQ v = liftV v ;
LiftVA v = liftV v ; ---- c1?
LiftVN v = liftV v ; ---- c1?
LiftVV v = {s = \\f => v.s ! VVF f ; p = v.p ; c1,c2 = [] ; isSubjectControl = False ; vtype = VTAct ; vvtype = VVInf} ; ---- c1? ---- VVF
LiftV3 v = liftV 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 ; c2 = v.c3 ; isSubjectControl = False ; vvtype = v.typ} ; ---- subj control should be defined in V2V
LiftV2A v = liftV v ** {c1 = v.c2} ;
LiftV2N v = liftV v ** {c1 = v.c2} ;
LiftAP ap = ap ** {c1,c2 = [] ; obj1 = \\_ => []} ; --- isPre
LiftCN cn = {s = \\n => cn.s ! n ! Nom ; c1,c2 = [] ; obj1 = \\_ => []} ;
LiftAdv a = a ** {isAdV = False ; c1 = []} ;
LiftAdV a = a ** {isAdV = True ; c1 = []} ;
LiftPrep p = {s = [] ; isAdV = False ; c1 = p.s} ;
}

41
src/experimental/alternatives/TransSwe.gf
View File

@@ -1,41 +0,0 @@
--# -path=.:../translator
concrete TransSwe of Trans =
RGLBaseSwe - [Pol,Tense]
,PredSwe
,DictionarySwe - [Pol,Tense]
** open CommonScand, ResSwe, PredInstanceSwe, Prelude in {
flags
literal=Symb ;
oper
liftV = PredInstanceSwe.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} ;
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} ;
LiftAP ap = {s = \\a => ap.s ! agr2aformpos a ; c1,c2 = [] ; obj1 = \\_ => []} ; --- isPre
LiftCN cn = {s = \\n => cn.s ! n ! DIndef ! Nom ; c1,c2 = [] ; obj1 = \\_ => []} ;
LiftAdv a = a ** {isAdV = False ; c1 = []} ;
LiftAdV a = a ** {isAdV = True ; c1 = []} ;
LiftPrep p = {s = [] ; isAdV = False ; c1 = p.s} ;
}

80
src/experimental/exx.gfs
View File

@@ -1,80 +0,0 @@
hon sover
hon sover inte
sover hon
sover hon inte
hon sover idag
hon har sovit
hon hade sovit
hon hade inte sovit
hon älskar oss
hon älskar sig
älskar hon oss
hon tittar på oss
hon tittar inte på sig
hon föredrar oss framför henne
hon vill sova
hon vill inte sova
vill hon sova
hon tvingar oss att sova
hon tvingar oss att älska henne
vi lovar henne att bli gamla
vi tvingar henne att bli gammal
hon är gammal
är hon gammal
hon gör oss gamla
vem sover
vem älskar henne
vem älskar hon inte
varför vill hon sova
sover hon
vill hon inte sova
vi undrar varför hon vill sova
vi undrar vem hon älskar
vi undrar vem som älskar henne
vi undrar vem som sover
vi undrar varför hon inte vill sova
vi undrar vem hon inte älskar
vi undrar om hon sover
vi undrar om hon inte alltid sover
vi tror att hon inte vill sova
vi tror hon inte vill sova
vi tror att hon har sovit
vi tror att hon hade sovit
vi tror att hon sovit
vi undrar om hon sovit
vi tror att hon skulle sovit
hon vill ha sovit
hon vill sovit
hon blev professor
vi blev professorer
vi befordrade henne till professor
hon befordrade oss till professorer
vi vill bli professorer
-- passive
hon älskas med oss
hon skulle befordras till professor
hon skulle ha befordrats till professor
vem ska befordras till professor
hon tittas på
vi älskas av henne
hon skulle befordras till professor av oss
gt UttS (UseCl (PredVP aNone ? (UseAP ? ? ? aNone old_A))) | l -list -bind
gt UttS (UseCl (PredVP aNone ? (UseV ? ? ? aNone sleep_V))) | l -list -bind

334
src/experimental/transfer/Both.gf
View File

@@ -1,334 +0,0 @@
--# -path=..:../../translator
abstract Both =
Old,
New - [AAnter,ASimul,PPos,PNeg,TPres,TPast,TFut,TCond,AdAdV,ApposNP,CompoundCN,UttAdV]
;
{-
Both> pg -cats
A A2 AP AdA AdN AdV Adv Ant CAdv CN Card Cl ClC_none ClC_np ClSlash Comp Conj Det Digits Float IAdv IComp IDet IP IQuant Imp Int Interj ListAP ListAdV ListAdv ListCN ListIAdv ListNP ListRS ListS ListVPI ListVPS N N2 N3 NP Num Numeral Ord PConj PN Phr Pol PrAP_none PrAP_np PrAdv_none PrAdv_np PrCN_none PrCN_np PrCl_none PrCl_np PrQCl_none PrQCl_np PrS PrVPI_none PrVPI_np PrVP_a PrVP_n PrVP_none PrVP_np PrVP_np_a PrVP_np_n PrVP_np_np PrVP_np_q PrVP_np_s PrVP_np_v PrVP_q PrVP_s PrVP_v PrV_a PrV_n PrV_none PrV_np PrV_np_a PrV_np_n PrV_np_np PrV_np_q PrV_np_s PrV_np_v PrV_q PrV_s PrV_v Predet Prep Pron QCl QS QVP Quant RCl RP RS S SC SSlash String Subj Symb Temp Tense Text Utt V V2 V2A V2Q V2S V2V V3 VA VP VPC_none VPC_np VPI VPS VPSlash VQ VS VV Voc
0 msec
Both> pg -funs
AAnter : Ant ;
ASimul : Ant ;
AdAP : AdA -> AP -> AP ;
AdAdV : AdA -> AdV -> AdV ;
AdAdv : AdA -> Adv -> Adv ;
AdNum : AdN -> Card -> Card ;
AdVVP : AdV -> VP -> VP ;
AdVVPSlash : AdV -> VPSlash -> VPSlash ;
AddAdvQVP : QVP -> IAdv -> QVP ;
AdjCN : AP -> CN -> CN ;
AdjOrd : Ord -> AP ;
AdnCAdv : CAdv -> AdN ;
AdvAP : AP -> Adv -> AP ;
AdvCN : CN -> Adv -> CN ;
AdvCl_none : PrAdv_none -> PrCl_none -> PrCl_none ;
AdvCl_np : PrAdv_np -> PrCl_none -> PrCl_np ;
AdvIAdv : IAdv -> Adv -> IAdv ;
AdvIP : IP -> Adv -> IP ;
AdvNP : NP -> Adv -> NP ;
AdvQCl_none : PrAdv_none -> PrQCl_none -> PrQCl_none ;
AdvQCl_np : PrAdv_np -> PrQCl_none -> PrQCl_np ;
AdvQVP : VP -> IAdv -> QVP ;
AdvS : Adv -> S -> S ;
AdvSlash : ClSlash -> Adv -> ClSlash ;
AdvVP : VP -> Adv -> VP ;
AdvVPSlash : VPSlash -> Adv -> VPSlash ;
AgentPassUseV_a : Ant -> Tense -> Pol -> PrV_np_a -> NP -> PrVP_a ;
AgentPassUseV_n : Ant -> Tense -> Pol -> PrV_np_n -> NP -> PrVP_n ;
AgentPassUseV_none : Ant -> Tense -> Pol -> PrV_np -> NP -> PrVP_none ;
AgentPassUseV_np : Ant -> Tense -> Pol -> PrV_np_np -> NP -> PrVP_np ;
AgentPassUseV_q : Ant -> Tense -> Pol -> PrV_np_q -> NP -> PrVP_q ;
AgentPassUseV_s : Ant -> Tense -> Pol -> PrV_np_s -> NP -> PrVP_s ;
AgentPassUseV_v : Ant -> Tense -> Pol -> PrV_np_v -> NP -> PrVP_v ;
AgentPastPartAP_none : PrV_np -> NP -> PrAP_none ;
ApposCN : CN -> NP -> CN ;
ApposNP : NP -> NP -> NP ;
BaseAP : AP -> AP -> ListAP ;
BaseAdV : AdV -> AdV -> ListAdV ;
BaseAdv : Adv -> Adv -> ListAdv ;
BaseCN : CN -> CN -> ListCN ;
BaseIAdv : IAdv -> IAdv -> ListIAdv ;
BaseNP : NP -> NP -> ListNP ;
BaseRS : RS -> RS -> ListRS ;
BaseS : S -> S -> ListS ;
BaseVPI : VPI -> VPI -> ListVPI ;
BaseVPS : VPS -> VPS -> ListVPS ;
CAdvAP : CAdv -> AP -> NP -> AP ;
CNNumNP : CN -> Card -> NP ;
CompAP : AP -> Comp ;
CompAdv : Adv -> Comp ;
CompCN : CN -> Comp ;
CompIAdv : IAdv -> IComp ;
CompIP : IP -> IComp ;
CompNP : NP -> Comp ;
CompQS : QS -> Comp ;
CompS : S -> Comp ;
CompVP : Ant -> Pol -> VP -> Comp ;
ComparA : A -> NP -> AP ;
ComparAdvAdj : CAdv -> A -> NP -> Adv ;
ComparAdvAdjS : CAdv -> A -> S -> Adv ;
ComplA2 : A2 -> NP -> AP ;
ComplAdv_none : PrAdv_np -> NP -> PrAdv_none ;
ComplN2 : N2 -> NP -> CN ;
ComplN3 : N3 -> NP -> N2 ;
ComplSlash : VPSlash -> NP -> VP ;
ComplSlashIP : VPSlash -> IP -> QVP ;
ComplV2_none : PrVP_np -> NP -> PrVP_none ;
ComplVA : VA -> AP -> VP ;
ComplVA_none : PrVP_a -> PrAP_none -> PrVP_none ;
ComplVN_none : PrVP_n -> PrCN_none -> PrVP_none ;
ComplVPIVV : VV -> VPI -> VP ;
ComplVQ : VQ -> QS -> VP ;
ComplVQ_none : PrVP_q -> PrQCl_none -> PrVP_none ;
ComplVS : VS -> S -> VP ;
ComplVS_none : PrVP_s -> PrCl_none -> PrVP_none ;
ComplVS_np : PrVP_s -> PrCl_np -> PrVP_np ;
ComplVV : VV -> Ant -> Pol -> VP -> VP ;
ComplVV_none : PrVP_v -> PrVPI_none -> PrVP_none ;
ComplVV_np : PrVP_v -> PrVPI_np -> PrVP_np ;
CompoundCN : N -> CN -> CN ;
ConjAP : Conj -> ListAP -> AP ;
ConjAdV : Conj -> ListAdV -> AdV ;
ConjAdv : Conj -> ListAdv -> Adv ;
ConjCN : Conj -> ListCN -> CN ;
ConjIAdv : Conj -> ListIAdv -> IAdv ;
ConjNP : Conj -> ListNP -> NP ;
ConjRS : Conj -> ListRS -> RS ;
ConjS : Conj -> ListS -> S ;
ConjVPI : Conj -> ListVPI -> VPI ;
ConjVPS : Conj -> ListVPS -> VPS ;
ConsAP : AP -> ListAP -> ListAP ;
ConsAdV : AdV -> ListAdV -> ListAdV ;
ConsAdv : Adv -> ListAdv -> ListAdv ;
ConsCN : CN -> ListCN -> ListCN ;
ConsIAdv : IAdv -> ListIAdv -> ListIAdv ;
ConsNP : NP -> ListNP -> ListNP ;
ConsRS : RS -> ListRS -> ListRS ;
ConsS : S -> ListS -> ListS ;
ConsVPI : VPI -> ListVPI -> ListVPI ;
ConsVPS : VPS -> ListVPS -> ListVPS ;
ContClC_none : PrCl_none -> ClC_none -> ClC_none ;
ContClC_np : PrCl_np -> ClC_np -> ClC_np ;
ContVPC_none : PrVP_none -> VPC_none -> VPC_none ;
ContVPC_np : PrVP_np -> VPC_np -> VPC_np ;
CountNP : Det -> NP -> NP ;
DefArt : Quant ;
DetCN : Det -> CN -> NP ;
DetNP : Det -> NP ;
DetQuant : Quant -> Num -> Det ;
DetQuantOrd : Quant -> Num -> Ord -> Det ;
EmbedQS : QS -> SC ;
EmbedS : S -> SC ;
EmbedVP : VP -> SC ;
EmptyRelSlash : ClSlash -> RCl ;
ExistNP : NP -> Cl ;
ExtAdvNP : NP -> Adv -> NP ;
ExtAdvS : Adv -> S -> S ;
ExtAdvVP : VP -> Adv -> VP ;
FunRP : Prep -> NP -> RP -> RP ;
GenIP : IP -> IQuant ;
GenNP : NP -> Quant ;
GenRP : Num -> CN -> RP ;
GerundAdv : VP -> Adv ;
GerundCN : VP -> CN ;
GerundNP : VP -> NP ;
IdRP : RP ;
IdetCN : IDet -> CN -> IP ;
IdetIP : IDet -> IP ;
IdetQuant : IQuant -> Num -> IDet ;
ImpVP : VP -> Imp ;
IndefArt : Quant ;
InfVP_none : PrVP_none -> PrVPI_none ;
InfVP_np : PrVP_np -> PrVPI_np ;
MassNP : CN -> NP ;
MkSymb : String -> Symb ;
MkVPI : VP -> VPI ;
MkVPS : Temp -> Pol -> VP -> VPS ;
NoPConj : PConj ;
NoVoc : Voc ;
NumCard : Card -> Num ;
NumDigits : Digits -> Card ;
NumNumeral : Numeral -> Card ;
NumPl : Num ;
NumSg : Num ;
OrdDigits : Digits -> Ord ;
OrdNumeral : Numeral -> Ord ;
OrdSuperl : A -> Ord ;
PConjConj : Conj -> PConj ;
PNeg : Pol ;
PPartNP : NP -> V2 -> NP ;
PPos : Pol ;
PartNP : CN -> NP -> CN ;
PassAgentVPSlash : VPSlash -> NP -> VP ;
PassUseV_a : Ant -> Tense -> Pol -> PrV_np_a -> PrVP_a ;
PassUseV_n : Ant -> Tense -> Pol -> PrV_np_n -> PrVP_n ;
PassUseV_none : Ant -> Tense -> Pol -> PrV_np -> PrVP_none ;
PassUseV_np : Ant -> Tense -> Pol -> PrV_np_np -> PrVP_np ;
PassUseV_q : Ant -> Tense -> Pol -> PrV_np_q -> PrVP_q ;
PassUseV_s : Ant -> Tense -> Pol -> PrV_np_s -> PrVP_s ;
PassUseV_v : Ant -> Tense -> Pol -> PrV_np_v -> PrVP_v ;
PassVPSlash : VPSlash -> VP ;
PastPartAP : VPSlash -> AP ;
PastPartAP_none : PrV_np -> PrAP_none ;
PastPartAgentAP : VPSlash -> NP -> AP ;
PastPartRS : Ant -> Pol -> VPSlash -> RS ;
PhrUtt : PConj -> Utt -> Voc -> Phr ;
PositA : A -> AP ;
PositAdAAdj : A -> AdA ;
PositAdVAdj : A -> AdV ;
PositAdvAdj : A -> Adv ;
PossNP : CN -> NP -> CN ;
PossPron : Pron -> Quant ;
PredFrontVQ : Temp -> NP -> VQ -> QS -> S ;
PredFrontVS : Temp -> NP -> VS -> S -> S ;
PredSCVP : SC -> VP -> Cl ;
PredVP : NP -> VP -> Cl ;
PredVPS : NP -> VPS -> S ;
PredVP_none : NP -> PrVP_none -> PrCl_none ;
PredVP_np : NP -> PrVP_np -> PrCl_np ;
PredetNP : Predet -> NP -> NP ;
PrepIP : Prep -> IP -> IAdv ;
PrepNP : Prep -> NP -> Adv ;
PresPartAP : VP -> AP ;
PresPartAP_none : PrV_none -> PrAP_none ;
PresPartAP_np : PrV_np -> PrAP_np ;
PresPartRS : Ant -> Pol -> VP -> RS ;
ProgrVP : VP -> VP ;
QuestCl : Cl -> QCl ;
QuestCl_none : PrCl_none -> PrQCl_none ;
QuestCl_np : PrCl_np -> PrQCl_np ;
QuestIAdv : IAdv -> Cl -> QCl ;
QuestIAdv_none : IAdv -> PrCl_none -> PrQCl_none ;
QuestIComp : IComp -> NP -> QCl ;
QuestQVP : IP -> QVP -> QCl ;
QuestSlash : IP -> ClSlash -> QCl ;
QuestSlash_none : IP -> PrQCl_np -> PrQCl_none ;
QuestVP : IP -> VP -> QCl ;
QuestVP_none : IP -> PrVP_none -> PrQCl_none ;
ReflA2 : A2 -> AP ;
ReflVP : VPSlash -> VP ;
ReflVP2_np : PrVP_np_np -> PrVP_np ;
ReflVP_a : PrVP_np_a -> PrVP_a ;
ReflVP_n : PrVP_np_n -> PrVP_n ;
ReflVP_none : PrVP_np -> PrVP_none ;
ReflVP_np : PrVP_np_np -> PrVP_np ;
ReflVP_q : PrVP_np_q -> PrVP_q ;
ReflVP_s : PrVP_np_s -> PrVP_s ;
ReflVP_v : PrVP_np_v -> PrVP_v ;
RelCN : CN -> RS -> CN ;
RelCl : Cl -> RCl ;
RelNP : NP -> RS -> NP ;
RelS : S -> RS -> S ;
RelSlash : RP -> ClSlash -> RCl ;
RelVP : RP -> VP -> RCl ;
SSubjS : S -> Subj -> S -> S ;
SelfAdVVP : VP -> VP ;
SelfAdvVP : VP -> VP ;
SelfNP : NP -> NP ;
SentAP : AP -> SC -> AP ;
SentCN : CN -> SC -> CN ;
Slash2V3 : V3 -> NP -> VPSlash ;
Slash3V3 : V3 -> NP -> VPSlash ;
SlashClNP_none : PrCl_np -> NP -> PrCl_none ;
SlashPrep : Cl -> Prep -> ClSlash ;
SlashSlashV2V : V2V -> Ant -> Pol -> VPSlash -> VPSlash ;
SlashV2A : V2A -> AP -> VPSlash ;
SlashV2A_none : PrVP_np_a -> PrAP_none -> PrVP_np ;
SlashV2N_none : PrVP_np_n -> PrCN_none -> PrVP_np ;
SlashV2Q : V2Q -> QS -> VPSlash ;
SlashV2Q_none : PrVP_np_q -> PrQCl_none -> PrVP_np ;
SlashV2S : V2S -> S -> VPSlash ;
SlashV2S_none : PrVP_np_s -> PrCl_none -> PrVP_np ;
SlashV2V : V2V -> Ant -> Pol -> VP -> VPSlash ;
SlashV2VNP : V2V -> NP -> VPSlash -> VPSlash ;
SlashV2V_none : PrVP_np_v -> PrVPI_none -> PrVP_np ;
SlashV2V_np : PrVP_np_v -> PrVPI_np -> PrVP_np_np ;
SlashV2a : V2 -> VPSlash ;
SlashV3_none : PrVP_np_np -> NP -> PrVP_np ;
SlashVP : NP -> VPSlash -> ClSlash ;
SlashVPIV2V : V2V -> Pol -> VPI -> VPSlash ;
SlashVS : NP -> VS -> SSlash -> ClSlash ;
SlashVV : VV -> VPSlash -> VPSlash ;
StartClC_none : Conj -> PrCl_none -> PrCl_none -> ClC_none ;
StartClC_np : Conj -> PrCl_np -> PrCl_np -> ClC_np ;
StartVPC_none : Conj -> PrVP_none -> PrVP_none -> VPC_none ;
StartVPC_np : Conj -> PrVP_np -> PrVP_np -> VPC_np ;
SubjS : Subj -> S -> Adv ;
SymbPN : Symb -> PN ;
TCond : Tense ;
TFut : Tense ;
TPast : Tense ;
TPres : Tense ;
TTAnt : Tense -> Ant -> Temp ;
Use2N3 : N3 -> N2 ;
Use3N3 : N3 -> N2 ;
UseA2 : A2 -> AP ;
UseAP_none : Ant -> Tense -> Pol -> PrAP_none -> PrVP_none ;
UseAP_np : Ant -> Tense -> Pol -> PrAP_np -> PrVP_np ;
UseAdvCl_none : PrAdv_none -> PrCl_none -> PrS ;
UseAdv_none : Ant -> Tense -> Pol -> PrAdv_none -> PrVP_none ;
UseAdv_np : Ant -> Tense -> Pol -> PrAdv_np -> PrVP_np ;
UseCN_none : Ant -> Tense -> Pol -> PrCN_none -> PrVP_none ;
UseCN_np : Ant -> Tense -> Pol -> PrCN_np -> PrVP_np ;
UseCl : Temp -> Pol -> Cl -> S ;
UseClC_none : ClC_none -> PrCl_none ;
UseClC_np : ClC_np -> PrCl_np ;
UseCl_none : PrCl_none -> PrS ;
UseComp : Comp -> VP ;
UseComparA : A -> AP ;
UseN : N -> CN ;
UseN2 : N2 -> CN ;
UseNP_none : Ant -> Tense -> Pol -> NP -> PrVP_none ;
UsePN : PN -> NP ;
UsePron : Pron -> NP ;
UseQCl : Temp -> Pol -> QCl -> QS ;
UseQCl_none : PrQCl_none -> PrS ;
UseQuantPN : Quant -> PN -> NP ;
UseRCl : Temp -> Pol -> RCl -> RS ;
UseSlash : Temp -> Pol -> ClSlash -> SSlash ;
UseV : V -> VP ;
UseVPC_none : VPC_none -> PrVP_none ;
UseVPC_np : VPC_np -> PrVP_np ;
UseV_a : Ant -> Tense -> Pol -> PrV_a -> PrVP_a ;
UseV_n : Ant -> Tense -> Pol -> PrV_v -> PrVP_n ;
UseV_none : Ant -> Tense -> Pol -> PrV_none -> PrVP_none ;
UseV_np : Ant -> Tense -> Pol -> PrV_np -> PrVP_np ;
UseV_np_a : Ant -> Tense -> Pol -> PrV_np_a -> PrVP_np_a ;
UseV_np_n : Ant -> Tense -> Pol -> PrV_np_n -> PrVP_np_n ;
UseV_np_np : Ant -> Tense -> Pol -> PrV_np_np -> PrVP_np_np ;
UseV_np_q : Ant -> Tense -> Pol -> PrV_np_q -> PrVP_np_q ;
UseV_np_s : Ant -> Tense -> Pol -> PrV_np_s -> PrVP_np_s ;
UseV_np_v : Ant -> Tense -> Pol -> PrV_np_v -> PrVP_np_v ;
UseV_q : Ant -> Tense -> Pol -> PrV_q -> PrVP_q ;
UseV_s : Ant -> Tense -> Pol -> PrV_s -> PrVP_s ;
UseV_v : Ant -> Tense -> Pol -> PrV_v -> PrVP_v ;
UttAP : AP -> Utt ;
UttAdV : AdV -> Utt ;
UttAdv : Adv -> Utt ;
UttCN : CN -> Utt ;
UttCard : Card -> Utt ;
UttIAdv : IAdv -> Utt ;
UttIP : IP -> Utt ;
UttImpPl : Pol -> Imp -> Utt ;
UttImpPol : Pol -> Imp -> Utt ;
UttImpSg : Pol -> Imp -> Utt ;
UttInterj : Interj -> Utt ;
UttNP : NP -> Utt ;
UttPrS : PrS -> Utt ;
UttQS : QS -> Utt ;
UttS : S -> Utt ;
UttVP : VP -> Utt ;
VPSlashPrep : VP -> Prep -> VPSlash ;
VPSlashVS : VS -> VP -> VPSlash ;
VocNP : NP -> Voc ;
that_RP : RP ;
who_RP : RP ;
-}

3078
src/experimental/transfer/Both.hs
View File

File diff suppressed because it is too large Load Diff

78
src/experimental/transfer/CountTransfer.hs
View File

@@ -1,78 +0,0 @@
module Main where
main = interact (unlines . map changeCounts . lines)
changeCounts = unlexer . concatMap counts . lexer
lexer s = case lex s of
(t,s2@(_:_)):_ -> t:lexer s2
_ -> []
unlexer = unwords
counts t = case t of
"UttImpPl" -> ["PrImpPl"]
"UttImpPol" -> ["PrImpPol"]
"UttImpSg" -> ["PrImpSg"]
"ImpVP" -> []
"UttQS" -> ["UttPrS","UseQCl_none"]
"UttS" -> ["UttPrS"]
"UttVP" -> ["UttPrVPI","InfVP_none"]
"UseRCl" -> []
"TTAnt" -> []
"RelCl" -> ["RelCl_none"]
"RelVP" -> ["RelVP_none"]
"RelSlash" -> ["RelSlash_none"]
"PastPartRS" -> ["PastPartAP_none"]
"PresPartRS" -> ["PresPartAP_none"]
"ComparAdvAdjS" -> ["ComparAdvAdjS_none"] ----
"SubjS" -> ["AdvSubjS"] ----
"ConjS" -> ["UseClC_none"]
"PredVPS" -> ["UseCl_none","PredVP_none","UseVPC_none"]
"BaseVPS" -> ["StartVPC_none"]
"ConsVPS" -> ["ContVPC_none"]
"BaseS" -> ["StartClC_none"]
"ConsS" -> ["ContClC_none"]
"PredVP" -> ["PredVP_none"]
"AdvVP" -> ["AdvCl_none","LiftAdv"] ---- some for Cl, some for QCl
"AdVVP" -> ["AdvQCl_none","LiftAdV"] ----
"QuestVP" -> ["QuestVP_none"]
"QuestSlash" -> ["QuestSlash_none"]
"QuestCl" -> ["QuestCl_none"]
"QuestIAdv" -> ["QuestIAdv_none"]
"QuestIComp" -> ["QuestIComp_none"]
"UseV" -> ["UseV_none"]
"ComplVS" -> ["ComplVS_none","UseV_s","LiftVS"]
"ComplVQ" -> ["ComplVQ_none","UseV_q","LiftVQ"]
"ComplVA" -> ["ComplVA_none","UseV_a","LiftVA"]
"ComplVV" -> ["ComplVV_none","UseV_v","LiftVV","InfVP_none"]
"ComplSlash" -> ["ComplV2_none"]
"UseComp" -> []
"CompAP" -> ["UseAP_none","LiftAP"]
"CompAdv" -> ["UseAdv_none","LiftAdv"]
"CompCN" -> ["UseCN_none","LiftCN"]
"CompNP" -> ["UseNP_none"]
"CompVP" -> ["UseAP_none","InfAP_none"]
"CompQS" -> ["UseQ_none"]
"CompS" -> ["UseS_none"]
"SlashV2a" -> ["UseV_np","LiftV2"]
"ComplSlashPartLast" -> ["ComplV2_none"]
"ComplVPIVV" -> ["ComplVV_none","UseV_v","LiftVV","InfVP_none"]
"MkVPI" -> []
"ConjVPI" -> ["UseVPC_none"]
"PassVPSlash" -> ["PassUseV_none","LiftV2"] ---- can be other V's
"PassAgentVPSlash" -> ["AgentPassUseV_none","LiftV2"] ---- can be other V's
"SlashV2S" -> ["SlashV2S_none","UseV_np_s","LiftV2S"]
"SlashV2Q" -> ["SlashV2Q_none","UseV_np_q","LiftV2Q"]
"SlashV2A" -> ["SlashV2A_none","UseV_np_a","LiftV2A"]
"SlashV2V" -> ["SlashV2V_none","UseV_np_v","LiftV2V","InfVP_none"]
"SlashVV" -> ["ComplVV_np","UseV_v","LiftVV","InfVP_none"]
"SlashVP" -> ["PredVP_np"]
"SlashPrep" -> ["AdvCl_np","LiftPrep"]
"SlashVS" -> [] ----
"AdvSlash" -> [] ----
"UseCl" -> []
"UseQCl" -> []
"UseSlash" -> []
t -> [t]

256
src/experimental/transfer/New.gf
View File

@@ -1,256 +0,0 @@
--# -path=..:../../translator
abstract New =
--abstract NDTrans =
---- Tense,
NDPred - [Pol,Tense],
NDLift [LiftV,LiftV2,LiftVS,LiftVQ,LiftVA,LiftVN,LiftVV,
LiftV3,LiftV2S,LiftV2Q,LiftV2A,LiftV2N,LiftV2V,
LiftAP,LiftA2,LiftCN,LiftN2,LiftAdv,LiftAdV,LiftPrep,
AppAPCN
],
Noun,
Adjective,
--- Numeral,
Conjunction,
---- Verb,
Adverb,
Phrase,
---- Sentence,
Question - [QuestCl,QuestVP,QuestSlash,QuestIAdv,QuestIComp],
Relative - [RelCl,RelVP,RelSlash],
Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP],
Symbol [PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP] ---- why only these?
---- Construction,
---- Extensions,
---- Documentation ;
,Extensions [CN,NP,AdA,AdV,CompoundCN,AdAdV,UttAdV,ApposNP]
;
{-
New> pg -cats
A A2 AP AdA AdN AdV Adv Ant CAdv CN Card Cl ClC_none ClC_np ClSlash Comp Conj Det Digits Float IAdv IComp IDet IP IQuant Imp Int Interj ListAP ListAdV ListAdv ListCN ListIAdv ListNP ListRS ListS N N2 N3 NP Num Numeral Ord PConj PN Phr Pol PrAP_none PrAP_np PrAdv_none PrAdv_np PrCN_none PrCN_np PrCl_none PrCl_np PrQCl_none PrQCl_np PrS PrVPI_none PrVPI_np PrVP_a PrVP_n PrVP_none PrVP_np PrVP_np_a PrVP_np_n PrVP_np_np PrVP_np_q PrVP_np_s PrVP_np_v PrVP_q PrVP_s PrVP_v PrV_a PrV_n PrV_none PrV_np PrV_np_a PrV_np_n PrV_np_np PrV_np_q PrV_np_s PrV_np_v PrV_q PrV_s PrV_v Predet Prep Pron QCl QS Quant RCl RP RS S SC SSlash String Subj Symb Temp Tense Text Utt V V2 V2A V2Q V2S V2V V3 VA VP VPC_none VPC_np VPSlash VQ VS VV Voc
0 msec
New> pg -funs
AAnter : Ant ;
ASimul : Ant ;
AdAP : AdA -> AP -> AP ;
AdAdV : AdA -> AdV -> AdV ;
AdAdv : AdA -> Adv -> Adv ;
AdNum : AdN -> Card -> Card ;
AdjCN : AP -> CN -> CN ;
AdjOrd : Ord -> AP ;
AdnCAdv : CAdv -> AdN ;
AdvAP : AP -> Adv -> AP ;
AdvCN : CN -> Adv -> CN ;
AdvCl_none : PrAdv_none -> PrCl_none -> PrCl_none ;
AdvCl_np : PrAdv_np -> PrCl_none -> PrCl_np ;
AdvNP : NP -> Adv -> NP ;
AdvQCl_none : PrAdv_none -> PrQCl_none -> PrQCl_none ;
AdvQCl_np : PrAdv_np -> PrQCl_none -> PrQCl_np ;
AgentPassUseV_a : Ant -> Tense -> Pol -> PrV_np_a -> NP -> PrVP_a ;
AgentPassUseV_n : Ant -> Tense -> Pol -> PrV_np_n -> NP -> PrVP_n ;
AgentPassUseV_none : Ant -> Tense -> Pol -> PrV_np -> NP -> PrVP_none ;
AgentPassUseV_np : Ant -> Tense -> Pol -> PrV_np_np -> NP -> PrVP_np ;
AgentPassUseV_q : Ant -> Tense -> Pol -> PrV_np_q -> NP -> PrVP_q ;
AgentPassUseV_s : Ant -> Tense -> Pol -> PrV_np_s -> NP -> PrVP_s ;
AgentPassUseV_v : Ant -> Tense -> Pol -> PrV_np_v -> NP -> PrVP_v ;
AgentPastPartAP_none : PrV_np -> NP -> PrAP_none ;
ApposCN : CN -> NP -> CN ;
ApposNP : NP -> NP -> NP ;
BaseAP : AP -> AP -> ListAP ;
BaseAdV : AdV -> AdV -> ListAdV ;
BaseAdv : Adv -> Adv -> ListAdv ;
BaseCN : CN -> CN -> ListCN ;
BaseIAdv : IAdv -> IAdv -> ListIAdv ;
BaseNP : NP -> NP -> ListNP ;
BaseRS : RS -> RS -> ListRS ;
BaseS : S -> S -> ListS ;
CAdvAP : CAdv -> AP -> NP -> AP ;
CNNumNP : CN -> Card -> NP ;
ComparA : A -> NP -> AP ;
ComparAdvAdj : CAdv -> A -> NP -> Adv ;
ComparAdvAdjS : CAdv -> A -> S -> Adv ;
ComplA2 : A2 -> NP -> AP ;
ComplAdv_none : PrAdv_np -> NP -> PrAdv_none ;
ComplN2 : N2 -> NP -> CN ;
ComplN3 : N3 -> NP -> N2 ;
ComplV2_none : PrVP_np -> NP -> PrVP_none ;
ComplVA_none : PrVP_a -> PrAP_none -> PrVP_none ;
ComplVN_none : PrVP_n -> PrCN_none -> PrVP_none ;
ComplVQ_none : PrVP_q -> PrQCl_none -> PrVP_none ;
ComplVS_none : PrVP_s -> PrCl_none -> PrVP_none ;
ComplVS_np : PrVP_s -> PrCl_np -> PrVP_np ;
ComplVV_none : PrVP_v -> PrVPI_none -> PrVP_none ;
ComplVV_np : PrVP_v -> PrVPI_np -> PrVP_np ;
CompoundCN : N -> CN -> CN ;
ConjAP : Conj -> ListAP -> AP ;
ConjAdV : Conj -> ListAdV -> AdV ;
ConjAdv : Conj -> ListAdv -> Adv ;
ConjCN : Conj -> ListCN -> CN ;
ConjIAdv : Conj -> ListIAdv -> IAdv ;
ConjNP : Conj -> ListNP -> NP ;
ConjRS : Conj -> ListRS -> RS ;
ConjS : Conj -> ListS -> S ;
ConsAP : AP -> ListAP -> ListAP ;
ConsAdV : AdV -> ListAdV -> ListAdV ;
ConsAdv : Adv -> ListAdv -> ListAdv ;
ConsCN : CN -> ListCN -> ListCN ;
ConsIAdv : IAdv -> ListIAdv -> ListIAdv ;
ConsNP : NP -> ListNP -> ListNP ;
ConsRS : RS -> ListRS -> ListRS ;
ConsS : S -> ListS -> ListS ;
ContClC_none : PrCl_none -> ClC_none -> ClC_none ;
ContClC_np : PrCl_np -> ClC_np -> ClC_np ;
ContVPC_none : PrVP_none -> VPC_none -> VPC_none ;
ContVPC_np : PrVP_np -> VPC_np -> VPC_np ;
CountNP : Det -> NP -> NP ;
DefArt : Quant ;
DetCN : Det -> CN -> NP ;
DetNP : Det -> NP ;
DetQuant : Quant -> Num -> Det ;
DetQuantOrd : Quant -> Num -> Ord -> Det ;
ExtAdvNP : NP -> Adv -> NP ;
FunRP : Prep -> NP -> RP -> RP ;
IdRP : RP ;
IndefArt : Quant ;
InfVP_none : PrVP_none -> PrVPI_none ;
InfVP_np : PrVP_np -> PrVPI_np ;
MassNP : CN -> NP ;
MkSymb : String -> Symb ;
NoPConj : PConj ;
NoVoc : Voc ;
NumCard : Card -> Num ;
NumDigits : Digits -> Card ;
NumNumeral : Numeral -> Card ;
NumPl : Num ;
NumSg : Num ;
OrdDigits : Digits -> Ord ;
OrdNumeral : Numeral -> Ord ;
OrdSuperl : A -> Ord ;
PConjConj : Conj -> PConj ;
PNeg : Pol ;
PPartNP : NP -> V2 -> NP ;
PPos : Pol ;
PartNP : CN -> NP -> CN ;
PassUseV_a : Ant -> Tense -> Pol -> PrV_np_a -> PrVP_a ;
PassUseV_n : Ant -> Tense -> Pol -> PrV_np_n -> PrVP_n ;
PassUseV_none : Ant -> Tense -> Pol -> PrV_np -> PrVP_none ;
PassUseV_np : Ant -> Tense -> Pol -> PrV_np_np -> PrVP_np ;
PassUseV_q : Ant -> Tense -> Pol -> PrV_np_q -> PrVP_q ;
PassUseV_s : Ant -> Tense -> Pol -> PrV_np_s -> PrVP_s ;
PassUseV_v : Ant -> Tense -> Pol -> PrV_np_v -> PrVP_v ;
PastPartAP_none : PrV_np -> PrAP_none ;
PhrUtt : PConj -> Utt -> Voc -> Phr ;
PositA : A -> AP ;
PositAdAAdj : A -> AdA ;
PositAdvAdj : A -> Adv ;
PossNP : CN -> NP -> CN ;
PossPron : Pron -> Quant ;
PredVP_none : NP -> PrVP_none -> PrCl_none ;
PredVP_np : NP -> PrVP_np -> PrCl_np ;
PredetNP : Predet -> NP -> NP ;
PrepNP : Prep -> NP -> Adv ;
PresPartAP_none : PrV_none -> PrAP_none ;
PresPartAP_np : PrV_np -> PrAP_np ;
QuestCl_none : PrCl_none -> PrQCl_none ;
QuestCl_np : PrCl_np -> PrQCl_np ;
QuestIAdv_none : IAdv -> PrCl_none -> PrQCl_none ;
QuestSlash_none : IP -> PrQCl_np -> PrQCl_none ;
QuestVP_none : IP -> PrVP_none -> PrQCl_none ;
ReflA2 : A2 -> AP ;
ReflVP2_np : PrVP_np_np -> PrVP_np ;
ReflVP_a : PrVP_np_a -> PrVP_a ;
ReflVP_n : PrVP_np_n -> PrVP_n ;
ReflVP_none : PrVP_np -> PrVP_none ;
ReflVP_np : PrVP_np_np -> PrVP_np ;
ReflVP_q : PrVP_np_q -> PrVP_q ;
ReflVP_s : PrVP_np_s -> PrVP_s ;
ReflVP_v : PrVP_np_v -> PrVP_v ;
RelCN : CN -> RS -> CN ;
RelCl : Cl -> RCl ;
RelNP : NP -> RS -> NP ;
RelSlash : RP -> ClSlash -> RCl ;
RelVP : RP -> VP -> RCl ;
SentAP : AP -> SC -> AP ;
SentCN : CN -> SC -> CN ;
SlashClNP_none : PrCl_np -> NP -> PrCl_none ;
SlashV2A_none : PrVP_np_a -> PrAP_none -> PrVP_np ;
SlashV2N_none : PrVP_np_n -> PrCN_none -> PrVP_np ;
SlashV2Q_none : PrVP_np_q -> PrQCl_none -> PrVP_np ;
SlashV2S_none : PrVP_np_s -> PrCl_none -> PrVP_np ;
SlashV2V_none : PrVP_np_v -> PrVPI_none -> PrVP_np ;
SlashV2V_np : PrVP_np_v -> PrVPI_np -> PrVP_np_np ;
SlashV3_none : PrVP_np_np -> NP -> PrVP_np ;
StartClC_none : Conj -> PrCl_none -> PrCl_none -> ClC_none ;
StartClC_np : Conj -> PrCl_np -> PrCl_np -> ClC_np ;
StartVPC_none : Conj -> PrVP_none -> PrVP_none -> VPC_none ;
StartVPC_np : Conj -> PrVP_np -> PrVP_np -> VPC_np ;
SubjS : Subj -> S -> Adv ;
SymbPN : Symb -> PN ;
TCond : Tense ;
TFut : Tense ;
TPast : Tense ;
TPres : Tense ;
Use2N3 : N3 -> N2 ;
Use3N3 : N3 -> N2 ;
UseA2 : A2 -> AP ;
UseAP_none : Ant -> Tense -> Pol -> PrAP_none -> PrVP_none ;
UseAP_np : Ant -> Tense -> Pol -> PrAP_np -> PrVP_np ;
UseAdvCl_none : PrAdv_none -> PrCl_none -> PrS ;
UseAdv_none : Ant -> Tense -> Pol -> PrAdv_none -> PrVP_none ;
UseAdv_np : Ant -> Tense -> Pol -> PrAdv_np -> PrVP_np ;
UseCN_none : Ant -> Tense -> Pol -> PrCN_none -> PrVP_none ;
UseCN_np : Ant -> Tense -> Pol -> PrCN_np -> PrVP_np ;
UseClC_none : ClC_none -> PrCl_none ;
UseClC_np : ClC_np -> PrCl_np ;
UseCl_none : PrCl_none -> PrS ;
UseComparA : A -> AP ;
UseN : N -> CN ;
UseN2 : N2 -> CN ;
UseNP_none : Ant -> Tense -> Pol -> NP -> PrVP_none ;
UsePN : PN -> NP ;
UsePron : Pron -> NP ;
UseQCl_none : PrQCl_none -> PrS ;
UseVPC_none : VPC_none -> PrVP_none ;
UseVPC_np : VPC_np -> PrVP_np ;
UseV_a : Ant -> Tense -> Pol -> PrV_a -> PrVP_a ;
UseV_n : Ant -> Tense -> Pol -> PrV_v -> PrVP_n ;
UseV_none : Ant -> Tense -> Pol -> PrV_none -> PrVP_none ;
UseV_np : Ant -> Tense -> Pol -> PrV_np -> PrVP_np ;
UseV_np_a : Ant -> Tense -> Pol -> PrV_np_a -> PrVP_np_a ;
UseV_np_n : Ant -> Tense -> Pol -> PrV_np_n -> PrVP_np_n ;
UseV_np_np : Ant -> Tense -> Pol -> PrV_np_np -> PrVP_np_np ;
UseV_np_q : Ant -> Tense -> Pol -> PrV_np_q -> PrVP_np_q ;
UseV_np_s : Ant -> Tense -> Pol -> PrV_np_s -> PrVP_np_s ;
UseV_np_v : Ant -> Tense -> Pol -> PrV_np_v -> PrVP_np_v ;
UseV_q : Ant -> Tense -> Pol -> PrV_q -> PrVP_q ;
UseV_s : Ant -> Tense -> Pol -> PrV_s -> PrVP_s ;
UseV_v : Ant -> Tense -> Pol -> PrV_v -> PrVP_v ;
UttAP : AP -> Utt ;
UttAdV : AdV -> Utt ;
UttAdv : Adv -> Utt ;
UttCN : CN -> Utt ;
UttCard : Card -> Utt ;
UttIAdv : IAdv -> Utt ;
UttIP : IP -> Utt ;
UttImpPl : Pol -> Imp -> Utt ;
UttImpPol : Pol -> Imp -> Utt ;
UttImpSg : Pol -> Imp -> Utt ;
UttInterj : Interj -> Utt ;
UttNP : NP -> Utt ;
UttPrS : PrS -> Utt ;
UttQS : QS -> Utt ;
UttS : S -> Utt ;
UttVP : VP -> Utt ;
VocNP : NP -> Voc ;
-}

110
src/experimental/transfer/New2Old.hs
View File

@@ -1,110 +0,0 @@
GAdvCl_none gPrAdv_none gPrCl_none -> t
GAdvCl_np gPrAdv_np gPrCl_none -> t
GAdvQCl_none gPrAdv_none gPrQCl_none -> t
GAdvQCl_np gPrAdv_np gPrQCl_none -> t
GAfterVP_none gPrVP_none gPrVPI_none -> t
GAgentPassUseV_a gAnt gTense gPol gPrV_np_a gNP -> t
GAgentPassUseV_n gAnt gTense gPol gPrV_np_n gNP -> t
GAgentPassUseV_none gAnt gTense gPol gPrV_np gNP -> t
GAgentPassUseV_np gAnt gTense gPol gPrV_np_np gNP -> t
GAgentPassUseV_q gAnt gTense gPol gPrV_np_q gNP -> t
GAgentPassUseV_s gAnt gTense gPol gPrV_np_s gNP -> t
GAgentPassUseV_v gAnt gTense gPol gPrV_np_v gNP -> t
GAgentPastPartAP_none gPrV_np gNP -> t
GBeforeVP_none gPrVP_none gPrVPI_none -> t
GByVP_none gPrVP_none gPrVPI_none -> t
GComplAdv_none gPrAdv_np gNP -> t
GComplV2_none gPrVP_np gNP -> t
GComplVA_none gPrVP_a gPrAP_none -> t
GComplVN_none gPrVP_n gPrCN_none -> t
GComplVQ_none gPrVP_q gPrQCl_none -> t
GComplVS_none gPrVP_s gPrCl_none -> t
GComplVS_np gPrVP_s gPrCl_np -> t
GComplVV_none gPrVP_v gPrVPI_none -> t
GComplVV_np gPrVP_v gPrVPI_np -> t
GCompoundCN gN gCN -> t
GContClC_none gPrCl_none gClC_none -> t
GContClC_np gPrCl_np gClC_np -> t
GContVPC_none gPrVP_none gVPC_none -> t
GContVPC_np gPrVP_np gVPC_np -> t
GInOrderVP_none gPrVP_none gPrVPI_none -> t
GInfVP_none gPrVP_none -> t
GInfVP_np gPrVP_np -> t
GNomVPNP_none gPrVPI_none -> t
GPPartNP gNP gV2 -> t
GPassUseV_a gAnt gTense gPol gPrV_np_a -> t
GPassUseV_n gAnt gTense gPol gPrV_np_n -> t
GPassUseV_none gAnt gTense gPol gPrV_np -> t
GPassUseV_np gAnt gTense gPol gPrV_np_np -> t
GPassUseV_q gAnt gTense gPol gPrV_np_q -> t
GPassUseV_s gAnt gTense gPol gPrV_np_s -> t
GPassUseV_v gAnt gTense gPol gPrV_np_v -> t
GPastPartAP_none gPrV_np -> t
GPrImpPl gPrVP_none -> t
GPrImpSg gPrVP_none -> t
GPredVP_none gNP gPrVP_none -> t
GPredVP_np gNP gPrVP_np -> t
GPresPartAP_none gPrV_none -> t
GPresPartAP_np gPrV_np -> t
GQuestCl_none gPrCl_none -> t
GQuestCl_np gPrCl_np -> t
GQuestIAdv_none gIAdv gPrCl_none -> t
GQuestIComp_none gAnt gTense gPol gIComp gNP -> t
GQuestSlash_none gIP gPrQCl_np -> t
GQuestVP_none gIP gPrVP_none -> t
GReflVP2_np gPrVP_np_np -> t
GReflVP_a gPrVP_np_a -> t
GReflVP_n gPrVP_np_n -> t
GReflVP_none gPrVP_np -> t
GReflVP_np gPrVP_np_np -> t
GReflVP_q gPrVP_np_q -> t
GReflVP_s gPrVP_np_s -> t
GReflVP_v gPrVP_np_v -> t
GRelCl_none gPrCl_none -> t
GRelSlash_none gRP gPrCl_np -> t
GRelVP_none gRP gPrVP_none -> t
GSlashClNP_none gPrCl_np gNP -> t
GSlashV2A_none gPrVP_np_a gPrAP_none -> t
GSlashV2N_none gPrVP_np_n gPrCN_none -> t
GSlashV2Q_none gPrVP_np_q gPrQCl_none -> t
GSlashV2S_none gPrVP_np_s gPrCl_none -> t
GSlashV2V_none gPrVP_np_v gPrVPI_none -> t
GSlashV2V_np gPrVP_np_v gPrVPI_np -> t
GSlashV3_none gPrVP_np_np gNP -> t
GStartClC_none gConj gPrCl_none gPrCl_none -> t
GStartClC_np gConj gPrCl_np gPrCl_np -> t
GStartVPC_none gConj gPrVP_none gPrVP_none -> t
GStartVPC_np gConj gPrVP_np gPrVP_np -> t
GUseAP_none gAnt gTense gPol gPrAP_none -> t
GUseAP_np gAnt gTense gPol gPrAP_np -> t
GUseAdvCl_none gPrAdv_none gPrCl_none -> t
GUseAdv_none gAnt gTense gPol gPrAdv_none -> t
GUseAdv_np gAnt gTense gPol gPrAdv_np -> t
GUseCN_none gAnt gTense gPol gPrCN_none -> t
GUseCN_np gAnt gTense gPol gPrCN_np -> t
GUseClC_none gClC_none -> t
GUseClC_np gClC_np -> t
GUseCl_none gPrCl_none -> t
GUseNP_none gAnt gTense gPol gNP -> t
GUseQCl_none gPrQCl_none -> t
GUseQ_none gAnt gTense gPol gPrQCl_none -> t
GUseS_none gAnt gTense gPol gPrCl_none -> t
GUseVPC_none gVPC_none -> t
GUseVPC_np gVPC_np -> t
GUseVP_none gAnt gTense gPol gPrVPI_none -> t
GUseV_a gAnt gTense gPol gPrV_a -> t
GUseV_n gAnt gTense gPol gPrV_v -> t
GUseV_none gAnt gTense gPol gPrV_none -> t
GUseV_np gAnt gTense gPol gPrV_np -> t
GUseV_np_a gAnt gTense gPol gPrV_np_a -> t
GUseV_np_n gAnt gTense gPol gPrV_np_n -> t
GUseV_np_np gAnt gTense gPol gPrV_np_np -> t
GUseV_np_q gAnt gTense gPol gPrV_np_q -> t
GUseV_np_s gAnt gTense gPol gPrV_np_s -> t
GUseV_np_v gAnt gTense gPol gPrV_np_v -> t
GUseV_q gAnt gTense gPol gPrV_q -> t
GUseV_s gAnt gTense gPol gPrV_s -> t
GUseV_v gAnt gTense gPol gPrV_v -> t
GUttPrS gPrS -> t
GWhenVP_none gPrVP_none gPrVPI_none -> t
GWithoutVP_none gPrVP_none gPrVPI_none -> t

8
src/experimental/transfer/ONTransfer.hs
View File

@@ -1,8 +0,0 @@
module Main where
import qualified PGF
import Old2New
main = interact (unlines . map trans . lines)
trans = maybe "" (PGF.showExpr [] . transfer) . PGF.readExpr

81
src/experimental/transfer/Old.gf
View File

@@ -1,81 +0,0 @@
--# -path=..:../../translator
abstract Old =
--- abstract ParseEngAbs =
Tense,
Cat,
Noun - [PPartNP],
Adjective,
---- Numeral,
Symbol [PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP],
Conjunction,
Verb - [SlashV2V, PassV2, UseCopula, ComplVV],
Adverb,
Phrase,
Sentence,
Question,
Relative,
Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP],
--- Construction,
--- Documentation,
ExtraEngAbs [NP, Quant, VPSlash, VP, GenNP, PassVPSlash, PassAgentVPSlash,
Temp, Tense, Pol, Conj, VPS, ListVPS, S, Num, CN, RP, MkVPS, BaseVPS, ConsVPS, ConjVPS, PredVPS, GenRP,
VPI, ListVPI, VV, MkVPI, BaseVPI, ConsVPI, ConjVPI, ComplVPIVV, ComplSlashPartLast,
ClSlash, RCl, EmptyRelSlash, VS, V2S, ComplBareVS, SlashBareV2S]
---- Dictionary
** {
flags
startcat=Phr;
heuristic_search_factor=0.60;
meta_prob=1.0e-5;
meta_token_prob=1.1965149246222233e-9;
fun CompoundCN : Num -> N -> CN -> CN ;
DashCN : N -> N -> N ;
GerundN : V -> N ;
GerundAP : V -> AP ;
PastPartAP : V2 -> AP ;
myself_NP : NP ;
yourselfSg_NP : NP ;
himself_NP : NP ;
herself_NP : NP ;
itself_NP : NP ;
ourselves_NP : NP ;
yourselfPl_NP : NP ;
themselves_NP : NP ;
OrdCompar : A -> Ord ;
PositAdVAdj : A -> AdV ;
UseQuantPN : Quant -> PN -> NP;
SlashV2V : V2V -> Ant -> Pol -> VP -> VPSlash ;
SlashVPIV2V : V2V -> Pol -> VPI -> VPSlash ;
SlashSlashV2V : V2V -> Ant -> Pol -> VPSlash -> VPSlash ;
ComplVV : VV -> Ant -> Pol -> VP -> VP ;
PredVPosv,PredVPovs : NP -> VP -> Cl ;
that_RP : RP ;
who_RP : RP ;
CompS : S -> Comp ;
CompQS : QS -> Comp ;
CompVP : Ant -> Pol -> VP -> Comp ;
VPSlashVS : VS -> VP -> VPSlash ;
PastPartRS : Ant -> Pol -> VPSlash -> RS ;
PresPartRS : Ant -> Pol -> VP -> RS ;
ApposNP : NP -> NP -> NP ;
AdAdV : AdA -> AdV -> AdV ;
UttAdV : AdV -> Utt;
}

182
src/experimental/transfer/Old2New.hs
View File

@@ -1,182 +0,0 @@
{-# OPTIONS_GHC -fglasgow-exts #-}
module Old2New (transfer) where
import PGF hiding (Tree)
import qualified PGF
import PGF.Data
import Both
transfer :: PGF.Tree -> PGF.Tree
transfer = gf . onPhr . fg
{-
transfer t = case unAppForm t of
(EMeta m, es) -> foldl EApp (EMeta m) (map transfer es)
_ -> gf $ on $ fg t
-}
onPhr :: Tree GPhr_ -> Tree GPhr_
onPhr = on
on :: forall a . Tree a -> Tree a
on t = case t of
---- GEMeta m ts -> GEMeta m (map on ts)
-- Utt
GUttImpPl pol (GImpVP vp) -> GPrImpPl (onVP GTPres GASimul pol vp)
GUttImpPol pol (GImpVP vp) -> GPrImpSg (onVP GTPres GASimul pol vp) ----
GUttImpSg pol (GImpVP vp) -> GPrImpSg (onVP GTPres GASimul pol vp)
GUttQS qs -> GUttPrS (GUseQCl_none (onQS2QCl qs))
GUttS s -> GUttPrS (onS s)
GUttVP s -> error "GUttPrVPI (GInfVP_none (onVP GTPres ant pol vp))"
-- RS
GUseRCl (GTTAnt t a) p (GRelVP rp vp) -> GRelVP_none rp (onVP t a p vp)
GUseRCl (GTTAnt t a) p (GRelSlash rp cls) -> GRelSlash_none rp (onClSlash t a p cls)
GUseRCl (GTTAnt t a) p (GRelCl cl) -> GRelCl_none (onCl t a p cl)
GPastPartRS _ _ _ -> error "PastPartRS : Ant -> Pol -> VPSlash -> RS"
GPresPartRS _ _ _ -> error "PresPartRS : Ant -> Pol -> VPSlash -> RS"
-- NP
-- Adv
GComparAdvAdjS cadv a s -> error "GComparAdvAdjS cadv a (onS s)"
GSubjS subj s -> error "AdvSubjS subj s"
-- AP
---- SentAP : AP -> SC -> AP
_ -> composOp on t
onS :: Tree GS_ -> Tree GPrS_
onS s = case s of
GUseCl (GTTAnt t a) p cl -> GUseCl_none (onCl t a p cl)
GAdvS adv s -> error "AdvS"
GExtAdvS adv s -> error "ExtAdvS"
GRelS s rs -> error "RelS"
GSSubjS s subj s2 -> error "SSubjS"
GConjS conj (GListS lists) -> GUseCl_none (GUseClC_none (mkClC conj [onS2Cl s | s <- lists]))
GPredVPS np vps -> GUseCl_none (GPredVP_none (on np) (onVPS2VP vps))
mkClC conj cls = foldr GContClC_none (GStartClC_none conj cl1 cl2) cls2
where
(cls2,[cl1,cl2]) = splitAt (length cls - 2) cls
onVPS2VP :: Tree GVPS_ -> Tree GPrVP_none_
onVPS2VP vps = case vps of
GMkVPS (GTTAnt t a) p vp -> onVP t a p vp
GConjVPS conj (GListVPS vs) -> GUseVPC_none (mkVPC conj [onVPS2VP v | v <- vs])
mkVPC conj cls = foldr GContVPC_none (GStartVPC_none conj cl1 cl2) cls2
where
(cls2,[cl1,cl2]) = splitAt (length cls - 2) cls
onCl :: GTense -> GAnt -> GPol -> Tree GCl_ -> Tree GPrCl_none_
onCl t a p cl = case cl of
GPredVP np vp -> let (advs,vp0) = getAdvs vp in appAdvCl advs (GPredVP_none (on np) (onVP t a p vp0)) ---
---- ExistNP : NP -> Cl ;
---- PredSCVP : SC -> VP -> Cl ;
---- PredVPosv : NP -> VP -> Cl ;
---- PredVPovs : NP -> VP -> Cl ;
-- adverbs in New are attached to Cl, in Old to VP. New makes no distinction between Adv and AdV
getAdvs :: GVP -> ([GPrAdv_none],GVP)
getAdvs vp = case vp of
GAdvVP vp1 adv -> let (advs,vp2) = getAdvs vp1 in (advs ++ [GLiftAdv adv],vp2)
GAdVVP adv vp1 -> let (advs,vp2) = getAdvs vp1 in (advs ++ [GLiftAdV adv],vp2)
GExtAdvVP vp1 adv -> let (advs,vp2) = getAdvs vp1 in (advs ++ [GLiftAdv adv],vp2) ---- as a variant
_ -> ([],vp)
appAdvCl :: [GPrAdv_none] -> GPrCl_none -> GPrCl_none
appAdvCl advs cl = foldr GAdvCl_none cl advs
onQCl :: GTense -> GAnt -> GPol -> Tree GQCl_ -> Tree GPrQCl_none_
onQCl t a p qcl = case qcl of
GQuestVP ip vp -> GQuestVP_none ip (onVP t a p vp)
GQuestSlash ip cls -> GQuestSlash_none ip (GQuestCl_np (onClSlash t a p cls))
GQuestCl cl -> GQuestCl_none (onCl t a p cl)
GQuestIAdv iadv cl -> GQuestIAdv_none iadv (onCl t a p cl)
GQuestIComp icomp np -> GQuestIComp_none a t p icomp np
GQuestQVP ip qvp -> error "QuestQVP"
onVP :: GTense -> GAnt -> GPol -> Tree GVP_ -> Tree GPrVP_none_
onVP t a p vp = case vp of
GUseV v -> GUseV_none a t p (GLiftV v)
GComplVS vs s -> GComplVS_none (GUseV_s a t p (GLiftVS vs)) (onS2Cl s)
GComplVQ vq q -> GComplVQ_none (GUseV_q a t p (GLiftVQ vq)) (onQS2QCl q)
GComplVA va ap -> GComplVA_none (GUseV_a a t p (GLiftVA va)) (GLiftAP ap)
GComplVV vv ant pol vp -> GComplVV_none (GUseV_v a t p (GLiftVV vv)) (GInfVP_none (onVP GTPres ant pol vp)) -- !!
GComplSlash vps np -> GComplV2_none (onVPSlash t a p vps) np
GUseComp comp -> case comp of
GCompAP ap -> GUseAP_none a t p (GLiftAP (on ap))
GCompAdv adv -> GUseAdv_none a t p (GLiftAdv (on adv))
GCompCN cn -> GUseCN_none a t p (GLiftCN (on cn))
GCompNP np -> GUseNP_none a t p (on np)
GCompS s -> GUseS_none a t p (onS2Cl s)
GCompQS qs -> GUseQ_none a t p (onQS2QCl qs)
GCompVP ant pol vp -> GUseVP_none a t p (GInfVP_none (onVP GTPres ant pol vp)) -- !!
GComplSlashPartLast vps np -> GComplV2_none (onVPSlash t a p vps) np ---- as a variant
GComplVPIVV vv vpi -> GComplVV_none (GUseV_v a t p (GLiftVV vv)) (GInfVP_none (onVPI2VP vpi))
GPassVPSlash vps -> onVPSlashPass t a p vps
GPassAgentVPSlash vps np -> onVPSlashPassAgent t a p vps np
---- ProgrVP : VP -> VP ;
---- ReflVP : VPSlash -> VP ;
---- SelfAdVVP : VP -> VP ;
---- SelfAdvVP : VP -> VP ;
onVPI2VP :: Tree GVPI_ -> Tree GPrVP_none_
onVPI2VP vpi = case vpi of
GMkVPI vp -> onVP GTPres GASimul GPPos vp
GConjVPI conj (GListVPI vs) -> GUseVPC_none (mkVPC conj [onVPI2VP v | v <- vs])
onVPSlash :: GTense -> GAnt -> GPol -> Tree GVPSlash_ -> Tree GPrVP_np_
onVPSlash t a p vps = case vps of
GSlashV2a v2 -> GUseV_np a t p (GLiftV2 v2)
GSlashV2S v2s s -> GSlashV2S_none (GUseV_np_s a t p (GLiftV2S v2s)) (onS2Cl s)
GSlashV2Q v2q q -> GSlashV2Q_none (GUseV_np_q a t p (GLiftV2Q v2q)) (onQS2QCl q)
GSlashV2A v2a ap -> GSlashV2A_none (GUseV_np_a a t p (GLiftV2A v2a)) (GLiftAP ap)
GSlashV2V v2v ant pol vp -> GSlashV2V_none (GUseV_np_v a t p (GLiftV2V v2v)) (GInfVP_none (onVP GTPres ant pol vp)) -- !!
GSlashVV vv vps -> GComplVV_np (GUseV_v a t p (GLiftVV vv)) (GInfVP_np (onVPSlash GTPres GASimul GPPos vps)) -- !!
--- GSlashSlashV2V vv ant pol vps -> GComplVV_np (GUseV_np_v a t p (GLiftV2V vv)) (GInfVP_np (onVPSlash GTPres ant pol vps))
GSlashVPIV2V v2v pol vpi -> GSlashV2V_none (GUseV_np_v a t p (GLiftV2V v2v)) (GInfVP_none (onVPI2VP vpi))
onVPSlashPass :: GTense -> GAnt -> GPol -> Tree GVPSlash_ -> Tree GPrVP_none_
onVPSlashPass t a p vps = case vps of
GSlashV2a v2 -> GPassUseV_none a t p (GLiftV2 v2)
GSlashV2S v2s s -> GComplVS_none (GPassUseV_s a t p (GLiftV2S v2s)) (onS2Cl s)
GSlashV2Q v2q q -> GComplVQ_none (GPassUseV_q a t p (GLiftV2Q v2q)) (onQS2QCl q)
---- GSlashV2A v2a ap -> (GPassUseV_np_a a t p (GLiftV2A v2a)) (GLiftAP ap)
---- GSlashV2V v2v ant pol vp -> (GPassUseV_np_v a t p (GLiftV2V v2v)) (GInfVP_none (onVP GTPres ant pol vp)) -- !!
-- GSlashVV vv vps -> GComplVV_np (GUseV_v a t p (GLiftVV vv)) (GInfVP_np (onVPSlash GTPres GASimul GPPos vps)) -- !!
onVPSlashPassAgent :: GTense -> GAnt -> GPol -> Tree GVPSlash_ -> GNP -> Tree GPrVP_none_
onVPSlashPassAgent t a p vps np = case vps of
GSlashV2a v2 -> GAgentPassUseV_none a t p (GLiftV2 v2) np
GSlashV2S v2s s -> GComplVS_none (GAgentPassUseV_s a t p (GLiftV2S v2s) np) (onS2Cl s)
onClSlash :: GTense -> GAnt -> GPol -> Tree GClSlash_ -> Tree GPrCl_np_
onClSlash t a p cls = case cls of
GSlashVP np vps -> GPredVP_np np (onVPSlash t a p vps)
GSlashPrep cl prep -> GAdvCl_np (GLiftPrep prep) (onCl t a p cl)
---- GSlashVS np vs sslash ->
---- GAdvSlash cls adv -> GAdvCl_none (GLiftAdv adv) (onClSlash t a p cls)
---- UseSlash : Temp -> Pol -> ClSlash -> SSlash ;
onS2Cl :: Tree GS_ -> Tree GPrCl_none_
onS2Cl s = case s of
GUseCl (GTTAnt t a) p cl -> onCl t a p cl
onQS2QCl :: Tree GQS_ -> Tree GPrQCl_none_
onQS2QCl s = case s of
GUseQCl (GTTAnt t a) p qcl -> onQCl t a p qcl

31
src/experimental/transfer/TrainFreq.hs
View File

@@ -1,31 +0,0 @@
import Data.List
import qualified Data.Map
main = do
ws <- readFile "new-trees.txt" >>= return . words
let freqs ws = Data.Map.fromListWith (+) [(w,1) | w <- ws]
let freqmap = freqs ws
fs <- readFile "all-ndfuns.txt" >>= return . lines
let catf ws = case ws of f:ty -> (f,last(init ty))
let catmap = Data.Map.fromList [catf (words f) | f <- fs]
let allist = [(f,(c,Data.Map.lookup f freqmap)) | (f,c) <- Data.Map.assocs catmap]
let catlist = Data.List.sortBy (\(f,(c,_)) (_,(k,_)) -> compare c k) allist
let gcatlist = Data.List.groupBy (\(f,(c,_)) (_,(k,_)) -> c==k) catlist
let fcatfreqs fcs = let cat = fst (snd (head fcs)) in let tot = sum [maybe 0 id mn | (f,(c,mn)) <- fcs] in [(f,maybe 0 id mn, cat, tot) | (f,(c,mn)) <- fcs]
let fcatfreqlist = map fcatfreqs gcatlist
let relprobs cat = [(f, (fromIntegral i+1 :: Double) / (fromIntegral tot :: Double)) | (f,i,c,t) <- cat, let tot = t + length cat]
-- writeFile "allFunFreqs.txt" $ unlines $ [unwords [f,show i,c,show t] | (f,i,c,t) <- concat fcatfreqlist]
writeFile "NDPredTrans.probs" $ unlines $ [unwords [f,show n] | (f,n) <- concatMap relprobs fcatfreqlist]

58
src/parametric/Parametric.gf
View File

@@ -1,58 +0,0 @@
interface Parametric = {
oper
-- primitive
S : Type ;
NP : Type ;
CN : Type ;
AP : Type ;
VPComp : Type ;
ITense : Type ;
CCase : Type ;
Agr : Type ;
V : Type ;
N : Type ;
A : Type ;
agrNP : NP -> Agr ;
PredVP : NP -> VP -> Cl ;
mkVPComp : (Agr => Str) -> Str -> Str -> VPComp ;
insertVPComp : VPComp -> VP -> VP ;
insertNP : CCase -> NP -> VP -> VP ;
iTense : Tense -> ITense ;
-- derived
Cl : Type = {s : ITense => Polarity => S} ;
VP : Type = {
verb : V ;
comp : VPComp
} ;
VPSlash : Type = VP ** {c : CComp} ;
UseV : V -> VP = \v -> {
verb = v ;
comp = mkVPComp (\\_ => []) [] []
} ;
SlashV : V -> (Agr => Str) -> Str -> Str -> CCase -> VPSlash =
\v,comp,adv,ext,c ->
insertVPComp (mkVPComp comp adv ext) (UseV v) ** {c = c} ;
ComplSlash : VPSlash -> NP -> VP = \vp,np -> insertNP vp.c np vp ;
UseCl : Tense -> Polarity -> Cl -> S = \t,p,cl -> cl.s ! iTense t ! p ;
}