add distinction between Attributive vs Predicative (esp for colours)

This commit is contained in:
1Regina
2022-01-03 15:54:05 +08:00
committed by Meowyam
parent cf9e2cdd7f
commit dd5b34492a
11 changed files with 172 additions and 159 deletions

View File

@@ -4,55 +4,58 @@ concrete AdjectiveChi of Adjective = CatChi ** open ResChi, Prelude in {
PositA a = a ** {hasAdA = False} ; PositA a = a ** {hasAdA = False} ;
--ComparA a np = complexAP (a.s ++ than_s ++ np.s) ; ComparA a np = a ** {
-- ComparA a np = complexAP (than_s ++ np.s ++ a.s) ; s = table { adjPlace => than_s ++ np.s ++ a.s!adjPlace};
ComparA a np = a ** { hasAdA = False
s = table { adjPlace => than_s ++ np.s ++ a.s!adjPlace}
};
--UseComparA a = complexAP (geng_s ++ a.s) ; };
UseComparA a = geng ** {
s = table { adjPlace => geng.s!adjPlace ++ a.s} UseComparA a = a ** {
}; s = table { adjPlace => geng_s ++ a.s!adjPlace};
hasAdA = False
};
-- AdjOrd ord = complexAP ord.s ;
AdjOrd ord = ord ** { AdjOrd ord = ord ** {
s = table {adjPlace => ord.s!adjPlace} s = table {
adjPlace => ord.s
-- Attr => ord.s; --"first is he" ;
-- Pred => ord.s --"he is first"
} ;
hasAdA = False;
monoSyl = True -- to do and figure out in relation to Ord = {s : Str}
}; };
-- CAdvAP ad ap np = complexAP (ap.s ++ ad.s ++ ad.p ++ np.s) ; CAdvAP ad ap np = ap ** {
-- CAdvAP ad ap np = complexAP (ad.s++ np.s++ad.p++ap.s ) ; --modified by ChenPeng 11.24
CAdvAP ad ap np = ap ** {
s = table {adjPlace => ad.s ++ np.s ++ ad.p ++ ap.s!adjPlace} s = table {adjPlace => ad.s ++ np.s ++ ad.p ++ ap.s!adjPlace}
}; };
-- ComplA2 a np = complexAP (appPrep a.c2 np.s ++ a.s) ;
ComplA2 a np = a ** { ComplA2 a np = a ** {
s= table { adjPlace => appPrep a.c2 np.s ++ a.s!adjPlace} s= table { adjPlace => appPrep a.c2 np.s ++ a.s!adjPlace};
}; hasAdA = False
};
-- ReflA2 a = complexAP (a.s ++ appPrep a.c2 reflPron) ;
ReflA2 a = a ** { ReflA2 a = a ** {
s = table {adjPlace => a.s!adjPlace ++ appPrep a.c2 reflPron} s = table {adjPlace => a.s!adjPlace ++ appPrep a.c2 reflPron};
}; hasAdA = False
};
-- SentAP ap sc = complexAP (ap.s ++ sc.s) ;
SentAP ap sc = ap ** { SentAP ap sc = ap ** {
s = table { adjPlace => ap.s ! adjPlace ++ sc.s } s = table { adjPlace => ap.s ! adjPlace ++ sc.s }
} ; } ;
-- AdAP ada ap = {s = ada.s ++ ap.s ; monoSyl = False ; hasAdA = True} ; -- AdAP ada ap = {s = ada.s ++ ap.s ; monoSyl = False ; hasAdA = True} ;
AdAP ada ap = ap ** { AdAP ada ap = ap ** {
s = table { adjPlace => ada.s ++ ap.s ! adjPlace ; monoSyl = False; hasAdA = True} s = table { adjPlace => ada.s ++ ap.s ! adjPlace };
}; monoSyl = False;
hasAdA = True
};
UseA2 a = a ** {hasAdA = False} ; UseA2 a = a ** {hasAdA = False} ;
-- AdvAP ap adv = complexAP (adv.s ++ ap.s) ; AdvAP ap adv = ap ** {
AdvAP ap adv = ap ** {
s = table { adjPlace => adv.s ++ ap.s ! adjPlace } s = table { adjPlace => adv.s ++ ap.s ! adjPlace }
}; };
} }

View File

@@ -1,14 +1,14 @@
concrete AdverbChi of Adverb = CatChi ** concrete AdverbChi of Adverb = CatChi **
open ResChi, Prelude in { open ResChi, Prelude in {
lin lin
PositAdvAdj a = {s = a.s ++ "地" ; advType = ATManner ; hasDe = False} ; ---- for all adjs? PositAdvAdj a = {s = a.s!Attr ++ "地" ; advType = ATManner ; hasDe = False} ; ---- for all adjs?
PrepNP prep np = ss (appPrep prep np.s) ** {advType = prep.advType ; hasDe = prep.hasDe} ; --- should depend on np too ? PrepNP prep np = ss (appPrep prep np.s) ** {advType = prep.advType ; hasDe = prep.hasDe} ; --- should depend on np too ?
ComparAdvAdj cadv a np = ss (a.s ++ cadv.s ++ cadv.p ++ np.s) ** {advType = ATManner ; hasDe = False} ; ComparAdvAdj cadv a np = ss (a.s!Attr ++ cadv.s ++ cadv.p ++ np.s) ** {advType = ATManner ; hasDe = False} ;
ComparAdvAdjS cadv a s = ss (a.s ++ cadv.s ++ cadv.p ++ s.s) ** {advType = ATManner ; hasDe = False} ; ComparAdvAdjS cadv a s = ss (a.s!Attr ++ cadv.s ++ cadv.p ++ s.s) ** {advType = ATManner ; hasDe = False} ;
AdAdv ad adv = adv ** {s = ad.s ++ adv.s} ; AdAdv ad adv = adv ** {s = ad.s ++ adv.s} ;
@@ -16,6 +16,6 @@ concrete AdverbChi of Adverb = CatChi **
AdnCAdv cadv = ss (cadv.s ++ conjThat) ** {advType = ATManner ; hasDe = False} ; ----- AdnCAdv cadv = ss (cadv.s ++ conjThat) ** {advType = ATManner ; hasDe = False} ; -----
PositAdAAdj a = {s = a.s} ; ---- PositAdAAdj a = {s = a.s!Attr} ; ----
} }

View File

@@ -5,9 +5,9 @@ concrete ConjunctionChi of Conjunction = CatChi ** open ResChi, Prelude, Coordin
ConjS c = conjunctDistrSS (c.s ! CSent) ; ConjS c = conjunctDistrSS (c.s ! CSent) ;
ConjAdv c as = conjunctDistrSS (c.s ! CSent) as ** {advType = as.advType ; hasDe = as.hasDe} ; ---- ?? ConjAdv c as = conjunctDistrSS (c.s ! CSent) as ** {advType = as.advType ; hasDe = as.hasDe} ; ---- ??
ConjNP c = conjunctDistrSS (c.s ! CPhr CNPhrase) ; ConjNP c = conjunctDistrSS (c.s ! CPhr CNPhrase) ;
ConjAP c as = conjunctDistrSS (c.s ! CPhr CAPhrase) as ** {monoSyl = notB as.monoSyl ; hasAdA = True} ; ---- add de iff as doesn't ConjAP c as = conjunctDistrTable AdjPlace (c.s ! CPhr CAPhrase) as ** {monoSyl = notB as.monoSyl ; hasAdA = True} ; ---- add de iff as doesn't
ConjRS c = conjunctDistrSS (c.s ! CSent) ; ConjRS c = conjunctDistrSS (c.s ! CSent) ;
ConjCN c ns = conjunctDistrSS (c.s ! CPhr CNPhrase) ns ** {c = ns.c} ; ConjCN c ns = conjunctDistrSS (c.s ! CPhr CNPhrase) ns ** {c = ns.c} ;
-- These fun's are generated from the list cat's. -- These fun's are generated from the list cat's.
@@ -17,8 +17,8 @@ concrete ConjunctionChi of Conjunction = CatChi ** open ResChi, Prelude, Coordin
ConsAdv x xs = consrSS duncomma x xs ** {advType = x.advType ; hasDe = xs.hasDe} ; ---- ?? ConsAdv x xs = consrSS duncomma x xs ** {advType = x.advType ; hasDe = xs.hasDe} ; ---- ??
BaseNP = twoSS ; BaseNP = twoSS ;
ConsNP = consrSS duncomma ; ConsNP = consrSS duncomma ;
BaseAP x y = twoSS x y ** {monoSyl = y.monoSyl} ; BaseAP x y = twoTable AdjPlace x y ** {monoSyl = y.monoSyl} ;
ConsAP x xs = consrSS duncomma x xs ** {monoSyl = xs.monoSyl} ; ConsAP x xs = consrTable AdjPlace duncomma x xs ** {monoSyl = xs.monoSyl} ;
BaseRS = twoSS ; BaseRS = twoSS ;
ConsRS = consrSS duncomma ; ConsRS = consrSS duncomma ;
BaseCN x y = twoSS x y ** {c = x.c} ; --- classified comes from first part ; should it rather be ge? BaseCN x y = twoSS x y ** {c = x.c} ; --- classified comes from first part ; should it rather be ge?
@@ -28,7 +28,7 @@ concrete ConjunctionChi of Conjunction = CatChi ** open ResChi, Prelude, Coordin
[S] = {s1,s2 : Str} ; [S] = {s1,s2 : Str} ;
[Adv] = {s1,s2 : Str ; advType : AdvType ; hasDe : Bool} ; [Adv] = {s1,s2 : Str ; advType : AdvType ; hasDe : Bool} ;
[NP] = {s1,s2 : Str} ; [NP] = {s1,s2 : Str} ;
[AP] = {s1,s2 : Str ; monoSyl : Bool} ; [AP] = {s1,s2 : AdjPlace => Str ; monoSyl : Bool} ;
[RS] = {s1,s2 : Str} ; [RS] = {s1,s2 : Str} ;
[CN] = {s1,s2 : Str ; c : Str} ; [CN] = {s1,s2 : Str ; c : Str} ;

View File

@@ -1,6 +1,6 @@
concrete DocumentationChi of Documentation = CatChi ** open concrete DocumentationChi of Documentation = CatChi ** open
ResChi, ResChi,
HTML HTML
in { in {
lincat lincat
@@ -19,9 +19,9 @@ lin
InflectionA, InflectionA2 = \adj -> { InflectionA, InflectionA2 = \adj -> {
t = "a" ; t = "a" ;
s1 = heading1 "Adjective" ; s1 = heading1 "Adjective" ;
s2 = adj.s s2 = adj.s!Attr
} ; } ;
InflectionAdv, InflectionAdV, InflectionAdA, InflectionAdN = \adv -> { InflectionAdv, InflectionAdV, InflectionAdA, InflectionAdN = \adv -> {
t = "adv" ; t = "adv" ;
s1 = heading1 "Adverb" ; s1 = heading1 "Adverb" ;

View File

@@ -1,9 +1,9 @@
concrete ExtraChi of ExtraChiAbs = CatChi ** concrete ExtraChi of ExtraChiAbs = CatChi **
open ResChi, Coordination, (S = StructuralChi), Prelude in { open ResChi, Coordination, (S = StructuralChi), Prelude in {
flags coding = utf8 ; flags coding = utf8 ;
lincat lincat
VPS = {s : Str} ; VPS = {s : Str} ;
[VPS] = {s1,s2 : Str} ; [VPS] = {s1,s2 : Str} ;
VPI = {s : Str} ; --- ??? VPI = {s : Str} ; --- ???
@@ -37,15 +37,15 @@ concrete ExtraChi of ExtraChiAbs = CatChi **
Aspect = {s : Str ; a : ResChi.Aspect} ; Aspect = {s : Str ; a : ResChi.Aspect} ;
lin lin
CompBareAP ap = case ap.hasAdA of { CompBareAP ap = case ap.hasAdA of {
True => insertObj (mkNP ap.s) (predV nocopula []) ; True => insertObj (mkNP (ap.s!Pred)) (predV nocopula []) ;
False => insertObj (mkNP ap.s) (predV hen_copula []) False => insertObj (mkNP (ap.s!Pred)) (predV hen_copula [])
} ; } ;
QuestRepV cl = { QuestRepV cl = {
s = \\_,p,a => ---- also for indirect questions? s = \\_,p,a => ---- also for indirect questions?
let let
v = cl.vp.verb ; v = cl.vp.verb ;
verb = case a of { verb = case a of {
APlain => v.s ++ v.neg ++ v.sn ; APlain => v.s ++ v.neg ++ v.sn ;
APerf => v.s ++ "不" ++ v.sn ++ v.pp ; APerf => v.s ++ "不" ++ v.sn ++ v.pp ;
ADurStat => v.s ++ "不" ++ v.sn ; ADurStat => v.s ++ "不" ++ v.sn ;
ADurProg => v.s ++ v.neg ++ v.dp ++ v.sn ; -- mei or bu ADurProg => v.s ++ v.neg ++ v.dp ++ v.sn ; -- mei or bu
@@ -57,4 +57,4 @@ concrete ExtraChi of ExtraChiAbs = CatChi **
TopicAdvVP vp adv = insertTopic adv vp ; TopicAdvVP vp adv = insertTopic adv vp ;
} }

View File

@@ -1,7 +1,7 @@
concrete LexiconChi of Lexicon = CatChi ** concrete LexiconChi of Lexicon = CatChi **
open ParadigmsChi, ResChi, Prelude in { open ParadigmsChi, ResChi, Prelude in {
flags flags
coding = utf8 ; coding = utf8 ;
lin lin
@@ -14,13 +14,13 @@ lin
tree_N = mkN "树" "棵"; -- "shu" "ke" tree_N = mkN "树" "棵"; -- "shu" "ke"
big_A = mkA "大" ; -- "da" big_A = mkA "大" ; -- "da"
small_A = mkA "小" ; -- "xiao" small_A = mkA "小" ; -- "xiao"
green_A = mkA "绿" ; -- "lv" green_A = colourA "绿" ; -- "lv"
walk_V = mkV "走" ; -- "zou" walk_V = mkV "走" ; -- "zou"
sleep_V = mkV "睡觉" ; -- "shui" sleep_V = mkV "睡觉" ; -- "shui"
love_V2 = mkV2 "爱" ; -- "ai" love_V2 = mkV2 "爱" ; -- "ai"
watch_V2 = mkV2 "看" ; -- "kan" watch_V2 = mkV2 "看" ; -- "kan"
know_VS = mkV "知道" ; -- "zhidao" know_VS = mkV "知道" ; -- "zhidao"
wonder_VQ = mkV "好奇" ; -- "haoqi" wonder_VQ = mkV "好奇" ; -- "haoqi"
john_PN = mkPN "约翰" ; -- "yuehan" john_PN = mkPN "约翰" ; -- "yuehan"
@@ -63,7 +63,7 @@ horn_N = mkN "角" "根";
tail_N = mkN "尾巴" "条"; -- [mark] "尾" -> "尾巴" , "尾" is often treated as morpheme, or if stands alone, it is a classifier itself tail_N = mkN "尾巴" "条"; -- [mark] "尾" -> "尾巴" , "尾" is often treated as morpheme, or if stands alone, it is a classifier itself
feather_N = mkN "羽毛" "根"; feather_N = mkN "羽毛" "根";
hair_N = mkN "头发" "根"; -- [mark] several classifiers , "根"(single hair), "把"(several hairs) hair_N = mkN "头发" "根"; -- [mark] several classifiers , "根"(single hair), "把"(several hairs)
head_N = mkN "头" "颗"; head_N = mkN "头" "颗";
ear_N = mkN "耳朵" "只"; ear_N = mkN "耳朵" "只";
eye_N = mkN "眼睛" "只"; eye_N = mkN "眼睛" "只";
nose_N = mkN "鼻子" ; nose_N = mkN "鼻子" ;
@@ -79,7 +79,7 @@ wing_N = mkN "翅膀" "只"; -- [mark] "翼" -> "翅膀", "翅膀" is the common
belly_N = mkN "肚子" ; belly_N = mkN "肚子" ;
guts_N = mkN "肠子" "根"; guts_N = mkN "肠子" "根";
neck_N = mkN "脖子" ; neck_N = mkN "脖子" ;
back_N = mkN "背" ; back_N = mkN "背" ;
breast_N = mkN "胸" ; breast_N = mkN "胸" ;
heart_N = mkN "心脏" "颗"; heart_N = mkN "心脏" "颗";
liver_N = mkN "肝" ; liver_N = mkN "肝" ;
@@ -101,7 +101,7 @@ live_V = mkV "活" ;
die_V = mkV "死" ; die_V = mkV "死" ;
kill_V2 = mkV2 "杀" ; kill_V2 = mkV2 "杀" ;
fight_V2 = mkV2 "打架" ; -- [mark] "吵架" -> "打架", "吵架" = quarrel, argue fight_V2 = mkV2 "打架" ; -- [mark] "吵架" -> "打架", "吵架" = quarrel, argue
hunt_V2 = mkV2 "打猎" ; -- [mark] "打猎" is iv, can't think of proper translation in v2 form for hunt hunt_V2 = mkV2 "打猎" ; -- [mark] "打猎" is iv, can't think of proper translation in v2 form for hunt
hit_V2 = mkV2 "打" ; hit_V2 = mkV2 "打" ;
cut_V2 = mkV2 "割" ; cut_V2 = mkV2 "割" ;
split_V2 = mkV2 "劈开" ; split_V2 = mkV2 "劈开" ;
@@ -159,10 +159,10 @@ ashes_N = mkN "灰" [];
burn_V = mkV "烧" ; burn_V = mkV "烧" ;
road_N = mkN "路" "条"; road_N = mkN "路" "条";
mountain_N = mkN "山" "座"; mountain_N = mkN "山" "座";
red_A = mkA "红" ; red_A = colourA "红" ;
yellow_A = mkA "黄" ; yellow_A = colourA "黄" ;
white_A = mkA "白" ; white_A = colourA "白" ;
black_A = mkA "黑" ; black_A = colourA "黑" ;
night_N = mkN "夜晚" ; -- [mark] "夜晚" 's classifier is "个" night_N = mkN "夜晚" ; -- [mark] "夜晚" 's classifier is "个"
day_N = mkN "白天" []; -- [mark] "白天" -> "天", "天" itself is classifier day_N = mkN "白天" []; -- [mark] "白天" -> "天", "天" itself is classifier
year_N = mkN "年" [] ; -- [mark] "年" itself is classifier year_N = mkN "年" [] ; -- [mark] "年" itself is classifier
@@ -343,7 +343,7 @@ shirt_N = mkN "衬衫" "件" ;
silver_N = mkN "银子" "块"; -- [mark] "银" --> "银子" silver_N = mkN "银子" "块"; -- [mark] "银" --> "银子"
sister_N = mkN "妹妹" ; sister_N = mkN "妹妹" ;
sock_N = mkN "袜子" "只"; sock_N = mkN "袜子" "只";
steel_N = mkN "钢" "块"; steel_N = mkN "钢" "块";
stove_N = mkN "炉子" ; stove_N = mkN "炉子" ;
village_N = mkN "村庄" "座"; village_N = mkN "村庄" "座";
war_N = mkN "战争" "场" ; -- [mark] rewritten war_N = mkN "战争" "场" ; -- [mark] rewritten
@@ -353,29 +353,27 @@ wood_N = mkN "木头" "块" ; -- [mark] "木" --> "木头"
-- from scratch, by Jolene -- from scratch, by Jolene
lin lin
alas_Interj = ssword "唉" ; alas_Interj = ssword "唉" ;
beg_V2V = mkV2V (mkV "乞求") ; -- beg him to do something beg_V2V = mkV2V (mkV "乞求") ; -- beg him to do something
break_V2 = mkV2 "打破" ; break_V2 = mkV2 "打破" ;
broad_A = mkA "宽" ; broad_A = mkA "宽" ;
brown_A = mkA "棕" ; brown_A = colourA "棕" ;
clever_A = mkA "聪明" ; clever_A = mkA "聪明" ;
close_V2 = mkV2 "关闭" ; close_V2 = mkV2 "关闭" ;
easy_A2V = mkA2 "简单" ; easy_A2V = mkA2 "简单" ;
empty_A = mkA "空" ; empty_A = mkA "空" ;
fun_AV = mkA "有趣" ; fun_AV = mkA "有趣" ;
hate_V2 = mkV2 "讨厌" ; hate_V2 = mkV2 "讨厌" ;
married_A2 = mkA2 "结婚" ; married_A2 = mkA2 "结婚" ;
paris_PN = mkPN "巴黎" ; paris_PN = mkPN "巴黎" ;
probable_AS = mkA "可能" ; probable_AS = mkA "可能" ;
ready_A = mkA "准备好" ; -- [mark] "准备好": 准备(v) + 好(adj,complement) ready_A = mkA "准备好" ; -- [mark] "准备好": 准备(v) + 好(adj,complement)
seek_V2 = mkV2 "寻求" ; seek_V2 = mkV2 "寻求" ;
stop_V = mkV "停止" ; stop_V = mkV "停止" ;
stupid_A = mkA "笨" ; stupid_A = mkA "笨" ;
switch8off_V2 = mkV2 "关" ; switch8off_V2 = mkV2 "关" ;
switch8on_V2 = mkV2 "开" ; switch8on_V2 = mkV2 "开" ;
ugly_A = mkA "丑" ; ugly_A = mkA "丑" ;
uncertain_A = mkA "不确定" ; -- [mark] "不确定": 不("un-") + 确定("certain") uncertain_A = mkA "不确定" ; -- [mark] "不确定": 不("un-") + 确定("certain")
}
}

View File

@@ -28,7 +28,7 @@ concrete NounChi of Noun = CatChi ** open ResChi, Prelude in {
NTFull => quant.pl ++ num.s ; -- to avoid yi in indef NTFull => quant.pl ++ num.s ; -- to avoid yi in indef
NTVoid Pl => quant.pl ++ num.s ; NTVoid Pl => quant.pl ++ num.s ;
_ => quant.s ++ num.s _ => quant.s ++ num.s
} ; } ;
detType = case num.numType of { detType = case num.numType of {
NTFull => DTNum ; -- five NTFull => DTNum ; -- five
NTVoid n => case quant.detType of { NTVoid n => case quant.detType of {
@@ -63,8 +63,8 @@ concrete NounChi of Noun = CatChi ** open ResChi, Prelude in {
AdNum adn num = {s = adn.s ++ num.s ; hasC = True} ; AdNum adn num = {s = adn.s ++ num.s ; hasC = True} ;
OrdSuperl a = {s = superlative_s ++ a.s} ; OrdSuperl a = {s = superlative_s ++ a.s ! Attr} ;
OrdNumeralSuperl n a = {s = ordinal_s ++ n.s ++ superlative_s ++ a.s} ; ---- to check AR 24/8/2014 OrdNumeralSuperl n a = {s = ordinal_s ++ n.s ++ superlative_s ++ a.s ! Attr} ; ---- to check AR 24/8/2014
DefArt = mkQuant [] [] DTPoss ; -- use that_Quant if you want the_s DefArt = mkQuant [] [] DTPoss ; -- use that_Quant if you want the_s
IndefArt = mkQuant yi_s [] DTNum ; -- (DTFull Sg) ; -- empty in the plural IndefArt = mkQuant yi_s [] DTNum ; -- (DTFull Sg) ; -- empty in the plural
@@ -80,8 +80,8 @@ concrete NounChi of Noun = CatChi ** open ResChi, Prelude in {
ComplN3 f x = {s = appPrep f.c2 x.s ++ f.s ; c = f.c ; c2 = f.c3} ; ComplN3 f x = {s = appPrep f.c2 x.s ++ f.s ; c = f.c ; c2 = f.c3} ;
AdjCN ap cn = case ap.monoSyl of { AdjCN ap cn = case ap.monoSyl of {
True => {s = ap.s ++ cn.s ; c = cn.c} ; True => {s = ap.s ! Attr ++ cn.s ; c = cn.c} ;
False => {s = ap.s ++ possessive_s ++ cn.s ; c = cn.c} False => {s = ap.s ! Attr ++ possessive_s ++ cn.s ; c = cn.c}
} ; } ;
RelCN cn rs = {s = rs.s ++ cn.s ; c = cn.c} ; RelCN cn rs = {s = rs.s ++ cn.s ; c = cn.c} ;

View File

@@ -5,11 +5,11 @@ flags coding = utf8 ;
flags coding=utf8; flags coding=utf8;
oper oper
mkN = overload { mkN = overload {
mkN : (man : Str) -> N mkN : (man : Str) -> N
= \n -> lin N (regNoun n ge_s) ; = \n -> lin N (regNoun n ge_s) ;
mkN : (man : Str) -> Str -> N mkN : (man : Str) -> Str -> N
= \n,c -> lin N (regNoun n c) = \n,c -> lin N (regNoun n c)
} ; } ;
mkN2 = overload { mkN2 = overload {
mkN2 : Str -> N2 mkN2 : Str -> N2
@@ -21,7 +21,7 @@ oper
mkN3 : N -> Prep -> Prep -> N3 mkN3 : N -> Prep -> Prep -> N3
= \n,p,q -> lin N3 (n ** {c2 = p ; c3 = q}) ; = \n,p,q -> lin N3 (n ** {c2 = p ; c3 = q}) ;
mkPN : (john : Str) -> PN mkPN : (john : Str) -> PN
= \s -> lin PN {s = word s} ; -- normal name, in Chinese characters = \s -> lin PN {s = word s} ; -- normal name, in Chinese characters
@@ -29,11 +29,14 @@ oper
= \s -> lin PN {s = s} ; -- foreign name, in Latin or other non-Chinese characters = \s -> lin PN {s = s} ; -- foreign name, in Latin or other non-Chinese characters
mkA = overload { mkA = overload {
mkA : (small : Str) -> A mkA : (small : Str) -> A
= \a -> lin A (simpleAdj a) ; = \a -> lin A (simpleAdj a) ;
mkA : (small : Str) -> Bool -> A mkA : (small : Str) -> Bool -> A
= \a,b -> lin A (mkAdj a b) ; = \a,b -> lin A (mkAdj a b) ;
} ; } ;
colourA : Str -> A ; -- colour Adjectives have a "色" when used as predicative
colourA colour = lin A (colourAdj colour);
mkA2 = overload { mkA2 = overload {
mkA2 : Str -> A2 mkA2 : Str -> A2
@@ -43,32 +46,32 @@ oper
mkA2 : A -> Prep -> A2 mkA2 : A -> Prep -> A2
= \a,p -> lin A2 (a ** {c2 = p}) ; = \a,p -> lin A2 (a ** {c2 = p}) ;
} ; } ;
mkV = overload { mkV = overload {
mkV : (walk : Str) -> V mkV : (walk : Str) -> V
= \walk -> case walk of { = \walk -> case walk of {
v + "+" + p => lin V (regVerb (v + p)) ; v + "+" + p => lin V (regVerb (v + p)) ;
_ => lin V (regVerb walk) _ => lin V (regVerb walk)
} ; } ;
mkV : (walk,out : Str) -> V mkV : (walk,out : Str) -> V
= \v,p -> lin V (regVerb (v + p)) ; ---- = \v,p -> lin V (regVerb (v + p)) ; ----
mkV : (arrive : Str) -> Str -> Str -> Str -> Str -> V mkV : (arrive : Str) -> Str -> Str -> Str -> Str -> V
= \arrive,pp,ds,dp,ep -> lin V (mkVerb arrive pp ds dp ep neg_s) ; = \arrive,pp,ds,dp,ep -> lin V (mkVerb arrive pp ds dp ep neg_s) ;
mkV : (arrive : Str) -> Str -> Str -> Str -> Str -> Str -> V mkV : (arrive : Str) -> Str -> Str -> Str -> Str -> Str -> V
= \arrive,pp,ds,dp,ep,neg -> lin V (mkVerb arrive pp ds dp ep neg) ; = \arrive,pp,ds,dp,ep,neg -> lin V (mkVerb arrive pp ds dp ep neg) ;
} ; } ;
mkV2 = overload { mkV2 = overload {
mkV2 : Str -> V2 mkV2 : Str -> V2
= \s -> case s of { = \s -> case s of {
v + "+" + p => lin V2 (regVerb v ** {c2 = emptyPrep ; hasPrep = False ; part = word p}) ; v + "+" + p => lin V2 (regVerb v ** {c2 = emptyPrep ; hasPrep = False ; part = word p}) ;
v + "*" + p => lin V2 (regVerb v ** v + "*" + p => lin V2 (regVerb v **
{c2 = ResChi.mkPreposition p [] (getAdvType p) ; hasPrep = True ; part = []}) ; {c2 = ResChi.mkPreposition p [] (getAdvType p) ; hasPrep = True ; part = []}) ;
_ => lin V2 (regVerb s ** {c2 = emptyPrep ; hasPrep = False ; part = []}) _ => lin V2 (regVerb s ** {c2 = emptyPrep ; hasPrep = False ; part = []})
} ; } ;
mkV2 : V -> V2 mkV2 : V -> V2
= \v -> lin V2 (v ** {c2 = emptyPrep ; hasPrep = False ; part = []}) ; = \v -> lin V2 (v ** {c2 = emptyPrep ; hasPrep = False ; part = []}) ;
mkV2 : V -> Prep -> V2 mkV2 : V -> Prep -> V2
= \v,p -> lin V2 (v ** {c2 = p ; hasPrep = True ; part = []}) ; = \v,p -> lin V2 (v ** {c2 = p ; hasPrep = True ; part = []}) ;
} ; } ;
@@ -110,47 +113,47 @@ oper
mkV2Q = overload { mkV2Q = overload {
mkV2Q : V -> V2Q = mkV2Q : V -> V2Q =
\v -> lin V2Q (v ** {c2 = emptyPrep ; hasPrep = False ; part = []}) ; \v -> lin V2Q (v ** {c2 = emptyPrep ; hasPrep = False ; part = []}) ;
mkV2Q : Str -> V2Q = mkV2Q : Str -> V2Q =
\v -> lin V2Q (regVerb v ** {c2 = emptyPrep ; hasPrep = False ; part = []}) ; \v -> lin V2Q (regVerb v ** {c2 = emptyPrep ; hasPrep = False ; part = []}) ;
} ; } ;
mkV2V= overload { mkV2V= overload {
mkV2V : Str -> V2V = mkV2V : Str -> V2V =
\s -> lin V2V (regVerb s ** {c2 = emptyPrep ; c3 = emptyPrep ; hasPrep = False ; part = []}) ; \s -> lin V2V (regVerb s ** {c2 = emptyPrep ; c3 = emptyPrep ; hasPrep = False ; part = []}) ;
mkV2V : V -> V2V = mkV2V : V -> V2V =
\v -> lin V2V (v ** {c2 = emptyPrep ; c3 = emptyPrep ; hasPrep = False ; part = []}) ; \v -> lin V2V (v ** {c2 = emptyPrep ; c3 = emptyPrep ; hasPrep = False ; part = []}) ;
---- mkV2V : V -> Str -> Str -> V2V = ---- mkV2V : V -> Str -> Str -> V2V =
---- \v,p,q -> lin V2V (v ** {c2 = mkPrep p ; c3 = mkPrep q}) ; ---- \v,p,q -> lin V2V (v ** {c2 = mkPrep p ; c3 = mkPrep q}) ;
} ; } ;
mkV2S = overload { mkV2S = overload {
mkV2S : Str -> V2S = mkV2S : Str -> V2S =
\s -> lin V2S (regVerb s ** {c2 = emptyPrep ; hasPrep = False ; part = []}) ; \s -> lin V2S (regVerb s ** {c2 = emptyPrep ; hasPrep = False ; part = []}) ;
mkV2S : V -> V2S = mkV2S : V -> V2S =
\v -> lin V2S (v ** {c2 = emptyPrep ; hasPrep = False ; part = []}) ; \v -> lin V2S (v ** {c2 = emptyPrep ; hasPrep = False ; part = []}) ;
---- mkV2S : V -> Str -> V2S = ---- mkV2S : V -> Str -> V2S =
---- \v,p -> lin V2S (v ** {c2 = mkPrep p}) ; ---- \v,p -> lin V2S (v ** {c2 = mkPrep p}) ;
} ; } ;
mkV2A = overload { mkV2A = overload {
mkV2A : Str -> V2A mkV2A : Str -> V2A
= \s -> lin V2A (regVerb s ** {c2 = emptyPrep ; c3 = emptyPrep ; hasPrep = False ; part = []}) ; = \s -> lin V2A (regVerb s ** {c2 = emptyPrep ; c3 = emptyPrep ; hasPrep = False ; part = []}) ;
mkV2A : V -> V2A mkV2A : V -> V2A
= \v -> lin V2A (v ** {c2 = emptyPrep ; c3 = emptyPrep ; hasPrep = False ; part = []}) ; = \v -> lin V2A (v ** {c2 = emptyPrep ; c3 = emptyPrep ; hasPrep = False ; part = []}) ;
} ; } ;
---- mkV2A : V -> Str -> Str -> V2A ---- mkV2A : V -> Str -> Str -> V2A
---- = \v,p,q -> lin V2A (v ** {c2 = mkPrep p ; c3 = mkPrep q}) ; ---- = \v,p,q -> lin V2A (v ** {c2 = mkPrep p ; c3 = mkPrep q}) ;
mkAdv = overload { mkAdv = overload {
mkAdv : Str -> Adv mkAdv : Str -> Adv
= \s -> let at = getAdvType s in lin Adv {s = word s ; advType = at ; hasDe = advTypeHasDe at} ; = \s -> let at = getAdvType s in lin Adv {s = word s ; advType = at ; hasDe = advTypeHasDe at} ;
mkAdv : Str -> Str -> Adv mkAdv : Str -> Str -> Adv
= \s,t -> let at = getAdvType s in lin Adv {s = word (s + t) ; advType = at ; hasDe = advTypeHasDe at} ; ---- = \s,t -> let at = getAdvType s in lin Adv {s = word (s + t) ; advType = at ; hasDe = advTypeHasDe at} ; ----
mkAdv : Str -> AdvType -> Adv mkAdv : Str -> AdvType -> Adv
= \s,at -> lin Adv {s = word s ; advType = at ; hasDe = advTypeHasDe at} ; = \s,at -> lin Adv {s = word s ; advType = at ; hasDe = advTypeHasDe at} ;
mkAdv : Adv -> AdvType -> Adv -- To fix the AdvType in an Adv produced by SyntaxChi.mkAdv mkAdv : Adv -> AdvType -> Adv -- To fix the AdvType in an Adv produced by SyntaxChi.mkAdv
= \adv,at -> adv ** {advType = at ; hasDe = advTypeHasDe at} ; = \adv,at -> adv ** {advType = at ; hasDe = advTypeHasDe at} ;
} ; } ;
@@ -165,50 +168,50 @@ oper
= ATTime ; = ATTime ;
mannerAdvType : AdvType mannerAdvType : AdvType
= ATManner ; = ATManner ;
mkPrep = overload { -- first pre part, then optional post part mkPrep = overload { -- first pre part, then optional post part
mkPrep : Str -> Prep mkPrep : Str -> Prep
= \s -> lin Prep (ResChi.mkPreposition s [] (getAdvType s)) ; = \s -> lin Prep (ResChi.mkPreposition s [] (getAdvType s)) ;
mkPrep : Str -> Str -> Prep mkPrep : Str -> Str -> Prep
= \s,t -> lin Prep (ResChi.mkPreposition s t (getAdvType s)) ; = \s,t -> lin Prep (ResChi.mkPreposition s t (getAdvType s)) ;
mkPrep : Str -> Str -> AdvType -> Prep mkPrep : Str -> Str -> AdvType -> Prep
= \s,t,a -> lin Prep (ResChi.mkPreposition s t a) ; = \s,t,a -> lin Prep (ResChi.mkPreposition s t a) ;
} ; } ;
mkInterj : Str -> Interj mkInterj : Str -> Interj
= \s -> lin Interj {s = word s} ; = \s -> lin Interj {s = word s} ;
emptyPrep : Preposition = mkPrep [] ; emptyPrep : Preposition = mkPrep [] ;
mkpNP : Str -> CatChi.NP mkpNP : Str -> CatChi.NP
= \s -> lin NP {s = word s} ; = \s -> lin NP {s = word s} ;
mkAdV : Str -> AdV mkAdV : Str -> AdV
= \s -> lin AdV {s = word s} ; = \s -> lin AdV {s = word s} ;
mkAdN : Str -> AdN mkAdN : Str -> AdN
= \s -> lin AdN {s = word s} ; = \s -> lin AdN {s = word s} ;
mkSubj : Str -> Subj mkSubj : Str -> Subj
= \s -> lin Subj (ResChi.mkSubj s []) ; = \s -> lin Subj (ResChi.mkSubj s []) ;
mkConj = overload { mkConj = overload {
mkConj : Str -> Conj mkConj : Str -> Conj
= \s -> lin Conj {s = \\_ => mkConjForm s} ; = \s -> lin Conj {s = \\_ => mkConjForm s} ;
mkConj : (both,and : Str) -> Conj mkConj : (both,and : Str) -> Conj
= \s,t -> lin Conj {s = \\_ => mkConjForm2 s t} ; = \s,t -> lin Conj {s = \\_ => mkConjForm2 s t} ;
} ; } ;
mkpDet : Str -> Det mkpDet : Str -> Det
= \s -> lin Det {s = word s ; detType = DTFull Sg} ; = \s -> lin Det {s = word s ; detType = DTFull Sg} ;
mkQuant : Str -> Quant mkQuant : Str -> Quant
= \s -> lin Quant {s,pl = word s ; detType = DTFull Sg} ; = \s -> lin Quant {s,pl = word s ; detType = DTFull Sg} ;
mkAdA : Str -> AdA mkAdA : Str -> AdA
= \s -> lin AdA {s = word s} ; = \s -> lin AdA {s = word s} ;
mkNum : Str -> Num mkNum : Str -> Num
= \s -> lin Num {s = word s ; numType = NTFull} ; = \s -> lin Num {s = word s ; numType = NTFull} ;
mkPredet : Str -> Predet mkPredet : Str -> Predet
= \s -> lin Predet {s = word s} ; = \s -> lin Predet {s = word s} ;
mkIDet : Str -> IDet mkIDet : Str -> IDet
= \s -> lin IDet {s = word s ; detType = DTNum} ; ---- = \s -> lin IDet {s = word s ; detType = DTNum} ; ----
mkPConj : Str -> PConj mkPConj : Str -> PConj
= \s -> lin PConj {s = word s} ; = \s -> lin PConj {s = word s} ;
mkRP : Str -> RP mkRP : Str -> RP
= \s -> lin RP {s = table {True => [] ; False => word s}} ; = \s -> lin RP {s = table {True => [] ; False => word s}} ;

View File

@@ -13,7 +13,7 @@ concrete PhraseChi of Phrase = CatChi ** open Prelude, ResChi in {
UttIAdv iadv = iadv ; UttIAdv iadv = iadv ;
UttNP np = np ; UttNP np = np ;
UttCN cn = cn ; UttCN cn = cn ;
UttAP ap = ap ; UttAP ap = {s = ap.s!Attr} ;
UttCard x = x ; UttCard x = x ;
UttVP vp = ss (infVP vp) ; UttVP vp = ss (infVP vp) ;
UttAdv adv = adv ; UttAdv adv = adv ;

View File

@@ -99,7 +99,6 @@ param
AdjPlace = Attr | Pred ; -- a green cat / the cat is green colour AdjPlace = Attr | Pred ; -- a green cat / the cat is green colour
-- parts of speech -- parts of speech
oper oper
VP = { VP = {
@@ -134,6 +133,16 @@ oper
_ => mkAdj s False _ => mkAdj s False
} ; } ;
colourAdj : Str -> Adj = \s -> {
s = table {
Attr => word s ;
Pred => word s ++ "色"
};
monoSyl = case s of {
? => True ;
_ => False }
};
copula : Verb = mkVerb "是" [] [] [] [] "不" ; copula : Verb = mkVerb "是" [] [] [] [] "不" ;
hen_copula : Verb = hen_copula : Verb =
{s = hen_s ; sn = [] ; pp = [] ; ds = [] ; dp = [] ; ep = [] ; neg = "不"} ; --- {s = hen_s ; sn = [] ; pp = [] ; ds = [] ; dp = [] ; ep = [] ; neg = "不"} ; ---

View File

@@ -7,14 +7,14 @@ concrete VerbChi of Verb = CatChi ** open ResChi, Prelude in {
SlashV2a v = predV v v.part ** {c2 = v.c2 ; isPre = v.hasPrep} ; SlashV2a v = predV v v.part ** {c2 = v.c2 ; isPre = v.hasPrep} ;
Slash2V3 v np = insertAdv (mkNP (ba_s ++ np.s)) (predV v v.part) ** {c2 = v.c3 ; isPre = v.hasPrep} ; -- slot for third argument Slash2V3 v np = insertAdv (mkNP (ba_s ++ np.s)) (predV v v.part) ** {c2 = v.c3 ; isPre = v.hasPrep} ; -- slot for third argument
Slash3V3 v np = insertObj (mkNP (appPrep v.c3 np.s)) (predV v v.part) ** {c2 = v.c2 ; isPre = True} ; -- slot for ba object Slash3V3 v np = insertObj (mkNP (appPrep v.c3 np.s)) (predV v v.part) ** {c2 = v.c2 ; isPre = True} ; -- slot for ba object
SlashV2A v ap = insertObj ap (predV v v.part) ** {c2 = v.c2 ; isPre = v.hasPrep} ; SlashV2A v ap = insertObj {s = ap.s ! Pred} (predV v v.part) ** {c2 = v.c2 ; isPre = v.hasPrep} ;
SlashV2V v vp = insertObj (mkNP (infVP vp)) (predV v v.part) ** {c2 = v.c2 ; isPre = v.hasPrep} ; SlashV2V v vp = insertObj (mkNP (infVP vp)) (predV v v.part) ** {c2 = v.c2 ; isPre = v.hasPrep} ;
SlashV2S v s = insertObj (ss (say_s ++ s.s)) (predV v v.part) ** {c2 = v.c2 ; isPre = v.hasPrep} ; SlashV2S v s = insertObj (ss (say_s ++ s.s)) (predV v v.part) ** {c2 = v.c2 ; isPre = v.hasPrep} ;
SlashV2Q v q = insertObj (ss (say_s ++ q.s ! False)) (predV v v.part) ** {c2 = v.c2 ; isPre = v.hasPrep} ; SlashV2Q v q = insertObj (ss (say_s ++ q.s ! False)) (predV v v.part) ** {c2 = v.c2 ; isPre = v.hasPrep} ;
ComplVV v vp = { ComplVV v vp = {
verb = v ; verb = v ;
@@ -23,9 +23,9 @@ concrete VerbChi of Verb = CatChi ** open ResChi, Prelude in {
isAdj = False ; isAdj = False ;
} ; } ;
ComplVS v s = insertObj s (predV v []) ; ComplVS v s = insertObj s (predV v []) ;
ComplVQ v q = insertObj (ss (q.s ! False)) (predV v []) ; ComplVQ v q = insertObj (ss (q.s ! False)) (predV v []) ;
ComplVA v ap = insertObj ap (predV v []) ; ComplVA v ap = insertObj {s = ap.s ! Pred} (predV v []) ;
ComplSlash vp np = case vp.isPre of { ComplSlash vp np = case vp.isPre of {
--- True => insertAdv (mkNP (ba_s ++ np.s)) vp ; --- ba or vp.c2 ? --- True => insertAdv (mkNP (ba_s ++ np.s)) vp ; --- ba or vp.c2 ?
@@ -39,7 +39,7 @@ concrete VerbChi of Verb = CatChi ** open ResChi, Prelude in {
SlashVV v vp = ---- too simple? SlashVV v vp = ---- too simple?
insertObj (mkNP (infVP vp)) (predV v []) ** {c2 = vp.c2 ; isPre = vp.isPre} ; insertObj (mkNP (infVP vp)) (predV v []) ** {c2 = vp.c2 ; isPre = vp.isPre} ;
SlashV2VNP v np vp = SlashV2VNP v np vp =
insertObj np insertObj np
(insertObj (mkNP (infVP vp)) (predV v v.part)) ** {c2 = vp.c2 ; isPre = vp.isPre} ; (insertObj (mkNP (infVP vp)) (predV v v.part)) ** {c2 = vp.c2 ; isPre = vp.isPre} ;
@@ -56,19 +56,19 @@ concrete VerbChi of Verb = CatChi ** open ResChi, Prelude in {
ATTime | ATPoss => insertTopic adv vp -- *today* he here sleeps ATTime | ATPoss => insertTopic adv vp -- *today* he here sleeps
} ; } ;
AdVVP adv vp = insertAdv adv vp ; AdVVP adv vp = insertAdv adv vp ;
ReflVP vp = insertObj (mkNP reflPron) vp ; ReflVP vp = insertObj (mkNP reflPron) vp ;
PassV2 v = insertAdv (mkNP passive_s) (predV v v.part) ; ---- PassV2 v = insertAdv (mkNP passive_s) (predV v v.part) ; ----
CompAP ap = insertObj (mkNP (ap.s ++ de_s)) (predV copula []) ** {isAdj = True} ; CompAP ap = insertObj (mkNP (ap.s ! Pred ++ de_s)) (predV copula []) ** {isAdj = True} ;
{- {-
CompAP ap = case ap.hasAdA of { CompAP ap = case ap.hasAdA of {
True => insertObj (mkNP ap.s) (predV nocopula []) ; True => insertObj (mkNP ap.s) (predV nocopula []) ;
False => insertObj (mkNP (ap.s ++ de_s)) (predV copula []) False => insertObj (mkNP (ap.s ++ de_s)) (predV copula [])
} ; } ;
-} -}
CompNP np = insertObj np (predV copula []) ; ---- CompNP np = insertObj np (predV copula []) ; ----