complete Thai resource syntax (but many unverified rules)

This commit is contained in:
aarne
2011-11-07 13:29:24 +00:00
parent 2699780736
commit 7cbf532735
15 changed files with 379 additions and 379 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -1,5 +1,7 @@
concrete NumeralTha of Numeral = CatTha ** open ResTha, StringsTha, Prelude in { concrete NumeralTha of Numeral = CatTha ** open ResTha, StringsTha, Prelude in {
flags coding = utf8 ;
lincat lincat
-- Numeral = {s : Str} ; -- Numeral = {s : Str} ;
Digit = {s : DForm => Str} ; Digit = {s : DForm => Str} ;
@@ -63,4 +65,25 @@ oper
roy = table {Unit => rooy_s ; Thousand => seen_s} ; roy = table {Unit => rooy_s ; Thousand => seen_s} ;
phan = table {Unit => [] ; Thousand => phan_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 "๙" ;
} }

View File

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

View File

@@ -7,35 +7,39 @@ concrete QuestionTha of Question = CatTha **
-- pos. may, neg. chay may - not always the proper forms --- -- 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 ;
--
} }

View File

@@ -1,48 +1,10 @@
--concrete RelativeTha of Relative = CatTha ** open ResTha in { concrete RelativeTha of Relative = CatTha ** open ResTha, Prelude in {
--
-- flags optimize=all_subs ; lin
-- RelCl cl = {s = \\p => thbind thii_s (cl.s ! ClDecl ! p)} ; ---- ??
-- lin RelVP rp vp = mkPolClause rp vp ;
-- RelSlash rp slash = {s = \\p => thbind slash.c2 rp.s (slash.s ! p)} ;
-- RelCl cl = { FunRP p np rp = {s = thbind np.s p.s rp.s} ; ---- ??
-- s = \\t,a,p,_ => "such" ++ "that" ++ cl.s ! t ! a ! p ! ODir ; IdRP = ss thii_s ;
-- 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
-- } ;
--
--}

View File

@@ -7,23 +7,31 @@
---- implement $Test$, it moreover contains regular lexical ---- implement $Test$, it moreover contains regular lexical
---- patterns needed for $Lex$. ---- patterns needed for $Lex$.
-- --
resource ResTha = ParamX ** open StringsTha, Prelude in { resource ResTha = ParamX, StringsTha ** open Prelude in {
oper oper
-- binding words together -- binding words together - if you want. But better do it with the unlexer -unchars.
bIND = [] ;
thbind = overload { thbind = overload {
thbind : Str -> Str = \s -> s ; thbind : Str -> Str = \s -> s ;
thbind : (s1,s2 : Str) -> Str = \s1,s2 -> s1 ++ BIND ++ s2 ; 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,_,s3 : Str) -> Str = \s1,s2,s3 -> s1 ++ bIND ++ s2 ++ bIND ++ s3 ;
thbind : (s1,_,_,s4 : Str) -> Str = 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 = 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 = thbind : (s1,_,_,_,_,s6 : Str) -> Str =
\s1,s2,s3,s4,s5,s6 -> \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) ;
} ; } ;
@@ -60,19 +68,23 @@ resource ResTha = ParamX ** open StringsTha, Prelude in {
Adj = SS ; Adj = SS ;
mkAdj : Str -> Adj = ss ;
-- Verb phrases: form negation and question, too. -- Verb phrases: form negation and question, too.
VP = { VP = {
s : Polarity => Str 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 s = \\p => if_then_Str v.isCompl
(thbind v.s1 (polStr may_s p ++ v.s2)) (thbind v.s1 (polStr may_s p ++ v.s2))
(v.s1 ++ (polStr may_s p ++ v.s2)) --- v.s1 = [] (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 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 { polStr : Str -> Polarity -> Str = \m,p -> case p of {
Pos => [] ; Pos => [] ;
Neg => thbind m [] Neg => m
} ; } ;
negation : Polarity -> Str = polStr may_s ;
-- clauses -- clauses
param ClForm = ClDecl | ClQuest ; param ClForm = ClDecl | ClQuest ;
@@ -96,6 +110,8 @@ param ClForm = ClDecl | ClQuest ;
oper oper
NP = SS ; NP = SS ;
mkNP : Str -> NP = ss ;
Clause = { Clause = {
s : ClForm => Polarity => Str s : ClForm => Polarity => Str
} ; } ;
@@ -103,8 +119,16 @@ oper
mkClause : NP -> VP -> Clause = \np,vp -> { mkClause : NP -> VP -> Clause = \np,vp -> {
s = table { s = table {
ClDecl => \\p => thbind np.s (vp.s ! p) ; 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 ;
} }

View File

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

View File

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

View File

@@ -3,9 +3,22 @@ concrete VerbTha of Verb = CatTha ** open ResTha, StringsTha, Prelude in {
flags optimize=all_subs ; flags optimize=all_subs ;
lin lin
UseV = mkVP ; UseV = predV ;
-- 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) ; 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 = { ComplVV vv vp = {
s = \\p => s = \\p =>
@@ -14,38 +27,52 @@ concrete VerbTha of Verb = CatTha ** open ResTha, StringsTha, Prelude in {
v = vp.s ! Pos v = vp.s ! Pos
in in
case vv.typ of { case vv.typ of {
VVPre => vv.s ++ neg ++ v ; VVPre => thbind vv.s neg v ;
VVMid => neg ++ vv.s ++ v ; VVMid => thbind neg vv.s v ;
VVPost => v ++ neg ++ vv.s VVPost => thbind v neg vv.s
} }
} ; } ;
-- ComplVS v s = insertObj (mkNP (thbind conjThat s.s)) (predV v) ;
-- ComplVS v s = insertObj (\\_ => conjThat ++ s.s) (predV v) ; ComplVQ v q = insertObj (mkNP (q.s ! QDir)) (predV v) ;
-- ComplVQ v q = insertObj (\\_ => q.s ! QIndir) (predV v) ;
--
-- ComplVA v ap = insertObj (ap.s) (predV v) ; ComplVA v ap = insertObj ap (predV v) ;
-- ComplV2A v np ap =
-- insertObj (\\_ => v.c2 ++ np.s ! Acc ++ ap.s ! np.a) (predV v) ; ComplSlash vp np = insertObj (mkNP (thbind vp.c2 np.s)) vp ;
--
UseComp comp = comp ; 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} ;
CompAP ap = {s = \\p => polStr may_s p ++ ap.s} ; 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} ;
CompNP np = {s = table { CompNP np = {s = table {
Pos => pen_s ++ np.s ; Pos => thbind pen_s np.s ;
Neg => may_s ++ chay_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} ; --- ?? CompAdv a = {s = \\p => polStr may_s p ++ a.s} ; --- ??
} }