Merge pull request #152 from inariksit/arabic

Arabic: add new funs and change V*V/V*S lincats

src/arabic/CatAra.gf

@@ -77,12 +77,12 @@ concrete CatAra of Cat = CommonX - [Utt]  ** open ResAra, Prelude, ParamX in {
 -- Open lexical classes, e.g. Lexicon
 
     V, VQ, VA = ResAra.Verb ; -- = {s : VForm => Str} ;
-    V2, V2A = ResAra.Verb2 ;
+    VV = ResAra.Verb ** {s2 : Str ; sc : Preposition} ; -- s2 is complementiser
-    VV = ResAra.Verb2 ** {sc : Preposition} ; -- c2 is for verb
+    V2, V2A, V2Q = ResAra.Verb2 ;
-    V2S, V2Q = ResAra.Verb2 ;
+    V2V = ResAra.Verb2 ** {s2 : Str ; sc : Preposition} ; -- s2 is complementiser, c2 is for dir.obj
-    VS = ResAra.Verb ** {o : Order; s2 : Str} ;
+    V2S = ResAra.Verb2 ** {s2 : Str ; o : Order} ;
+    VS = ResAra.Verb ** {s2 : Str ; o : Order} ;
     V3 = ResAra.Verb3 ;
-    V2V = ResAra.Verb3 ** {sc : Preposition} ; -- c3 is for verb, c2 is for dir.obj
 
     A = ResAra.Adj ;
     A2 = ResAra.Adj2 ;

src/arabic/ExtendAra.gf

@@ -2,61 +2,75 @@
 
 concrete ExtendAra of Extend =
   CatAra ** ExtendFunctor - [
-    GenNP, SlashBareV2S, PredAPVP, GenModNP, ExistsNP,
+    GenNP, ApposNP, ICompAP, DetNPMasc, DetNPFem,
-    StrandRelSlash, ExistPluralCN, ExistMassCN, ExistCN, EmptyRelSlash, DetNPMasc, DetNPFem,
+    EmptyRelSlash, PredAPVP,
-    ComplBareVS, ComplDirectVS, ComplDirectVQ,
+    ComplDirectVS, ComplDirectVQ, -- because of Utt
-    ICompAP,
+    VPS, MkVPS, PredVPS, BaseVPS, ConsVPS, ConjVPS
-    VPS, MkVPS, PredVPS, BaseVPS, ConsVPS, ConjVPS,
-    ApposNP
 ]
   with (Grammar=GrammarAra)
   ** open
 
-    ParamX,
     ResAra,
     Prelude,
+    ParadigmsAra,
     RelativeAra,
     Coordination
 
   in {
 
-  lin
+lin
-    GenNP np = baseQuant ** {s = \\_,_,_,_ => np.s ! Gen ; d = Const} ;
+  -- If the NP is a pronoun, just use PossPron
+  GenNP np = case np.a.isPron of {
+    True  => Grammar.PossPron (pgn2pron np.a.pgn) ;
+    False => let g = np.s ! Gen in mkQuant3 g g g Const
+  } ;
 
-    -- : NP -> NP -> NP
+  -- : NP -> NP -> NP
-    ApposNP np1 np2 = np2 ** {s = \\c => np1.s ! c ++ np2.s ! c} ;
+  ApposNP np1 np2 = np2 ** {s = \\c => np1.s ! c ++ np2.s ! c} ;
 
-    -- : AP -> IComp ;   -- "how old"
+  -- : AP -> IComp ;   -- "how old"
-    ICompAP ap = {s = \\gn => "كَمْ" ++ ap.s ! NoHum ! gn.g ! gn.n ! Indef ! Acc} ;
+  ICompAP ap = {s = \\gn => "كَمْ" ++ ap.s ! NoHum ! gn.g ! gn.n ! Indef ! Acc} ;
 
-    -- : ClSlash -> RCl  -- he lives in
+  -- : AP -> VP -> Cl ;   -- it is good to walk
-    EmptyRelSlash = RelSlash (IdRP ** {s = \\_ => []}) ;
+  PredAPVP ap vp =
+    let isGood : Str = "مِنَ" ++ ap.s ! Hum ! Masc ! Sg ! Def ! Gen ;
+        toWalk : Str = "ال" ++ BIND ++ (uttVP VPGer vp ! Masc) ; -- TODO: Masdar into NForm=>Str?
+        goodToWalk_Adv : Adv = lin Adv {s = isGood ++ toWalk} ;
+     in PredVP emptyNP (UseComp (CompAdv goodToWalk_Adv)) ;
 
-  lincat
+  -- : Det -> NP
-    VPS   = {s : PerGenNum => Str} ;  -- finite VP's with tense and polarity
+  DetNPMasc det = emptyNP ** {s = det.s ! NoHum ! Masc} ;
-    [VPS] = {s1,s2 : PerGenNum => Str} ;
+  DetNPFem det = emptyNP ** {s = det.s ! NoHum ! Fem} ;
-  lin
-    -- : Temp -> Pol -> VP -> VPS ; -- hasn't slept
-    MkVPS t p vp = {
-      s = \\pgn => let vps =
-        wordOrderNoSubj
-          Nominal --  Nominal (=SVO) generalises best for ConjVPS.
-          vp.obj.a.isPron
-          (vStr vp pgn t.t p.p Nominal)
-          vp.obj.s -- BIND is taken care of when the VP was made, no need to add one here
-          (pred vp pgn t.t p.p)
-          vp.s2
-      in vps.before ++ vps.after -- word order is SVO, so this is safe for just this case.
-      } ;
 
-    -- maybe more robust to use إِيَّا as object carrier if the VPS
-    -- consists of several VPSs; like it's done in Slash3V3 /IL
-    BaseVPS = twoTable PerGenNum ;
-    ConsVPS = consrTable PerGenNum comma ;
-    ConjVPS = conjunctDistrTable PerGenNum ;
 
-    PredVPS np vps = {
+  -- : ClSlash -> RCl  -- he lives in
-      s = \\_ => np.s ! Nom ++ vps.s ! np.a.pgn -- first quick version with order always Nominal.
+  EmptyRelSlash = RelSlash (IdRP ** {s = \\_ => []}) ;
-      } ;                                       -- if necessary, change VPS into {s : PerGenNum => Order => {before,after : Str}}
+
+lincat
+  VPS   = {s : PerGenNum => Str} ;  -- finite VP's with tense and polarity
+  [VPS] = {s1,s2 : PerGenNum => Str} ;
+lin
+  -- : Temp -> Pol -> VP -> VPS ; -- hasn't slept
+  MkVPS t p vp = {
+    s = \\pgn => let vps =
+      wordOrderNoSubj
+        Nominal --  Nominal (=SVO) generalises best for ConjVPS.
+        vp.obj.a.isPron
+        (vStr vp pgn t.t p.p Nominal)
+        vp.obj.s -- BIND is taken care of when the VP was made, no need to add one here
+        (pred vp pgn t.t p.p)
+        vp.s2
+    in vps.before ++ vps.after -- word order is SVO, so this is safe for just this case.
+    } ;
+
+  -- maybe more robust to use إِيَّا as object carrier if the VPS
+  -- consists of several VPSs; like it's done in Slash3V3 /IL
+  BaseVPS = twoTable PerGenNum ;
+  ConsVPS = consrTable PerGenNum comma ;
+  ConjVPS = conjunctDistrTable PerGenNum ;
+
+  PredVPS np vps = {
+    s = \\_ => np.s ! Nom ++ vps.s ! np.a.pgn -- first quick version with order always Nominal.
+    } ;                                       -- if necessary, change VPS into {s : PerGenNum => Order => {before,after : Str}}
 
 }

src/arabic/IdiomAra.gf

@@ -31,7 +31,10 @@ concrete IdiomAra of Idiom = CatAra ** open
   ExistNP np =
     predVP (emptyNP ** {s=\\c=>"هُنَاكَ"}) (UseComp (CompNP np)) ; -- IL
 
-  -- ExistIP   : IP -> QCl ;       -- which houses are there
+  -- : IP -> QCl ;       -- which houses are there
+  ExistIP ip = let cl = ExistNP (ip2np ip False) in {
+    s = \\t,p,q => cl.s ! t ! p ! Nominal -- IL guessed
+    } ;
 
 -- 7/12/2012 generalizations of these
 

src/arabic/LexiconAra.gf

@@ -11,7 +11,7 @@ flags
   lin
 
   airplane_N   = sdfN "طءر" "فاعِلة" Fem NoHum ;
-  answer_V2S   = dirV2 (v3 "جوب") ;
+  answer_V2S   = mkV2S (v3 "جوب") ;
   apartment_N  = brkN "شقّ" "فِعّة" "فِعَل" Fem NoHum ;
   apple_N      = sdfN "تفح" "فِعّالة" Fem NoHum ;
   art_N        = brkN "فنن" "فَعّ" "فُعُول" Masc NoHum ;
@@ -142,7 +142,7 @@ flags
   old_A        = sndA "قدم" "فَعِيل" ;
   open_V2      = dirV2 (regV "يَفتَح") ;
 --  open_V2      = dirV2 (v1 "فتح" a a ) ;
-  paint_V2A    = mkV2A (regV "يَدهَن" ) [] ;
+  paint_V2A    = dirV2 (regV "يَدهَن" ) ;
 --  paint_V2A    = mkV2A (v1 "دهن" a a ) [] ;
   paper_N      = brkN "ورق" "فَعَلة" "أَفعَال" Fem NoHum ;
   paris_PN     = mkPN "بارِيس" Fem NoHum  ;

src/arabic/MissingAra.gf

@@ -11,8 +11,6 @@ oper ComparAdvAdj : CAdv -> A -> NP -> Adv = notYet "ComparAdvAdj" ;
 oper ComparAdvAdjS : CAdv -> A -> S -> Adv = notYet "ComparAdvAdjS" ;
 oper ConjRS : Conj -> ListRS -> RS = notYet "ConjRS" ;
 oper ConsRS : RS -> ListRS -> ListRS = notYet "ConsRS" ;
-oper DetNP : Det -> NP = notYet "DetNP" ;
-oper ExistIP : IP -> QCl = notYet "ExistIP" ;
 oper FunRP : Prep -> NP -> RP -> RP = notYet "FunRP" ;
 oper ImpPl1 : VP -> Utt = notYet "ImpPl1" ;
 oper PConjConj : Conj -> PConj = notYet "PConjConj" ;
@@ -23,10 +21,8 @@ oper SentCN : CN -> SC -> CN = notYet "SentCN" ;
 oper SlashPrep : Cl -> Prep -> ClSlash = notYet "SlashPrep" ;
 oper SlashV2A : V2A -> AP -> VPSlash = notYet "SlashV2A" ;
 oper SlashV2Q : V2Q -> QS -> VPSlash = notYet "SlashV2Q" ;
-oper SlashV2S : V2S -> S -> VPSlash = notYet "SlashV2S" ;
 oper SlashVS : NP -> VS -> SSlash -> ClSlash = notYet "SlashVS" ;
 oper SubjS : Subj -> S -> Adv = notYet "SubjS" ;
 oper VocNP : NP -> Voc = notYet "VocNP" ;
 oper pot3plus : Sub1000 -> Sub1000 -> Sub1000000 = notYet "pot3plus" ;
-
 }

src/arabic/ParadigmsAra.gf

@@ -88,14 +88,13 @@ resource ParadigmsAra = open
      = smartPN ;
     mkPN : N -> PN    -- Make a PN out of N. The PN is in construct state.
      = \n -> lin PN (n ** {
-          s = \\c => n.s ! Sg ! Const ! c 
+          s = \\c => n.s ! Sg ! Const ! c
                   ++ n.s2 ! Sg ! Def ! c -- NB this hack works for idaafa constructions (if you used mkN : N -> N -> N), but wrong for mkN : N -> A -> N. /IL
         }) ;
     mkPN : Str -> Gender -> Species -> PN -- Make a PN out of string, gender and species.
      = mkFullPN ;
   } ;
 
-
 --3 Relational nouns
 
   mkN2 : overload {
@@ -110,7 +109,6 @@ resource ParadigmsAra = open
     mkN3 : N -> Str -> Str -> N3 ;  -- prepositions given as strings
   } ;
 
-
 --2 Adjectives
 
 -- Overloaded operator for main cases
@@ -268,29 +266,34 @@ resource ParadigmsAra = open
 
   mkV0  : V -> V0 ;
   mkVS : overload {
-    mkVS : V -> VS ;
+    mkVS : V -> VS ; -- Takes a V, returns a VS with default complementiser أَنَّ.
-    mkVS : V -> Str -> VS
+    mkVS : V -> Str -> VS -- Takes a V and a complementiser.
     } ;
-  mkV2S : V -> Str -> V2S ;
+  mkV2S : overload {
+    mkV2S : V -> V2S ;  -- Takes a V, returns a V2S with default complementiser أَنَّ and accusative as the direct object case.
+    mkV2S : VS -> V2S ; -- Takes a VS, returns a V2S with accusative as the object case, retaining the VS's complementiser.
+    mkV2S : V2 -> V2S ; -- Takes a V2, returns a V2S with default complementiser أَنَّ, retaining the V2's direct object case.
+    mkV2S : V -> Prep -> Str -> V2S ; -- Takes V, preposition and complementiser.
+  } ;
   mkVV = overload {
-    mkVV : V -> VV -- Make VV out of a V; أَنْ as the complementiser, default subject case (nominative).
+    mkVV : V -> VV -- Takes a V, returns a VV with default complementiser أَنَّ.
      = regVV ;
-    mkVV : V -> Str -> VV -- String argument as the complementiser, default subject case (nominative).
+    mkVV : V -> Str -> VV -- Takes a V and a complementiser.
-     = c2VV ;
+     = s2VV ;
-    mkVV : V -> Prep -> VV -- Prep argument as the complementiser, default subject case (nominative).
-     = prepVV ;
-    mkVV : V -> Prep -> Prep -> VV -- First Prep argument is the complementiser, second Prep is subject case. For instance, أَنْ and لِ to get "يُمْكِنُ أَنْ يَفْعَلَ لِشَيْءٍ".
-     = prep2VV
     } ;
   mkV2V : overload {
-    mkV2V : V -> Str -> Str -> V2V ;
+    mkV2V : V -> V2V ; -- Takes a V, returns a V2V with default complementiser أَنْ and accusative as the direct object case.
-    mkV2V : V -> Prep -> Prep -> V2V ;
+    mkV2V : VV -> V2V ; -- Takes VV, returns V2V with accusative as the object case, retaining the VV's complementiser.
-    mkV2V : VV -> Prep -> V2V
+    mkV2V : V -> Prep -> Str -> V2V ; -- Takes V, preposition and complementiser.
+  } ;
+  subjCase : overload {
+    subjCase : VV -> Prep -> VV ; -- Change the subject case of a VV. (Default is nominative; use any other case or preposition.)
+    subjCase : V2V -> Prep -> V2V ; -- Change the subject case to a V2V. (Default is nominative; use any other case or preposition.)
   } ;
   mkVA  : V -> VA ;
-  mkV2A : V -> Str -> V2A ;
+  mkV2A : V -> Str -> V2A ; -- Takes a V and an object case/preposition. NB. V2A = V2, see mkV2 for more constructors.
   mkVQ  : V -> VQ ;
-  mkV2Q : V -> Str -> V2Q ;
+  mkV2Q : V -> Str -> V2Q ; -- Takes a V and an object case/preposition. NB. V2Q = V2, see mkV2 for more constructors.
 
   mkAS  : A -> AS ;
   mkA2S : A -> Str -> A2S ;
@@ -797,36 +800,54 @@ resource ParadigmsAra = open
   dirdirV3 v = dirV3 v (casePrep acc) ;
 
   mkVS = overload {
-    mkVS : V -> VS = \v -> lin VS (v ** {o = Subord; s2 = []}) ;
+    mkVS : V -> VS = \v -> lin VS (v ** {o = Subord; s2 = anna}) ;
     mkVS : V -> Str -> VS =  \v,s -> lin VS (v ** {o = Subord; s2 = s})
     } ;
   mkVQ v = lin VQ v ;
 
-  regVV : V -> VV = \v -> lin VV v ** {c2 = mkPreposition "أَنْ" ; sc = noPrep} ;
+  -- Complementisers for V*V and V*S
-  c2VV : V -> Str -> VV = \v,prep -> regVV v ** {c2 = mkPreposition prep ; sc = noPrep} ;
+  an : Str = "أَنْ" ;
-  prepVV : V -> Prep -> VV = \v,prep -> regVV v ** {c2=prep; sc=noPrep} ;
+  anna : Str = "أَنَّ" ;
-  prep2VV : V -> (_,_ : Prep) -> VV = \v,p1,p2 -> regVV v ** {c2=p1; sc=p2} ;
+
+  regVV : V -> VV = \v -> lin VV v ** {s2=an ; sc=noPrep} ;
+  s2VV : V -> Str -> VV = \v,compl -> regVV v ** {s2=compl; sc=noPrep} ;
+  prepVV : V -> Prep -> VV = \v,prep -> regVV v ** {s2=an ; sc=prep} ;
+  prep2VV : V -> Prep -> Str -> VV = \v,p,c -> regVV v ** {s2=c; sc=p} ;
   V0 : Type = V ;
 ----  V2S, V2V, V2Q, V2A : Type = V2 ;
   AS, A2S, AV : Type = A ;
   A2V : Type = A2 ;
 
   mkV0  v = v ;
-  mkV2S v p = lin V2S (prepV2 v (mkPreposition p)) ;
+  mkV2S = overload {
+    mkV2S : V -> V2S
+      = \v -> lin V2S (prepV2 v accPrep ** {s2=anna ; o=Subord}) ;
+    mkV2S : V2 -> V2S
+      = \v2 -> lin V2S (v2 ** {s2=anna ; o=Subord}) ;
+    mkV2S : V -> Preposition -> V2S
+      = \v,p -> lin V2S ((prepV2 v p) ** {s2=anna ; o=Subord})
+    } ;
+
   mkV2V = overload {
-    mkV2V : V -> Str -> Str -> V2V = \v,p,q ->
+    mkV2V : V -> V2V = \v ->
-      lin V2V (prepV3 v (mkPreposition p) (mkPreposition q) ** {sc = noPrep}) ;
+      lin V2V (v ** {c2=accPrep ; s2=an ; sc=noPrep}) ;
-    mkV2V : V2 -> V2V = \v2 ->
+    mkV2V : VV -> V2V = \vv ->
-      lin V2V (v2 ** {c2 = v2.c2 ; c3,sc = noPrep}) ;
+      lin V2V (vv ** {c2 = accPrep}) ;
-    mkV2V : V2 -> Prep -> V2V = \v2,p ->
-      lin V2V (v2 ** {c2 = v2.c2 ; c3 = p ; sc = noPrep}) ;
-    mkV2V : V2 -> Prep -> Prep -> V2V = \v2,p,q->
-      lin V2V (v2 ** {c2 = v2.c2 ; c3 = p ; sc = q}) ;
-    mkV2V : V -> Prep -> Prep -> V2V = \v,p,q ->
-      lin V2V (prepV3 v p q ** {sc = noPrep}) ;
     mkV2V : VV -> Prep -> V2V = \vv,p ->
-      lin V2V (vv ** {c2 = p ; c3 = vv.c2}) ;
+      lin V2V (vv ** {c2 = p}) ;
+    mkV2V : V -> Prep -> Str -> V2V = \v,p,q ->
+      lin V2V (v ** {c2 = p ; s2 = q ; sc = noPrep}) ;
+    mkV2V : V2 -> V2V = \v2 ->
+      lin V2V (v2 ** {s2 = an ; sc = noPrep}) ;
+    mkV2V : V2 -> Str -> V2V = \v2,c ->
+      lin V2V (v2 ** {c2 = v2.c2 ; s2 = c ; sc = noPrep}) ;
   } ;
+
+  subjCase = overload {
+    subjCase : VV -> Prep -> VV = \vv,p -> vv ** {sc=p} ;
+    subjCase : V2V -> Prep -> V2V = \vv,p -> vv ** {sc=p}
+  } ;
+
   mkVA  v   = v ** {lock_VA = <>} ;
   mkV2A v p = lin V2A (prepV2 v (mkPreposition p));
   mkV2Q v p = lin V2Q (prepV2 v (mkPreposition p));

src/arabic/ResAra.gf

@@ -505,7 +505,7 @@ oper
   insertObj : NP -> VPSlash -> VP = \np,vp -> vp ** {
     obj = {s = vp.obj.s -- old object, if there was one
             ++ bindIfPron np vp -- new object, bind if pronoun and not pred
-            ++ vp.agrObj ! np.a.pgn ; -- only used for SlashV2V and Slash3V3
+            ++ vp.agrObj ! np.a.pgn ; -- used for SlashV2V, Slash3V3 and SlashV2S
            a = agrLite np.a} ;
     agrObj = \\_ => []
     } ;

src/arabic/VerbAra.gf

@@ -12,7 +12,7 @@ concrete VerbAra of Verb = CatAra ** open Prelude, ResAra, ParamX in {
     SlashV2V v2v vp = let v2vVP = predV v2v in -- IL
       vp ** {
         s = v2vVP.s ;
-        agrObj = \\pgn => v2v.c3.s  -- أَنْ
+        agrObj = \\pgn => v2v.s2  -- أَنْ
                        ++ vp.s ! pgn ! VPImpf Cnj -- this will agree with the object added by ComplSlash
                        ++ vp.obj.s ;
         obj = emptyObj ;
@@ -26,7 +26,7 @@ concrete VerbAra of Verb = CatAra ** open Prelude, ResAra, ParamX in {
       vps ** {
         s = \\pgn,vpf => v2vVP.s ! pgn ! vpf -- main verb agrees with subject
                       ++ bindIfPron np v2vVP
-                      ++ v2v.c3.s  -- أَنْ
+                      ++ v2v.s2  -- أَنْ
                       ++ vps.s ! np.a.pgn ! VPImpf Cnj -- verb from old VP agrees with object
                       ++ vps.obj.s ; -- otherwise obj appears in a weird place /IL
         obj = emptyObj ;
@@ -35,6 +35,13 @@ concrete VerbAra of Verb = CatAra ** open Prelude, ResAra, ParamX in {
         sc = v2v.sc
       } ;
 
+    -- : V2S -> S -> VPSlash ;  -- answer (to him) that it is good
+    SlashV2S v2s s = slashV2 v2s ** { -- IL
+      agrObj = -- this is put into agrObj even though it doesn't depend on agr, because insertObj puts agrObj *after* the new object.
+        \\pgn => v2s.s2 -- أَنَّ
+              ++ s.s ! v2s.o ;
+      } ;
+
     SlashV2a = slashV2 ;
     Slash2V3 v np = insertObj np (slashV2 v) ** {c2 = v.c3 ; agrObj = \\_ => []};
 
@@ -59,7 +66,7 @@ concrete VerbAra of Verb = CatAra ** open Prelude, ResAra, ParamX in {
     ComplVV vv vp = let vvVP = predV vv in -- IL
       vp ** {
         s = \\pgn,vpf => vvVP.s ! pgn ! vpf
-                      ++ vv.c2.s  -- أَنْ
+                      ++ vv.s2  -- أَنْ
                       ++ vp.s ! pgn ! VPImpf Cnj ;
         isPred = False ;
         sc = vv.sc
@@ -67,7 +74,8 @@ concrete VerbAra of Verb = CatAra ** open Prelude, ResAra, ParamX in {
 
     -- : VS -> S -> VP ;  -- say that she runs
     ComplVS vs s = predV vs ** { -- IL
-      obj = emptyObj ** {s = vs.s2 ++ s.s ! vs.o}
+      obj = emptyObj ** {s = vs.s2 -- أَنَّ
+                          ++ s.s ! vs.o}
       } ;
 
     -- : VQ -> QS -> VP ;  -- wonder who runs