mirror of
https://github.com/GrammaticalFramework/gf-rgl.git
synced 2026-06-14 17:40:12 -06:00
399 lines
14 KiB
Plaintext
399 lines
14 KiB
Plaintext
--# -path=.:../abstract:../common:../../prelude
|
||
--
|
||
--1 Persian auxiliary operations.
|
||
--
|
||
-- This module contains operations that are needed to make the
|
||
-- resource syntax work.
|
||
|
||
resource ResPes = MorphoPes ** open Prelude,Predef in {
|
||
|
||
flags optimize=all ;
|
||
coding = utf8;
|
||
|
||
param
|
||
Order = ODir | OQuest ;
|
||
PMood = Del | Imper | PCond ;
|
||
|
||
NPCase = NPC Ezafa ;
|
||
CardOrd = NCard | NOrd ;
|
||
RAgr = RNoAg | RAg Agr ;
|
||
-- RCase = RC Number Case ;
|
||
|
||
CPolarity = CPos
|
||
| CNeg Bool; -- contracted or not
|
||
|
||
oper
|
||
|
||
Compl : Type = {s : Str ; ra : Str ; c : VType} ;
|
||
CN : Type = Noun ** {hasAdj : Bool} ; -- for getting the right form when NP/CN is a predicate
|
||
NP : Type = {s : NPCase => Str ; a : Agr ; animacy : Animacy ; hasAdj : Bool} ;
|
||
VPHSlash : Type = VPH ** {c2 : Compl} ;
|
||
|
||
oper
|
||
contrNeg : Bool -> Polarity -> CPolarity = \b,p -> case p of {
|
||
Pos => CPos ;
|
||
Neg => CNeg b
|
||
} ;
|
||
|
||
cpol2pol : CPolarity -> Polarity = \cp -> case cp of {
|
||
CPos => Pos ;
|
||
_ => Neg
|
||
} ;
|
||
|
||
-----------------------
|
||
--- Verb Phrase
|
||
-----------------------
|
||
|
||
oper
|
||
|
||
VPH : Type = {
|
||
s : VPHForm => Str ; -- {inf : Str} ;
|
||
obj : {s : Str ; a : Agr} ;
|
||
subj : VType ;
|
||
comp : Agr => Str;
|
||
vComp : Agr => Str;
|
||
inf : Str;
|
||
ad : Str;
|
||
embComp : Str ;
|
||
wish : Bool ;
|
||
} ;
|
||
param
|
||
|
||
VPHForm =
|
||
VPTense Polarity VPPTense Agr -- 9 * 12
|
||
-- | VPReq
|
||
| VPImp Polarity Number
|
||
-- | VPReqFut
|
||
| VVForm Agr
|
||
| VPStem1
|
||
| VPStem2
|
||
;
|
||
|
||
VPHTense =
|
||
VPres -- impf hum nahim "I گْ"
|
||
| VPast -- impf Ta nahim "I weنت"
|
||
| VFut -- fut na/nahim "I سهلل گْ"
|
||
| VPerfPres -- perf hum na/nahim "I هوe گْنe"
|
||
| VPerfPast -- perf Ta na/nahim "I هد گْنe"
|
||
| VPerfFut
|
||
| VCondSimul
|
||
| VCondAnter -- subj na "I می گْ"
|
||
| VVVForm -- AR 21/3/2018 for mustCl after Nasrin
|
||
| VRoot1 -- AR 22/3/2018 for mustCl past after Nasrin
|
||
;
|
||
|
||
|
||
VType = VIntrans | VTrans | VTransPost ;
|
||
|
||
VPPTense =
|
||
VPPres Anteriority
|
||
|VPPast Anteriority
|
||
|VPFutr Anteriority
|
||
|VPCond Anteriority ;
|
||
oper
|
||
--s (Vvform (Ag Sg P1)) : بخوانم
|
||
|
||
|
||
predV : Verb -> VPH = \verb -> {
|
||
s = \\vh =>
|
||
case vh of {
|
||
VPTense pol (VPPres Simul) agr => verb.s ! VF pol (PPresent2 PrImperf) agr ;
|
||
VPTense pol (VPPres Anter) agr => verb.s ! VF pol (PPresent2 PrPerf) agr ;
|
||
VPTense pol (VPPast Simul) agr => verb.s ! VF pol (PPast2 PstAorist) agr ;
|
||
VPTense pol (VPPast Anter) agr => verb.s ! VF pol (PPast2 PstPerf) agr ;
|
||
VPTense pol (VPFutr Simul) agr => verb.s ! VF pol (PFut2 FtAorist) agr ;
|
||
VPTense pol (VPFutr Anter) agr => verb.s ! VF pol (PPresent2 PrPerf) agr ; -- this is to be confirmed
|
||
VPTense pol (VPCond Simul) agr => verb.s ! VF pol (PPast2 PstImperf) agr ;
|
||
VPTense pol (VPCond Anter) agr => verb.s ! VF pol (PPast2 PstImperf) agr ;
|
||
VVForm agr => verb.s ! Vvform agr ;
|
||
VPStem1 => verb.s ! Root1 ;
|
||
VPStem2 => verb.s ! Root2 ;
|
||
VPImp pol n =>verb.s ! Imp pol n };
|
||
obj = {s = [] ; a = defaultAgr} ;
|
||
subj = VIntrans ;
|
||
inf = verb.s ! Inf;
|
||
ad = [];
|
||
embComp = [];
|
||
wish = False ;
|
||
vComp = \\_ => [] ;
|
||
comp = \\_ => []
|
||
} ;
|
||
|
||
predVc : (Verb ** {c2,c1 : Str}) -> VPHSlash = \verb ->
|
||
predV verb ** {c2 = {s = verb.c1 ; ra = [] ; c = VTrans} } ;
|
||
----------------------
|
||
-- Verb Phrase complimantation
|
||
------------------------
|
||
{-
|
||
insertObject : NP -> VPHSlash -> VPH = \np,vps -> vps ** {
|
||
-- obj = {s = variants { vps.obj.s ++ np.s ++ vps.c2.s ; vps.obj.s ++ np.s } ; a = np.a} ;
|
||
obj = {s = case vps.c2.s of {
|
||
"را" => np.s ++ vps.c2.s ++ vps.obj.s;
|
||
_ => vps.c2.s ++ np.s ++ vps.obj.s
|
||
};
|
||
a = np.a} ;
|
||
subj = vps.c2.c ;
|
||
} ;
|
||
-}
|
||
insertObjc : (Agr => Str) -> VPHSlash -> VPHSlash = \obj,vp ->
|
||
insertObj obj vp ** {c2 = vp.c2} ;
|
||
insertVVc : (Agr => Str) -> VPHSlash -> VPHSlash = \obj,vp ->
|
||
insertVV obj vp ** {c2 = vp.c2} ;
|
||
|
||
{-
|
||
insertSubj : Person -> Str -> Str = \p,s ->
|
||
case p of { Pers1 => s ++ "wN" ; _ => s ++ "E"};
|
||
-}
|
||
insertObj : (Agr => Str) -> VPH -> VPH = \obj1,vp -> vp ** {
|
||
comp = \\a => vp.comp ! a ++ obj1 ! a
|
||
} ;
|
||
|
||
insertVV : (Agr => Str) -> VPH -> VPH = \obj1,vp -> vp ** {
|
||
wish = True ;
|
||
-- vComp = \\a => vp.comp ! a ++ conjThat ++ obj1 ! a ; -- TODO: do we insert conjThat here or in infVV? /IL
|
||
vComp = \\a => vp.comp ! a ++ obj1 ! a ;
|
||
} ;
|
||
|
||
insertObj2 : (Str) -> VPH -> VPH = \obj1,vp -> vp ** {
|
||
embComp = vp.embComp ++ obj1;
|
||
} ;
|
||
|
||
insertObj3 : (Str) -> VPH -> VPH = \obj1,vp -> vp ** {
|
||
obj = {s = obj1 ++ vp.obj.s ; a = vp.obj.a };
|
||
} ;
|
||
|
||
|
||
insertObjc2 : Str -> VPHSlash -> VPHSlash = \obj,vp ->
|
||
insertObj2 obj vp ** {c2 = vp.c2} ;
|
||
insertObjc3 : Str -> VPHSlash -> VPHSlash = \obj,vp ->
|
||
insertObj3 obj vp ** {c2 = vp.c2} ;
|
||
{-
|
||
infVP : Bool -> VPH -> Agr -> Str = \isAux,vp,a ->
|
||
vp.obj.s ++ vp.inf ++ vp.comp ! a ;
|
||
-}
|
||
|
||
---- AR 14/9/2017 trying to fix isAux = True case by inserting conjThat
|
||
---- but don't know yet how False should be affect
|
||
infVV : Bool -> VPH -> {s : Agr => Str} = \isAux,vp -> {
|
||
s = \\agr => case isAux of {
|
||
True => conjThat ++ vp.ad ++ vp.comp ! agr ++ vp.s ! VVForm agr ;
|
||
False => vp.ad ++ vp.comp ! agr ++ vp.s ! VVForm agr }
|
||
} ;
|
||
|
||
insertObjPre : (Agr => Str) -> VPHSlash -> VPH = \obj,vp -> vp ** {
|
||
-- comp = \\a => case vp.c2.s of {"را" => obj ! a ++ vp.c2.s ++ vp.comp ! a ; _ => vp.c2.s ++ obj ! a ++ vp.comp ! a} -- gives linking error
|
||
comp = \\a => vp.c2.s ++ obj ! a ++ vp.c2.ra ++ vp.comp ! a
|
||
} ;
|
||
|
||
insertAdV : Str -> VPH -> VPH = \ad,vp -> vp ** {
|
||
ad = vp.ad ++ ad ;
|
||
} ;
|
||
|
||
conjThat : Str = "که" ;
|
||
{- checkPron : NP -> Str -> Str = \np,str -> case (np.isPron) of {
|
||
True => np.s ! NPC Obl;
|
||
False => np.s ! NPC Obl ++ str} ;
|
||
|
||
insertEmbCompl : VPH -> Str -> VPH = \vp,emb -> vp ** {
|
||
embComp = vp.embComp ++ emb;
|
||
} ;
|
||
|
||
insertTrans : VPH -> VType -> VPH = \vp,vtype -> vp ** {
|
||
subj = case vtype of {VIntrans => VTransPost ; VTrans => VTrans ; _ => vtype} ; -- still some problem not working properly
|
||
} ;
|
||
-}
|
||
---------------------------
|
||
--- Clauses
|
||
---------------------------
|
||
Clause : Type = {s : VPHTense => Polarity => Order => Str} ;
|
||
SlClause : Type = {quest : Order => Str ; subj : Str ; vp : VPHTense => Polarity => Order => Str} ;
|
||
|
||
---- AR 18/9/2017 intermediate SClause to preserve SOV in e.g. QuestionPes.QuestSlash
|
||
|
||
clTable : VPH -> (Agr => VPHTense => Polarity => Str) = \vp ->
|
||
\\agr,vt,b => case <b,vt> of {
|
||
<Pos,VPres> => vp.s ! VPTense Pos (VPPres Simul) agr ;
|
||
<Neg,VPres> => vp.s ! VPTense Neg (VPPres Simul) agr ;
|
||
<Pos,VPerfPres> => vp.s ! VPTense Pos (VPPres Anter) agr ;
|
||
<Neg,VPerfPres> => vp.s ! VPTense Neg (VPPres Anter) agr ;
|
||
<Pos,VPast> => vp.s ! VPTense Pos (VPPast Simul) agr ;
|
||
<Neg,VPast> => vp.s ! VPTense Neg (VPPast Simul) agr ;
|
||
<Pos,VPerfPast> => vp.s ! VPTense Pos (VPPast Anter) agr ;
|
||
<Pos,VFut> => case vp.wish of {
|
||
True => vp.s ! VPTense Pos (VPPres Simul) agr ;
|
||
False => vp.s ! VPTense Pos (VPFutr Simul) agr };
|
||
<Pos,VPerfFut> => case vp.wish of {
|
||
True => vp.s ! VPTense Pos (VPPres Anter) agr ;
|
||
False => vp.s ! VPTense Pos (VPFutr Anter) agr }; -- verb form need to be confirmed
|
||
<Neg,VPerfPast> => vp.s ! VPTense Neg (VPPast Anter) agr ;
|
||
<Neg,VFut> => case vp.wish of {
|
||
True => vp.s ! VPTense Neg (VPPres Simul) agr ;
|
||
False => vp.s ! VPTense Neg (VPFutr Simul) agr };
|
||
<Neg,VPerfFut> => case vp.wish of {
|
||
True => vp.s ! VPTense Neg (VPPres Anter) agr ;
|
||
False => vp.s ! VPTense Neg (VPFutr Anter) agr }; -- verb form need to be confirmed
|
||
<Pos,VCondSimul> => vp.s ! VPTense Pos (VPCond Simul) agr ;
|
||
<Pos,VCondAnter> => vp.s ! VPTense Pos (VPCond Anter) agr; -- verb form to be confirmed
|
||
<Neg,VCondSimul> => vp.s ! VPTense Neg (VPCond Simul) agr ;
|
||
<Neg,VCondAnter> => vp.s ! VPTense Neg (VPCond Anter) agr ; -- verb form to be confirmed
|
||
<_, VVVForm> => vp.s ! VVForm agr ; -- AR 21/3/2018
|
||
<_, VRoot1> => vp.s ! VPStem1 {- ++ Predef.Bind ++ "ه" -} -- AR 22/3/2018
|
||
};
|
||
|
||
mkClause : NP -> VPH -> Clause = \np,vp ->
|
||
let cls = mkSlClause np vp
|
||
in {s = \\vt,b,ord => cls.quest ! ord ++ cls.subj ++ cls.vp ! vt ! b ! ord} ;
|
||
|
||
mkSlClause : NP -> VPH -> SlClause = \np,vp -> {
|
||
quest = table
|
||
{ ODir => [];
|
||
OQuest => "آیا" } ;
|
||
subj = np.s ! NPC bEzafa ;
|
||
vp = \\vt,b,ord =>
|
||
let vps = clTable vp ! np.a ! vt ! b
|
||
in vp.ad ++ vp.comp ! np.a ++ vp.obj.s ++ vps ++ vp.vComp ! np.a ++ vp.embComp
|
||
};
|
||
|
||
--Clause : Type = {s : VPHTense => Polarity => Order => Str} ;
|
||
mkSClause : Str -> Agr -> VPH -> Clause = \subj,agr,vp -> {
|
||
s = \\vt,b,ord =>
|
||
let vps = clTable vp ! agr ! vt ! b ;
|
||
quest = case ord of { ODir => [] ; OQuest => "آیا" }
|
||
in quest ++ subj ++ vp.ad ++ vp.comp ! agr ++ vp.obj.s ++ vps ++ vp.vComp ! agr ++ vp.embComp
|
||
};
|
||
|
||
predAux : Aux -> VPH = \verb -> {
|
||
s = \\vh => case vh of {
|
||
VPTense pol (VPPres Simul) agr => verb.inf ! AX pol (AuxPresent PrImperf) agr ;
|
||
VPTense pol (VPPres Anter) agr => verb.inf ! AX pol (AuxPresent PrPerf) agr ;
|
||
VPTense pol (VPPast Simul) agr => verb.inf ! AX pol (AuxPast PstAorist) agr ;
|
||
VPTense pol (VPPast Anter) agr => verb.inf ! AX pol (AuxPresent PrPerf) agr ;
|
||
VPTense pol (VPFutr Simul) agr => verb.inf ! AX pol (AuxFut FtAorist) agr ;
|
||
VPTense pol (VPFutr Anter) agr => verb.inf ! AX pol (AuxFut FtAorist) agr ; -- this is to be confirmed
|
||
VPTense pol (VPCond Simul) agr => verb.inf ! AX pol (AuxFut FtAorist) agr ;
|
||
VPTense pol (VPCond Anter) agr => verb.inf ! AX pol (AuxPast PstImperf) agr ;
|
||
VVForm agr => []; -- to be checked => verb.s ! Vvform agr ;
|
||
VPStem1 => [];
|
||
VPStem2 => "بود" ;
|
||
VPImp _ _ => [] -- need to be confirmed
|
||
-- _ => []
|
||
};
|
||
obj = {s = [] ; a = defaultAgr} ;
|
||
subj = VIntrans ;
|
||
inf = "بودن";
|
||
ad = [];
|
||
embComp = [];
|
||
wish = False ;
|
||
vComp = \\_ => [] ;
|
||
comp = \\_ => []
|
||
} ;
|
||
|
||
Aux = {
|
||
inf : AuxForm => Str ;
|
||
} ;
|
||
|
||
auxBe : Aux = {
|
||
inf = table {
|
||
AX pol tense ag => mkAux pol tense ag
|
||
} ;
|
||
} ;
|
||
|
||
-- TODO: find out how much overlap with beVerb in MorphoPes /IL
|
||
mkAux : Polarity -> AuxTense -> Agr -> Str = \pol,t,ag ->
|
||
let bodh = "بوده" ;
|
||
nbodh = "نبوده" ;
|
||
hast = "هست" ;
|
||
nhast = "نیست" ;
|
||
bod = "بود" ;
|
||
khah = "خواه" ;
|
||
nbod = "نبود" ;
|
||
nkhah = "نخواه" ;
|
||
impfSuff : Str -> Str = imperfectSuffix ag ;
|
||
impfSuffD : Str -> Str = imperfectSuffixD ag ;
|
||
perfSuff : Str -> Str = perfectSuffix ag
|
||
in case <pol,t,ag> of {
|
||
<Pos,AuxPresent PrImperf,Ag Sg P3> => "است" ;
|
||
<Pos,AuxPresent PrImperf> => impfSuff hast ;
|
||
<Pos,AuxPresent PrPerf> => perfSuff bodh ;
|
||
|
||
<Pos,AuxPast PstPerf> => [] ;
|
||
<Pos,AuxPast PstImperf> => zwnj "می" (impfSuff bod) ;
|
||
<Pos,AuxPast PstAorist> => impfSuff bod ;
|
||
|
||
<Pos,AuxFut FtAorist> => impfSuffD khah ++ bod ;
|
||
|
||
-- negatives
|
||
<Neg,AuxPresent PrImperf> => impfSuff nhast ;
|
||
<Neg,AuxPresent PrPerf> => perfSuff nbodh ;
|
||
|
||
<Neg,AuxPast PstPerf> => [] ;
|
||
<Neg,AuxPast PstImperf> => zwnj "نمی" (impfSuff bod) ;
|
||
<Neg,AuxPast PstAorist> => impfSuff nbod ;
|
||
|
||
<Neg,AuxFut FtAorist> => impfSuffD nkhah ++ bod
|
||
} ;
|
||
|
||
param
|
||
AuxTense = AuxPresent PrAspect | AuxPast PstAspect | AuxFut FtAspect ;
|
||
AuxForm = AX Polarity AuxTense Agr ;
|
||
|
||
|
||
oper
|
||
|
||
predProg : VPH -> VPH = \verb -> verb ** {
|
||
s = \\vh => case vh of {
|
||
VPTense pol (VPPres Simul) agr => toHave Pos (PPresent2 PrImperf) agr ++ verb.s ! VPTense pol (VPPres Simul) agr ;
|
||
VPTense pol (VPPast Simul) agr => toHave Pos (PPast2 PstAorist) agr ++ verb.s ! VPTense pol (VPCond Simul) agr ;
|
||
VPTense pol (VPCond Simul) agr => toHave Pos (PPast2 PstAorist) agr ++ verb.s ! VPTense pol (VPCond Simul) agr ;
|
||
VPTense pol (VPCond Anter) agr => toHave Pos (PPast2 PstAorist) agr ++ verb.s ! VPTense pol (VPCond Anter) agr ;
|
||
-- VPTense pol (VPFutr Anter) agr => verb.s ! VPTense pol (VPFutr Anter) agr ; -- this is to be confirmed
|
||
_ => verb.s ! vh } ;
|
||
subj = VIntrans
|
||
} ;
|
||
|
||
|
||
|
||
IndefArticle : Str ;
|
||
IndefArticle = "یک";
|
||
taryn : Str ;
|
||
taryn = "ترین" ;
|
||
|
||
-----------------------------
|
||
-- Noun Phrase
|
||
-----------------------------
|
||
{-toNP : Str -> Str = \pn, npc -> case npc of {
|
||
NPC c => pn ! c ;
|
||
NPObj => pn ! Dir ;
|
||
NPErg => pn ! Obl
|
||
} ;
|
||
-}
|
||
|
||
partNP : Str -> Str = \str -> (Prelude.glue str "ه") ++ "شده" ;
|
||
-- partNP : Str -> Str = \str -> str + "ه" ++ "شده" ;
|
||
|
||
|
||
-----------------------------------
|
||
-- Reflexive Pronouns
|
||
-----------------------------------
|
||
|
||
reflPron : Agr => Str = table {
|
||
Ag Sg P1 => "خودم" ;
|
||
Ag Sg P2 => "خودت" ;
|
||
Ag Sg P3 => "خودش" ;
|
||
Ag Pl P1 => "خودمان" ;
|
||
Ag Pl P2 => "خودتان" ;
|
||
Ag Pl P3 => "خودشان"
|
||
|
||
} ;
|
||
|
||
getPron : Animacy -> Number -> Str = \ani,number ->
|
||
case <ani,number> of {
|
||
<Animate,Sg> => "او" ;
|
||
<Animate,Pl> => zwnj "آن" "ها" ;
|
||
<Inanimate,Sg> => "آن" ;
|
||
<Inanimate,Pl> => zwnj "آن" "ها"
|
||
};
|
||
|
||
|
||
}
|