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

Merge pull request #188 from inariksit/persian

Browse Source 
(Pes) restructuring V, VV, VP + WIP vowels for TTS
This commit is contained in:
Inari Listenmaa
2019-02-26 17:16:12 +01:00
committed by GitHub
parent f840f6aaff 51eb1dbb1a
commit e7634e9b6c
9 changed files with 243 additions and 239 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/persian/CatPes.gf
View File

@@ -82,8 +82,8 @@ concrete CatPes of Cat = CommonX - [Adv] ** open ResPes, Prelude in {
V2, V2A, V2Q, V2S = ResPes.Verb ** {c2 : Compl} ; V2, V2A, V2Q, V2S = ResPes.Verb ** {c2 : Compl} ;
V3 = ResPes.Verb ** {c2, c3 : Compl} ; V3 = ResPes.Verb ** {c2, c3 : Compl} ;
VV = ResPes.Verb ** {isAux : Bool} ; VV = ResPes.VV ;
V2V = ResPes.Verb ** {c1 : Str ; c2 : Str ; isAux : Bool} ; V2V = ResPes.VV ** {c1 : Str ; c2 : Str} ;
A = ResPes.Adjective ; A = ResPes.Adjective ;
A2 = ResPes.Adjective ** {c2 : Str} ; A2 = ResPes.Adjective ** {c2 : Str} ;

6
src/persian/IdiomPes.gf
View File

@@ -30,8 +30,10 @@ lin
ProgrVP vp = predProg vp ; ProgrVP vp = predProg vp ;
ImpPl1 vp = {s = "بیایید" ++ vp.s ! Vvform (agrP1 Pl)} ; ImpPl1 vp = let a = agrP1 Pl in
ImpP3 np vp = {s = "بگذارید" ++ np.s!Bare ++ vp.s ! Vvform np.a}; {s = "بیایید" ++ showVPH (VSubj Pos a) a vp } ;
ImpP3 np vp =
{s = "بگذارید" ++ np.s ! Bare ++ showVPH (VSubj Pos np.a) np.a vp};
} }

247
src/persian/MorphoPes.gf
View File

@@ -21,6 +21,11 @@ oper
ZWNJ : Str = "‌" ; ZWNJ : Str = "‌" ;
zwnj : Str -> Str -> Str = \s1,s2 -> s1 + ZWNJ + s2 ; zwnj : Str -> Str -> Str = \s1,s2 -> s1 + ZWNJ + s2 ;
-- kasre : Str = "ِ" ; -- To enable vowels for TTS input
-- fatha : Str = "َ" ;
kasre,fatha : Str = [] ;
---- Nouns ---- Nouns
param param
Animacy = Animate | Inanimate ; Animacy = Animate | Inanimate ;
@@ -55,21 +60,17 @@ oper
oper oper
mkPossStem : Str -> Str = \str -> mkPossStem : Str -> Str = \str ->
case str of {
case str of { _ + ("اه"|"او"|"وه")
_+ "اه" => str ; => str + fatha ;
_+ "او" => str ; _ + ("ا"|"و") => str + fatha + "ی" ;
_+ "وه" => str ; _ + "ه" => zwnj str "ا" ;
_+ ("ا"|"و") => str + "ی" ; _ => str + fatha } ;
_+ "ه" => zwnj str "ا" ;
_ => str } ;
mkEzafe : Str -> Str = \str -> mkEzafe : Str -> Str = \str ->
--let kasre = "ِ" in -- TODO: Eventually use this
let kasre = "" in
case str of { case str of {
st + "اه" => str + kasre ; st + "اه" => str + kasre ;
st + "وه" => str + kasre ; st + "وه" => str + kasre ;
@@ -142,36 +143,67 @@ Determiner : Type = {s : Str ; n :Number ; isNum : Bool ; mod : Mod} ;
-- Verbs -- Verbs
------------------------------------------------------------------ ------------------------------------------------------------------
param param
VerbForm = VF Polarity VTense Agr VerbForm = Inf -- kardan
| Vvform Agr | PastStem -- kard -- Also used for future stem
| Imp Polarity Number | PresStem -- kon -- Also imperative stem
| Inf | Root1 | Root2 ; | PerfStem -- kardeh -- Perfect, pluperfect
VTense = VFPres PrAspect | PastPart -- konandeh
| VFPast PstAspect | ImpPrefix Polarity -- mi/nmi, except for be and have
| VFFut FtAspect | VAor Polarity Agr -- konam
| VFInfrPast InfrAspect; | VPerf Polarity Agr -- kardeh am/nkardeh am
PrAspect = PrPerf | PrImperf ; | VPast Polarity Agr -- kardam/nkardam
PstAspect = PstPerf | PstImperf | PstAorist ; | VSubj Polarity Agr -- bekonam/nakonam
FtAspect = FtAorist ; -- just keep FtAorist | VImp Polarity Number -- bekon,bekonid/nakon,nakonid
InfrAspect = InfrPerf | InfrImperf ; ;
oper oper
Verb = {s : VerbForm => Str} ; impRoot : Str -> Str = \root -> case root of {
st + "ی" => st ;
_ => root
};
mkVerb : (x1,x2 : Str) -> Verb = \inf,root2 -> mkVerb : (inf,pres : Str) -> Verb = \kardan,kon -> {
let root1 = tk 1 inf ; s = table {
impRoot = impRoot root2 Inf => kardan ;
in { s = table { PastStem => kard ;
Root1 => root1 ; PresStem => kon ;
Root2 => root2 ; PerfStem => kardeh ;
Inf => inf ; PastPart => kon + "نده" ;
Imp Pos Sg => addBh impRoot ; ImpPrefix Pos => "می" + ZWNJ ++ BIND ;
Imp Pos Pl => addBh impRoot + "ید" ; ImpPrefix Neg => "نمی" + ZWNJ ++ BIND ;
Imp Neg Sg => "ن" + impRoot ; VAor _ agr => imperfectSuffixD agr kon ; -- for reg verbs, negation comes from prefix
Imp Neg Pl => "ن" + impRoot + "ید" ; VPerf pol agr => perfectSuffix agr (addN pol kardeh) ;
Vvform ag => mkvVform root2 ag ; VPast pol agr => imperfectSuffix agr (addN pol kard) ;
VF p t ag => mkCmnVF root1 root2 p t ag } VSubj Pos agr => addBh (imperfectSuffixD agr kon) ;
} ; VSubj Neg agr => addN (imperfectSuffixD agr kon) ;
VImp Pos Sg => addBh imp ;
VImp Pos Pl => addBh imp + "ید" ;
VImp Neg Sg => addN imp ;
VImp Neg Pl => addN imp + "ید" } ;
prefix = [] -- For compound verbs
} where {
kard = tk 1 kardan ;
kardeh = kard + "ه" ;
imp = impRoot kon ;
} ;
invarV : (inv : Str) -> Verb = \s -> -- truly invariable
let invReg = defectiveVerb s s s in invReg **
{s = table {ImpPrefix p => invReg.s ! ImpPrefix p ; _ => s}} ;
defectiveVerb : (inf,pres,past : Str) -> Verb = \bayestan,bayad,bayest ->
let invReg = mkVerb bayestan bayad in invReg **
{s = \\vf => case vf of {
VAor pol _ => addN pol bayad ;
VImp pol _ => addN pol bayad ;
VSubj pol _ => addN pol bayad ;
VPast pol _ => addN pol bayest ;
VPerf pol _ => addN pol bayest ;
_ => invReg.s ! vf }
} ;
--
oper
Verb = {s : VerbForm => Str ; prefix : Str} ;
-- Verbs that end in یدن, ادن or ودن -- Verbs that end in یدن, ادن or ودن
-- Also some verbs that don't: دانستن with stem دان -- Also some verbs that don't: دانستن with stem دان
@@ -180,67 +212,16 @@ oper
-- Most verbs that end in C+تن or C+دن -- Most verbs that end in C+تن or C+دن
mkVerb2 : (_: Str) -> Verb = \inf -> mkVerb inf (tk 2 inf) ; mkVerb2 : (_: Str) -> Verb = \inf -> mkVerb inf (tk 2 inf) ;
mkCmnVF : Str -> Str -> Polarity -> VTense -> Agr -> Str = \root1,root2,pol,t,ag ->
let khordh = root1 + "ه";
nkhordh = addN khordh ;
mekhor = zwnj "می" root2 ;
nmekhor = zwnj "نمی" root2 ;
mekhord = zwnj "می" root1 ;
nmekhord = zwnj "نمی" root1 ;
mekhordh = zwnj "می" khordh ;
nmekhordh = zwnj "نمی" khordh ;
khah = "خواه" ;
nkhah = "نخواه" ;
-- mekhah = zwnj "می" khah ;
-- nmekhah = zwnj "نمی" khah ;
bvdh = "بوده" ;
impfSuff : Str -> Str = imperfectSuffix ag ;
impfSuffD : Str -> Str = imperfectSuffixD ag ;
perfSuff : Str -> Str = perfectSuffix ag ;
pluperfSuff : Str -> Str = pluperfectSuffix ag
in case <pol,t> of {
<Pos,VFPres PrImperf> => impfSuffD mekhor ;
<Pos,VFPres PrPerf> => perfSuff khordh ;
<Pos,VFPast PstPerf> => pluperfSuff khordh ;
<Pos,VFPast PstImperf> => impfSuff mekhord ;
<Pos,VFPast PstAorist> => impfSuff root1 ;
<Pos,VFFut FtAorist> => impfSuffD khah ++ root1;
<Pos,VFInfrPast InfrPerf> => khordh ++ perfSuff bvdh ;
<Pos,VFInfrPast InfrImperf> => perfSuff khordh ;
-- negatives
<Neg,VFPres PrImperf> => impfSuffD nmekhor ;
<Neg,VFPres PrPerf> => perfSuff nkhordh ;
<Neg,VFPast PstPerf> => pluperfSuff nkhordh ;
<Neg,VFPast PstImperf> => impfSuff nmekhord ;
<Neg,VFPast PstAorist> => impfSuff (addN root1) ;
<Neg,VFFut FtAorist> => impfSuffD nkhah ++ root1 ;
<Neg,VFInfrPast InfrPerf> => nkhordh ++ perfSuff bvdh ;
<Neg,VFInfrPast InfrImperf> => perfSuff nmekhordh
-- <Pos,VFFut FtImperf> => perfSuffD mekhah ++ addBh (perfSuffD root2) ;
-- <Neg,VFFut FtImperf> => perfSuffD nmekhah ++ addBh (perfSuffD root2) ;
} ;
mkvVform : Str -> Agr -> Str = \root2,ag ->
addBh (imperfectSuffixD ag root2) ;
impRoot : Str -> Str = \root -> case root of {
st + "ی" => st ;
_ => root
};
------------------- -------------------
-- making negatives -- making negatives
------------------- -------------------
addN : Str -> Str ; addN = overload {
addN str = addN : Str -> Str = addN' ;
addN : Polarity -> Str -> Str = \p,s ->
case p of {Pos => s ; Neg => addN' s}
} ;
addN' : Str -> Str = \str ->
case str of { case str of {
"ا" + st => "نی" + str ; "ا" + st => "نی" + str ;
"آ" + st => "نیا" + st ; "آ" + st => "نیا" + st ;
@@ -293,60 +274,34 @@ oper
Ag Pl P2 => zwnj s "اید" ; Ag Pl P2 => zwnj s "اید" ;
Ag Pl P3 => zwnj s "اند" } ; Ag Pl P3 => zwnj s "اند" } ;
pluperfectSuffix : Agr -> Str -> Str = \ag,s -> s ++ pluperfAux : Polarity -> Agr -> Str = \pol,agr ->
case ag of { -- not suffix, just using consistent naming scheme :-P /IL addN pol (imperfectSuffix agr "بود") ;
Ag Sg P1 => "بودم" ;
Ag Sg P2 => "بودی" ;
Ag Sg P3 => "بود" ;
Ag Pl P1 => "بودیم" ;
Ag Pl P2 => "بودید" ;
Ag Pl P3 => "بودند" } ;
futAux : Polarity -> Agr -> Str = \pol,agr ->
addN pol (imperfectSuffixD agr "خواه") ;
subjAux : Polarity -> Agr -> Str = \pol,agr ->
addN pol (imperfectSuffixD agr "باش") ;
---------------------------------- ----------------------------------
-- Irregular verbs -- Irregular verbs
---------------------------------- ----------------------------------
haveVerb : Verb = {s = table { haveVerb : Verb = haveRegV ** {s = table {
Root1 => "داشت" ; ImpPrefix _ => [] ;
Root2 => "دار" ; vf => haveRegV.s ! vf }
Inf => "داشتن" ; } where { haveRegV = mkVerb "داشتن" "دار" } ;
Imp Pos Sg => "بدار" ;
Imp Pos Pl => "بدارید" ; beVerb : Verb = beRegV ** {s = table {
Imp Neg Sg => "ندار" ; ImpPrefix _ => [] ;
Imp Neg Pl => "ندارید" ; VAor Pos (Ag Sg P3) => "است" ;
Vvform agr => mkvVform "دار" agr ; VAor Pos agr => imperfectSuffix agr "هست" ;
VF pol tense agr => case <pol,tense> of { VAor Neg agr => imperfectSuffix agr "نیست" ;
<Pos,VFPres PrImperf> => imperfectSuffixD agr "دار" ; VSubj pol agr => addN pol (imperfectSuffixD agr "باش") ;
<Neg,VFPres PrImperf> => imperfectSuffixD agr (addN "دار") ; VImp Pos Sg => "باش" ;
_ => mkCmnVF "داشت" "دار" pol tense agr VImp Pos Pl => "باشید" ;
} VImp Neg Sg => "نباش" ;
} VImp Neg Pl => "نباشید" ;
} ; vf => beRegV.s ! vf }
} where { beRegV = mkVerb "بودن" "باش" } ;
-- TODO: merge with auxBe in ResPes
beVerb : Verb = { s = table {
Vvform agr => imperfectSuffixD agr "باش" ;
Imp Pos Sg => "باش" ;
Imp Pos Pl => "باشید" ;
Imp Neg Sg => "نباش" ;
Imp Neg Pl => "نباشید" ;
Inf => "بودن" ;
Root1 => "بود" ;
Root2 => "باش" ;
VF pol tense agr =>
let impfSuff = imperfectSuffix agr ;
perfSuff = perfectSuffix agr
in case <pol,tense,agr> of {
<Pos,VFPres PrImperf,Ag Sg P3> => "است" ;
<Neg,VFPres PrImperf,Ag Sg P3> => "نیست" ;
<Pos,VFPres PrImperf> => impfSuff "هست" ;
<Neg,VFPres PrImperf> => impfSuff "نیست" ;
<Pos,VFPres PrPerf> => perfSuff "بوده" ;
<Neg,VFPres PrPerf> => perfSuff "نبوده" ;
<Pos,VFPast PstImperf> => impfSuff "بود" ;
<Neg,VFPast PstImperf> => impfSuff "نبود" ;
_ => mkCmnVF "بود" "باش" pol tense agr
}
}
} ;
} }

2
src/persian/NounPes.gf
View File

@@ -23,7 +23,7 @@ concrete NounPes of Noun = CatPes ** open ResPes, Prelude in {
} ; } ;
PPartNP np v2 = np ** { PPartNP np v2 = np ** {
s = \\ez => np.s ! ez ++ partNP (v2.s ! Root1) s = \\ez => np.s ! ez ++ partNP v2
} ; } ;
RelNP np rs = np ** { RelNP np rs = np ** {

41
src/persian/ParadigmsPes.gf
View File

@@ -24,6 +24,10 @@ oper
singular : Number ; -- e.g. mkConj "یا" singular singular : Number ; -- e.g. mkConj "یا" singular
plural : Number ; -- e.g. mkConj "و" plural plural : Number ; -- e.g. mkConj "و" plural
VVForm : Type ; -- Argument to mkVV
subjunctive : VVForm ; -- The verbal complement of VV is in subjunctive
indicative : VVForm ; -- The verbal complement of VV is in indicative
--2 Nouns --2 Nouns
mkN : overload { mkN : overload {
@@ -88,6 +92,15 @@ oper
= \s1, s2 -> lin V (mkVerb s1 s2) = \s1, s2 -> lin V (mkVerb s1 s2)
} ; } ;
compoundV : overload {
compoundV : Str -> V -> V -- Invariable prefix to a verb, e.g. compoundV "دوست" haveVerb
} ;
invarV : Str -> V -- no inflection at all
= \s -> lin V (M.invarV s);
defV : (inf,pres,past : Str) -> V -- no personal forms, but past/present difference, like بایستن ('must'),
= \i,pr,pa -> lin V (M.defectiveVerb i pr pa) ;
haveVerb : V -- The verb "have", to be used for light verb constructions: e.g. compoundV "دوست" haveVerb. NB. this has different imperative and VV forms from StructuralPes.have_V2. haveVerb : V -- The verb "have", to be used for light verb constructions: e.g. compoundV "دوست" haveVerb. NB. this has different imperative and VV forms from StructuralPes.have_V2.
= lin V M.haveVerb ; = lin V M.haveVerb ;
beVerb : V -- The verb "be", to be used for light verb constructions: e.g. compoundV "عاشق" beVerb. beVerb : V -- The verb "be", to be used for light verb constructions: e.g. compoundV "عاشق" beVerb.
@@ -99,20 +112,22 @@ oper
mkV2 : (listen : V) -> (to : Prep) -> V2 -- V2 out of V. Use given preposition, no را for direct object. mkV2 : (listen : V) -> (to : Prep) -> V2 -- V2 out of V. Use given preposition, no را for direct object.
} ; } ;
mkV3 : V -> (dir,indir : Str) -> V3 ; -- Takes a verb and two prepositions as strings (can be empty). If the verb takes را for direct object, it's the first Str argument. e.g. talk, با, دربارۀ mkV3 : V -> (dir,indir : Str) -> V3 ; -- Takes a verb and two prepositions as strings (can be empty). If the verb takes را for direct object, it's the first Str argument. e.g. talk, با, دربارۀ
mkV3 v p q = lin V3 (v ** {c2 = prepOrRa p ; c3 = prepOrRa q}) ; mkV3 v p q = lin V3 (v ** {c2 = prepOrRa p ; c3 = prepOrRa q}) ;
mkV2V : V -> (cV, cN : Str) -> (isAux : Bool) -> V2V ; -- Verb, complementiser for the verb, complementiser for the noun, whether it's auxiliary. mkVV = overload {
mkV2V v s1 s2 b = lin V2V (v ** {isAux = b ; c1 = s1 ; c2 = s2}) ; mkVV : V -> VV -- takes its VP complement in subjunctive. Is auxiliary.
= \v -> v ** {isAux = True ; compl = subjunctive ; isDef = False} ;
-- compund verbs mkVV : VVForm -> V -> VV -- takes its VP complement in the given VVForm
compoundV : overload { = \vvf,v -> v ** {isAux = True ; compl = vvf ; isDef = False} ;
compoundV : Str -> V -> V -- Invariable prefix to a verb, e.g. compoundV "دوست" haveVerb mkVV : (isAux : Bool) -> VVForm -> V -> VV -- takes its VP complement in the given VVForm. Whether it's auxiliary (T/F) given as the first argument.
= \isAux,vvf,v -> v ** {isAux = isAux ; compl = vvf ; isDef = False}
} ; } ;
invarV : Str -> V -- for verbs like بایستن ('must'), which don't inflect mkV2V : V -> (cV, cN : Str) -> (isAux : Bool) -> V2V -- Verb, complementiser for the verb, complementiser for the noun, whether it's auxiliary.
= \s -> lin V {s = \\_ => s} ; = \v,s1,s2,b -> let vv : VV = mkVV b subjunctive v in
lin V2V (vv ** {c1 = s1 ; c2 = s2}) ;
----2 Adverbs ----2 Adverbs
mkAdv : Str -> Adv -- Takes a string, returns an adverb. mkAdv : Str -> Adv -- Takes a string, returns an adverb.
@@ -162,6 +177,10 @@ oper
animate = human ; animate = human ;
inanimate = nonhuman ; inanimate = nonhuman ;
VVForm = ResPes.VVForm ;
subjunctive = ResPes.Subj ;
indicative = Indic ;
-- Removed mkV_1, mkV_2, mkN01 and mkN02 from public API, still available for -- Removed mkV_1, mkV_2, mkN01 and mkN02 from public API, still available for
-- any applications that open ParadigmsPes. /IL 2019-02-08 -- any applications that open ParadigmsPes. /IL 2019-02-08
mkV_1 : Str -> V mkV_1 : Str -> V
@@ -240,9 +259,9 @@ oper
compoundV = overload { compoundV = overload {
compoundV : Str -> V -> V compoundV : Str -> V -> V
= \s,v -> v ** {s = \\vf => s ++ v.s ! vf} ; = \s,v -> v ** {prefix = s} ;
compoundV : Str -> V2 -> V -- hidden from public API compoundV : Str -> V2 -> V -- hidden from public API
= \s,v -> lin V {s = \\vf => s ++ v.s ! vf} ; = \s,v -> lin V (v ** {prefix = s}) ;
}; };
regV : Str -> V = \inf -> regV : Str -> V = \inf ->

119
src/persian/ResPes.gf
View File

@@ -55,22 +55,36 @@ resource ResPes = MorphoPes ** open Prelude,Predef in {
----------------------- -----------------------
--- Verb Phrase --- Verb Phrase
----------------------- -----------------------
param
VVForm = Indic | Subj ;
oper oper
VPH : Type = { VV : Type = Verb ** {
s : VerbForm => Str ; isAux : Bool ;
compl : VVForm ; -- indicative or subjunctive
isDef : Bool -- defective verb forms don't get same inflection
} ;
VPH : Type = Verb ** {
comp : Agr => Str; -- complements of a verb, agr for e.g. CompCN "I am human/we are humans" comp : Agr => Str; -- complements of a verb, agr for e.g. CompCN "I am human/we are humans"
vComp : Agr => Str; -- when a verb is used as a complement of an auxiliary verb. Unlike ‘comp’ or ‘obj’, this type of complement follows the auxiliary verb. vComp : Agr => Anteriority => Str; -- when a verb is used as a complement of an auxiliary verb. Unlike ‘comp’ or ‘obj’, this type of complement follows the auxiliary verb.
obj : Str ; -- object of a verb; so far only used for A ("paint it black") obj : Str ; -- object of a verb; so far only used for A ("paint it black")
subj : VType ; subj : VType ;
ad : Str ; ad : Str ;
embComp : Str ; -- when a declarative or interrogative sentence is used as a complement of a verb. embComp : Str ; -- when a declarative or interrogative sentence is used as a complement of a verb.
wish : Bool ; -- whether a VV has been added defVV : Bool ; -- whether a defective VV has been added
} ; } ;
showVPH : VerbForm -> Agr -> VPH -> Str = \vf,agr,vp -> showVPH = overload {
vp.ad ++ vp.comp ! agr ++ vp.obj ++ vp.s ! vf ++ vp.vComp ! agr ++ vp.embComp ; showVPH : VerbForm -> Agr -> VPH -> Str = showVPH' Simul ;
showVPH : Anteriority -> VerbForm -> Agr -> VPH -> Str = showVPH'
} ;
showVPH' : Anteriority -> VerbForm -> Agr -> VPH -> Str =
\ant,vf,agr,vp -> vp.ad ++ vp.comp ! agr ++ vp.obj
++ vp.prefix ++ vp.s ! vf
++ vp.vComp ! agr ! ant ++ vp.embComp ;
Compl : Type = {s : Str ; ra : Str} ; Compl : Type = {s : Str ; ra : Str} ;
@@ -93,9 +107,9 @@ oper
ad, ad,
obj, obj,
embComp = []; embComp = [];
wish = False ; defVV = False ;
comp, comp = \\_ => [] ;
vComp = \\_ => [] } ; vComp = \\_,_ => [] } ;
predVc : (Verb ** {c2,c1 : Str}) -> VPHSlash = \verb -> predVc : (Verb ** {c2,c1 : Str}) -> VPHSlash = \verb ->
predV verb ** {c2 = {s = verb.c1 ; ra = []} } ; predV verb ** {c2 = {s = verb.c1 ; ra = []} } ;
@@ -116,9 +130,10 @@ oper
comp = \\a => appComp vp.c2 (obj ! a) ++ vp.comp ! a comp = \\a => appComp vp.c2 (obj ! a) ++ vp.comp ! a
} ; } ;
insertVV : (Agr => Str) -> VPH -> VPH = \obj1,vp -> vp ** { insertVV : Bool -> (Agr => Anteriority => Str) -> VPH -> VPH =
wish = True ; \isDef,infcl,vp -> vp ** {
vComp = \\a => vp.comp ! a ++ obj1 ! a ; -- IL why this is vp.comp and not vp.vComp?? defVV = True; --isDef ;
vComp = \\agr,ant => vp.vComp ! agr ! ant ++ infcl ! agr ! ant ;
} ; } ;
embComp : Str -> VPH -> VPH = \str,vp -> vp ** { embComp : Str -> VPH -> VPH = \str,vp -> vp ** {
@@ -135,8 +150,14 @@ oper
---- AR 14/9/2017 trying to fix isAux = True case by inserting conjThat ---- AR 14/9/2017 trying to fix isAux = True case by inserting conjThat
---- but don't know yet how False should be affect ---- but don't know yet how False should be affect
infVV : Bool -> VPH -> (Agr => Str) = \isAux,vp -> infVV : VV -> VPH -> (Agr => Anteriority => Str) = \vv,vp ->
\\agr => if_then_Str isAux conjThat [] ++ showVPH (Vvform agr) agr vp ; \\agr,ant => if_then_Str vv.isAux conjThat [] ++
case <ant,vv.compl> of {
<_Simul,Subj> => showVPH (VSubj Pos agr) agr vp ;
<_Simul,Indic> => showVPH (VAor Pos agr) agr vp
-- TODO: confirm <Anter,_> => showVPH PerfStem agr vp ++ subjAux Pos agr
} ;
insertAdV : Str -> VPH -> VPH = \ad,vp -> vp ** { insertAdV : Str -> VPH -> VPH = \ad,vp -> vp ** {
ad = vp.ad ++ ad ; ad = vp.ad ++ ad ;
@@ -153,23 +174,32 @@ oper
---- AR 18/9/2017 intermediate SClause to preserve SOV in e.g. QuestionPes.QuestSlash ---- AR 18/9/2017 intermediate SClause to preserve SOV in e.g. QuestionPes.QuestSlash
clTable : VPH -> (Agr => VPHTense => Polarity => Str) = \vp -> clTable : VPH -> (Agr => VPHTense => Polarity => Str) = \vp ->
\\agr,vt,pol => case vt of { \\agr,vt,pol => vp.prefix ++ case vt of {
TA Pres Simul => vp.s ! VF pol (VFPres PrImperf) agr ; TA Pres Simul => vp.s ! ImpPrefix pol ++ vp.s ! VAor pol agr ; -- for reg. verbs, VAor pol is invariant and negation comes in ImpPrefix.
TA Pres Anter => vp.s ! VF pol (VFPres PrPerf) agr ; TA Pres Anter => vp.s ! VPerf pol agr ;
TA Past Simul => vp.s ! VF pol (VFPast PstAorist) agr ; TA Past Simul => vp.s ! VPast pol agr ;
TA Past Anter => vp.s ! VF pol (VFPast PstPerf) agr ; TA Past Anter =>
TA Fut Simul => case vp.wish of { case vp.defVV of {
True => vp.s ! VF pol (VFPres PrImperf) agr ; True => vp.s ! ImpPrefix pol ++ vp.s ! VAor pol agr ;
False => vp.s ! VF pol (VFFut FtAorist) agr } ; False => vp.s ! PerfStem ++ pluperfAux pol agr } ;
TA Fut Anter => case vp.wish of { TA Fut Simul =>
_True => vp.s ! VF pol (VFPres PrPerf) agr } ; case vp.defVV of {
--False => vp.s ! VF pol (VFFut FtAorist) agr } ; -- verb form need to be confirmed True => vp.s ! ImpPrefix pol ++ vp.s ! VAor pol agr ;
TA Cond Simul => vp.s ! VF pol (VFPast PstImperf) agr ; False => futAux pol agr ++ vp.s ! PastStem
TA Cond Anter => vp.s ! VF pol (VFPast PstImperf) agr ; -- verb form to be confirmed } ; -- PastStem is, despite the name, used for future too. /IL
VVVForm => vp.s ! Vvform agr ; -- AR 21/3/2018 TA Fut Anter =>
VRoot1 => vp.s ! Root1 {- ++ Predef.Bind ++ "ه" -} -- AR 22/3/2018 case vp.defVV of {
True => vp.s ! VPerf pol agr ;
} ; False => "خواسته" ++ pluperfAux pol agr ++ vp.s ! PastStem
} ; -- verb form need to be confirmed
TA Cond Simul => vp.s ! VSubj pol agr ;
TA Cond Anter =>
case vp.defVV of {
True => vp.s ! VSubj pol agr ;
False => vp.s ! PerfStem ++ subjAux pol agr } ; -- verb form to be confirmed
VVVForm => vp.s ! VSubj Pos agr ; -- AR 21/3/2018
VRoot1 => vp.s ! PastStem -- AR 22/3/2018
} ;
mkClause : NP -> VPH -> Clause = \np,vp -> mkClause : NP -> VPH -> Clause = \np,vp ->
let cls = mkSlClause np vp let cls = mkSlClause np vp
@@ -181,23 +211,34 @@ oper
OQuest => "آیا" } ; OQuest => "آیا" } ;
subj = np.s ! Bare ; subj = np.s ! Bare ;
vp = \\vt,b,ord => vp = \\vt,b,ord =>
let vps = clTable vp ! np.a ! vt ! b let vps = clTable vp ! np.a ! vt ! b ;
in vp.ad ++ vp.comp ! np.a ++ vp.obj ++ vps ++ vp.vComp ! np.a ++ vp.embComp ant = case vp.defVV of {
True => case vt of {TA Pres _ => Simul ; TA _ a => Anter ; _ => Simul} ;
False => Simul }
in vp.ad ++ vp.comp ! np.a ++ vp.obj ++ vps
++ vp.vComp ! np.a ! ant ++ vp.embComp
}; };
--Clause : Type = {s : VPHTense => Polarity => Order => Str} ; --Clause : Type = {s : VPHTense => Polarity => Order => Str} ;
mkSClause : Str -> Agr -> VPH -> Clause = \subj,agr,vp -> { mkSClause : Str -> Agr -> VPH -> Clause = \subj,agr,vp -> {
s = \\vt,b,ord => s = \\vt,b,ord =>
let vps = clTable vp ! agr ! vt ! b ; let vps = clTable vp ! agr ! vt ! b ;
quest = case ord of { ODir => [] ; OQuest => "آیا" } quest = case ord of { ODir => [] ; OQuest => "آیا" } ;
in quest ++ subj ++ vp.ad ++ vp.comp ! agr ++ vp.obj ++ vps ++ vp.vComp ! agr ++ vp.embComp ant = case vp.defVV of {
True => case vt of {TA Pres _ => Simul ; TA _ a => Anter ; _ => Simul} ;
False => Simul }
in quest ++ subj ++ vp.ad ++ vp.comp ! agr ++ vp.obj
++ vps ++ vp.vComp ! agr ! ant ++ vp.embComp
}; };
predProg : VPH -> VPH = \verb -> verb ** { predProg : VPH -> VPH = \verb -> verb ** {
s = \\vh => case vh of { s = \\vh => case vh of {
VF pol (VFPres PrImperf) agr => haveVerb.s ! VF Pos (VFPres PrImperf) agr ++ verb.s ! VF pol (VFPres PrImperf) agr ; ImpPrefix _ => [] ;
VF pol (VFPast PstAorist) agr => haveVerb.s ! VF Pos (VFPast PstAorist) agr ++ verb.s ! VF pol (VFPast PstAorist) agr ; VAor p a => haveVerb.s ! VAor Pos a ++ verb.s ! ImpPrefix p ++ verb.s ! VAor Pos a ;
VF pol (VFPast PstImperf) agr => haveVerb.s ! VF Pos (VFPast PstAorist) agr ++ verb.s ! VF pol (VFPast PstImperf) agr ; VPast p a => haveVerb.s ! VPast Pos a ++ verb.s ! ImpPrefix p ++ verb.s ! VPast Pos a ; -- negation in ImpPrefix
-- VF pol (VFPres PrImperf) agr => haveVerb.s ! VF Pos (VFPres PrImperf) agr ++ verb.s ! VF pol (VFPres PrImperf) agr ;
-- VF pol (VFPast PstAorist) agr => haveVerb.s ! VF Pos (VFPast PstAorist) agr ++ verb.s ! VF pol (VFPast PstAorist) agr ;
-- VF pol (VFPast PstImperf) agr => haveVerb.s ! VF Pos (VFPast PstAorist) agr ++ verb.s ! VF pol (VFPast PstImperf) agr ;
_ => verb.s ! vh } ; _ => verb.s ! vh } ;
subj = VIntrans subj = VIntrans
} ; } ;
@@ -211,7 +252,7 @@ oper
-- Noun Phrase -- Noun Phrase
----------------------------- -----------------------------
partNP : Str -> Str = \str -> (Prelude.glue str "ه") ++ "شده" ; partNP : Verb -> Str = \v -> v.prefix ++ v.s ! PerfStem ++ "شده" ;
----------------------------------- -----------------------------------
-- Reflexive Pronouns -- Reflexive Pronouns

8
src/persian/SentencePes.gf
View File

@@ -12,9 +12,9 @@ concrete SentencePes of Sentence = CatPes ** open Prelude, ResPes,Predef in {
ImpVP vp = { ImpVP vp = {
s = \\pol,n => s = \\pol,n =>
let agr = Ag (numImp n) P2 ; let agr = Ag (numImp n) P2 ;
in case vp.wish of { in case vp.defVV of {
True => vp.s ! Imp pol (numImp n) ++ vp.ad ++ vp.comp ! agr ++ vp.obj ++ vp.vComp ! agr ++ vp.embComp; True => vp.s ! VImp pol (numImp n) ++ vp.ad ++ vp.comp ! agr ++ vp.obj ++ vp.vComp ! agr ! Simul ++ vp.embComp;
False => vp.ad ++ vp.comp ! agr ++ vp.obj ++ vp.vComp ! agr ++ vp.s ! Imp pol (numImp n) ++ vp.embComp } False => vp.ad ++ vp.comp ! agr ++ vp.obj ++ vp.vComp ! agr ! Simul ++ vp.s ! VImp pol (numImp n) ++ vp.embComp }
} ; } ;
SlashVP np vp = SlashVP np vp =
@@ -59,6 +59,6 @@ concrete SentencePes of Sentence = CatPes ** open Prelude, ResPes,Predef in {
AdvS a s = {s = a.s ++ s.s} ; AdvS a s = {s = a.s ++ s.s} ;
RelS s r = {s = s.s ++ r.s ! agrP3 Sg} ; RelS s r = {s = s.s ++ r.s ! agrP3 Sg} ;
SSubjS s sj s = { s = s.s ++ sj.s ++ s.s}; SSubjS s1 sj s2 = { s = s1.s ++ sj.s ++ s2.s};
} }

47
src/persian/StructuralPes.gf
View File

@@ -21,7 +21,7 @@ concrete StructuralPes of Structural = CatPes **
by8agent_Prep = ss "توسط" ; by8agent_Prep = ss "توسط" ;
by8means_Prep = ss "با" ; by8means_Prep = ss "با" ;
-- can8know_VV,can_VV = mkV "سکن" ** { isAux = True} ; -- can8know_VV,can_VV = mkV "سکن" ** { isAux = True} ;
can_VV = mkV_1 " توانستن " ** { isAux = True} ; ---- AR can_VV = mkVV (mkV_1 "توانستن") ; ---- AR
during_Prep = ss ["در طول"] ; during_Prep = ss ["در طول"] ;
either7or_DConj = sd2 "یا" "یا" ** {n = Sg} ; either7or_DConj = sd2 "یا" "یا" ** {n = Sg} ;
-- everybody_NP = MassNP (UseN (MorphoPnb.mkN11 ["هر کwی"])); -- not a good way coz need to include NounPnb -- everybody_NP = MassNP (UseN (MorphoPnb.mkN11 ["هر کwی"])); -- not a good way coz need to include NounPnb
@@ -49,29 +49,16 @@ concrete StructuralPes of Structural = CatPes **
more_CAdv = {s = "بیشتر" ; p = "" } ; more_CAdv = {s = "بیشتر" ; p = "" } ;
most_Predet = ss "اکثر"; most_Predet = ss "اکثر";
much_Det = mkDet ["مقدار زیادی"] Pl ; much_Det = mkDet ["مقدار زیادی"] Pl ;
must_VV = invarV " بایستن " ** {isAux = True} ; ---- AR must_VV =
-- must_VV = { let must_V : V = defV "بایستن" "باید" "بایست" ;
-- s = table { in mkVV must_V ;
-- VVF VInf => ["هوe تْ"] ; -- TODO: ** {isDef=True} ; past tense forms with مجبور+beVerb
-- VVF VPres => "مست" ;
-- VVF VPPart => ["هد تْ"] ;
-- VVF VPresPart => ["هونگ تْ"] ;
-- VVF VPast => ["هد تْ"] ; --# notpresent
-- VVPastNeg => ["هدn'ت تْ"] ; --# notpresent
-- VVPresNeg => "مستn'ت"
-- } ;
-- isAux = True
-- } ;
-----b no_Phr = ss "نْ" ;
no_Utt = ss "نه" ; no_Utt = ss "نه" ;
on_Prep = ss "روی" ; on_Prep = ss "روی" ;
-- one_Quant = demoPN "یک" ; -- DEPRECATED
only_Predet = ss "فقط" ; only_Predet = ss "فقط" ;
or_Conj = sd2 [] "یا" ** {n = Sg} ; or_Conj = sd2 [] "یا" ** {n = Sg} ;
otherwise_PConj = ss ["درغیراین صورت"] ; otherwise_PConj = ss ["درغیراین صورت"] ;
part_Prep = ss "از" ; -- the object following it should be in Ezafa form part_Prep = ss "از" ; -- TODO: the object following it should be in Ezafa form
please_Voc = ss "لطفاً" ; please_Voc = ss "لطفاً" ;
possess_Prep = ss "" ; -- will be handeled in Ezafeh possess_Prep = ss "" ; -- will be handeled in Ezafeh
quite_Adv = ss "کاملاً" ; quite_Adv = ss "کاملاً" ;
@@ -95,7 +82,7 @@ concrete StructuralPes of Structural = CatPes **
to_Prep = ss "به" ** {lock_Prep = <>}; to_Prep = ss "به" ** {lock_Prep = <>};
under_Prep = ss "زیر" ** {lock_Prep = <>}; under_Prep = ss "زیر" ** {lock_Prep = <>};
very_AdA = ss "خیلی" ; very_AdA = ss "خیلی" ;
want_VV = mkV "خواستن" "خواه" ** { isAux = False} ; want_VV = mkVV False subjunctive (mkV "خواستن" "خواه") ; --not aux
we_Pron = personalPron "ما" "مان" Pl P1 ; we_Pron = personalPron "ما" "مان" Pl P1 ;
whatSg_IP = {s = ["چه چیزی"] ; n = Sg } ; whatSg_IP = {s = ["چه چیزی"] ; n = Sg } ;
whatPl_IP = {s = ["چه چیزهایی"] ; n = Pl } ; whatPl_IP = {s = ["چه چیزهایی"] ; n = Pl } ;
@@ -136,16 +123,16 @@ concrete StructuralPes of Structural = CatPes **
-- MorphoPes.haveVerb: "have" as auxiliary. -- MorphoPes.haveVerb: "have" as auxiliary.
have_V2 = haveVerb ** { have_V2 = haveVerb ** {
s = table { s = table {
R.Imp Pos Sg => "داشته باش" ; VImp Pos Sg => "داشته باش" ;
R.Imp Pos Pl => "داشته باشید" ; VImp Pos Pl => "داشته باشید" ;
R.Imp Neg Sg => "نداشته باش" ; VImp Neg Sg => "نداشته باش" ;
R.Imp Neg Pl => "نداشته باشید" ; VImp Neg Pl => "نداشته باشید" ;
Vvform (Ag Sg P1) => "داشته باشم" ; VSubj _ (Ag Sg P1) => "داشته باشم" ;
Vvform (Ag Sg P2) => "داشته باشی" ; VSubj _ (Ag Sg P2) => "داشته باشی" ;
Vvform (Ag Sg P3) => "داشته باشد" ; VSubj _ (Ag Sg P3) => "داشته باشد" ;
Vvform (Ag Pl P1) => "داشته باشیم" ; VSubj _ (Ag Pl P1) => "داشته باشیم" ;
Vvform (Ag Pl P2) => "داشته باشید" ; VSubj _ (Ag Pl P2) => "داشته باشید" ;
Vvform (Ag Pl P3) => "داشته باشند" ; VSubj _ (Ag Pl P3) => "داشته باشند" ;
x => haveVerb.s ! x } ; x => haveVerb.s ! x } ;
c2 = { c2 = {
s = [] ; s = [] ;

8
src/persian/VerbPes.gf
View File

@@ -14,20 +14,20 @@ concrete VerbPes of Verb = CatPes ** open ResPes,Prelude in {
ComplSlash = complSlash ; ComplSlash = complSlash ;
ComplVV v vp = insertVV (infVV v.isAux vp) (predV v) ; ComplVV v vp = insertVV v.isDef (infVV v vp) (predV v) ;
ComplVS v s = embComp (conjThat ++ s.s) (predV v) ; ComplVS v s = embComp (conjThat ++ s.s) (predV v) ;
ComplVQ v q = embComp (conjThat ++ q.s ! QIndir) (predV v) ; ComplVQ v q = embComp (conjThat ++ q.s ! QIndir) (predV v) ;
ComplVA v ap = insertObj (ap.s ! Bare) (predV v) ; -- check form of adjective ComplVA v ap = insertObj (ap.s ! Bare) (predV v) ; -- check form of adjective
SlashV2V v vp = insertVV (infVV v.isAux vp) (predV v) **{c2 = {s = v.c1 ; ra = []}} ; SlashV2V v vp = insertVV v.isDef (infVV v vp) (predV v) **{c2 = {s = v.c1 ; ra = []}} ;
SlashV2S v s = v ** embComp (conjThat ++ s.s) (predV v) ; SlashV2S v s = v ** embComp (conjThat ++ s.s) (predV v) ;
SlashV2Q v q = v ** embComp (q.s ! QIndir) (predV v) ; SlashV2Q v q = v ** embComp (q.s ! QIndir) (predV v) ;
SlashV2A v ap = v ** insertObj (ap.s ! Bare) (predV v) ; ---- paint it red , check form of adjective SlashV2A v ap = v ** insertObj (ap.s ! Bare) (predV v) ; ---- paint it red , check form of adjective
SlashVV vv vps = vps ** insertVV (infVV vv.isAux vps) (predV vv) ; SlashVV vv vps = vps ** insertVV vv.isDef (infVV vv vps) (predV vv) ;
SlashV2VNP v2v np vps = SlashV2VNP v2v np vps =
let vvVP : VPH = insertVV (infVV v2v.isAux vps) (predV v2v) ; let vvVP : VPH = insertVV v2v.isDef (infVV v2v vps) (predV v2v) ;
vvVPS = vvVP ** {c2={s=v2v.c1 ; ra=v2v.c2}} ; -- TODO find out if it's a general rule; only one V2V in the lexicon /IL vvVPS = vvVP ** {c2={s=v2v.c1 ; ra=v2v.c2}} ; -- TODO find out if it's a general rule; only one V2V in the lexicon /IL
in complSlash vvVPS np ** {c2 = vps.c2} ; in complSlash vvVPS np ** {c2 = vps.c2} ;