Merge pull request #73 from inariksit/arabic

(Ara) Conjunctions, ComplV*, additions in Idiom&Construction, etc.

src/arabic/CatAra.gf

@@ -38,7 +38,7 @@ concrete CatAra of Cat = CommonX - [Utt]  ** open ResAra, Prelude, ParamX in {
 
     VP = ResAra.VP ;
     VPSlash = ResAra.VPSlash ; -- VP ** {c2:Preposition}
-    Comp = ResAra.Comp ; --{s : AAgr => Case => Str} ;
+    Comp = ResAra.Comp ** {obj : Obj ; isNP : Bool} ;
 --    SC = {s : Str} ;
 --
 -- Adjective
@@ -94,5 +94,6 @@ linref
 
   CN = \cn -> uttCN cn ! Masc ;
   N = \n -> uttCN (useN n) ! Masc ;
+  VP = \vp -> uttVP vp ! Masc ;
 
 }

src/arabic/ConjunctionAra.gf

@@ -1,45 +1,80 @@
 concrete ConjunctionAra of Conjunction = 
   CatAra ** open ResAra, Coordination, Prelude in {
---
+
---  flags optimize=all_subs ;
+lincat
---
+
---  lin
+  [S],
---
+  [Adv] = {s1,s2 : Str} ;
---    ConjS = conjunctSS ;
+  [NP] = {s1,s2 : Case => Str ; a : Agr ; empty : Str} ;
---    DConjS = conjunctDistrSS ;
+  [AP] = {s1,s2 : Species => Gender => Number => State => Case => Str} ;
---
+
---    ConjAdv = conjunctSS ;
+lin
---    DConjAdv = conjunctDistrSS ;
+
---
+  BaseS,
---    ConjNP conj ss = conjunctTable Case conj ss ** {
+  BaseAdv = twoSS ;
---      a = {n = conjNumber conj.n ss.a.n ; p = ss.a.p}
+  ConsS,
---      } ;
+  ConsAdv = consrSS comma ;
---    DConjNP conj ss = conjunctDistrTable Case conj ss ** {
+  ConjS,
---      a = {n = conjNumber conj.n ss.a.n ; p = ss.a.p}
+  ConjAdv = conjunctSS ;
---      } ;
+
---
+  BaseNP x y = twoTable Case x y ** {
---    ConjAP conj ss = conjunctTable Agr conj ss ** {
+    a = conjAgr x.a y.a ;
---      isPre = ss.isPre
+    empty = []
---      } ;
+    } ;
---    DConjAP conj ss = conjunctDistrTable Agr conj ss ** {
+  ConsNP xs x = consrTable Case comma xs x ** {
---      isPre = ss.isPre
+    a = conjAgr xs.a x.a ;
---      } ;
+    empty = []
---
+    } ;
----- These fun's are generated from the list cat's.
+  ConjNP conj ss = conjunctTable Case conj ss ** {
---
+    a = let gn = pgn2gn ss.a.pgn in 
---    BaseS = twoSS ;
+        {pgn = Per3 gn.g (conjNumber conj.n gn.n) ; isPron = False} ;
---    ConsS = consrSS comma ;
+    empty = []
---    BaseAdv = twoSS ;
+    } ;
---    ConsAdv = consrSS comma ;
+
---    BaseNP x y = twoTable Case x y ** {a = conjAgr x.a y.a} ;
+  BaseAP x y = twoTable5 Species  Gender  Number  State  Case x y  ;
---    ConsNP xs x = consrTable Case comma xs x ** {a = conjAgr xs.a x.a} ;
+  ConsAP xs x = consrTable5 Species  Gender  Number  State  Case comma xs x ;
---    BaseAP x y = twoTable Agr x y ** {isPre = andB x.isPre y.isPre} ;
+  ConjAP conj ss = conjunctTable5 Species  Gender  Number  State  Case conj ss ;
---    ConsAP xs x = consrTable Agr comma xs x ** {isPre = andB xs.isPre x.isPre} ;
+
---
+
---  lincat
+oper
---    [S] = {s1,s2 : Str} ;
+  conjAgr : Agr -> Agr -> Agr = \a,b -> {
---    [Adv] = {s1,s2 : Str} ;
+    isPron = False ;
---    [NP] = {s1,s2 : Case => Str ; a : Agr} ;
+    pgn = let gnA = pgn2gn a.pgn ; gnB = pgn2gn b.pgn in
---    [AP] = {s1,s2 : Agr => Str ; isPre : Bool} ;
+    	  Per3 (conjGender gnA.g gnB.g) (conjNumber gnA.n gnB.n)
---
+    } ;
+
+  conjGender : Gender -> Gender -> Gender = \g,h ->
+    case g of {Fem => h ; _ => Masc} ;
+
+  conjNumber : Number -> Number -> Number = \m,n ->
+    case m of {Sg => n ; _ => Pl} ;
+
+  -- move to predef?
+
+  ListTable5 : PType -> PType -> PType -> PType -> PType -> Type = \P,Q,R,T,S -> 
+    {s1,s2 : P => Q => R => T => S => Str} ; 
+
+  twoTable5 : (P,Q,R,T,S : PType) -> (_,_ : {s : P => Q => R => T => S => Str}) -> 
+              ListTable5 P Q R T S = 
+    \_,_,_,_,_,x,y ->
+    {s1 = x.s ; s2 = y.s} ; 
+
+  consrTable5 : 
+    (P,Q,R,T,S : PType) -> Str -> {s : P => Q => R => T => S => Str} -> 
+       ListTable5 P Q R T S -> ListTable5 P Q R T S =
+     \P,Q,R,T,S,c,x,xs ->
+    {s1 = \\p,q,r,t,s => xs.s1 ! p ! q ! r ! t ! s ++ c ++ xs.s2 ! p ! q ! r ! t ! s ; 
+     s2 = x.s
+    } ; 
+
+  conjunctTable5 : 
+    (P,Q,R,T,S : PType) -> Conjunction -> ListTable5 P Q R T S -> {s : P => Q => R => T => S => Str} = 
+    \P,Q,R,T,S,or,xs ->
+    {s = \\p,q,r,t,s => xs.s1 ! p ! q ! r ! t ! s ++ or.s ++ xs.s2 ! p ! q ! r ! t ! s} ;
+
+  -- conjunctDistrTable5 : 
+  --   (P,Q,R,T,S : PType) -> ConjunctionDistr -> ListTable5 P Q R T S -> 
+  --      {s : P => Q => R => T => S => Str} = 
+  --   \P,Q,R,T,S,or,xs ->
+  --   {s = \\p,q,r,t,s => or.s1++ xs.s1 ! p ! q ! r ! t ! s ++ or.s2 ++ xs.s2 ! p ! q ! r ! t ! s} ;
 }

src/arabic/ConstructionAra.gf

@@ -1,8 +1,10 @@
 concrete ConstructionAra of Construction = CatAra ** open 
+  Prelude,
   ParadigmsAra,
   SyntaxAra,
   SymbolicAra,
   StructuralAra,
+  (E=ExtendAra),
   (R=ResAra),
   (L=LexiconAra) in {
 	
@@ -39,19 +41,26 @@ lin
 
 --  n_units_AP
 
+
+oper
+  -- hack used in the name constructions
+  toNP : Bool -> NP -> NP = \b -> if_then_else NP b R.emptyNP ;
+
+lin
   -- : NP -> NP -> Cl
-  have_name_Cl pe nm = 
+  have_name_Cl np nm = 
-    let subjPron : Pron = case pe.a.isPron of {
+    let subjPron : Pron = R.np2pron np ;
-          True  => pe ;
+        me : NP = toNP np.a.isPron np ;
-          False => case (R.pgn2gn pe.a.pgn).g of {
+        myName : NP = E.ApposNP me (mkNP (mkDet subjPron) L.name_N) ;
-                     R.Fem  => she_Pron ;
+     in mkCl myName nm ;
-                     R.Masc => he_Pron }
-        } ;
 
-        myName : NP = mkNP (mkDet subjPron) L.name_N ;
+  -- : NP -> QCl
-     in mkCl myName nm ; --TODO: now it only works for pronouns, drops the NP
+  what_name_QCl np = 
-
+    let subjPron : Pron = R.np2pron np ;
---  what_name_QCl = 
+        me : R.NP = toNP np.a.isPron np ;
+        myName : NP = E.ApposNP me (mkNP (mkDet subjPron) L.name_N) ;
+        what_IP : R.IP = R.mkIP "مَا هُوَ" R.Sg ;
+     in mkQCl what_IP myName ;
 
 --  how_old_QCl
 
@@ -76,7 +85,7 @@ lin
 oper mkLanguage : Str -> N = mkN ;
 
 ----------------------------------------------
----- lexicon of special names
+---- lexicon of snpcial names
 
 -- TODO in arabic
 lin second_Timeunit = mkN "second" ;
@@ -131,7 +140,7 @@ lin finnish_Language = mkLanguage "فِنْلَنْدِيّة" ;
 -- lin maltese_Language = mkLanguage "Maltese" ;
 -- lin nepali_Language = mkLanguage "Nepali" ;
 -- lin norwegian_Language = mkLanguage "Norwegian" ;
-lin persian_Language = mkLanguage "فَارِسيّة" ;
+lin nprsian_Language = mkLanguage "فَارِسيّة" ;
 -- lin polish_Language = mkLanguage "Polish" ;
 -- lin punjabi_Language = mkLanguage "Punjabi" ;
 -- lin romanian_Language = mkLanguage "Romanian" ;

src/arabic/ExtendAra.gf

@@ -6,7 +6,8 @@ concrete ExtendAra of Extend =
     StrandRelSlash, ExistPluralCN, ExistMassCN, ExistCN, EmptyRelSlash, DetNPMasc, DetNPFem,
     ComplBareVS, ComplDirectVS, ComplDirectVQ,
     ICompAP,
-    VPS, MkVPS
+    VPS, MkVPS,
+    ApposNP
 ]
   with (Grammar=GrammarAra)
   ** open
@@ -20,6 +21,9 @@ concrete ExtendAra of Extend =
   lin
     GenNP np = {s = \\_,_,_,_ => np.s ! Gen ; d = Const ; isNum,isPron,is1sg = False} ;
 
+    -- : NP -> NP -> NP
+    ApposNP np1 np2 = np2 ** {s = \\c => np1.s ! c ++ np2.s ! c} ;
+
     -- : AP -> IComp ;   -- "how old"
     ICompAP ap = {s = \\gn => "كَمْ" ++ ap.s ! NoHum ! gn.g ! gn.n ! Indef ! Acc} ;
 

src/arabic/IdiomAra.gf

@@ -1,15 +1,63 @@
-concrete IdiomAra of Idiom = CatAra ** open Prelude, ResAra in {
+concrete IdiomAra of Idiom = CatAra ** open 
-  flags coding=utf8;
+  Prelude,
---
+  ResAra,
---  flags optimize=all_subs ;
+  ParadigmsAra
---
+ in {
---  lin
+
---    ExistNP np = 
+
---      mkClause "تهري" (agrP3 np.a.n) (insertObj (\\_ => np.s ! Acc) (predAux auxBe)) ;
+ lin
---    ImpersCl vp = mkClause "ِت" (agrP3 Sg) vp ;
+
---    GenericCl vp = mkClause "ْني" (agrP3 Sg) vp ;
+  -- : VP -> Cl ;        -- it is hot
---
+  ImpersCl vp = 
---    ProgrVP vp = insertObj (\\a => vp.ad ++ vp.prp ++ vp.s2 ! a) (predAux auxBe) ;
+    let it : ResAra.NP = pron2np (pgn2pron vp.obj.a.pgn) ; -- if no obj, Per3 Masc Sg chosen by default
---
+     in predVP it vp ;
+
+  --  : VP -> Cl ;        -- one sleeps
+  GenericCl = predVP (regNP "المَرْء" Sg) ;    
+
+  -- : NP  -> RS -> Cl ; -- it is I who did it
+  --CleftNP np rs = 
+
+  -- : Adv -> S -> Cl ; -- it is here she slept
+  CleftAdv adv s = 
+  	let comp : Comp = {s = \\_,_ => adv.s ++ s.s} in ----
+  	predVP he_Pron (kaan comp) ;
+
+   -- : NP -> Cl ;        -- there is a house
+  ExistNP np =
+    predVP emptyNP (insertObj np (predV copula ** {c2=noPrep})) ; -- dummy /IL
+
+  -- ExistIP   : IP -> QCl ;       -- which houses are there
+
+-- 7/12/2012 generalizations of these
+
+   -- : NP -> Adv -> Cl ;    -- there is a house in Paris
+  ExistNPAdv np adv = 
+   	predVP emptyNP (insertStr adv.s (insertObj np (predV copula ** {c2=noPrep}))) ;
+
+   -- ExistIPAdv : IP -> Adv -> QCl ;   -- which houses are there in Paris
+
+    -- ProgrVP   : VP -> VP ;        -- be sleeping
+
+    -- ImpPl1    : VP -> Utt ;       -- let's go
+
+    -- ImpP3     : NP -> VP -> Utt ; -- let John walk
+
+-- 3/12/2013 non-reflexive uses of "self"
+
+  -- : VP -> VP ;        -- is at home himself; is himself at home
+  SelfAdvVP, 
+  SelfAdVVP = \vp -> vp ** {
+    s = \\pgn,vf => let pron : ResAra.NP = pgn2pron pgn in
+        vp.s ! pgn ! vf ++ refl ! Nom ++ pron.s ! Gen 
+    } ;
+
+  -- : NP -> NP ;        -- the president himself (is at home)
+  SelfNP np = np ** {
+  	s = let pron : ResAra.NP = np2pron np ;
+  		 in \\c => np.s ! c ++ refl ! c ++ pron.s ! Gen
+    } ;
+
+
 }
 

src/arabic/LangAra.gf

@@ -2,7 +2,8 @@
 
 concrete LangAra of Lang = 
   GrammarAra,
-  LexiconAra
+  LexiconAra,
+  ConstructionAra
   ** {
 
   flags startcat = Phr ; unlexer = text ; lexer = text ; coding = utf8 ;

src/arabic/MissingAra.gf

@@ -8,37 +8,19 @@ oper AdnCAdv : CAdv -> AdN = notYet "AdnCAdv" ;
 oper AdvCN : CN -> Adv -> CN = notYet "AdvCN" ;
 oper AdvIAdv : IAdv -> Adv -> IAdv = notYet "AdvIAdv" ;
 oper AdvS : Adv -> S -> S = notYet "AdvS" ;
-oper BaseAP : AP -> AP -> ListAP = notYet "BaseAP" ;
-oper BaseAdv : Adv -> Adv -> ListAdv = notYet "BaseAdv" ;
-oper BaseNP : NP -> NP -> ListNP = notYet "BaseNP" ;
 oper BaseRS : RS -> RS -> ListRS = notYet "BaseRS" ;
-oper BaseS : S -> S -> ListS = notYet "BaseS" ;
 oper CAdvAP : CAdv -> AP -> NP -> AP = notYet "CAdvAP" ;
-oper CleftAdv : Adv -> S -> Cl = notYet "CleftAdv" ;
 oper CleftNP : NP -> RS -> Cl = notYet "CleftNP" ;
 oper ComparAdvAdj : CAdv -> A -> NP -> Adv = notYet "ComparAdvAdj" ;
 oper ComparAdvAdjS : CAdv -> A -> S -> Adv = notYet "ComparAdvAdjS" ;
-oper ComplVA : VA -> AP -> VP = notYet "ComplVA" ;
-oper ComplVQ : VQ -> QS -> VP = notYet "ComplVQ" ;
-oper ComplVS : VS -> S -> VP = notYet "ComplVS" ;
-oper ConjAP : Conj -> ListAP -> AP = notYet "ConjAP" ;
-oper ConjAdv : Conj -> ListAdv -> Adv = notYet "ConjAdv" ;
-oper ConjNP : Conj -> ListNP -> NP = notYet "ConjNP" ;
 oper ConjRS : Conj -> ListRS -> RS = notYet "ConjRS" ;
-oper ConjS : Conj -> ListS -> S = notYet "ConjS" ;
-oper ConsAP : AP -> ListAP -> ListAP = notYet "ConsAP" ;
-oper ConsAdv : Adv -> ListAdv -> ListAdv = notYet "ConsAdv" ;
-oper ConsNP : NP -> ListNP -> ListNP = notYet "ConsNP" ;
 oper ConsRS : RS -> ListRS -> ListRS = notYet "ConsRS" ;
-oper ConsS : S -> ListS -> ListS = notYet "ConsS" ;
 oper DetNP : Det -> NP = notYet "DetNP" ;
 oper EmbedQS : QS -> SC = notYet "EmbedQS" ;
 oper EmbedS : S -> SC = notYet "EmbedS" ;
 oper EmbedVP : VP -> SC = notYet "EmbedVP" ;
 oper ExistIP : IP -> QCl = notYet "ExistIP" ;
-oper ExistNP : NP -> Cl = notYet "ExistNP" ;
 oper FunRP : Prep -> NP -> RP -> RP = notYet "FunRP" ;
-oper GenericCl : VP -> Cl = notYet "GenericCl" ;
 oper ImpPl1 : VP -> Utt = notYet "ImpPl1" ;
 oper ImpersCl : VP -> Cl = notYet "ImpersCl" ;
 oper PConjConj : Conj -> PConj = notYet "PConjConj" ;

src/arabic/NounAra.gf

@@ -6,7 +6,7 @@ lin
 
   DetCN det cn = let {
     cas : Case -> Case = if_then_else Case det.is1sg Bare ;
-    number = sizeToNumber det.n ;
+    number = case cn.isDual of {True => Dl ; _ => sizeToNumber det.n} ;
     determiner : Case -> Str = \c ->
       det.s ! cn.h ! (detGender cn.g det.n) ! c ;
     noun : Case -> Str = \c -> 
@@ -169,8 +169,11 @@ lin
     isNum,isPron,is1sg = False
     } ;
 
-  MassNP cn = ---- AR
+  MassNP cn =
-    {s = \\c => cn.s ! Sg ! Indef ! c ++ cn.np ! c ++ cn.adj ! Sg ! Indef ! c ; 
+    {s = \\c => cn.s ! Sg ! Indef ! c 
+       ++ cn.s2 ! Sg ! Indef ! c
+       ++ cn.np ! c 
+       ++ cn.adj ! Sg ! Indef ! c ; 
      a = {pgn = Per3 cn.g Sg ; isPron = False} ;
      empty = []} ;
 

src/arabic/ParadigmsAra.gf

@@ -76,6 +76,8 @@ resource ParadigmsAra = open
 ---    = sdfN ;
    } ;
 
+  dualN : N -> N ;
+
 --This is used for loan words or anything that has untreated irregularities
 --in the interdigitization process of its words
   mkFullN : NTable -> Gender -> Species -> N ;
@@ -261,7 +263,8 @@ resource ParadigmsAra = open
   mkV2S : V -> Str -> V2S ;
   mkVV = overload {
     mkVV : V -> VV = regVV ;
-    mkVV : V -> Str -> VV = c2VV
+    mkVV : V -> Str -> VV = c2VV ;
+    mkVV : V -> Preposition -> VV = prepVV
     } ;
   mkV2V : overload {
     mkV2V : V -> Str -> Str -> V2V ;
@@ -349,11 +352,17 @@ resource ParadigmsAra = open
      = \n,attr -> n ** {s2 = \\n,s,c => attr} ;
    mkN : N -> N -> N                                                  -- Compound nouns
      = \n1,n2 -> n1 ** {s2 =
-      \\n,s,c => n1.s2 ! n ! s ! c -- card
+      \\n,s,c => n1.s2 ! n ! s ! c
-              ++ n2.s  ! n ! s ! c -- type
+              ++ n2.s  ! n ! s ! c
-              ++ n2.s2 ! n ! s ! c} ; -- blood
+              ++ n2.s2 ! n ! s ! c} ;
    } ;
 
+  dualN : N -> N = \n -> n ** {isDual=True} ;
+
+  proDrop : NP -> NP ; -- Force a NP to lose its string, only contributing with its agreement.
+
+  mkPron : (_,_,_ : Str) -> PerGenNum -> Pron ;
+
   mkV = overload {
     mkV : (imperfect : Str) -> V
       = regV ;
@@ -470,12 +479,12 @@ resource ParadigmsAra = open
                 _         => v10sound }
       } in lin V (v10fun rbT) ;
 
-  mkFullN nsc gen spec =
+  mkFullN nsc gen spec = lin N
     { s = nsc; --NTable
       s2 = emptyNTable;
       g = gen;
       h = spec;
-      lock_N = <>
+      isDual = False
     };
 
   brkN' : Str -> Str -> Str -> Gender -> Species -> N =
@@ -533,31 +542,19 @@ resource ParadigmsAra = open
   } ;
 
   mkPron : (_,_,_ : Str) -> PerGenNum -> Pron = \ana,nI,I,pgn ->
-    lin Pron { s =
+    lin Pron (ResAra.mkPron ana nI I pgn) ;
-        table {
-          Acc => BIND ++ nI; -- object suffix
-          Gen => BIND ++ I;  -- possessive suffix
-          _   => ana
-        };
-      a = {pgn = pgn; isPron = True };
-      empty = []
-    };
 
-  proDrop : NP -> NP = ResAra.proDrop ; -- Force a NP to lose its string, only contributing with its agreement.
+  proDrop : NP -> NP = \np -> lin NP (ResAra.proDrop np) ;
 
   -- e.g. al-jamii3, 2a7ad
-  regNP : Str -> Number -> NP = \word,n -> lin NP
+  regNP : Str -> Number -> NP = \word,n -> lin NP (emptyNP ** { 
-    { s = \\c => fixShd word (dec1sg ! Def ! c) ;
+    s = \\c => fixShd word (dec1sg ! Def ! c)
-      a = {pgn = Per3 Masc n; isPron = False };
+    });
-      empty = []
-    };
 
   -- e.g. hadha, dhaalika
-  indeclNP : Str -> Number -> NP = \word,n -> lin NP
+  indeclNP : Str -> Number -> NP = \word,n -> lin NP (emptyNP ** { 
-    { s = \\c => word ;
+    s = \\c => word
-      a = {pgn = Per3 Masc n; isPron = False };
+    });
-      empty = []
-    };
 
   mkQuant7 : (_,_,_,_,_,_,_ : Str) -> State -> Quant =
     \hava,havihi,havAn,havayn,hAtAn,hAtayn,hA'ulA,det -> lin Quant (baseQuant **
@@ -666,7 +663,8 @@ resource ParadigmsAra = open
   mkVQ  v = v ** {lock_VQ = <>} ;
 
   regVV : V -> VV = \v -> lin VV v ** {c2 = mkPreposition "أَنْ"} ;
-  c2VV : V -> Str -> VV = \v,prep -> regVV v ** {c2 = noPrep} ;
+  c2VV : V -> Str -> VV = \v,prep -> regVV v ** {c2 = mkPreposition prep} ;
+  prepVV : V -> Preposition -> VV = \v,prep -> regVV v ** {c2=prep} ;
 
   V0 : Type = V ;
 ----  V2S, V2V, V2Q, V2A : Type = V2 ;

src/arabic/PhraseAra.gf

@@ -17,7 +17,7 @@ concrete PhraseAra of Phrase = CatAra ** open
 
     UttCN cn = {s = ResAra.uttCN cn } ; --IL
     UttNP np = {s = \\_ => np.s ! Nom} ;
-    UttVP vp = {s = \\g => (compVP vp).s ! {g=g ; n=Sg} ! Nom} ; --IL
+    UttVP vp = {s = uttVP vp} ; --IL
     UttS,
     UttAdv,
     UttIAdv = \s -> {s = \\_ => s.s} ; ---- OK? AR

src/arabic/QuestionAra.gf

@@ -7,8 +7,8 @@ concrete QuestionAra of Question = CatAra ** open ResAra, ParamX, Prelude, VerbA
     QuestCl cl = {
       s = \\t,p =>
         table {
-          QIndir => "إِذا" ++ cl.s ! t ! p ! Verbal ;
+          QIndir => "إِذا" ++ cl.s ! t ! p ! toOrder QIndir ;
-          QDir => "هَلْ" ++ cl.s ! t ! p ! Verbal
+          QDir => "هَلْ" ++ cl.s ! t ! p ! toOrder QDir
         }
       };
 
@@ -18,12 +18,12 @@ concrete QuestionAra of Question = CatAra ** open ResAra, ParamX, Prelude, VerbA
     QuestVP qp vp =
      let np = ip2np qp vp.isPred ;
          cl = PredVP np vp ;
-      in { s = \\t,p,_qf => cl.s ! t ! p ! Nominal } ;
+      in { s = \\t,p,qf => cl.s ! t ! p ! toOrder qf } ;
 
 
 
 ---- AR guessed
-   QuestIAdv iadv cl = {s = \\t,p,_ => iadv.s ++ cl.s ! t ! p ! Verbal} ;
+   QuestIAdv iadv cl = {s = \\t,p,qf => iadv.s ++ cl.s ! t ! p ! toOrder qf} ;
 
 ---- IL guessed
    -- : IComp -> NP -> QCl
@@ -46,7 +46,7 @@ concrete QuestionAra of Question = CatAra ** open ResAra, ParamX, Prelude, VerbA
    QuestSlash ip cls = { ----IL just guessing
       s = \\t,p,qf => 
         let cl : ResAra.Cl = complClSlash cls ; -- dummy conversion to Cl
-            o = case qf of { QDir => Nominal ; _ => Verbal } ; -- purely guessing
+            o = toOrder qf
           in cls.c2.s ++ ip.s ! False ! Masc ! Def ! Nom ++ cl.s ! t ! p ! o
       } ;
 

src/arabic/RelativeAra.gf

@@ -1,5 +1,5 @@
 concrete RelativeAra of Relative = CatAra ** 
-  open ResAra, (Se=SentenceAra), (St=StructuralAra) in {
+  open ResAra in {
  flags coding=utf8;
 
  lin
@@ -13,8 +13,8 @@ concrete RelativeAra of Relative = CatAra **
      s = \\t,p,agr,c => 
        let 
          npS : Case => Str = \\_ => rp.s ! agr2ragr agr c ;
-         np = emptyNP ** {s = npS ; a = agr} ;
+         np : NP = agrNP agr ** {s = npS} ;
-         cl = Se.PredVP np vp ;
+         cl = predVP np vp ;
        in
        cl.s ! t ! p ! Nominal
      } ;
@@ -22,9 +22,8 @@ concrete RelativeAra of Relative = CatAra **
     -- : RP -> ClSlash -> RCl ; -- whom John loves 
    RelSlash rp cls = cls ** {
      s = \\t,p,agr,c => 
-        let obj = case (pgn2gn agr.pgn).g of {
+        let --empty : Agr -> NP = emptyNP ;
-        			Fem  => St.she_Pron ; -- head is repeated as a clitic object pronoun
+            obj : ResAra.NP = pgn2pron agr.pgn ; -- head is repeated as a clitic object pronoun
-        			Masc => St.he_Pron } ;
             cl : ResAra.Cl = complClSlash obj cls ;
         in rp.s ! agr2ragr agr c ++ cl.s ! t ! p ! VOS
      } ;

src/arabic/ResAra.gf

@@ -31,7 +31,8 @@ resource ResAra = PatternsAra ** open  Prelude, Predef, OrthoAra, ParamX  in {
 
   oper
 
-    --roots, patterns, and making words:
+-----------------------------------------------------------------------------
+-- General morphology with roots, patterns, and making words:
 
     Pattern : Type = {h, m1, m2, t : Str};
     Root    : Type = {f : Str};
@@ -109,7 +110,12 @@ resource ResAra = PatternsAra ** open  Prelude, Predef, OrthoAra, ParamX  in {
     emptyNTable : NTable = \\n,s,c => [] ;
 
     Preposition : Type = {s : Str ; c : Case} ;
-    Noun : Type = {s,s2 : NTable ; g : Gender; h : Species} ;
+    Noun : Type = { 
+      s,s2 : NTable ; 
+      g : Gender ; 
+      h : Species ; 
+      isDual : Bool -- whether it takes dual instead of plural: eyes, twins, ...
+      } ;
     Noun2 : Type = Noun ** {c2 : Preposition} ;
     Noun3 : Type = Noun2 ** {c3 : Preposition} ;
 
@@ -118,6 +124,8 @@ resource ResAra = PatternsAra ** open  Prelude, Predef, OrthoAra, ParamX  in {
       mkPreposition : Str -> Preposition = \s -> {s=s;c=Gen} ;
     } ;
 
+    noPrep : Preposition = mkPreposition [] Nom ;
+
     Adj  : Type = {s : AForm => Str} ;
     Adj2 : Type = Adj ** {c2 : Preposition} ;
 
@@ -1138,18 +1146,14 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
                       }
       };
 
+    gn2pgn : {g : Gender; n : Number} -> PerGenNum = \gn -> 
+      case gn of { {g = gn; n = nm} => Per3 gn nm } ;
+
+    -- these are chosen in many places, trying to be consistent
+    toOrder : QForm -> Order = \qf ->
+      case qf of { QIndir => Nominal ;
+                   QDir   => Verbal } ;
 
-    mkIP = overload { 
-       mkIP : Str -> Number -> IP = \maa,n -> {
-          s = \\_p,_g,_s,_c => maa ; 
-          a = { pgn = agrP3 NoHum Masc n ; isPron = False }
-          } ;
-      mkIP : (_,_ : Str) -> Number -> IP = \maa,maadhaa,n -> {
-          s = table { True  => \\_g,_s,_c => maa ; 
-                      False => \\_g,_s,_c => maadhaa } ; 
-          a = { pgn = agrP3 NoHum Masc n ; isPron = False }
-          } 
-      } ;
 
     mkOrd : (_,_ : Str) -> Size -> NumOrdCard =
       \aysar,yusra,sz ->
@@ -1163,7 +1167,9 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
       };
 
 
-  oper
+
+-----------------------------------------------------------------------------
+-- Det, Quant
 
     BaseQuant : Type = {
       d : State;
@@ -1194,21 +1200,8 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
     AAgr = { g : Gender ; n : Number} ;
 
 
-
+-----------------------------------------------------------------------------
-    Comp : Type = {
+-- NP, Pron
-      s : AAgr => Case => Str
-      } ;
-
-    IComp : Type = {
-      s : AAgr     -- "how old": masc or fem for adjective
-                   -- no need for Case, IComp is only used by QuestIComp, as grammatical subject
-       => Str ;
-      } ;
-
-    Obj : Type = {
-      s : Str ;
-      a : Agr
-      };
 
     NP : Type = {
       s : Case => Str ;
@@ -1216,6 +1209,17 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
       empty : Str -- to prevent ambiguities with prodrop
       } ;
 
+    mkPron : (_,_,_ : Str) -> PerGenNum -> NP = \ana,nI,I,pgn ->
+     { s =
+        table {
+          Acc => BIND ++ nI; -- object suffix
+          Gen => BIND ++ I;  -- possessive suffix
+          _   => ana
+        };
+      a = {pgn = pgn; isPron = True };
+      empty = []
+    };
+
     proDrop : NP -> NP = \np -> 
       case np.a.isPron of {
         True => np ** {s = \\_ => []};
@@ -1227,6 +1231,58 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
       a = {pgn = Per3 Masc Sg ; isPron = False} ;
       empty = [] } ;
 
+    agrNP : Agr -> NP = \agr -> emptyNP ** {a = agr} ;
+
+    i_Pron : NP = mkPron "أَنَا" "نِي" "ي" (Per1 Sing) ;
+    youSgMasc_Pron : NP = mkPron "أَنتَ" "كَ" "كَ" (Per2 Masc Sg) ;
+    youSgFem_Pron : NP = mkPron "أَنتِ" "كِ" "كِ" (Per2 Fem Sg) ;
+    youDlMasc_Pron : NP = mkPron "أَنتُمَا" "كُمَا" "كُمَا" (Per2 Masc Dl) ;
+    youDlFem_Pron : NP = mkPron "أَنتُمَا" "كُمَا" "كُمَا" (Per2 Fem Dl) ;
+    he_Pron : NP = mkPron "هُوَ" "هُ" "هُ" (Per3 Masc Sg) ;
+    she_Pron : NP = mkPron "هِيَ" "ها" "ها" (Per3 Fem Sg) ;
+    we_Pron : NP = mkPron "نَحنُ" "نا" "نا" (Per1 Plur) ;
+    youPlMasc_Pron : NP = mkPron "أَنتُمْ" "كُمْ" "كُمْ" (Per2 Masc Sg) ;
+    youPlFem_Pron : NP = mkPron "أَنتُنَّ" "كُنَّ" "كُنَّ" (Per2 Fem Sg) ;
+    theyMasc_Pron : NP = mkPron "هُمْ" "هُمْ" "هُمْ" (Per3 Masc Pl) ;
+    theyFem_Pron : NP = mkPron "هُنَّ" "هُنَّ" "هُنَّ" (Per3 Fem Pl) ;
+    theyDlMasc_Pron : NP = mkPron "هُمَا" "هُمَا" "هُمَا" (Per3 Masc Dl) ;
+    theyDlFem_Pron : NP = mkPron "هُمَا" "هُمَا" "هُمَا" (Per3 Fem Dl) ;
+
+    -- Used e.g. to encode the subject as an object clitic
+    -- or to find a possessive suffix corresponding to the NP.
+    -- If the NP is a pronoun, just use itself.
+    np2pron : NP -> NP = \np -> case np.a.isPron of {
+      True  => np ;
+      False => pgn2pron np.a.pgn
+      } ;
+
+    pgn2pron : PerGenNum -> NP = \pgn -> 
+      case pgn of {
+        Per1 Sing => i_Pron ;
+        Per1 Plur => we_Pron ;
+        Per2 Fem  Sg => youSgFem_Pron ;
+        Per2 Masc Sg => youSgMasc_Pron ;
+        Per2 Fem  Dl => youDlFem_Pron ;
+        Per2 Masc Dl => youDlMasc_Pron ;
+        Per2 Fem  Pl => youPlFem_Pron ;
+        Per2 Masc Pl => youPlMasc_Pron ;
+        Per3 Fem  Sg => she_Pron ;
+        Per3 Masc Sg => he_Pron ;
+        Per3 Fem  Dl => theyDlFem_Pron ;
+        Per3 Masc Dl => theyDlMasc_Pron ;
+        Per3 Fem  Pl => theyFem_Pron ;
+        Per3 Masc Pl => theyMasc_Pron 
+      } ;
+
+    pron2np : NP -> NP = \np -> np ** {
+      a = np.a ** {isPron=False} -- hack, sometimes we *don't* want prodrop
+    } ;
+
+    refl : Case => Str = \\c => "نَفْس" + caseTbl ! c ;
+
+-----------------------------------------------------------------------------
+-- IP, questions
+
     IP : Type = {
       s : Bool -- different forms for "what is this" and "what do you do"
        => Gender -- because an IP can be made into an IComp
@@ -1235,6 +1291,18 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
       a : Agr -- can be both subject and object of a QCl, needs full agr. info (stupid given that s depends on gender but meh)
       } ;
 
+    mkIP = overload { 
+       mkIP : Str -> Number -> IP = \maa,n -> {
+          s = \\_p,_g,_s,_c => maa ; 
+          a = { pgn = agrP3 NoHum Masc n ; isPron = False }
+          } ;
+      mkIP : (_,_ : Str) -> Number -> IP = \maa,maadhaa,n -> {
+          s = table { True  => \\_g,_s,_c => maa ; 
+                      False => \\_g,_s,_c => maadhaa } ; 
+          a = { pgn = agrP3 NoHum Masc n ; isPron = False }
+          } 
+      } ;
+
     ip2np : IP -> Bool -> NP = \ip,isPred -> ip ** { s = ip.s ! isPred ! Masc ! Def ; empty = [] } ;
     np2ip : NP -> IP = \np -> np ** {s = \\_,_,_ => np.s} ;
     
@@ -1248,6 +1316,15 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
       s : State => Case => Str
       } ;
 
+    IComp : Type = {
+      s : AAgr     -- "how old": masc or fem for adjective
+                   -- no need for Case, IComp is only used by QuestIComp, as grammatical subject
+       => Str ;
+      } ;
+
+-----------------------------------------------------------------------------
+-- VP
+
   param VPForm =
         VPPerf
       | VPImpf Mood
@@ -1263,16 +1340,10 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
       s2 : Str
       };
 
-    -- For complements of VV.
+    uttVP : VP -> (Gender=>Str) = \vp ->
-    -- TODO: does verbal complement agree with the noun
+     \\g => vp.s ! Per3 g Sg ! VPPerf 
-    compVP : VP -> Comp = \vp -> ---- IL
+         ++ vp.obj.s ++ vp.pred.s ! {n = Sg ; g = g} ! Nom
-     { s = table {
+         ++ vp.s2 ;
-         aagr@{g=g ; n=n} => \\c =>
-           vp.s ! Per3 g n ! VPImpf Ind  ---- IL guesswork + https://arabic.desert-sky.net/g_modals.html
-           ++ vp.s2
-           ++ vp.pred.s ! aagr ! Acc
-           ++ vp.obj.s }
-      } ;
 
     predV : Verb -> VP = \v ->
       { s = \\pgn,vf =>
@@ -1282,10 +1353,7 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
             VPImpf m => v.s ! (VImpf m Act pgn);
             VPImp => v.s ! (VImp gn.g gn.n)
           };
-        obj = {
+        obj = emptyObj ;
-          s = [] ;
-          a = {pgn = Per3 Masc Sg ; isPron = False}
-          }; --or anything!
         s2 = [];
         pred = {s = \\_,_ => []} ;
         isPred = False
@@ -1357,10 +1425,24 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
         _        => pgn
       };
 
+-----------------------------------------------------------------------------
+-- Comp, arguments for VP
+
+    Comp : Type = {
+      s : AAgr => Case => Str ;
+      } ;
+
+    Obj : Type = {
+      s : Str ;
+      a : Agr -- default Agr in a VP without real Obj is Per3 Masc Sg
+      };
+
+    emptyObj : Obj = emptyNP ** {s=[]} ;
+
     insertObj : NP -> VPSlash -> VP = \np,vp -> vp **
       { obj = {s = vp.obj.s ++ vp.c2.s ++ np.s ! vp.c2.c ; a = np.a} };
 
-    insertPred : {s : AAgr => Case => Str} -> VP -> VP = \p,vp -> vp **
+    insertPred : Comp -> VP -> VP = \p,vp -> vp **
       { pred = p;
         isPred = True
       };
@@ -1372,6 +1454,8 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
       insertPred xabar (predV copula);
 
     copula : Verb = v1hollow {f = "ك"; c = "و" ; l = "ن"} u ;
+
+-----------------------------------------------------------------------------
 -- Slash categories
 
     VPSlash : Type = VP ** {c2 : Preposition} ;
@@ -1397,7 +1481,9 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
     Cl  : Type = {s : Tense => Polarity => Order => Str} ;
     QCl : Type = {s : Tense => Polarity => QForm => Str} ;
 
+-----------------------------------------------------------------------------
 -- Relative
+
   param 
     RAgr = RSg Gender | RPl Gender | RDl Gender Case ;
 
@@ -1418,6 +1504,9 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
     RCl : Type = {s : Tense => Polarity => Agr => Case => Str} ;
     RP  : Type = {s : RAgr => Str } ;
 
+-----------------------------------------------------------------------------
+-- Num
+
   param
 
     Size = One | Two | ThreeTen | Teen | NonTeen | Hundreds | None ;
@@ -1505,6 +1594,4 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
         Masc => Fem;
         Fem => Masc
       };
-
-
 }

src/arabic/StructuralAra.gf

@@ -35,7 +35,7 @@ concrete StructuralAra of Structural = CatAra **
   few_Det = mkDet "بَعض" Pl Const ;
 --  first_Ord = ss "فِرست" ;
   from_Prep = mkPrep "مِنَ" ;
-  he_Pron = mkPron "هُوَ" "هُ" "هُ" (Per3 Masc Sg) ;
+  he_Pron = ResAra.he_Pron ;
   here_Adv = ss "هُنا" ;
 --  here7to_Adv = ss ["تْ هري"] ;
 --  here7from_Adv = ss ["فرْم هري"] ;
@@ -43,7 +43,7 @@ concrete StructuralAra of Structural = CatAra **
 --  how8many_IDet = mkDet "كَمْ" Pl Const ;   -- IL: check (was ["هْو مَني"]) ;
 --  if_Subj = ss "ِف" ;
   in8front_Prep = mkPrep "مُقَابِلَ" ;
-  i_Pron  = mkPron "أَنَا" "نِي" "ي" (Per1 Sing);
+  i_Pron  = ResAra.i_Pron ;
   in_Prep = mkPrep "فِي" ;
   it_Pron = he_Pron ; -- was: it_Pron = mkPron "ِت" "ِت" "ِتس" (Per3 Masc Sg);
 --  less_CAdv = ss "لسّ" ;
@@ -66,7 +66,7 @@ concrete StructuralAra of Structural = CatAra **
 --  please_Voc = ss "ةلَسي" ;
   possess_Prep = mkPrep "ل" ;
 --  quite_Adv = ss "قُِتي" ;
-  she_Pron = mkPron "هِيَ" "ها" "ها" (Per3 Fem Sg) ;
+  she_Pron = ResAra.she_Pron ;
 --  so_AdA = ss "سْ" ;
   somebody_NP = regNP "أَحَد" Sg ;
   someSg_Det = mkDet "أَحَد" Sg Const ;
@@ -80,7 +80,7 @@ concrete StructuralAra of Structural = CatAra **
 --  there7from_Adv = ss ["فرْم تهري"] ;
 --  therefore_PConj = ss "تهرفْري" ;
 ----b  these_NP = indeclNP "هَؤُلَاء" Pl ;
- they_Pron = mkPron "هُمْ" "هُمْ" "هُمْ" (Per3 Masc Pl) ;
+ they_Pron = theyMasc_Pron ;
   this_Quant = mkQuant7 "هَذا" "هَذِهِ" "هَذَان" "هَذَيْن" "هَاتَان" "هَاتَيْن" "هَؤُلَاء" Def;
 ----b  this_NP = indeclNP "هَذا" Sg ;
 ----b  those_NP = indeclNP "هَؤُلَاءكَ" Pl ;
@@ -90,7 +90,7 @@ concrete StructuralAra of Structural = CatAra **
   under_Prep = mkPrep "تَحْتَ" ;
 --  very_AdA = ss "ثري" ;
 --  want_VV = P.mkVV (P.regV "وَنت") ;
-  we_Pron = mkPron "نَحنُ" "نا" "نا" (Per1 Plur) ;
+  we_Pron = ResAra.we_Pron ;
   whatPl_IP = mkIP "ما" "ماذا" Pl ;
   whatSg_IP = mkIP "ما" "ماذا" Sg ;
   when_IAdv = ss "مَتَى" ;
@@ -113,9 +113,9 @@ concrete StructuralAra of Structural = CatAra **
   without_Prep = mkPrep "بِدُونِ" ;
   with_Prep = mkPrep "مَع" ;
   yes_Utt = {s = \\_ => "نَعَم"} ;
-  youSg_Pron = mkPron "أَنتَ" "كَ" "كَ" (Per2 Masc Sg) ;
+  youSg_Pron = youSgMasc_Pron ;
-  youPl_Pron = mkPron "أَنتُمْ" "كُمْ" "كُمْ" (Per2 Masc Sg) ;
+  youPl_Pron = youPlMasc_Pron ;
-  youPol_Pron = mkPron "أَنتِ" "كِ" "كِ" (Per2 Fem Sg) ;
+  youPol_Pron = youSgFem_Pron ; -- arbitrary?
 
   have_V2      = dirV2 (regV "يَملِك") ;
 

src/arabic/VerbAra.gf

@@ -1,4 +1,4 @@
-concrete VerbAra of Verb = CatAra ** open Prelude, ResAra in {
+concrete VerbAra of Verb = CatAra ** open Prelude, ResAra, ParamX in {
 
   flags optimize=all_subs ;
 
@@ -16,13 +16,8 @@ concrete VerbAra of Verb = CatAra ** open Prelude, ResAra in {
 
     ComplSlash vp np = insertObj np vp ;
 
---    Complv3 v np np2 = insertObj np2 (insertObj np (predV v)) ;
+    -- : VV  -> VP -> VP ;  -- want to run
-
+    ComplVV vv vp = let vvVP = predV vv in -- IL
-{-{s = \\_ => v.c2 ++ np.s ! Acc ++ v.c3 ++ np2.s ! Acc ;
-                 a = {pgn = Per3 Masc Sg ; isPron = False} } --FIXME
-      (predV v) ;-}
-
-    ComplVV vv vp =  let vvVP = predV vv in --- IL
       vp ** {
         s = \\pgn,vpf => vvVP.s ! pgn ! vpf
                       ++ vv.c2.s  -- أَنْ
@@ -30,14 +25,26 @@ concrete VerbAra of Verb = CatAra ** open Prelude, ResAra in {
         isPred = False
       } ;
 
---    ComplVS v s  = insertObj (\\_ => conjThat ++ s.s) (predV v) ;
+    -- : VS -> S -> VP ;  -- say that she runs
---    ComplVQ v q  = insertObj (\\_ => q.s ! QIndir) (predV v) ;
+    ComplVS vs s = predV vs ** { -- IL
---
+      obj = emptyObj ** s } ;
---    ComplVA  v    ap = insertObj (ap.s) (predV v) ;
+
+    -- : VQ -> QS -> VP ;  -- wonder who runs
+    ComplVQ vq qs = predV vq ** { -- IL
+      obj = emptyObj ** {s = qs.s ! QIndir}
+      } ;
+
+    -- : VA -> AP -> VP ;  -- they become red
+    ComplVA v ap = predV v ** {comp = CompAP ap} ;
+
 --    ComplV2A v np ap =
 --      insertObj (\\_ => v.c2 ++ np.s ! Acc ++ ap.s ! np.a) (predV v) ;
 --
-    UseComp xabar = kaan xabar ;
+    UseComp xabar =
+      case xabar.isNP of {
+        False => kaan xabar ;
+        True  => predV copula ** {obj = xabar.obj ; isPred=True} 
+      } ;
 
     UseCopula = predV copula ;
 
@@ -51,10 +58,14 @@ concrete VerbAra of Verb = CatAra ** open Prelude, ResAra in {
 --
 --    UseVS, UseVQ = \vv -> {s = vv.s ; c2 = [] ; isRefl = vv.isRefl} ; -- no
 
-    CompCN cn = {s = \\agr,c => cn.s ! agr.n ! Indef ! c ++ cn.np ! c ++ cn.adj ! agr.n ! Indef ! c} ; ----IL
+    CompAP ap = {s   = \\agr,c => ap.s ! Hum ! agr.g ! agr.n ! Indef ! c ; --FIXME
-    CompAP ap = {s = \\agr,c => ap.s ! Hum ! agr.g ! agr.n ! Indef ! c} ; --FIXME
+                 obj = emptyObj ; isNP = False} ;
-    CompNP np = {s = \\_,c => np.s ! c};
+    CompAdv a = {s   = \\_,_ => a.s ;
-    CompAdv a = {s = \\_,_ => a.s} ;
+                 obj = emptyObj ; isNP = False} ;
+
+    CompCN cn = {s = \\agr,c => cn.s ! agr.n ! Indef ! Nom ++ cn.np ! Nom ++ cn.adj ! agr.n ! Indef ! Nom ;
+                 obj = emptyObj ; isNP = False} ;
+    CompNP np = {s = \\_,_ => [] ; obj = np ** {s = np.s ! Nom} ; isNP = True} ;
 --
 --
 }