extensions added with Codex

This commit is contained in:
Krasimir Angelov
2026-05-29 14:44:23 +02:00
parent b8bb7f1d72
commit 0201d62777
15 changed files with 544 additions and 95 deletions

View File

@@ -19,10 +19,16 @@ concrete AdjectiveSom of Adjective = CatSom ** open ResSom, Prelude in {
} ;
-- : A2 -> NP -> AP ; -- married to her
-- ComplA2 a2 np = a2 ** { } ;
ComplA2 a2 np = a2 ** {
s = \\af => a2.s ! af ++ (prepTable ! a2.c2).s ! (agr2objAgr np.a) ++ objpron np ! Abs ;
compar = []
} ;
-- : A2 -> AP ; -- married to itself
-- ReflA2 a2 = a2 ** { } ;
ReflA2 a2 = a2 ** {
s = \\af => a2.s ! af ++ (prepTable ! a2.c2).s ! ReflexiveObj ;
compar = []
} ;
-- : A2 -> AP ; -- married
UseA2 = PositA ;
@@ -35,7 +41,9 @@ concrete AdjectiveSom of Adjective = CatSom ** open ResSom, Prelude in {
-- : CAdv -> AP -> NP -> AP ; -- as cool as John
-- CAdvAP adv ap np = ap ** { } ;
CAdvAP adv ap np = ap ** {
s = \\af => adv.s ++ ap.s ! af ++ adv.p ++ np.s ! Abs
} ;
-- The superlative use is covered in $Ord$.
@@ -49,18 +57,22 @@ concrete AdjectiveSom of Adjective = CatSom ** open ResSom, Prelude in {
-- : AP -> SC -> AP ; -- good that she is here
SentAP ap sc = ap ** {
s = \\af => ap.s ! af ++ sc.s -- TODO check
s = \\af => sc.s ++ ap.s ! af
} ;
-- An adjectival phrase can be modified by an *adadjective*, such as "very".
-- : AdA -> AP -> AP ;
-- AdAP ada ap = ap ** { } ;
AdAP ada ap = ap ** {
s = \\af => ada.s ++ ap.s ! af
} ;
-- It can also be postmodified by an adverb, typically a prepositional phrase.
-- : AP -> Adv -> AP ; -- warm by nature
-- AdvAP ap adv = ap ** {} ;
AdvAP ap adv = ap ** {
s = \\af => ap.s ! af ++ linAdv adv
} ;
}

View File

@@ -3,24 +3,26 @@ concrete AdverbSom of Adverb = CatSom ** open ResSom, ParamSom, ParadigmsSom, Pr
lin
-- : A -> Adv ;
--PositAdvAdj adj = { } ;
PositAdvAdj adj = mkAdv ("si" ++ adj.s ! AF Sg Abs) ;
-- : CAdv -> A -> NP -> Adv ; -- more warmly than John
-- ComparAdvAdj cadv a np = { } ;
ComparAdvAdj cadv a np =
mkAdv (cadv.s ++ "si" ++ a.s ! AF Sg Abs ++ cadv.p ++ np.s ! Abs) ;
-- ComparAdvAdjS : CAdv -> A -> S -> Adv ; -- more warmly than he runs
ComparAdvAdjS cadv a s =
mkAdv (cadv.s ++ "si" ++ a.s ! AF Sg Abs ++ cadv.p ++ s.s ! False) ;
-- : Prep -> NP -> Adv ;
PrepNP = prepNP ;
-- Adverbs can be modified by 'adadjectives', just like adjectives.
--AdAdv : AdA -> Adv -> Adv ; -- very quickly
AdAdv ada adv = adv ** {berri = ada.s ++ adv.berri} ;
-- Like adverbs, adadjectives can be produced by adjectives.
-- : A -> AdA ; -- extremely
-- PositAdAAdj a = { } ;
PositAdAAdj a = mkAdA (a.s ! AF Sg Abs) ;
-- Subordinate clauses can function as adverbs.
-- : Subj -> S -> Adv ;
@@ -28,6 +30,5 @@ lin
-- Comparison adverbs also work as numeral adverbs.
--AdnCAdv : CAdv -> AdN ; -- less (than five)
--AdnCAdv cadv = {s = } ;
AdnCAdv cadv = {s = cadv.s ++ cadv.p} ;
} ;

View File

@@ -125,8 +125,12 @@ concrete CatSom of Cat = CommonX - [Adv,IAdv] ** open ResSom, Prelude in {
linref
-- Cl = linCl ;
V, VS, VQ, VA, VV, V2A, V2V, V2S, V2Q, V2, V3 = \v -> v.s ! VImp Sg Pos ;
VP = infVP ;
V, VS, VQ, VA, VV = \v -> v.s ! VImp Sg Pos ;
V2A, V2V, V2S, V2Q, V2 = \v -> (prepTable ! v.c2).s ! ZeroObj ++ v.s ! VImp Sg Pos ;
V3 = \v -> (prepTable ! v.c2).s ! ZeroObj ++ (prepTable ! v.c3).s ! ZeroObj ++ v.s ! VImp Sg Pos ;
VP = linVP (VImp Sg Pos) Statement ;
CN = linCN ;
Prep = \prep -> prep.s ! ZeroObj ++ prep.sii ++ prep.dhex ++ prep.hoostiisa ! Sg3 Masc ;
A = \a -> a.s ! AF Sg Abs ;
A2 = \a -> (prepTable ! a.c2).s ! ZeroObj ++ a.s ! AF Sg Abs ;
}

View File

@@ -28,60 +28,97 @@ concrete ConjunctionSom of Conjunction =
--}
-- Adverb and other simple {s : Str} types.
-- Adverbs have language-specific fields, so lists keep only their
-- realized strings and rebuild a plain adverb at conjunction time.
lincat
[Adv],[AdV],[IAdv] = {s1,s2 : Str} ;
[Adv],[AdV] = {s1,s2 : Str} ;
[IAdv] = {s1 : Str; s2 : IAdv} ;
lin
BaseAdv, BaseAdV, BaseIAdv = twoSS ;
ConsAdv, ConsAdV, ConsIAdv = consrSS comma ;
ConjAdv, ConjAdV, ConjIAdv = conjunctDistrSS ;
BaseAdv x y = {s1 = linAdv x ; s2 = linAdv y} ;
ConsAdv x xs = xs ** {s1 = linAdv x ++ comma ++ xs.s1} ;
ConjAdv co xs = conjAdv (co.s1 ++ xs.s1 ++ co.s2 ! Indefinite ++ xs.s2) ;
BaseAdV x y = {s1 = x.s ; s2 = y.s} ;
ConsAdV x xs = xs ** {s1 = x.s ++ comma ++ xs.s1} ;
ConjAdV co xs = {s = co.s1 ++ xs.s1 ++ co.s2 ! Indefinite ++ xs.s2} ;
BaseIAdv x y = {s1 = x.s ; s2 = y} ;
ConsIAdv x xs = xs ** {s1 = x.s ++ comma ++ xs.s1} ;
ConjIAdv co xs = xs.s2 ** {
s = co.s1 ++ xs.s1 ++ co.s2 ! Indefinite ++ xs.s2.s ;
berri = co.s1 ++ xs.s1 ++ co.s2 ! Indefinite ++ xs.s2.s
} ;
-- RS depends on state, gender and case, otherwise exactly like previous.
-- RS can modify CNs, which are open for state, number and case, and have inherent gender.
lincat
[RS] = {s1,s2 : State => Gender => Case => Str} ;
[RS] = {s1,s2 : State => GenNum => Case => Str} ;
lin
BaseRS = twoTable3 State GenNum Case ;
ConsRS = consrTable3 State GenNum Case comma ;
ConjRS = conjunctRSTable ;
{-
lincat
[S] = {} ;
[S] = {s1,s2 : Bool => Str} ;
lin
BaseS x y = y ** { } ;
BaseS = twoTable Bool ;
ConsS x xs =
xs ** { } ;
ConjS co xs = {} ;
consrTable Bool comma x xs ;
ConjS co xs = conjunctDistrTable' Bool co xs ;
lincat
[AP] = {} ;
[AP] = {s1,s2 : AForm => Str ; compar : Str} ;
lin
BaseAP x y = twoTable Agr x y ** y ; --choose all the other fields from second argument
ConsAP as a = consrTable Agr comma as a ** as ;
ConjAP co as = conjunctDistrTable Agr co as ** as ;
BaseAP x y = twoTable AForm x y ** {compar = y.compar} ;
ConsAP x xs = consrTable AForm comma x xs ** {compar = xs.compar} ;
ConjAP co xs = {
s = \\af => co.s1 ++ xs.s1 ! af ++ co.s2 ! Indefinite ++ xs.s2 ! af ;
compar = xs.compar
} ;
lincat
[CN] = { } ;
[CN] = {s1,s2 : Number => Case => Str ; cn : CNoun} ;
lin
BaseCN = {} ;
ConsCN = {} ;
ConjCN co cs = conjunctDistrTable Agr co cs ** cs ;
BaseCN x y = {
s1 = \\n,c => cn2str n c x ;
s2 = \\n,c => cn2str n c y ;
cn = y
} ;
ConsCN x xs = xs ** {
s1 = \\n,c => cn2str n c x ++ "," ++ xs.s1 ! n ! c
} ;
ConjCN co xs = xs.cn ** {
s = \\nf =>
let n = case nf of {
Def n => n ;
Indef n => n ;
_ => Sg } ;
in co.s1 ++ xs.s1 ! n ! Abs ++ co.s2 ! Indefinite ++ xs.s2 ! n ! Abs ;
mod = \\_,_,_ => [] ;
modtype = NoMod
} ;
lincat
[DAP] = Determiner ** { pref2 : Str } ;
[DAP] = {s1,s2 : Gender => Case => Str ; det : Determiner} ;
lin
BaseDAP x y = x ** { pref2 = y.pref } ;
ConsDAP xs x = xs ** { pref2 = x.pref } ;
ConjDet conj xs = xs ** { pref = conj.s1 ++ xs.pref ++ conj.s2 ++ xs.pref2 } ;
-}
BaseDAP x y = {
s1 = x.sp ;
s2 = y.sp ;
det = y
} ;
ConsDAP x xs = xs ** {
s1 = \\g,c => x.sp ! g ! c ++ "," ++ xs.s1 ! g ! c
} ;
ConjDAP co xs = xs.det ** {
sp = \\g,c => co.s1 ++ xs.s1 ! g ! c ++ co.s2 ! Indefinite ++ xs.s2 ! g ! c
} ;
-- Noun phrases
lincat
@@ -101,6 +138,13 @@ oper
ConjDistr : Type = {s2 : State => Str ; s1 : Str} ;
conjAdv : Str -> Adverb = \s -> {
berri = s ;
c2 = NoAdp ;
np = {s = [] ; a = ZeroObj} ;
sii,dhex,miscAdv = []
} ;
conjunctDistrSS : ConjDistr -> ListX -> SS = \or,xs ->
ss (or.s1 ++ xs.s1 ++ or.s2 ! Indefinite ++ xs.s2) ;
@@ -132,13 +176,13 @@ oper
} ;
consNP : BaseNP -> BaseNP -> BaseNP = \x,y ->
x ** { agr = conjAgr x.agr (getNum y.agr) } ;
x ** { a = conjAgr x.a (getNum y.a) } ;
conjNP : BaseNP -> Conj -> BaseNP = \xs,conj ->
xs ** { agr = conjAgr xs.agr conj.nbr } ;
xs ** { a = conjAgr xs.a conj.n } ;
conjAgr : Agreement -> Number -> Agreement = \a,n ->
case n of { Pl => plAgr a ; _ => a } ;
case n of { Pl => ResSom.plAgr a ; _ => a } ;
conjNbr : Number -> Number -> Number = \n,m ->
case n of { Pl => Pl ; _ => m } ;

View File

@@ -1,4 +1,4 @@
concrete ConstructionSom of Construction = CatSom ** open ParadigmsSom in {
concrete ConstructionSom of Construction = CatSom ** open ParadigmsSom, GrammarSom, ResSom in {
lincat
Timeunit = N ;
@@ -6,6 +6,53 @@ lincat
Monthday = NP ;
Month = N ;
Year = NP ;
lin
ready_VP = UseComp (CompAP (PositA (mkA "diyaar"))) ;
has_age_VP card = UseComp (CompAdv (mkAdv (card.s ! Hal ++ "jir"))) ;
monthAdv m = mkAdv (m.s ! Indef Sg) ;
yearAdv y = mkAdv (y.s ! Abs) ;
intYear i = lin NP (indeclNP i.s) ;
weekdayPunctualAdv w = mkAdv (w.s ! Indef Sg) ;
weekdayHabitualAdv w = mkAdv (w.s ! Indef Pl) ;
weekdayNextAdv w = mkAdv ("maalinta xigta" ++ w.s ! Indef Sg) ;
weekdayLastAdv w = mkAdv ("maalintii hore" ++ w.s ! Indef Sg) ;
weekdayN w = w ;
monthN m = m ;
weekdayPN w = mkPN (w.s ! Indef Sg) ;
monthPN m = mkPN (m.s ! Indef Sg) ;
cup_of_CN np = PartNP (UseN (mkN "koob")) np ;
n_units_AP card cn a = lin AP {
s = \\af => card.s ! Hal ++ cn.s ! Indef Sg ++ a.s ! af ;
compar = []
} ;
n_units_of_NP card cn np =
lin NP (indeclNP (card.s ! Hal ++ cn.s ! Indef Sg ++ "oo" ++ np.s ! Abs)) ;
monday_Weekday = mkN "isniin" ;
tuesday_Weekday = mkN "talaado" ;
wednesday_Weekday = mkN "arbaco" ;
thursday_Weekday = mkN "khamiis" ;
friday_Weekday = mkN "jimce" ;
saturday_Weekday = mkN "sabti" ;
sunday_Weekday = mkN "axad" ;
january_Month = mkN "janaayo" ;
february_Month = mkN "febaraayo" ;
march_Month = mkN "maarso" ;
april_Month = mkN "abriil" ;
may_Month = mkN "maajo" ;
june_Month = mkN "juun" ;
july_Month = mkN "luuliyo" ;
august_Month = mkN "agoosto" ;
september_Month = mkN "sebtembar" ;
october_Month = mkN "oktoobar" ;
november_Month = mkN "nofembar" ;
december_Month = mkN "disembar" ;
{-
lin

View File

@@ -1,12 +1,68 @@
--# -path=.:../common:../abstract
concrete ExtendSom of Extend = CatSom
** ExtendFunctor - [GenModNP, FocusObj, ComplDirectVS, ComplDirectVQ, ExistIPQS]
** ExtendFunctor - [
GenModNP, FocusObj, ComplDirectVS, ComplDirectVQ, ExistIPQS,
BaseVPS, ConsVPS, MkVPS, ConjVPS, PredVPS, SQuestVPS,
QuestVPS, BaseVPI, ConsVPI, MkVPI, ConjVPI, ComplVPIVV,
PassVPSlash, PassAgentVPSlash, PastPartAP, PastPartAgentAP,
ProgrVPSlash, PurposeVP, ReflRNP, ReflPron, ReflPoss,
PredetRNP, ComplSlashPartLast, CompoundN, CompoundAP, GerundCN, GerundNP,
GerundAdv, WithoutVP, ByVP, InOrderToVP, ApposNP, AdAdV,
UttAdV, PositAdVAdj, CompS, CompQS
]
with (Grammar=GrammarSom)
** open Prelude, ResSom, NounSom in {
** open Prelude, ResSom, NounSom, GrammarSom, ParadigmsSom in {
lincat
VPS = {s : Agreement => Bool => Str} ;
[VPS] = {s1,s2 : Agreement => Bool => Str} ;
VPI = {s : Str} ;
[VPI] = {s1,s2 : Str} ;
[Comp] = {s1,s2 : Agreement => Str ; stm : STM} ;
[Imp] = {s1,s2 : Str} ;
lin
MkVPS t p vp = {
s = \\agr,b => (UseCl t p (PredVP (pronTable ! agr) vp)).s ! b
} ;
BaseVPS x y = {s1 = x.s ; s2 = y.s} ;
ConsVPS x xs = xs ** {
s1 = \\agr,b => x.s ! agr ! b ++ "," ++ xs.s1 ! agr ! b
} ;
ConjVPS co xs = {
s = \\agr,b => co.s1 ++ xs.s1 ! agr ! b ++ co.s2 ! Indefinite ++ xs.s2 ! agr ! b
} ;
PredVPS np vps = lin S {s = \\b => vps.s ! np.a ! b} ;
SQuestVPS np vps = {s = vps.s ! np.a ! False} ;
QuestVPS ip vps = {s = ip.s ! Abs ++ vps.s ! ip.a ! False} ;
MkVPI vp = {s = infVP vp} ;
BaseVPI x y = {s1 = x.s ; s2 = y.s} ;
ConsVPI x xs = xs ** {s1 = x.s ++ "," ++ xs.s1} ;
ConjVPI co xs = {s = co.s1 ++ xs.s1 ++ co.s2 ! Indefinite ++ xs.s2} ;
ComplVPIVV vv vpi = UseComp (CompAdv (mkAdv vpi.s)) ;
BaseComp x y = {s1 = compStr x ; s2 = compStr y ; stm = x.stm} ;
ConsComp x xs = xs ** {
s1 = \\agr => compStr x ! agr ++ "," ++ xs.s1 ! agr
} ;
ConjComp co xs = {
aComp = \\agr => co.s1 ++ xs.s1 ! agr ++ co.s2 ! Indefinite ++ xs.s2 ! agr ;
nComp = [] ;
compar = [] ;
stm = xs.stm
} ;
BaseImp x y = {s1 = x.s ! Sg ! Pos ; s2 = y.s ! Sg ! Pos} ;
ConsImp x xs = xs ** {
s1 = x.s ! Sg ! Pos ++ "," ++ xs.s1
} ;
ConjImp co xs = {
s = \\num,pol => co.s1 ++ xs.s1 ++ co.s2 ! Indefinite ++ xs.s2
} ;
-- : Num -> NP -> CN -> NP ; -- this man's car(s)
GenModNP num np cn = DetCN (DetQuant IndefArt num) (genModCN cn np) ;
@@ -15,6 +71,98 @@ lin
-- FocusAdv : Adv -> S -> Utt ; -- today I will sleep
-- FocusAdV : AdV -> S -> Utt ; -- never will I sleep
-- FocusAP : AP -> NP -> Utt ; -- green was the tree
-- FocusAP : AP -> NP -> Utt ; -- green was the tree
UseDAP dap = DetNP dap ;
UseDAPMasc dap = DetNP (dap ** {sp = \\_,c => dap.sp ! Masc ! c}) ;
UseDAPFem dap = DetNP (dap ** {sp = \\_,c => dap.sp ! Fem ! c}) ;
PassVPSlash vps = lin VP (passVP vps) ;
PassAgentVPSlash vps np = AdvVP (lin VP (passVP vps)) (mkAdv (np.s ! Abs)) ;
PresPartAP vp = partAP vp ;
PastPartAP vps = partAP (lin VP (passVP vps)) ;
PastPartAgentAP vps np = lin AP {
s = \\af => np.s ! Abs ++ linVP (VRel (af2gn af)) Subord vps ;
compar = []
} ;
CompoundN n1 n2 = n2 ** {
s = \\nf => n1.s ! Indef Sg ++ n2.s ! nf
} ;
CompoundAP n a = lin AP {
s = \\af => n.s ! Indef Sg ++ a.s ! af ;
compar = []
} ;
GerundCN vp = strCN (infVP vp) ;
GerundNP vp = MassNP (GerundCN vp) ;
GerundAdv vp = mkAdv (infVP vp) ;
ByVP vp = mkAdv ("adigoo" ++ infVP vp) ;
WithoutVP vp = mkAdv (infVP vp ++ "la'aan") ;
InOrderToVP vp = mkAdv ("si" ++ infVP vp) ;
PurposeVP = InOrderToVP ;
ApposNP np app = np ** {
s = \\c => np.s ! c ++ "," ++ app.s ! Abs ;
isPron = False
} ;
AdAdV ada adv = {s = ada.s ++ adv.s} ;
UttAdV adv = {s = adv.s} ;
PositAdVAdj a = {s = "si" ++ a.s ! AF Sg Abs} ;
CompS s = CompAdv (mkAdv (s.s ! True)) ;
CompQS qs = CompAdv (mkAdv qs.s) ;
ProgrVPSlash = ProgrVP ;
ComplSlashPartLast = ComplSlash ;
ReflPron = lin NP (indeclNP "is") ;
ReflPoss num cn = DetCN (DetQuant (PossPron he_Pron) num) cn ;
ReflRNP vps rnp = ComplSlash vps rnp ;
ReflA2RNP a2 rnp = ComplA2 a2 rnp ;
PredetRNP pred rnp = PredetNP pred rnp ;
AdvRNP np prep rnp = AdvNP np (PrepNP prep rnp) ;
AdvRVP vp prep rnp = AdvVP vp (PrepNP prep rnp) ;
AdvRAP ap prep rnp = AdvAP ap (PrepNP prep rnp) ;
PossPronRNP pron num cn rnp =
DetCN (DetQuant (PossPron pron) num) (PossNP cn rnp) ;
RecipVPSlash = ReflVP ;
RecipVPSlashCN vps cn = ReflVP vps ;
oper
af2gn : AForm -> GenNum = \af -> case af of {
AF Pl _ => PlInv ;
AF Sg _ => SgMasc
} ;
partAP : VP -> AP = \vp -> lin AP {
s = \\af => linVP (VRel (af2gn af)) Subord vp ;
compar = []
} ;
strCN : Str -> CN = \s -> lin CN {
s = table {
Indef _ => s ;
Def _ => s ;
NomSg => s ;
Numerative => s
} ;
gda = MM KA KA ;
shortPoss = False ;
mod = \\_,_,_ => [] ;
modtype = NoMod ;
isPoss = False ;
a = Sg3 Masc ;
isPron = False ;
st = Indefinite ;
empty = []
} ;
compStr : Complement -> Agreement => Str = \comp ->
\\agr => comp.aComp ! agr ++ comp.nComp ++ comp.compar ;
} ;

View File

@@ -26,9 +26,10 @@ concrete IdiomSom of Idiom = CatSom ** open Prelude, ResSom, VerbSom, NounSom, S
-- 7/12/2012 generalizations of these
ExistNPAdv : NP -> Adv -> Cl ; -- there is a house in Paris
ExistIPAdv : IP -> Adv -> QCl ; -- which houses are there in Paris
-}
ExistNPAdv np adv = ExistNP (AdvNP np adv) ;
-- : VP -> VP ;
ProgrVP vp = vp ** {
s = table {
@@ -39,9 +40,10 @@ concrete IdiomSom of Idiom = CatSom ** open Prelude, ResSom, VerbSom, NounSom, S
} ;
{- TODO: Saeed p. 92 and 207, optative
-- : VP -> Utt ; -- let's go
ImpPl1 vp = { } ;
ImpPl1 vp = {s = "aan" ++ linVP (VImp Pl Pos) Statement vp} ;
{- TODO: Saeed p. 92 and 207, optative
ImpP3 : NP -> VP -> Utt ; -- let John walk

View File

@@ -1,4 +1,4 @@
concrete NamesSom of Names = CatSom ** open ResSom, Prelude in {
concrete NamesSom of Names = CatSom ** open ResSom, ParadigmsSom, Prelude in {
lin GivenName, MaleSurname, FemaleSurname = \n -> n ** {
s = \\c => n.s ;
@@ -22,4 +22,10 @@ lin FullName gn sn = {
empty = [] ;
} ;
InLN ln = prepNP (mkPrep ku) (UseLN ln) ;
AdjLN ap ln = ln ** {
s = ap.s ! AF Sg Abs ++ ln.s
} ;
}

View File

@@ -94,7 +94,15 @@ concrete NounSom of Noun = CatSom ** open ResSom, Prelude in {
-- s = \\c => v2.s ! ??? ++ np.s ! c } ; ----
-- : NP -> Adv -> NP ; -- Paris today ; boys, such as ..
--AdvNP,ExtAdvNP = \np,adv -> np ** {} ; --adverbs are complicated
AdvNP np adv = np ** {
s = \\c => objpron np ! c ++ linAdv adv ;
isPron = False
} ;
ExtAdvNP np adv = np ** {
s = \\c => objpron np ! c ++ "," ++ linAdv adv ;
isPron = False
} ;
-- : NP -> RS -> NP ; -- Paris, which is here
{- NB. technically, if the RS has undergone ConjRS, it could contain both
@@ -174,18 +182,29 @@ concrete NounSom of Noun = CatSom ** open ResSom, Prelude in {
} ;
-- : Digits -> Card ;
-- NumDigits dig = { s = dig.s ! NCard ; n = dig.n } ;
NumDigits dig = baseNum ** {
s = \\_ => dig.s ! NCard ;
da = M KA ;
n = dig.n
} ;
NumDecimal dec = baseNum ** {
s = \\_ => dec.s ! NCard ;
da = M KA ;
n = dec.n
} ;
-- : Numeral -> Card ;
NumNumeral num = num ; -- ** {s = num.s ! NCard};
{-
-- : AdN -> Card -> Card ;
AdNum adn card = card ** { s = adn.s ++ card.s } ;
AdNum adn card = card ** { s = \\df => adn.s ++ card.s ! df } ;
-- : Digits -> Ord ;
OrdDigits digs = digs ** { s = digs.s ! NOrd } ;
-}
OrdDigits digs = {
s = \\_ => digs.s ! NOrd ;
n = digs.n
} ;
-- : Numeral -> Ord ;
OrdNumeral num = num ** {
s = \\_ => num.ord
@@ -269,16 +288,33 @@ concrete NounSom of Noun = CatSom ** open ResSom, Prelude in {
modtype = AMod
} ;
{-
-- : CN -> Adv -> CN ;
AdvCN cn adv = cn ** { } ;
AdvCN cn adv = cn ** {
s = table {
Numerative => cn.s ! Numerative ++ andConj Indefinite (notMod cn.modtype) ;
nf => cn.s ! nf } ;
mod = \\st,n,c =>
cn.mod ! st ! n ! Abs
++ andConj st cn.modtype
++ linAdv adv ;
modtype = OtherMod
} ;
-- Nouns can also be modified by embedded sentences and questions.
-- For some nouns this makes little sense, but we leave this for applications
-- to decide. Sentential complements are defined in VerbSom.
-- : CN -> SC -> CN ; -- question where she sleeps
SentCN cn sc = cn ** { } ;
SentCN cn sc = cn ** {
s = table {
Numerative => cn.s ! Numerative ++ andConj Indefinite (notMod cn.modtype) ;
nf => cn.s ! nf } ;
mod = \\st,n,c =>
cn.mod ! st ! n ! Abs
++ andConj st cn.modtype
++ sc.s ;
modtype = OtherMod
} ;
--2 Apposition
@@ -286,8 +322,13 @@ concrete NounSom of Noun = CatSom ** open ResSom, Prelude in {
-- This is certainly overgenerating.
-- : CN -> NP -> CN ; -- city Paris (, numbers x and y)
ApposCN cn np = cn ** { s = } ;
-}
ApposCN cn np = cn ** {
mod = \\st,n,c =>
cn.mod ! st ! n ! Abs
++ andConj st cn.modtype
++ np.s ! Abs ;
modtype = OtherMod
} ;
--2 Possessive and partitive constructs
@@ -311,22 +352,26 @@ concrete NounSom of Noun = CatSom ** open ResSom, Prelude in {
_ => OtherMod }
} ;
{-
-- This is different from the partitive, as shown by many languages.
-- : Det -> NP -> NP ;
CountNP det np = np **
{ } ; -- Nonsense for DefArt or IndefArt
{ s = \\c => det.sp ! Masc ! c ++ objpron np ! Abs ;
a = getAgr det.n Masc ;
isPron = False } ; -- Nonsense for DefArt or IndefArt
--3 Conjoinable determiners and ones with adjectives
-- : DAP -> AP -> DAP ; -- the large (one)
AdjDAP dap ap = dap ** { } ;
AdjDAP dap ap = dap ** {
s = \\da,c => dap.s ! da ! c ++ ap.s ! AF dap.n c ;
sp = \\g,c => dap.sp ! g ! c ++ ap.s ! AF dap.n c
} ;
-- : Det -> DAP ; -- this (or that)
DetDAP det = det ;
-}
QuantityNP dec mu = indeclNP (dec.s ! NCard ++ mu.s) ;
oper
andConj : State -> ModType -> Str = \st,mod ->

View File

@@ -129,8 +129,75 @@ lin pot3plus n m = n ** {
n = Pl} ;
lin pot3as4 n = n ;
lin pot41 = {
s = \\_ => [] ;
thousand = "milyan" ;
hasThousand = True ;
ord = "milyanaad" ;
da = M KA ;
n = Pl
} ;
lin pot4 n = n ** {
thousand = n.thousand ++ "milyan" ;
hasThousand = True ;
ord = n.s ! Hal ++ n.thousand ++ "milyanaad" ;
n = Pl
} ;
lin pot4plus n m = n ** {
s = \\b => n.s ! b ++ n.thousand ++ "milyan iyo" ++ m.s ! b ++ m.thousand ;
thousand = [] ;
hasThousand = True ;
ord = n.s ! Hal ++ n.thousand ++ "milyan iyo" ++ m.ord ;
n = Pl
} ;
lin pot4as5 n = n ;
lin pot4decimal dec = {
s = \\_ => dec.s ! NCard ;
thousand = "milyan" ;
hasThousand = True ;
ord = dec.s ! NCard ++ "milyanaad" ;
da = M KA ;
n = Pl
} ;
lin pot51 = {
s = \\_ => [] ;
thousand = "bilyan" ;
hasThousand = True ;
ord = "bilyanaad" ;
da = M KA ;
n = Pl
} ;
lin pot5 n = n ** {
thousand = n.thousand ++ "bilyan" ;
hasThousand = True ;
ord = n.s ! Hal ++ n.thousand ++ "bilyanaad" ;
n = Pl
} ;
lin pot5plus n m = n ** {
s = \\b => n.s ! b ++ n.thousand ++ "bilyan iyo" ++ m.s ! b ++ m.thousand ;
thousand = [] ;
hasThousand = True ;
ord = n.s ! Hal ++ n.thousand ++ "bilyan iyo" ++ m.ord ;
n = Pl
} ;
lin pot5decimal dec = {
s = \\_ => dec.s ! NCard ;
thousand = "bilyan" ;
hasThousand = True ;
ord = dec.s ! NCard ++ "bilyanaad" ;
da = M KA ;
n = Pl
} ;
----------------------------------------------------------------------------

View File

@@ -65,7 +65,10 @@ oper
mkA : (sg,pl : Str) -> A
} ;
-- mkA2 : Str -> Prep -> A2 ;
mkA2 : overload {
mkA2 : A -> A2 ;
mkA2 : A -> Adposition -> A2 ;
} ;
--2 Verbs
@@ -207,11 +210,31 @@ oper
mkPN : Str -> Agr -> PN = \s,a -> lin PN (mkPNoun s a)
} ;
mkGN = overload {
mkGN : Str -> GN = \s -> lin GN (mkPNoun s sgMasc) ;
mkGN : Str -> Agr -> GN = \s,a -> lin GN (mkPNoun s a)
} ;
mkSN = overload {
mkSN : Str -> SN = \s -> lin SN (mkPNoun s sgMasc) ;
mkSN : Str -> Agr -> SN = \s,a -> lin SN (mkPNoun s a)
} ;
mkLN = overload {
mkLN : Str -> LN = \s -> lin LN (mkPNoun s sgMasc) ;
mkLN : Str -> Agr -> LN = \s,a -> lin LN (mkPNoun s a)
} ;
mkA = overload {
mkA : (yar : Str) -> A = \s -> lin A (duplA s) ;
mkA : (sg,pl : Str) -> A = \s,p -> lin A (mkAdj s p)
} ;
mkA2 = overload {
mkA2 : A -> A2 = \a -> lin A2 (a ** {c2=NoAdp}) ;
mkA2 : A -> Adposition -> A2 = \a,adp -> lin A2 (a ** {c2=adp}) ;
} ;
mkV = overload {
mkV : (imp : Str) -> V = \v -> lin V (regV v) ;
mkV : (imp, sg1 : Str) -> V = \i,s1 -> lin V (reg2V i s1) ;
@@ -286,6 +309,48 @@ oper
} ;
--------------------------------------------------------------------------------
mkInterj : Str -> Interj = \s -> lin Interj {s=s} ;
mkSubj : Str -> Subj = \s -> lin Subj {s=s} ;
mkAdN : Str -> AdN = \s -> lin AdN {s=s} ;
mkCAdv : Str -> CAdv = \s -> lin CAdv {s=s; p=[]} ;
mkPConj : Str -> PConj = \s -> lin PConj {s=s} ;
mkVoc : Str -> Voc = \s -> lin Voc {s=s} ;
mkQuant : Str -> Quant = \s -> lin Quant (baseQuant ** {
s = \\allomorph,c => s ;
sp = \\gn,c => s ;
}) ;
mkCard : Str -> Card = \s -> lin Card (baseNum ** {
s = \\_ => s
}) ;
mkACard : Str -> ACard = \s -> lin ACard {s=s} ;
mkDet : Str -> Det = \s -> lin Det (baseQuant ** {
sp = \\gn,c => s ;
n = Sg ;
numtype = NoNum
}) ;
mkPredet : Str -> Predet = \s -> lin Predet {
s = s ;
da = F TA ;
isPoss = True
} ;
mkIQuant : Str -> IQuant = \s -> lin IQuant (baseQuant ** {
s = \\allomorph,c => s ;
sp = \\gn,c => s ;
}) ;
mkIDet : Str -> IDet = \s -> lin IDet (baseQuant ** {
sp = \\gn,c => s ;
n = Sg ;
numtype = NoNum
}) ;
mkConj : Str -> Conj = \s -> lin Conj {
s1 = s;
s2 = \\_ => s;
n = Sg
} ;
mkMU : Str -> MU = \s -> lin MU {s=s; isPre=False} ;
}

View File

@@ -67,7 +67,7 @@ concrete QuestionSom of Question = CatSom ** open
-- They can be modified with adverbs.
-- : IP -> Adv -> IP ; -- who in Paris
--AdvIP = NS.AdvNP ;
AdvIP ip adv = NS.AdvNP ip adv ** {contractSTM = ip.contractSTM} ;
-- Interrogative quantifiers have number forms and can take number modifiers.
@@ -81,7 +81,7 @@ concrete QuestionSom of Question = CatSom ** open
-- They can be modified with other adverbs.
-- : IAdv -> Adv -> IAdv ; -- where in Paris
-- AdvIAdv iadv adv = iadv ** {s = iadv.s ++ adv.berri} ; -- TODO do we need AdpCombination in IAdv?
AdvIAdv iadv adv = iadv ** {s = iadv.s ++ linAdv adv ; berri = iadv.berri ++ linAdv adv} ;
-- Interrogative complements to copulas can be both adverbs and
-- pronouns.

View File

@@ -4,7 +4,7 @@ concrete RelativeSom of Relative = CatSom ** open
lin
-- : Cl -> RCl ; -- such that John loves her
-- RelCl cl = {s = cl.s ! Subord} ;
RelCl cl = {s = \\g,c,t,a,p => (cl2rcl cl).s ! t ! a ! p} ;
-- : RP -> VP -> RCl ;
{- NB. this works because vfSubord only puts different forms from vfStatement
@@ -34,7 +34,7 @@ lin
IdRP = {s = ""} ; -- no overt relative pronoun "that, which". For "what" e.g. "tell me what you saw", use waxa. (Nilsson p. 107)
-- : Prep -> NP -> RP -> RP ; -- the mother of whom
--FunRP prep np rp = {} ;
FunRP prep np rp = {s = prep.s ! ZeroObj ++ np.s ! Abs ++ rp.s} ;
oper

View File

@@ -11,17 +11,18 @@ lin
PredVP = predVP ;
-- : SC -> VP -> Cl ; -- that she goes is good (Saeed p. 94)
--PredSCVP sc vp = ;
PredSCVP sc vp = predVP (lin NP (indeclNP sc.s)) vp ;
--2 Clauses missing object noun phrases
-- : NP -> VPSlash -> ClSlash ;
SlashVP = predVP ;
{-
-- : ClSlash -> Adv -> ClSlash ; -- (whom) he sees today
AdvSlash cls adv = cls ** insertAdv adv cls ;
AdvSlash cls adv = cls ** insertAdvLite cls adv ;
-- SlashPrep : Cl -> Prep -> ClSlash ; -- (with whom) he walks
-- : Cl -> Prep -> ClSlash ; -- (with whom) he walks
SlashPrep cls prep = cls ** insertAdvLite cls (prepNP prep emptyNP) ;
{-
-- : NP -> VS -> SSlash -> ClSlash ; -- (whom) she says that he loves
-- SlashVS np vs ss = {} ;
@@ -40,13 +41,17 @@ lin
-- : VP -> Imp ;
ImpVP vp = {s = \\num,pol => linVP (VImp num pol) Statement vp} ;
AdvImp adv imp = {
s = \\num,pol => linAdv adv ++ imp.s ! num ! pol
} ;
--2 Embedded sentences
-- : S -> SC ;
EmbedS s = {s = s.s ! True} ; -- choose subordinate
-- : QS -> SC ;
-- EmbedQS qs = { } ;
EmbedQS qs = {s = qs.s} ;
-- : VP -> SC ;
EmbedVP vp = {s = infVP vp} ;

View File

@@ -53,9 +53,19 @@ lin
ComplVQ vq qs = ;
-- : VA -> AP -> VP ; -- they become red
ComplVA va ap = ResSom.insertComp (CompAP ap).s (useV va) ;
-}
ComplVQ vq qs =
let vps = useV vq
in vps ** {obj = {s = qs.s ; a = ZeroObj}} ;
-- : VA -> AP -> VP ; -- they become red
ComplVA va ap =
let comp = CompAP ap
in useV va ** {
aComp = comp.aComp ;
nComp = comp.nComp ;
compar = comp.compar
} ;
--------
-- Slash
@@ -73,13 +83,15 @@ lin
subord = SubjS {s="in"} s ;
in vps ** {obj = {s = subord.berri ; a = ZeroObj}} ;
{-
-- : V2V -> VP -> VPSlash ; -- beg (her) to go
SlashV2V v2v vp = ;
SlashV2V v2v vp = useVc v2v ** {
vComp = {subjunc = [] ; inf = infVP vp ; subcl = \\_ => []}
} ;
-- : V2Q -> QS -> VPSlash ; -- ask (him) who came
SlashV2Q v2q qs = ;
-}
SlashV2Q v2q qs = useVc v2q ** {
miscAdv = qs.s
} ;
-- : V2A -> AP -> VPSlash ; -- paint (it) red
-- TODO: is "red" plural in "paint them red"?
SlashV2A v2a ap = useVc v2a ** {
@@ -89,20 +101,13 @@ lin
-- : VPSlash -> NP -> VP
ComplSlash = insertComp ;
{-
-- : VV -> VPSlash -> VPSlash ;
-- Just like ComplVV except missing subject!
SlashVV vv vps = ComplVV vv vps ** { missing = vps.missing ;
post = vps.post } ;
SlashVV vv vps = ComplVV vv vps ;
-- : V2V -> NP -> VPSlash -> VPSlash ; -- beg me to buy
SlashV2VNP v2v np vps =
ComplVV v2v vps **
{ missing = vps.missing ;
post = vps.post ;
iobj = np ** { s = np.s ! Dat } } ;
-}
insertComp (SlashV2V v2v vps) np ;
-- : Comp -> VP ;
UseComp comp = UseCopula ** comp ;
@@ -113,17 +118,15 @@ lin
-- : VPSlash -> Adv -> VPSlash ; -- use (it) here
AdvVPSlash = insertAdv ;
{-
-- : VP -> Adv -> VP ; -- sleep , even though ...
ExtAdvVP vp adv = ;
ExtAdvVP = AdvVP ;
-- : AdV -> VP -> VP ; -- always sleep
AdVVP adv vp = vp ** {adv = adv} ;
AdVVP adv vp = vp ** {berri = vp.berri ++ adv.s} ;
-- : AdV -> VPSlash -> VPSlash ; -- always use (it)
AdVVPSlash adv vps = vps ** { adv = adv.s ++ vps.adv } ;
-}
AdVVPSlash adv vps = vps ** {berri = vps.berri ++ adv.s} ;
-- : VP -> Prep -> VPSlash ; -- live in (it)
VPSlashPrep vp prep =
let adv = prepNP prep emptyNP