complete Thai resource syntax (but many unverified rules)

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 ;
+
 }