complete Thai resource syntax (but many unverified rules)

lib/src/thai/AdjectiveTha.gf

@@ -4,33 +4,22 @@ concrete AdjectiveTha of Adjective = CatTha ** open ResTha, Prelude in {
 
     PositA  a = a ;
 
---    ComparA a np = {
---      s = \\_ => a.s ! AAdj Compar ++ "than" ++ np.s ! Nom ; 
---      isPre = False
---      } ;
---
----- $SuperlA$ belongs to determiner syntax in $Noun$.
---
---    ComplA2 a np = {
---      s = \\_ => a.s ! AAdj Posit ++ a.c2 ++ np.s ! Acc ; 
---      isPre = False
---      } ;
---
---    ReflA2 a = {
---      s = \\ag => a.s ! AAdj Posit ++ a.c2 ++ reflPron ! ag ; 
---      isPre = False
---      } ;
---
---    SentAP ap sc = {
---      s = \\a => ap.s ! a ++ sc.s ; 
---      isPre = False
---      } ;
---
---    AdAP ada ap = {
---      s = \\a => ada.s ++ ap.s ! a ;
---      isPre = ap.isPre
---      } ;
---
---    UseA2 a = a ;
---
+    ComparA a np = mkAdj (thbind a.s kwaa_s np.s) ;
+
+    UseComparA a = mkAdj (thbind a.s kwaa_s) ;
+
+    AdjOrd ord = ord ;
+
+    CAdvAP ad ap np = mkAdj (thbind ap.s ad.s np.s) ;
+
+    ComplA2 a np = mkAdj (thbind a.s a.c2 np.s) ;
+
+    ReflA2 a = mkAdj (thbind a.s a.c2 reflPron) ;
+
+    SentAP ap sc = thbind ap sc ;
+
+    AdAP ada ap = thbind ap ada ;
+
+    UseA2 a = a ;
+
 }

lib/src/thai/AdverbTha.gf

@@ -4,20 +4,16 @@ concrete AdverbTha of Adverb = CatTha **
   lin
     PositAdvAdj a = a ;
 
---    ComparAdvAdj cadv a np = {
---      s = cadv.s ++ a.s ! AAdv ++ "than" ++ np.s ! Nom
---      } ;
---    ComparAdvAdjS cadv a s = {
---      s = cadv.s ++ a.s ! AAdv ++ "than" ++ s.s
---      } ;
---
---    PrepNP prep np = {s = prep.s ++ np.s ! Acc} ;
---
---    AdAdv = cc2 ;
---
---    SubjS = cc2 ;
---    AdvSC s = s ; --- this rule give stack overflow in ordinary parsing
---
---    AdnCAdv cadv = {s = cadv.s ++ "than"} ;
---
+    PrepNP prep np = thbind prep np ;
+
+    ComparAdvAdj cadv a np = ss (thbind a.s cadv.s np.s) ;
+
+    ComparAdvAdjS cadv a s = ss (thbind a.s cadv.s s.s) ;
+
+    AdAdv adv ad = thbind ad adv ;
+
+    SubjS = thbind ;
+
+    AdnCAdv cadv = ss (thbind cadv.s conjThat) ; -----
+
 }

lib/src/thai/CatTha.gf

@@ -8,70 +8,68 @@ concrete CatTha of Cat = CommonX ** open ResTha, Prelude in {
 
     S  = {s : Str} ;
     QS = {s : QForm => Str} ;
---    RS = {s : Agr => Str ; c : Case} ; -- c for it clefts
---
----- Sentence
---
-    Cl = {s : Polarity => Str} ;
---    Slash = {
---      s : Tense => Anteriority => CPolarity => Order => Str ;
---      c2 : Str
---      } ;
+    RS = {s : Str} ;
+    SSlash  = {s : Str ; c2 : Str} ;
+
+-- Sentence
+
+    Cl = ResTha.Clause ; -- {s : Polarity => Str} ;
+    ClSlash = {s : Polarity => Str ; c2 : Str} ;
     Imp = {s : Polarity => Str} ;
---
----- Question
---
+
+-- Question
+
     QCl = {s : Polarity => Str} ;
---    IP = {s : Case => Str ; n : Number} ;
---    IComp = {s : Str} ;    
---    IDet = {s : Str ; n : Number} ;
---
----- Relative
---
---    RCl = {s : Tense => Anteriority => CPolarity => Agr => Str ; c : Case} ;
---    RP = {s : RCase => Str ; a : RAgr} ;
---
----- Verb
---
+    IP = {s : Str} ;
+    IComp = {s : Str} ;    
+    IDet, IQuant = Determiner ;
+
+-- Relative
+
+    RCl = {s : Polarity => Str} ;
+    RP = {s : Str} ;
+
+-- Verb
+
     VP = ResTha.VP ; 
-    Comp = ResTha.VP ; 
---
----- Adjective
---
---    AP = {s : Agr => Str ; isPre : Bool} ; 
---
+    Comp = ResTha.VP ;
+    VPSlash = ResTha.VP ** {c2 : Str} ;
+
+-- Adjective
+
+    AP = ResTha.Adj ;
+
 -- Noun
---
-    CN = Noun ;
-    NP, Pron = SS ;
-    Det = Determiner ; 
---    Predet, Ord = {s : Str} ;
+
+    CN = ResTha.Noun ;
+    NP, Pron = ResTha.NP ;
+    Det = ResTha.Determiner ; 
+    Predet, Ord = {s : Str} ;
     Num, Quant = {s : Str ; hasC : Bool} ;
 
 -- Numeral
 
-    Numeral = {s : Str} ;
+    Numeral, Card, Digits = {s : Str} ;
+
+-- Structural
+
+    Conj = {s1,s2 : Str} ;
+    Subj = {s : Str} ;
+    Prep = {s : Str} ;
 
----- Structural
---
---    Conj = {s : Str ; n : Number} ;
---    DConj = {s1,s2 : Str ; n : Number} ;
---    Subj = {s : Str} ;
---    Prep = {s : Str} ;
---
 -- Open lexical classes, e.g. Lexicon
 
     V, VS, VQ, VA = Verb ; 
-    V2, V2A = Verb ** {c2 : Str} ;
+    V2, V2A, V2Q, V2S, V2V = Verb ** {c2 : Str} ;
     V3 = Verb ** {c2, c3 : Str} ;
     VV = VVerb ;
---
---    A = {s : AForm => Str} ;
---    A2 = {s : AForm => Str ; c2 : Str} ;
---
-    N = Noun ;
---    N2 = {s : Number => Case => Str} ** {c2 : Str} ;
---    N3 = {s : Number => Case => Str} ** {c2,c3 : Str} ;
---    PN = {s : Case => Str} ;
---
+
+    A = ResTha.Adj ;
+    A2 = ResTha.Adj ** {c2 : Str} ;
+
+    N = ResTha.Noun ;
+    N2 = ResTha.Noun ** {c2 : Str} ;
+    N3 = ResTha.Noun ** {c2,c3 : Str} ;
+    PN = ResTha.NP ;
+
 }

lib/src/thai/ConjunctionTha.gf

@@ -1,45 +1,31 @@
---concrete ConjunctionTha of Conjunction = 
---  CatTha ** open ResTha, Coordination, Prelude in {
---
---  flags optimize=all_subs ;
---
---  lin
---
---    ConjS = conjunctSS ;
---    DConjS = conjunctDistrSS ;
---
---    ConjAdv = conjunctSS ;
---    DConjAdv = conjunctDistrSS ;
---
---    ConjNP conj ss = conjunctTable Case conj ss ** {
---      a = {n = conjNumber conj.n ss.a.n ; p = ss.a.p}
---      } ;
---    DConjNP conj ss = conjunctDistrTable Case conj ss ** {
---      a = {n = conjNumber conj.n ss.a.n ; p = ss.a.p}
---      } ;
---
---    ConjAP conj ss = conjunctTable Agr conj ss ** {
---      isPre = ss.isPre
---      } ;
---    DConjAP conj ss = conjunctDistrTable Agr conj ss ** {
---      isPre = ss.isPre
---      } ;
---
----- These fun's are generated from the list cat's.
---
---    BaseS = twoSS ;
---    ConsS = consrSS comma ;
---    BaseAdv = twoSS ;
---    ConsAdv = consrSS comma ;
---    BaseNP x y = twoTable Case x y ** {a = conjAgr x.a y.a} ;
---    ConsNP xs x = consrTable Case comma xs x ** {a = conjAgr xs.a x.a} ;
---    BaseAP x y = twoTable Agr x y ** {isPre = andB x.isPre y.isPre} ;
---    ConsAP xs x = consrTable Agr comma xs x ** {isPre = andB xs.isPre x.isPre} ;
---
---  lincat
---    [S] = {s1,s2 : Str} ;
---    [Adv] = {s1,s2 : Str} ;
---    [NP] = {s1,s2 : Case => Str ; a : Agr} ;
---    [AP] = {s1,s2 : Agr => Str ; isPre : Bool} ;
---
---}
+concrete ConjunctionTha of Conjunction = CatTha ** open Prelude, Coordination in {
+
+  lin
+
+    ConjS = conjunctDistrSS ;
+    ConjAdv = conjunctDistrSS ;
+    ConjNP = conjunctDistrSS ;
+    ConjAP = conjunctDistrSS ;
+    ConjRS = conjunctDistrSS ;
+
+-- These fun's are generated from the list cat's.
+
+    BaseS = twoSS ;
+    ConsS = consrSS comma ;
+    BaseAdv = twoSS ;
+    ConsAdv = consrSS comma ;
+    BaseNP = twoSS ;
+    ConsNP = consrSS comma ;
+    BaseAP = twoSS ;
+    ConsAP = consrSS comma ;
+    BaseRS = twoSS ;
+    ConsRS = consrSS comma ;
+
+  lincat
+    [S] = {s1,s2 : Str} ;
+    [Adv] = {s1,s2 : Str} ;
+    [NP] = {s1,s2 : Str} ;
+    [AP] = {s1,s2 : Str} ;
+    [RS] = {s1,s2 : Str} ;
+
+}

lib/src/thai/GrammarTha.gf

@@ -8,12 +8,12 @@ concrete GrammarTha of Grammar =
   NumeralTha,
   SentenceTha,
   QuestionTha,
---  RelativeTha,
---  ConjunctionTha,
+  RelativeTha,
+  ConjunctionTha,
   PhraseTha,
---  TextX,
+  TextX,
   StructuralTha,
---  IdiomTha
+  IdiomTha,
   TenseX
   ** {
 

lib/src/thai/IdiomTha.gf

@@ -1,30 +1,32 @@
---concrete IdiomTha of Idiom = CatTha ** open Prelude, ResTha in {
---
---  flags optimize=all_subs ;
---
---  lin
---    ImpersCl vp = mkClause "it" (agrP3 Sg) vp ;
---    GenericCl vp = mkClause "one" (agrP3 Sg) vp ;
---
---    CleftNP np rs = mkClause "it" (agrP3 Sg) 
---      (insertObj (\\_ => rs.s ! np.a)
---        (insertObj (\\_ => np.s ! rs.c) (predAux auxBe))) ;
---
---    CleftAdv ad s = mkClause "it" (agrP3 Sg) 
---      (insertObj (\\_ => conjThat ++ s.s)
---        (insertObj (\\_ => ad.s) (predAux auxBe))) ;
---
---    ExistNP np = 
---      mkClause "there" (agrP3 np.a.n) 
---        (insertObj (\\_ => np.s ! Acc) (predAux auxBe)) ;
---
---    ExistIP ip = 
---      mkQuestion (ss (ip.s ! Nom)) 
---        (mkClause "there" (agrP3 ip.n) (predAux auxBe)) ;
---
---    ProgrVP vp = insertObj (\\a => vp.ad ++ vp.prp ++ vp.s2 ! a) (predAux auxBe) ;
---
---    ImpPl1 vp = {s = "let's" ++ infVP True vp {n = Pl ; p = P1}} ;
---
---}
---
+concrete IdiomTha of Idiom = CatTha ** open Prelude, ResTha in {
+
+  lin
+    ImpersCl vp = mkClause (mkNP []) vp ;
+    GenericCl vp = mkClause (mkNP []) vp ; ---- ??
+
+    CleftNP np rs = {s = \\q,p => thbind (case p of{      ---- ??
+      Pos => thbind np.s pen_s rs.s ;
+      Neg => thbind np.s may_s chay_s rs.s
+      })  (case q of {ClQuest => m'ay_s ; _ => []})
+    } ;
+
+    CleftAdv ad s = {s = \\q,p => thbind (negation p) ad.s s.s (case q of {ClQuest => m'ay_s ; _ => []})} ; ---- ??
+
+    ExistNP np = {
+      s = \\q,p => thbind (case p of {
+        Pos => thbind pen_s np.s ;
+        Neg => thbind may_s chay_s np.s
+      }) (case q of {ClQuest => m'ay_s ; _ => []})
+    } ;
+
+    ExistIP ip = mkPolClause ip (predV (regV [])) ; ----
+
+    ProgrVP vp = {
+      s = \\p => thbind kam_s lag2_s (vp.s ! p) ;
+      } ;
+
+    ImpPl1 vp = ss (infVP vp) ; ----
+
+}
+
+

lib/src/thai/NounTha.gf

@@ -5,29 +5,22 @@ concrete NounTha of Noun = CatTha ** open StringsTha, ResTha, Prelude in {
   lin
     DetCN det cn = 
       let cnc = if_then_Str det.hasC cn.c []
-      in  ss (cn.s ++ det.s1 ++ cnc ++ det.s2) ;
+      in  mkNP (thbind cn.s det.s1 cnc det.s2) ;
     UsePN pn = pn ;
     UsePron p = p ;
---
---    PredetNP pred np = {
---      s = \\c => pred.s ++ np.s ! c ;
---      a = np.a
---      } ;
---
---    PPartNP np v2 = {
---      s = \\c => np.s ! c ++ v2.s ! VPPart ;
---      a = np.a
---      } ;
---
---    AdvNP np adv = {
---      s = \\c => np.s ! c ++ adv.s ;
---      a = np.a
---      } ;
+
+    DetNP det = mkNP (thbind det.s1 det.s2) ;
+
+    PredetNP pred np = thbind pred np ;
+
+    PPartNP np v2 = thbind np (ss ((predV v2).s ! Pos)) ; ---- ??
+
+    AdvNP np adv = thbind np adv ;
 
     DetQuant quant num = {
-      s1 = [] ;
-      s2 = quant.s ++ num.s ;
-      hasC = quant.hasC ;
+      s1 = num.s ;
+      s2 = quant.s ;
+      hasC = orB num.hasC quant.hasC ;
       } ;
     DetQuantOrd quant num ord = {
       s1 = num.s ;
@@ -43,34 +36,36 @@ concrete NounTha of Noun = CatTha ** open StringsTha, ResTha, Prelude in {
     NumSg, NumPl = {s = [] ; hasC = False} ;
 
     NumCard n = n ** {hasC = True} ;
---    OrdInt n = {s = n.s ++ "th"} ; ---
---
+    NumDigits d = d ;
+    OrdDigits d = {s = thbind thii_s d.s} ;
+
     NumNumeral numeral = numeral ** {hasC = True} ;
-    OrdNumeral numeral = {s = thii_s ++ numeral.s} ;
---
---    AdNum adn num = {s = adn.s ++ num.s} ;
---
---    OrdSuperl a = {s = a.s ! AAdj Superl} ;
---
+    OrdNumeral numeral = {s = thbind thii_s numeral.s} ;
+
+    AdNum adn num = thbind num adn ;
+
+    OrdSuperl a = {s = thbind a.s thii_s sut_s} ;
+
     DefArt = {s = [] ; hasC = False} ;
     IndefArt = {s = [] ; hasC = False} ;
 
     MassNP cn = cn ;
 
     UseN n = n ;
---    UseN2 n = n ;
---    UseN3 n = n ;
---
---    ComplN2 f x = {s = \\n,c => f.s ! n ! Nom ++ f.c2 ++ x.s ! c} ;
---    ComplN3 f x = {s = \\n,c => f.s ! n ! Nom ++ f.c2 ++ x.s ! c ; c2 = f.c3} ;
+    UseN2 n = n ;
+    Use2N3 f = {s = thbind f.s ; c = f.c ; c2 = f.c2} ;
+    Use3N3 f = {s = thbind f.s ; c = f.c ; c2 = f.c3} ;
+
+    ComplN2 f x = {s = thbind f.s f.c2 x.s ; c = f.c} ;
+    ComplN3 f x = {s = thbind f.s f.c2 x.s ; c = f.c ; c2 = f.c3} ;
 
     AdjCN ap cn = {s = cn.s ++ ap.s ; c = cn.c} ;
 
---    RelCN cn rs = {s = \\n,c => cn.s ! n ! c ++ rs.s ! {n = n ; p = P3}} ;
---    AdvCN cn ad = {s = \\n,c => cn.s ! n ! c ++ ad.s} ;
---
---    SentCN cn sc = {s = \\n,c => cn.s ! n ! c ++ sc.s} ;
---
---    ApposCN cn np = {s = \\n,c => cn.s ! n ! Nom ++ np.s ! c} ;
---
+    RelCN cn rs = {s = thbind cn.s rs.s ; c = cn.s} ;
+    AdvCN cn ad = {s = thbind cn.s ad.s ; c = cn.s} ;
+    SentCN cn cs = {s = thbind cn.s cs.s ; c = cn.s} ;
+    ApposCN cn np = {s = thbind cn.s np.s ; c = cn.s} ;
+
+    RelNP np rs = thbind np rs ;
+
 }

lib/src/thai/NumeralTha.gf

@@ -1,5 +1,7 @@
 concrete NumeralTha of Numeral = CatTha ** open ResTha, StringsTha, Prelude in {
 
+flags coding = utf8 ;
+
 lincat 
 --  Numeral    = {s : Str} ;
   Digit      = {s : DForm => Str} ;
@@ -63,4 +65,25 @@ oper
   roy  = table {Unit => rooy_s ; Thousand => seen_s} ;
   phan = table {Unit => []      ; Thousand => phan_s} ;
 
+-- numerals as sequences of digits
+
+  lincat 
+    Dig = SS ;
+
+  lin
+    IDig d = d ;
+
+    IIDig d i = thbind d i ;
+
+    D_0 = ss "๐" ;
+    D_1 = ss "๑" ;
+    D_2 = ss "๒" ;
+    D_3 = ss "๓" ;
+    D_4 = ss "๔" ;
+    D_5 = ss "๕" ;
+    D_6 = ss "๖" ;
+    D_7 = ss "๗" ;
+    D_8 = ss "๘" ;
+    D_9 = ss "๙" ;
+
 }

lib/src/thai/PhraseTha.gf

@@ -16,7 +16,7 @@ concrete PhraseTha of Phrase = CatTha ** open Prelude, ResTha in {
     UttAdv adv = adv ;
 
     NoPConj = {s = []} ;
-    PConjConj conj = conj ;
+    PConjConj conj = ss conj.s2 ;
 
     NoVoc = {s = []} ;
     VocNP np = {s = np.s} ; ---- ??

lib/src/thai/QuestionTha.gf

@@ -7,35 +7,39 @@ concrete QuestionTha of Question = CatTha **
 
 -- pos. may, neg. chay may - not always the proper forms ---
 
-    QuestCl cl = {s = \\p => cl.s ! Pos ++ polStr chay_s p ++ m'ay_s} ; 
+    QuestCl cl = {s = cl.s ! ClQuest} ; 
+
+---- order of IP and VP to be revisited: Smyth p. 160
+
+    QuestVP qp vp = {s = (mkClause qp vp).s ! ClQuest} ;
+
+    QuestSlash ip slash = {s = \\p => thbind (slash.s ! p) slash.c2 ip.s} ; 
+
+    QuestIAdv iadv cl = {s = \\p => thbind (cl.s ! ClDecl ! p) iadv.s} ; 
+
+    QuestIComp icomp np = {s = \\p => thbind np.s icomp.s} ; 
+
+    PrepIP p ip = thbind p ip ;
+
+    AdvIP ip adv = thbind ip adv ;
+
+    IdetCN det cn = 
+      let cnc = if_then_Str det.hasC cn.c []
+      in  mkNP (thbind cn.s det.s1 cnc det.s2) ;
+
+    IdetIP idet = mkNP (thbind idet.s1 idet.s2) ;
+
+    IdetQuant iquant num = {
+      s1 = iquant.s1 ++ num.s ;
+      s2 = iquant.s2 ;
+      hasC = iquant.hasC
+      } ;
+
+    AdvIAdv i a = thbind i a ;
+
+    CompIAdv a = a ;
+
+    CompIP ip = ip ;
 
---
---    QuestVP qp vp = 
---      let cl = mkClause (qp.s ! Nom) {n = qp.n ; p = P3} vp
---      in {s = \\t,a,b,_ => cl.s ! t ! a ! b ! ODir} ;
---
---    QuestSlash ip slash = 
---      mkQuestion (ss (slash.c2 ++ ip.s ! Acc)) slash ;
---      --- stranding in ExratTha 
---
---    QuestIAdv iadv cl = mkQuestion iadv cl ;
---
---    QuestIComp icomp np = 
---      mkQuestion icomp (mkClause (np.s ! Nom) np.a (predAux auxBe)) ;
---
---
---    PrepIP p ip = {s = p.s ++ ip.s ! Nom} ;
---
---    AdvIP ip adv = {
---      s = \\c => ip.s ! c ++ adv.s ;
---      n = ip.n
---      } ;
--- 
---    IDetCN idet num ord cn = {
---      s = \\c => idet.s ++ num.s ++ ord.s ++ cn.s ! idet.n ! c ; 
---      n = idet.n
---      } ;
---
---    CompIAdv a = a ;
---
 }
+

lib/src/thai/RelativeTha.gf

@@ -1,48 +1,10 @@
---concrete RelativeTha of Relative = CatTha ** open ResTha in {
---
---  flags optimize=all_subs ;
---
---  lin
---
---    RelCl cl = {
---      s = \\t,a,p,_ => "such" ++ "that" ++ cl.s ! t ! a ! p ! ODir ; 
---      c = Nom
---      } ;
---
---    RelVP rp vp = {
---      s = \\t,ant,b,ag => 
---        let 
---          agr = case rp.a of {
---            RNoAg => ag ;
---            RAg a => a
---            } ;
---          cl = mkClause (rp.s ! RC Nom) agr vp
---        in
---        cl.s ! t ! ant ! b ! ODir ;
---      c = Nom
---      } ;
---
----- Pied piping: "at which we are looking". Stranding and empty
----- relative are defined in $ExtraTha.gf$ ("that we are looking at", 
----- "we are looking at").
---
---    RelSlash rp slash = {
---      s = \\t,a,p,_ => slash.c2 ++ rp.s ! RPrep ++ slash.s ! t ! a ! p ! ODir ;
---      c = Acc
---      } ;
---
---    FunRP p np rp = {
---      s = \\c => np.s ! Acc ++ p.s ++ rp.s ! RPrep ;
---      a = RAg np.a
---      } ;
---
---    IdRP = {
---      s = table {
---        RC Gen => "whose" ; 
---        RC _   => "that" ;
---        RPrep  => "which"
---        } ;
---      a = RNoAg
---      } ;
---
---}
+concrete RelativeTha of Relative = CatTha ** open ResTha, Prelude in {
+
+  lin
+    RelCl cl = {s = \\p => thbind thii_s (cl.s ! ClDecl ! p)} ; ---- ??
+    RelVP rp vp = mkPolClause rp vp ;
+    RelSlash rp slash = {s = \\p => thbind slash.c2 rp.s (slash.s ! p)} ;
+    FunRP p np rp = {s = thbind np.s p.s rp.s} ; ---- ??
+    IdRP = ss thii_s ;
+
+}

lib/src/thai/ResTha.gf

@@ -7,23 +7,31 @@
 ---- implement $Test$, it moreover contains regular lexical
 ---- patterns needed for $Lex$.
 --
-resource ResTha = ParamX ** open StringsTha, Prelude in {
+resource ResTha = ParamX, StringsTha ** open Prelude in {
 
   oper
 
--- binding words together
+-- binding words together - if you want. But better do it with the unlexer -unchars.
+
+  bIND = [] ;
 
   thbind = overload {
     thbind : Str -> Str = \s -> s ;
-    thbind : (s1,s2 : Str) -> Str = \s1,s2 -> s1 ++ BIND ++ s2 ;
-    thbind : (s1,_,s3 : Str) -> Str = \s1,s2,s3 -> s1 ++ BIND ++ s2 ++ BIND ++ s3 ;
+    thbind : (s1,s2 : Str) -> Str = \s1,s2 -> s1 ++ bIND ++ s2 ;
+    thbind : (s1,_,s3 : Str) -> Str = \s1,s2,s3 -> s1 ++ bIND ++ s2 ++ bIND ++ s3 ;
     thbind : (s1,_,_,s4 : Str) -> Str = 
-      \s1,s2,s3,s4 -> s1 ++ BIND ++ s2 ++ BIND ++ s3 ++ BIND ++ s4 ;
+      \s1,s2,s3,s4 -> s1 ++ bIND ++ s2 ++ bIND ++ s3 ++ bIND ++ s4 ;
     thbind : (s1,_,_,_,s5 : Str) -> Str = 
-      \s1,s2,s3,s4,s5 -> s1 ++ BIND ++ s2 ++ BIND ++ s3 ++ BIND ++ s4 ++ BIND ++ s5 ;
+      \s1,s2,s3,s4,s5 -> s1 ++ bIND ++ s2 ++ bIND ++ s3 ++ bIND ++ s4 ++ bIND ++ s5 ;
     thbind : (s1,_,_,_,_,s6 : Str) -> Str = 
       \s1,s2,s3,s4,s5,s6 -> 
-       s1 ++ BIND ++ s2 ++ BIND ++ s3 ++ BIND ++ s4 ++ BIND ++ s5 ++ BIND ++ s6 ;
+       s1 ++ bIND ++ s2 ++ bIND ++ s3 ++ bIND ++ s4 ++ bIND ++ s5 ++ bIND ++ s6 ;
+
+    thbind : SS -> SS = \s -> s ;
+    thbind : (s1,s2 : SS) -> SS = \s1,s2 -> ss (s1.s ++ bIND ++ s2.s) ;
+    thbind : (s1,_,s3 : SS) -> SS = \s1,s2,s3 -> ss (s1.s ++ bIND ++ s2.s ++ bIND ++ s3.s) ;
+    thbind : (s1,_,_,s4 : SS) -> SS = 
+      \s1,s2,s3,s4 -> ss (s1.s ++ bIND ++ s2.s ++ bIND ++ s3.s ++ bIND ++ s4.s) ;
     } ;
 
 
@@ -59,6 +67,8 @@ resource ResTha = ParamX ** open StringsTha, Prelude in {
    VVerb = {s : Str ; typ : VVTyp} ;
 
    Adj = SS ; 
+ 
+   mkAdj : Str -> Adj = ss ;
 
 -- Verb phrases: form negation and question, too.
 
@@ -66,13 +76,15 @@ resource ResTha = ParamX ** open StringsTha, Prelude in {
      s : Polarity => Str 
      } ;
 
-   mkVP : Verb -> VP = \v -> {
+  infVP : VP -> Str = \vp -> vp.s ! Pos ; ----
+
+  predV : Verb -> VP = \v -> {
      s = \\p => if_then_Str v.isCompl 
                    (thbind v.s1 (polStr may_s p ++ v.s2))
                    (v.s1 ++     (polStr may_s p ++ v.s2)) --- v.s1 = []
      } ;
 
-   insertObj : VP -> NP -> VP = \vp,o -> {
+   insertObj : NP -> VP -> VP = \o,vp -> {
      s = \\p => thbind (vp.s ! p) o.s
      } ; 
 
@@ -86,9 +98,11 @@ resource ResTha = ParamX ** open StringsTha, Prelude in {
 
    polStr : Str -> Polarity -> Str = \m,p -> case p of {
      Pos => [] ;
-     Neg => thbind m []
+     Neg => m
      } ;
 
+   negation : Polarity -> Str = polStr may_s ;
+
 -- clauses
 
 param ClForm = ClDecl | ClQuest ;
@@ -96,6 +110,8 @@ param ClForm = ClDecl | ClQuest ;
 oper
   NP = SS ;
 
+  mkNP : Str -> NP = ss ;
+
   Clause = {
     s : ClForm => Polarity => Str
     } ;
@@ -103,8 +119,16 @@ oper
   mkClause : NP -> VP -> Clause = \np,vp -> {
     s = table {
       ClDecl  => \\p => thbind np.s (vp.s ! p) ;
-      ClQuest => \\p => thbind np.s (vp.s ! p) m'ay_s
+      ClQuest => \\p => thbind np.s (vp.s ! p) (polStr chay_s p) m'ay_s
       }
     } ;
 
+  mkPolClause : NP -> VP -> {s : Polarity => Str} = \np,vp -> {
+    s = (mkClause np vp).s ! ClDecl
+    } ;
+
+  conjThat = waa_s ;
+
+  reflPron = thbind tua_s eeng_s ;
+
 }

lib/src/thai/SentenceTha.gf

@@ -5,57 +5,44 @@ concrete SentenceTha of Sentence = CatTha **
 
   lin
 
-    PredVP np vp = {s = \\p => np.s ++ vp.s ! p} ;
+    PredVP np vp = mkClause np vp ;
 
---    PredSCVP sc vp = mkClause sc.s (agrP3 Sg) vp ;
+    PredSCVP sc vp = mkClause sc vp ;
 
     ImpVP vp = {
       s = table {
-        Pos => vp.s ! Pos ++ si_s ;
-        Neg => yaa_s ++ vp.s ! Pos
+        Pos => thbind (vp.s ! Pos) si_s ;
+        Neg => thbind yaa_s (vp.s ! Pos)
         }
       } ;
---    SlashV2 np v2 = 
---      mkClause (np.s ! Nom) np.a (predV v2) ** {c2 = v2.c2} ;
---
---    SlashVVV2 np vv v2 = 
---      mkClause (np.s ! Nom) np.a 
---        (insertObj (\\a => infVP vv.isAux (predV v2) a) (predVV vv))  **
---        {c2 = v2.c2} ;
---
---    AdvSlash slash adv = {
---      s  = \\t,a,b,o => slash.s ! t ! a ! b ! o ++ adv.s ;
---      c2 = slash.c2
---    } ;
---
---    SlashPrep cl prep = cl ** {c2 = prep.s} ;
---
---    EmbedS  s  = {s = conjThat ++ s.s} ;
---    EmbedQS qs = {s = qs.s ! QIndir} ;
---    EmbedVP vp = {s = infVP False vp (agrP3 Sg)} ; --- agr
---
-    UseCl  t p cl = {s = t.s ++ p.s ++ cl.s ! p.p} ;
-    UseQCl t p cl = {
-      s = \\q => t.s ++ p.s ++
-                 case q of {QIndir => waa_s ; _ => []} ++ 
-                 cl.s ! p.p
+
+    SlashVP np vp = mkPolClause np vp ** {c2 = vp.c2} ;
+
+    SlashVS np vs slash = 
+      mkPolClause np (insertObj (mkNP <thbind conjThat slash.s : Str>) (predV vs))  ** {c2 = slash.c2} ;
+
+    AdvSlash slash adv = {
+      s  = \\p => thbind (slash.s ! p) adv.s ;
+      c2 = slash.c2
       } ;
---    UseRCl t a p cl = {
---      s = \\r => t.s ++ a.s ++ p.s ++ cl.s ! t.t ! a.a ! ctr p.p ! r ;
---      c = cl.c
---      } ;
---
---    AdvS a s = {s = a.s ++ "," ++ s.s} ;
---
---  oper
---    ctr = contrNeg True ;  -- contracted negations
---}
---
---{-
------ todo: tense of embedded Slash
---
---    SlashVSS np vs s = 
---      mkClause (np.s ! Nom) np.a 
---        (insertObj (\\_ => conjThat ++ s.s) (predV vs)) **
---        {c2 = s.c2} ;
+  
+    SlashPrep cl prep = {s = cl.s ! ClDecl ; c2 = prep.s} ;
+  
+    EmbedS  s  = {s = thbind conjThat s.s} ;
+    EmbedQS qs = {s = qs.s ! QIndir} ;
+    EmbedVP vp = {s = infVP vp} ;
+
+    UseCl  t p cl = {s = thbind t.s p.s (cl.s ! ClDecl ! p.p)} ;
+    UseQCl t p cl = {
+      s = \\q => thbind t.s p.s
+                 (case q of {QIndir => waa_s ; _ => []}) (cl.s ! p.p)
+      } ;
+    UseRCl t p cl = {
+      s = thbind t.s p.s (cl.s ! p.p) ;
+      } ;
+    UseSlash  t p cl = {s = thbind t.s p.s (cl.s ! p.p) ; c2 = cl.c2} ;
+
+    AdvS a s = thbind a s ;
+
+    RelS s r = thbind s r ;
 }

lib/src/thai/StringsTha.gf

@@ -24,6 +24,7 @@ di_s = "ดิ" ; -- I (fem)1
 dii_s = "ดี" ; -- hello2
 duay_s = "ด้วย" ; -- help2
 dvm_s = "ดึม" ; -- drink
+eeng_s = "เอง" ; -- self
 et_s = "เอ็ด" ; -- one'
 haa_s = "ห้า" ; -- five
 hay_s = "ให้" ; -- give
@@ -31,6 +32,7 @@ hoog_s = "ห้อง" ; -- room
 hok_s = "หก" ; -- six
 jai_s = "ใj" ; -- understand2
 kaaw_s = "เกา" ; -- nine
+kam_s = "กำ" ; -- Progr1
 kew_s = "แก้ว" ; -- glass (drink Classif)
 khaw_s = "เขา" ; -- he
 khon_s = "คน" ; -- people Classif
@@ -40,7 +42,9 @@ khoop_s = "ขอบ" ; -- thank
 khow_s = "เข้ว" ; -- understand1
 khun_s = "คุณ" ; -- you
 koon_s = "ก่อน" ; -- bye2
+kwaa_s = "กว่า" ; -- comparative
 laa_s = "ลา" ; -- bye1
+lag2_s = "ลัง" ; -- Progr2
 lag_s = "หลัง" ; -- houses Classif
 lap_s = "หลับ" ; -- sleep2 
 lem_s = "เล่ม" ; -- books Classif
@@ -75,11 +79,14 @@ si_s = "ซิ" ; -- Imperative
 sii_s = "สี่" ; -- four
 sip_s = "สิบ" ; -- ten
 soog_s = "สอง" ; -- two
+sut_s = "สุด" ; -- Superlative
 svv_s = "สือ" ; -- book2
 thii_s = "ที่" ; -- Ord
 thoot_s = "โทr'" ; -- sorry2
 thao_s = "เท่า" ; -- how-much1
+thuuk_s = "ถูก" ; -- passive
 tog_s = "ต้อง" ; -- must
+tua_s = "ตัว" ; -- refl pronoun
 waa_s = "ว่า" ; -- that Conj
 way_s = "ไหว" ; -- can-potent
 yaa_s = "อย่า" ; -- Neg Imper

lib/src/thai/VerbTha.gf

@@ -3,9 +3,22 @@ concrete VerbTha of Verb = CatTha ** open ResTha, StringsTha, Prelude in {
   flags optimize=all_subs ;
 
   lin
-    UseV = mkVP ;
---    ComplV2 v np = insertObject (v.c2 ++ np.s) (mkVP v)  ;
---    ComplV3 v np np2 = insertObject (v.c2 ++ np.s ++ v.c3 ++ np2.s) (mkVP v)  ;
+    UseV = predV ;
+
+    SlashV2a v = predV v ** {c2 = v.c2} ;
+
+    Slash2V3 v np = insertObj np (predV v) ** {c2 = v.c3} ;
+    Slash3V3 v np = insertObj np (predV v) ** {c2 = v.c2} ;
+
+    SlashV2A v ap = 
+      insertObj (mkNP <thbind v.c2 ap.s : Str>) (predV v) ** {c2 = v.c2} ;
+
+    SlashV2V v vp = ---- looks too simple compared with ComplVV
+      insertObj (mkNP <thbind v.c2 (infVP vp) : Str>) (predV v) ** {c2 = v.c2} ;
+    SlashV2S v s  = 
+      insertObj (mkNP <thbind conjThat s.s : Str>) (predV v) ** {c2 = v.c2} ;
+    SlashV2Q v q  = 
+      insertObj (mkNP (q.s ! QDir)) (predV v) ** {c2 = v.c2} ;
 
     ComplVV vv vp = {
       s = \\p =>
@@ -14,38 +27,52 @@ concrete VerbTha of Verb = CatTha ** open ResTha, StringsTha, Prelude in {
           v = vp.s ! Pos
         in 
         case vv.typ of {
-          VVPre => vv.s ++ neg ++ v ; 
-          VVMid => neg ++ vv.s ++ v ; 
-          VVPost => v ++ neg ++ vv.s
+          VVPre => thbind vv.s neg v ; 
+          VVMid => thbind neg vv.s v ; 
+          VVPost => thbind v neg vv.s
           }
       } ;
 
---
---    ComplVS v s  = insertObj (\\_ => conjThat ++ s.s) (predV v) ;
---    ComplVQ v q  = insertObj (\\_ => q.s ! QIndir) (predV v) ;
---
---    ComplVA  v    ap = insertObj (ap.s) (predV v) ;
---    ComplV2A v np ap = 
---      insertObj (\\_ => v.c2 ++ np.s ! Acc ++ ap.s ! np.a) (predV v) ;
---
-    UseComp comp = comp ;
---
---    AdvVP vp adv = insertObj (\\_ => adv.s) vp ;
---
---    AdVVP adv vp = insertAdV adv.s vp ;
---
---    ReflV2 v = insertObj (\\a => v.c2 ++ reflPron ! a) (predV v) ;
---
---    PassV2 v = insertObj (\\_ => v.s ! VPPart) (predAux auxBe) ;
---
---    UseVS, UseVQ = \vv -> {s = vv.s ; c2 = [] ; isRefl = vv.isRefl} ; 
+    ComplVS v s  = insertObj (mkNP (thbind conjThat s.s)) (predV v) ;
+    ComplVQ v q  = insertObj (mkNP (q.s ! QDir)) (predV v) ;
+
+
+    ComplVA  v    ap = insertObj ap (predV v) ; 
+
+    ComplSlash vp np = insertObj (mkNP (thbind vp.c2 np.s)) vp ;
+
+    UseComp comp = comp ;
+
+    SlashVV v vp = ---- too simple?
+      insertObj (mkNP (infVP vp)) (predV (regV v.s)) ** {c2 = vp.c2} ;
+
+    SlashV2VNP v np vp = 
+      insertObj np
+        (insertObj (mkNP (infVP vp)) (predV v)) ** {c2 = vp.c2} ;
+
+    AdvVP vp adv = insertObj adv vp ;
+
+    AdVVP adv vp = insertObj adv vp ; 
+    
+    ReflVP vp = insertObj (mkNP (thbind vp.c2 reflPron)) vp ;
+
+    PassV2 v = {s = \\p => thbind thuuk_s ((predV v).s ! p)} ;
+
+    CompAP ap = {s = \\p => thbind (polStr may_s p) ap.s} ;
 
-    CompAP ap = {s = \\p => polStr may_s p ++ ap.s} ;
     CompNP np = {s = table {
-      Pos => pen_s ++ np.s ;
-      Neg => may_s ++ chay_s ++ np.s
+      Pos => thbind pen_s np.s ;
+      Neg => thbind may_s chay_s np.s
       }
     } ;
+
+    CompCN np = {s = table {
+      Pos => thbind pen_s np.s ;
+      Neg => thbind may_s chay_s np.s
+      }
+    } ;
+
     CompAdv a = {s = \\p => polStr may_s p ++ a.s} ; --- ??
 
 }
+