(Pes) Add comparative

src/persian/AdjectivePes.gf

@@ -3,23 +3,23 @@ concrete AdjectivePes of Adjective = CatPes ** open ResPes, Prelude in {
   flags coding = utf8;
   lin
 
-  PositA a = a ;
- 	UseComparA a = a ;
+  PositA a = a ** {s = a.s ! Positive} ;
+ 	UseComparA a = a ** {s = a.s ! Comparative} ;
 
   ComparA a np = a ** {
-    s = \\m => a.s ! m ++ "تر" ++ "از" ++ np2str np ;
+    s = \\m => a.s ! Comparative ! m ++ "تر" ++ "از" ++ np2str np ;
     adv = a.adv ++ "تر" ++ "از" ++ np2str np ;
     } ;
 
 ---- $SuperlA$ belongs to determiner syntax in $Noun$.
 
   ComplA2 a np = a ** {
-    s = \\m => a.c2 ++ np2str np ++ a.s ! m ;
+    s = \\m => a.c2 ++ np2str np ++ a.s ! Positive ! m ;
     adv = np2str np ++ a.c2 ++ a.adv
     } ;
 
   ReflA2 a = a ** {
-    s = \\m => a.s ! m ++ reflPron ! defaultAgr ! Bare ; ---- need to be fixed
+    s = \\m => a.s ! Positive ! m ++ reflPron ! defaultAgr ! Bare ; ---- s needs to be an inflection table from Agr to string, to choose the right reflexive pronoun
     adv = a.adv ++ reflPron ! defaultAgr ! Bare
     } ;
 
@@ -33,7 +33,7 @@ concrete AdjectivePes of Adjective = CatPes ** open ResPes, Prelude in {
     adv = ada.s ++ ap.adv ;
     } ;
 
-  UseA2 a = a ;
+  UseA2 = PositA ;
 
   CAdvAP cadv ap np = ap ** {
     s = \\m => cadv.s ++ np2str np ++ ap.s ! m ;

src/persian/CatPes.gf

@@ -46,7 +46,7 @@ concrete CatPes of Cat = CommonX ** open ResPes, Prelude in {
 
 ---- Adjective
 
-    AP = ResPes.Adjective ;
+    AP = ResPes.AP ;
 
 ---- Noun
 

src/persian/MorphoPes.gf

@@ -36,6 +36,7 @@ param
   Mod = Bare | Ezafe | Clitic | Poss ;
   Agr = Ag Number Person ;
   CmpdStatus = IsCmpd | NotCmpd ;
+  Degr = Positive | Comparative ;
 
 ------------------------------------------
 -- Agreement transformations
@@ -151,21 +152,30 @@ oper
 ---------------------------
 -- Adjectives
 --------------------------
-  Adjective : Type = {
-    s : Mod => Str ;
+  BaseAdjective : Type = {
     adv : Str ;
     isPre : Bool ;        -- as attributive
     afterPrefix : Bool ;  -- as predicative, does it go between the prefix and the light verb
     } ;
 
- mkAdj : Str -> Str -> Adjective = \adj,adv -> {
-   s = table { Bare => adj;
-               Ezafe => mkEzafe adj ;
-               Clitic => mkEnclic adj ;
-               Poss => mkPossStem adj
-             } ;
-   adv = adv ; isPre = False ; afterPrefix = True ;
-   };
+  Adjective : Type = BaseAdjective ** {
+    s : Degr => Mod => Str } ;
+
+  AP : Type =  BaseAdjective ** {
+    s : Mod => Str } ;
+
+  mkAdj = overload {
+    mkAdj : Str -> Str -> Adjective = \adj,adv -> {
+       s = table { Positive => modTable adj ;
+                   Comparative => modTable (adj + "تر") -- Regular comparative.
+                 } ;
+       adv = adv ; isPre = False ; afterPrefix = True } ;
+    mkAdj : Str -> Str -> Str -> Adjective = \pos,cmp,adv -> {
+       s = table { Positive => modTable pos ;
+                   Comparative => modTable cmp -- Irregular comparative, e.g. xub-behtar
+                 } ;
+       adv = adv ; isPre = False ; afterPrefix = True }
+    } ;
 
 ------------------------------------------------------------------
 -- Verbs

src/persian/NounPes.gf

@@ -102,7 +102,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 ! Bare ++ taryn; n = Sg ; isNum=False ; isPre = True} ; -- check the form of adjective
+    OrdSuperl a = {s = a.s ! Comparative ! Bare ++ BIND ++ "ین" ; n = Sg ; isNum=False ; isPre = True} ;
 
     DefArt = makeQuant [] [] ;
     IndefArt = makeQuant IndefArticle [] ** {isDef = False} ;

src/persian/ParadigmsPes.gf

@@ -321,9 +321,13 @@ oper
 
   mkA = overload {
     mkA : Str -> A -- Regular adjective, same adj and adv forms.
-       = \str -> lin A (mkAdj str str);
+       = \str -> lin A (case str of {
+          _ + " " + _ => mkAdj str str str ;
+          _           => mkAdj str str }) ;
     mkA : Str-> Str -> A -- Takes adj and adv forms
        = \str,adv -> lin A (mkAdj str adv);
+    mkA : (pos,compar,adv : Str) -> A -- positive, comparative and adverb
+       = \p,c,adv -> lin A (mkAdj p c adv);
     mkA : Str -> Str -> A2 -- Takes string and complementiser, returns A2. Hidden from public API, confusing naming. /IL
       = \a,c -> lin A2 (mkAdj a a ** {c2 = c})
    } ;
@@ -331,7 +335,7 @@ oper
    prefixA a = a ** {isPre=True};
 
    preA : (adj,adv : Str) -> A = \adj,adv ->
-     lin A ((mkAdj adj adv) ** {isPre=True}) ;
+     lin A (<mkAdj adj adv:Adjective> ** {isPre=True}) ;
 
    {-
     -- Demonstrative Pronouns