diff --git a/lib/src/thai/AdjectiveTha.gf b/lib/src/thai/AdjectiveTha.gf index 68e8acba9..dc398d44d 100644 --- a/lib/src/thai/AdjectiveTha.gf +++ b/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 ; + } diff --git a/lib/src/thai/AdverbTha.gf b/lib/src/thai/AdverbTha.gf index 876629468..e92bae6b3 100644 --- a/lib/src/thai/AdverbTha.gf +++ b/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) ; ----- + } diff --git a/lib/src/thai/CatTha.gf b/lib/src/thai/CatTha.gf index d13983f4a..ae66466d9 100644 --- a/lib/src/thai/CatTha.gf +++ b/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 ; + } diff --git a/lib/src/thai/ConjunctionTha.gf b/lib/src/thai/ConjunctionTha.gf index 38071f077..59540b603 100644 --- a/lib/src/thai/ConjunctionTha.gf +++ b/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} ; + +} diff --git a/lib/src/thai/GrammarTha.gf b/lib/src/thai/GrammarTha.gf index 9445ef6f8..0b213c14f 100644 --- a/lib/src/thai/GrammarTha.gf +++ b/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 ** { diff --git a/lib/src/thai/IdiomTha.gf b/lib/src/thai/IdiomTha.gf index 40851f3ab..7fbe9b967 100644 --- a/lib/src/thai/IdiomTha.gf +++ b/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) ; ---- + +} + + diff --git a/lib/src/thai/NounTha.gf b/lib/src/thai/NounTha.gf index 3bc9ab578..4b65db9e0 100644 --- a/lib/src/thai/NounTha.gf +++ b/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 ; + } diff --git a/lib/src/thai/NumeralTha.gf b/lib/src/thai/NumeralTha.gf index 9201fa26f..470628688 100644 --- a/lib/src/thai/NumeralTha.gf +++ b/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 "๙" ; + } diff --git a/lib/src/thai/PhraseTha.gf b/lib/src/thai/PhraseTha.gf index c51d85a20..372f3c687 100644 --- a/lib/src/thai/PhraseTha.gf +++ b/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} ; ---- ?? diff --git a/lib/src/thai/QuestionTha.gf b/lib/src/thai/QuestionTha.gf index 033539bdf..4d4b5a819 100644 --- a/lib/src/thai/QuestionTha.gf +++ b/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 ; --- } + diff --git a/lib/src/thai/RelativeTha.gf b/lib/src/thai/RelativeTha.gf index 1dadd0ccf..5b02cc3c4 100644 --- a/lib/src/thai/RelativeTha.gf +++ b/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 ; + +} diff --git a/lib/src/thai/ResTha.gf b/lib/src/thai/ResTha.gf index 9e4c800b6..886fc4053 100644 --- a/lib/src/thai/ResTha.gf +++ b/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 ; + } diff --git a/lib/src/thai/SentenceTha.gf b/lib/src/thai/SentenceTha.gf index 3d46348c8..65f64e937 100644 --- a/lib/src/thai/SentenceTha.gf +++ b/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 ) (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 ; } diff --git a/lib/src/thai/StringsTha.gf b/lib/src/thai/StringsTha.gf index e57986de5..0663b49d7 100644 --- a/lib/src/thai/StringsTha.gf +++ b/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 diff --git a/lib/src/thai/VerbTha.gf b/lib/src/thai/VerbTha.gf index b894a04f9..2dd54d19d 100644 --- a/lib/src/thai/VerbTha.gf +++ b/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 ) (predV v) ** {c2 = v.c2} ; + + SlashV2V v vp = ---- looks too simple compared with ComplVV + insertObj (mkNP ) (predV v) ** {c2 = v.c2} ; + SlashV2S v s = + insertObj (mkNP ) (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} ; --- ?? } +