copy files over from GF-latin

This commit is contained in:
Herbert Lange
2019-01-14 16:40:07 +01:00
parent 579bdfcca5
commit 58c8cf70ea
492 changed files with 6213807 additions and 809 deletions
+548 -108
View File
@@ -2,7 +2,7 @@
--1 Latin auxiliary operations.
resource ResLat = ParamX ** open Prelude,TenseX in {
resource ResLat = ParamX ** open Prelude, Predef, (C=CommonX) in {
param
Case = Nom | Acc | Gen | Dat | Abl | Voc ;
@@ -12,36 +12,47 @@ param
oper
consonant : pattern Str = #( "p" | "b" | "f" | "v" | "m" | "t" | "d" | "s" | "z" | "n" | "r" | "c" | "g" | "l" | "q" | "qu" | "h" );
Noun : Type = {s : Number => Case => Str ; g : Gender} ;
Noun : Type = {s : Number => Case => Str ; g : Gender } ; -- massable : Bool } ;
NounPhrase : Type =
{
s : Case => Str ;
g : Gender ;
n : Number ;
p : Person ;
adv : Str ;
preap : {s : Agr => Str } ;
postap : {s : Agr => Str } ;
det : Determiner
} ;
param
Order = SVO | VSO | VOS | OSV | OVS | SOV ;
Order = SVO | VSO | VOS | OSV | OVS | SOV ;
AdvPos = PreS | PreV | PreO | PreNeg | InV | InS ; -- | InO
SAdvPos = SPreS | SPreV | SPreO | SPreNeg ;
param
Agr = Ag Gender Number Case ; -- Agreement for NP et al.
oper
Adjective : Type = {
s : Degree => Agr => Str ;
-- comp_adv : Str ;
-- super_adv : Str
-- super_adv : Str
adv : Adverb ;
} ;
ComplexNoun : Type =
CommonNoun : Type =
{
s : Number => Case => Str ;
g : Gender ;
adv : Str ;
preap : {s : Agr => Str } ;
postap : {s : Agr => Str } ;
} ;
postap : {s : Agr => Str }
-- massable : Bool
} ;
-- nouns
useCNasN : ComplexNoun -> Noun = \cn ->
useCNasN : CommonNoun -> Noun = \cn ->
{
s = cn.s ;
g = cn.g ;
g = cn.g
-- massable = cn.massable;
} ;
pluralN : Noun -> Noun = \n ->
@@ -52,11 +63,39 @@ param
};
g = n.g ;
preap = n.preap ;
postap = n.postap ;
postap = n.postap
-- massable = n.massable ;
};
mkNoun : (n1,_,_,_,_,_,_,_,_,n10 : Str) -> Gender -> Noun =
singularN : Noun -> Noun = \n ->
lin N {
s = table {
Sg => n.s ! Sg ;
Pl => \\_ => nonExist -- no plural forms
};
g = n.g ;
preap = n.preap ;
postap = n.postap
-- massable = n.massable ;
};
param
AdjPos = Pre | Post ;
oper
addAdjToCN : AdjectivePhrase -> CommonNoun -> AdjPos -> CommonNoun = \ap,cn,pos ->
{
s = cn.s ;
postap = case pos of { Pre => cn.postap ; Post => { s = \\a => ap.s ! a ++ cn.postap.s ! a } } ;
preap = case pos of { Pre => { s = \\a => ap.s ! a ++ cn.preap.s ! a } ; Post => cn.preap } ;
g = cn.g ;
adv = cn.adv
-- massable = cn.massable
} ;
mkNoun : (n1,_,_,_,_,_,_,_,_,n10 : Str) -> Gender -> Noun =
\sn,sa,sg,sd,sab,sv,pn,pa,pg,pd,g -> {
-- mkNoun : (n1,_,_,_,_,_,_,_,_,n10 : Str) -> Gender -> Bool -> Noun =
--\sn,sa,sg,sd,sab,sv,pn,pa,pg,pd,g,m -> {
s = table {
Sg => table {
Nom => sn ;
@@ -74,31 +113,51 @@ param
}
} ;
g = g
-- massable = m
} ;
-- to change the default gender
nounWithGen : Gender -> Noun -> Noun = \g,n ->
{s = n.s ; g = g} ;
nounWithGender : Gender -> Noun -> Noun = \g,n ->
{s = n.s ; g = g } ; -- massable = n.massable ;} ;
-- nounMassable : Bool -> Noun -> Noun = \m,n ->
-- {s = n.s ; g = n.g ; massable = m } ;
prefixNoun : Str -> Noun -> Noun =
\p,n ->
{ s = \\num,cas => addPrefix p (n.s ! num ! cas) ; g = n.g };
regNP : (_,_,_,_,_,_ : Str) -> Gender -> Number -> NounPhrase =
\nom,acc,gen,dat,abl,voc,g,n ->
{
s = table Case [ nom ; acc ; gen ; dat ; abl ; voc ] ;
g = g ;
n = n ;
p = P3
p = P3;
adv = "" ;
preap, postap = { s = \\_ => "" } ;
det = { s = \\_,_ => "" ; sp = \\_,_ => "" ; n = n} ;
} ;
emptyNP : NounPhrase = { s = \\_ => ""; g = Masc; n = Sg; p = P1 };
dummyNP : Str -> NounPhrase = \s -> regNP s s s s s s Masc Sg ;
emptyNP : NounPhrase = { s = \\_ => ""; g = Masc; n = Sg; p = P1 ; adv = "" ; preap, postap = { s = \\_ => "" } ; det = { s = \\_,_ => "" ; sp = \\_,_ => "" ; n = Sg } ;};
-- also used for adjectives and so on
-- adjectives
mkAdjective : (_,_,_ : Noun) ->
AdjectivePhrase : Type = {
s : Agr => Str ;
-- isPre : Bool ; -- should have no use in latin because adjectives can appear variably before and after nouns
} ;
mkAdjective : (bonus,bona,bonum : Noun) ->
( (Agr => Str) * Str ) ->
( (Agr => Str) * Str ) -> Adjective =
\bonus,bona,bonum,melior,optimus ->
( (Agr => Str) * Str ) ->
(bono,bonius,bonissimo : Str) ->
Adjective =
\bonus,bona,bonum,melior,optimus,bono,bonius,bonissimo ->
{
s = table {
Posit => table {
@@ -110,7 +169,8 @@ param
Superl => optimus.p1
} ;
comp_adv = melior.p2 ;
super_adv = optimus.p2
super_adv = optimus.p2 ;
adv = { s = table { Posit => bono ; Compar => bonius ; Superl => bonissimo } };
} ;
@@ -128,7 +188,7 @@ param
emptyAdj : Adjective =
{ s = \\_,_ => "" ; comp_adv = "" ; super_adv = "" } ;
{ s = \\_,_ => "" ; comp_adv = "" ; super_adv = "" ; adv = { s = \\_ => "" } } ;
-- verbs
@@ -149,11 +209,16 @@ param
oper
VerbPhrase : Type = {
fin : VActForm => VQForm => Str ;
s : VActForm => VQForm => Str ;
part : VPartForm =>Agr => Str ;
inf : VInfForm => Str ;
imp : VImpForm => Str ;
obj : Str ;
adj : Agr => Str
} ;
compl : Agr => Str ; -- general complement. Agr might be ignored except for adjectives
adv : Str
} ;
ObjectVerbPhrase : Type = VerbPhrase ** {c : Preposition} ;
Verb : Type = {
act : VActForm => Str ;
@@ -203,10 +268,11 @@ param
useVPasV : VerbPhrase -> Verb = \vp ->
{
act = \\a => vp.obj ++ vp.fin ! a ! VQFalse;
act = \\a => vp.obj ++ vp.s ! a ! VQFalse;
pass = \\_ => nonExist ;
inf = \\a => vp.obj ++ vp.inf ! a ;
imp = \\_ => nonExist ;
-- inf = \\a => vp.obj ++ vp.inf ! a ;
inf = vp.inf ;
imp = vp.imp ;
ger = \\_ => nonExist ;
geriv = \\_ => nonExist ;
sup = \\_ => nonExist ;
@@ -378,25 +444,26 @@ param
pres_stem + fill.p1 + "ndo"
} ;
geriv =
( mkAdjective
( mkNoun ( pres_stem + fill.p1 + "ndus" ) ( pres_stem + fill.p1 + "ndum" ) ( pres_stem + fill.p1 + "ndi" )
( pres_stem + fill.p1 + "ndo" ) ( pres_stem + fill.p1 + "ndo" ) ( pres_stem + fill.p1 + "nde" )
( pres_stem + fill.p1 + "ndi" ) ( pres_stem + fill.p1 + "ndos" ) ( pres_stem + fill.p1 + "ndorum" )
( pres_stem + fill.p1 + "ndis" )
Masc )
( mkNoun ( pres_stem + fill.p1 + "nda" ) ( pres_stem + fill.p1 + "ndam" ) ( pres_stem + fill.p1 + "ndae" )
( pres_stem + fill.p1 + "ndae" ) ( pres_stem + fill.p1 + "nda" ) ( pres_stem + fill.p1 + "nda" )
( pres_stem + fill.p1 + "ndae" ) ( pres_stem + fill.p1 + "ndas" ) (pres_stem + fill.p1 +"ndarum" )
( pres_stem + fill.p1 + "ndis" )
Fem )
( mkNoun ( pres_stem + fill.p1 + "ndum" ) ( pres_stem + fill.p1 + "ndum" ) ( pres_stem + fill.p1 + "ndi" )
( pres_stem + fill.p1 + "ndo" ) ( pres_stem + fill.p1 + "ndo" ) ( pres_stem + fill.p1 + "ndum" )
( pres_stem + fill.p1 + "nda" ) ( pres_stem + fill.p1 + "nda" ) ( pres_stem + fill.p1 + "ndorum" )
( pres_stem + fill.p1 + "ndis" )
Neutr )
< \\_ => "" , "" >
< \\_ => "" , "" >
).s!Posit ;
( mkAdjective
( mkNoun ( pres_stem + fill.p1 + "ndus" ) ( pres_stem + fill.p1 + "ndum" ) ( pres_stem + fill.p1 + "ndi" )
( pres_stem + fill.p1 + "ndo" ) ( pres_stem + fill.p1 + "ndo" ) ( pres_stem + fill.p1 + "nde" )
( pres_stem + fill.p1 + "ndi" ) ( pres_stem + fill.p1 + "ndos" ) ( pres_stem + fill.p1 + "ndorum" )
( pres_stem + fill.p1 + "ndis" )
Masc )
( mkNoun ( pres_stem + fill.p1 + "nda" ) ( pres_stem + fill.p1 + "ndam" ) ( pres_stem + fill.p1 + "ndae" )
( pres_stem + fill.p1 + "ndae" ) ( pres_stem + fill.p1 + "nda" ) ( pres_stem + fill.p1 + "nda" )
( pres_stem + fill.p1 + "ndae" ) ( pres_stem + fill.p1 + "ndas" ) (pres_stem + fill.p1 +"ndarum" )
( pres_stem + fill.p1 + "ndis" )
Fem )
( mkNoun ( pres_stem + fill.p1 + "ndum" ) ( pres_stem + fill.p1 + "ndum" ) ( pres_stem + fill.p1 + "ndi" )
( pres_stem + fill.p1 + "ndo" ) ( pres_stem + fill.p1 + "ndo" ) ( pres_stem + fill.p1 + "ndum" )
( pres_stem + fill.p1 + "nda" ) ( pres_stem + fill.p1 + "nda" ) ( pres_stem + fill.p1 + "ndorum" )
( pres_stem + fill.p1 + "ndis" )
Neutr )
< \\_ => "" , "" > -- Comparative
< \\_ => "" , "" > -- Superlative
"" "" "" -- Adverb part
).s!Posit ;
sup =
table {
VSupAcc => -- Supin
@@ -436,6 +503,7 @@ param
Neutr )
< \\_ => "" , "" >
< \\_ => "" , "" >
"" "" ""
).s!Posit ;
VPassPerf =>
( mkAdjective
@@ -453,6 +521,7 @@ param
Neutr )
< \\_ => "" , "" >
< \\_ => "" , "" >
"" "" ""
).s!Posit
}
} ;
@@ -607,6 +676,7 @@ param
Neutr )
< \\_ => "" , "" >
< \\_ => "" , "" >
"" "" ""
).s!Posit ;
sup =
table {
@@ -648,6 +718,7 @@ param
Neutr )
< \\_ => "" , "" >
< \\_ => "" , "" >
"" "" ""
).s!Posit ;
VPassPerf =>
( mkAdjective
@@ -668,10 +739,27 @@ param
Neutr )
< \\_ => "" , "" >
< \\_ => "" , "" >
"" "" ""
).s!Posit
}
} ;
-- at the moment only fills present tense
mkImpersonal : Str -> Verb = \s ->
{
act = table {
VAct VSim (VPres VInd) Sg P1 => s ;
_ => nonExist
} ;
pass = \\_ => nonExist ;
imp = \\_ => nonExist ;
inf = \\_ => nonExist ;
ger = \\_ => nonExist ;
geriv = \\_ => nonExist ;
part = \\_,_ => nonExist ;
sup = \\_ => nonExist ;
} ;
actPresEnding : Number -> Person -> Str =
useEndingTable <"m", "s", "t", "mus", "tis", "nt"> ;
@@ -690,7 +778,7 @@ param
}
in
(useEndingTable endings n p) + passPresEnding n p ;
useEndingTable : (Str*Str*Str*Str*Str*Str) -> Number -> Person -> Str =
\es,n,p -> case n of {
Sg => case p of {
@@ -705,6 +793,210 @@ param
}
} ;
addPrefix : Str -> Str -> Str =
\prefix,verb ->
case <prefix,verb> of {
<p + "b","f" + _ > => p + verb ;
<p + "b", "te" + r > => prefix + "sti" + r;
<p + "b", "t" + r > => prefix + "s" + verb;
<p + "b", "iact" + r > => prefix + "iect" + r;
<p + "b", "iac" + r > => prefix + "ic" + r;
<p + "d","capt" + r > => p + "ccept" + r ;
<p + "d","ca" + r > => p + "cci" + r ;
<p ,"spe" + r > => p + "spi" + r ;
<p ,"spex" + r > => prefix + verb;
<p ,"stat" + r > => p + "stit" + r ;
<p ,"tex" + r > => p + verb ;
<p ,"te" + r > => p + "ti" + r ;
<p + "d","c" + _ > => p + "c" + verb ;
<p + "d","t" + _ > => p + "t" + verb ;
<p + "d","l" + _ > => p + "l" + verb ;
_ => prefix + verb
} ;-- TODO too simple e.g. ab+fuit = afuit
prefixVerb2 : Str -> Verb2 -> Verb2 =
\prefix,verb ->
let v = { act = verb.act ; pass = verb.pass ; inf = verb.inf ; imp = verb.imp ; ger = verb.ger ; geriv = verb.geriv ; sup = verb.sup ; part = verb.part }
in
(prefixVerb prefix v) ** { c = verb.c };
prefixVerb : Str -> Verb -> Verb =
\prefix,verb ->
{
act = \\form => addPrefix prefix (verb.act ! form) ;
pass = \\form => addPrefix prefix (verb.pass ! form) ;
inf = \\form => addPrefix prefix (verb.inf ! form) ;
imp = \\form => addPrefix prefix (verb.imp ! form) ;
ger = \\form => addPrefix prefix (verb.ger ! form) ;
geriv = \\agr => addPrefix prefix (verb.geriv ! agr) ;
sup = \\form => addPrefix prefix (verb.sup ! form) ;
part = \\form,agr => addPrefix prefix (verb.part ! form ! agr) ;
} ;
esseAux : Verb = -- Bayer-Lindauer 93 1
let
pres_stem = "s" ;
pres_ind_base = "su" ;
pres_conj_base = "si" ;
impf_ind_base = "era" ;
impf_conj_base = "esse" ;
fut_I_base = "eri" ;
imp_base = "es" ;
perf_stem = "fu" ;
perf_ind_base = "fu" ;
perf_conj_base = "fueri" ;
pqperf_ind_base = "fuera" ;
pqperf_conj_base = "fuisse" ;
fut_II_base = "fueri" ;
part_stem = "fut" ;
verb = mkVerb "esse" pres_stem pres_ind_base pres_conj_base impf_ind_base impf_conj_base fut_I_base
imp_base perf_stem perf_ind_base perf_conj_base pqperf_ind_base pqperf_conj_base fut_II_base part_stem ;
in
{
act =
table {
VAct VSim (VPres VInd) n p =>
table Number [ table Person [ "sum" ; "es" ; "est" ] ;
table Person [ "sumus" ; "estis" ; "sunt" ]
] ! n ! p ;
a => verb.act ! a
};
pass =
\\_ => nonExist ; -- no passive forms
inf =
verb.inf ;
imp =
table {
VImp1 Sg => "es" ;
VImp1 Pl => "este" ;
VImp2 Pl P2 => "estote" ;
a => verb.imp ! a
} ;
sup =
\\_ => nonExist ; -- no supin forms
ger =
\\_ => nonExist ; -- no gerund forms
geriv =
\\_ => nonExist ; -- no gerundive forms
part = table {
VActFut =>
verb.part ! VActFut ;
VActPres =>
\\_ => nonExist ; -- no such participle
VPassPerf =>
\\_ => nonExist -- no such participle
}
} ;
ferreAux : Verb =
let
pres_stem = "fer" ;
pres_ind_base = "fer" ;
pres_conj_base = "fera" ;
impf_ind_base = "fereba" ;
impf_conj_base = "ferre" ;
fut_I_base = "fere" ;
imp_base = "fer" ;
perf_stem = "tul" ;
perf_ind_base = "tul" ;
perf_conj_base = "tuleri" ;
pqperf_ind_base = "tulera" ;
pqperf_conj_base = "tulisse" ;
fut_II_base = "tuleri" ;
part_stem = "lat" ;
verb = mkVerb "ferre" pres_stem pres_ind_base pres_conj_base impf_ind_base impf_conj_base fut_I_base
imp_base perf_stem perf_ind_base perf_conj_base pqperf_ind_base pqperf_conj_base fut_II_base part_stem ;
in
{
act =
table {
VAct VSim (VPres VInd) n p =>
table Number [ table Person [ "fero" ; "fers" ; "fert" ] ;
table Person [ "ferimus" ; "fertis" ; "ferunt" ]
] ! n ! p ;
a => verb.act ! a
} ;
pass =
table {
VPass (VPres VInd) n p =>
table Number [ table Person [ "feror" ; "ferris" ; "fertur" ] ;
table Person [ "ferimur" ; "ferimini" ; "feruntur" ]
] ! n ! p ;
a => verb.pass ! a
} ;
inf =
verb.inf ;
imp =
table {
VImp1 n => table Number [ "fer" ; "ferte" ] ! n ;
VImp2 Sg ( P2 | P3 ) => "ferto" ;
VImp2 Pl P2 => "fertote" ;
a => verb.imp ! a
} ;
sup =
verb.sup ;
ger =
verb.ger ;
geriv =
verb.geriv ;
part = verb.part ;
};
posseAux : Verb =
let
pres_stem = "pos" ;
pres_ind_base = "pos" ;
pres_conj_base = "possi" ;
impf_ind_base = "potera" ;
impf_conj_base = "posse" ;
fut_I_base = "poteri" ;
imp_base = "" ;
perf_stem = "potu" ;
perf_ind_base = "potu" ;
perf_conj_base = "potueri" ;
pqperf_ind_base = "potuera" ;
pqperf_conj_base = "potuisse" ;
fut_II_base = "potueri" ;
part_stem = "" ;
verb = mkVerb "posse" pres_stem pres_ind_base pres_conj_base impf_ind_base impf_conj_base fut_I_base
imp_base perf_stem perf_ind_base perf_conj_base pqperf_ind_base pqperf_conj_base fut_II_base part_stem ;
in
{
act =
table {
VAct VSim (VPres VInd) n p =>
table Number [ table Person [ "possum" ; "potes" ; "potest" ] ;
table Person [ "possumus" ; "potestis" ; "possunt" ]
] ! n ! p ;
a => verb.act ! a
} ;
pass =
\\_ => nonExist ; -- no passive forms
inf =
table {
VInfActFut _ => nonExist ;
a => verb.inf ! a
} ;
imp =
\\_ => nonExist ;
sup =
\\_ => nonExist ;
ger =
\\_ => nonExist ;
geriv =
\\_ => nonExist ;
part = table {
VActFut =>
\\_ => nonExist ; -- no such participle
VActPres =>
\\_ => nonExist ; -- no such participle
VPassPerf =>
\\_ => nonExist -- no such participle
} ;
};
-- pronouns
param
@@ -717,15 +1009,31 @@ param
-- PronIndef PronIndefUsage PronIndefPol PronIndefMeaning ;
oper
Pronoun : Type = {
pers : PronDropForm => PronReflForm => Case => Str ;
poss : PronReflForm => Agr => Str ;
PersonalPronoun = {
s : PronDropForm => PronReflForm => Case => Str ;
g : Gender ;
n : Number ;
p : Person ;
n : Number
} ;
PossessivePronoun = {
s : PronReflForm => Agr => Str ;
} ;
-- Pronoun : Type = {
-- pers : PronDropForm => PronReflForm => Case => Str ;
-- poss : PronReflForm => Agr => Str ;
-- g : Gender ;
-- n : Number ;
-- p : Person ;
-- } ;
Pronoun : Type = {
pers : PersonalPronoun ;
poss : PossessivePronoun ;
p : Person
} ;
pronForms = overload {
pronForms : (_,_,_,_,_ : Str) -> Case => Str =
\ego,me,mei,mihi,mee -> table Case [ego ; me ; mei ; mihi ; mee ; ego] ;
@@ -839,90 +1147,170 @@ oper
createPronouns g n p ;
in
{
pers = prons.p1 ;
poss = prons.p2 ;
g = g ;
n = n ;
pers = { s = prons.p1 ; g = g ; n = n } ;
poss = { s = prons.p2 } ;
p = p
} ;
-- prepositions
Preposition : Type = {s : Str ; c : Case} ;
Preposition : Type = {s : Str ; c : Case ; isPost : Bool } ;
-- Bayer-Lindauer $149ff.
about_P = lin Prep (mkPrep "de" Gen ) ; -- L...
at_P = lin Prep (mkPrep "ad" Acc ) ; -- L...
on_P = lin Prep ( mkPrep "ad" Gen ) ; -- L...
to_P = lin Prep ( mkPrep "ad" Acc ) ; -- L...
Gen_Prep = lin Prep ( mkPrep "" Gen ) ;
Acc_Prep = lin Prep ( mkPrep "" Acc ) ;
Dat_Prep = lin Prep ( mkPrep "" Dat ) ;
Abl_Prep = lin Prep ( mkPrep "" Abl ) ;
VPSlash = VerbPhrase ** {c2 : Preposition} ;
-- conjunctions
param Coordinator = And | Or | If | Neither | Because | Comma | Colon | Empty ;
oper
Conjunction : Type = { s1 : Str ; s2 : Str ; n : Number ; c : Coordinator };
mkConjunction : Str -> Str -> Number -> Coordinator -> Conjunction = \s1,s2,num,coord -> { s1 = s1; s2 = s2 ; n = num ; c = coord } ;
VPSlash = VerbPhrase ** {c : Preposition} ;
predV : Verb -> VerbPhrase = \v -> {
fin = \\a,q => v.act ! a ++ case q of { VQTrue => Prelude.BIND ++ "ne"; VQFalse => "" };
s = \\a,q => v.act ! a ++ case q of { VQTrue => Prelude.BIND ++ "ne"; VQFalse => "" };
part = v.part;
imp = v.imp ;
inf = v.inf ;
obj = [] ;
adj = \\a => []
compl = \\a => [] ;
adv = ""
} ;
predV2 : Verb2 -> VPSlash = \v ->
predV v ** {c2 = v.c} ;
predV v ** {c = v.c} ;
predV3 : Verb3 -> VPSlash = \v
-> predV v ** {c2 = v.c2; c3 = v.c3 } ;
-> predV v ** {c = v.c; c2 = v.c2 } ;
appPrep : Preposition -> (Case => Str) -> Str = \c,s -> c.s ++ s ! c.c ;
insertObj : Str -> VerbPhrase -> VerbPhrase = \obj,vp -> {
fin = vp.fin ;
insertObj : NounPhrase -> Preposition -> VerbPhrase -> VerbPhrase = \np,prep,vp -> {
s = vp.s ;
part = vp.part ;
imp = vp.imp ;
inf = vp.inf ;
obj = obj ++ vp.obj ;
adj = vp.adj
obj = np.det.s ! np.g ! prep.c ++ np.preap.s ! (Ag np.g np.n prep.c) ++ (appPrep prep np.s) ++ np.postap.s ! (Ag np.g np.n prep.c) ++ np.det.sp ! np.g ! prep.c ++ vp.obj ;
compl = vp.compl ;
adv = vp.adv ++ np.adv
} ;
insertObjc: Str -> VPSlash -> VPSlash = \obj,vp -> {
fin = vp.fin ;
insertObjc: NounPhrase -> VPSlash -> VPSlash = \np,vp -> {
s = vp.s ;
part = vp.part ;
imp = vp.imp ;
inf = vp.inf ;
obj = obj ++ vp.obj ;
adj = vp.adj ;
c2 = vp.c2
obj = np.det.s ! np.g ! vp.c.c ++ np.preap.s ! (Ag np.g np.n vp.c.c) ++ (appPrep vp.c np.s) ++ np.postap.s ! (Ag np.g np.n vp.c.c) ++ np.det.sp ! np.g ! vp.c.c ++ vp.obj ;
compl = vp.compl ;
c = vp.c ;
adv = vp.adv ++ np.adv
} ;
insertAdj : (Agr => Str) -> VerbPhrase -> VerbPhrase = \adj,vp -> {
fin = vp.fin ;
s = vp.s ;
part = vp.part ;
imp = vp.imp ;
inf = vp.inf ;
obj = vp.obj ;
adj = \\a => adj ! a ++ vp.adj ! a
compl = \\a => adj ! a ++ vp.compl ! a ;
adv = vp.adv
} ;
insertAdv : Adverb -> VerbPhrase -> VerbPhrase = \a,vp -> {
s = vp.s ;
part = vp.part ;
imp = vp.imp ;
inf = vp.inf ;
obj = vp.obj ;
compl = vp.compl ;
adv = vp.adv ++ (a.s ! Posit)
} ;
-- clauses
Clause = {s : Tense => Anteriority => Polarity => VQForm => Order => Str} ;
QClause = {s : Tense => Anteriority => Polarity => QForm => Str} ;
Sentence =
{
s,o,v,neg : AdvPos => Str ; -- Subject, verbphrase, object and negation particle plus potential adverb
t : C.Tense ; -- tense marker
p : C.Pol ; -- polarity marker
sadv : Str -- sentence adverb¡
} ;
Clause = {s,o : AdvPos => Str ; v : Tense => Anteriority => VQForm => AdvPos => Str ; neg : Polarity => AdvPos => Str ; adv : Str } ;
QClause = {s : C.Tense => Anteriority => C.Pol => QForm => Str} ;
-- The VQForm parameter defines if the ordinary verbform or the quistion form with suffix "-ne" will be used
mkClause : NounPhrase -> VerbPhrase -> Clause = \np,vp -> {
s = \\tense,anter,pol,vqf,order => case order of {
SVO => np.s ! Nom ++ negation pol ++ vp.adj ! Ag np.g Sg Nom ++ vp.inf ! VInfActPres ++ vp.fin ! VAct ( anteriorityToVAnter anter ) ( tenseToVTense tense ) np.n np.p ! vqf ++ vp.obj ;
VSO => negation pol ++ vp.adj ! Ag np.g Sg Nom ++ vp.fin ! VAct ( anteriorityToVAnter anter ) ( tenseToVTense tense ) np.n np.p ! vqf ++ np.s ! Nom ++ vp.obj ;
VOS => negation pol ++ vp.adj ! Ag np.g Sg Nom ++ vp.fin ! VAct ( anteriorityToVAnter anter ) ( tenseToVTense tense ) np.n np.p ! vqf ++ vp.obj ++ np.s ! Nom ;
OSV => vp.obj ++ np.s ! Nom ++ negation pol ++ vp.adj ! Ag np.g Sg Nom ++ vp.fin ! VAct ( anteriorityToVAnter anter ) ( tenseToVTense tense ) np.n np.p ! vqf ;
OVS => vp.obj ++ negation pol ++ vp.adj ! Ag np.g Sg Nom ++ vp.fin ! VAct ( anteriorityToVAnter anter ) ( tenseToVTense tense ) np.n np.p ! vqf ++ np.s ! Nom ;
SOV => np.s ! Nom ++ vp.obj ++ negation pol ++ vp.adj ! Ag np.g Sg Nom ++ vp.fin ! VAct ( anteriorityToVAnter anter ) ( tenseToVTense tense ) np.n np.p ! vqf
}
-- np.s ! Nom ++ vp.obj ++ vp.adj ! np.g ! np.n ++ negation p ++ vp.fin ! VAct a t np.n np.p
mkClause : NounPhrase -> VerbPhrase -> Clause = \np,vp ->
let
-- combines adverbs from noun phrase and verb phrase
adv = np.adv ++ vp.adv ;
-- helper functions to either place the adverb in the designated position
-- or an empty string instead
pres : AdvPos -> Str = \ap -> case ap of { PreS => adv ; _ => [] } ;
prev : AdvPos -> Str = \ap -> case ap of { PreV => adv ; _ => [] } ;
preo : AdvPos -> Str = \ap -> case ap of { PreO => adv ; _ => [] } ;
preneg : AdvPos -> Str = \ap -> case ap of { PreNeg => adv ; _ => [] } ;
ins : AdvPos -> Str = \ap -> case ap of { InS => adv ; _ => [] } ;
inv : AdvPos -> Str = \ap -> case ap of { InV => adv ; _ => [] }
in
{
-- subject part of the clause:
-- ap is the adverb position in the clause
s = \\ap =>
pres ap ++ -- adverbs can be placed in the beginning of the clause
np.det.s ! np.g ! Nom ++ -- the determiner, if any
np.preap.s ! (Ag np.g np.n Nom) ++ -- adjectives which come before the subject noun, agreeing with it
ins ap ++ -- adverbs can be placed within the subject noun phrase
np.s ! Nom ++ -- the noun of the subject noun phrase in nominative
np.postap .s ! (Ag np.g np.n Nom) ++ -- adjectives which come after the subject noun, agreeing with it
np.det.sp ! np.g ! Nom ; -- second part of split determiners
-- verb part of the clause:
-- tense and anter(ority) for the verb tense
-- vqf is the VQForm parameter which defines if the ordinary verbform or the quistion form with suffix "-ne" will be used
-- ap is the adverb position in the clause
v = \\tense,anter,vqf,ap =>
prev ap ++ -- adverbs can be placed in the before the verb phrase
vp.compl ! Ag np.g np.n Nom ++ -- verb phrase complement, e.g. predicative expression, agreeing with the subject
inv ap ++ -- adverbs can be placed within the verb phrase
-- verb form with conversion between different forms of tense and aspect
vp.s ! VAct ( anteriorityToVAnter anter ) ( tenseToVTense tense ) np.n np.p ! vqf ;
-- object part of the clause
o = \\ap => preo ap ++ vp.obj ;
-- optional negation particle, adverbs can be placed before the negation
neg = \\pol,ap => preneg ap ++ negation pol ;
adv = ""
} ;
combineClause : Clause -> C.Tense -> Anteriority -> C.Pol -> VQForm -> Sentence = \cl,tense,anter,pol,vqf ->
{ s = cl.s ;
o = cl.o ;
v = cl.v ! tense.t ! anter ! vqf ;
neg = cl.neg ! pol.p ;
sadv = "" ;
t = tense ;
p = pol
} ;
combineSentence : Sentence -> ( SAdvPos => AdvPos => Order => Str ) = \s ->
let
pres : SAdvPos -> Str = \ap -> case ap of { SPreS => s.sadv ; _ => [] } ;
prev : SAdvPos -> Str = \ap -> case ap of { SPreV => s.sadv ; _ => [] } ;
preo : SAdvPos -> Str = \ap -> case ap of { SPreO => s.sadv ; _ => [] } ;
preneg : SAdvPos -> Str = \ap -> case ap of { SPreNeg => s.sadv ; _ => [] }
in
\\sap,ap,order => case order of {
SVO => s.t.s ++ s.p.s ++ pres sap ++ s.s ! ap ++ preneg sap ++ s.neg ! ap ++ prev sap ++ s.v ! ap ++ preo sap ++ s.o ! ap;
VSO => s.t.s ++ s.p.s ++ preneg sap ++ s.neg ! ap ++ prev sap ++ s.v ! ap ++ pres sap ++ s.s ! ap ++ preo sap ++ s.o ! ap;
VOS => s.t.s ++ s.p.s ++ preneg sap ++ s.neg ! ap ++ prev sap ++ s.v ! ap ++ preo sap ++ s.o ! ap ++ pres sap ++ s.s ! ap ;
OSV => s.t.s ++ s.p.s ++ preo sap ++ s.o ! ap ++ pres sap ++ s.s ! ap ++ preneg sap ++ s.neg ! ap ++ prev sap ++ s.v ! ap;
OVS => s.t.s ++ s.p.s ++ preo sap ++ s.o ! ap ++ preneg sap ++ s.neg ! ap ++ prev sap ++ s.v ! ap ++ pres sap ++ s.s ! ap ;
SOV => s.t.s ++ s.p.s ++ pres sap ++ s.s ! ap ++ preo sap ++ s.o ! ap ++ preneg sap ++ s.neg ! ap ++ prev sap ++ s.v ! ap
} ;
-- questions
mkQuestion : SS -> Clause -> QClause = \ss,cl -> {
s = \\tense,anter,pol,form => case form of {
QDir => ss.s ++ cl.s ! tense ! anter ! pol ! VQFalse ! OVS;
QIndir => ss.s ++ cl.s ! tense ! anter ! pol ! VQFalse ! OSV
}
} ;
s = \\tense,anter,pol,form => case form of {
QDir => ss.s ++ (combineSentence (combineClause cl tense anter pol VQFalse)) ! SPreS ! PreS ! OVS ;
QIndir => ss.s ++ (combineSentence (combineClause cl tense anter pol VQFalse)) ! SPreO ! PreO ! OSV
}
};
negation : Polarity -> Str = \p -> case p of {
Pos => [] ;
@@ -932,7 +1320,7 @@ oper
-- determiners
Determiner : Type = {
s : Gender => Case => Str ; -- s,sp : Gender => Case => Str ; Don't know what sp is for
s,sp : Gender => Case => Str ; -- sp for split determiners (not clear if really needed)
n : Number
} ;
@@ -940,6 +1328,7 @@ oper
{
n = n ;
s = \\g,c => a.s ! Posit ! Ag g n c ;
sp = \\_,_ => ""
} ;
Quantifier : Type = {
@@ -985,11 +1374,62 @@ oper
"illa" "illorum" "illis")
;
mkPrep : Str -> Case -> Preposition = \s,c -> lin Preposition {s = s ; c = c} ;
mkPreposition : Str -> Case -> Preposition = \s,c -> {s = s ; c = c; isPost = False} ;
mkAdv : Str -> { s: Str } = \adv -> { s = adv } ;
mkPostposition : Str -> Case -> Preposition = \s,c -> {s = s ; c = c ; isPost = True } ;
param
Unit = one | ten | hundred | thousand | ten_thousand | hundred_thousand ;
-- adverbs
Adverb : Type = { s : Degree => Str} ;
mkAdverb : Str -> Adverb = \adv ->
{ s = table { Posit => adv ; _ => nonExist } } ;
mkFullAdverb : (pos,comp,sup : Str) -> Adverb = \p,c,s ->
{ s = table { Posit => p ; Compar => c ; Super => s } };
-- numerals
param
CardOrd = NCard | NOrd ;
Unit = one | ten | hundred | thousand | ten_thousand | hundred_thousand ;
oper
Cardinal : Type = {s : Gender => Case => Str ; n : Number};
Ordinal : Type = { s : Gender => Number => Case => Str } ;
Numeral : Type = { card : Cardinal ; ord : Ordinal } ;
mkNumeral : Str -> Str -> Numeral = \c,o -> -- cardinal and ordinal form
let
cardFlex : Gender => Case => Str = case c of { "unus" => \\gen,cas => case <gen,cas> of {
<Masc, Nom | Voc> => "unus" ; <Masc, Acc> => "unum" ; <Masc, Abl> => "uno" ;
<Fem, Nom | Abl | Voc> => "una" ; <Fem, Acc> => "unam" ;
<Neutr, Nom | Acc | Voc> => "unum" ; <Neutr, Abl> => "uno" ;
<_, Gen> => "unius" ; <_, Dat> => "uni"
} ;
"duo" => table {
Masc | Neutr => table Case [ "duo" ; "duo" ; "duorum" ; "duobus" ; "duobus" ; "duo" ] ;
Fem => table Case [ "duae" ; "duas" ; "duarum" ; "duabus" ; "duabus" ; "duae" ] } ;
"tres" => \\gen,cas => case <gen,cas> of {
<Neutr, Nom | Acc | Voc > => "tria" ; <_, Nom | Acc | Voc > => "tres" ;
<_, Gen> => "trium" ; <_, Dat | Abl > => "tribus"
} ;
"milia" => table {
Neutr => table Case [ "milia" ; "milia" ; "milium" ; "milibus" ; "milibus" ; "milia" ] ;
_ => \\_ => nonExist
} ;
_ => \\_,_ => c
} ;
ordFlex : Gender => Number => Case => Str =
case o of {
stem + "us" => table {
Masc => table Number [ table Case [ stem + "us" ; stem + "um" ; stem + "i" ; stem + "o" ; stem + "o" ; stem + "e" ] ;
table Case [ stem + "i" ; stem + "os" ; stem + "orum" ; stem + "is" ; stem + "is" ; stem + "i" ] ;
];
Fem => table Number [ table Case [ stem + "a" ; stem + "am" ; stem + "ae" ; stem + "ae" ; stem + "a" ; stem + "a" ] ;
table Case [ stem + "ae" ; stem + "as" ; stem + "arum" ; stem + "is" ; stem + "is" ; stem + "ae" ] ;
] ;
Neutr => table Number [ table Case [ stem + "um" ; stem + "um" ; stem + "i" ; stem + "o" ; stem + "o" ; stem + "um" ] ;
table Case [ stem + "a" ; stem + "a" ; stem + "orum" ; stem + "is" ; stem + "is" ; stem + "a" ] ;
]
} ;
_ => error "unsupported ordinal form"
}
in
{ card = { s = cardFlex ; n = case c of { "unus" => Sg ; _ => Pl } } ; ord = { s = ordFlex } } ;
}