updates from Codex

src/api/TryPes.gf

@@ -1,12 +1,16 @@
 --# -path=.:../persian:../common:../abstract:../prelude
 
-resource TryPes = SyntaxPes, LexiconPes, ParadigmsPes -[mkDet,mkQuant,mkAdv]** 
+resource TryPes = SyntaxPes-[mkAdN], LexiconPes, ParadigmsPes -[mkDet,mkQuant,mkAdv,mkAdN,mkOrd,mkQuant,mkVoc]**
   open (P = ParadigmsPes) in {
 
--- oper
+oper
+  mkAdv = overload SyntaxPes {
+    mkAdv : Str -> Adv = P.mkAdv ;
+  } ;
 
---  mkAdv = overload SyntaxPes {
---    mkAdv : Str -> Adv = P.mkAdv ;
---  } ;
+  mkAdN = overload {
+    mkAdN : CAdv -> AdN = SyntaxPes.mkAdN ;
+    mkAdN : Str -> AdN = P.mkAdN ;
+  } ;
 
 }

src/persian/AdjectivePes.gf

@@ -6,9 +6,9 @@ concrete AdjectivePes of Adjective = CatPes ** open ResPes, Prelude in {
   PositA a = a ** {s = a.s ! Positive} ;
  	UseComparA a = a ** {s = a.s ! Comparative} ;
 
-  ComparA a np = a ** {
-    s = \\m => a.s ! Comparative ! m ++ "تر" ++ "از" ++ np2str np ;
-    adv = a.adv ++ "تر" ++ "از" ++ np2str np ;
+  ComparA a np = a ** {
+    s = \\m => a.s ! Comparative ! m ++ "از" ++ np2str np ;
+    adv = a.s ! Comparative ! Bare ++ "از" ++ np2str np ;
     } ;
 
 ---- $SuperlA$ belongs to determiner syntax in $Noun$.

src/persian/AdverbPes.gf

@@ -3,7 +3,8 @@ concrete AdverbPes of Adverb = CatPes ** open ResPes, Prelude in {
   flags coding = utf8;
   lin
  --   PositAdvAdj a = {s = a.s ! Bare  } ;
-     PositAdvAdj a = {s = a.adv  } ;
+     PositAdvAdj a = {s = a.adv  } ;
+    PositAdAAdj a = {s = a.adv} ;
     ComparAdvAdj cadv a np = {
       s = a.adv ++ cadv.p ++ cadv.s ++ np.s !  Bare  ;
       } ;
@@ -17,9 +18,9 @@ concrete AdverbPes of Adverb = CatPes ** open ResPes, Prelude in {
 
 --    SubjS = cc2 ;
     SubjS sub snt = {
-       s = case sub.relpron of {
-            Ke   => sub.s ++ conjThat ++ snt.s ! sub.compl ;
-            Ance => "آنچه" ++ snt.s ! sub.compl }
+       s = case sub.relpron of {
+            Ke   => sub.s ++ snt.s ! sub.compl ;
+            Ance => "آنچه" ++ snt.s ! sub.compl }
     } ;
 
     AdnCAdv cadv = {s =  cadv.s ++ "از"} ;

src/persian/AllPes.gf

@@ -2,5 +2,6 @@
 
 concrete AllPes of AllPesAbs =
   LangPes,
-  ExtraPes
+  ExtraPes,
+  IrregPes
   ** {} ;

src/persian/AllPesAbs.gf

@@ -1,4 +1,5 @@
 abstract AllPesAbs =
   Lang,
-  ExtraPesAbs
+  ExtraPesAbs,
+  IrregPesAbs
   ** {} ;

src/persian/CatPes.gf

@@ -54,7 +54,8 @@ concrete CatPes of Cat = CommonX ** open ResPes, Prelude in {
 
     NP = ResPes.NP ;
     Pron = ResPes.Pron ;
-    Det = ResPes.Determiner ;
+    Det = ResPes.Determiner ;
+    DAP = {s : Str ; n : Number} ;
     Predet = {s : Str} ;
     Num  = {s : Str ; n : Number ; isNum : Bool} ;
     Card = {s : Str; n : Number} ;

src/persian/ConstructionPes.gf

@@ -21,6 +21,27 @@ lincat
 
 
 lin
+  monday_Weekday = mkN "دوشنبه" ;
+  tuesday_Weekday = mkN "سه‌شنبه" ;
+  wednesday_Weekday = mkN "چهارشنبه" ;
+  thursday_Weekday = mkN "پنجشنبه" ;
+  friday_Weekday = mkN "جمعه" ;
+  saturday_Weekday = mkN "شنبه" ;
+  sunday_Weekday = mkN "یکشنبه" ;
+
+  january_Month = mkN "ژانویه" ;
+  february_Month = mkN "فوریه" ;
+  march_Month = mkN "مارس" ;
+  april_Month = mkN "آوریل" ;
+  may_Month = mkN "مه" ;
+  june_Month = mkN "ژوئن" ;
+  july_Month = mkN "ژوئیه" ;
+  august_Month = mkN "اوت" ;
+  september_Month = mkN "سپتامبر" ;
+  october_Month = mkN "اکتبر" ;
+  november_Month = mkN "نوامبر" ;
+  december_Month = mkN "دسامبر" ;
+
   weekdayN w = w ;
   monthN m = m ;
 
@@ -76,6 +97,13 @@ lin
 
   hungry_VP = mkVP (mkA "گرسنه") ;
   thirsty_VP = mkVP (mkA "تشنه") ;
+  ready_VP = mkVP (mkA "آماده") ;
+  has_age_VP card = mkVP (P.mkAdv (card.s ++ "ساله")) ;
+  cup_of_CN np = mkCN (P.mkN2 (P.mkN "فنجان") "از") np ;
+  n_units_of_NP card unit np = R.emptyNP ** {
+    s = \\_ => card.s ++ unit.s ! R.Sg ! R.Ezafe ++ np.s ! R.Bare ;
+    a = R.agrP3 R.Pl
+    } ;
   have_name_Cl p n = mkCl (mkNP (E.GenNP p) L.name_N) n ;
   what_name_QCl p = mkQCl what_IAdv (mkNP (E.GenNP p) L.name_N) ;
 

src/persian/ExtendPes.gf

@@ -2,13 +2,128 @@
 
 concrete ExtendPes of Extend =
   CatPes ** ExtendFunctor - [
+    VPS, ListVPS, BaseVPS, ConsVPS, ConjVPS, MkVPS, PredVPS, RelVPS,
+    VPI, ListVPI, BaseVPI, ConsVPI, ConjVPI, MkVPI, ComplVPIVV,
+    ListComp, BaseComp, ConsComp, ConjComp,
+    ListImp, BaseImp, ConsImp, ConjImp,
+    PresPartAP, PastPartAP, PastPartAgentAP,
+    PassVPSlash, PassAgentVPSlash, ProgrVPSlash,
+    ReflPron, ReflPoss, AdvRNP, AdvRVP, AdvRAP, PossPronRNP,
+    CompoundN, CompoundAP, PositAdVAdj, UseDAP, UseDAPMasc, UseDAPFem,
     GenNP, ApposNP, ICompAP, AdvIsNP, InOrderToVP, ByVP, AdjAsNP, ComplBareVS
     ,GerundNP,GerundCN,GerundAdv,EmbedPresPart,EmbedSSlash
     ]
   with (Grammar=GrammarPes)
-  ** open Prelude, ResPes in {
+  ** open Prelude, ResPes, (M=MorphoPes) in {
+
+lincat
+  VPS = {s : Agr => Str} ;
+  [VPS] = {s1,s2 : Agr => Str} ;
+  VPI = {s : Str} ;
+  [VPI] = {s1,s2 : Str} ;
+  [Comp] = {s1,s2 : Agr => Str} ;
+  [Imp] = {s1,s2 : Polarity => Number => Str} ;
 
 lin
+  MkVPS temp pol vp = {
+    s = \\agr => (mkSClause [] agr vp).s ! Ind temp.t temp.a ! pol.p ! ODir
+    } ;
+  BaseVPS first second = {s1 = first.s ; s2 = second.s} ;
+  ConsVPS first rest = {
+    s1 = \\agr => first.s ! agr ++ SOFT_BIND ++ "،" ++ rest.s1 ! agr ;
+    s2 = rest.s2
+    } ;
+  ConjVPS conj verbs = {
+    s = \\agr => verbs.s1 ! agr ++ conj.s2 ++ verbs.s2 ! agr
+    } ;
+  PredVPS np verbs = {s = \\_ => np.s ! Bare ++ verbs.s ! np.a} ;
+  RelVPS rp verbs = {
+    s = \\agr => verbs.s ! agr ;
+    rp = rp.s
+    } ;
+
+  MkVPI vp = {s = infVP vp} ;
+  BaseVPI first second = {s1 = first.s ; s2 = second.s} ;
+  ConsVPI first rest = {s1 = first.s ++ SOFT_BIND ++ "،" ++ rest.s1 ; s2 = rest.s2} ;
+  ConjVPI conj verbs = {s = verbs.s1 ++ conj.s2 ++ verbs.s2} ;
+  ComplVPIVV vv verbs = predV vv ** {
+    vComp = \\_,_ => verbs.s ;
+    vvtype = case vv.isDef of {True => DefVV ; False => FullVV}
+    } ;
+
+  BaseComp first second = {s1 = first.s ; s2 = second.s} ;
+  ConsComp first rest = {
+    s1 = \\agr => first.s ! agr ++ SOFT_BIND ++ "،" ++ rest.s1 ! agr ;
+    s2 = rest.s2
+    } ;
+  ConjComp conj comps = {
+    s = \\agr => comps.s1 ! agr ++ conj.s2 ++ comps.s2 ! agr
+    } ;
+
+  BaseImp first second = {s1 = first.s ; s2 = second.s} ;
+  ConsImp first rest = {
+    s1 = \\pol,num => first.s ! pol ! num ++ SOFT_BIND ++ "،" ++ rest.s1 ! pol ! num ;
+    s2 = rest.s2
+    } ;
+  ConjImp conj imps = {
+    s = \\pol,num => imps.s1 ! pol ! num ++ conj.s2 ++ imps.s2 ! pol ! num
+    } ;
+
+  PresPartAP vp = mkPartAP (infVP vp) ;
+  PastPartAP slash = mkPartAP (passivePart slash) ;
+  PastPartAgentAP slash agent =
+    mkPartAP (passivePart slash ++ "توسط" ++ np2str agent) ;
+
+  PassVPSlash slash = passVP slash ;
+  PassAgentVPSlash slash agent = insertAdv ("توسط" ++ np2str agent) (passVP slash) ;
+  ProgrVPSlash slash = predProg slash ** {c2 = slash.c2 ; agrObj = slash.agrObj} ;
+
+  ReflPron = lin RNP (emptyNP ** {
+    -- The invariant emphatic خود is valid with every subject and avoids
+    -- incorrectly freezing this underspecified RNP to third-person خودش.
+    s = \\_ => "خود" ;
+    a = defaultAgr ;
+    animacy = Animate ;
+    lock_NP = <>
+    }) ;
+  ReflPoss num cn = lin RNP (emptyNP ** {
+    s = \\m => cn.s ! num.n ! Ezafe ++ "خود" ++ cn.compl ! num.n ;
+    a = agrP3 num.n ;
+    animacy = cn.animacy ;
+    lock_NP = <>
+    }) ;
+  AdvRNP np prep rnp = lin RNP (rnp ** {
+    s = \\m => np.s ! Ezafe ++ appComp prep rnp.s ;
+    a = np.a ;
+    lock_NP = <>
+    }) ;
+  AdvRVP vp prep rnp = insertAdv (appComp prep rnp.s) vp ;
+  AdvRAP ap prep rnp = ap ** {
+    s = \\m => ap.s ! m ++ appComp prep rnp.s ;
+    adv = ap.adv ++ appComp prep rnp.s
+    } ;
+  PossPronRNP pron num cn rnp = emptyNP ** {
+    s = \\m => cn.s ! num.n ! Ezafe ++ rnp.s ! Bare ++ "توسط" ++ pron.s ;
+    a = agrP3 num.n ;
+    animacy = cn.animacy
+    } ;
+
+  CompoundN modifier head = head ** {
+    s = \\n,m => head.s ! n ! Ezafe ++ modifier.s ! Sg ! Bare ;
+    isCmpd = IsCmpd
+    } ;
+  CompoundAP noun adjective = {
+    s = \\m => noun.s ! Sg ! Ezafe ++ adjective.s ! Positive ! m ;
+    adv = noun.s ! Sg ! Bare ++ adjective.adv ;
+    isPre = adjective.isPre ;
+    afterPrefix = adjective.afterPrefix
+    } ;
+  PositAdVAdj adjective = {s = adjective.adv} ;
+
+  UseDAP dap = indeclNP dap.s ** {a = agrP3 dap.n} ;
+  UseDAPMasc dap = indeclNP dap.s ** {a = agrP3 dap.n ; animacy = Animate} ;
+  UseDAPFem dap = indeclNP dap.s ** {a = agrP3 dap.n ; animacy = Animate} ;
+
   -- NP -> Quant ; -- this man's
   GenNP np = makeQuant [] [] Ezafe False ** np ** {
     mod = Ezafe ; -- the possessed will get Ezafe
@@ -57,4 +172,16 @@ lin
          Kardan => showVPH PerfStem defaultAgr <vp ** {s = \\vf => []} : VP> ; -- only show prefix
          _ => showVPH PerfStem defaultAgr vp}
    } ;
+
+oper
+  mkPartAP : Str -> M.AP = \s -> {
+    s = \\_ => s ;
+    adv = s ;
+    isPre = False ;
+    afterPrefix = False
+    } ;
+
+  passivePart : VPH -> Str = \vp ->
+    let passive = passVP vp
+    in passive.prefix ++ passive.s ! PerfStem ;
 }

src/persian/MorphoPes.gf

@@ -210,8 +210,9 @@ param
            ;
 
   -- Affects clitic placement and passive
-  LightVerb = NotLight | Light  -- ateš zadan -> ateš zade šodan
-            | Kardan ;          -- gom kardan -> gom   ∅   šodan
+  LightVerb = NotLight | Light  -- ateš zadan -> ateš zade šodan
+            | BareKardan        -- simple kardan, with no non-verbal host
+            | Kardan ;          -- gom kardan -> gom   ∅   šodan
 oper
   impRoot : Str -> Str = \root -> case root of {
     st + "ی" => st ;
@@ -229,14 +230,24 @@ oper
       vf => v.s ! vf }
     } ;
 
-  addClitic : LightVerb -> Str -> Verb -> Verb = \light,cl,v -> v ** {s =
-    let f : Str -> Str = case light of {
-          NotLight => \s -> glue s cl ;
-          _ => \s -> BIND ++ cl ++ s } -- hack: put clitic before the verb, so it attaches to the prefix
-    in table {
-          Inf => glue (v.s ! Inf) cl ;
-          vf => (modifyFiniteForms f v).s ! vf }
-       } ;
+  addClitic : LightVerb -> Str -> Verb -> Verb = \light,cl,v ->
+    case light of {
+      NotLight | BareKardan => v ** {
+        s = table {
+          Inf => glue (v.s ! Inf) cl ;
+          vf  => (modifyFiniteForms (\s -> glue s cl) v).s ! vf
+          }
+        } ;
+      -- With a compound verb the clitic attaches to its non-verbal element:
+      -- نشانش می‌دهد, not *نشان می‌ش‌دهد.
+      _ => v ** {
+        prefix = glue v.prefix cl ;
+        s = table {
+          Inf => glue (v.s ! Inf) cl ;
+          vf  => v.s ! vf
+          }
+        }
+      } ;
 
   mkVerb : (inf,pres : Str) -> Verb = \kardan,kon -> {
     s = table {
@@ -391,7 +402,7 @@ oper
     VImp Neg Sg => "نکن" ;
     VImp Neg Pl => "نکنید" ;
     vf          => doRegV.s ! vf } ;
-    lightverb = Kardan
+    lightverb = BareKardan
   } where { doRegV = mkVerb "کردن" "کن" } ;
 
   becomeVerb : Verb = mkVerb "شدن" "شو" ;

src/persian/NounPes.gf

@@ -46,9 +46,13 @@ concrete NounPes of Noun = CatPes ** open ResPes, Prelude in {
               Ke   => np.s ! Clitic ++ rs2str np.relpron np.a rs }
       } ;
 
-    AdvNP np adv = np ** {
-      s = \\ez => np.s ! Ezafe ++ adv.s
-      } ;
+    AdvNP np adv = np ** {
+      s = \\ez => np.s ! Ezafe ++ adv.s
+      } ;
+
+    ExtAdvNP np adv = np ** {
+      s = \\m => np.s ! m ++ SOFT_BIND ++ "،" ++ adv.s
+      } ;
 
     DetQuantOrd quant num ord =
       let cs : CmpdStatus => Str = case <num.isNum,num.n,quant.isDef> of {
@@ -75,14 +79,17 @@ concrete NounPes of Noun = CatPes ** open ResPes, Prelude in {
       n = case quant.isNeg of {True => Sg ; _ => num.n} ;
       } ;
 
-    DetNP det = emptyNP ** {
+    DetNP det = emptyNP ** {
       s = \\_ => det.sp ;
       a = agrP3 det.n ;
       hasAdj = False ;
       animacy = Inanimate ;
       --TODO: isClitic, clitic
-      relpron = Ance -- TODO check if this works for all Dets
-      } ;
+      relpron = Ance -- TODO check if this works for all Dets
+      } ;
+
+    DetDAP det = {s = det.sp ; n = det.n} ;
+    AdjDAP dap ap = {s = dap.s ++ ap.s ! Bare ; n = dap.n} ;
 
     PossPron p = DefArt ** {
        s = \\_ => table {
@@ -105,7 +112,7 @@ concrete NounPes of Noun = CatPes ** open ResPes, Prelude in {
 -- to here
     AdNum adn num = num ** {s = adn.s ++ num.s} ;
 
-    OrdSuperl a = {s = a.s ! Comparative ! Bare ++ BIND ++ "ین" ; n = Sg ; isNum=False ; isPre = True} ;
+    OrdSuperl a = {s = a.s ! Positive ! Bare ++ BIND ++ ZWNJ ++ BIND ++ "ترین" ; n = Sg ; isNum=False ; isPre = True} ;
 
     DefArt = makeQuant [] [] Bare False ;
     IndefArt = makeQuant IndefArticle [] Bare False ** {isDef = False} ;
@@ -164,7 +171,22 @@ concrete NounPes of Noun = CatPes ** open ResPes, Prelude in {
     ApposCN cn np = cn ** {s = \\n,m => cn.s ! n ! Ezafe ++ np.s ! m} ;
 
     --  : CN -> NP -> CN ;     -- house of Paris, house of mine
-    PossNP cn np = cn ** {
-      s = \\n => replaceBare Ezafe (cn.s ! n) ; -- alternative: place np2str np here for "<house of mine> <on the hill>"
-      compl = \\n => cn.compl ! n ++ np2str np } ; -- "<house> <on the hill of mine>"
-}
+    PossNP cn np = cn ** {
+      s = \\n => replaceBare Ezafe (cn.s ! n) ; -- alternative: place np2str np here for "<house of mine> <on the hill>"
+      compl = \\n => cn.compl ! n ++ np2str np } ; -- "<house> <on the hill of mine>"
+
+    PartNP cn np = cn ** {
+      s = \\n,m => cn.s ! n ! Ezafe ;
+      compl = \\n => cn.compl ! n ++ np2str np
+      } ;
+
+    CountNP det np = np ** {
+      s = \\m => det.s ++ "از" ++ np.s ! m ;
+      a = agrP3 det.n
+      } ;
+
+    QuantityNP decimal unit = emptyNP ** {
+      s = \\_ => decimal.s ! NCard ++ unit.s ;
+      a = agrP3 decimal.n
+      } ;
+}

src/persian/NumeralPes.gf

@@ -14,6 +14,8 @@ lincat
   Sub100     = {s : CardOrd => Str ; n : Number} ;
   Sub1000    = {s : CardOrd => Str ; n : Number} ;
   Sub1000000 = {s : CardOrd => Str ; n : Number} ;
+  Sub1000000000 = {s : CardOrd => Str ; n : Number} ;
+  Sub1000000000000 = {s : CardOrd => Str ; n : Number} ;
 
 lin num x = x ;
 -- 2     12     20    200             
@@ -47,6 +49,10 @@ lin pot1plus d e = {
 lin pot1as2 n = n ;
 
 lin pot2 d = {s = d.s ! hundreds}  ** {n = Pl} ;
+lin pot21 = {s = \\o => table {
+  NCard => "صد" ;
+  NOrd => "صدم"
+  } ! o ; n = Pl} ;
 lin pot2plus d e = {
   s = \\o => d.s ! hundreds ! NCard  ++ "و" ++ e.s ! o  ; n = Pl} ; -- remove "??"
 
@@ -57,6 +63,21 @@ lin pot3 n = { s = \\o => n.s ! NCard ++  "هزار" ; n = Pl} ;
 lin pot3plus n m = {
   s = \\o => n.s ! NCard ++ "هزار" ++ "و" ++ m.s ! o; n = Pl} ; -- missing word "????????" after NCard
 
+lin pot31 = {s = \\o => table {NCard => "هزار" ; NOrd => "هزارم"} ! o ; n = Pl} ;
+lin pot3as4 n = n ;
+lin pot3decimal n = {s = \\o => n.s ! o ++ "هزار" ; n = Pl} ;
+
+lin pot41 = {s = \\o => table {NCard => "یک میلیون" ; NOrd => "یک میلیونم"} ! o ; n = Pl} ;
+lin pot4 n = {s = \\o => n.s ! NCard ++ "میلیون" ; n = Pl} ;
+lin pot4plus n m = {s = \\o => n.s ! NCard ++ "میلیون" ++ "و" ++ m.s ! o ; n = Pl} ;
+lin pot4as5 n = n ;
+lin pot4decimal n = {s = \\o => n.s ! o ++ "میلیون" ; n = Pl} ;
+
+lin pot51 = {s = \\o => table {NCard => "یک میلیارد" ; NOrd => "یک میلیاردم"} ! o ; n = Pl} ;
+lin pot5 n = {s = \\o => n.s ! NCard ++ "میلیارد" ; n = Pl} ;
+lin pot5plus n m = {s = \\o => n.s ! NCard ++ "میلیارد" ++ "و" ++ m.s ! o ; n = Pl} ;
+lin pot5decimal n = {s = \\o => n.s ! o ++ "میلیارد" ; n = Pl} ;
+
 -- numerals as sequences of digits
 
   lincat 
@@ -83,7 +104,10 @@ lin pot3plus n m = {
     D_9 = mkDig "9" ;
    
   --  lin IDig d = { s = \\_ => d.s ; n = Sg} ;
-    IIDig d dg = { s = \\df => d.s ! NCard ++ dg.s ! df   ; n = Pl}; 
+    IIDig d dg = {
+      s = \\df => d.s ! NCard ++ BIND ++ dg.s ! df ;
+      n = Pl
+      } ;
 
     PosDecimal d = d ** {hasDot=False} ;
     NegDecimal d = {

src/persian/ParadigmsPes.gf

@@ -64,9 +64,17 @@ oper
            isCmpd = IsCmpd} ;
     } ;
 
--- Proper names
-  mkPN : Str -> Animacy -> PN -- Proper noun with given animacy
-    = \str,ani -> lin PN {s = str ; animacy = ani} ;
+-- Proper names
+  mkPN : Str -> Animacy -> PN -- Proper noun with given animacy
+    = \str,ani -> lin PN {s = str ; animacy = ani} ;
+
+-- Given names and surnames
+  mkGN : Str -> GN = \s -> lin GN {s = s} ;
+  mkSN : Str -> SN = \s -> lin SN {s = s} ;
+
+-- Location names
+  mkLN : Str -> LN -- Location name from a string
+    = \str -> lin LN {s = str} ;
 
 -- Determiner
 
@@ -81,11 +89,9 @@ oper
       = \s,n,nu,ne,m -> lin Det (makeDet s n nu ne ** {mod=m})
   };
 
- {-
-
--- AdN
-  mkAdN : Str -> AdN = \s -> ss s ;
--}
+-- Adverb modifying a numeral
+  mkAdN : Str -> AdN
+    = \s -> lin AdN {s = s} ;
 --2 Adjectives
 
   mkA : overload {
@@ -127,8 +133,8 @@ oper
   } ;
 
   mkV3 = overload {
-    mkV3 : Str -> V3 -- Predictable V3, را for direct object, no prepositions.
-     = \s -> lin V3 (regV s ** {c2 = prepOrRa "را" ; c3 = noPrep}) ;
+    mkV3 : Str -> V3 -- Predictable ditransitive: recipient with به, theme with را.
+     = \s -> lin V3 (regV s ** {c2 = prepOrRa "به" ; c3 = prepOrRa "را"}) ;
     mkV3 : V -> (dir,indir : Str) -> V3 -- Takes a verb and two prepositions or را as strings (can be empty).
      = \v,p,q -> lin V3 (v ** {c2 = prepOrRa p ; c3 = prepOrRa q}) ;
     mkV3 : V -> (dir,indir : Prep) -> V3 -- Takes a verb and two prepositions
@@ -142,16 +148,25 @@ oper
     = \v -> lin VQ v
   } ;
 
-  mkVA = overload {
+  mkVA = overload {
     mkVA : Str -> VA -- predictable verb with adjective complement
       = \s -> lin VA (regV s ** {c2 = noPrep}) ;
     mkVA : V -> VA -- VA out of a verb
       = \v -> lin VA (v ** {c2 = noPrep}) ;
     mkVA : V -> Prep -> VA -- VA out of a verb and preposition
       = \v,p -> lin VA (v ** {c2 = p}) ;
-    } ;
-
-  mkVS = overload {
+    } ;
+
+  mkV2A = overload {
+    mkV2A : Str -> V2A -- predictable verb with a direct object and adjective complement
+      = \s -> lin V2A (regV s ** {c2 = prepOrRa "را"}) ;
+    mkV2A : V -> V2A -- V2A out of V; را for the direct object
+      = \v -> lin V2A (v ** {c2 = prepOrRa "را"}) ;
+    mkV2A : V -> Prep -> V2A -- V2A out of V with the given object marker or preposition
+      = \v,p -> lin V2A (v ** {c2 = p})
+  } ;
+
+  mkVS = overload {
    mkVS : Str -> VS -- predictable verb with sentence complement in subjunctive.
     = \s -> lin VS (regV s ** {compl=subjunctive}) ;
    mkVS : V -> VS -- VS out of a verb, sentence complement in subjunctive.
@@ -161,12 +176,12 @@ oper
   } ;
 
   mkVV = overload {
-    mkVV : Str -> VV -- Predictable VV, subjunctive complement, is auxiliary.
-     = \s -> lin VV (regV s ** {isAux = True ; compl = subjunctive ; isDef = False}) ;
-    mkVV : V -> VV -- takes its VP complement in subjunctive. Is auxiliary.
-     = \v -> lin VV (v ** {isAux = True ; compl = subjunctive ; isDef = False}) ;
+    mkVV : Str -> VV -- Predictable VV with a subjunctive complement.
+     = \s -> lin VV (regV s ** {isAux = False ; compl = subjunctive ; isDef = False}) ;
+    mkVV : V -> VV -- takes its VP complement in subjunctive.
+     = \v -> lin VV (v ** {isAux = False ; compl = subjunctive ; isDef = False}) ;
     mkVV : VVForm -> V -> VV -- takes its VP complement in the given VVForm
-     = \vvf,v -> lin VV (v ** {isAux = True ; compl = vvf ; isDef = False}) ;
+     = \vvf,v -> lin VV (v ** {isAux = False ; compl = vvf ; isDef = False}) ;
     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 -> lin VV (v ** {isAux = isAux ; compl = vvf ; isDef = False})
   } ;
@@ -197,11 +212,17 @@ oper
   } ;
 
 
-----2 Adverbs
-  mkAdv : Str -> Adv -- Takes a string, returns an adverb.
-    = \str -> lin Adv {s = str} ;
-
-----2 Prepositions
+----2 Adverbs
+  mkAdv : Str -> Adv -- Takes a string, returns an adverb.
+    = \str -> lin Adv {s = str} ;
+
+  mkAdV : Str -> AdV -- Takes a string, returns a verb-modifying adverb.
+    = \str -> lin AdV {s = str} ;
+
+  mkAdA : Str -> AdA -- Takes a string, returns an adjective-modifying adverb.
+    = \str -> lin AdA {s = str} ;
+
+----2 Prepositions
 
   mkPrep = overload {
     mkPrep : Str -> Prep -- Takes a string, returns a preposition.
@@ -238,10 +259,13 @@ oper
       = \vvf,s -> mkSubj' s ** {compl=vvf}
   } ;
 
-  mkInterj : Str -> Interj
-    = \s -> lin Interj {s=s} ;
-
---.
+  mkInterj : Str -> Interj
+    = \s -> lin Interj {s=s} ;
+
+  mkVoc : Str -> Voc
+    = \s -> lin Voc {s=s} ;
+
+--.
 --2 Definitions of paradigms
 
 -- The definitions should not bother the user of the API. So they are
@@ -266,11 +290,11 @@ oper
   ezafe = ResPes.Ezafe ;
 
 
-  mkSubj' : Str -> Subj ;
-  mkSubj' s = lin Subj (case s of {
-    "آن" => {s = [] ; relpron = Ance ; compl = indicative} ;
-     _    => {s = s ; relpron = Ke ; compl = indicative}
-    }) ;
+  mkSubj' : Str -> Subj ;
+  mkSubj' s = lin Subj (case s of {
+    "آن" => {s = [] ; relpron = Ance ; compl = indicative} ;
+     _    => {s = s ; relpron = Ke ; compl = indicative}
+    }) ;
 
 -- Removed mkV_1, mkV_2, mkN01 and mkN02 from public API, still available for
 -- any applications that open ParadigmsPes. /IL 2019-02-08
@@ -364,18 +388,18 @@ oper
     compoundV : Str -> V -> V
       = \s,v -> v ** {
           prefix = s ;
-          lightverb = case v.lightverb of {Kardan => Kardan ; _ => Light}
+          lightverb = case v.lightverb of {BareKardan | Kardan => Kardan ; _ => Light}
         } ;
     compoundV : Str -> V2 -> V -- hidden from public API
       = \s,v -> lin V (v ** {prefix = s}) ;
   };
 
-  regV : Str -> V = \inf ->
-    let pres : Str = case inf of {
-          stem + ("ی"|"ا"|"و") + "دن" => stem ;
-          stem + ("تن"|"دن")           => stem }
-    in lin V (mkVerb inf pres) ;
-
+  regV : Str -> V = \inf ->
+    let pres : Str = case inf of {
+          stem + ("ی"|"ا"|"و") + "دن" => stem ;
+          stem + ("تن"|"دن")           => stem }
+    in lin V (mkVerb inf pres) ;
+
   mkV2 = overload {
     mkV2 : Str -> V2 -- Predictable V2 with را
       = \s -> lin V2 (regV s ** {c2 = prepOrRa "را"}) ;

src/persian/ResPes.gf

@@ -24,9 +24,9 @@ resource ResPes = MorphoPes ** open Prelude,Predef in {
                             -- dep. on Number because of RelCN
       } ;
 
-    NP : Type = BaseNP ** {
-      s : Mod => Str ; -- NP can appear with a clitic, need to keep Mod open
-      } ;
+    NP : Type = BaseNP ** {
+      s : Mod => Str ; -- NP can appear with a clitic, need to keep Mod open
+      } ;
 
     BaseNP : Type = {
       a : Agr ;
@@ -40,9 +40,9 @@ resource ResPes = MorphoPes ** open Prelude,Predef in {
       } ;
 
   oper
-    emptyNP : NP = {
-      s = \\_ => [] ;
-      a = defaultAgr ;
+    emptyNP : NP = {
+      s = \\_ => [] ;
+      a = defaultAgr ;
       isNeg = False ;
       takesYeAsComp = False ;
       animacy = Inanimate ;
@@ -218,26 +218,22 @@ oper
             => (addClitic vp.lightverb np.clitic vp).s ;
           _ => vp.s
         } ;
-    obj = vp.obj ++ vp.agrObj ! np.a ; -- "beg her to buy", buy agrees with her
-    isNeg = np.isNeg
-  } ;
+    obj = vp.obj ;
+    -- A V2V's dependent VP agrees with its object, but follows the finite
+    -- matrix verb in Persian: به او اجازه دادم برود.
+    vComp = \\a,t => vp.vComp ! a ! t ++ vp.agrObj ! np.a ;
+    isNeg = np.isNeg
+  } ;
 
 ---- AR 14/9/2017 trying to fix isAux = True case by inserting conjThat
 ---- but don't know yet how False should be affect
-  complVV : VV -> VPH -> (Agr => VVTense => Str) = \vv,vp ->
-    \\agr,ant => if_then_Str vv.isAux conjThat [] ++
-      case <ant,vv.isDef,vv.compl> of {
-       -- Auxiliaries with defective inflection: complement inflects in tense
-        <VVPast Indic,True,>  => showVPHwithImpPrefix (VPast Pos agr) agr vp ;
-        <VVPast Indic,_,_>    => showVPH (VPast Pos agr) agr vp ;
-        <VVPast Subj>         => showVPH PerfStem agr vp ++ subjAux Pos agr ;
-
-        -- Auxiliaries that take indicative (full or defective inflection)
-        <VVPres,_,Indic> => showVPH (VAor Pos agr) agr vp ;
-
-       -- Default: complement in subjunctive
-        _ => showVPH (VSubj Pos agr) agr vp
-    } ;
+  complVV : VV -> VPH -> (Agr => VVTense => Str) = \vv,vp ->
+    \\agr,ant => if_then_Str vv.isAux conjThat [] ++
+      case <ant,vv.compl> of {
+        <VVPast Subj,_> => showVPH PerfStem agr vp ++ subjAux Pos agr ;
+        <_,Indic>       => showVPH (VAor Pos agr) agr vp ;
+        _               => showVPH (VSubj Pos agr) agr vp
+    } ;
 
   insertAdv : Str -> VPH -> VPH = \ad,vp -> vp ** {
     ad = vp.ad ++ ad ;
@@ -309,13 +305,23 @@ oper
        ++ vps ++ vp.vComp ! agr ! vvt ++ vp.embComp
   };
 
-  predProg : VPH -> VPH = \verb -> verb ** {
-    s = \\vh => case vh of {
-      ImpPrefix _ => [] ;
-      VAor  p a => haveVerb.s ! VAor  Pos a ++ verb.s ! ImpPrefix p ++ verb.s ! VAor Pos a ;
-      VPast p a => haveVerb.s ! VPast Pos a ++ verb.s ! ImpPrefix p ++ verb.s ! VPast Pos a ; -- negation in ImpPrefix
-	    _ => verb.s ! vh } ; -- TODO more forms
-    } ;
+  -- The progressive auxiliary precedes the lexical predicate in Persian:
+  -- داشتند گل می‌دادند, not *گل داشتند می‌دادند. Keep VP-level
+  -- adverbs before the auxiliary, but put the lexical verb's arguments,
+  -- light-verb prefix and complements between the two verbs.
+  predProg : VPH -> VPH = \vp -> predV haveVerb ** {
+    ad = vp.ad ;
+    isNeg = vp.isNeg ;
+    vvtype = FullVV ;
+    vComp = \\agr,t =>
+      vp.comp ! agr ! OV ++ vp.obj ++ vp.prefix
+      ++ vp.s ! ImpPrefix Pos
+      ++ vp.s ! case t of {
+           VVPres   => VAor Pos agr ;
+           VVPast _ => VPast Pos agr
+         }
+      ++ vp.vComp ! agr ! t ++ vp.embComp
+    } ;
 
   IndefArticle : Str ;
   IndefArticle = "یک";

src/persian/SentencePes.gf

@@ -61,7 +61,9 @@ concrete SentencePes of Sentence = CatPes ** open Prelude, ResPes,Predef in {
             Subj  => cls.vp ! Sub        temp.a ! p.p ! ODir }
       } ;
 
-    AdvS a s = {s = \\vvf => a.s ++ s.s ! vvf} ;
+    AdvS a s = {s = \\vvf => a.s ++ s.s ! vvf} ;
+    ExtAdvS a s = {s = \\vvf => a.s ++ SOFT_BIND ++ "،" ++ s.s ! vvf} ;
+    AdvImp adv imp = {s = \\pol,n => adv.s ++ imp.s ! pol ! n} ;
 
     RelS s r = {s = \\vvf => s.s ! vvf ++ rs2str Ke (agrP3 Sg) r} ;
     SSubjS s1 sj s2 = {s = \\vvf => s1.s ! vvf ++ sj.s ++ s2.s ! sj.compl};

src/persian/VerbPes.gf

@@ -24,7 +24,9 @@ concrete VerbPes of Verb = CatPes ** open ResPes,Prelude in {
     SlashVV vv vps = vps ** ComplVV vv vps ;
     SlashV2S v s  = predVc v ** ComplVS v s ;
     SlashV2Q v q  = predVc v ** ComplVQ v q ;
-    SlashV2A v ap = predVc v ** insertObj (appComp v.c2 ap.s) (predV v) ; ---- paint it red , check form of adjective
+    -- The marker in a V2A belongs to the NP object, not to its AP predicate:
+    -- او دیوار را قرمز کرد, not *دیوار را قرمز را کرد.
+    SlashV2A v ap = predVc v ** insertObj (ap.s ! Bare) (predV v) ;
 
     -- : V2V -> VP -> VPSlash ;  -- beg (her) to go
     SlashV2V v2v vp = predVc v2v ** {
@@ -56,6 +58,9 @@ concrete VerbPes of Verb = CatPes ** open ResPes,Prelude in {
 
     AdvVP vp adv = insertAdv adv.s vp ;
     AdVVP adv vp = insertAdV adv.s vp ;
+    AdvVPSlash vp adv = vp ** insertAdv adv.s vp ;
+    AdVVPSlash adv vp = vp ** insertAdV adv.s vp ;
+    ExtAdvVP vp adv = insertAdv ("،" ++ adv.s) vp ;
     ReflVP = insertCompPre reflPron ;
     PassV2 = passV ;
 
@@ -66,7 +71,7 @@ concrete VerbPes of Verb = CatPes ** open ResPes,Prelude in {
     -- see https://sites.la.utexas.edu/persian_online_resources/nouns/noun-in-a-predicative-position/
     -- TODO: extend this to all verbs, when NP is indefinite
     CompCN cn = {
-      s = \\a => cn.s ! giveNumber a
+      s = \\a => cn.s ! Sg
                       ! case cn.hasAdj of {
                           False => Bare ;
                           True  => Clitic }