1
0
forked from GitHub/gf-core

Hindi and Thai compile in 1.5

This commit is contained in:
aarne
2008-12-18 14:21:28 +00:00
parent 031909c8c7
commit 994aa43bd0
48 changed files with 5121 additions and 0 deletions

View File

@@ -0,0 +1,36 @@
concrete AdjectiveHin of Adjective = CatHin ** open ResHin, Prelude in {
lin
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 ;
--
}

View File

@@ -0,0 +1,20 @@
concrete AdverbHin of Adverb = CatHin ** open ResHin, Prelude in {
--
-- lin
-- PositAdvAdj a = {s = a.s ! AAdv} ;
-- 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 ;
--
-- AdnCAdv cadv = {s = cadv.s ++ "than"} ;
--
}

View File

@@ -0,0 +1,3 @@
--# -path=.:../abstract:../common:prelude
concrete AllHin of AllHinAbs = LangHin ;

View File

@@ -0,0 +1 @@
abstract AllHinAbs = Lang ;

View File

@@ -0,0 +1,76 @@
--concrete BackwardHin of Backward = CatHin ** open ResHin in {
--
-- flags optimize=all_subs ;
--
-- lin
--
---- A repository of obsolete constructs, needed for backward compatibility.
---- They create spurious ambiguities if used in combination with Lang.
--
---- from Verb 19/4/2008
--
-- ComplV2 v np = insertObj (\\_ => v.c2 ++ np.s ! Acc) (predV v) ;
-- ComplV3 v np np2 =
-- insertObj (\\_ => v.c2 ++ np.s ! Acc ++ v.c3 ++ np2.s ! Acc) (predV v) ;
-- ComplV2V v np vp =
-- insertObj (\\a => infVP v.isAux vp a)
-- (insertObj (\\_ => v.c2 ++ np.s ! Acc) (predV v)) ;
-- ComplV2S v np s =
-- insertObj (\\_ => conjThat ++ s.s)
-- (insertObj (\\_ => v.c2 ++ np.s ! Acc) (predV v)) ;
-- ComplV2Q v np q =
-- insertObj (\\_ => q.s ! QIndir)
-- (insertObj (\\_ => v.c2 ++ np.s ! Acc) (predV v)) ;
-- ComplV2A v np ap =
-- insertObj (\\_ => v.c2 ++ np.s ! Acc ++ ap.s ! np.a) (predV v) ;
--
-- ReflV2 v = insertObj (\\a => v.c2 ++ reflPron ! a) (predV v) ;
--
---- from Sentence 19/4/2008
--
-- 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} ;
--
---- from Noun 19/4/2008
--
-- NumInt n = {s = n.s ; n = Pl} ;
-- OrdInt n = {s = n.s ++ "th"} ; --- DEPRECATED
--
-- DetSg quant ord = {
-- s = quant.s ! Sg ++ ord.s ;
-- n = Sg
-- } ;
--
-- DetPl quant num ord = {
-- s = quant.s ! num.n ++ num.s ++ ord.s ;
-- n = num.n
-- } ;
--
-- NoNum = {s = []; n = Pl } ;
--
-- DefArt = {s = \\_ => artDef} ;
--
-- IndefArt = {
-- s = table {
-- Sg => artIndef ;
-- Pl => []
-- }
-- } ;
--
-- MassDet = {s = \\_ => []} ;
--
--
--
---- from Structural 19/4/2008
--
-- that_NP = regNP "that" Sg ;
-- these_NP = regNP "these" Pl ;
-- this_NP = regNP "this" Sg ;
-- those_NP = regNP "those" Pl ;
--
--}

View File

@@ -0,0 +1,90 @@
concrete CatHin of Cat = CommonX ** open ResHin, Prelude in {
flags optimize=all_subs ;
lincat
--
---- Tensed/Untensed
--
-- S = {s : Str} ;
-- QS = {s : QForm => Str} ;
-- RS = {s : Agr => Str ; c : Case} ; -- c for it clefts
-- SSlash = {s : Str ; c2 : Str} ;
--
---- Sentence
--
Cl = ResHin.Clause ;
-- ClSlash = {
-- s : ResHin.Tense => Anteriority => CPolarity => Order => Str ;
-- c2 : Str
-- } ;
-- Imp = {s : CPolarity => ImpForm => Str} ;
--
---- Question
--
-- QCl = {s : ResHin.Tense => Anteriority => CPolarity => QForm => Str} ;
-- IP = {s : Case => Str ; n : Number} ;
-- IComp = {s : Str} ;
-- IDet = {s : Str ; n : Number} ;
-- IQuant = {s : Number => Str} ;
--
---- Relative
--
-- RCl = {
-- s : ResHin.Tense => Anteriority => CPolarity => Agr => Str ;
-- c : Case
-- } ;
-- RP = {s : RCase => Str ; a : RAgr} ;
--
---- Verb
--
VP = ResHin.VPH ;
VPSlash = ResHin.VPHSlash ;
-- Comp = {s : Agr => Str} ;
--
---- Adjective
--
AP = ResHin.Adjective ;
--
---- Noun
--
CN = ResHin.Noun ;
NP = ResHin.NP ;
Pron = {s : PronCase => Str ; a : Agr} ;
Det = {s : Gender => Case => Str ; n : Number} ;
-- Predet, Ord = {s : Str} ;
Num = {s : Str ; n : Number} ;
-- Card = {s : Str; n : Number} ;
Quant = {s : Number => Gender => Case => Str} ;
Art = {s : Str} ;
--
---- Numeral
--
-- Numeral = {s : CardOrd => Str ; n : Number} ;
-- Digits = {s : CardOrd => Str ; n : Number ; tail : DTail} ;
--
---- Structural
--
-- Conj = {s1,s2 : Str ; n : Number} ;
-----b Conj = {s : Str ; n : Number} ;
-----b DConj = {s1,s2 : Str ; n : Number} ;
-- Subj = {s : Str} ;
-- Prep = {s : Str} ;
--
---- Open lexical classes, e.g. Lexicon
--
V, VS, VQ, VA = Verb ; -- = {s : VForm => Str} ;
V2, V2A, V2Q, V2S = Verb ** {c2 : Compl} ;
-- V3 = Verb ** {c2, c3 : Str} ;
-- VV = {s : VVForm => Str ; isAux : Bool} ;
-- V2V = Verb ** {c2 : Str ; isAux : Bool} ;
--
A = ResHin.Adjective ; --- {s : Gender => Number => Case => Str} ;
-- A2 = {s : AForm => Str ; c2 : Str} ;
--
N = {s : Number => Case => Str ; g : Gender} ;
-- N2 = {s : Number => Case => Str ; g : Gender} ** {c2 : Str} ;
-- N3 = {s : Number => Case => Str ; g : Gender} ** {c2,c3 : Str} ;
PN = {s : Case => Str ; g : Gender} ;
--
}

View File

@@ -0,0 +1,37 @@
concrete ConjunctionHin of Conjunction =
CatHin ** open ResHin, Coordination, Prelude in {
--
-- flags optimize=all_subs ;
--
-- lin
--
-- ConjS = conjunctDistrSS ;
--
-- ConjAdv = conjunctDistrSS ;
--
-- ConjNP conj ss = conjunctDistrTable Case conj ss ** {
-- a = conjAgr (agrP3 conj.n) ss.a
-- } ;
--
-- ConjAP 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} ;
--
}

View File

@@ -0,0 +1,21 @@
--# -path=.:../abstract:../common:prelude
concrete GrammarHin of Grammar =
NounHin,
VerbHin,
AdjectiveHin,
AdverbHin,
NumeralHin,
SentenceHin,
QuestionHin,
RelativeHin,
ConjunctionHin,
PhraseHin,
TextX,
StructuralHin,
IdiomHin
** {
flags startcat = Phr ; unlexer = text ; lexer = text ;
}

View File

@@ -0,0 +1,30 @@
concrete IdiomHin of Idiom = CatHin ** open Prelude, ResHin 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 (\\_ => optStr conjThat ++ s.s)
-- (insertObj (\\_ => ad.s) (predAux auxBe))) ;
--
-- ExistNP np =
-- mkClause "there" (agrP3 (fromAgr 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 (AgP1 Pl)} ;
--
}

View File

@@ -0,0 +1,181 @@
----# -path=.:prelude:../abstract:../common
--
--concrete IrregHin of IrregHinAbs = CatHin ** open ParadigmsHin in {
--
--flags optimize=values ;
--
-- lin
-- awake_V = irregV "awake" "awoke" "awoken" ;
-- bear_V = irregV "bear" "bore" "born" ;
-- beat_V = irregV "beat" "beat" "beat" ;
-- become_V = irregV "become" "became" "become" ;
-- begin_V = irregV "begin" "began" "begun" ;
-- bend_V = irregV "bend" "bent" "bent" ;
-- beset_V = irregV "beset" "beset" "beset" ;
-- bet_V = irregDuplV "bet" "bet" "bet" ;
-- bid_V = irregDuplV "bid" (variants {"bid" ; "bade"}) (variants {"bid" ; "bidden"}) ;
-- bind_V = irregV "bind" "bound" "bound" ;
-- bite_V = irregV "bite" "bit" "bitten" ;
-- bleed_V = irregV "bleed" "bled" "bled" ;
-- blow_V = irregV "blow" "blew" "blown" ;
-- break_V = irregV "break" "broke" "broken" ;
-- breed_V = irregV "breed" "bred" "bred" ;
-- bring_V = irregV "bring" "brought" "brought" ;
-- broadcast_V = irregV "broadcast" "broadcast" "broadcast" ;
-- build_V = irregV "build" "built" "built" ;
-- burn_V = irregV "burn" (variants {"burned" ; "burnt"}) (variants {"burned" ; "burnt"}) ;
-- burst_V = irregV "burst" "burst" "burst" ;
-- buy_V = irregV "buy" "bought" "bought" ;
-- cast_V = irregV "cast" "cast" "cast" ;
-- catch_V = irregV "catch" "caught" "caught" ;
-- choose_V = irregV "choose" "chose" "chosen" ;
-- cling_V = irregV "cling" "clung" "clung" ;
-- come_V = irregV "come" "came" "come" ;
-- cost_V = irregV "cost" "cost" "cost" ;
-- creep_V = irregV "creep" "crept" "crept" ;
-- cut_V = irregDuplV "cut" "cut" "cut" ;
-- deal_V = irregV "deal" "dealt" "dealt" ;
-- dig_V = irregDuplV "dig" "dug" "dug" ;
-- dive_V = irregV "dive" (variants {"dived" ; "dove"}) "dived" ;
-- do_V = mk5V "do" "does" "did" "done" "doing" ;
-- draw_V = irregV "draw" "drew" "drawn" ;
-- dream_V = irregV "dream" (variants {"dreamed" ; "dreamt"}) (variants {"dreamed" ; "dreamt"}) ;
-- drive_V = irregV "drive" "drove" "driven" ;
-- drink_V = irregV "drink" "drank" "drunk" ;
-- eat_V = irregV "eat" "ate" "eaten" ;
-- fall_V = irregV "fall" "fell" "fallen" ;
-- feed_V = irregV "feed" "fed" "fed" ;
-- feel_V = irregV "feel" "felt" "felt" ;
-- fight_V = irregV "fight" "fought" "fought" ;
-- find_V = irregV "find" "found" "found" ;
-- fit_V = irregDuplV "fit" "fit" "fit" ;
-- flee_V = irregV "flee" "fled" "fled" ;
-- fling_V = irregV "fling" "flung" "flung" ;
-- fly_V = irregV "fly" "flew" "flown" ;
-- forbid_V = irregDuplV "forbid" "forbade" "forbidden" ;
-- forget_V = irregDuplV "forget" "forgot" "forgotten" ;
-- forgive_V = irregV "forgive" "forgave" "forgiven" ;
-- forsake_V = irregV "forsake" "forsook" "forsaken" ;
-- freeze_V = irregV "freeze" "froze" "frozen" ;
-- get_V = irregDuplV "get" "got" "gotten" ;
-- give_V = irregV "give" "gave" "given" ;
-- go_V = mk5V "go" "goes" "went" "gone" "going" ;
-- grind_V = irregV "grind" "ground" "ground" ;
-- grow_V = irregV "grow" "grew" "grown" ;
-- hang_V = irregV "hang" "hung" "hung" ;
-- have_V = mk5V "have" "has" "had" "had" "having" ;
-- hear_V = irregV "hear" "heard" "heard" ;
-- hide_V = irregV "hide" "hid" "hidden" ;
-- hit_V = irregDuplV "hit" "hit" "hit" ;
-- hold_V = irregV "hold" "held" "held" ;
-- hurt_V = irregV "hurt" "hurt" "hurt" ;
-- keep_V = irregV "keep" "kept" "kept" ;
-- kneel_V = irregV "kneel" "knelt" "knelt" ;
-- knit_V = irregDuplV "knit" "knit" "knit" ;
-- know_V = irregV "know" "knew" "know" ;
-- lay_V = irregV "lay" "laid" "laid" ;
-- lead_V = irregV "lead" "led" "led" ;
-- leap_V = irregV "leap" (variants {"leaped" ; "lept"}) (variants {"leaped" ; "lept"}) ;
-- learn_V = irregV "learn" (variants {"learned" ; "learnt"}) (variants {"learned" ; "learnt"}) ;
-- leave_V = irregV "leave" "left" "left" ;
-- lend_V = irregV "lend" "lent" "lent" ;
-- let_V = irregDuplV "let" "let" "let" ;
-- lie_V = irregV "lie" "lay" "lain" ;
-- light_V = irregV "light" (variants {"lighted" ; "lit"}) "lighted" ;
-- lose_V = irregV "lose" "lost" "lost" ;
-- make_V = irregV "make" "made" "made" ;
-- mean_V = irregV "mean" "meant" "meant" ;
-- meet_V = irregV "meet" "met" "met" ;
-- misspell_V = irregV "misspell" (variants {"misspelled" ; "misspelt"}) (variants {"misspelled" ; "misspelt"}) ;
-- mistake_V = irregV "mistake" "mistook" "mistaken" ;
-- mow_V = irregV "mow" "mowed" (variants {"mowed" ; "mown"}) ;
-- overcome_V = irregV "overcome" "overcame" "overcome" ;
-- overdo_V = mk5V "overdo" "overdoes" "overdid" "overdone" "overdoing" ;
-- overtake_V = irregV "overtake" "overtook" "overtaken" ;
-- overthrow_V = irregV "overthrow" "overthrew" "overthrown" ;
-- pay_V = irregV "pay" "paid" "paid" ;
-- plead_V = irregV "plead" "pled" "pled" ;
-- prove_V = irregV "prove" "proved" (variants {"proved" ; "proven"}) ;
-- put_V = irregDuplV "put" "put" "put" ;
-- quit_V = irregDuplV "quit" "quit" "quit" ;
-- read_V = irregV "read" "read" "read" ;
-- rid_V = irregDuplV "rid" "rid" "rid" ;
-- ride_V = irregV "ride" "rode" "ridden" ;
-- ring_V = irregV "ring" "rang" "rung" ;
-- rise_V = irregV "rise" "rose" "risen" ;
-- run_V = irregDuplV "run" "ran" "run" ;
-- saw_V = irregV "saw" "sawed" (variants {"sawed" ; "sawn"}) ;
-- say_V = irregV "say" "said" "said" ;
-- see_V = irregV "see" "saw" "seen" ;
-- seek_V = irregV "seek" "sought" "sought" ;
-- sell_V = irregV "sell" "sold" "sold" ;
-- send_V = irregV "send" "sent" "sent" ;
-- set_V = irregDuplV "set" "set" "set" ;
-- sew_V = irregV "sew" "sewed" (variants {"sewed" ; "sewn"}) ;
-- shake_V = irregV "shake" "shook" "shaken" ;
-- shave_V = irregV "shave" "shaved" (variants {"shaved" ; "shaven"}) ;
-- shear_V = irregV "shear" "shore" "shorn" ;
-- shed_V = irregDuplV "shed" "shed" "shed" ;
-- shine_V = irregV "shine" "shone" "shone" ;
-- shoe_V = irregV "shoe" "shoed" (variants {"shoed" ; "shod"}) ;
-- shoot_V = irregV "shoot" "shot" "shot" ;
-- show_V = irregV "show" "showed" (variants {"showed" ; "shown"}) ;
-- shrink_V = irregV "shrink" "shrank" "shrunk" ;
-- shut_V = irregDuplV "shut" "shut" "shut" ;
-- sing_V = irregV "sing" "sang" "sung" ;
-- sink_V = irregV "sink" "sank" "sunk" ;
-- sit_V = irregDuplV "sit" "sat" "sat" ;
-- sleep_V = irregV "sleep" "slept" "slept" ;
-- slay_V = irregV "slay" "slew" "slain" ;
-- slide_V = irregV "slide" "slid" "slid" ;
-- sling_V = irregV "sling" "slung" "slung" ;
-- slit_V = irregDuplV "slit" "slit" "slit" ;
-- smite_V = irregV "smite" "smote" "smitten" ;
-- sow_V = irregV "sow" "sowed" (variants {"sowed" ; "sown"}) ;
-- speak_V = irregV "speak" "spoke" "spoken" ;
-- speed_V = irregV "speed" "sped" "sped" ;
-- spend_V = irregV "spend" "spent" "spent" ;
-- spill_V = irregV "spill" (variants {"spilled" ; "spilt"}) (variants {"spilled" ; "spilt"}) ;
-- spin_V = irregDuplV "spin" "spun" "spun" ;
-- spit_V = irregDuplV "spit" (variants {"spit" ; "spat"}) "spit" ;
-- split_V = irregDuplV "split" "split" "split" ;
-- spread_V = irregV "spread" "spread" "spread" ;
-- spring_V = irregV "spring" (variants {"sprang" ; "sprung"}) "sprung" ;
-- stand_V = irregV "stand" "stood" "stood" ;
-- steal_V = irregV "steal" "stole" "stolen" ;
-- stick_V = irregV "stick" "stuck" "stuck" ;
-- sting_V = irregV "sting" "stung" "stung" ;
-- stink_V = irregV "stink" "stank" "stunk" ;
-- stride_V = irregV "stride" "strod" "stridden" ;
-- strike_V = irregV "strike" "struck" "struck" ;
-- string_V = irregV "string" "strung" "strung" ;
-- strive_V = irregV "strive" "strove" "striven" ;
-- swear_V = irregV "swear" "swore" "sworn" ;
-- sweep_V = irregV "sweep" "swept" "swept" ;
-- swell_V = irregV "swell" "swelled" (variants {"swelled" ; "swollen"}) ;
-- swim_V = irregDuplV "swim" "swam" "swum" ;
-- swing_V = irregV "swing" "swung" "swung" ;
-- take_V = irregV "take" "took" "taken" ;
-- teach_V = irregV "teach" "taught" "taught" ;
-- tear_V = irregV "tear" "tore" "torn" ;
-- tell_V = irregV "tell" "told" "told" ;
-- think_V = irregV "think" "thought" "thought" ;
-- thrive_V = irregV "thrive" (variants {"thrived" ; "throve"}) "thrived" ;
-- throw_V = irregV "throw" "threw" "thrown" ;
-- thrust_V = irregV "thrust" "thrust" "thrust" ;
-- tread_V = irregV "tread" "trod" "trodden" ;
-- understand_V = irregV "understand" "understood" "understood" ;
-- uphold_V = irregV "uphold" "upheld" "upheld" ;
-- upset_V = irregDuplV "upset" "upset" "upset" ;
-- wake_V = irregV "wake" "woke" "woken" ;
-- wear_V = irregV "wear" "wore" "worn" ;
-- weave_V = irregV "weave" (variants {"weaved" ; "wove"}) (variants {"weaved" ; "woven"}) ;
-- wed_V = irregDuplV "wed" "wed" "wed" ;
-- weep_V = irregV "weep" "wept" "wept" ;
-- wind_V = irregV "wind" "wound" "wound" ;
-- win_V = irregDuplV "win" "won" "won" ;
-- withhold_V = irregV "withhold" "withheld" "withheld" ;
-- withstand_V = irregV "withstand" "withstood" "withstood" ;
-- wring_V = irregV "wring" "wrung" "wrung" ;
-- write_V = irregV "write" "wrote" "written" ;
--}

View File

@@ -0,0 +1,10 @@
--# -path=.:../abstract:../common:prelude
concrete LangHin of Lang =
GrammarHin,
LexiconHin
** {
flags startcat = Phr ; unlexer=unwords ; lexer=words ;
}

View File

@@ -0,0 +1,375 @@
--# -path=.:prelude
concrete LexiconHin of Lexicon = CatHin **
open ParadigmsHin, Prelude in {
flags
optimize=values ;
lin
-- airplane_N = regN "airplane" ;
-- answer_V2S = mkV2S (regV "answer") toP ;
-- apartment_N = regN "apartment" ;
apple_N = mkN "seb" ;
-- art_N = regN "art" ;
-- ask_V2Q = mkV2Q (regV "ask") noPrep ;
-- baby_N = regN "baby" ;
-- bad_A = mkADeg "bad" "worse" "worst" "badly" ;
-- bank_N = regN "bank" ;
-- beautiful_A = compoundADeg (regA "beautiful") ;
-- become_VA = mkVA (irregV "become" "became" "become") ;
-- beer_N = regN "beer" ;
-- beg_V2V = mkV2V (regDuplV "beg") noPrep toP ;
big_A = mkA "baRA" ;
-- bike_N = regN "bike" ;
-- bird_N = regN "bird" ;
-- black_A = regADeg "black" ;
-- blue_A = regADeg "blue" ;
-- boat_N = regN "boat" ;
-- book_N = regN "book" ;
-- boot_N = regN "boot" ;
-- boss_N = mkN human (regN "boss") ;
boy_N = mkN "lar.kA" ;
bread_N = mkN "rot.I" ;
-- break_V2 = dirV2 (irregV "break" "broke" "broken") ;
-- broad_A = regADeg "broad" ;
-- brother_N2 = mkN2 (mkN masculine (mkN "brother")) (mkPrep "of") ;
-- brown_A = regADeg "brown" ;
-- butter_N = regN "butter" ;
-- buy_V2 = dirV2 (irregV "buy" "bought" "bought") ;
-- camera_N = regN "camera" ;
-- cap_N = regN "cap" ;
-- car_N = regN "car" ;
-- carpet_N = regN "carpet" ;
-- cat_N = regN "cat" ;
-- ceiling_N = regN "ceiling" ;
-- chair_N = regN "chair" ;
-- cheese_N = regN "cheese" ;
-- child_N = mk2N "child" "children" ;
-- church_N = regN "church" ;
-- city_N = regN "city" ;
-- clean_A = regADeg "clean" ;
-- clever_A = regADeg "clever" ;
-- close_V2 = dirV2 (regV "close") ;
-- coat_N = regN "coat" ;
-- cold_A = regADeg "cold" ;
-- come_V = (irregV "come" "came" "come") ;
-- computer_N = regN "computer" ;
-- country_N = regN "country" ;
-- cousin_N = mkN human (regN "cousin") ;
-- cow_N = regN "cow" ;
-- die_V = (regV "die") ;
-- dirty_A = regADeg "dirty" ;
-- distance_N3 = mkN3 (regN "distance") fromP toP ;
-- doctor_N = mkN human (regN "doctor") ;
-- dog_N = regN "dog" ;
-- door_N = regN "door" ;
-- drink_V2 = dirV2 (irregV "drink" "drank" "drunk") ;
-- easy_A2V = mkA2V (regA "easy") forP ;
eat_V2 = mkV2 "KA" ;
-- empty_A = regADeg "empty" ;
-- enemy_N = regN "enemy" ;
-- factory_N = regN "factory" ;
-- father_N2 = mkN2 (mkN masculine (mkN "father")) (mkPrep "of") ;
-- fear_VS = mkVS (regV "fear") ;
-- find_V2 = dirV2 (irregV "find" "found" "found") ;
-- fish_N = mk2N "fish" "fish" ;
-- floor_N = regN "floor" ;
-- forget_V2 = dirV2 (irregDuplV "forget" "forgot" "forgotten") ;
-- fridge_N = regN "fridge" ;
-- friend_N = mkN human (regN "friend") ;
-- fruit_N = regN "fruit" ;
-- fun_AV = mkAV (regA "fun") ;
-- garden_N = regN "garden" ;
girl_N = mkN "lar.kI" ;
-- glove_N = regN "glove" ;
-- gold_N = regN "gold" ;
good_A = mkA "a-cCA" ;
go_V = mkV "cal" ;
-- green_A = regADeg "green" ;
-- harbour_N = regN "harbour" ;
-- hate_V2 = dirV2 (regV "hate") ;
-- hat_N = regN "hat" ;
-- have_V2 = dirV2 (mk5V "have" "has" "had" "had" "having") ;
-- hear_V2 = dirV2 (irregV "hear" "heard" "heard") ;
-- hill_N = regN "hill" ;
-- hope_VS = mkVS (regV "hope") ;
-- horse_N = regN "horse" ;
-- hot_A = duplADeg "hot" ;
-- house_N = regN "house" ;
-- important_A = compoundADeg (regA "important") ;
-- industry_N = regN "industry" ;
-- iron_N = regN "iron" ;
-- king_N = mkN masculine (regN "king") ;
-- know_V2 = dirV2 (irregV "know" "knew" "known") ;
-- lake_N = regN "lake" ;
-- lamp_N = regN "lamp" ;
-- learn_V2 = dirV2 (regV "learn") ;
-- leather_N = regN "leather" ;
-- leave_V2 = dirV2 (irregV "leave" "left" "left") ;
-- like_V2 = dirV2 (regV "like") ;
-- listen_V2 = prepV2 (regV "listen") toP ;
live_V = mkV "CU" ; ---- touch
-- long_A = regADeg "long" ;
-- lose_V2 = dirV2 (irregV "lose" "lost" "lost") ;
-- love_N = regN "love" ;
-- love_V2 = dirV2 (regV "love") ;
-- man_N = mkN masculine (mk2N "man" "men") ;
-- married_A2 = mkA2 (regA "married") toP ;
-- meat_N = regN "meat" ;
-- milk_N = regN "milk" ;
-- moon_N = regN "moon" ;
-- mother_N2 = mkN2 (mkN feminine (mkN "mother")) (mkPrep "of") ;
-- mountain_N = regN "mountain" ;
-- music_N = regN "music" ;
-- narrow_A = regADeg "narrow" ;
-- new_A = regADeg "new" ;
-- newspaper_N = regN "newspaper" ;
-- oil_N = regN "oil" ;
-- old_A = regADeg "old" ;
-- open_V2 = dirV2 (regV "open") ;
-- paint_V2A = mkV2A (regV "paint") noPrep ;
-- paper_N = regN "paper" ;
-- paris_PN = mkPN (mkN nonhuman (mkN "Paris")) ;
-- peace_N = regN "peace" ;
-- pen_N = regN "pen" ;
-- planet_N = regN "planet" ;
-- plastic_N = regN "plastic" ;
-- play_V2 = dirV2 (regV "play") ;
-- policeman_N = mkN masculine (mkN "policeman" "policemen") ;
-- priest_N = mkN human (regN "priest") ;
-- probable_AS = mkAS (regA "probable") ;
-- queen_N = mkN feminine (regN "queen") ;
-- radio_N = regN "radio" ;
-- rain_V0 = mkV0 (regV "rain") ;
-- read_V2 = dirV2 (irregV "read" "read" "read") ;
red_A = mkA "lAl" ;
-- religion_N = regN "religion" ;
-- restaurant_N = regN "restaurant" ;
-- river_N = regN "river" ;
-- rock_N = regN "rock" ;
-- roof_N = regN "roof" ;
-- rubber_N = regN "rubber" ;
-- run_V = (irregDuplV "run" "ran" "run") ;
-- say_VS = mkVS (irregV "say" "said" "said") ;
-- school_N = regN "school" ;
-- science_N = regN "science" ;
-- sea_N = regN "sea" ;
-- seek_V2 = dirV2 (irregV "seek" "sought" "sought") ;
-- see_V2 = dirV2 (irregV "see" "saw" "seen") ;
-- sell_V3 = dirV3 (irregV "sell" "sold" "sold") toP ;
-- send_V3 = dirV3 (irregV "send" "sent" "sent") toP ;
-- sheep_N = mk2N "sheep" "sheep" ;
-- ship_N = regN "ship" ;
-- shirt_N = regN "shirt" ;
-- shoe_N = regN "shoe" ;
-- shop_N = regN "shop" ;
-- short_A = regADeg "short" ;
-- silver_N = regN "silver" ;
-- sister_N = mkN2 (mkN feminine (mkN "sister")) (mkPrep "of") ;
-- sleep_V = (irregV "sleep" "slept" "slept") ;
-- small_A = regADeg "small" ;
-- snake_N = regN "snake" ;
-- sock_N = regN "sock" ;
-- speak_V2 = dirV2 (irregV "speak" "spoke" "spoken") ;
-- star_N = regN "star" ;
-- steel_N = regN "steel" ;
-- stone_N = regN "stone" ;
-- stove_N = regN "stove" ;
-- student_N = mkN human (regN "student") ;
-- stupid_A = regADeg "stupid" ;
-- sun_N = regN "sun" ;
-- switch8off_V2 = dirV2 (partV (regV "switch") "off") ;
-- switch8on_V2 = dirV2 (partV (regV "switch") "on") ;
-- table_N = regN "table" ;
-- talk_V3 = mkV3 (regV "talk") toP aboutP ;
-- teacher_N = mkN human (regN "teacher") ;
-- teach_V2 = dirV2 (irregV "teach" "taught" "taught") ;
-- television_N = regN "television" ;
-- thick_A = regADeg "thick" ;
-- thin_A = duplADeg "thin" ;
-- train_N = regN "train" ;
-- travel_V = (regDuplV "travel") ;
-- tree_N = regN "tree" ;
-- ---- trousers_N = regN "trousers" ;
-- ugly_A = regADeg "ugly" ;
-- understand_V2 = dirV2 (irregV "understand" "understood" "understood") ;
-- university_N = regN "university" ;
-- village_N = regN "village" ;
-- wait_V2 = prepV2 (regV "wait") forP ;
-- walk_V = (regV "walk") ;
-- warm_A = regADeg "warm" ;
-- war_N = regN "war" ;
-- watch_V2 = dirV2 (regV "watch") ;
-- water_N = regN "water" ;
-- white_A = regADeg "white" ;
-- window_N = regN "window" ;
-- wine_N = regN "wine" ;
-- win_V2 = dirV2 (irregDuplV "win" "won" "won") ;
-- woman_N = mkN feminine (mk2N "woman" "women") ;
-- wonder_VQ = mkVQ (regV "wonder") ;
-- wood_N = regN "wood" ;
-- write_V2 = dirV2 (irregV "write" "wrote" "written") ;
-- yellow_A = regADeg "yellow" ;
-- young_A = regADeg "young" ;
--
-- do_V2 = dirV2 (mk5V "do" "does" "did" "done" "doing") ;
-- now_Adv = mkAdv "now" ;
-- already_Adv = mkAdv "already" ;
-- song_N = regN "song" ;
-- add_V3 = dirV3 (regV "add") toP ;
-- number_N = regN "number" ;
-- put_V2 = prepV2 (irregDuplV "put" "put" "put") noPrep ;
-- stop_V = regDuplV "stop" ;
-- jump_V = regV "jump" ;
--
-- left_Ord = ss "left" ;
-- right_Ord = ss "right" ;
-- far_Adv = mkAdv "far" ;
-- correct_A = (regA "correct") ;
-- dry_A = regA "dry" ;
-- dull_A = regA "dull" ;
-- full_A = regA "full" ;
-- heavy_A = regA "heavy" ;
-- near_A = regA "near" ;
-- rotten_A = (regA "rotten") ;
-- round_A = regA "round" ;
-- sharp_A = regA "sharp" ;
-- smooth_A = regA "smooth" ;
-- straight_A = regA "straight" ;
-- wet_A = regA "wet" ; ----
-- wide_A = regA "wide" ;
-- animal_N = regN "animal" ;
-- ashes_N = regN "ash" ; -- FIXME: plural only?
-- back_N = regN "back" ;
-- bark_N = regN "bark" ;
-- belly_N = regN "belly" ;
-- blood_N = regN "blood" ;
-- bone_N = regN "bone" ;
-- breast_N = regN "breast" ;
-- cloud_N = regN "cloud" ;
-- day_N = regN "day" ;
-- dust_N = regN "dust" ;
-- ear_N = regN "ear" ;
-- earth_N = regN "earth" ;
-- egg_N = regN "egg" ;
-- eye_N = regN "eye" ;
-- fat_N = regN "fat" ;
-- feather_N = regN "feather" ;
-- fingernail_N = regN "fingernail" ;
-- fire_N = regN "fire" ;
-- flower_N = regN "flower" ;
-- fog_N = regN "fog" ;
-- foot_N = mk2N "foot" "feet" ;
-- forest_N = regN "forest" ;
-- grass_N = regN "grass" ;
-- guts_N = regN "gut" ; -- FIXME: no singular
-- hair_N = regN "hair" ;
-- hand_N = regN "hand" ;
-- head_N = regN "head" ;
-- heart_N = regN "heart" ;
-- horn_N = regN "horn" ;
-- husband_N = mkN masculine (regN "husband") ;
-- ice_N = regN "ice" ;
-- knee_N = regN "knee" ;
-- leaf_N = mk2N "leaf" "leaves" ;
-- leg_N = regN "leg" ;
-- liver_N = regN "liver" ;
-- louse_N = mk2N "louse" "lice" ;
-- mouth_N = regN "mouth" ;
-- name_N = regN "name" ;
-- neck_N = regN "neck" ;
-- night_N = regN "night" ;
-- nose_N = regN "nose" ;
-- person_N = mkN human (regN "person") ;
-- rain_N = regN "rain" ;
-- road_N = regN "road" ;
-- root_N = regN "root" ;
-- rope_N = regN "rope" ;
-- salt_N = regN "salt" ;
-- sand_N = regN "sand" ;
-- seed_N = regN "seed" ;
-- skin_N = regN "skin" ;
-- sky_N = regN "sky" ;
-- smoke_N = regN "smoke" ;
-- snow_N = regN "snow" ;
-- stick_N = regN "stick" ;
-- tail_N = regN "tail" ;
-- tongue_N = regN "tongue" ;
-- tooth_N = mk2N "tooth" "teeth" ;
-- wife_N = mkN feminine (mk2N "wife" "wives") ;
-- wind_N = regN "wind" ;
-- wing_N = regN "wing" ;
-- worm_N = regN "worm" ;
-- year_N = regN "year" ;
-- blow_V = IrregHin.blow_V ;
-- breathe_V = dirV2 (regV "breathe") ;
-- burn_V = IrregHin.burn_V ;
-- dig_V = IrregHin.dig_V ;
-- fall_V = IrregHin.fall_V ;
-- float_V = regV "float" ;
-- flow_V = regV "flow" ;
-- fly_V = IrregHin.fly_V ;
-- freeze_V = IrregHin.freeze_V ;
-- give_V3 = dirV3 give_V toP ;
-- laugh_V = regV "laugh" ;
-- lie_V = IrregHin.lie_V ;
-- play_V = regV "play" ;
sew_V = mkV "sI" ;
-- sing_V = IrregHin.sing_V ;
-- sit_V = IrregHin.sit_V ;
-- smell_V = regV "smell" ;
-- spit_V = IrregHin.spit_V ;
-- stand_V = IrregHin.stand_V ;
-- swell_V = IrregHin.swell_V ;
-- swim_V = IrregHin.swim_V ;
-- think_V = IrregHin.think_V ;
-- turn_V = regV "turn" ;
-- vomit_V = regV "vomit" ;
--
-- bite_V2 = dirV2 IrregHin.bite_V ;
-- count_V2 = dirV2 (regV "count") ;
-- cut_V2 = dirV2 IrregHin.cut_V ;
-- fear_V2 = dirV2 (regV "fear") ;
-- fight_V2 = dirV2 fight_V ;
hit_V2 = mkV2 (mkV "mAr") "ko" ;
-- hold_V2 = dirV2 hold_V ;
-- hunt_V2 = dirV2 (regV "hunt") ;
-- kill_V2 = dirV2 (regV "kill") ;
-- pull_V2 = dirV2 (regV "pull") ;
-- push_V2 = dirV2 (regV "push") ;
-- rub_V2 = dirV2 (regDuplV "rub") ;
-- scratch_V2 = dirV2 (regV "scratch") ;
-- split_V2 = dirV2 split_V ;
-- squeeze_V2 = dirV2 (regV "squeeze") ;
-- stab_V2 = dirV2 (regDuplV "stab") ;
-- suck_V2 = dirV2 (regV "suck") ;
-- throw_V2 = dirV2 throw_V ;
-- tie_V2 = dirV2 (regV "tie") ;
-- wash_V2 = dirV2 (regV "wash") ;
-- wipe_V2 = dirV2 (regV "wipe") ;
--
---- other_A = regA "other" ;
--
-- grammar_N = regN "grammar" ;
-- language_N = regN "language" ;
-- rule_N = regN "rule" ;
--
---- added 4/6/2007
john_PN = mkPN "jon" ;
-- question_N = regN "question" ;
-- ready_A = regA "ready" ;
-- reason_N = regN "reason" ;
-- today_Adv = mkAdv "today" ;
-- uncertain_A = regA "uncertain" ;
--
--oper
-- aboutP = mkPrep "about" ;
-- atP = mkPrep "at" ;
-- forP = mkPrep "for" ;
-- fromP = mkPrep "from" ;
-- inP = mkPrep "in" ;
-- onP = mkPrep "on" ;
-- toP = mkPrep "to" ;
--
}

View File

@@ -0,0 +1,196 @@
--# -path=.:../../prelude
--
----1 A Simple Hindi Resource Morphology
----
---- Aarne Ranta 2002 -- 2005
----
---- This resource morphology contains definitions needed in the resource
---- syntax. To build a lexicon, it is better to use $ParadigmsHin$, which
---- gives a higher-level access to this module.
--
resource MorphoHin = ResHin ** open Prelude, (Predef=Predef) in {
--
-- flags optimize=all ;
--
----2 Phonology
----
---- To regulate the use of endings for both nouns, adjectives, and verbs:
--
--oper
-- y2ie : Str -> Str -> Str = \fly,s ->
-- let y = last (init fly) in
-- case y of {
-- "a" => fly + s ;
-- "e" => fly + s ;
-- "o" => fly + s ;
-- "u" => fly + s ;
-- _ => init fly + "ie" + s
-- } ;
--
--
----2 Nouns
----
---- For conciseness and abstraction, we define a worst-case macro for
---- noun inflection. It is used for defining special case that
---- only need one string as argument.
--
--oper
-- CommonNoun : Type = {s : Number => Case => Str} ;
--
-- nounGen : Str -> CommonNoun = \dog -> case last dog of {
-- "y" => nounY "dog" ;
-- "s" => nounS (init "dog") ;
-- _ => nounReg "dog"
-- } ;
--
---- These are auxiliaries to $nounGen$.
--
-- nounReg : Str -> CommonNoun = \dog ->
-- mkNoun dog (dog + "s") (dog + "'s") (dog + "s'");
-- nounS : Str -> CommonNoun = \kiss ->
-- mkNoun kiss (kiss + "es") (kiss + "'s") (kiss + "es'") ;
-- nounY : Str -> CommonNoun = \fl ->
-- mkNoun (fl + "y") (fl + "ies") (fl + "y's") (fl + "ies'") ;
--
--
----3 Proper names
----
---- Regular proper names are inflected with "'s" in the genitive.
--
-- nameReg : Str -> Gender -> {s : Case => Str} = \john,g ->
-- {s = table {Gen => john + "'s" ; _ => john} ; g = g} ;
--
----2 Determiners
--
-- mkDeterminer : Number -> Str -> {s : Str ; n : Number} = \n,s ->
-- {s = s ; n = n} ;
--
----2 Pronouns
----
---- Here we define personal pronouns.
----
---- We record the form "mine" and the gender for later use.
--
-- Pronoun : Type =
-- {s : Case => Str ; a : Agr} ;
--
-- mkPronoun : (_,_,_,_ : Str) -> Number -> Person -> Gender -> Pronoun =
-- \I,me,my,mine,n,p,g ->
-- {s = table {Nom => I ; Acc => me ; Gen => my} ;
-- a = toAgr n p g
-- } ;
--
-- human : Gender = Masc ; --- doesn't matter
--
-- pronI = mkPronoun "I" "me" "my" "mine" Sg P1 human ;
-- pronYouSg = mkPronoun "you" "you" "your" "yours" Sg P2 human ; -- verb agr OK
-- pronHe = mkPronoun "he" "him" "his" "his" Sg P3 Masc ;
-- pronShe = mkPronoun "she" "her" "her" "hers" Sg P3 Fem ;
-- pronIt = mkPronoun "it" "it" "its" "it" Sg P3 Neutr ;
--
-- pronWe = mkPronoun "we" "us" "our" "ours" Pl P1 human ;
-- pronYouPl = mkPronoun "you" "you" "your" "yours" Pl P2 human ;
-- pronThey = mkPronoun "they" "them" "their" "theirs" Pl P3 human ; ---
--
--
----2 Adjectives
----
---- To form the adjectival and the adverbial forms, two strings are needed
---- in the worst case. (First without degrees.)
--
-- Adjective = {s : AForm => Str} ;
--
---- However, most adjectives can be inflected using the final character.
---- N.B. this is not correct for "shy", but $mkAdjective$ has to be used.
--
-- regAdjective : Str -> Adjective = \free ->
-- let
-- e = last free ;
-- fre = init free ;
-- freely = case e of {
-- "y" => fre + "ily" ;
-- _ => free + "ly"
-- } ;
-- fre = case e of {
-- "e" => fre ;
-- "y" => fre + "i" ;
-- _ => free
-- }
-- in
-- mkAdjective free (fre + "er") (fre + "est") freely ;
--
---- Many adjectives are 'inflected' by adding a comparison word.
--
-- adjDegrLong : Str -> Adjective = \ridiculous ->
-- mkAdjective
-- ridiculous
-- ("more" ++ ridiculous)
-- ("most" ++ ridiculous)
-- ((regAdjective ridiculous).s ! AAdv) ;
--
--
----3 Verbs
----
---- The worst case needs five forms. (The verb "be" is treated separately.)
--
-- mkVerb4 : (_,_,_,_: Str) -> Verb = \go,goes,went,gone ->
-- let going = case last go of {
-- "e" => init go + "ing" ;
-- _ => go + "ing"
-- }
-- in
-- mkVerb go goes went gone going ;
--
---- This is what we use to derive the irregular forms in almost all cases
--
-- mkVerbIrreg : (_,_,_ : Str) -> Verb = \bite,bit,bitten ->
-- let bites = case last bite of {
-- "y" => y2ie bite "s" ;
-- "s" => init bite + "es" ;
-- _ => bite + "s"
-- }
-- in mkVerb4 bite bites bit bitten ;
--
---- This is used to derive regular forms.
--
-- mkVerbReg : Str -> Verb = \soak ->
-- let
-- soaks = case last soak of {
-- "y" => y2ie soak "s" ;
-- "s" => init soak + "es" ;
-- _ => soak + "s"
-- } ;
-- soaked = case last soak of {
-- "e" => init soak + "s" ;
-- _ => soak + "ed"
-- }
-- in
-- mkVerb4 soak soaks soaked soaked ;
--
-- verbGen : Str -> Verb = \kill -> case last kill of {
-- "y" => verbP3y (init kill) ;
-- "e" => verbP3e (init kill) ;
-- "s" => verbP3s (init kill) ;
-- _ => regVerbP3 kill
-- } ;
--
---- These are just auxiliary to $verbGen$.
--
-- regVerbP3 : Str -> Verb = \walk ->
-- mkVerbIrreg walk (walk + "ed") (walk + "ed") ;
-- verbP3s : Str -> Verb = \kiss ->
-- mkVerb4 kiss (kiss + "es") (kiss + "ed") (kiss + "ed") ;
-- verbP3e : Str -> Verb = \love ->
-- mkVerb4 love (love + "s") (love + "d") (love + "d") ;
-- verbP3y : Str -> Verb = \cr ->
-- mkVerb4 (cr + "y") (cr + "ies") (cr + "ied") (cr + "ied") ;
--
----- The particle always appears right after the verb.
--
-- verbPart : Verb -> Str -> Verb = \v,p ->
-- {s = \\f => v.s ! f ++ p ; isRefl = v.isRefl} ;
--
-- verbNoPart : Verb -> Verb = \v -> verbPart v [] ;
--
--
}

View File

@@ -0,0 +1,121 @@
concrete NounHin of Noun = CatHin ** open ResHin, Prelude in {
flags optimize=all_subs ;
lin
DetCN det cn = {
s = \\c => det.s ! cn.g ! npcase2case c ++ toNP (cn.s ! det.n) c ;
a = agrP3 cn.g det.n
} ;
UsePN pn = {s = \\c => toNP pn.s c ; a = agrP3 pn.g Sg} ;
UsePron p = {s = \\c => p.s ! np2pronCase c ; a = p.a} ;
--
-- 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
-- } ;
--
-- RelNP np rs = {
-- s = \\c => np.s ! c ++ "," ++ rs.s ! np.a ;
-- a = np.a
-- } ;
--
-- AdvNP np adv = {
-- s = \\c => np.s ! c ++ adv.s ;
-- a = np.a
-- } ;
--
-- DetQuantOrd quant num ord = {
-- s = quant.s ! num.n ++ num.s ++ ord.s ;
-- n = num.n
-- } ;
DetQuant quant num = {
s = \\g,c => quant.s ! num.n ! g ! c ++ num.s ;
n = num.n
} ;
-- DetNP det = {
-- s = \\c => det.s ; ---- case
-- a = agrP3 det.n
-- } ;
--
PossPron p = {s = \\_,_,_ => p.s ! PPoss} ;
NumSg = {s = []; n = Sg} ;
NumPl = {s = []; n = Pl} ;
-- NumCard n = n ** {hasCard = True} ;
--
-- NumDigits n = {s = n.s ! NCard ; n = n.n} ;
-- OrdDigits n = {s = n.s ! NOrd} ;
--
-- NumNumeral numeral = {s = numeral.s ! NCard; n = numeral.n} ;
-- OrdNumeral numeral = {s = numeral.s ! NOrd} ;
--
-- AdNum adn num = {s = adn.s ++ num.s ; n = num.n} ;
--
-- OrdSuperl a = {s = a.s ! AAdj Superl} ;
--
-- DetArtOrd art num ord = {
-- s = art.s ! num.hasCard ! num.n ++ num.s ++ ord.s ;
-- n = num.n
-- } ;
--
-- DetArtCard art card = {
-- s = art.s ! True ! card.n ++ card.s ;
-- n = card.n
-- } ;
DefArt = {s = \\_,_,_ => []} ;
IndefArt = {s = \\_,_,_ => []} ;
-- MassNP cn = {
-- s = cn.s ! Sg ;
-- a = agrP3 Sg
-- } ;
UseN n = n ;
-- UseN2 n = n ;
--
-- Use2N3 f = {
-- s = \\n,c => f.s ! n ! Nom ;
-- g = f.g ;
-- c2 = f.c2
-- } ;
--
-- Use3N3 f = {
-- s = \\n,c => f.s ! n ! Nom ;
-- g = f.g ;
-- c2 = f.c3
-- } ;
--
-- ComplN2 f x = {s = \\n,c => f.s ! n ! Nom ++ f.c2 ++ x.s ! c ; g = f.g} ;
-- ComplN3 f x = {
-- s = \\n,c => f.s ! n ! Nom ++ f.c2 ++ x.s ! c ;
-- g = f.g ;
-- c2 = f.c3
-- } ;
AdjCN ap cn = {
s = \\n,c => ap.s ! cn.g ! n ! c ++ cn.s ! n ! c ;
g = cn.g
} ;
-- RelCN cn rs = {
-- s = \\n,c => cn.s ! n ! c ++ rs.s ! agrgP3 n cn.g ;
-- g = cn.g
-- } ;
-- AdvCN cn ad = {s = \\n,c => cn.s ! n ! c ++ ad.s ; g = cn.g} ;
--
-- SentCN cn sc = {s = \\n,c => cn.s ! n ! c ++ sc.s ; g = cn.g} ;
--
-- ApposCN cn np = {s = \\n,c => cn.s ! n ! Nom ++ np.s ! c ; g = cn.g} ;
--
}

View File

@@ -0,0 +1,95 @@
concrete NumeralHin of Numeral = CatHin ** open ResHin in {
--
--lincat
-- Digit = {s : DForm => CardOrd => Str} ;
-- Sub10 = {s : DForm => CardOrd => Str ; n : Number} ;
-- Sub100 = {s : CardOrd => Str ; n : Number} ;
-- Sub1000 = {s : CardOrd => Str ; n : Number} ;
-- Sub1000000 = {s : CardOrd => Str ; n : Number} ;
--
--lin num x = x ;
--lin n2 = let two = mkNum "two" "twelve" "twenty" "second" in
-- {s = \\f,c => case <f,c> of {
-- <teen,NOrd> => "twelfth" ;
-- _ => two.s ! f ! c
-- }
-- } ;
--
--lin n3 = mkNum "three" "thirteen" "thirty" "third" ;
--lin n4 = mkNum "four" "fourteen" "forty" "fourth" ;
--lin n5 = mkNum "five" "fifteen" "fifty" "fifth" ;
--lin n6 = regNum "six" ;
--lin n7 = regNum "seven" ;
--lin n8 = mkNum "eight" "eighteen" "eighty" "eighth" ;
--lin n9 = mkNum "nine" "nineteen" "ninety" "ninth" ;
--
--lin pot01 = mkNum "one" "eleven" "ten" "first" ** {n = Sg} ;
--lin pot0 d = d ** {n = Pl} ;
--lin pot110 = regCardOrd "ten" ** {n = Pl} ;
--lin pot111 = regCardOrd "eleven" ** {n = Pl} ;
--lin pot1to19 d = {s = d.s ! teen} ** {n = Pl} ;
--lin pot0as1 n = {s = n.s ! unit} ** {n = n.n} ;
--lin pot1 d = {s = d.s ! ten} ** {n = Pl} ;
--lin pot1plus d e = {
-- s = \\c => d.s ! ten ! NCard ++ "-" ++ e.s ! unit ! c ; n = Pl} ;
--lin pot1as2 n = n ;
--lin pot2 d = {s = \\c => d.s ! unit ! NCard ++ mkCard c "hundred"} ** {n = Pl} ;
--lin pot2plus d e = {
-- s = \\c => d.s ! unit ! NCard ++ "hundred" ++ "and" ++ e.s ! c ; n = Pl} ;
--lin pot2as3 n = n ;
--lin pot3 n = {
-- s = \\c => n.s ! NCard ++ mkCard c "thousand" ; n = Pl} ;
--lin pot3plus n m = {
-- s = \\c => n.s ! NCard ++ "thousand" ++ m.s ! c ; n = Pl} ;
--
---- numerals as sequences of digits
--
-- lincat
-- Dig = TDigit ;
--
-- lin
-- IDig d = d ** {tail = T1} ;
--
-- IIDig d i = {
-- s = \\o => d.s ! NCard ++ commaIf i.tail ++ i.s ! o ;
-- n = Pl ;
-- tail = inc i.tail
-- } ;
--
-- D_0 = mkDig "0" ;
-- D_1 = mk3Dig "1" "1st" Sg ;
-- D_2 = mk2Dig "2" "2nd" ;
-- D_3 = mk2Dig "3" "3rd" ;
-- D_4 = mkDig "4" ;
-- D_5 = mkDig "5" ;
-- D_6 = mkDig "6" ;
-- D_7 = mkDig "7" ;
-- D_8 = mkDig "8" ;
-- D_9 = mkDig "9" ;
--
-- oper
-- commaIf : DTail -> Str = \t -> case t of {
-- T3 => "," ;
-- _ => []
-- } ;
--
-- inc : DTail -> DTail = \t -> case t of {
-- T1 => T2 ;
-- T2 => T3 ;
-- T3 => T1
-- } ;
--
-- mk2Dig : Str -> Str -> TDigit = \c,o -> mk3Dig c o Pl ;
-- mkDig : Str -> TDigit = \c -> mk2Dig c (c + "th") ;
--
-- mk3Dig : Str -> Str -> Number -> TDigit = \c,o,n -> {
-- s = table {NCard => c ; NOrd => o} ;
-- n = n
-- } ;
--
-- TDigit = {
-- n : Number ;
-- s : CardOrd => Str
-- } ;
--
}

View File

@@ -0,0 +1,556 @@
--# -path=.:../abstract:../../prelude:../common
--
----1 Hindi Lexical Paradigms
resource ParadigmsHin = open
(Predef=Predef),
Prelude,
MorphoHin,
CatHin
in {
--2 Parameters
oper
masculine : Gender ;
feminine : Gender ;
masculine = Masc ; feminine = Fem ; --i
--2 Nouns
mkN = overload {
mkN : Str -> N
= \s -> regNoun s ** {lock_N = <>} ;
mkN : Str -> Gender -> N
= \s,g -> reggNoun s g ** {lock_N = <>} ;
mkN : (x1,_,_,_,_,x6 : Str) -> Gender -> N
= \sd,so,sv,pd,po,pv,g -> mkNoun sd so sv pd po pv g ** {lock_N = <>} ;
} ;
mkPN = overload {
mkPN : Str -> PN = \s -> let n = regNoun s in {s = n.s ! Sg ; g = n.g ; lock_PN = <>} ;
mkPN : N -> Gender -> PN = \n,g -> {s = n.s ! Sg ; g = g ; lock_PN = <>} ;
} ;
--2 Adjectives
mkA = overload {
mkA : Str -> A
= \s -> regAdjective s ** {lock_A = <>} ;
mkA : (x1,_,x3 : Str) -> A
= \msd,m,f -> mkAdjective msd m f ** {lock_A = <>} ;
} ;
--2 Verbs
mkV = overload {
mkV : Str -> V
= \s -> regVerb s ** {lock_V = <>} ;
mkV : (x1,_,_,_,_,_,_,_,_,_,_,_,_,_,x15 : Str) -> V
= \inf,stem,ims,imp,ifs,ifp,pms,pmp,pfs,pfp,ss1,ss2,sp2,sp3,r ->
mkVerb inf stem ims imp ifs ifp pms pmp pfs pfp ss1 ss2 sp2 sp3 r **
{lock_V = <>} ;
} ;
mkV2 = overload {
mkV2 : Str -> V2
= \s -> regVerb s ** {c2 = {s = [] ; c = VTrans} ; lock_V2 = <>} ;
mkV2 : V -> V2
= \v -> v ** {c2 = {s = [] ; c = VTrans} ; lock_V2 = <>} ;
mkV2 : V -> Str -> V2
= \v,p -> v ** {c2 = {s = p ; c = VTransPost} ; lock_V2 = <>} ;
} ;
----3 Compound nouns
----
---- A compound noun is an uninflected string attached to an inflected noun,
---- such as "baby boom", "chief executive officer".
--
-- mkN : Str -> N -> N
-- } ;
--
--
----3 Relational nouns
----
---- Relational nouns ("daughter of x") need a preposition.
--
-- mkN2 : N -> Prep -> N2 ;
--
---- The most common preposition is "of", and the following is a
---- shortcut for regular relational nouns with "of".
--
-- regN2 : Str -> N2 ;
--
---- Use the function $mkPrep$ or see the section on prepositions below to
---- form other prepositions.
----
---- Three-place relational nouns ("the connection from x to y") need two prepositions.
--
-- mkN3 : N -> Prep -> Prep -> N3 ;
--
--
--
----3 Proper names and noun phrases
----
---- Proper names, with a regular genitive, are formed from strings.
--
-- mkPN : overload {
--
-- mkPN : Str -> PN ;
--
---- Sometimes a common noun can be reused as a proper name, e.g. "Bank"
--
-- mkPN : N -> PN
-- } ;
--
--
----2 Adjectives
--
-- mkA : overload {
--
---- For regular adjectives, the adverbial and comparison forms are derived. This holds
---- even for cases with the variations "happy - happily - happier - happiest",
---- "free - freely - freer - freest", and "rude - rudest".
--
-- mkA : (happy : Str) -> A ;
--
---- However, the duplication of the final consonant cannot be predicted,
---- but a separate case is used to give the comparative
--
-- mkA : (fat,fatter : Str) -> A ;
--
---- As many as four forms may be needed.
--
-- mkA : (good,better,best,well : Str) -> A
-- } ;
--
---- To force comparison to be formed by "more - most",
---- the following function is used:
--
-- compoundA : A -> A ; -- -/more/most ridiculous
--
--
--
----3 Two-place adjectives
----
---- Two-place adjectives need a preposition for their second argument.
--
-- mkA2 : A -> Prep -> A2 ;
--
--
--
----2 Adverbs
--
---- Adverbs are not inflected. Most lexical ones have position
---- after the verb. Some can be preverbal (e.g. "always").
--
-- mkAdv : Str -> Adv ;
-- mkAdV : Str -> AdV ;
--
---- Adverbs modifying adjectives and sentences can also be formed.
--
-- mkAdA : Str -> AdA ;
--
----2 Prepositions
----
---- A preposition as used for rection in the lexicon, as well as to
---- build $PP$s in the resource API, just requires a string.
--
-- mkPrep : Str -> Prep ;
-- noPrep : Prep ;
--
---- (These two functions are synonyms.)
--
----2 Verbs
----
--
---- Verbs are constructed by the function $mkV$, which takes a varying
---- number of arguments.
--
-- mkV : overload {
--
---- The regular verb function recognizes the special cases where the last
---- character is "y" ("cry-cries" but "buy-buys") or a sibilant
---- ("kiss-"kisses", "jazz-jazzes", "rush-rushes", "munch - munches",
---- "fix - fixes").
--
-- mkV : (cry : Str) -> V ;
--
---- Give the present and past forms for regular verbs where
---- the last letter is duplicated in some forms,
---- e.g. "rip - ripped - ripping".
--
-- mkV : (stop, stopped : Str) -> V ;
--
---- There is an extensive list of irregular verbs in the module $IrregularHin$.
---- In practice, it is enough to give three forms,
---- e.g. "drink - drank - drunk".
--
-- mkV : (drink, drank, drunk : Str) -> V ;
--
---- Irregular verbs with duplicated consonant in the present participle.
--
-- mkV : (run, ran, run, running : Str) -> V ;
--
---- Except for "be", the worst case needs five forms: the infinitive and
---- the third person singular present, the past indicative, and the
---- past and present participles.
--
-- mkV : (go, goes, went, gone, going : Str) -> V
-- };
--
---- Verbs with a particle.
---- The particle, such as in "switch on", is given as a string.
--
-- partV : V -> Str -> V ;
--
---- Reflexive verbs.
---- By default, verbs are not reflexive; this function makes them that.
--
-- reflV : V -> V ;
--
----3 Two-place verbs
----
---- Two-place verbs need a preposition, except the special case with direct object.
---- (transitive verbs). Notice that a particle comes from the $V$.
--
-- mkV2 : overload {
-- mkV2 : V -> Prep -> V2 ; -- believe in
-- mkV2 : V -> V2 -- kill
-- };
--
----3 Three-place verbs
----
---- Three-place (ditransitive) verbs need two prepositions, of which
---- the first one or both can be absent.
--
-- mkV3 : V -> Prep -> Prep -> V3 ; -- speak, with, about
-- dirV3 : V -> Prep -> V3 ; -- give,_,to
-- dirdirV3 : V -> V3 ; -- give,_,_
--
----3 Other complement patterns
----
---- Verbs and adjectives can take complements such as sentences,
---- questions, verb phrases, and adjectives.
--
-- mkV0 : V -> V0 ;
-- mkVS : V -> VS ;
-- mkV2S : V -> Prep -> V2S ;
-- mkVV : V -> VV ;
-- mkV2V : V -> Prep -> Prep -> V2V ;
-- mkVA : V -> VA ;
-- mkV2A : V -> Prep -> V2A ;
-- mkVQ : V -> VQ ;
-- mkV2Q : V -> Prep -> V2Q ;
--
-- mkAS : A -> AS ;
-- mkA2S : A -> Prep -> A2S ;
-- mkAV : A -> AV ;
-- mkA2V : A -> Prep -> A2V ;
--
---- Notice: Categories $V0, AS, A2S, AV, A2V$ are just $A$.
---- $V0$ is just $V$; the second argument is treated as adverb.
--
-- V0 : Type ;
-- AS, A2S, AV, A2V : Type ;
--
----.
----2 Definitions of paradigms
----
---- The definitions should not bother the user of the API. So they are
---- hidden from the document.
--
-- Gender = MorphoHin.Gender ;
-- Number = MorphoHin.Number ;
-- Case = MorphoHin.Case ;
-- human = Masc ;
-- nonhuman = Neutr ;
-- masculine = Masc ;
-- feminine = Fem ;
-- singular = Sg ;
-- plural = Pl ;
-- nominative = Nom ;
-- genitive = Gen ;
--
-- Preposition : Type = Str ; -- obsolete
--
-- regN = \ray ->
-- let rays = add_s ray
-- in
-- mk2N ray rays ;
--
--
-- add_s : Str -> Str = \w -> case w of {
-- _ + ("io" | "oo") => w + "s" ; -- radio, bamboo
-- _ + ("s" | "z" | "x" | "sh" | "ch" | "o") => w + "es" ; -- bus, hero
-- _ + ("a" | "o" | "u" | "e") + "y" => w + "s" ; -- boy
-- x + "y" => x + "ies" ; -- fly
-- _ => w + "s" -- car
-- } ;
--
-- mk2N = \man,men ->
-- let mens = case last men of {
-- "s" => men + "'" ;
-- _ => men + "'s"
-- }
-- in
-- mk4N man men (man + "'s") mens ;
--
-- mk4N = \man,men,man's,men's ->
-- mkNoun man man's men men's ** {g = Neutr ; lock_N = <>} ;
--
-- genderN g man = {s = man.s ; g = g ; lock_N = <>} ;
--
-- compoundN s n = {s = \\x,y => s ++ n.s ! x ! y ; g=n.g ; lock_N = <>} ;
--
-- mkPN = overload {
-- mkPN : Str -> PN = regPN ;
-- mkPN : N -> PN = nounPN
-- } ;
--
--
-- mkN2 = \n,p -> n ** {lock_N2 = <> ; c2 = p.s} ;
-- regN2 n = mkN2 (regN n) (mkPrep "of") ;
-- mkN3 = \n,p,q -> n ** {lock_N3 = <> ; c2 = p.s ; c3 = q.s} ;
--
----3 Relational common noun phrases
----
---- In some cases, you may want to make a complex $CN$ into a
---- relational noun (e.g. "the old town hall of").
--
-- cnN2 : CN -> Prep -> N2 ;
-- cnN3 : CN -> Prep -> Prep -> N3 ;
--
---- This is obsolete.
-- cnN2 = \n,p -> n ** {lock_N2 = <> ; c2 = p.s} ;
-- cnN3 = \n,p,q -> n ** {lock_N3 = <> ; c2 = p.s ; c3 = q.s} ;
--
-- regPN n = regGenPN n human ;
-- regGenPN n g = nameReg n g ** {g = g ; lock_PN = <>} ;
-- nounPN n = {s = n.s ! singular ; g = n.g ; lock_PN = <>} ;
--
-- mk2A a b = mkAdjective a a a b ** {lock_A = <>} ;
-- regA a = regADeg a ** {lock_A = <>} ;
--
-- mkA2 a p = a ** {c2 = p.s ; lock_A2 = <>} ;
--
-- ADeg = A ; ----
--
-- mkADeg a b c d = mkAdjective a b c d ** {lock_A = <>} ;
--
-- regADeg happy =
-- let
-- happ = init happy ;
-- y = last happy ;
-- happie = case y of {
-- "y" => happ + "ie" ;
-- "e" => happy ;
-- _ => happy + "e"
-- } ;
-- happily : Str = case happy of {
-- _ + "y" => happ + "ily" ;
-- _ + "ll" => happy + "y" ;
-- _ => happy + "ly"
-- } ;
-- in mkADeg happy (happie + "r") (happie + "st") happily ;
--
-- duplADeg fat =
-- mkADeg fat
-- (fat + last fat + "er") (fat + last fat + "est") (fat + "ly") ;
--
-- compoundADeg a =
-- let ad = (a.s ! AAdj Posit)
-- in mkADeg ad ("more" ++ ad) ("most" ++ ad) (a.s ! AAdv) ;
--
-- adegA a = a ;
--
-- mkAdv x = ss x ** {lock_Adv = <>} ;
-- mkAdV x = ss x ** {lock_AdV = <>} ;
-- mkAdA x = ss x ** {lock_AdA = <>} ;
--
-- mkPrep p = ss p ** {lock_Prep = <>} ;
-- noPrep = mkPrep [] ;
--
-- mk5V a b c d e = mkVerb a b c d e ** {s1 = [] ; lock_V = <>} ;
--
-- regV cry =
-- let
-- cr = init cry ;
-- y = last cry ;
-- cries = (regN cry).s ! Pl ! Nom ; -- !
-- crie = init cries ;
-- cried = case last crie of {
-- "e" => crie + "d" ;
-- _ => crie + "ed"
-- } ;
-- crying = case y of {
-- "e" => case last cr of {
-- "e" => cry + "ing" ;
-- _ => cr + "ing"
-- } ;
-- _ => cry + "ing"
-- }
-- in mk5V cry cries cried cried crying ;
--
-- reg2V fit fitted =
-- let fitt = Predef.tk 2 fitted ;
-- in mk5V fit (fit + "s") (fitt + "ed") (fitt + "ed") (fitt + "ing") ;
--
-- regDuplV fit =
-- case last fit of {
-- ("a" | "e" | "i" | "o" | "u" | "y") =>
-- Predef.error (["final duplication makes no sense for"] ++ fit) ;
-- t =>
-- let fitt = fit + t in
-- mk5V fit (fit + "s") (fitt + "ed") (fitt + "ed") (fitt + "ing")
-- } ;
--
-- irregV x y z = let reg = (regV x).s in
-- mk5V x (reg ! VPres) y z (reg ! VPresPart) ** {s1 = [] ; lock_V = <>} ;
--
-- irreg4V x y z w = let reg = (regV x).s in
-- mk5V x (reg ! VPres) y z w ** {s1 = [] ; lock_V = <>} ;
--
-- irregDuplV fit y z =
-- let
-- fitting = (regDuplV fit).s ! VPresPart
-- in
-- mk5V fit (fit + "s") y z fitting ;
--
-- partV v p = verbPart v p ** {lock_V = <>} ;
-- reflV v = {s = v.s ; part = v.part ; lock_V = v.lock_V ; isRefl = True} ;
--
-- prepV2 v p = v ** {s = v.s ; s1 = v.s1 ; c2 = p.s ; lock_V2 = <>} ;
-- dirV2 v = prepV2 v noPrep ;
--
-- mkV3 v p q = v ** {s = v.s ; s1 = v.s1 ; c2 = p.s ; c3 = q.s ; lock_V3 = <>} ;
-- dirV3 v p = mkV3 v noPrep p ;
-- dirdirV3 v = dirV3 v noPrep ;
--
-- mkVS v = v ** {lock_VS = <>} ;
-- mkVV v = {
-- s = table {VVF vf => v.s ! vf ; _ => variants {}} ;
-- isAux = False ; lock_VV = <>
-- } ;
-- mkVQ v = v ** {lock_VQ = <>} ;
--
-- V0 : Type = V ;
---- V2S, V2V, V2Q : Type = V2 ;
-- AS, A2S, AV : Type = A ;
-- A2V : Type = A2 ;
--
-- mkV0 v = v ** {lock_V = <>} ;
-- mkV2S v p = prepV2 v p ** {lock_V2S = <>} ;
-- mkV2V v p t = prepV2 v p ** {isAux = False ; lock_V2V = <>} ;
-- mkVA v = v ** {lock_VA = <>} ;
-- mkV2A v p = prepV2 v p ** {lock_V2A = <>} ;
-- mkV2Q v p = prepV2 v p ** {lock_V2Q = <>} ;
--
-- mkAS v = v ** {lock_A = <>} ;
-- mkA2S v p = mkA2 v p ** {lock_A = <>} ;
-- mkAV v = v ** {lock_A = <>} ;
-- mkA2V v p = mkA2 v p ** {lock_A2 = <>} ;
--
--
---- pre-overload API and overload definitions
--
-- mk4N : (man,men,man's,men's : Str) -> N ;
-- regN : Str -> N ;
-- mk2N : (man,men : Str) -> N ;
-- genderN : Gender -> N -> N ;
-- compoundN : Str -> N -> N ;
--
-- mkN = overload {
-- mkN : (man,men,man's,men's : Str) -> N = mk4N ;
-- mkN : Str -> N = regN ;
-- mkN : (man,men : Str) -> N = mk2N ;
-- mkN : Gender -> N -> N = genderN ;
-- mkN : Str -> N -> N = compoundN
-- } ;
--
--
-- mk2A : (free,freely : Str) -> A ;
-- regA : Str -> A ;
--
-- mkA = overload {
-- mkA : Str -> A = regA ;
-- mkA : (fat,fatter : Str) -> A = \fat,fatter ->
-- mkAdjective fat fatter (init fatter + "st") (fat + "ly") ** {lock_A = <>} ;
-- mkA : (good,better,best,well : Str) -> A = \a,b,c,d ->
-- mkAdjective a b c d ** {lock_A = <>}
-- } ;
--
-- compoundA = compoundADeg ;
--
--
-- mk5V : (go, goes, went, gone, going : Str) -> V ;
-- regV : (cry : Str) -> V ;
-- reg2V : (stop, stopped : Str) -> V;
-- irregV : (drink, drank, drunk : Str) -> V ;
-- irreg4V : (run, ran, run, running : Str) -> V ;
--
-- -- Use reg2V instead
-- regDuplV : Str -> V ;
-- -- Use irreg4V instead
-- irregDuplV : (get, got, gotten : Str) -> V ;
--
-- mkV = overload {
-- mkV : (cry : Str) -> V = regV ;
-- mkV : (stop, stopped : Str) -> V = reg2V ;
-- mkV : (drink, drank, drunk : Str) -> V = irregV ;
-- mkV : (run, ran, run, running : Str) -> V = irreg4V ;
-- mkV : (go, goes, went, gone, going : Str) -> V = mk5V
-- };
--
-- prepV2 : V -> Prep -> V2 ;
-- dirV2 : V -> V2 ;
--
-- mkV2 = overload {
-- mkV2 : V -> Prep -> V2 = prepV2;
-- mkV2 : V -> V2 = dirV2
-- };
--
--
------ obsolete
--
---- Comparison adjectives may two more forms.
--
-- ADeg : Type ;
--
-- mkADeg : (good,better,best,well : Str) -> ADeg ;
--
---- The regular pattern recognizes two common variations:
---- "-e" ("rude" - "ruder" - "rudest") and
---- "-y" ("happy - happier - happiest - happily")
--
-- regADeg : Str -> ADeg ; -- long, longer, longest
--
---- However, the duplication of the final consonant is nor predicted,
---- but a separate pattern is used:
--
-- duplADeg : Str -> ADeg ; -- fat, fatter, fattest
--
---- If comparison is formed by "more", "most", as in general for
---- long adjective, the following pattern is used:
--
-- compoundADeg : A -> ADeg ; -- -/more/most ridiculous
--
---- From a given $ADeg$, it is possible to get back to $A$.
--
-- adegA : ADeg -> A ;
--
--
-- regPN : Str -> PN ;
-- regGenPN : Str -> Gender -> PN ; -- John, John's
--
---- Sometimes you can reuse a common noun as a proper name, e.g. "Bank".
--
-- nounPN : N -> PN ;
--
--
--
}

View File

@@ -0,0 +1,24 @@
concrete PhraseHin of Phrase = CatHin ** open Prelude, ResHin in {
--
-- lin
-- PhrUtt pconj utt voc = {s = pconj.s ++ utt.s ++ voc.s} ;
--
-- UttS s = s ;
-- UttQS qs = {s = qs.s ! QDir} ;
-- UttImpSg pol imp = {s = pol.s ++ imp.s ! contrNeg True pol.p ! ImpF Sg False} ;
-- UttImpPl pol imp = {s = pol.s ++ imp.s ! contrNeg True pol.p ! ImpF Pl False} ;
-- UttImpPol pol imp = {s = pol.s ++ imp.s ! contrNeg True pol.p ! ImpF Sg True} ;
--
-- UttIP ip = {s = ip.s ! Nom} ; --- Acc also
-- UttIAdv iadv = iadv ;
-- UttNP np = {s = np.s ! Nom} ;
-- UttVP vp = {s = infVP False vp (agrP3 Sg)} ;
-- UttAdv adv = adv ;
--
-- NoPConj = {s = []} ;
-- PConjConj conj = {s = conj.s2} ; ---
--
-- NoVoc = {s = []} ;
-- VocNP np = {s = "," ++ np.s ! Nom} ;
--
}

View File

@@ -0,0 +1,55 @@
concrete QuestionHin of Question = CatHin ** open ResHin, Prelude in {
--
-- flags optimize=all_subs ;
--
-- lin
--
-- QuestCl cl = {
-- s = \\t,a,p =>
-- let cls = cl.s ! t ! a ! p
-- in table {
-- QDir => cls ! OQuest ;
-- QIndir => "if" ++ cls ! ODir
-- } ---- "whether" in ExtHin
-- } ;
--
-- QuestVP qp vp =
-- let cl = mkClause (qp.s ! Nom) (agrP3 qp.n) 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 ExratHin
--
-- 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 ! Acc} ;
--
-- AdvIP ip adv = {
-- s = \\c => ip.s ! c ++ adv.s ;
-- n = ip.n
-- } ;
--
-- IdetCN idet cn = {
-- s = \\c => idet.s ++ cn.s ! idet.n ! c ;
-- n = idet.n
-- } ;
--
-- IdetIP idet = {
-- s = \\c => idet.s ;
-- n = idet.n
-- } ;
--
-- IdetQuant idet num = {
-- s = idet.s ! num.n ++ num.s ;
-- n = num.n
-- } ;
--
-- CompIAdv a = a ;
-- CompIP p = ss (p.s ! Nom) ;
--
}

View File

@@ -0,0 +1,54 @@
concrete RelativeHin of Relative = CatHin ** open ResHin 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 (fromAgr agr).g 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 $ExtraHin.gf$ ("that we are looking at",
---- "we are looking at").
--
-- RelSlash rp slash = {
-- s = \\t,a,p,agr =>
-- slash.c2 ++ rp.s ! RPrep (fromAgr agr).g ++ slash.s ! t ! a ! p ! ODir ;
-- c = Acc
-- } ;
--
-- FunRP p np rp = {
-- s = \\c => np.s ! Acc ++ p.s ++ rp.s ! RPrep (fromAgr np.a).g ;
-- a = RAg np.a
-- } ;
--
-- IdRP =
-- let varr : Str -> Str = \x -> variants {x ; "that"} --- for bwc
-- in {
-- s = table {
-- RC _ Gen => "whose" ;
-- RC Neutr _ => varr "which" ;
-- RC _ Acc => varr "whom" ;
-- RC _ Nom => varr "who" ;
-- RPrep Neutr => "which" ;
-- RPrep _ => "whom"
-- } ;
-- a = RNoAg
-- } ;
--
}

View File

@@ -0,0 +1,300 @@
--# -path=.:../abstract:../common:../../prelude
--
--1 Hindi auxiliary operations.
--
-- This module contains operations that are needed to make the
-- resource syntax work.
resource ResHin = ParamX ** open Prelude in {
flags optimize=all ;
param
Case = Dir | Obl | Voc ;
Gender = Masc | Fem ;
oper
Noun = {s : Number => Case => Str ; g : Gender} ;
mkNoun : (x1,_,_,_,_,x6 : Str) -> Gender -> Noun =
\sd,so,sv,pd,po,pv,g -> {
s = table Number [table Case [sd;so;sv] ; table Case [pd;po;pv]] ;
g = g
} ;
reggNoun : Str -> Gender -> Noun = \s,g -> case <s,g> of {
<-(_ + ("A" | "I")), Fem> =>
mkNoun s s s (s + "eM") (s + "oM") (s + "o") Fem ;
_ => regNoun s ** {g = g}
} ;
regNoun : Str -> Noun = \s -> case s of {
x + "iyA" =>
mkNoun s s s (x + "iyAM") (x + "iyoN") (x + "iyo") Fem ;
x + "A" =>
mkNoun s (x + "e") (x + "e") (x + "e") (x + "oN") (x + "o") Masc ;
x + "I" =>
mkNoun s s s (x + "iyAM") (x + "iyoN") (x + "iyo") Fem ;
_ =>
mkNoun s s s s (s + "oN") (s + "o") Masc
} ;
Adjective = {s : Gender => Number => Case => Str} ;
mkAdjective : (x1,x2,x3 : Str) -> Adjective = \smd,sm,f -> {
s = \\g,n,c => case <g,n,c> of {
<Masc,Sg,Dir> => smd ;
<Masc> => sm ;
_ => f
}
} ;
regAdjective : Str -> Adjective = \s -> case s of {
acch + "A" => mkAdjective s (acch + "e") (acch + "I") ;
_ => mkAdjective s s s
} ;
param
VForm =
VInf
| VStem
| VImpf Gender Number
| VPerf Gender Number
| VSubj Number Person
| VFut Number Person Gender
| VAbs
| VReq
| VImp
| VReqFut
;
oper
Verb = {s : VForm => Str} ;
mkVerb : (x1,_,_,_,_,_,_,_,_,_,_,_,_,_,x15 : Str) -> Verb =
\inf,stem,ims,imp,ifs,ifp,pms,pmp,pfs,pfp,ss1,ss2,sp2,sp3,r -> {
s =
let ga : Number -> Gender -> Str = \n,g ->
(regAdjective "gA").s ! g ! n ! Dir
in table {
VInf => inf ;
VStem => stem ;
VImpf Masc Sg => ims ;
VImpf Masc Pl => imp ;
VImpf Fem Sg => ifs ;
VImpf Fem Pl => ifp ;
VPerf Masc Sg => pms ;
VPerf Masc Pl => pmp ;
VPerf Fem Sg => pfs ;
VPerf Fem Pl => pfp ;
VSubj Sg P1 => ss1 ;
VSubj Sg _ => ss2 ;
VSubj Pl P2 => sp2 ;
VSubj Pl _ => sp3 ;
VFut Sg P1 g => ss1 + ga Sg g ;
VFut Sg _ g => ss2 + ga Sg g ;
VFut Pl P2 g => sp2 + ga Pl g ;
VFut Pl _ g => sp3 + ga Pl g ;
VAbs => stem + "kar" ; --- ke
VReq => r ;
VImp => sp2 ;
VReqFut => stem + "ie-gA"
}
} ;
regVerb : Str -> Verb = \cal ->
let caly : Str = case cal of {
_ + ("A" | "e") => cal + "y" ;
c + "U" => c + "uy" ;
c + "I" => c + "iy" ;
_ => cal
}
in
mkVerb
(cal + "nA") cal
(cal + "tA") (cal + "te") (cal + "tI") (cal + "tI")
(caly + "A") (caly + "e") (caly + "I") (caly + "IN")
(caly + "UM") (caly + "e") (caly + "o") (caly + "eN")
(caly + "ie-") ;
param
CTense = CPresent | CPast | CFuture ;
oper
copula : CTense -> Number -> Person -> Gender -> Str = \t,n,p,g ->
case <t,n,p,g> of {
<CPresent,Sg,P1,_ > => "hUM" ;
<CPresent,Sg,P2,_ > => "hE" ;
<CPresent,Sg,P3,_ > => "hE" ;
<CPresent,Pl,P1,_ > => "hEN" ;
<CPresent,Pl,P2,_ > => "ho" ;
<CPresent,Pl,P3,_ > => "hEN" ;
<CPast, Sg,_ ,Masc> => "TA" ;
<CPast, Sg,_ ,Fem > => "TI" ;
<CPast, Pl,_ ,Masc> => "Te" ;
<CPast, Pl,_ ,Fem > => "TIN" ;
<CFuture, Sg,P1,Masc> => "hUNgA" ;
<CFuture, Sg,P1,Fem > => "hUNgI" ;
<CFuture, Sg,_ ,Masc> => "hogA" ;
<CFuture, Sg,_ ,Fem > => "hogI" ;
<CFuture, Pl,P2,Masc> => "hoge" ;
<CFuture, Pl,_ ,Masc> => "hoNge" ;
<CFuture, Pl,P2,Fem > => "hogi:" ;
<CFuture, Pl,_ ,Fem > => "hoNgi:"
} ;
param
PronCase = PC Case | PObj | PPoss ;
oper
personalPronoun : Person -> Number -> {s : PronCase => Str} = \p,n ->
case <p,n> of {
<P1,Sg> => {s = table PronCase ["mEN" ; "muJ" ; "muJ" ; "muJe" ; "merA"]} ;
<P1,Pl> => {s = table PronCase ["ham" ; "ham" ; "ham" ; "hameN" ; "hamArA"]} ;
<P2,Sg> => {s = table PronCase ["tU" ; "tuJ" ; "tuJ" ; "tuJe" ; "terA"]} ;
<P2,Pl> => {s = table PronCase ["tum" ; "tum" ; "tum" ; "tum" ; "tumhArA"]} ;
<P3,Sg> => {s = table PronCase ["vah" ; "u-s" ; "u-s" ; "u-se" ; "u-skA"]} ;
<P3,Pl> => {s = table PronCase ["ve" ; "u-n" ; "u-n" ; "u-nheN" ; "u-nkA"]}
} ;
---- the third is the vocative - is it really this way?
-- the Hindi verb phrase
--- CTense = CPresent | CPast | CFuture ;
param
VPHTense =
VPGenPres -- impf hum nahim "I go"
| VPImpPast -- impf Ta nahim "I went"
| VPContPres -- stem raha hum nahim "I am going"
| VPContPast -- stem raha Ta nahim "I was going"
| VPPerf -- perf na/nahim "I went"
| VPPerfPres -- perf hum na/nahim "I have gone"
| VPPerfPast -- perf Ta na/nahim "I had gone"
| VPSubj -- subj na "I may go"
| VPFut -- fut na/nahim "I shall go"
;
VPHForm =
VPTense VPHTense Agr -- 9 * 12
| VPReq
| VPImp
| VPReqFut
| VPInf
| VPStem
;
VType = VIntrans | VTrans | VTransPost ;
oper
objVType : VType -> NPCase = \vt -> case vt of {
VTrans => NPObj ;
_ => NPC Obl
} ;
VPH : Type = {
s : Bool => VPHForm => {fin, inf, neg : Str} ;
obj : {s : Str ; a : Agr} ;
subj : VType ;
comp : Agr => Str
} ;
predV : Verb -> VPH = \verb -> {
s = \\b,vh =>
let
na = if_then_Str b [] "na" ;
nahim = if_then_Str b [] "nahIN" ;
in
case vh of {
VPTense VPGenPres (Ag g n p) =>
{fin = copula CPresent n p g ; inf = verb.s ! VImpf g n ; neg = nahim} ;
VPTense VPImpPast (Ag g n p) =>
{fin = copula CPast n p g ; inf = verb.s ! VImpf g n ; neg = nahim} ;
VPTense VPContPres (Ag g n p) =>
{fin = copula CPresent n p g ;
inf = verb.s ! VStem ++ raha g n ; neg = nahim} ;
VPTense VPContPast (Ag g n p) =>
{fin = copula CPast n p g ;
inf = verb.s ! VStem ++ raha g n ; neg = nahim} ;
VPTense VPPerf (Ag g n _) =>
{fin = verb.s ! VPerf g n ; inf = [] ; neg = nahim} ;
VPTense VPPerfPres (Ag g n p) =>
{fin = copula CPresent n p g ; inf = verb.s ! VPerf g n ; neg = nahim} ;
VPTense VPPerfPast (Ag g n p) =>
{fin = copula CPast n p g ; inf = verb.s ! VPerf g n ; neg = nahim} ;
VPTense VPSubj (Ag _ n p) => {fin = verb.s ! VSubj n p ; inf = [] ; neg = na} ;
VPTense VPFut (Ag g n p) => {fin = verb.s ! VFut n p g ; inf = [] ; neg = na} ;
VPInf => {fin = verb.s ! VStem ; inf = [] ; neg = na} ;
_ => {fin = verb.s ! VStem ; inf = [] ; neg = na} ----
} ;
obj = {s = [] ; a = defaultAgr} ;
subj = VIntrans ;
comp = \\_ => []
} ;
raha : Gender -> Number -> Str = \g,n ->
(regAdjective "rahA").s ! g ! n ! Dir ;
VPHSlash = VPH ** {c2 : Compl} ;
Clause : Type = {s : VPHTense => Bool => Str} ;
Compl : Type = {s : Str ; c : VType} ;
insertObject : NP -> VPHSlash -> VPH = \np,vps -> {
s = vps.s ;
obj = {s = vps.obj.s ++ np.s ! objVType vps.c2.c ++ vps.c2.s ; a = np.a} ;
subj = vps.c2.c ;
comp = vps.comp
} ;
param
Agr = Ag Gender Number Person ;
NPCase = NPC Case | NPObj | NPErg ;
oper
agrP3 : Gender -> Number -> Agr = \g,n -> Ag g n P3 ;
defaultAgr : Agr = agrP3 Masc Sg ;
npcase2case : NPCase -> Case = \npc -> case npc of {
NPC c => c ;
NPObj => Obl ;
NPErg => Obl
} ;
np2pronCase : NPCase -> PronCase = \np -> case np of {
NPC c => PC c ;
NPObj => PObj ;
NPErg => PC Obl
} ;
toNP : (Case => Str) -> NPCase -> Str = \pn, npc -> case npc of {
NPC c => pn ! c ;
NPObj => pn ! Obl ;
NPErg => pn ! Obl ++ "ne"
} ;
NP : Type = {s : NPCase => Str ; a : Agr} ;
mkClause : NP -> VPH -> Clause = \np,vp -> {
s = \\vt,b =>
let
subjagr : NPCase * Agr = case vt of {
VPPerf => case vp.subj of {
VTrans => <NPErg, vp.obj.a> ;
VTransPost => <NPErg, defaultAgr> ;
_ => <NPC Dir, np.a>
} ;
_ => <NPC Dir, np.a>
} ;
subj = subjagr.p1 ;
agr = subjagr.p2 ;
vps = vp.s ! b ! VPTense vt agr ;
in
np.s ! subj ++ vp.obj.s ++ vp.comp ! np.a ++ vps.neg ++ vps.inf ++ vps.fin
} ;
}

View File

@@ -0,0 +1,66 @@
concrete SentenceHin of Sentence = CatHin ** open Prelude, ResHin in {
flags optimize=all_subs ;
lin
PredVP np vp = mkClause np vp ;
-- PredSCVP sc vp = mkClause sc.s (agrP3 Sg) vp ;
--
-- ImpVP vp = {
-- s = \\pol,n =>
-- let
-- agr = AgP2 (numImp n) ;
-- verb = infVP True vp agr ;
-- dont = case pol of {
-- CNeg True => "don't" ;
-- CNeg False => "do" ++ "not" ;
-- _ => []
-- }
-- in
-- dont ++ verb
-- } ;
--
-- SlashVP np vp =
-- mkClause (np.s ! Nom) np.a vp ** {c2 = vp.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} ;
--
-- SlashVS np vs slash =
-- mkClause (np.s ! Nom) np.a
-- (insertObj (\\_ => conjThat ++ slash.s) (predV vs)) **
-- {c2 = slash.c2} ;
--
-- EmbedS s = {s = conjThat ++ s.s} ;
-- EmbedQS qs = {s = qs.s ! QIndir} ;
-- EmbedVP vp = {s = infVP False vp (agrP3 Sg)} ; --- agr
--
-- UseCl t a p cl = {
-- s = t.s ++ a.s ++ p.s ++ cl.s ! t.t ! a.a ! ctr p.p ! ODir
-- } ;
-- UseQCl t a p cl = {
-- s = \\q => t.s ++ a.s ++ p.s ++ cl.s ! t.t ! a.a ! ctr p.p ! q
-- } ;
-- 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
-- } ;
-- UseSlash t a p cl = {
-- s = t.s ++ a.s ++ p.s ++ cl.s ! t.t ! a.a ! ctr p.p ! ODir ;
-- c2 = cl.c2
-- } ;
--
-- AdvS a s = {s = a.s ++ "," ++ s.s} ;
--
-- RelS s r = {s = s.s ++ "," ++ r.s ! agrP3 Sg} ;
--
-- oper
-- ctr = contrNeg True ; -- contracted negations
--
}

View File

@@ -0,0 +1,132 @@
concrete StructuralHin of Structural = CatHin **
open MorphoHin, (P = ParadigmsHin), Prelude in {
flags optimize=all ;
lin
-- above_Prep = ss "above" ;
-- after_Prep = ss "after" ;
-- all_Predet = ss "all" ;
-- almost_AdA, almost_AdN = ss "almost" ;
-- although_Subj = ss "although" ;
-- always_AdV = ss "always" ;
-- and_Conj = sd2 [] "and" ** {n = Pl} ;
-----b and_Conj = ss "and" ** {n = Pl} ;
-- because_Subj = ss "because" ;
-- before_Prep = ss "before" ;
-- behind_Prep = ss "behind" ;
-- between_Prep = ss "between" ;
-- both7and_DConj = sd2 "both" "and" ** {n = Pl} ;
-- but_PConj = ss "but" ;
-- by8agent_Prep = ss "by" ;
-- by8means_Prep = ss "by" ;
-- can8know_VV, can_VV = {
-- s = table {
-- VVF VInf => ["be able to"] ;
-- VVF VPres => "can" ;
-- VVF VPPart => ["been able to"] ;
-- VVF VPresPart => ["being able to"] ;
-- VVF VPast => "could" ; --# notpresent
-- VVPastNeg => "couldn't" ; --# notpresent
-- VVPresNeg => "can't"
-- } ;
-- isAux = True
-- } ;
-- during_Prep = ss "during" ;
-- either7or_DConj = sd2 "either" "or" ** {n = Sg} ;
-- everybody_NP = regNP "everybody" Sg ;
-- every_Det = mkDeterminer Sg "every" ;
-- everything_NP = regNP "everything" Sg ;
-- everywhere_Adv = ss "everywhere" ;
-- few_Det = mkDeterminer Pl "few" ;
----- first_Ord = ss "first" ; DEPRECATED
-- for_Prep = ss "for" ;
-- from_Prep = ss "from" ;
he_Pron = personalPronoun P3 Sg ** {a = Ag Masc Sg P3} ;
-- here_Adv = ss "here" ;
-- here7to_Adv = ss ["to here"] ;
-- here7from_Adv = ss ["from here"] ;
-- how_IAdv = ss "how" ;
-- how8many_IDet = mkDeterminer Pl ["how many"] ;
-- if_Subj = ss "if" ;
-- in8front_Prep = ss ["in front of"] ;
i_Pron = personalPronoun P1 Sg ** {a = Ag Masc Sg P1} ;
in_Prep = ss "meN" ;
-- it_Pron = mkNP "it" "it" "its" Sg P3 Neutr ;
-- less_CAdv = ss "less" ;
-- many_Det = mkDeterminer Pl "many" ;
-- more_CAdv = ss "more" ;
-- most_Predet = ss "most" ;
-- much_Det = mkDeterminer Sg "much" ;
-- must_VV = {
-- s = table {
-- VVF VInf => ["have to"] ;
-- VVF VPres => "must" ;
-- VVF VPPart => ["had to"] ;
-- VVF VPresPart => ["having to"] ;
-- VVF VPast => ["had to"] ; --# notpresent
-- VVPastNeg => ["hadn't to"] ; --# notpresent
-- VVPresNeg => "mustn't"
-- } ;
-- isAux = True
-- } ;
-----b no_Phr = ss "no" ;
-- no_Utt = ss "no" ;
-- on_Prep = ss "on" ;
------ one_Quant = mkDeterminer Sg "one" ; -- DEPRECATED
-- only_Predet = ss "only" ;
-- or_Conj = sd2 [] "or" ** {n = Sg} ;
-- otherwise_PConj = ss "otherwise" ;
-- part_Prep = ss "of" ;
-- please_Voc = ss "please" ;
-- possess_Prep = ss "of" ;
-- quite_Adv = ss "quite" ;
-- she_Pron = mkNP "she" "her" "her" Sg P3 Fem ;
-- so_AdA = ss "so" ;
-- somebody_NP = regNP "somebody" Sg ;
-- someSg_Det = mkDeterminer Sg "some" ;
-- somePl_Det = mkDeterminer Pl "some" ;
-- something_NP = regNP "something" Sg ;
-- somewhere_Adv = ss "somewhere" ;
-- that_Quant = mkQuant "that" "those" ;
-- there_Adv = ss "there" ;
-- there7to_Adv = ss "there" ;
-- there7from_Adv = ss ["from there"] ;
-- therefore_PConj = ss "therefore" ;
-- they_Pron = mkNP "they" "them" "their" Pl P3 Masc ; ----
-- this_Quant = mkQuant "this" "these" ;
-- through_Prep = ss "through" ;
-- too_AdA = ss "too" ;
-- to_Prep = ss "to" ;
-- under_Prep = ss "under" ;
-- very_AdA = ss "very" ;
-- want_VV = P.mkVV (P.regV "want") ;
we_Pron = personalPronoun P1 Pl ** {a = Ag Masc Pl P1} ;
-- whatPl_IP = mkIP "what" "what" "what's" Sg ;
-- whatSg_IP = mkIP "what" "what" "what's" Sg ;
-- when_IAdv = ss "when" ;
-- when_Subj = ss "when" ;
-- where_IAdv = ss "where" ;
-- which_IQuant = {s = \\_ => "which"} ;
-----b whichPl_IDet = mkDeterminer Pl ["which"] ;
-----b whichSg_IDet = mkDeterminer Sg ["which"] ;
-- whoSg_IP = mkIP "who" "whom" "whose" Sg ;
-- whoPl_IP = mkIP "who" "whom" "whose" Pl ;
-- why_IAdv = ss "why" ;
-- without_Prep = ss "without" ;
-- with_Prep = ss "with" ;
-----b yes_Phr = ss "yes" ;
-- yes_Utt = ss "yes" ;
-- youSg_Pron = mkNP "you" "you" "your" Sg P2 Masc ;
-- youPl_Pron = mkNP "you" "you" "your" Pl P2 Masc ;
-- youPol_Pron = mkNP "you" "you" "your" Sg P2 Masc ;
--
--
--oper
-- mkQuant : Str -> Str -> {s : Number => Str} = \x,y -> {
-- s = table Number [x ; y]
-- } ;
--
}
--

View File

@@ -0,0 +1,50 @@
concrete VerbHin of Verb = CatHin ** open ResHin in {
flags optimize=all_subs ;
lin
UseV = predV ;
SlashV2a v = predV v ** {c2 = v.c2} ;
-- Slash2V3 v np =
-- insertObjc (\\_ => v.c2 ++ np.s ! Acc) (predV v ** {c2 = v.c3}) ;
-- Slash3V3 v np =
-- insertObjc (\\_ => v.c3 ++ np.s ! Acc) (predVc v) ; ----
--
-- ComplVV v vp = insertObj (\\a => infVP v.isAux vp a) (predVV v) ;
-- 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) ;
--
-- SlashV2V v vp = insertObjc (\\a => infVP v.isAux vp a) (predVc v) ;
-- SlashV2S v s = insertObjc (\\_ => conjThat ++ s.s) (predVc v) ;
-- SlashV2Q v q = insertObjc (\\_ => q.s ! QIndir) (predVc v) ;
-- SlashV2A v ap = insertObjc (\\a => ap.s ! a) (predVc v) ; ----
ComplSlash vp np = insertObject np vp ;
-- SlashVV vv vp =
-- insertObj (\\a => infVP vv.isAux vp a) (predVV vv) **
-- {c2 = vp.c2} ;
-- SlashV2VNP vv np vp =
-- insertObjPre (\\_ => vp.c2 ++ np.s ! Acc)
-- (insertObjc (\\a => infVP vv.isAux vp a) (predVc vv)) **
-- {c2 = vp.c2} ;
--
-- UseComp comp = insertComplement comp.s (predAux auxBe) ;
--
-- AdvVP vp adv = insertObj (\\_ => adv.s) vp ;
--
-- AdVVP adv vp = insertAdV adv.s vp ;
--
-- ReflVP v = insertObjPre (\\a => v.c2 ++ reflPron ! a) v ;
--
-- PassV2 v = insertObj (\\_ => v.s ! VPPart) (predAux auxBe) ;
--
--
-- CompAP ap = ap ;
-- CompNP np = {s = \\_ => np.s ! Acc} ;
-- CompAdv a = {s = \\_ => a.s} ;
--
}

View File

@@ -0,0 +1,36 @@
concrete AdjectiveTha of Adjective = CatTha ** open ResTha, Prelude in {
lin
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 ;
--
}

View File

@@ -0,0 +1,23 @@
concrete AdverbTha of Adverb = CatTha **
open ResTha, StringsTha, Prelude in {
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"} ;
--
}

View File

@@ -0,0 +1,3 @@
--# -path=.:../abstract:../common:prelude
concrete AllTha of AllThaAbs = LangTha ;

View File

@@ -0,0 +1,3 @@
--# -path=.:../abstract:../common:prelude
abstract AllThaAbs = Lang ;

View File

@@ -0,0 +1,77 @@
concrete CatTha of Cat = CommonX ** open ResTha, Prelude in {
flags optimize=all_subs ;
lincat
-- Tensed/Untensed
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
-- } ;
Imp = {s : Polarity => Str} ;
--
---- 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
--
VP = ResTha.VP ;
Comp = ResTha.VP ;
--
---- Adjective
--
-- AP = {s : Agr => Str ; isPre : Bool} ;
--
-- Noun
--
CN = Noun ;
NP, Pron = SS ;
Det = Determiner ;
-- Predet, Ord = {s : Str} ;
Num, Quant = {s : Str ; hasC : Bool} ;
-- Numeral
Numeral = {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} ;
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} ;
--
}

View File

@@ -0,0 +1,45 @@
--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} ;
--
--}

View File

@@ -0,0 +1,52 @@
--concrete ExtraTha of ExtraThaAbs = CatTha **
-- open ResTha, Coordination, Prelude in {
--
-- lin
-- GenNP np = {s = \\_ => np.s ! Gen} ;
-- ComplBareVS v s = insertObj (\\_ => s.s) (predV v) ;
--
-- StrandRelSlash rp slash = {
-- s = \\t,a,p,_ => rp.s ! RC Acc ++ slash.s ! t ! a ! p ! ODir ++ slash.c2 ;
-- c = Acc
-- } ;
-- EmptyRelSlash rp slash = {
-- s = \\t,a,p,_ => slash.s ! t ! a ! p ! ODir ++ slash.c2 ;
-- c = Acc
-- } ;
--
-- StrandQuestSlash ip slash =
-- {s = \\t,a,b,q =>
-- (mkQuestion (ss (ip.s ! Acc)) slash).s ! t ! a ! b ! q ++ slash.c2
-- };
--
-- lincat
-- VPI = {s : VPIForm => Agr => Str} ;
-- [VPI] = {s1,s2 : VPIForm => Agr => Str} ;
--
-- lin
-- BaseVPI = twoTable2 VPIForm Agr ;
-- ConsVPI = consrTable2 VPIForm Agr comma ;
--
-- MkVPI vp = {
-- s = \\v,a => vp.ad ++ vp.inf ++ vp.s2 ! a
-- } ;
-- ConjVPI = conjunctTable2 VPIForm Agr ;
-- ComplVPIVV vv vpi =
-- insertObj (\\a => (if_then_Str vv.isAux [] "to") ++ vpi.s ! VPIInf ! a) (predVV vv) ;
--
-- UncNegCl t a cl = {s = t.s ++ a.s ++ cl.s ! t.t ! a.a ! neg ! ODir} ;
-- UncNegQCl t a cl = {s = \\q => t.s ++ a.s ++ cl.s ! t.t ! a.a ! neg !q} ;
-- UncNegRCl t a cl = {
-- s = \\r => t.s ++ a.s ++ cl.s ! t.t ! a.a ! neg ! r ;
-- c = cl.c
-- } ;
-- UncNegImpSg imp = {s = imp.s ! neg ! ImpF Sg False} ;
-- UncNegImpPl imp = {s = imp.s ! neg ! ImpF Pl False} ;
--
-- CompoundCN a b = {s = \\n,c => a.s ! Sg ! Nom ++ b.s ! n ! c} ;
--
--
-- oper
-- neg = CNeg False ;
--
--}

View File

@@ -0,0 +1,21 @@
--# -path=.:../abstract:../common:prelude
concrete GrammarTha of Grammar =
NounTha,
VerbTha,
AdjectiveTha,
AdverbTha,
NumeralTha,
SentenceTha,
QuestionTha,
-- RelativeTha,
-- ConjunctionTha,
PhraseTha,
-- TextX,
StructuralTha,
-- IdiomTha
** {
flags startcat = Phr ; unlexer = text ; lexer = text ;
} ;

View File

@@ -0,0 +1,30 @@
--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}} ;
--
--}
--

View File

@@ -0,0 +1,181 @@
----# -path=.:prelude:../abstract:../common
--
--concrete IrregTha of IrregThaAbs = CatTha ** open ParadigmsTha in {
--
--flags optimize=values ;
--
-- lin
-- awake_V = irregV "awake" "awoke" "awoken" ;
-- bear_V = irregV "bear" "bore" "born" ;
-- beat_V = irregV "beat" "beat" "beat" ;
-- become_V = irregV "become" "became" "become" ;
-- begin_V = irregV "begin" "began" "begun" ;
-- bend_V = irregV "bend" "bent" "bent" ;
-- beset_V = irregV "beset" "beset" "beset" ;
-- bet_V = irregDuplV "bet" "bet" "bet" ;
-- bid_V = irregDuplV "bid" (variants {"bid" ; "bade"}) (variants {"bid" ; "bidden"}) ;
-- bind_V = irregV "bind" "bound" "bound" ;
-- bite_V = irregV "bite" "bit" "bitten" ;
-- bleed_V = irregV "bleed" "bled" "bled" ;
-- blow_V = irregV "blow" "blew" "blown" ;
-- break_V = irregV "break" "broke" "broken" ;
-- breed_V = irregV "breed" "bred" "bred" ;
-- bring_V = irregV "bring" "brought" "brought" ;
-- broadcast_V = irregV "broadcast" "broadcast" "broadcast" ;
-- build_V = irregV "build" "built" "built" ;
-- burn_V = irregV "burn" (variants {"burned" ; "burnt"}) (variants {"burned" ; "burnt"}) ;
-- burst_V = irregV "burst" "burst" "burst" ;
-- buy_V = irregV "buy" "bought" "bought" ;
-- cast_V = irregV "cast" "cast" "cast" ;
-- catch_V = irregV "catch" "caught" "caught" ;
-- choose_V = irregV "choose" "chose" "chosen" ;
-- cling_V = irregV "cling" "clung" "clung" ;
-- come_V = irregV "come" "came" "come" ;
-- cost_V = irregV "cost" "cost" "cost" ;
-- creep_V = irregV "creep" "crept" "crept" ;
-- cut_V = irregDuplV "cut" "cut" "cut" ;
-- deal_V = irregV "deal" "dealt" "dealt" ;
-- dig_V = irregDuplV "dig" "dug" "dug" ;
-- dive_V = irregV "dive" (variants {"dived" ; "dove"}) "dived" ;
-- do_V = mkV "do" "does" "did" "done" "doing" ;
-- draw_V = irregV "draw" "drew" "drawn" ;
-- dream_V = irregV "dream" (variants {"dreamed" ; "dreamt"}) (variants {"dreamed" ; "dreamt"}) ;
-- drive_V = irregV "drive" "drove" "driven" ;
-- drink_V = irregV "drink" "drank" "drunk" ;
-- eat_V = irregV "eat" "ate" "eaten" ;
-- fall_V = irregV "fall" "fell" "fallen" ;
-- feed_V = irregV "feed" "fed" "fed" ;
-- feel_V = irregV "feel" "felt" "felt" ;
-- fight_V = irregV "fight" "fought" "fought" ;
-- find_V = irregV "find" "found" "found" ;
-- fit_V = irregDuplV "fit" "fit" "fit" ;
-- flee_V = irregV "flee" "fled" "fled" ;
-- fling_V = irregV "fling" "flung" "flung" ;
-- fly_V = irregV "fly" "flew" "flown" ;
-- forbid_V = irregDuplV "forbid" "forbade" "forbidden" ;
-- forget_V = irregDuplV "forget" "forgot" "forgotten" ;
-- forgive_V = irregV "forgive" "forgave" "forgiven" ;
-- forsake_V = irregV "forsake" "forsook" "forsaken" ;
-- freeze_V = irregV "freeze" "froze" "frozen" ;
-- get_V = irregDuplV "get" "got" "gotten" ;
-- give_V = irregV "give" "gave" "given" ;
-- go_V = mkV "go" "goes" "went" "gone" "going" ;
-- grind_V = irregV "grind" "ground" "ground" ;
-- grow_V = irregV "grow" "grew" "grown" ;
-- hang_V = irregV "hang" "hung" "hung" ;
-- have_V = mkV "have" "has" "had" "had" "having" ;
-- hear_V = irregV "hear" "heard" "heard" ;
-- hide_V = irregV "hide" "hid" "hidden" ;
-- hit_V = irregDuplV "hit" "hit" "hit" ;
-- hold_V = irregV "hold" "held" "held" ;
-- hurt_V = irregV "hurt" "hurt" "hurt" ;
-- keep_V = irregV "keep" "kept" "kept" ;
-- kneel_V = irregV "kneel" "knelt" "knelt" ;
-- knit_V = irregDuplV "knit" "knit" "knit" ;
-- know_V = irregV "know" "knew" "know" ;
-- lay_V = irregV "lay" "laid" "laid" ;
-- lead_V = irregV "lead" "led" "led" ;
-- leap_V = irregV "leap" (variants {"leaped" ; "lept"}) (variants {"leaped" ; "lept"}) ;
-- learn_V = irregV "learn" (variants {"learned" ; "learnt"}) (variants {"learned" ; "learnt"}) ;
-- leave_V = irregV "leave" "left" "left" ;
-- lend_V = irregV "lend" "lent" "lent" ;
-- let_V = irregDuplV "let" "let" "let" ;
-- lie_V = irregV "lie" "lay" "lain" ;
-- light_V = irregV "light" (variants {"lighted" ; "lit"}) "lighted" ;
-- lose_V = irregV "lose" "lost" "lost" ;
-- make_V = irregV "make" "made" "made" ;
-- mean_V = irregV "mean" "meant" "meant" ;
-- meet_V = irregV "meet" "met" "met" ;
-- misspell_V = irregV "misspell" (variants {"misspelled" ; "misspelt"}) (variants {"misspelled" ; "misspelt"}) ;
-- mistake_V = irregV "mistake" "mistook" "mistaken" ;
-- mow_V = irregV "mow" "mowed" (variants {"mowed" ; "mown"}) ;
-- overcome_V = irregV "overcome" "overcame" "overcome" ;
-- overdo_V = mkV "overdo" "overdoes" "overdid" "overdone" "overdoing" ;
-- overtake_V = irregV "overtake" "overtook" "overtaken" ;
-- overthrow_V = irregV "overthrow" "overthrew" "overthrown" ;
-- pay_V = irregV "pay" "paid" "paid" ;
-- plead_V = irregV "plead" "pled" "pled" ;
-- prove_V = irregV "prove" "proved" (variants {"proved" ; "proven"}) ;
-- put_V = irregDuplV "put" "put" "put" ;
-- quit_V = irregDuplV "quit" "quit" "quit" ;
-- read_V = irregV "read" "read" "read" ;
-- rid_V = irregDuplV "rid" "rid" "rid" ;
-- ride_V = irregV "ride" "rode" "ridden" ;
-- ring_V = irregV "ring" "rang" "rung" ;
-- rise_V = irregV "rise" "rose" "risen" ;
-- run_V = irregDuplV "run" "ran" "run" ;
-- saw_V = irregV "saw" "sawed" (variants {"sawed" ; "sawn"}) ;
-- say_V = irregV "say" "said" "said" ;
-- see_V = irregV "see" "saw" "seen" ;
-- seek_V = irregV "seek" "sought" "sought" ;
-- sell_V = irregV "sell" "sold" "sold" ;
-- send_V = irregV "send" "sent" "sent" ;
-- set_V = irregDuplV "set" "set" "set" ;
-- sew_V = irregV "sew" "sewed" (variants {"sewed" ; "sewn"}) ;
-- shake_V = irregV "shake" "shook" "shaken" ;
-- shave_V = irregV "shave" "shaved" (variants {"shaved" ; "shaven"}) ;
-- shear_V = irregV "shear" "shore" "shorn" ;
-- shed_V = irregDuplV "shed" "shed" "shed" ;
-- shine_V = irregV "shine" "shone" "shone" ;
-- shoe_V = irregV "shoe" "shoed" (variants {"shoed" ; "shod"}) ;
-- shoot_V = irregV "shoot" "shot" "shot" ;
-- show_V = irregV "show" "showed" (variants {"showed" ; "shown"}) ;
-- shrink_V = irregV "shrink" "shrank" "shrunk" ;
-- shut_V = irregDuplV "shut" "shut" "shut" ;
-- sing_V = irregV "sing" "sang" "sung" ;
-- sink_V = irregV "sink" "sank" "sunk" ;
-- sit_V = irregDuplV "sit" "sat" "sat" ;
-- sleep_V = irregV "sleep" "slept" "slept" ;
-- slay_V = irregV "slay" "slew" "slain" ;
-- slide_V = irregV "slide" "slid" "slid" ;
-- sling_V = irregV "sling" "slung" "slung" ;
-- slit_V = irregDuplV "slit" "slit" "slit" ;
-- smite_V = irregV "smite" "smote" "smitten" ;
-- sow_V = irregV "sow" "sowed" (variants {"sowed" ; "sown"}) ;
-- speak_V = irregV "speak" "spoke" "spoken" ;
-- speed_V = irregV "speed" "sped" "sped" ;
-- spend_V = irregV "spend" "spent" "spent" ;
-- spill_V = irregV "spill" (variants {"spilled" ; "spilt"}) (variants {"spilled" ; "spilt"}) ;
-- spin_V = irregDuplV "spin" "spun" "spun" ;
-- spit_V = irregDuplV "spit" (variants {"spit" ; "spat"}) "spit" ;
-- split_V = irregDuplV "split" "split" "split" ;
-- spread_V = irregV "spread" "spread" "spread" ;
-- spring_V = irregV "spring" (variants {"sprang" ; "sprung"}) "sprung" ;
-- stand_V = irregV "stand" "stood" "stood" ;
-- steal_V = irregV "steal" "stole" "stolen" ;
-- stick_V = irregV "stick" "stuck" "stuck" ;
-- sting_V = irregV "sting" "stung" "stung" ;
-- stink_V = irregV "stink" "stank" "stunk" ;
-- stride_V = irregV "stride" "strod" "stridden" ;
-- strike_V = irregV "strike" "struck" "struck" ;
-- string_V = irregV "string" "strung" "strung" ;
-- strive_V = irregV "strive" "strove" "striven" ;
-- swear_V = irregV "swear" "swore" "sworn" ;
-- sweep_V = irregV "sweep" "swept" "swept" ;
-- swell_V = irregV "swell" "swelled" (variants {"swelled" ; "swollen"}) ;
-- swim_V = irregDuplV "swim" "swam" "swum" ;
-- swing_V = irregV "swing" "swung" "swung" ;
-- take_V = irregV "take" "took" "taken" ;
-- teach_V = irregV "teach" "taught" "taught" ;
-- tear_V = irregV "tear" "tore" "torn" ;
-- tell_V = irregV "tell" "told" "told" ;
-- think_V = irregV "think" "thought" "thought" ;
-- thrive_V = irregV "thrive" (variants {"thrived" ; "throve"}) "thrived" ;
-- throw_V = irregV "throw" "threw" "thrown" ;
-- thrust_V = irregV "thrust" "thrust" "thrust" ;
-- tread_V = irregV "tread" "trod" "trodden" ;
-- understand_V = irregV "understand" "understood" "understood" ;
-- uphold_V = irregV "uphold" "upheld" "upheld" ;
-- upset_V = irregDuplV "upset" "upset" "upset" ;
-- wake_V = irregV "wake" "woke" "woken" ;
-- wear_V = irregV "wear" "wore" "worn" ;
-- weave_V = irregV "weave" (variants {"weaved" ; "wove"}) (variants {"weaved" ; "woven"}) ;
-- wed_V = irregDuplV "wed" "wed" "wed" ;
-- weep_V = irregV "weep" "wept" "wept" ;
-- wind_V = irregV "wind" "wound" "wound" ;
-- win_V = irregDuplV "win" "won" "won" ;
-- withhold_V = irregV "withhold" "withheld" "withheld" ;
-- withstand_V = irregV "withstand" "withstood" "withstood" ;
-- wring_V = irregV "wring" "wrung" "wrung" ;
-- write_V = irregV "write" "wrote" "written" ;
--}

View File

@@ -0,0 +1,10 @@
--# -path=.:../abstract:../common:prelude
concrete LangTha of Lang =
GrammarTha,
LexiconTha
** {
flags startcat = Phr ; unlexer = concat ; lexer = text ;
} ;

View File

@@ -0,0 +1,368 @@
--# -path=.:prelude
concrete LexiconTha of Lexicon = CatTha **
open StringsTha, ResTha, Prelude in {
flags
optimize=values ;
lin
-- airplane_N = regN "airplane" ;
-- answer_V2S = mkV2S (regV "answer") toP ;
-- apartment_N = regN "apartment" ;
-- apple_N = regN "apple" ;
-- art_N = regN "art" ;
-- ask_V2Q = mkV2Q (regV "ask") noPrep ;
-- baby_N = regN "baby" ;
-- bad_A = mkADeg "bad" "badly" "worse" "worst" ;
-- bank_N = regN "bank" ;
-- beautiful_A = regADeg "beautiful" ;
-- become_VA = mkVA (irregV "become" "became" "become") ;
beer_N = mkN biar_s kew_s ;
-- beg_V2V = mkV2V (regDuplV "beg") noPrep toP ;
big_A = ss yay_s ;
-- bike_N = regN "bike" ;
-- bird_N = regN "bird" ;
-- black_A = regADeg "black" ;
-- blue_A = regADeg "blue" ;
-- boat_N = regN "boat" ;
book_N = mkN (nag_s ++ svv_s) lem_s ;
-- boot_N = regN "boot" ;
-- boss_N = regN "boss" ;
-- boy_N = regN "boy" ;
-- bread_N = regN "bread" ;
-- break_V2 = dirV2 (irregV "break" "broke" "broken") ;
-- broad_A = regADeg "broad" ;
-- brother_N2 = regN2 "brother" ;
-- brown_A = regADeg "brown" ;
-- butter_N = regN "butter" ;
-- buy_V2 = dirV2 (irregV "buy" "bought" "bought") ;
-- camera_N = regN "camera" ;
-- cap_N = regN "cap" ;
-- car_N = regN "car" ;
-- carpet_N = regN "carpet" ;
-- cat_N = regN "cat" ;
-- ceiling_N = regN "ceiling" ;
-- chair_N = regN "chair" ;
-- cheese_N = regN "cheese" ;
-- child_N = mk2N "child" "children" ;
-- church_N = regN "church" ;
-- city_N = regN "city" ;
-- clean_A = regADeg "clean" ;
-- clever_A = regADeg "clever" ;
-- close_V2 = dirV2 (regV "close") ;
-- coat_N = regN "coat" ;
-- cold_A = regADeg "cold" ;
-- come_V = (irregV "come" "came" "come") ;
-- computer_N = regN "computer" ;
-- country_N = regN "country" ;
-- cousin_N = regN "cousin" ;
-- cow_N = regN "cow" ;
-- die_V = (regV "die") ;
-- dirty_A = regADeg "dirty" ;
-- distance_N3 = mkN3 (regN "distance") fromP toP ;
-- doctor_N = regN "doctor" ;
-- dog_N = regN "dog" ;
-- door_N = regN "door" ;
drink_V2 = dirV2 (regV dvm_s) ;
-- easy_A2V = mkA2V (regA "easy") forP ;
-- eat_V2 = dirV2 (irregV "eat" "ate" "eaten") ;
-- empty_A = regADeg "empty" ;
-- enemy_N = regN "enemy" ;
-- factory_N = regN "factory" ;
-- father_N2 = regN2 "father" ;
-- fear_VS = mkVS (regV "fear") ;
-- find_V2 = dirV2 (irregV "find" "found" "found") ;
-- fish_N = mk2N "fish" "fish" ;
-- floor_N = regN "floor" ;
-- forget_V2 = dirV2 (irregDuplV "forget" "forgot" "forgotten") ;
-- fridge_N = regN "fridge" ;
-- friend_N = regN "friend" ;
-- fruit_N = regN "fruit" ;
-- fun_AV = mkAV (regA "fun") ;
-- garden_N = regN "garden" ;
-- girl_N = regN "girl" ;
-- glove_N = regN "glove" ;
-- gold_N = regN "gold" ;
-- good_A = mkADeg "good" "well" "better" "best" ;
go_V = regV pay_s ;
-- green_A = regADeg "green" ;
-- harbour_N = regN "harbour" ;
-- hate_V2 = dirV2 (regV "hate") ;
-- hat_N = regN "hat" ;
-- have_V2 = dirV2 (mkV "have" "has" "had" "had" "having") ;
-- hear_V2 = dirV2 (irregV "hear" "heard" "heard") ;
-- hill_N = regN "hill" ;
-- hope_VS = mkVS (regV "hope") ;
-- horse_N = regN "horse" ;
-- hot_A = duplADeg "hot" ;
house_N = mkN baan_s lag_s ;
-- important_A = compoundADeg (regA "important") ;
-- industry_N = regN "industry" ;
-- iron_N = regN "iron" ;
-- king_N = regN "king" ;
-- know_V2 = dirV2 (irregV "know" "knew" "known") ;
-- lake_N = regN "lake" ;
-- lamp_N = regN "lamp" ;
-- learn_V2 = dirV2 (regV "learn") ;
-- leather_N = regN "leather" ;
-- leave_V2 = dirV2 (irregV "leave" "left" "left") ;
-- like_V2 = dirV2 (regV "like") ;
-- listen_V2 = mkV2 (regV "listen") toP ;
-- live_V = (regV "live") ;
john_PN = ss "cn" ;
-- long_A = regADeg "long" ;
-- lose_V2 = dirV2 (irregV "lose" "lost" "lost") ;
-- love_N = regN "love" ;
love_V2 = dirV2 (regV rak_s) ;
-- man_N = mk2N "man" "men" ;
-- married_A2 = mkA2 (regA "married") toP ;
-- meat_N = regN "meat" ;
-- milk_N = regN "milk" ;
-- moon_N = regN "moon" ;
-- mother_N2 = regN2 "mother" ;
-- mountain_N = regN "mountain" ;
-- music_N = regN "music" ;
-- narrow_A = regADeg "narrow" ;
-- new_A = regADeg "new" ;
-- newspaper_N = regN "newspaper" ;
-- oil_N = regN "oil" ;
-- old_A = regADeg "old" ;
-- open_V2 = dirV2 (regV "open") ;
-- paint_V2A = mkV2A (regV "paint") noPrep ;
-- paper_N = regN "paper" ;
-- paris_PN = regPN "Paris" ;
-- peace_N = regN "peace" ;
-- pen_N = regN "pen" ;
-- planet_N = regN "planet" ;
-- plastic_N = regN "plastic" ;
-- play_V2 = dirV2 (regV "play") ;
-- policeman_N = regN "policeman" ;
-- priest_N = regN "priest" ;
-- probable_AS = mkAS (regA "probable") ;
-- queen_N = regN "queen" ;
-- radio_N = regN "radio" ;
-- rain_V0 = mkV0 (regV "rain") ;
-- read_V2 = dirV2 (irregV "read" "read" "read") ;
-- red_A = duplADeg "red" ;
-- religion_N = regN "religion" ;
-- restaurant_N = regN "restaurant" ;
-- river_N = regN "river" ;
-- rock_N = regN "rock" ;
-- roof_N = regN "roof" ;
-- rubber_N = regN "rubber" ;
-- run_V = (irregDuplV "run" "ran" "run") ;
-- say_VS = mkVS (irregV "say" "said" "said") ;
-- school_N = regN "school" ;
-- science_N = regN "science" ;
-- sea_N = regN "sea" ;
-- seek_V2 = dirV2 (irregV "seek" "sought" "sought") ;
-- see_V2 = dirV2 (irregV "see" "saw" "seen") ;
-- sell_V3 = dirV3 (irregV "sell" "sold" "sold") toP ;
-- send_V3 = dirV3 (irregV "send" "sent" "sent") toP ;
-- sheep_N = mk2N "sheep" "sheep" ;
-- ship_N = regN "ship" ;
-- shirt_N = regN "shirt" ;
-- shoe_N = regN "shoe" ;
-- shop_N = regN "shop" ;
-- short_A = regADeg "short" ;
-- silver_N = regN "silver" ;
-- sister_N = regN "sister" ;
sleep_V = resV noon_s lap_s ;
-- small_A = regADeg "small" ;
-- snake_N = regN "snake" ;
-- sock_N = regN "sock" ;
-- speak_V2 = dirV2 (irregV "speak" "spoke" "spoken") ;
-- star_N = regN "star" ;
-- steel_N = regN "steel" ;
-- stone_N = regN "stone" ;
-- stove_N = regN "stove" ;
-- student_N = regN "student" ;
-- stupid_A = regADeg "stupid" ;
-- sun_N = regN "sun" ;
-- switch8off_V2 = dirV2 (partV (regV "switch") "off") ;
-- switch8on_V2 = dirV2 (partV (regV "switch") "on") ;
-- table_N = regN "table" ;
-- talk_V3 = mkV3 (regV "talk") toP aboutP ;
-- teacher_N = regN "teacher" ;
-- teach_V2 = dirV2 (irregV "teach" "taught" "taught") ;
-- television_N = regN "television" ;
-- thick_A = regADeg "thick" ;
-- thin_A = duplADeg "thin" ;
-- train_N = regN "train" ;
-- travel_V = (regDuplV "travel") ;
-- tree_N = regN "tree" ;
-- ---- trousers_N = regN "trousers" ;
-- ugly_A = regADeg "ugly" ;
-- understand_V2 = dirV2 (irregV "understand" "understood" "understood") ;
-- university_N = regN "university" ;
-- village_N = regN "village" ;
-- wait_V2 = mkV2 (regV "wait") forP ;
-- walk_V = (regV "walk") ;
-- warm_A = regADeg "warm" ;
-- war_N = regN "war" ;
-- watch_V2 = dirV2 (regV "watch") ;
-- water_N = regN "water" ;
-- white_A = regADeg "white" ;
-- window_N = regN "window" ;
-- wine_N = regN "wine" ;
-- win_V2 = dirV2 (irregDuplV "win" "won" "won") ;
woman_N = mkN (puu_s ++ yig_s) khon_s ;
-- wonder_VQ = mkVQ (regV "wonder") ;
-- wood_N = regN "wood" ;
-- write_V2 = dirV2 (irregV "write" "wrote" "written") ;
-- yellow_A = regADeg "yellow" ;
-- young_A = regADeg "young" ;
--
-- do_V2 = dirV2 (mkV "do" "does" "did" "done" "doing") ;
-- now_Adv = mkAdv "now" ;
-- already_Adv = mkAdv "already" ;
-- song_N = regN "song" ;
-- add_V3 = dirV3 (regV "add") toP ;
-- number_N = regN "number" ;
-- put_V2 = mkV2 (irregDuplV "put" "put" "put") noPrep ;
-- stop_V = regDuplV "stop" ;
-- jump_V = regV "jump" ;
--
-- left_Ord = ss "left" ;
-- right_Ord = ss "right" ;
-- far_Adv = mkAdv "far" ;
-- correct_A = (regA "correct") ;
-- dry_A = regA "dry" ;
-- dull_A = regA "dull" ;
-- full_A = regA "full" ;
-- heavy_A = regA "heavy" ;
-- near_A = regA "near" ;
-- rotten_A = (regA "rotten") ;
-- round_A = regA "round" ;
-- sharp_A = regA "sharp" ;
-- smooth_A = regA "smooth" ;
-- straight_A = regA "straight" ;
-- wet_A = regA "wet" ; ----
-- wide_A = regA "wide" ;
-- animal_N = regN "animal" ;
-- ashes_N = regN "ash" ; -- FIXME: plural only?
-- back_N = regN "back" ;
-- bark_N = regN "bark" ;
-- belly_N = regN "belly" ;
-- blood_N = regN "blood" ;
-- bone_N = regN "bone" ;
-- breast_N = regN "breast" ;
-- cloud_N = regN "cloud" ;
-- day_N = regN "day" ;
-- dust_N = regN "dust" ;
-- ear_N = regN "ear" ;
-- earth_N = regN "earth" ;
-- egg_N = regN "egg" ;
-- eye_N = regN "eye" ;
-- fat_N = regN "fat" ;
-- feather_N = regN "feather" ;
-- fingernail_N = regN "fingernail" ;
-- fire_N = regN "fire" ;
-- flower_N = regN "flower" ;
-- fog_N = regN "fog" ;
-- foot_N = mk2N "foot" "feet" ;
-- forest_N = regN "forest" ;
-- grass_N = regN "grass" ;
-- guts_N = regN "gut" ; -- FIXME: no singular
-- hair_N = regN "hair" ;
-- hand_N = regN "hand" ;
-- head_N = regN "head" ;
-- heart_N = regN "heart" ;
-- horn_N = regN "horn" ;
-- husband_N = genderN masculine (regN "husband") ;
-- ice_N = regN "ice" ;
-- knee_N = regN "knee" ;
-- leaf_N = mk2N "leaf" "leaves" ;
-- leg_N = regN "leg" ;
-- liver_N = regN "liver" ;
-- louse_N = mk2N "louse" "lice" ;
-- mouth_N = regN "mouth" ;
-- name_N = regN "name" ;
-- neck_N = regN "neck" ;
-- night_N = regN "night" ;
-- nose_N = regN "nose" ;
-- person_N = genderN human (regN "person") ;
-- rain_N = regN "rain" ;
-- road_N = regN "road" ;
-- root_N = regN "root" ;
-- rope_N = regN "rope" ;
-- salt_N = regN "salt" ;
-- sand_N = regN "sand" ;
-- seed_N = regN "seed" ;
-- skin_N = regN "skin" ;
-- sky_N = regN "sky" ;
-- smoke_N = regN "smoke" ;
-- snow_N = regN "snow" ;
-- stick_N = regN "stick" ;
-- tail_N = regN "tail" ;
-- tongue_N = regN "tongue" ;
-- tooth_N = mk2N "tooth" "teeth" ;
-- wife_N = genderN feminine (mk2N "wife" "wives") ;
-- wind_N = regN "wind" ;
-- wing_N = regN "wing" ;
-- worm_N = regN "worm" ;
-- year_N = regN "year" ;
-- blow_V = blow_V ;
-- breathe_V = dirV2 (regV "breathe") ;
-- burn_V = burn_V ;
-- dig_V = dig_V ;
-- fall_V = fall_V ;
-- float_V = regV "float" ;
-- flow_V = regV "flow" ;
-- fly_V = fly_V ;
-- freeze_V = freeze_V ;
-- give_V3 = dirV3 give_V toP ;
-- laugh_V = regV "laugh" ;
-- lie_V = lie_V ;
-- play_V = regV "play" ;
-- sew_V = sew_V ;
-- sing_V = sing_V ;
-- sit_V = sit_V ;
-- smell_V = regV "smell" ;
-- spit_V = spit_V ;
-- stand_V = stand_V ;
-- swell_V = swell_V ;
-- swim_V = swim_V ;
-- think_V = think_V ;
-- turn_V = regV "turn" ;
-- vomit_V = regV "vomit" ;
--
-- bite_V2 = dirV2 bite_V ;
-- count_V2 = dirV2 (regV "count") ;
-- cut_V2 = dirV2 cut_V ;
-- fear_V2 = dirV2 (regV "fear") ;
-- fight_V2 = dirV2 fight_V ;
-- hit_V2 = dirV2 hit_V ;
-- hold_V2 = dirV2 hold_V ;
-- hunt_V2 = dirV2 (regV "hunt") ;
-- kill_V2 = dirV2 (regV "kill") ;
-- pull_V2 = dirV2 (regV "pull") ;
-- push_V2 = dirV2 (regV "push") ;
-- rub_V2 = dirV2 (regDuplV "rub") ;
-- scratch_V2 = dirV2 (regV "scratch") ;
-- split_V2 = dirV2 split_V ;
-- squeeze_V2 = dirV2 (regV "squeeze") ;
-- stab_V2 = dirV2 (regDuplV "stab") ;
-- suck_V2 = dirV2 (regV "suck") ;
-- throw_V2 = dirV2 throw_V ;
-- tie_V2 = dirV2 (regV "tie") ;
-- wash_V2 = dirV2 (regV "wash") ;
-- wipe_V2 = dirV2 (regV "wipe") ;
--
---- other_A = regA "other" ;
--
-- grammar_N = regN "grammar" ;
-- language_N = regN "language" ;
-- rule_N = regN "rule" ;
--
--oper
-- aboutP = mkPrep "about" ;
-- atP = mkPrep "at" ;
-- forP = mkPrep "for" ;
-- fromP = mkPrep "from" ;
-- inP = mkPrep "in" ;
-- onP = mkPrep "on" ;
-- toP = mkPrep "to" ;
--
}

View File

@@ -0,0 +1,198 @@
----# -path=.:../../prelude
--
----1 A Simple Thai Resource Morphology
----
---- Aarne Ranta 2002 -- 2005
----
---- This resource morphology contains definitions needed in the resource
---- syntax. To build a lexicon, it is better to use $ParadigmsTha$, which
---- gives a higher-level access to this module.
--
--resource MorphoTha = ResTha ** open Prelude, (Predef=Predef) in {
--
-- flags optimize=all ;
--
----2 Phonology
----
---- To regulate the use of endings for both nouns, adjectives, and verbs:
--
--oper
-- y2ie : Str -> Str -> Str = \fly,s ->
-- let y = last (init fly) in
-- case y of {
-- "a" => fly + s ;
-- "e" => fly + s ;
-- "o" => fly + s ;
-- "u" => fly + s ;
-- _ => init fly + "ie" + s
-- } ;
--
--
----2 Nouns
----
---- For conciseness and abstraction, we define a worst-case macro for
---- noun inflection. It is used for defining special case that
---- only need one string as argument.
--
--oper
-- CommonNoun : Type = {s : Number => Case => Str} ;
--
-- nounGen : Str -> CommonNoun = \dog -> case last dog of {
-- "y" => nounY "dog" ;
-- "s" => nounS (init "dog") ;
-- _ => nounReg "dog"
-- } ;
--
---- These are auxiliaries to $nounGen$.
--
-- nounReg : Str -> CommonNoun = \dog ->
-- mkNoun dog (dog + "s") (dog + "'s") (dog + "s'");
-- nounS : Str -> CommonNoun = \kiss ->
-- mkNoun kiss (kiss + "es") (kiss + "'s") (kiss + "es'") ;
-- nounY : Str -> CommonNoun = \fl ->
-- mkNoun (fl + "y") (fl + "ies") (fl + "y's") (fl + "ies'") ;
--
--
----3 Proper names
----
---- Regular proper names are inflected with "'s" in the genitive.
--
-- nameReg : Str -> Gender -> {s : Case => Str} = \john,g ->
-- {s = table {Gen => john + "'s" ; _ => john} ; g = g} ;
--
----2 Determiners
--
-- mkDeterminer : Number -> Str -> {s : Str ; n : Number} = \n,s ->
-- {s = s ; n = n} ;
--
----2 Pronouns
----
---- Here we define personal pronouns.
----
---- We record the form "mine" and the gender for later use.
--
-- Pronoun : Type =
-- {s : Case => Str ; a : Agr ; g : Gender} ;
--
-- mkPronoun : (_,_,_,_ : Str) -> Number -> Person -> Gender -> Pronoun =
-- \I,me,my,mine,n,p,g ->
-- {s = table {Nom => I ; Acc => me ; Gen => my} ;
-- a = {n = n ; p = p} ;
-- g = g
-- } ;
--
-- human : Gender = Masc ; --- doesn't matter
--
-- pronI = mkPronoun "I" "me" "my" "mine" Sg P1 human ;
-- pronYouSg = mkPronoun "you" "you" "your" "yours" Sg P2 human ; -- verb agr OK
-- pronHe = mkPronoun "he" "him" "his" "his" Sg P3 Masc ;
-- pronShe = mkPronoun "she" "her" "her" "hers" Sg P3 Fem ;
-- pronIt = mkPronoun "it" "it" "its" "it" Sg P3 Neutr ;
--
-- pronWe = mkPronoun "we" "us" "our" "ours" Pl P1 human ;
-- pronYouPl = mkPronoun "you" "you" "your" "yours" Pl P2 human ;
-- pronThey = mkPronoun "they" "them" "their" "theirs" Pl P3 human ; ---
--
--
----2 Adjectives
----
---- To form the adjectival and the adverbial forms, two strings are needed
---- in the worst case. (First without degrees.)
--
-- Adjective = {s : AForm => Str} ;
--
---- However, most adjectives can be inflected using the final character.
---- N.B. this is not correct for "shy", but $mkAdjective$ has to be used.
--
-- regAdjective : Str -> Adjective = \free ->
-- let
-- e = last free ;
-- fre = init free ;
-- freely = case e of {
-- "y" => fre + "ily" ;
-- _ => free + "ly"
-- } ;
-- fre = case e of {
-- "e" => fre ;
-- "y" => fre + "i" ;
-- _ => free
-- }
-- in
-- mkAdjective free (fre + "er") (fre + "est") freely ;
--
---- Many adjectives are 'inflected' by adding a comparison word.
--
-- adjDegrLong : Str -> Adjective = \ridiculous ->
-- mkAdjective
-- ridiculous
-- ("more" ++ ridiculous)
-- ("most" ++ ridiculous)
-- ((regAdjective ridiculous).s ! AAdv) ;
--
--
----3 Verbs
----
---- The worst case needs five forms. (The verb "be" is treated separately.)
--
-- mkVerb4 : (_,_,_,_: Str) -> Verb = \go,goes,went,gone ->
-- let going = case last go of {
-- "e" => init go + "ing" ;
-- _ => go + "ing"
-- }
-- in
-- mkVerb go goes went gone going ;
--
---- This is what we use to derive the irregular forms in almost all cases
--
-- mkVerbIrreg : (_,_,_ : Str) -> Verb = \bite,bit,bitten ->
-- let bites = case last bite of {
-- "y" => y2ie bite "s" ;
-- "s" => init bite + "es" ;
-- _ => bite + "s"
-- }
-- in mkVerb4 bite bites bit bitten ;
--
---- This is used to derive regular forms.
--
-- mkVerbReg : Str -> Verb = \soak ->
-- let
-- soaks = case last soak of {
-- "y" => y2ie soak "s" ;
-- "s" => init soak + "es" ;
-- _ => soak + "s"
-- } ;
-- soaked = case last soak of {
-- "e" => init soak + "s" ;
-- _ => soak + "ed"
-- }
-- in
-- mkVerb4 soak soaks soaked soaked ;
--
-- verbGen : Str -> Verb = \kill -> case last kill of {
-- "y" => verbP3y (init kill) ;
-- "e" => verbP3e (init kill) ;
-- "s" => verbP3s (init kill) ;
-- _ => regVerbP3 kill
-- } ;
--
---- These are just auxiliary to $verbGen$.
--
-- regVerbP3 : Str -> Verb = \walk ->
-- mkVerbIrreg walk (walk + "ed") (walk + "ed") ;
-- verbP3s : Str -> Verb = \kiss ->
-- mkVerb4 kiss (kiss + "es") (kiss + "ed") (kiss + "ed") ;
-- verbP3e : Str -> Verb = \love ->
-- mkVerb4 love (love + "s") (love + "d") (love + "d") ;
-- verbP3y : Str -> Verb = \cr ->
-- mkVerb4 (cr + "y") (cr + "ies") (cr + "ied") (cr + "ied") ;
--
----- The particle always appears right after the verb.
--
-- verbPart : Verb -> Str -> Verb = \v,p ->
-- {s = \\f => v.s ! f ++ p ; isRefl = v.isRefl} ;
--
-- verbNoPart : Verb -> Verb = \v -> verbPart v [] ;
--
--
--} ;
--

View File

@@ -0,0 +1,76 @@
concrete NounTha of Noun = CatTha ** open StringsTha, ResTha, Prelude in {
flags optimize=all_subs ;
lin
DetCN det cn =
let cnc = if_then_Str det.hasC cn.c []
in ss (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
-- } ;
DetQuant quant num = {
s1 = [] ;
s2 = quant.s ++ num.s ;
hasC = quant.hasC ;
} ;
DetQuantOrd quant num ord = {
s1 = num.s ;
s2 = quant.s ++ ord.s ;
hasC = orB num.hasC quant.hasC ;
} ;
PossPron p = {
s = khoog_s ++ p.s ;
hasC = False
} ;
NumSg, NumPl = {s = [] ; hasC = False} ;
NumCard n = n ** {hasC = True} ;
-- OrdInt n = {s = n.s ++ "th"} ; ---
--
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} ;
--
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} ;
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} ;
--
}

View File

@@ -0,0 +1,66 @@
concrete NumeralTha of Numeral = CatTha ** open ResTha, StringsTha in {
lincat
-- Numeral = {s : Str} ;
Digit = {s : DForm => Str} ;
Sub10 = {s : DForm => Str} ;
Sub100 = {s : NForm => Str} ;
Sub1000 = {s : NForm => Str} ;
Sub1000000 = {s : Str} ;
lin
num x = x ;
pot01 = mkNum nvg_s nvg_s et_s ;
n2 = mkNum soog_s yii_s soog_s ;
n3 = regNum saam_s ;
n4 = regNum sii_s ;
n5 = regNum haa_s ;
n6 = regNum hok_s ;
n7 = regNum cet_s ;
n8 = regNum peet_s ;
n9 = regNum kaaw_s ;
pot0 d = d ;
pot110 = {s = sip} ;
pot111 = {s = table {
Unit => sip_s ++ et_s ;
Thousand => nvg_s ++ mvvn_s ++ nvg_s ++ phan_s
}
} ;
pot1to19 d = {s = table {
Unit => sip_s ++ d.s ! After ;
Thousand => nvg_s ++ mvvn_s ++ d.s ! Indep ++ phan_s
}
} ;
pot0as1 d = {s = \\n => d.s ! Indep ++ phan ! n} ;
pot1 d = {s = \\n => d.s ! ModTen ++ sip ! n} ;
pot1plus d e = {
s = \\n => d.s ! ModTen ++ sip ! n ++ e.s ! After ++ phan ! n
} ;
pot1as2 n = n ;
pot2 d = {s = \\n => d.s ! Indep ++ roy ! n} ;
pot2plus d e = {s = \\n => d.s ! Indep ++ roy ! n ++ e.s ! n} ;
pot2as3 n = {s = n.s ! Unit} ;
pot3 n = {s = n.s ! Thousand} ;
pot3plus n m = {s = n.s ! Thousand ++ m.s ! Unit} ;
param
DForm = Indep | ModTen | After ;
NForm = Unit | Thousand ;
oper
mkNum : Str -> Str -> Str -> {s : DForm => Str} = \x,y,z ->
{s = table {Indep => x ; ModTen => y ; After => z}} ;
regNum : Str -> {s : DForm => Str} = \x ->
mkNum x x x ;
sip = table {Unit => sip_s ; Thousand => mvvn_s} ;
roy = table {Unit => rooy_s ; Thousand => seen_s} ;
phan = table {Unit => [] ; Thousand => phan_s} ;
}

View File

@@ -0,0 +1 @@
--resource OverloadTha = Overload with (Grammar = GrammarTha) ;

View File

@@ -0,0 +1,496 @@
----# -path=.:../abstract:../../prelude:../common
--
----1 Thai Lexical Paradigms
----
---- Aarne Ranta 2003--2005
----
---- This is an API for the user of the resource grammar
---- for adding lexical items. It gives functions for forming
---- expressions of open categories: nouns, adjectives, verbs.
----
---- Closed categories (determiners, pronouns, conjunctions) are
---- accessed through the resource syntax API, $Structural.gf$.
----
---- The main difference with $MorphoTha.gf$ is that the types
---- referred to are compiled resource grammar types. We have moreover
---- had the design principle of always having existing forms, rather
---- than stems, as string arguments of the paradigms.
----
---- The structure of functions for each word class $C$ is the following:
---- first we give a handful of patterns that aim to cover all
---- regular cases. Then we give a worst-case function $mkC$, which serves as an
---- escape to construct the most irregular words of type $C$.
---- However, this function should only seldom be needed: we have a
---- separate module [``IrregTha`` ../../english/IrregTha.gf],
---- which covers irregular verbss.
--
--resource ParadigmsTha = open
-- (Predef=Predef),
-- Prelude,
-- MorphoTha,
-- CatTha
-- in {
----2 Parameters
----
---- To abstract over gender names, we define the following identifiers.
--
--oper
-- Gender : Type ;
--
-- human : Gender ;
-- nonhuman : Gender ;
-- masculine : Gender ;
--
---- To abstract over number names, we define the following.
--
-- Number : Type ;
--
-- singular : Number ;
-- plural : Number ;
--
---- To abstract over case names, we define the following.
--
-- Case : Type ;
--
-- nominative : Case ;
-- genitive : Case ;
--
---- Prepositions are used in many-argument functions for rection.
---- The resource category $Prep$ is used.
--
--
--
----2 Nouns
--
---- Nouns are constructed by the function $mkN$, which takes a varying
---- number of arguments.
--
-- mkN : overload {
--
---- Worst case: give all four forms.
--
-- mkN : (man,men,man's,men's : Str) -> N ;
--
---- The regular function captures the variants for nouns ending with
---- "s","sh","x","z" or "y": "kiss - kisses", "flash - flashes";
---- "fly - flies" (but "toy - toys"),
--
-- mkN : (flash : Str) -> N ;
--
---- In practice the worst case is just: give singular and plural nominative.
--
-- mkN : (man,men : Str) -> N ;
--
---- All nouns created by the previous functions are marked as
---- $nonhuman$. If you want a $human$ noun, wrap it with the following
---- function:
--
-- mkN : Gender -> N -> N ;
--
----3 Compound nouns
----
---- A compound noun is an uninflected string attached to an inflected noun,
---- such as "baby boom", "chief executive officer".
--
-- mkN : Str -> N -> N
-- } ;
--
--
----3 Relational nouns
----
---- Relational nouns ("daughter of x") need a preposition.
--
-- mkN2 : N -> Prep -> N2 ;
--
---- The most common preposition is "of", and the following is a
---- shortcut for regular relational nouns with "of".
--
-- regN2 : Str -> N2 ;
--
---- Use the function $mkPrep$ or see the section on prepositions below to
---- form other prepositions.
----
---- Three-place relational nouns ("the connection from x to y") need two prepositions.
--
-- mkN3 : N -> Prep -> Prep -> N3 ;
--
--
----3 Relational common noun phrases
----
---- In some cases, you may want to make a complex $CN$ into a
---- relational noun (e.g. "the old town hall of").
--
-- cnN2 : CN -> Prep -> N2 ;
-- cnN3 : CN -> Prep -> Prep -> N3 ;
--
----
----3 Proper names and noun phrases
----
---- Proper names, with a regular genitive, are formed as follows
--
-- regPN : Str -> PN ;
-- regGenPN : Str -> Gender -> PN ; -- John, John's
--
---- Sometimes you can reuse a common noun as a proper name, e.g. "Bank".
--
-- nounPN : N -> PN ;
--
---- To form a noun phrase that can also be plural and have an irregular
---- genitive, you can use the worst-case function.
--
-- mkNP : Str -> Str -> Number -> Gender -> NP ;
--
----2 Adjectives
--
---- Non-comparison one-place adjectives need two forms: one for
---- the adjectival and one for the adverbial form ("free - freely")
--
-- mkA : (free,freely : Str) -> A ;
--
---- For regular adjectives, the adverbial form is derived. This holds
---- even for cases with the variation "happy - happily".
--
-- regA : Str -> A ;
--
----3 Two-place adjectives
----
---- Two-place adjectives need a preposition for their second argument.
--
-- mkA2 : A -> Prep -> A2 ;
--
---- Comparison adjectives may two more forms.
--
-- ADeg : Type ;
--
-- mkADeg : (good,better,best,well : Str) -> ADeg ;
--
---- The regular pattern recognizes two common variations:
---- "-e" ("rude" - "ruder" - "rudest") and
---- "-y" ("happy - happier - happiest - happily")
--
-- regADeg : Str -> ADeg ; -- long, longer, longest
--
---- However, the duplication of the final consonant is nor predicted,
---- but a separate pattern is used:
--
-- duplADeg : Str -> ADeg ; -- fat, fatter, fattest
--
---- If comparison is formed by "more", "most", as in general for
---- long adjective, the following pattern is used:
--
-- compoundADeg : A -> ADeg ; -- -/more/most ridiculous
--
---- From a given $ADeg$, it is possible to get back to $A$.
--
-- adegA : ADeg -> A ;
--
--
----2 Adverbs
--
---- Adverbs are not inflected. Most lexical ones have position
---- after the verb. Some can be preverbal (e.g. "always").
--
-- mkAdv : Str -> Adv ;
-- mkAdV : Str -> AdV ;
--
---- Adverbs modifying adjectives and sentences can also be formed.
--
-- mkAdA : Str -> AdA ;
--
----2 Prepositions
----
---- A preposition as used for rection in the lexicon, as well as to
---- build $PP$s in the resource API, just requires a string.
--
-- mkPrep : Str -> Prep ;
-- noPrep : Prep ;
--
---- (These two functions are synonyms.)
--
----2 Verbs
----
---- Except for "be", the worst case needs five forms: the infinitive and
---- the third person singular present, the past indicative, and the
---- past and present participles.
--
-- mkV : (go, goes, went, gone, going : Str) -> V ;
--
---- The regular verb function recognizes the special cases where the last
---- character is "y" ("cry - cries" but "buy - buys") or "s", "sh", "x", "z"
---- ("fix - fixes", etc).
--
-- regV : Str -> V ;
--
---- The following variant duplicates the last letter in the forms like
---- "rip - ripped - ripping".
--
-- regDuplV : Str -> V ;
--
---- There is an extensive list of irregular verbs in the module $IrregularTha$.
---- In practice, it is enough to give three forms,
---- e.g. "drink - drank - drunk", with a variant indicating consonant
---- duplication in the present participle.
--
-- irregV : (drink, drank, drunk : Str) -> V ;
-- irregDuplV : (get, got, gotten : Str) -> V ;
--
--
----3 Verbs with a particle.
----
---- The particle, such as in "switch on", is given as a string.
--
-- partV : V -> Str -> V ;
--
----3 Reflexive verbs
----
---- By default, verbs are not reflexive; this function makes them that.
--
-- reflV : V -> V ;
--
----3 Two-place verbs
----
---- Two-place verbs need a preposition, except the special case with direct object.
---- (transitive verbs). Notice that a particle comes from the $V$.
--
-- mkV2 : V -> Prep -> V2 ;
--
-- dirV2 : V -> V2 ;
--
----3 Three-place verbs
----
---- Three-place (ditransitive) verbs need two prepositions, of which
---- the first one or both can be absent.
--
-- mkV3 : V -> Prep -> Prep -> V3 ; -- speak, with, about
-- dirV3 : V -> Prep -> V3 ; -- give,_,to
-- dirdirV3 : V -> V3 ; -- give,_,_
--
----3 Other complement patterns
----
---- Verbs and adjectives can take complements such as sentences,
---- questions, verb phrases, and adjectives.
--
-- mkV0 : V -> V0 ;
-- mkVS : V -> VS ;
-- mkV2S : V -> Prep -> V2S ;
-- mkVV : V -> VV ;
-- mkV2V : V -> Prep -> Prep -> V2V ;
-- mkVA : V -> VA ;
-- mkV2A : V -> Prep -> V2A ;
-- mkVQ : V -> VQ ;
-- mkV2Q : V -> Prep -> V2Q ;
--
-- mkAS : A -> AS ;
-- mkA2S : A -> Prep -> A2S ;
-- mkAV : A -> AV ;
-- mkA2V : A -> Prep -> A2V ;
--
---- Notice: categories $V2S, V2V, V2A, V2Q$ are in v 1.0 treated
---- just as synonyms of $V2$, and the second argument is given
---- as an adverb. Likewise $AS, A2S, AV, A2V$ are just $A$.
---- $V0$ is just $V$.
--
-- V0, V2S, V2V, V2A, V2Q : Type ;
-- AS, A2S, AV, A2V : Type ;
--
----.
----2 Definitions of paradigms
----
---- The definitions should not bother the user of the API. So they are
---- hidden from the document.
--
-- Gender = MorphoTha.Gender ;
-- Number = MorphoTha.Number ;
-- Case = MorphoTha.Case ;
-- human = Masc ;
-- nonhuman = Neutr ;
-- masculine = Masc ;
-- feminine = Fem ;
-- singular = Sg ;
-- plural = Pl ;
-- nominative = Nom ;
-- genitive = Gen ;
--
-- Preposition : Type = Str ; -- obsolete
--
-- regN = \ray ->
-- let
-- ra = Predef.tk 1 ray ;
-- y = Predef.dp 1 ray ;
-- r = Predef.tk 2 ray ;
-- ay = Predef.dp 2 ray ;
-- rays =
-- case y of {
-- "y" => y2ie ray "s" ;
-- "s" => ray + "es" ;
-- "z" => ray + "es" ;
-- "x" => ray + "es" ;
-- _ => case ay of {
-- "sh" => ray + "es" ;
-- "ch" => ray + "es" ;
-- _ => ray + "s"
-- }
-- }
-- in
-- mk2N ray rays ;
--
-- mk2N = \man,men ->
-- let mens = case last men of {
-- "s" => men + "'" ;
-- _ => men + "'s"
-- }
-- in
-- mk4N man men (man + "'s") mens ;
--
-- mk4N = \man,men,man's,men's ->
-- mkNoun man man's men men's ** {g = Neutr ; lock_N = <>} ;
--
-- genderN g man = {s = man.s ; g = g ; lock_N = <>} ;
--
-- compoundN s n = {s = \\x,y => s ++ n.s ! x ! y ; g=n.g ; lock_N = <>} ;
--
-- mkN2 = \n,p -> n ** {lock_N2 = <> ; c2 = p.s} ;
-- regN2 n = mkN2 (regN n) (mkPrep "of") ;
-- mkN3 = \n,p,q -> n ** {lock_N3 = <> ; c2 = p.s ; c3 = q.s} ;
-- cnN2 = \n,p -> n ** {lock_N2 = <> ; c2 = p.s} ;
-- cnN3 = \n,p,q -> n ** {lock_N3 = <> ; c2 = p.s ; c3 = q.s} ;
--
-- regPN n = regGenPN n human ;
-- regGenPN n g = nameReg n g ** {lock_PN = <>} ;
-- nounPN n = {s = n.s ! singular ; g = n.g ; lock_PN = <>} ;
-- mkNP x y n g = {s = table {Gen => x ; _ => y} ; a = agrP3 n ;
-- lock_NP = <>} ;
--
-- mkA a b = mkAdjective a a a b ** {lock_A = <>} ;
-- regA a = regAdjective a ** {lock_A = <>} ;
--
-- mkA2 a p = a ** {c2 = p.s ; lock_A2 = <>} ;
--
-- ADeg = A ; ----
--
-- mkADeg a b c d = mkAdjective a b c d ** {lock_A = <>} ;
--
-- regADeg happy =
-- let
-- happ = init happy ;
-- y = last happy ;
-- happie = case y of {
-- "y" => happ + "ie" ;
-- "e" => happy ;
-- _ => happy + "e"
-- } ;
-- happily = case y of {
-- "y" => happ + "ily" ;
-- _ => happy + "ly"
-- } ;
-- in mkADeg happy (happie + "r") (happie + "st") happily ;
--
-- duplADeg fat =
-- mkADeg fat
-- (fat + last fat + "er") (fat + last fat + "est") (fat + "ly") ;
--
-- compoundADeg a =
-- let ad = (a.s ! AAdj Posit)
-- in mkADeg ad ("more" ++ ad) ("most" ++ ad) (a.s ! AAdv) ;
--
-- adegA a = a ;
--
-- mkAdv x = ss x ** {lock_Adv = <>} ;
-- mkAdV x = ss x ** {lock_AdV = <>} ;
-- mkAdA x = ss x ** {lock_AdA = <>} ;
--
-- mkPrep p = ss p ** {lock_Prep = <>} ;
-- noPrep = mkPrep [] ;
--
-- mkV a b c d e = mkVerb a b c d e ** {s1 = [] ; lock_V = <>} ;
--
-- regV cry =
-- let
-- cr = init cry ;
-- y = last cry ;
-- cries = (regN cry).s ! Pl ! Nom ; -- !
-- crie = init cries ;
-- cried = case last crie of {
-- "e" => crie + "d" ;
-- _ => crie + "ed"
-- } ;
-- crying = case y of {
-- "e" => case last cr of {
-- "e" => cry + "ing" ;
-- _ => cr + "ing"
-- } ;
-- _ => cry + "ing"
-- }
-- in mkV cry cries cried cried crying ;
--
-- regDuplV fit =
-- case last fit of {
-- ("a" | "e" | "i" | "o" | "u" | "y") =>
-- Predef.error (["final duplication makes no sense for"] ++ fit) ;
-- t =>
-- let fitt = fit + t in
-- mkV fit (fit + "s") (fitt + "ed") (fitt + "ed") (fitt + "ing")
-- } ;
--
-- irregV x y z = let reg = (regV x).s in
-- mkV x (reg ! VPres) y z (reg ! VPresPart) ** {s1 = [] ; lock_V = <>} ;
--
-- irregDuplV fit y z =
-- let
-- fitting = (regDuplV fit).s ! VPresPart
-- in
-- mkV fit (fit + "s") y z fitting ;
--
-- partV v p = verbPart v p ** {lock_V = <>} ;
-- reflV v = {s = v.s ; part = v.part ; lock_V = v.lock_V ; isRefl = True} ;
--
-- mkV2 v p = v ** {s = v.s ; s1 = v.s1 ; c2 = p.s ; lock_V2 = <>} ;
-- dirV2 v = mkV2 v noPrep ;
--
-- mkV3 v p q = v ** {s = v.s ; s1 = v.s1 ; c2 = p.s ; c3 = q.s ; lock_V3 = <>} ;
-- dirV3 v p = mkV3 v noPrep p ;
-- dirdirV3 v = dirV3 v noPrep ;
--
-- mkVS v = v ** {lock_VS = <>} ;
-- mkVV v = {
-- s = table {VVF vf => v.s ! vf ; _ => variants {}} ;
-- isAux = False ; lock_VV = <>
-- } ;
-- mkVQ v = v ** {lock_VQ = <>} ;
--
-- V0 : Type = V ;
-- V2S, V2V, V2Q, V2A : Type = V2 ;
-- AS, A2S, AV : Type = A ;
-- A2V : Type = A2 ;
--
-- mkV0 v = v ** {lock_V = <>} ;
-- mkV2S v p = mkV2 v p ** {lock_V2 = <>} ;
-- mkV2V v p t = mkV2 v p ** {s4 = t ; lock_V2 = <>} ;
-- mkVA v = v ** {lock_VA = <>} ;
-- mkV2A v p = mkV2 v p ** {lock_V2A = <>} ;
-- mkV2Q v p = mkV2 v p ** {lock_V2 = <>} ;
--
-- mkAS v = v ** {lock_A = <>} ;
-- mkA2S v p = mkA2 v p ** {lock_A = <>} ;
-- mkAV v = v ** {lock_A = <>} ;
-- mkA2V v p = mkA2 v p ** {lock_A2 = <>} ;
--
--
---- pre-overload API and overload definitions
--
-- mk4N : (man,men,man's,men's : Str) -> N ;
-- regN : Str -> N ;
-- mk2N : (man,men : Str) -> N ;
-- genderN : Gender -> N -> N ;
-- compoundN : Str -> N -> N ;
--
-- mkN = overload {
-- mkN : (man,men,man's,men's : Str) -> N = mk4N ;
-- mkN : Str -> N = regN ;
-- mkN : (man,men : Str) -> N = mk2N ;
-- mkN : Gender -> N -> N = genderN ;
-- mkN : Str -> N -> N = compoundN
-- } ;
--
--
--} ;

View File

@@ -0,0 +1,24 @@
concrete PhraseTha of Phrase = CatTha ** open Prelude, ResTha in {
lin
PhrUtt pconj utt voc = {s = pconj.s ++ utt.s ++ voc.s} ;
UttS s = s ;
UttQS qs = {s = qs.s ! QDir} ;
UttImpSg pol imp = {s = pol.s ++ imp.s ! pol.p} ;
UttImpPl pol imp = {s = pol.s ++ imp.s ! pol.p} ;
UttImpPol pol imp = {s = pol.s ++ imp.s ! pol.p} ; --- add politeness here?
UttIP ip = ip ;
UttIAdv iadv = iadv ;
UttNP np = np ;
UttVP vp = {s = vp.s ! Pos} ;
UttAdv adv = adv ;
NoPConj = {s = []} ;
PConjConj conj = conj ;
NoVoc = {s = []} ;
VocNP np = {s = np.s} ; ---- ??
}

View File

@@ -0,0 +1,41 @@
concrete QuestionTha of Question = CatTha **
open ResTha, StringsTha, Prelude in {
flags optimize=all_subs ;
lin
-- pos. may, neg. chay may - not always the proper forms ---
QuestCl cl = {s = \\p => cl.s ! Pos ++ polStr chay_s p ++ m'ay_s} ;
--
-- 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

@@ -0,0 +1,48 @@
--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
-- } ;
--
--}

484
next-lib/src/thai/ResTha.gf Normal file
View File

@@ -0,0 +1,484 @@
--# -path=.:../abstract:../common:../../prelude
--1 Thai auxiliary operations.
--
---- This module contains operations that are needed to make the
---- resource syntax work. To define everything that is needed to
---- implement $Test$, it moreover contains regular lexical
---- patterns needed for $Lex$.
--
resource ResTha = ParamX ** open StringsTha, Prelude in {
oper
-- noun and classifier
Noun = {s,c : Str} ;
mkN : Str -> Str -> Noun = \s,c -> {s = s ; c = c} ;
-- before and after classifier; whether classifier needed (default)
Determiner = {s1, s2 : Str ; hasC : Bool} ;
mkDet : Str -> Str -> Determiner =
\s,c -> {s1 = s ; s2 = c ; hasC = True} ;
-- Part before and after negation (mai_s)
Verb = {s1,s2 : Str} ;
resV : Str -> Str -> Verb = \s,c -> {s1 = s ; s2 = c} ;
regV : Str -> Verb = \s -> resV [] s ;
dirV2 : Verb -> Verb ** {c2 : Str} = \v -> v ** {c2 = []} ;
-- Auxiliary verbs, according to order and negation.
-- The three types are $VV may VP | may VV VP | VP may VV$
param VVTyp = VVPre | VVMid | VVPost ;
oper VVerb = {s : Str ; typ : VVTyp} ;
-- Verb phrases: form negation and question, too.
VP = {
s : Polarity => Str
} ;
mkVP : Verb -> VP = \v -> {
s = \\p => v.s1 ++ polStr may_s p ++ v.s2
} ;
insertObject : Str -> VP -> VP = \np,vp -> {
s = \\p => vp.s ! p ++ np
} ;
polStr : Str -> Polarity -> Str = \m,p -> case p of {
Pos => [] ;
Neg => m
} ;
-- flags optimize=all ;
--
--
---- Some parameters, such as $Number$, are inherited from $ParamX$.
--
----2 For $Noun$
--
---- This is the worst-case $Case$ needed for pronouns.
--
-- param
-- Case = Nom | Acc | Gen ;
--
---- Agreement of $NP$ is a record. We'll add $Gender$ later.
--
-- oper
-- Agr = {n : Number ; p : Person} ;
--
-- param
-- Gender = Neutr | Masc | Fem ;
--
----2 For $Verb$
--
---- Only these five forms are needed for open-lexicon verbs.
--
-- param
-- VForm =
-- VInf
-- | VPres
-- | VPPart
-- | VPresPart
-- | VPast --# notpresent
-- ;
--
---- Auxiliary verbs have special negative forms.
--
-- VVForm =
-- VVF VForm
-- | VVPresNeg
-- | VVPastNeg --# notpresent
-- ;
--
---- The order of sentence is needed already in $VP$.
--
-- Order = ODir | OQuest ;
--
--
----2 For $Adjective$
--
-- AForm = AAdj Degree | AAdv ;
--
----2 For $Relative$
--
-- RAgr = RNoAg | RAg {n : Number ; p : Person} ;
-- RCase = RPrep | RC Case ;
--
----2 For $Numeral$
--
-- CardOrd = NCard | NOrd ;
-- DForm = unit | teen | ten ;
--
----2 Transformations between parameter types
--
-- oper
-- agrP3 : Number -> Agr = \n ->
-- {n = n ; p = P3} ;
--
-- conjAgr : Agr -> Agr -> Agr = \a,b -> {
-- n = conjNumber a.n b.n ;
-- p = conjPerson a.p b.p
-- } ;
--
---- For $Lex$.
--
---- For each lexical category, here are the worst-case constructors.
--
-- mkNoun : (_,_,_,_ : Str) -> {s : Number => Case => Str} =
-- \man,mans,men,mens -> {
-- s = table {
-- Sg => table {
-- Gen => mans ;
-- _ => man
-- } ;
-- Pl => table {
-- Gen => mens ;
-- _ => men
-- }
-- }
-- } ;
--
-- mkAdjective : (_,_,_,_ : Str) -> {s : AForm => Str} =
-- \good,better,best,well -> {
-- s = table {
-- AAdj Posit => good ;
-- AAdj Compar => better ;
-- AAdj Superl => best ;
-- AAdv => well
-- }
-- } ;
--
-- mkVerb : (_,_,_,_,_ : Str) -> Verb =
-- \go,goes,went,gone,going -> {
-- s = table {
-- VInf => go ;
-- VPres => goes ;
-- VPast => went ; --# notpresent
-- VPPart => gone ;
-- VPresPart => going
-- } ;
-- isRefl = False
-- } ;
--
-- mkIP : (i,me,my : Str) -> Number -> {s : Case => Str ; n : Number} =
-- \i,me,my,n -> let who = mkNP i me my n P3 in {s = who.s ; n = n} ;
--
-- mkNP : (i,me,my : Str) -> Number -> Person -> {s : Case => Str ; a : Agr} =
-- \i,me,my,n,p -> {
-- s = table {
-- Nom => i ;
-- Acc => me ;
-- Gen => my
-- } ;
-- a = {
-- n = n ;
-- p = p
-- }
-- } ;
--
---- These functions cover many cases; full coverage inflectional patterns are
---- in $MorphoTha$.
--
-- regN : Str -> {s : Number => Case => Str} = \car ->
-- mkNoun car (car + "'s") (car + "s") (car + "s'") ;
--
-- regA : Str -> {s : AForm => Str} = \warm ->
-- mkAdjective warm (warm + "er") (warm + "est") (warm + "ly") ;
--
-- regV : Str -> Verb = \walk ->
-- mkVerb walk (walk + "s") (walk + "ed") (walk + "ed") (walk + "ing") ;
--
-- regNP : Str -> Number -> {s : Case => Str ; a : Agr} = \that,n ->
-- mkNP that that (that + "'s") n P3 ;
--
---- We have just a heuristic definition of the indefinite article.
---- There are lots of exceptions: consonantic "e" ("euphemism"), consonantic
---- "o" ("one-sided"), vocalic "u" ("umbrella").
--
-- artIndef = pre {
-- "a" ;
-- "an" / strs {"a" ; "e" ; "i" ; "o" ; "A" ; "E" ; "I" ; "O" }
-- } ;
--
-- artDef = "the" ;
--
---- For $Verb$.
--
-- Verb : Type = {
-- s : VForm => Str ;
-- isRefl : Bool
-- } ;
--
-- param
-- CPolarity =
-- CPos
-- | CNeg Bool ; -- contracted or not
--
-- oper
-- contrNeg : Bool -> Polarity -> CPolarity = \b,p -> case p of {
-- Pos => CPos ;
-- Neg => CNeg b
-- } ;
--
-- VerbForms : Type =
-- Tense => Anteriority => CPolarity => Order => Agr => {fin, inf : Str} ;
--
-- VP : Type = {
-- s : VerbForms ;
-- prp : Str ; -- present participle
-- inf : Str ; -- the infinitive form ; VerbForms would be the logical place
-- ad : Str ; -- sentential adverb
-- s2 : Agr => Str -- complement
-- } ;
--
--
-- predV : Verb -> VP = \verb -> {
-- s = \\t,ant,b,ord,agr =>
-- let
-- inf = verb.s ! VInf ;
-- fin = presVerb verb agr ;
-- part = verb.s ! VPPart ;
-- in
-- case <t,ant,b,ord> of {
-- <Pres,Simul,CPos,ODir> => vf fin [] ;
-- <Pres,Simul,CPos,OQuest> => vf (does agr) inf ;
-- <Pres,Anter,CPos,_> => vf (have agr) part ; --# notpresent
-- <Pres,Anter,CNeg c,_> => vfn c (have agr) (havent agr) part ; --# notpresent
-- <Past,Simul,CPos,ODir> => vf (verb.s ! VPast) [] ; --# notpresent
-- <Past,Simul,CPos,OQuest> => vf "did" inf ; --# notpresent
-- <Past,Simul,CNeg c,_> => vfn c "did" "didn't" inf ; --# notpresent
-- <Past,Anter,CPos,_> => vf "had" part ; --# notpresent
-- <Past,Anter,CNeg c,_> => vfn c "had" "hadn't" part ; --# notpresent
-- <Fut, Simul,CPos,_> => vf "will" inf ; --# notpresent
-- <Fut, Simul,CNeg c,_> => vfn c "will" "won't" inf ; --# notpresent
-- <Fut, Anter,CPos,_> => vf "will" ("have" ++ part) ; --# notpresent
-- <Fut, Anter,CNeg c,_> => vfn c "will" "won't"("have" ++ part) ; --# notpresent
-- <Cond,Simul,CPos,_> => vf "would" inf ; --# notpresent
-- <Cond,Simul,CNeg c,_> => vfn c "would" "wouldn't" inf ; --# notpresent
-- <Cond,Anter,CPos,_> => vf "would" ("have" ++ part) ; --# notpresent
-- <Cond,Anter,CNeg c,_> => vfn c "would" "wouldn't" ("have" ++ part) ; --# notpresent
-- <Pres,Simul,CNeg c,_> => vfn c (does agr) (doesnt agr) inf
-- } ;
-- prp = verb.s ! VPresPart ;
-- inf = verb.s ! VInf ;
-- ad = [] ;
-- s2 = \\a => if_then_Str verb.isRefl (reflPron ! a) []
-- } ;
--
-- predAux : Aux -> VP = \verb -> {
-- s = \\t,ant,cb,ord,agr =>
-- let
-- b = case cb of {
-- CPos => Pos ;
-- _ => Neg
-- } ;
-- inf = verb.inf ;
-- fin = verb.pres ! b ! agr ;
-- finp = verb.pres ! Pos ! agr ;
-- part = verb.ppart ;
-- in
-- case <t,ant,cb,ord> of {
-- <Pres,Anter,CPos,_> => vf (have agr) part ; --# notpresent
-- <Pres,Anter,CNeg c,_> => vfn c (have agr) (havent agr) part ; --# notpresent
-- <Past,Simul,CPos, _> => vf (verb.past ! b ! agr) [] ; --# notpresent
-- <Past,Simul,CNeg c, _> => vfn c (verb.past!Pos!agr)(verb.past!Neg!agr) [] ; --# notpresent
-- <Past,Anter,CPos,_> => vf "had" part ; --# notpresent
-- <Past,Anter,CNeg c,_> => vfn c "had" "hadn't" part ; --# notpresent
-- <Fut, Simul,CPos,_> => vf "will" inf ; --# notpresent
-- <Fut, Simul,CNeg c,_> => vfn c "will" "won't" inf ; --# notpresent
-- <Fut, Anter,CPos,_> => vf "will" ("have" ++ part) ; --# notpresent
-- <Fut, Anter,CNeg c,_> => vfn c "will" "won't"("have" ++ part) ; --# notpresent
-- <Cond,Simul,CPos,_> => vf "would" inf ; --# notpresent
-- <Cond,Simul,CNeg c,_> => vfn c "would" "wouldn't" inf ; --# notpresent
-- <Cond,Anter,CPos,_> => vf "would" ("have" ++ part) ; --# notpresent
-- <Cond,Anter,CNeg c,_> => vfn c "would" "wouldn't" ("have" ++ part) ; --# notpresent
-- <Pres,Simul,CPos, _> => vf fin [] ;
-- <Pres,Simul,CNeg c, _> => vfn c finp fin []
-- } ;
-- prp = verb.prpart ;
-- inf = verb.inf ;
-- ad = [] ;
-- s2 = \\_ => []
-- } ;
--
-- vf : Str -> Str -> {fin, inf : Str} = \x,y -> vfn True x x y ;
--
-- vfn : Bool -> Str -> Str -> Str -> {fin, inf : Str} = \contr,x,y,z ->
-- case contr of {
-- True => {fin = y ; inf = z} ;
-- False => {fin = x ; inf = "not" ++ z}
-- } ;
--
-- insertObj : (Agr => Str) -> VP -> VP = \obj,vp -> {
-- s = vp.s ;
-- prp = vp.prp ;
-- inf = vp.inf ;
-- ad = vp.ad ;
-- s2 = \\a => vp.s2 ! a ++ obj ! a
-- } ;
--
----- The adverb should be before the finite verb.
--
-- insertAdV : Str -> VP -> VP = \adv,vp -> {
-- s = vp.s ;
-- prp = vp.prp ;
-- inf = vp.inf ;
-- ad = vp.ad ++ adv ;
-- s2 = \\a => vp.s2 ! a
-- } ;
--
----
--
-- predVV : {s : VVForm => Str ; isAux : Bool} -> VP = \verb ->
-- let verbs = verb.s
-- in
-- case verb.isAux of {
-- True => predAux {
-- pres = table {
-- Pos => \\_ => verbs ! VVF VPres ;
-- Neg => \\_ => verbs ! VVPresNeg
-- } ;
-- past = table { --# notpresent
-- Pos => \\_ => verbs ! VVF VPast ; --# notpresent
-- Neg => \\_ => verbs ! VVPastNeg --# notpresent
-- } ; --# notpresent
-- inf = verbs ! VVF VInf ;
-- ppart = verbs ! VVF VPPart ;
-- prpart = verbs ! VVF VPresPart ;
-- } ;
-- _ => predV {s = \\vf => verbs ! VVF vf ; isRefl = False}
-- } ;
--
-- presVerb : {s : VForm => Str} -> Agr -> Str = \verb ->
-- agrVerb (verb.s ! VPres) (verb.s ! VInf) ;
--
-- infVP : Bool -> VP -> Agr -> Str = \isAux,vp,a ->
-- vp.ad ++ if_then_Str isAux [] "to" ++
-- vp.inf ++ vp.s2 ! a ;
--
-- agrVerb : Str -> Str -> Agr -> Str = \has,have,agr ->
-- case agr of {
-- {n = Sg ; p = P3} => has ;
-- _ => have
-- } ;
--
-- have = agrVerb "has" "have" ;
-- havent = agrVerb "hasn't" "haven't" ;
-- does = agrVerb "does" "do" ;
-- doesnt = agrVerb "doesn't" "don't" ;
--
-- Aux = {
-- pres : Polarity => Agr => Str ;
-- past : Polarity => Agr => Str ; --# notpresent
-- inf,ppart,prpart : Str
-- } ;
--
-- auxBe : Aux = {
-- pres = \\b,a => case <b,a> of {
-- <Pos,{n = Sg ; p = P1}> => "am" ;
-- <Neg,{n = Sg ; p = P1}> => ["am not"] ; --- am not I
-- _ => agrVerb (posneg b "is") (posneg b "are") a
-- } ;
-- past = \\b,a => case a of { --# notpresent
-- {n = Sg ; p = P1|P3} => (posneg b "was") ; --# notpresent
-- _ => (posneg b "were") --# notpresent
-- } ; --# notpresent
-- inf = "be" ;
-- ppart = "been" ;
-- prpart = "being"
-- } ;
--
-- posneg : Polarity -> Str -> Str = \p,s -> case p of {
-- Pos => s ;
-- Neg => s + "n't"
-- } ;
--
-- conjThat : Str = "that" ;
--
-- reflPron : Agr => Str = table {
-- {n = Sg ; p = P1} => "myself" ;
-- {n = Sg ; p = P2} => "yourself" ;
-- {n = Sg ; p = P3} => "itself" ; ----
-- {n = Pl ; p = P1} => "ourselves" ;
-- {n = Pl ; p = P2} => "yourselves" ;
-- {n = Pl ; p = P3} => "themselves"
-- } ;
--
---- For $Sentence$.
--
-- Clause : Type = {
-- s : Tense => Anteriority => CPolarity => Order => Str
-- } ;
--
-- mkClause : Str -> Agr -> VP -> Clause =
-- \subj,agr,vp -> {
-- s = \\t,a,b,o =>
-- let
-- verb = vp.s ! t ! a ! b ! o ! agr ;
-- compl = vp.s2 ! agr
-- in
-- case o of {
-- ODir => subj ++ verb.fin ++ vp.ad ++ verb.inf ++ compl ;
-- OQuest => verb.fin ++ subj ++ vp.ad ++ verb.inf ++ compl
-- }
-- } ;
--
--
---- For $Numeral$.
--
-- mkNum : Str -> Str -> Str -> Str -> {s : DForm => CardOrd => Str} =
-- \two, twelve, twenty, second ->
-- {s = table {
-- unit => table {NCard => two ; NOrd => second} ;
-- teen => \\c => mkCard c twelve ;
-- ten => \\c => mkCard c twenty
-- }
-- } ;
--
-- regNum : Str -> {s : DForm => CardOrd => Str} =
-- \six -> mkNum six (six + "teen") (six + "ty") (regOrd six) ;
--
-- regCardOrd : Str -> {s : CardOrd => Str} = \ten ->
-- {s = table {NCard => ten ; NOrd => regOrd ten}} ;
--
-- mkCard : CardOrd -> Str -> Str = \c,ten ->
-- (regCardOrd ten).s ! c ;
--
-- regOrd : Str -> Str = \ten ->
-- case last ten of {
-- "y" => init ten + "ieth" ;
-- _ => ten + "th"
-- } ;
--
-- mkQuestion :
-- {s : Str} -> Clause ->
-- {s : Tense => Anteriority => CPolarity => QForm => Str} = \wh,cl ->
-- {
-- s = \\t,a,p =>
-- let
-- cls = cl.s ! t ! a ! p ;
-- why = wh.s
-- in table {
-- QDir => why ++ cls ! OQuest ;
-- QIndir => why ++ cls ! ODir
-- }
-- } ;
--
---- for VP conjunction
--
-- param
-- VPIForm = VPIInf | VPIPPart ;
--
--
}

View File

@@ -0,0 +1,61 @@
concrete SentenceTha of Sentence = CatTha **
open Prelude, StringsTha, ResTha in {
flags optimize=all_subs ;
lin
PredVP np vp = {s = \\p => np.s ++ vp.s ! p} ;
-- PredSCVP sc vp = mkClause sc.s (agrP3 Sg) vp ;
ImpVP vp = {
s = table {
Pos => vp.s ! Pos ++ si_s ;
Neg => 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
} ;
-- 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} ;
}

View File

@@ -0,0 +1,87 @@
-- The only place where literal Thai strings are defined
-- (except for Lexicon and Structural).
-- Convert this into StringsThai by 'make strings'
resource StringsTha = {
oper
aphai_s = "Op3ay" ; -- excuse2
baan_s = "bT2a:n" ; -- house
biar_s = "ebi:OrK" ; -- beer
ca_s = "ca." ; -- Modal
cet_s = "ecSd" ; -- seven
chan_s = "c1an" ; -- I
chay_s = "a%c2T1" ; -- yes
cheut_s = "ec2v:T2t" ; -- shirt2
chuay_s = "c2T1wy" ; -- help1
di_s = "di" ; -- I (fem)1
dii_s = "di:" ; -- hello2
duay_s = "dT2wy" ; -- help2
dvm_s = "dvm" ; -- drink
et_s = "eOSd" ; -- one'
haa_s = "hT2a:" ; -- five
hay_s = "a%hT2" ; -- give
hoog_s = "hT2Og" ; -- room
hok_s = "ho?k" ; -- six
jai_s = "a%j" ; -- understand2
kaaw_s = "eka:" ; -- nine
kew_s = "e'kT2w" ; -- glass (drink Classif)
khaw_s = "ek1a:" ; -- he
khon_s = "k2n" ; -- people Classif
khoo_s = "k1O" ; -- please
khoog_s = "k1Og" ; -- Possessive
khoop_s = "k1Ob" ; -- thank
khow_s = "ek1T2w" ; -- understand1
khun_s = "k2un'" ; -- you
koon_s = "kT1On" ; -- bye2
laa_s = "la:" ; -- bye1
lag_s = "hlag" ; -- houses Classif
lap_s = "hlab" ; -- sleep2
lem_s = "elT1m" ; -- books Classif
may_s = "a&mT1" ; -- not
m'ay_s = "a&hm" ; -- Question
mvvn_s = "hmv:T1n" ; -- ten thousand
nag_s = "hna.g" ; -- book1
nai_s = "a&hn" ; -- where2
nam_s = "na+" ; -- water
nan_s = "naT2n" ; -- that
nii_s = "ni:T2" ; -- this
nit_s = "nid" ; -- little1
noon_s = "nOn" ; -- sleep1
noi_s = "hnT1Oy" ; -- little2
nvg_s = "hnvg" ; -- one
pay_s = "a&p" ; -- go
peet_s = "e'pd" ; -- eight
pen_s = "epSn" ; -- be, can-know
phan_s = "p2an" ; -- thousand
phom_s = "p1m" ; -- I (masc)
puu_s = "p1u:T2" ; -- woman1
rai_s = "a&r" ; -- how-much2
rak_s = "rak" ; -- love
raw_s = "era:" ; -- we
rooy_s = "rT2Oy" ; -- hundred
saam_s = "sa:m" ; -- three
sawat_s = "swas" ; -- hello1
seen_s = "e'sn" ; -- hundred thousand
seua_s = "esv:T2O" ; -- shirt1
si_s = "s'i" ; -- Imperative
sii_s = "si:T1" ; -- four
sip_s = "sib" ; -- ten
soog_s = "sOg" ; -- two
svv_s = "sv:O" ; -- book2
thii_s = "t5i:T1" ; -- Ord
thoot_s = "o:t5r'" ; -- sorry2
thao_s = "et5T1a:" ; -- how-much1
tog_s = "tT2Og" ; -- must
waa_s = "wT1a:" ; -- that Conj
way_s = "a&hw" ; -- can-potent
yaa_s = "OyT1a:" ; -- Neg Imper
yaak_s = "Oya:k" ; -- want
yay_s = "a%hy'" ; -- big
yig_s = "hy'ig" ; -- woman2
yii_s = "yi:T1" ; -- two'
yin_s = "yin" ; -- you're-welcome1
yuu_s = "yu:" ; -- where0(?)
}

View File

@@ -0,0 +1,110 @@
concrete StructuralTha of Structural = CatTha **
open StringsTha, ResTha, Prelude in {
flags optimize=all ;
lin
-- above_Prep = ss "above" ;
-- after_Prep = ss "after" ;
-- all_Predet = ss "all" ;
-- almost_AdA, almost_AdN = ss "almost" ;
-- although_Subj = ss "although" ;
-- always_AdV = ss "always" ;
-- and_Conj = ss "and" ** {n = Pl} ;
-- because_Subj = ss "because" ;
-- before_Prep = ss "before" ;
-- behind_Prep = ss "behind" ;
-- between_Prep = ss "between" ;
-- both7and_DConj = sd2 "both" "and" ** {n = Pl} ;
-- but_PConj = ss "but" ;
-- by8agent_Prep = ss "by" ;
-- by8means_Prep = ss "by" ;
can8know_VV = {s = pen_s ; typ = VVPost} ;
can_VV = {s = way_s ; typ = VVPost} ;
-- during_Prep = ss "during" ;
-- either7or_DConj = sd2 "either" "or" ** {n = Sg} ;
-- everybody_NP = regNP "everybody" Sg ;
-- every_Det = mkDeterminer Sg "every" ;
-- everything_NP = regNP "everything" Sg ;
-- everywhere_Adv = ss "everywhere" ;
-- few_Det = mkDeterminer Pl "few" ;
-- first_Ord = ss "first" ;
-- for_Prep = ss "for" ;
-- from_Prep = ss "from" ;
he_Pron = ss khaw_s ;
-- here_Adv = ss "here" ;
-- here7to_Adv = ss ["to here"] ;
-- here7from_Adv = ss ["from here"] ;
-- how_IAdv = ss "how" ;
-- how8many_IDet = mkDeterminer Pl ["how many"] ;
-- if_Subj = ss "if" ;
-- in8front_Prep = ss ["in front of"] ;
i_Pron = ss chan_s ;
-- in_Prep = ss "in" ;
-- it_Pron = mkNP "it" "it" "its" Sg P3 ;
-- less_CAdv = ss "less" ;
-- many_Det = mkDeterminer Pl "many" ;
-- more_CAdv = ss "more" ;
-- most_Predet = ss "most" ;
-- much_Det = mkDeterminer Sg "much" ;
must_VV = {s = tog_s ; typ = VVPre} ;
-- no_Phr = ss "no" ;
-- on_Prep = ss "on" ;
-- one_Quant = mkDeterminer Sg "one" ;
-- only_Predet = ss "only" ;
-- or_Conj = ss "or" ** {n = Sg} ;
-- otherwise_PConj = ss "otherwise" ;
-- part_Prep = ss "of" ;
-- please_Voc = ss "please" ;
-- possess_Prep = ss "of" ;
-- quite_Adv = ss "quite" ;
she_Pron = ss khaw_s ;
-- so_AdA = ss "so" ;
-- somebody_NP = regNP "somebody" Sg ;
-- someSg_Det = mkDeterminer Sg "some" ;
-- somePl_Det = mkDeterminer Pl "some" ;
-- something_NP = regNP "something" Sg ;
-- somewhere_Adv = ss "somewhere" ;
that_Quant = ss nan_s ** {hasC = True} ;
-- that_NP = regNP "that" Sg ;
-- there_Adv = ss "there" ;
-- there7to_Adv = ss "there" ;
-- there7from_Adv = ss ["from there"] ;
-- therefore_PConj = ss "therefore" ;
-- these_NP = regNP "these" Pl ;
-- they_Pron = mkNP "they" "them" "their" Pl P3 ;
-- this_Quant = mkQuant "this" "these" ;
-- this_NP = regNP "this" Sg ;
-- those_NP = regNP "those" Pl ;
-- through_Prep = ss "through" ;
-- too_AdA = ss "too" ;
-- to_Prep = ss "to" ;
-- under_Prep = ss "under" ;
-- very_AdA = ss "very" ;
want_VV = {s = yaak_s ; typ = VVMid} ;
we_Pron = ss raw_s ;
-- whatPl_IP = mkIP "what" "what" "what's" Sg ;
-- whatSg_IP = mkIP "what" "what" "what's" Sg ;
-- when_IAdv = ss "when" ;
-- when_Subj = ss "when" ;
-- where_IAdv = ss "where" ;
-- whichPl_IDet = mkDeterminer Pl ["which"] ;
-- whichSg_IDet = mkDeterminer Sg ["which"] ;
-- whoSg_IP = mkIP "who" "whom" "whose" Sg ;
-- whoPl_IP = mkIP "who" "whom" "whose" Pl ;
-- why_IAdv = ss "why" ;
-- without_Prep = ss "without" ;
-- with_Prep = ss "with" ;
-- yes_Phr = ss "yes" ;
youSg_Pron = ss khun_s ;
youPl_Pron = ss khun_s ;
youPol_Pron = ss khun_s ;
--
--
--oper
-- mkQuant : Str -> Str -> {s : Number => Str} = \x,y -> {
-- s = table Number [x ; y]
-- } ;
--
}

View File

@@ -0,0 +1,51 @@
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) ;
ComplVV vv vp = {
s = \\p =>
let
neg = polStr may_s p ;
v = vp.s ! Pos
in
case vv.typ of {
VVPre => vv.s ++ neg ++ v ;
VVMid => neg ++ vv.s ++ v ;
VVPost => 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} ;
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
}
} ;
CompAdv a = {s = \\p => polStr may_s p ++ a.s} ; --- ??
}