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 -- : 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 -- : 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 -- : A2 -> AP ; -- married
UseA2 = PositA ; UseA2 = PositA ;
@@ -35,7 +41,9 @@ concrete AdjectiveSom of Adjective = CatSom ** open ResSom, Prelude in {
-- : CAdv -> AP -> NP -> AP ; -- as cool as John -- : 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$. -- 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 -- : AP -> SC -> AP ; -- good that she is here
SentAP ap sc = ap ** { 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". -- An adjectival phrase can be modified by an *adadjective*, such as "very".
-- : AdA -> AP -> AP ; -- : 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. -- It can also be postmodified by an adverb, typically a prepositional phrase.
-- : AP -> Adv -> AP ; -- warm by nature -- : 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 lin
-- : A -> Adv ; -- : A -> Adv ;
--PositAdvAdj adj = { } ; PositAdvAdj adj = mkAdv ("si" ++ adj.s ! AF Sg Abs) ;
-- : CAdv -> A -> NP -> Adv ; -- more warmly than John -- : 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 -> 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 ; -- : Prep -> NP -> Adv ;
PrepNP = prepNP ; PrepNP = prepNP ;
-- Adverbs can be modified by 'adadjectives', just like adjectives. -- Adverbs can be modified by 'adadjectives', just like adjectives.
--AdAdv : AdA -> Adv -> Adv ; -- very quickly
AdAdv ada adv = adv ** {berri = ada.s ++ adv.berri} ; AdAdv ada adv = adv ** {berri = ada.s ++ adv.berri} ;
-- Like adverbs, adadjectives can be produced by adjectives. -- Like adverbs, adadjectives can be produced by adjectives.
-- : A -> AdA ; -- extremely -- : A -> AdA ; -- extremely
-- PositAdAAdj a = { } ; PositAdAAdj a = mkAdA (a.s ! AF Sg Abs) ;
-- Subordinate clauses can function as adverbs. -- Subordinate clauses can function as adverbs.
-- : Subj -> S -> Adv ; -- : Subj -> S -> Adv ;
@@ -28,6 +30,5 @@ lin
-- Comparison adverbs also work as numeral adverbs. -- Comparison adverbs also work as numeral adverbs.
--AdnCAdv : CAdv -> AdN ; -- less (than five) AdnCAdv cadv = {s = cadv.s ++ cadv.p} ;
--AdnCAdv cadv = {s = } ;
} ; } ;

View File

@@ -125,8 +125,12 @@ concrete CatSom of Cat = CommonX - [Adv,IAdv] ** open ResSom, Prelude in {
linref linref
-- Cl = linCl ; -- Cl = linCl ;
V, VS, VQ, VA, VV, V2A, V2V, V2S, V2Q, V2, V3 = \v -> v.s ! VImp Sg Pos ; V, VS, VQ, VA, VV = \v -> v.s ! VImp Sg Pos ;
VP = infVP ; 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 ; CN = linCN ;
Prep = \prep -> prep.s ! ZeroObj ++ prep.sii ++ prep.dhex ++ prep.hoostiisa ! Sg3 Masc ; 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 lincat
[Adv],[AdV],[IAdv] = {s1,s2 : Str} ; [Adv],[AdV] = {s1,s2 : Str} ;
[IAdv] = {s1 : Str; s2 : IAdv} ;
lin lin
BaseAdv, BaseAdV, BaseIAdv = twoSS ; BaseAdv x y = {s1 = linAdv x ; s2 = linAdv y} ;
ConsAdv, ConsAdV, ConsIAdv = consrSS comma ; ConsAdv x xs = xs ** {s1 = linAdv x ++ comma ++ xs.s1} ;
ConjAdv, ConjAdV, ConjIAdv = conjunctDistrSS ; 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 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. -- RS can modify CNs, which are open for state, number and case, and have inherent gender.
lincat lincat
[RS] = {s1,s2 : State => Gender => Case => Str} ; [RS] = {s1,s2 : State => GenNum => Case => Str} ;
lin lin
BaseRS = twoTable3 State GenNum Case ; BaseRS = twoTable3 State GenNum Case ;
ConsRS = consrTable3 State GenNum Case comma ; ConsRS = consrTable3 State GenNum Case comma ;
ConjRS = conjunctRSTable ; ConjRS = conjunctRSTable ;
{-
lincat lincat
[S] = {} ; [S] = {s1,s2 : Bool => Str} ;
lin lin
BaseS x y = y ** { } ; BaseS = twoTable Bool ;
ConsS x xs = ConsS x xs =
xs ** { } ; consrTable Bool comma x xs ;
ConjS co xs = {} ; ConjS co xs = conjunctDistrTable' Bool co xs ;
lincat lincat
[AP] = {} ; [AP] = {s1,s2 : AForm => Str ; compar : Str} ;
lin lin
BaseAP x y = twoTable Agr x y ** y ; --choose all the other fields from second argument BaseAP x y = twoTable AForm x y ** {compar = y.compar} ;
ConsAP as a = consrTable Agr comma as a ** as ; ConsAP x xs = consrTable AForm comma x xs ** {compar = xs.compar} ;
ConjAP co as = conjunctDistrTable Agr co as ** as ; ConjAP co xs = {
s = \\af => co.s1 ++ xs.s1 ! af ++ co.s2 ! Indefinite ++ xs.s2 ! af ;
compar = xs.compar
} ;
lincat lincat
[CN] = { } ; [CN] = {s1,s2 : Number => Case => Str ; cn : CNoun} ;
lin lin
BaseCN = {} ; BaseCN x y = {
ConsCN = {} ; s1 = \\n,c => cn2str n c x ;
ConjCN co cs = conjunctDistrTable Agr co cs ** cs ; 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 lincat
[DAP] = Determiner ** { pref2 : Str } ; [DAP] = {s1,s2 : Gender => Case => Str ; det : Determiner} ;
lin lin
BaseDAP x y = x ** { pref2 = y.pref } ; BaseDAP x y = {
ConsDAP xs x = xs ** { pref2 = x.pref } ; s1 = x.sp ;
ConjDet conj xs = xs ** { pref = conj.s1 ++ xs.pref ++ conj.s2 ++ xs.pref2 } ; 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 -- Noun phrases
lincat lincat
@@ -101,6 +138,13 @@ oper
ConjDistr : Type = {s2 : State => Str ; s1 : Str} ; 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 -> conjunctDistrSS : ConjDistr -> ListX -> SS = \or,xs ->
ss (or.s1 ++ xs.s1 ++ or.s2 ! Indefinite ++ xs.s2) ; ss (or.s1 ++ xs.s1 ++ or.s2 ! Indefinite ++ xs.s2) ;
@@ -132,13 +176,13 @@ oper
} ; } ;
consNP : BaseNP -> BaseNP -> BaseNP = \x,y -> 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 -> 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 -> 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 -> conjNbr : Number -> Number -> Number = \n,m ->
case n of { Pl => Pl ; _ => 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 lincat
Timeunit = N ; Timeunit = N ;
@@ -6,6 +6,53 @@ lincat
Monthday = NP ; Monthday = NP ;
Month = N ; Month = N ;
Year = NP ; 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 lin

View File

@@ -1,12 +1,68 @@
--# -path=.:../common:../abstract --# -path=.:../common:../abstract
concrete ExtendSom of Extend = CatSom 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) 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 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) -- : Num -> NP -> CN -> NP ; -- this man's car(s)
GenModNP num np cn = DetCN (DetQuant IndefArt num) (genModCN cn np) ; GenModNP num np cn = DetCN (DetQuant IndefArt num) (genModCN cn np) ;
@@ -17,4 +73,96 @@ lin
-- FocusAdV : AdV -> S -> Utt ; -- never will I 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 -- 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 ExistIPAdv : IP -> Adv -> QCl ; -- which houses are there in Paris
-} -}
ExistNPAdv np adv = ExistNP (AdvNP np adv) ;
-- : VP -> VP ; -- : VP -> VP ;
ProgrVP vp = vp ** { ProgrVP vp = vp ** {
s = table { 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 -- : 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 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 ** { lin GivenName, MaleSurname, FemaleSurname = \n -> n ** {
s = \\c => n.s ; s = \\c => n.s ;
@@ -22,4 +22,10 @@ lin FullName gn sn = {
empty = [] ; 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 } ; ---- -- s = \\c => v2.s ! ??? ++ np.s ! c } ; ----
-- : NP -> Adv -> NP ; -- Paris today ; boys, such as .. -- : 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 -- : NP -> RS -> NP ; -- Paris, which is here
{- NB. technically, if the RS has undergone ConjRS, it could contain both {- 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 ; -- : 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 ; -- : Numeral -> Card ;
NumNumeral num = num ; -- ** {s = num.s ! NCard}; NumNumeral num = num ; -- ** {s = num.s ! NCard};
{-
-- : AdN -> Card -> Card ; -- : 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 ; -- : Digits -> Ord ;
OrdDigits digs = digs ** { s = digs.s ! NOrd } ; OrdDigits digs = {
-} s = \\_ => digs.s ! NOrd ;
n = digs.n
} ;
-- : Numeral -> Ord ; -- : Numeral -> Ord ;
OrdNumeral num = num ** { OrdNumeral num = num ** {
s = \\_ => num.ord s = \\_ => num.ord
@@ -269,16 +288,33 @@ concrete NounSom of Noun = CatSom ** open ResSom, Prelude in {
modtype = AMod modtype = AMod
} ; } ;
{-
-- : CN -> Adv -> CN ; -- : 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. -- Nouns can also be modified by embedded sentences and questions.
-- For some nouns this makes little sense, but we leave this for applications -- For some nouns this makes little sense, but we leave this for applications
-- to decide. Sentential complements are defined in VerbSom. -- to decide. Sentential complements are defined in VerbSom.
-- : CN -> SC -> CN ; -- question where she sleeps -- : 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 --2 Apposition
@@ -286,8 +322,13 @@ concrete NounSom of Noun = CatSom ** open ResSom, Prelude in {
-- This is certainly overgenerating. -- This is certainly overgenerating.
-- : CN -> NP -> CN ; -- city Paris (, numbers x and y) -- : 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 --2 Possessive and partitive constructs
@@ -311,22 +352,26 @@ concrete NounSom of Noun = CatSom ** open ResSom, Prelude in {
_ => OtherMod } _ => OtherMod }
} ; } ;
{-
-- This is different from the partitive, as shown by many languages. -- This is different from the partitive, as shown by many languages.
-- : Det -> NP -> NP ; -- : Det -> NP -> NP ;
CountNP 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 --3 Conjoinable determiners and ones with adjectives
-- : DAP -> AP -> DAP ; -- the large (one) -- : 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) -- : Det -> DAP ; -- this (or that)
DetDAP det = det ; DetDAP det = det ;
-}
QuantityNP dec mu = indeclNP (dec.s ! NCard ++ mu.s) ;
oper oper
andConj : State -> ModType -> Str = \st,mod -> andConj : State -> ModType -> Str = \st,mod ->

View File

@@ -129,8 +129,75 @@ lin pot3plus n m = n ** {
n = Pl} ; n = Pl} ;
lin pot3as4 n = n ; 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 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 mkA : (sg,pl : Str) -> A
} ; } ;
-- mkA2 : Str -> Prep -> A2 ; mkA2 : overload {
mkA2 : A -> A2 ;
mkA2 : A -> Adposition -> A2 ;
} ;
--2 Verbs --2 Verbs
@@ -207,11 +210,31 @@ oper
mkPN : Str -> Agr -> PN = \s,a -> lin PN (mkPNoun s a) 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 = overload {
mkA : (yar : Str) -> A = \s -> lin A (duplA s) ; mkA : (yar : Str) -> A = \s -> lin A (duplA s) ;
mkA : (sg,pl : Str) -> A = \s,p -> lin A (mkAdj s p) 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 = overload {
mkV : (imp : Str) -> V = \v -> lin V (regV v) ; mkV : (imp : Str) -> V = \v -> lin V (regV v) ;
mkV : (imp, sg1 : Str) -> V = \i,s1 -> lin V (reg2V i s1) ; 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} ; 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. -- They can be modified with adverbs.
-- : IP -> Adv -> IP ; -- who in Paris -- : 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. -- 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. -- They can be modified with other adverbs.
-- : IAdv -> Adv -> IAdv ; -- where in Paris -- : 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 -- Interrogative complements to copulas can be both adverbs and
-- pronouns. -- pronouns.

View File

@@ -4,7 +4,7 @@ concrete RelativeSom of Relative = CatSom ** open
lin lin
-- : Cl -> RCl ; -- such that John loves her -- : 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 ; -- : RP -> VP -> RCl ;
{- NB. this works because vfSubord only puts different forms from vfStatement {- 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) 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 -- : 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 oper

View File

@@ -11,17 +11,18 @@ lin
PredVP = predVP ; PredVP = predVP ;
-- : SC -> VP -> Cl ; -- that she goes is good (Saeed p. 94) -- : 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 --2 Clauses missing object noun phrases
-- : NP -> VPSlash -> ClSlash ; -- : NP -> VPSlash -> ClSlash ;
SlashVP = predVP ; SlashVP = predVP ;
{-
-- : ClSlash -> Adv -> ClSlash ; -- (whom) he sees today -- : 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 -- : NP -> VS -> SSlash -> ClSlash ; -- (whom) she says that he loves
-- SlashVS np vs ss = {} ; -- SlashVS np vs ss = {} ;
@@ -40,13 +41,17 @@ lin
-- : VP -> Imp ; -- : VP -> Imp ;
ImpVP vp = {s = \\num,pol => linVP (VImp num pol) Statement vp} ; 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 --2 Embedded sentences
-- : S -> SC ; -- : S -> SC ;
EmbedS s = {s = s.s ! True} ; -- choose subordinate EmbedS s = {s = s.s ! True} ; -- choose subordinate
-- : QS -> SC ; -- : QS -> SC ;
-- EmbedQS qs = { } ; EmbedQS qs = {s = qs.s} ;
-- : VP -> SC ; -- : VP -> SC ;
EmbedVP vp = {s = infVP vp} ; EmbedVP vp = {s = infVP vp} ;

View File

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