GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-13 23:09:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

partial implementation of Ancient Greek RGL

Browse Source
This commit is contained in:
leiss
2016-05-25 12:35:37 +00:00
parent e81b39a300
commit d9d617be5d
53 changed files with 45536 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

407
lib/src/ancient_greek/AccentsGrc.gf Normal file
View File

@@ -0,0 +1,407 @@
--# -path=.:../abstract:../common:../prelude
--1 Greek auxiliary operations. -- NOT USED. Remember old version; sound law SL etc
resource AccentsGrc = {
flags
optimize = noexpand ;
oper
-- Accent shift and accent change: the following functions are applied to
-- the stem in certain cases:
-- a) when the Pl Gen ending w~n is added, the accent in the stem
-- must be removed using dropAccent:
dropAccent : Str -> Str = \str -> case str of {
x + ("'" | "`" | "~") + z => x + z ;
x + "=" + z => x + "-" + z ;
_ => str
} ;
{- Redesign: ------------------------------------------------------------------
Try to extract the patterns of vowel lengths and accent position
and do the paradigms with less pattern matching.
We need the general rule:
1. the accent position is taken from SgNom, and only moved on demand.
2. a shift is demanded if a an ending with a long vowel is added and
the accent position is on the 3rd last vowel.
3. if an ending with accent is added, the accent in the stem has to be dropped.
-- Declension I,II: Word`stock'+NomSgEnding => wordkind includes ending.
Then from lists of endings *without accent* one takes the accent position
from the user-provided form(s), and given the vowel length of the ending,
determines the accent position of other forms
-- Declension III:
Wordstem+Ending (wordstem+os=GenSg) => NomSg may have empty ending
Then the accent position is taken from the NomSg.
-}
oper
Position : PType = Predef.Ints 3 ;
WPat = { syl : Syllability ;
v : VPat * VPat * VPat ;
s : Str * Str * Str * Str;
acnt : Accent
} ;
param
Accent = Acute Position | Circum Position | NoAccent ;
Syllability = Mono | Bi | Many ;
Vowel = A | E | I | O | U | AU | EU | OU | AI | EI | OI | UI |
-- vowel with spirtus asper/lenis:
Aa | Ea | Ia | Oa | Ua | AUa | EUa | OUa | AIa | EIa | OIa | UIa |
Al | El | Il | Ol | Ul | AUl | EUl | OUl | AIl | EIl | OIl | UIl |
-- vowel with iota subscriptum and spiritus
Ai | Ei | Oi | Aia | Eia | Oia | Ail | Eil | Oil
;
VPat = NoVowel | Short Vowel | Long Vowel ; -- 1+45+45 = 91 possibilities
Spirit = Asper | Lenis | NoSpirit ;
oper
removeLength : Str -> Str = \str -> case str of {
"a_" | "a." => "a" ; "i_" | "i." => "i" ; "y_" | "y." => "y" ; x => x } ;
toStr : VPat -> Str = \vpat -> case vpat of {
Short A => "a" ;
Short E => "e" ;
Short I => "i" ;
Short O => "o" ;
Short U => "y" ;
Long A => "a_" ; -- maybe better "a", since the unicode-table has not a_'
Long E => "h" ;
Long I => "i_" ;
Long O => "w" ;
Long U => "y_" ;
Long AU => "ay" ;
Long EU => "ey" ;
Long OU => "oy" ;
Long AI => "ai" ;
Long EI => "ei" ;
Long OI => "oi" ;
Long UI => "yi" ;
Short AI => "ai" ;
Short OI => "oi" ;
-- vowels and diphthongs with spriritus asper:
Short Aa => "a(" ;
Short Ea => "e(" ;
Short Ia => "i(" ;
Short Oa => "o(" ;
Short Ua => "y(" ;
-- Long Aa
Long Ea => "h(" ;
-- Long Ia
Long Oa => "w(" ;
-- Long Ua
Long AUa => "ay(" ;
Long EUa => "ey(" ;
Long OUa => "oy(" ;
Long AIa => "ai(" ;
Long EIa => "ei(" ;
Long OIa => "oi(" ;
Long UIa => "yi(" ;
-- vowels and diphthongs with spriritus lenis:
Short Al => "a)" ;
Short El => "e)" ;
Short Il => "i)" ;
Short Ol => "o)" ;
Short Ul => "y)" ;
-- Long Al
Long El => "h)" ;
-- Long Il
Long Ol => "w)" ;
-- Long Ul
Long AUl => "ay)" ;
Long EUl => "ey)" ;
Long OUl => "oy)" ;
Long AIl => "ai)" ;
Long EIl => "ei)" ;
Long OIl => "oi)" ;
Long UIl => "yi)" ;
-- vowels with iota subscriptum, and spirits
Long Ai => "a|" ;
Long Ei => "e|" ;
Long Oi => "o|" ;
Long Aia => "a|(" ;
Long Eia => "h|(" ;
Long Oia => "w|(" ;
Long Ail => "a|)" ;
Long Eil => "h|)" ;
Long Oil => "w|)" ;
NoVowel => "" ; -- TODO: trema etc. perhaps I2 = "i-"
_ => "*" -- ca.30 possibilities
} ;
toVPat : Str -> VPat = \str -> case str of {
("a."|"a") => Short A ;
("i."|"i"|"i-"|"i=") => Short I ;
("y."|"y"|"y-"|"y=") => Short U ;
"a_" => Long A ;
"i_" => Long I ;
"y_" => Long U ;
"a" => Short A ;
"e" => Short E ;
"i" => Short I ;
"o" => Short O ;
"y" => Short U ;
"a" => Long A ; -- maybe better "a", since the unicode-table has not a_'
"h" => Long E ;
"i" => Long I ;
"w" => Long O ;
"y" => Long U ;
"ay" => Long AU ;
"ey" => Long EU ;
"oy" => Long OU ;
"ai" => Long AI ;
"ei" => Long EI ;
"oi" => Long OI ;
"yi" => Long UI ;
-- vowels and diphthongs with spriritus asper:
"a(" => Short Aa ;
"e(" => Short Ea ;
"i(" => Short Ia ;
"o(" => Short Oa ;
"y(" => Short Ua ;
-- Long Aa
"h(" => Long Ea ;
-- Long Ia
"w(" => Long Oa ;
-- Long Ua
"ay(" => Long AUa ;
"ey(" => Long EUa ;
"oy(" => Long OUa ;
"ai(" => Long AIa ;
"ei(" => Long EIa ;
"oi(" => Long OIa ;
"yi(" => Long UIa ;
-- vowels and diphthongs with spriritus lenis:
"a)" => Short Al ;
"e)" => Short El ;
"i)" => Short Il ;
"o)" => Short Ol ;
"y)" => Short Ul ;
-- Long Al
"h)" => Long El ;
-- Long Il
"w)" => Long Ol ;
-- Long Ul
"ay)" => Long AUl ;
"ey)" => Long EUl ;
"oy)" => Long OUl ;
"ai)" => Long AIl ;
"ei)" => Long EIl ;
"oi)" => Long OIl ;
"yi)" => Long UIl ;
-- vowels with iota subscriptum, and spirits
"a|" => Long Ai ;
"e|" => Long Ei ;
"o|" => Long Oi ;
"a|(" => Long Aia ;
"h|(" => Long Eia ;
"w|(" => Long Oia ;
"a|)" => Long Ail ;
"h|)" => Long Eil ;
"w|)" => Long Oil ;
_ => NoVowel -- TODO: trema etc. perhaps I2 = "i-"
} ;
-- accent ~ can only be on long vowels, hence y~ must become <Long U, Circum> etc:
toVPat2 : Str -> Str -> VPat = \o,z ->
case o of { (#shortV|#restV) => case z of {"~"+_ => toVPat (removeLength o + "_") ;
_ => toVPat o} ;
_ => toVPat o } ;
toAcntPos : Str -> Accent = \str ->
case str of { -- we don't check for double accent; the leftmost accent counts
-- 3 syllables
("'"|"('"|")'") + _ + "$" + _ + "$" + _ => Acute 1 ;
("~"|"(~"|")~") + _ + "$" + _ + "$" + _ => Circum 1 ;
_ + "$" + "'" + _ + "$" + _ => Acute 2 ;
_ + "$" + "~" + _ + "$" + _ => Circum 2 ;
_ + "$" + _ + "$" + "'" + _ => Acute 3 ;
_ + "$" + _ + "$" + "~" + _ => Circum 3 ;
-- 2 syllables
("'"|"('"|")'") + _ + "$" + _ => Acute 2 ;
("~"|"(~"|")~") + _ + "$" + _ => Circum 2 ;
_ + "$" + "'" + _ => Acute 3 ;
_ + "$" + "~" + _ => Circum 3 ;
-- 1 syllable
("'"|"('"|")'") + _ => Acute 3 ;
("~"|"(~"|")~") + _ => Circum 3 ;
-(_ + ("'" | "~" | "`") + _) => NoAccent ;
_ => Predef.error "Error: double accent"
} ;
-- The order of the patterns in the pattern alternatives is important since
-- diphthongs match against vowel+vowel, and short vowels.
-- (Here "ai", "oi" count as long; for end syllables, this is adjusted in addAccent.)
wpat : Str -> WPat = \str ->
let T = "$" ;
da = dropAccent
in
case str of {
-- monosyllabic words:
y@(("r(" | "") + #nonvowels)
+ o@((#diphthong | #longV | #shortV | #restV) + (#spirit | ""))
+ z@#nonvowels
=> { syl = Mono ;
v = <NoVowel, NoVowel, toVPat2 o z> ;
acnt = toAcntPos z ;
s = <[] , [] , y , da z>
} ;
-- bisyllabic words:
x@(("r(" | "") + #nonvowels)
+ e@((#diphthong | #longV | #shortV | #restV) + (#spirit | ""))
+ y@#nonvowels
+ o@(#diphthong | #longV | #shortV | #restV)
+ z@#nonvowels
=> { syl = Bi ;
v = <NoVowel , toVPat2 e y, toVPat2 o z> ;
acnt = toAcntPos (y + T + z) ;
s = <[] , x , da y , da z>
} ;
-- manysyllabic words:
r@_
+ a@((#diphthong | #longV | #shortV | #restV) + (#spirit | ""))
+ x@#nonvowels
+ e@(#diphthong | #longV | #shortV | #restV)
+ y@#nonvowels
+ o@(#diphthong | #longV | #shortV | #restV)
+ z@#nonvowels
=> { syl = Many ;
v = <toVPat2 a x, toVPat2 e y, toVPat2 o z> ;
acnt = toAcntPos (x + T + y + T + z) ;
s = <r , da x , da y , da z>
} ;
_ => -- Predef.error "vowel/accent pattern not recognized"
{ syl = Mono ;
v = <NoVowel,NoVowel,NoVowel> ;
acnt= NoAccent ;
s = <"BUGGY","VOWEL","ACCENT","PATTERN">
}
} ;
-- Add an accent to an unaccentuated string; includes necessary accent changes and shifts
-- (We don't check that the given string has enough vowels.)
merge : (Str * Str * Str * Str) -> (Str * Str * Str) -> Str =
\cs,vs -> cs.p1 + vs.p1 + cs.p2 + vs.p2 + cs.p3 + vs.p3 + cs.p4 ;
glue : (Str * Str * Str * Str )-> (VPat * VPat * VPat) -> Str =
\cs,vs -> cs.p1 + (toStr vs.p1) + cs.p2 + (toStr vs.p2) + cs.p3 + (toStr vs.p3) + cs.p4 ;
addAccent0 : Accent -> Str -> Str = \accent,str -> str ; -- for testing
-- addAccent inserts the given accent = (accnt pos) to the vowel at the position,
-- and for pos=1=3rd last and last vowel is short, puts the accent to 2nd last:
addAccent : Accent -> Str -> Str = \accent,str ->
let
w = wpat str ;
v1 = toStr w.v.p1 ; -- third last vowel
v2 = toStr w.v.p2 ; -- second last vowel
v3 = toStr w.v.p3 ; -- last vowel
v2s = removeLength v2 ;
v3s = removeLength v3 ;
in
case accent of {
Acute 3 => merge w.s <v1, v2, v3 + "'"> ;
Circum 3 => merge w.s <v1, v2, v3s + "~"> ;
Acute 2 => case <w.v.p2, w.v.p3> of { -- BR 9 4
<Long u2, Short u3> => merge w.s <v1, v2s + "~", v3> ;
_ => merge w.s <v1, v2 + "'", v3>
} ;
Circum 2 => merge w.s <v1, v2s + "~", v3> ; -- change to ' for v2 short?
Acute 1 => case <w.v.p3, w.s.p4> of {
<Short _, _> => merge w.s <v1 + "'", v2, v3> ; -- BR 9 1.b
<Long AI,""> => merge w.s <v1 + "'", v2, v3> ; -- BR 29.7 declension ; conjug?
<Long OI,""> => merge w.s <v1 + "'", v2, v3> ; -- BR 29.7 declension ; conjug?
_ => merge w.s <v1, v2 + "'", v3> -- sometimes changes to "~" needed?
} ;
_ => -- Predef.error ("Illegal accentuation for " ++ str)
str
} ;
-- from accent position in stem to accent position in (stem+long ending): ?
-- stempos1,stempos2,stempos3 => (stem+end)pos1,(stem+end)pos2,(stem+end)pos3
addAccent' : Accent -> Str -> Str = \accent,str ->
let
accent' = case accent of {Acute 2 => Acute 1 ;
Circum 2 => Acute 1 ;
Acute 3 => Acute 2 ;
Circum 3 => Circum 2 ;
_ => accent}
in addAccent accent' str ;
-}
-- --------------------------------------------------------------------------------
{- Sound laws on structured string (Example)
-- Problem:
-- In addNEnding, an accent on the ending overwrites accents on the stem.
-- But if vowel contraction <e',ei> => <[],ei~> deletes the final vowel of
-- the stem, one would need to shift stem parts to the right:
-- c1+v1+c2+v2+c3+v3+[]++[]+v+c2 => c1+v1+c2+v2+c3+[]+[]++[]+(v3+v)+c2
-- to avoid the adjacent []+[]. But c1 may contain vowels, and the number of
-- syllables is not exactly known!
-- If we use c1+v1+c2+v2+c3+v3+[]++[]+v+c2 => c1+v1+c2+v2+c3+(v3+v)+[]++[]+[]+c2,
-- as with <e',ei> => <ei~,[]>, we have to adjust the accent in the stem. (ToDo)
-- (could also turn the ending to c2+[]+[], but need not).
-- cV2 : soundlaw = \s2 -> <"", contractVowels s2.p1 s2.p2> ; -- deprec.
-- Test
SL : Soundlaw = \we -> let S = we.p1 ;
E = we.p2 ;
sv3 : Str = S.v.p3 + case S.a of { Acute 3 => "'" ;
Circum 3 => "~" ;
_ => "" } ;
sc4 = S.c.p4 ;
ec1 = E.c.p1 ;
ev = E.v ;
in case <sv3,sc4,ec1,ev> of {
<_,"","",_> => let vs = cV2 <sv3,ev> ; -- contractVowels
S2 = substV3 S vs.p1 ;
E2 = toNEnding (vs.p2 + E.c.p2)
in <S2, E2> ;
<_,?+_,_+("m"|"s"|"t"|"v"),_> =>
let cs = mC2 <sc4,ec1> ;
S2 = substC4 S cs.p1 ;
E2 = substC E <cs.p2,E.c.p2>
in <S2, E2> ;
_ => we } ;
substV3 : Word -> Str -> Word = -- assume that w.v.p3 and u are not "" !!
\w,u -> { a = case u of { _+"~" => Circum 3 ; _+"'" => Acute 3 ; _ => w.a } ;
s = w.s ;
v = <w.v.p1, w.v.p2, dropAccent u> ; -- We need u=/=[], else w.v.p1 prevents shifting
l = <w.l.p1, w.l.p2, vowelLength (dropAccent u)> ; -- TODO: short "ai" etc
c = w.c } ;
substC : NEnding -> (Str*Str) -> NEnding =
\w,cs -> { a = w.a ; v = w.v ; l = w.l ; c = cs } ;
-- expl: cc SL <toWord "nanoga'", toNEnding "wn">
toStrN3 : Word -> Str -> Str =
\w,e -> let we = SL (adjustAccent <w, toNEnding e>)
in toStrT (concat we) ;
-- toStrN3 : Word -> Str -> Str = \w,e -> let we = (SL <w, toNEnding e>)
-- in toStr (addNEnding we.p1 we.p2) ;
-- cc let we = (SL <toWord "gene'", toNEnding "i">) in toStr (addNEnding we.p1 we.p2)
-- cc toStr (addNEnding (SL <toWord "gene'", toNEnding "i">).p1 (SL <toWord "gene'", toNEnding "i">).p2)
-}
}

42
lib/src/ancient_greek/AdjectiveGrc.gf Normal file
View File

@@ -0,0 +1,42 @@
concrete AdjectiveGrc of Adjective = CatGrc ** open ResGrc, Prelude, (M=MorphoGrc) in {
lin
PositA a = { s = \\af => a.s ! Posit ! af } ;
ComparA a np = let agr = Ag Masc Sg P3 -- Default, TODO : s : Agr => ...
in {
s = \\af => a.s ! Compar ! af ++ np.s ! Gen ;
} ;
-- $SuperlA$ belongs to determiner syntax in $Noun$.
-- TODO: where is the argument of an A going - before or after the adjective?
ComplA2 a np = let agr = Ag Masc Sg P3 -- DEFAULT, need ap.s : Agr => ... TODO
in {
s = \\af => a.s ! Posit ! af ++ a.c2.s ++ np.s ! a.c2.c ;
} ;
ReflA2 a = {
s = \\af => a.s ! Posit ! af ++ a.c2.s ++ -- P3 ??
M.reflPron ! (Ag (genderAf af) (numberAf af) P3) ! a.c2.c ;
} ;
SentAP ap sc = {
s = \\af => ap.s ! af ++ sc.s ;
} ;
AdAP ada ap = {
s = \\af => ada.s ++ ap.s ! af ;
} ;
UseA2 a = { s = a.s ! Posit } ;
UseComparA a = {
s = a.s ! Compar
} ;
-- TODO:
-- CAdvAP : CAdv -> AP -> NP -> AP -- as cool as John
AdjOrd ord = ord ; -- Ord -> AP = { s : AForm => Str } -- warmest
}

26
lib/src/ancient_greek/AdverbGrc.gf Normal file
View File

@@ -0,0 +1,26 @@
concrete AdverbGrc of Adverb = CatGrc ** open ResGrc, Prelude in {
lin
PositAdvAdj a = { s = a.adv ! Posit } ;
ComparAdvAdj cadv a np = let agr = Ag Neutr Sg P3 -- default, TODO s:Agr => ..
in {
s = cadv.s ++ a.adv ! Compar ++ np.s ! Gen -- TODO: check
} ;
-- ComparAdvAdjS cadv a s = {
-- s = cadv.s ++ a.s ! AAdv ++ "than" ++ s.s
-- } ;
PrepNP prep np = { -- prepositions need stressed pronouns, BR
s = appPrep prep np -- default; TODO s:Agr => ..
} ;
-- AdAdv = cc2 ;
SubjS = cc2 ;
-----b AdvSC s = s ; --- this rule give stack overflow in ordinary parsing
--
-- AdnCAdv cadv = {s = cadv.s ++ "than"} ;
--
}

8
lib/src/ancient_greek/AllGrc.gf Normal file
View File

@@ -0,0 +1,8 @@
--# -path=.:../../gf/lib/src/abstract:../common:../prelude
-- --# -path=.:../abstract:../common:../prelude
concrete AllGrc of AllGrcAbs =
LangGrc,
ExtraGrc,
BornemannGrc -- added HL
** {} ;

8
lib/src/ancient_greek/AllGrcAbs.gf Normal file
View File

@@ -0,0 +1,8 @@
--# -path=.:../abstract:../common:../prelude
abstract AllGrcAbs =
Lang,
Bornemann,
ExtraGrcAbs,
TransferGrcAbs
** {} ;

76
lib/src/ancient_greek/BackwardGrc.gf Normal file
View File

@@ -0,0 +1,76 @@
--concrete BackwardGrc of Backward = CatGrc ** open ResGrc 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 ;
--
--}

224
lib/src/ancient_greek/Bornemann.gf Normal file
View File

@@ -0,0 +1,224 @@
abstract Bornemann = Cat ** {
fun
-- A-declension of nouns and adjectives
-- Femina ending in -a_, -h, -a. BR 32
idea_N : N ; -- Form, Gestalt
chora_N : N ; -- Land
stratia_N : N ; -- Heer
doxa_N : N ; -- Meinung
glotta_N : N ; -- Zunge
macha_N : N ; -- Kampf
nika_N : N ; -- Sieg
tima_N : N ; -- Ehre
thalatta_N : N ; -- Meer
gephyra_N : N ; -- Bruecke
-- Masculina ending in -a_s*, -hs* BR 33
neanias_N : N ; -- Juengling
polita_N : N ; -- Buerger
dikasta_N : N ; -- Richter
atreida_N : N ; -- Atride
-- Contracta of the A-declension
athena_N : N ; -- Athena
gea_N : N ; -- Erde
hermea_N : N ; -- Hermes
-- O-declension
-- Nouns ending in -os* (Masc of Fem), -on (Neutr)
logos_N : N ; -- Wort, Rede
demos_N : N ; -- Volk
anthropos_N : N ; -- Mensch
hodos_N : N ; -- Weg
doron_N : N ; -- Geschenk
-- ergon_N : N ;
-- Adjectives of A- or O-declination
dikaios_A : A ; -- gerecht
neos_A : A ; -- neu
idios_A : A ; -- eigen
dikaios_A : A ; -- gerecht
patrwos_A : A ; -- vaeterlich
aisxros_A : A ; -- haesslich
philos_A : A ; -- lieb
delos_A : A ; -- offenbar
lithinos_A : A ; -- steinern
oligos_A : A ; -- wenig
agathos_A : A ; -- gut
-- Contracta of the O-declension
-- Nouns and adjectives of 2 endings
nous_N : N ;
osteon_N : N ;
eunous_A : A ;
-- Adjectives (3-ending) of A- and O-declension
argyrous_A : A ;
chrysous_A : A ;
-- Attical O-declension
news_N : N ;
Meneleos_PN : PN ;
ilews_A : A ;
-- Noun declension III
krathr_N : N ; -- stem in -r, -l BR 42
rhtwr_N : N ;
als_N : N ;
vhr_N : N ;
fylax_N : N ; -- gutturals -k, -g, -x BR 43
aix_N : N ;
gyps_N : N ; -- labials -p, -b, -f
fleps_N : N ;
esvhs_N : N ; -- dentals -t, -d, -v BR 44
elpis_N : N ;
caris_N : N ;
swma_N : N ;
ellhn_N : N ; -- stem in -n BR 45
agwn_N : N ;
poimhn_N : N ;
daimwn_N : N ;
gigas_N : N ; -- stem in -nt BR 46
odoys_N : N ;
gerwn_N : N ;
-- stems ending in -r with 3 ablautlevels BR 47
pathr_N : N ;
mhthr_N : N ;
vygathr_N : N ;
gasthr_N : N ;
anhr_N : N ;
-- stems ending in -s BR 48
genos_N : N ;
eugenhs_A : A ;
diogenhs_PN : PN ;
periklhs_PN : PN ;
philosopher_N : N ; -- filosofos_N : N ;
-- stems ending in i with ablaut e BR 49
polis_N : N ;
dynamis_N : N ;
-- stems ending in y with ablaut
phcys_N : N ;
asty_N : N ;
hdys_A : A ;
-- pure stems ending in y
icvys_N : N ;
sys_N : N ;
erinys : N ;
pitys_N : N ;
-- stems ending in ey BR 52
basileys_N : N ;
-- monosyllabic stems ending in ou, au, eu BR 53
boys_N : N ;
nays_N : N ;
zeys_PN : PN ;
-- stems ending in oi and w BR 54
peivw_N : N ;
hrws_N : N ;
-- Adjectives of the 3rd declension:
-- BR 44: stem ending in -t,-d,-v
acaris_A : A ; -- BR 44.5
eyelpis_A : A ;
apolis_A : A ;
agnws_A : A ; -- BR 57, 1-ending
penhs_A : A ;
fygas_A : A ;
apais_A : A ;
makar_A : A ;
pepaideykws_A : A ; -- BR 44.6
-- BR 45: stem ending in -n
eydaimwn_A : A ;
-- BR 46: stem ending in -nt
pas_A : A ;
ekwn_A : A ;
lywn_A : A ;
lysas_A : A ;
veis_A : A ;
dys_A : A ;
carieis_A : A ;
-- Verbs
-- w-conjugation:
-- a) verba vocalia, i.e. verbal stem ends in a vowel
paideyw_V : V ; -- BR 91
timaw_V : V ; -- BR 93, with contraction
poiew_V : V ;
doylow_V : V ;
-- b) verba muta, i.e. verbal stem ends in muta consonant (p,b,f | t,d,v | k,g,c)
leipw_V : V ; -- BR 99 - BR 102
elleipw_V : V ; -- prefix-verb en+leipw
trepw_V : V ; -- BR 99.1
grafw_V : V ;
tribw_V : V ;
diwkw_V : V ;
arcw_V : V ;
legw_V : V ;
anytw_V : V ;
peivw_V : V ;
pseydw_V : V ;
typtw_V : V ;
kryptw_V : V ;
blabtw_V : V ;
fylattw_V : V ;
ktizw_V : V ;
nomizw_V : V ;
swzw_V : V ;
scizw_V : V ;
evizw_V : V ;
-- c) verba liquida, i.e. verbal stem ends in liq.consonant (l,r) or nasal (m,n,(n)g)
derw_V : V ;
menw_V : V ;
nemw_V : V ;
angellw_V : V ;
fainw_V : V ;
-- deponents
veaomai_V : V ;
acvomai_V : V ;
-- mi-conjugation:
tivhmi_V : V ; -- BR 129 mi-verbs with reduplication in the present stem
ihmi_V : V ;
didwmi_V : V ;
-- isthmi_V : V ;
deiknymi_V : V ;
-- Greek tablets:
pythagoras_PN : PN ;
advise_V2V : V2V ;
abstain_V2 : V2 ;
letter_N : N ;
eimi_V : V ;
pistos_A2 : A2 ;
} ;

229
lib/src/ancient_greek/BornemannGrc.gf Normal file
View File

@@ -0,0 +1,229 @@
--# -path=.:../abstract:../common:../prelude
-- in mkN we may write "...os" instead of "...os*"
concrete BornemannGrc of Bornemann =
CatGrc ** open ParadigmsGrc, (M=MorphoGrc) in {
flags optimize=values ;
lin
-- A-declension, examples from Bornemann/Risch, Griechische Grammatik, BR 32
idea_N = mkN "i)de'a_" ; -- "i)de'a_" Form, Gestalt
chora_N = mkN "cw'ra_" ; -- "cw'ra_" Land
stratia_N = mkN "stratia_'" ; -- "stratia_'" Heer
doxa_N = mkN "do'xa" "do'xhs*" ; -- "do'xa." Meinung
glotta_N = mkN "glw~tta" "glw'tths*"; -- "glw~tta." Zunge
macha_N = mkN "ma'ch" ; -- "ma.'ca_" Kampf
nika_N = mkN "ni'kh" "ni'khs*" "ni~kai" ; -- "ni_'ka_" Sieg
tima_N = mkN "timh'" ; -- "ti_mh'" Ehre
thalatta_N = mkN "va'latta" "vala'tths*"; -- "va'latta." Meer
gephyra_N = mkN "ge'fyra" "gefy'ras*"; -- "ge'phu_ra." Bruecke
-- Masculina ending in -a_s*, -hs* BR 33
neanias_N = mkN "neani'as*" ; -- "nea_ni.'a_" Juengling
polita_N = mkN "poli'ths*" "poli~tai" ; -- "poli_'ta_", Buerger accentChange i~ta, i~tai
dikasta_N = mkN "dikasth's*" ; -- Richter
atreida_N = mkN "A)trei='dhs*" "A)trei=~dai" ; -- Atride
-- Contracta of the A-declension: -aa_ > a_, ea_ > h BR 34
athena_N = mkN "A)vhna~" ; -- Athena
gea_N = mkN "gh~" ; -- Erde
hermea_N = mkN "E(rmh~s*" ; -- Hermes
-- O-declension
-- Nouns ending in -os or -on: BR 36
logos_N = mkN "lo'gos" ; -- Wort, Rede
demos_N = mkN "dh~mos" ; -- Volk
anthropos_N = mkN "a)'nvrwpos" "a)nvrw'poy" masculine ; -- Mensch
hodos_N = mkN feminine (mkN "o(do's*") ; -- Weg
doron_N = mkN "dw~ron" ; -- Geschenk
-- ergon_N = mkN "e)'rgon" ; -- TESTWORD
-- 3 ending adjectives:
dikaios_A = mkA "di'kaios*" "dikai'a_s*" ; -- gerecht
neos_A = mkA "ne'os" ;
idios_A = mkA "i)'dios" ;
patrwos_A = mkA "patrw|~os" ; -- vaeterlich
aisxros_A = mkA "ai)sxro's" ; -- haesslich
philos_A = mkA "fi'los" ;
delos_A = mkA "dh~los" ;
lithinos_A = mkA "li'vinos" ;
oligos_A = mkA "o)li'gos" ;
agathos_A = mkA "a)gavo's" ; -- gut
nous_N = mkN "noy~s*" ;
osteon_N = mkN "o)stoy~n" ; -- Knochen
eunous_A = mkA "ey)'noys" ;
argyrous_A = mkA "a)rgyroy~s" ; -- silvern
chrysous_A = mkA "crysoy~s" ; -- golden
news_N = mkN "new's*" ; -- nounOs added 2/16
Meneleos_PN = mkPN (mkN "Menele'os") singular ;
ilews_A = mkA "i_('lews" ;
-- Declension III for nouns and adjectives
-- BR 42: stem ending in -r or -l
krathr_N = mkN "kra_th'r" "kra_th~ros" masculine ;
rhtwr_N = mkN "rh'twr" "rh'toros" masculine ;
als_N = mkN "a('ls" "a(lo's" masculine ;
vhr_N = mkN "vh'r" "vhro's" masculine ;
-- BR 43: stem ending in -k,-g,-c or -p,-b,-f
fylax_N = mkN "fy'lax" "fy'lakos" masculine ;
aix_N = mkN "ai)~x" "ai)go's" feminine ;
gyps_N = mkN "gy_'ps" "gy_po's" masculine ;
fleps_N = mkN "fle'ps" "flebo's" feminine ;
-- BR 44: stem ending in -t,-d,-v
esvhs_N = mkN "e)svh's" "e)svh~tos" feminine ;
elpis_N = mkN "e)lpi.'s" "e)lpi'dos" feminine ;
caris_N = mkN "ca'ri.s" "ca'ritos" feminine ; --
swma_N = mkN "sw~ma" "sw'matos" neuter ;
-- BR 45: stem ending in -n
ellhn_N = mkN "E('llhn" "E('llhnos" masculine ;
agwn_N = mkN "a)gw'n" "a)gw~nos" masculine ;
poimhn_N = mkN "poimh'n" "poime'nos" masculine ; -- sgVoc falsch, datPl falsch
daimwn_N = mkN "dai'mwn" "dai'monos" masculine ; -- datPl daimousi; richtig daimosi
-- BR 46: stem in -nt
gigas_N = mkN "gi'ga_s" "gi'gantos" masculine ; -- sgVoc falsch
odoys_N = mkN "o)doy's" "o)do'ntos" masculine ; --
gerwn_N = mkN "ge'rwn" "ge'rontos" masculine ; --
-- Adjectives of 3rd declension:
-- BR 44: stem ending in -t,-d,-v
-- acaris_A = mkA "a)'caris" "a)ca'ritos" ; -- TODO adj3
-- eyelpis_A = mkA "ey)'elpis" "ey)elpi'dos" ; -- TODO adj3
-- apolis_A = mkA "a)'polis" "a)po'lidos" ; -- TODO adj3
-- agnws_A = mkA "a)gnw's" "a)gnw~tos" ; -- BR 57, 1-ending TODO adj3
-- penhs_A = mkA "pe'nhs" "pe'nhtos" ; -- TODO adj3/adjustAccent
-- fygas_A = mkA "fyga's" "fyga'dos" ; -- TODO adj3
-- apais_A = mkA "a)'pais" "a)'paidos" ; -- TODO adj3
-- makar_A = mkA "ma'kar" "ma'karos" ; -- TODO adj3
pepaideykws_A = mkA "pepaideykw's" ; -- BR 44.6
-- BR 45: stem ending in -n
eydaimwn_A = mkA "ey)dai'mwn" "ey)dai'monos" ; -- datPl daimousi; richtig daimosi
-- BR 46.b
pas_A = mkA "pa~s" "panto's" ;
ekwn_A = mkA "e(kw'n" "e(ko'ntos" ;
lywn_A = mkA "ly_'wn" "ly_'ontos" ;
lysas_A = mkA "ly_'sas" "ly_'santos" ;
veis_A = mkA "vei's" "vento's" ;
dys_A = mkA "dy_'s" "dy'ntos" ;
carieis_A = mkA "cari'eis" "cari'entos" ;
-- BR 47: stems ending in -r with 3 ablautlevels
pathr_N = mkN "path'r" "patro's" "pate'ra" masculine ;
mhthr_N = mkN "mh'thr" "mhtro's" "mhte'ra" feminine ;
vygathr_N = mkN "vyga'thr" "vygatro's" "vygate'ra" feminine ;
gasthr_N = mkN "gasth'r" "gastro's" feminine ;
anhr_N = mkN "a)nh'r" "a)ndro's" "a)'ndra" masculine ;
-- BR 48: stems ending in -s
genos_N = mkN "ge'nos" "ge'noys" neuter ;
diogenhs_PN = mkPN "Dioge'nhs" masculine ; -- mkN "Dioge'nhs" "Dioge'noys" masculine ;
periklhs_PN = mkPN "Periklh~s" masculine ;
philosopher_N = mkN "filo'sofos" "filoso'foy" masculine ; -- filosofos
-- For stems ending a vowel:
-- BR 49: -i with ablaut -e:
polis_N = mkN "po'lis" "po'lews" feminine ;
dynamis_N = mkN "dy'namis" "dyna'mews" feminine ;
-- -y with ablaut -e:
phcys_N = mkN "ph~cys" "ph'cews" feminine ; -- TODO to a)'sty
asty_N = mkN "a)'sty" "a)'stews" neuter ;
-- BR 51: -y_ or -y without ablaut:
icvys_N = mkN "icvy~s" "icvy'os" masculine ;
sys_N = mkN "sy~s" "syo's" masculine ; -- and feminine
erinys_N = mkN "E)ri_ny_'s" "E)ri_ny'os" feminine ;
pitys_N = mkN "pi'ty.s" "pi'tyos" feminine ;
-- BR 52: stems ending in -ey
basileys_N = mkN "basiley's" "basile'ws" masculine ;
-- BR 53: -oy, -ay, -ey
boys_N = mkN "boy~s" "boo's" masculine ; -- also: feminine
nays_N = mkN "nay~s" "new's" feminine ;
-- zeys_PN = mkPN (mkN "zey's" "dio's" masculine) singular ; -- TODO: zey'n > di'a ; no Pl
zeys_PN = mkPN "Zey's*" "Dio's*" "Dii='" "Di'a" "Zey~" masculine ;
-- BR 54: -w
peivw_N = mkN "peivw'" "peivoy~s" feminine ;
hrws_N = mkN "h('rws" "h('rwos" masculine ;
-- W-Conjugation
-- a) verba vocalia
paideyw_V = mkV "paidey'w" ;
timaw_V = mkV "tima'w" ; -- "timh'sw" ;
poiew_V = mkV "poie'w" ; -- "poih'sw" ;
doylow_V = mkV "doylo'w" ; -- "doylw'sw" ;
-- b) verba muta
-- labial
leipw_V = mkV "lei'pw" "lei'qw" "e)'lipa" "le'loipa" "le'leipmai" "e)lei'fvhn" "leipto's" ;
elleipw_V = prefixV "e)'n" -- gf does not permit to reuse leipw_V: prefixV "e)'n" leipw_V ;
(mkV "lei'pw" "lei'qw" "e)'lipa" "le'loipa" "le'leipmai" "e)lei'fvhn" "leipto's") ;
-- 1. simple ones (present stem = verbal stem)
trepw_V = mkV "tre'pw" ;
grafw_V = mkV "gra'fw" ;
tribw_V = mkV "tri_'bw" ;
diwkw_V = mkV "diw'kw" ;
arcw_V = mkV "a)'rcw" ;
legw_V = mkV "le'gw" ;
anytw_V = mkV "a(ny'tw" ;
peivw_V = mkV "pei'vw" ;
pseydw_V = mkV "psey'dw" ;
typtw_V = mkV "ty'ptw" ;
kryptw_V = mkV "kry'ptw" ;
blabtw_V = mkV "bla'ptw" ; -- stem blab !
fylattw_V = mkV "fyla'ttw" ; -- stem fylak ! BUG with mC: tt>st
ktizw_V = mkV "kti'zw" ; -- j-stem cannot be guessed, need a good mkVerbW7mut !
nomizw_V = mkV "nomi'zw" "nomiw~" "e)no'misa" "neno'mika" "neno'mismai" "e)nomi'svhn" "nomisto's" ;
swzw_V = mkV "sw|'zw" ;
scizw_V = mkV "sci'zw" ;
evize_V = "e)vi'zw" ;
-- c) verba liquida
derw_V = mkV "de'rw" ;
menw_V = mkV "me'nw" ;
nemw_V = mkV "ne'mw" ;
angellw_V = mkV "a)gge'llw" ;
fainw_V = mkV "fai'nw" ;
-- fainw_V = mkV "fai'nw" "fanw~" "e)'fhna" "pe'fagka" "pe'fasmai" "e)fa'nhn" "fanto's";
--deponents
veaomai_V = mkV "vea'omai" depMed ;
acvomai_V = mkV "acvomai" depPass ;
-- Mi-Conjugation, present stem with reduplication:
tivhmi_V = mkV "ti'vhmi" "vh'sw" "e)'vhka" "te'vhka" "kei~mai" "e)te'vhn" "veto's" ;
-- ihmi_V = mkV "i('hmi" "h('sw" "h(~ka" "ei(~ka" "ei(~mai" "ei('vhn" "e(to's" ;
didwmi_V = mkV "di'dwmi" "dw'sw" "e)'dwka" "de'dwka" "de'domai" "e)do'vhn" "doto's" ;
-- isthmi_V = mkV "i('svhmi" "svh'sw" "e)'svhsa"
-- Mi-Conjugation, present stem with -ny-
deiknymi_V = mkV "dei'knymi" "dei'xw" "e)'deixa" "de'deica" "de'deigmai" "e)dei'cvhn" "deikto's" ;
-- Mi-Conjugation, present stem as verbal root:
-- "ei)mi'"
-- Example sentence: Greek school tablet, F.G.Kenyon
-- Pyvagoras filosofos apobas kai grammata didaskwn syneboyleyen tois eaytoy mavhtais enaimonwn apecesvai.
-- Pythagoras the philospher when going away and teaching letters advised his students to abstain from meat.
pythagoras_PN = mkPN (mkN "Pyva'goras") singular ;
-- advise_V = prefixV "sy'n" (mkV "boyley'w") ;
advise_V2V = mkV2V (prefixV "sy'n" (mkV "boyley'w")) datPrep ;
abstain_V2 = mkV2 (prefixV "a)po'" (mkV "e)'cw")) genPrep ; -- apecw tina tinos + apecomai tinos V3/Vrefl?
-- leave_V2 = dirV2 (prefixV "a)po'" (mkV "bai'nw")) ; -- LexiconGrc
-- student_N = mkN masculine (mkN "mavhth's*") ; -- LexiconGrc, TODO check
-- teach_V2 = mkV2 "dida'skw" ; -- LexiconGrc
letter_N = mkN "gra'mma" "gra'mmatos" neuter ;
eimi_V = lin V (MorphoGrc.eimi_V) ;
pistos_A2 = mkA2 (mkA "pisto's") datPrep ;
} ;

145
lib/src/ancient_greek/BugGrc.gf Normal file
View File

@@ -0,0 +1,145 @@
--# -path=.:../abstract:../common:../prelude
resource BugGrc = ParamX ** open (Ph=PhonoGrc), ResGrc, (P=Predef) in {
-- flags optimize = noexpand ; -- optimize=all is impossible with addAccent
flags optimize = noexpand;
oper
vowel : pattern Str = Ph.vowel ; -- Syntax problem: I still have to use #Ph.vowel, not #vowel
toWord : Str -> Word = ResGrc.toWord ; -- else I get a ConcreteLazy error: missing pattern
{-
-- I. problematic calls are:
call1 : Str = toStrNs1 (toWord "ge'ne") "os*" ; -- 500ms
call2 : Str = toStrNs2 (toWord "ge'ne") "os*" ; -- 12ms
call3 : Str = toStrNs3 (toWord "ge'ne") "os*" ; -- 12ms
call4 : Str = toStrNs4 (toWord "ge'ne") "os*" ; -- 450ms
-- cc Id (toStrNs1) ; -- loops(?)
-- ...
-- cc Id (toStrNs4) ; -- loops(?)
toStrNs1 : Word -> Str -> Str = -- bad
\w,e -> let we = adjustAccent <w, toNEnding e> ;
sl : Soundlaw =
case e of { #Ph.vowel + _ => \xy -> (cV (dS xy)) ;
_ => \xy -> xy } ;
we' = sl we
in toStr (concat we') ;
toStrNs2 : Word -> Str -> Str = -- ok
\w,e -> let we = adjustAccent <w, toNEnding e> ;
we' : Word*NEnding = case e of { #Ph.vowel + _ => (cV (dS we)) ;
_ => we } ;
in toStr (concat we') ;
slOrig : Soundlaw = \ue -> case (toStr ue.p2) of { #Ph.vowel + _ => (cV (dS ue)) ; _ => ue } ;
toStrNs3 : Word -> Str -> Str = -- ok
\w,e -> let we = adjustAccent <w, toNEnding e> ;
sl : Soundlaw = slOrig ;
we' = sl we ;
in toStr (concat we') ;
toStrNs4 : Word -> Str -> Str = -- bad
\w,e -> let we = adjustAccent <w, toNEnding e> ;
sl : Soundlaw = -- = slOrig
\ue -> case (toStr ue.p2) of { #Ph.vowel + _ => (cV (dS ue)) ; _ => ue } ;
we' = sl we ;
in toStr (concat we') ;
Id : (Word -> Str -> Str) -> (Word -> Str -> Str) = \x -> x ;
-- Also note: cc toStrNs1 (toWord "ge'ne") "o*s" ; -- "o*s" instead o "os*" !
-- shows
-- ====================================================================================
-- II. Embedding further: try building part of a noun paradigm using the toStrNs-functions
-- in some variations, and define . Then the slowdown muliplies(?) if the problem is nested.
--
-- cc the following call5 under various sl:Soundlaw, definied outside toStrNs (ls1 - ls6)
-- used in the let sl : Soundlaw = ... of toStrNs
-- either a) by let sl : Soundlaw = slX (X=1,..,6)
-- or b) by let sl : Soundlaw = ... defining term of lsX .
call5 : {PlGen : Str ; SgDat : Str} = noun3s "ge'nos*" "genoy~s*" ResGrc.Neutr ;
toStrNs : Word -> Str -> Str =
\w,e -> let we = adjustAccent <w, toNEnding e> ;
sl : Soundlaw = sl6 ; -- 30ms
-- sl : Soundlaw = \ue -> (cV (dS (adjustAccent ue))) ; -- 2000ms
--
-- sl : Soundlaw = sl5 ; -- 12ms
-- sl : Soundlaw = \ue -> case (toStr ue.p2) of { #Ph.vowel + _ => (cV (dS ue)) ; _ => ue } ; -- 730ms
--
-- sl : Soundlaw = sl4 ; -- 20ms
-- sl : Soundlaw = \we -> case (toStr we.p2) of { #Ph.vowel + _ => we ; _ => we } ; -- Bug we_25
-- sl : Soundlaw = \ue -> case (toStr ue.p2) of { #Ph.vowel + _ => ue ; _ => ue } ; -- 20ms
--
-- sl : Soundlaw = sl3 ; -- 50ms
-- sl : Soundlaw = toSL' (\xy -> case xy of {<x+"e","o"+y> => <x,"oy"+y> ; _ => xy }) ; -- 50ms
we' = sl we ;
in toStr (concat we') ;
sl1 : Soundlaw = (\xy -> xy) ; -- identity
sl2 : Soundlaw = toSL' (\xy -> xy) ; -- identity
sl3 : Soundlaw = toSL' (\xy -> case xy of {<x+"e","o"+y> => <x,"oy"+y> ; _ => xy }) ;
sl4 : Soundlaw = \we -> case (toStr we.p2) of { #Ph.vowel + _ => we ; _ => we } ; -- identity
sl5 : Soundlaw = \ue -> case (toStr ue.p2) of { #Ph.vowel + _ => (cV (dS ue)) ; _ => ue } ;
sl6 : Soundlaw = \ue -> (cV (dS (adjustAccent ue))) ; -- 900ms
noun3s : Str -> Str -> Gender -> { SgDat : Str ; PlGen : Str } = \genos, genoys, g ->
let
-- BR 48: stems ending in s; input needs -s* at the end
w = toWord genos ;
syl = w.s ;
stem : Str = case genoys of {
stm + ("oy's*"|"oy~s*") => stm + "e";
_ => Predef.tk 4 genoys + "e" } ;
-- toStrNs : Word -> Str -> Str = toStrNs; -- does not(?) compile
ge'ne:Word = let stm : Word = toWord stem
in case stm.a of { NoAccent => toWord (addAccentW w.a stm) ;
_ => stm } ;
genei = toStrNs ge'ne (endingsN3!Sg!Dat!g!syl) ; -- Accent: gene'+wn > genw~n
genwn = toStrNs ge'ne (endingsN3!Pl!Gen!g!syl) ; -- not: ge'ne+wn > ge'nwn
in { SgDat = genei ; PlGen = genwn } ;
-}
-- III. Finally, if you uncomment -- toStrNs in noun3s, it seems not to compile ...
{- Generic overwriting of table slots does not work in GF:
exception : (P:PType) -> (V:Type) -> (p:P) -> (v:V) -> (P => V) -> (P => V) =
\P,V,p,v,t -> table { p => v ; x => t ! x } ;
updateAdj : (AForm => Str) -> (AForm => Str) =
\adj -> exception AForm Str (AF Masc Sg Nom) "new" adj ;
updateMSN : (AForm => Str) -> (AForm => Str) = -- nongeneric; this works
\adj -> table { (AF Masc Sg Nom) => "new" ; form => adj ! form } ;
equal : (P:PType) -> P -> P -> Bool =
\P,p,q -> case q of { p => True ; _ => False } ;
eq : (P:PType) -> (P*P) => Bool =
\P -> table (P*P) { <p,p> => True ; _ => False } ;
Lang> cc exception
\P_205,V_206,p_207,v_208,t_209 -> table P_205 {
^^^^^ p_210 => v_208;
^^^^^
x_211 => t_209 ! x_211
}
-}
eqParam : (P:PType) -> P -> P -> Predef.PBool =
\P,p,q -> Predef.eqStr ((Predef.show P) p) ((Predef.show P) q);
-- cc eqParam ResGrc.Gender ResGrc.Fem ResGrc.Masc
-- Predef.PFalse
exception : (P:PType) -> (V:Type) -> (p:P) -> (v:V) -> (P => V) -> (P => V) =
\P,V,p,v,t -> \\q => table { Predef.PTrue => v ; Predef.PFalse => t ! q } ! (eqParam P p q) ;
tab1 : ResGrc.Gender => Str = \\c => "masc" ;
tab2 : ResGrc.Gender => Str = exception ResGrc.Gender Str ResGrc.Fem "fem" tab1 ;
}

136
lib/src/ancient_greek/CatGrc.gf Normal file
View File

@@ -0,0 +1,136 @@
--# -path=.:../abstract:../common:prelude
concrete CatGrc of Cat = CommonX - [Temp,Tense] ** open ResGrc, Prelude in {
flags optimize=all_subs ;
lincat
Temp = {s : Str ; t : VTense ; a : Anteriority } ;
Tense = {s : Str ; t : VTense } ; -- cf. TenseGrc, ResGrc
-- Tensed/Untensed
S = {s : Str} ;
QS = {s : QForm => Str} ;
RS = { s : Agr => Str } ;
SSlash = {s : Str ; c2 : Preposition} ;
-- Sentence
-- We parameterize clauses by VTense rather than Temp or Tense and Anteriority,
-- since absolute or relative tenses are hardly expressed in Greek.
Cl = ResGrc.Clause ; -- {s : VTense => Polarity => Order => Str} ;
ClSlash = {
s : VTense => Polarity => Order => Str ;
c2 : Preposition
} ;
Imp = {s : Polarity => VPImpForm => Str} ;
-- Question
QCl = {s : VTense => Polarity => QForm => Str} ;
IP = { s : Case => Str ; n : Number } ;
-- IComp = {s : Str} ;
IDet = {s : Gender => Case => Str ; n : Number} ;
IQuant = {s : Number => Gender => Case => Str} ;
-- Relative
RCl = {
s : VTense => Polarity => Agr => Str ;
c : Case
} ;
RP = {s : Gender => Number => Case => Str } ;
-- Verb
VP = ResGrc.VP ;
VPSlash = ResGrc.VP ** {c2 : Preposition} ;
Comp = { s : Agr => Str } ;
-- Adverb is defined in CommonX as Adv = { s : Str } ;
-- TODO: Adverbs derived from adjectives have comparative and superlative forms
-- Adjective
AP = { s : AForm => Str } ; -- ResGrc: AForm = AF Gender Number Case
-- TODO: s : Agr => AForm => Str for possessive: one's nice
-- Noun, whose adjective or genitive object may depend on the subject (reflexive possessive)
CN = { s : Number => Case => Str ; -- noun only
s2 : Number => Case => Str ; -- attributes (pre- or postnominal)
isMod : Bool ; -- attribute nonempty?
rel : Number => Str ; -- relative clause (dep. on Agr ?)
g : Gender } ;
NP = {s : Case => Str ;
isPron : Bool ;
e : Case => Str ; -- emphasized pronoun, or ignored
a : Agr } ; -- We need: isPron: PronTon | PronAton | None
-- pron: Tonicity
-- TODO: For CompNP in Verb, we would like to suppress the article
-- At sentence beginnings, (kai|men|de) may be inserted between DefArt and CN
-- NPRefl: noun phrase which may depend on the subject (via reflexive object or possessive)
-- See ExtraGrc
Pron = { s : PronForm => Str ; a : Agr } ; -- personal and possessive
Det = Determiner ; -- = { s : Gender => Case => Str ; n : Number } ;
-- Predet = {s : Str} ; s : Number => Gender => Case => Str ??
Num = {s : Gender => Case => Str ; n : Number ; isCard : Bool} ;
Card = {s : Gender => Case => Str ; n : Number} ; -- cardinals > 200 are adjectives
Ord = {s : AForm => Str} ; -- number: oi tritoi anthropoi?
Quant = Quantifier ; -- = { s : Number => Gender => Case => Str } ;
-- Numeral
Numeral = {s : CardOrd => Str ; n : Number} ;
Digits = {s : Str ; unit : Unit} ;
-- Structural
Conj = {s1,s2 : Str ; n : Number} ;
Subj = {s : Str} ;
Prep = Preposition ; -- = {s : Str ; c : Case} ;
-- Open lexical classes, e.g. Lexicon
V, VS, VA, VQ, VV = Verb ;
V2, V2A, V2S = Verb ** {c2 : Preposition} ;
V2V,V2Q = Verb ** {c2 : Preposition ; isAux : Bool} ;
V3 = Verb ** {c2, c3 : Preposition} ;
A = Adjective ; -- including degree
A2 = Adjective ** {c2 : Preposition} ; -- TODO: add degree
N = Noun ; -- = {s : Number => Case => Str ; g : Gender}
N2 = Noun ** {c2 : Preposition ; obj : Agr => Str } ;
-- we add obj to N2 to have ComplN3 : N3 -> NP -> N2 (which should be N3 -> NP -> CN2!)
N3 = Noun ** {c2,c3 : Preposition} ;
PN = ProperNoun ; -- = {s : Case => Str ; g : Gender ; n : Number} ;
-- default linearizations, stolen from CatGer.gf and modified:
linref
-- SSlash = \ss -> ss.s ! Main ++ ss.c2.s ;
-- ClSlash = \cls -> cls.s ! MIndic ! Pres ! Simul ! Pos ! Main ++ cls.c2.s ;
VP = \vp -> useInfVP vp ;
VPSlash = \vps -> useInfVP vps ++ vps.c2.s ;
V, VS, VQ, VA = \v -> useInfVP (predV v) ;
V2, V2A, V2Q, V2S = \v -> useInfVP (predV v) ++ v.c2.s ;
V3 = \v -> useInfVP (predV v) ++ v.c2.s ++ v.c3.s ;
VV = \v -> useInfVP (predV v) ;
V2V = \v -> useInfVP (predV v) ++ v.c2.s ;
Conj = \c -> c.s1 ++ c.s2 ;
CN = \cn -> cn.s2 ! Sg ! Nom ++ cn.s ! Sg ! Nom ++ cn.rel ! Sg ;
}

15
lib/src/ancient_greek/CombinatorsGrc.gf Normal file
View File

@@ -0,0 +1,15 @@
--# -path=.:alltenses:prelude
resource CombinatorsGrc = Combinators - [appCN, appCNc] with
(Cat = CatGrc),
(Structural = StructuralGrc),
(Noun = NounGrc),
(Constructors = ConstructorsGrc) **
{
oper
appCN : CN -> NP -> NP
= \cn,x -> mkNP the_Art (PossNP cn x) ;
appCNc : CN -> [NP] -> NP
= \cn,xs -> let np : NP = mkNP and_Conj xs
in mkNP the_Art (PossNP cn np) ;
}

74
lib/src/ancient_greek/ConjunctionGrc.gf Normal file
View File

@@ -0,0 +1,74 @@
--# -path=.:../abstract
concrete ConjunctionGrc of Conjunction =
CatGrc ** open ResGrc, Coordination, Prelude in {
flags optimize=all_subs ;
lin
ConjS = conjunctDistrSS ;
ConjAdv = conjunctDistrSS ;
ConjNP conj ss = -- TODO: adapt to proper nps later
let
bigNPs = conjunctDistrTable Case conj ss
in
{ s = \\c => bigNPs.s ! c } ** {
a = conjAgr (agrP3 conj.n) ss.a ;
e = \\_ => [] ;
isPron = False
} ;
ConjAP conj ss = conjunctDistrTable AForm conj ss ;
ConjCN conj ss =
let bigCNs = conjunctDistrTable2 Number Case conj ss
in
{ s = bigCNs.s ;
s2 = \\n,c => [] ;
isMod = True ;
rel = \\_ => [] ;
g = Neutr -- irrelevant
} ;
-- These fun's are generated from the list cat's.
BaseS = twoSS ;
ConsS = consrSS comma ;
BaseAdv = twoSS ;
ConsAdv = consrSS comma ;
BaseNP x y =
{ s1 = bigNP x ; s2 = bigNP y ; a = conjAgr x.a y.a } ;
ConsNP x xs =
{ s1 = \\c => (bigNP x) ! c ++ comma ++ xs.s1 ! c ;
s2 = xs.s2 ;
a = conjAgr x.a xs.a } ;
BaseAP x y =
{ s1 = bigAP x ; s2 = bigAP y } ;
ConsAP x xs =
{ s1 = \\a => (bigAP x) ! a ++ comma ++ xs.s1 ! a ;
s2 = xs.s2 } ;
BaseCN x y =
{ s1 = bigCN x ; s2 = bigCN y } ;
ConsCN x xs =
{ s1 = \\n,c => bigCN x ! n ! c ++ comma ++ xs.s1 ! n ! c ;
s2 = xs.s2 } ;
lincat
[S] = {s1,s2 : Str} ;
[Adv] = {s1,s2 : Str} ;
[NP] = {s1,s2 : Case => Str ; a : Agr} ;
[AP] = {s1,s2 : AForm => Str} ;
[CN] = {s1,s2 : Number => Case => Str} ;
oper
bigAP : AP -> AForm => Str =
\ap -> \\a => ap.s ! a ; -- TODO: add objects of adjective
bigNP : NP -> Case => Str =
\np -> \\c => case np.isPron of { False => np.s ! c ; True => np.e ! c } ;
bigCN : CN -> Number => Case => Str = -- TODO: add ..., *if* cn.rel is nonempty
\cn -> \\n,c => cn.s2 ! n ! c ++ cn.s ! n ! c ; -- ++ comma ++ cn.rel ! n ;
}

8
lib/src/ancient_greek/ConstructionGrc.gf Normal file
View File

@@ -0,0 +1,8 @@
--# -path=.:../abstract
concrete ConstructionGrc of Construction = CatGrc **
open SyntaxGrc, SymbolicGrc, ParadigmsGrc,
(L = LexiconGrc), (E = ExtraGrc), (G = GrammarGrc), (I = IrregGrc), (R = ResGrc), (N = NounGrc), Prelude in {
flags coding=utf8 ;
}

3
lib/src/ancient_greek/ConstructorsGrc.gf Normal file
View File

@@ -0,0 +1,3 @@
--# -path=.:alltenses:prelude
resource ConstructorsGrc = Constructors with (Grammar = GrammarGrc) ;

6
lib/src/ancient_greek/DocumentationGrc.gf Normal file
View File

@@ -0,0 +1,6 @@
--# -path=.:../abstract:../common
-- documentation of Greek in Ancient Greek: the default introduced in LangGrc
concrete DocumentationGrc of Documentation = CatGrc **
DocumentationGrcFunctor with (Terminology = TerminologyGrc) ;

23
lib/src/ancient_greek/DocumentationGrcFunctor.gf Normal file
View File

@@ -0,0 +1,23 @@
--# -path=.:../abstract:../common
incomplete concrete DocumentationGrcFunctor of Documentation = CatGrc ** open
Terminology, -- the interface that generates different documentation languages
ResGrc,
ParadigmsGrc,
(G = GrammarGrc),
(S = SyntaxGrc),
(L = LexiconGrc),
Prelude,
HTML
in {
flags coding=utf8 ;
lincat
Inflection = {t : Str; s1,s2 : Str} ;
Definition = {s : Str} ;
Document = {s : Str} ;
Tag = {s : Str} ;
-- partial, stolen from DocumentationGerFunctor.gf, HL
}

406
lib/src/ancient_greek/ExtraGrc.gf Normal file
View File

@@ -0,0 +1,406 @@
--# -path=.:../abstract:../common:../prelude
concrete ExtraGrc of ExtraGrcAbs = CatGrc, NumeralGrc[Sub1000000,tenthousand] **
open ResGrc, Coordination, Prelude, (M=MorphoGrc), (Ph=PhonoGrc),
(P=ParadigmsGrc), (Rel=RelativeGrc) in {
lincat
DemPron = { s : Gender => Number => Case => Str } ;
CNRefl =
{ s : Number => Case => Str ; -- noun only
s2 : Agr => Number => Case => Str ; -- attributes (pre- or postnominal)
isMod : Bool ; -- attribute nonempty?
rel : Number => Str ; -- relative clause (dep. on Agr ?)
g : Gender } ;
NPRefl =
{s : Agr => Case => Str ; -- reflexive and reflexive possessive use
isPron : Bool ;
e : Case => Str ; -- emphasized pronoun, or ignored
a : Agr } ; -- We need: isPron: PronTon | PronAton | None
-- not used yet (reflexive possessive, specific participle?):
APRefl = { s : Agr => AForm => Str } ;
lin
NumDl = {s = \\_,_ => [] ; n = Dl ; isCard = False} ;
DetCNpost det cn = { -- o anvrwpos o agavos
s = let n = det.n ; g = cn.g in
\\c => det.s ! g ! c ++ cn.s ! n ! c ++ det.s ! g ! c ++ cn.s2 ! n ! c ++ cn.rel ! n ;
isPron = False ;
e = \\_ => [] ;
a = Ag cn.g det.n P3
} ; -- overgenerates since det may not be DefArt !
DetCNRefl det cn = {
s = \\r,c => let n = det.n ; g = cn.g
in det.s ! g ! c ++ cn.s2 ! r ! n ! c ++ cn.s ! n ! c ++ cn.rel ! n ;
isPron = False ;
e = \\_ => [] ;
a = Ag cn.g det.n P3
} ;
AdvNPRefl np adv = {
s = \\r,c => np.s ! r ! c ++ adv.s ;
isPron = False ;
e = \\c => [] ;
a = np.a
} ;
RelNPRefl np rs = {
s = \\r,c => np.s ! r ! c ++ "," ++ rs.s ! np.a ;
isPron = False ;
e = \\c => [] ;
a = np.a
} ;
ComplN2Refl n2 np = {
s = n2.s ;
s2 = -- noun + (refl) object + indir obj ; -- attribute
\\a,n,c => (appPrep n2.c2 np) ++ n2.obj ! a ;
isMod = True ;
rel = \\n => [] ;
g = n2.g
} ;
-- BR 67 2a (ensure that the unemphasized pronoun follows then n)
PossNPRefl cn np = { -- house of mine -- BR 67 2 a (unemphasized pronoun only)
s = \\n,c => cn.s ! n ! c ++ case <np.isPron, np.a> of {
<True,Ag g na p> => (M.mkPersPron g na p) ! Aton ! Gen ; _ => [] } ;
s2= \\a,n,c => case <np.isPron, np.a> of { <True,Ag g na p> => [] ;
_ => np.s ! a ! Gen } ++ cn.s2 ! a ! n ! c ;
isMod = True ;
rel = cn.rel ;
g = cn.g
} ;
PossCNRefl p cn = { -- BR 67 TODO: distinguish between Emph|UnEmph possessive ?
s = cn.s ;
s2 = \\a,n,c => case p.a of { Ag g' Sg _ => (cn.s2 ! a ! n ! c) ++ (p.s ! NPCase Ton Gen) ;
_ => (p.s ! NPPoss cn.g n c) ++ (cn.s2 ! a ! n ! c) } ;
isMod = True ;
rel = cn.rel ;
g = cn.g
} ;
ComplSlashRefl vp np = insertObj (\\a => appPrepRefl vp.c2 np a) vp ;
-- Memo: AForm = AF Gender Number Case ;
-- Agr = Ag Gender Number Person ; -- BR 257: also Case, for AcI, AcP
-- PartVP = PartPresVP PPos ;
-- adjectival attributive use of participle : Pol -> VP -> AP
-- (nonreflexive: vp.obj ! DefaultAgr)
PartPresVP p vp = { s = \\af => (partTmpVP GPres p vp) ! (Ag Masc Sg P3) ! af } ;
PartAorVP p vp = { s = \\af => (partTmpVP GAor p vp) ! (Ag Masc Sg P3) ! af } ;
PartPerfVP p vp = { s = \\af => (partTmpVP GPerf p vp) ! (Ag Masc Sg P3) ! af } ;
PartFutVP p vp = { s = \\af => (partTmpVP GFut p vp) ! (Ag Masc Sg P3) ! af } ;
-- A more general ParticpleNP depending on Temp and Pol seems inappropriate,
-- since the participle leaves the relation to the main verb open; via the aspect of
-- the main tenses, one roughly has (BR 220)
-- PartPres = TSimul, PartAor = TAnter, PartPerf = TSimul, PartFut = inverse TAnter
-- adverbial use of participle : NP -> Pol -> VP -> NP (reflexive: vp.obj ! np.a)
-- CHECK: position of negation and vp.adv?
PartPresNP np p vp = partNP np GPres p vp ;
PartAorNP np p vp = partNP np GAor p vp ;
PartFutNP np p vp = partNP np GFut p vp ;
PartPerfNP np p vp = partNP np GPerf p vp ;
SlashV2VNPRefl vv np vp =
insertObjPre (\\a => vv.c2.s ++ np.s ! a ! vv.c2.c)
(insertObjc (\\a => infVP vp a) (predV2 vv)) ** {c2 = vp.c2} ;
ACP v2 np p vp = -- accusative cum (pres.) participle (if v2.c2 = Acc!)
let g = genderAgr np.a ; -- Sketch only !
n = numberAgr np.a ;
v2p = predV v2 ;
in insertObj (\\agr => np.s ! Acc ++ (PartPresVP p vp).s ! (AF g n Acc)) v2p ;
-- Additional pronouns are needed since ReflPron agrees with the subject in gender.
iFem_Pron = M.mkPron Fem Sg P1 ;
youSgFem_Pron = M.mkPron Fem Sg P2 ;
weFem_Pron = M.mkPron Fem Pl P1 ;
youPlFem_Pron = M.mkPron Fem Pl P2 ;
theyFem_Pron = M.mkPron Fem Pl P3 ;
theyNeutr_Pron = M.mkPron Neutr Pl P3 ;
-- Additional NP-constructions:
{-
UsePronEmph p =
{ s = \\o,c => p.s ! NPCase Ton c ; -- emphasized personal pronoun
isPron = True ;
a = p.a } ;
UsePronUnEmph p =
{ s = \\o,c => p.s ! NPCase Aton c ; -- unemphasized personal pronoun
isPron = True ;
a = p.a } ;
-}
-- DefArt + Inf|Adv|AP ... Nominalizations (TODO: dependencies on Subj.agr)
InfPres vp = { s= \\c => artDef ! Neutr ! Sg ! c ++ vp.obj ! (Ag Neutr Sg P3)
++ vp.s ! VPInf GPres ;
isPron = False ;
e = \\c => [] ;
a = Ag Neutr Sg P3 } ;
InfAor vp = { s = \\c => artDef ! Neutr ! Sg ! c ++ vp.obj ! (Ag Neutr Sg P3)
++ vp.s ! VPInf GAor ;
isPron = False ;
e = \\c => [] ;
a = Ag Neutr Sg P3 } ;
InfPerf vp = { s = \\c => artDef ! Neutr ! Sg ! c ++ vp.obj ! (Ag Neutr Sg P3)
++ vp.s ! VPInf GPerf ;
isPron = False ;
e = \\c => [] ;
a = Ag Neutr Sg P3 } ;
ApposPN pn cn = let ag = cn.g ; -- cn.g = ag ??
an = pn.n ;
in {s = \\c => pn.s ! c ++ ho_Quantifier.s ! an ! ag ! c
++ cn.s2 ! an ! c
++ cn.s ! an ! c
++ cn.rel ! an ;
isPron = False ;
e = \\c => [] ;
a = Ag ag an P3 } ;
ApposPron pr cn = let ag = cn.g ; -- cn.g = pn.g ??
an = numberAgr pr.a ;
in {s = \\c => pr.s ! NPCase Ton c ++ ho_Quantifier.s ! an ! ag ! c --TODO aytoys??
++ cn.s2 ! an ! c
++ cn.s ! an ! c ++ cn.rel ! an ;
isPron = False ;
e = \\c => [] ;
a = Ag ag an P3} ;
-- the greek possessive pronoun is an adjective rather than a determiner
PossCN p cn = { -- BR 67 TODO: distinguish between Emph|UnEmph possessive ?
s = cn.s ;
s2 = \\n,c => case p.a of { Ag g' Sg _ => (cn.s2 ! n ! c) ++ (p.s ! NPCase Ton Gen) ;
_ => (p.s ! NPPoss cn.g n c) ++ (cn.s2 ! n ! c) } ;
isMod = True ;
rel = cn.rel ;
g = cn.g
} ;
-- the reflexive possessive relation, i.e. CN of one's own = eautoy CN, is implemented by
-- the following ReflCN : CN -> CN; note that reflPron is not a Pron or NP.
ReflCN cn = { -- TODO: ensure that relfPron comes before n ??
-- had been: s = \\a,n,c => M.reflPron ! a ! Gen ++ cn.s ! a ! n ! c ;
s = cn.s ;
s2 = \\a,n,c => cn.s2 ! n ! c ++ M.reflPron ! a ! Gen ;
isMod = True ;
rel = cn.rel ;
g = cn.g
} ;
DemNumPre dem num cn = let g = cn.g ; n = num.n ; art = M.artDef
in { s = \\c => dem.s!g!n!c ++ art!g!n!c ++ num.s!g!c ++ cn.s2!n!c ++ cn.s!n!c ;
isPron = False ;
e = \\_ => [] ;
a = Ag g n P3
} ;
DemNumPost dem num cn = let g = cn.g ; n = num.n ; art = M.artDef
in { s = \\c => art!g!n!c ++ cn.s2!n!c ++ cn.s!n!c ++ dem.s!g!n!c ;
isPron = False ;
e = \\_ => [] ;
a = Ag g n P3
} ;
-- Relative Clauses
-- TODO: preposition stranding and empty relative, if they exist
-- Additional VP-constructions:
-- in many languages, combine a V2 (resp.V3) with a reciprocal to get a V (resp.V2)
-- with plural subject (resp.object) [TODO: enforce the plural - we use refl for Sg]:
ReciVP v = insertObj (table { Ag g Pl p => v.c2.s ++ M.reciPron ! g ! v.c2.c ;
agr => v.c2.s ++ M.reflPron !agr! v.c2.c } ) v ;
-- Additional structural words:
so8big_AP = { s = table { AF g n c => M.tosoytos.s ! g ! n ! c } } ; -- tosoytos BR 68 6
such_AP = { s = table { AF g n c => M.toioytos.s ! g ! n ! c } } ; -- toioytos BR 68 6
-- Demonstrative pronouns: BR 68
this_Pron = -- BR 68 1 o'de
{ s = \\g,n,c => let ho : Str = (artDef ! g ! n ! c)
in case ho of { #Ph.vowel + _ => M.a2 ho + "de" ;
toys + "*" => toys + "de" ;
_ => ho + "de" }
} ;
that_Pron = -- BR 68 2 oy~tos
{ s = \\g,n,c => case c of {
ResGrc.Voc => M.a2 (artDef!g!n!Nom + "te") ; -- HL
_ => let ton : Str = M.dA (artDef ! g ! n ! c)
in case ton of { "o(" => "oy('tos*" ;
"h(" => "ay('th" ;
"oi(" => "oy(~toi" ;
"ai(" => "ay(~tai" ;
t+("a"|"h")+n => M.a2 ("tay" + ton) ;
_ => M.a2 ("toy" + ton) }
}
} ;
yonder_Pron = -- BR 68 3 ekei~nos
let autos = adjAO "e)kei~nos" ;
in {s = \\g,n,c => case <g,n,c> of {<Neutr,Sg,Nom|Acc> => "e)kei~no" ;
_ => autos.s ! AF g n c}
};
tosoytos_Pron = M.tosoytos ; -- { s = M.tosoutos } ; -- that big
toioytos_Pron = M.toioytos ; -- { s : M.toioutos } ; -- of that kind
-- Additional Adverbs:
immediately_Adv = ss "ey)vy's*" ; -- BR 63 1
near_Adv = ss "pe'las*" ; -- BR 63
hardly_Adv = ss "mo'lis*" ; -- mo'gis
enough_Adv = ss "a('lis*" ;
for8free_Adv = ss ("dwrea'n" | "proi~ka") ; -- umsonst
in8vain_Adv = ss "ma'thn" ;
too8much_Adv = ss ("a)'gan" | "li'an") ;
nowhere_Adv = ss "oy)damoy~" ;
together_Adv = ss "koinh|~" ;
elsewhere_Adv = ss "a)'llovi" ; -- BR 63 3
elsewhere_from_Adv = ss "a)'lloven" ; -- -kis, -vi, -ven, -se
elsewhere_to_Adv = ss "a)'llose" ;
same_there_Adv = ss "ay)to'vi" ;
same_there_from_Adv = ss "ay)to'ven" ;
same_there_to_Adv = ss "ay)to'se" ;
samePlace_Adv = ss "o(moy~" ;
samePlace_from_Adv = ss "o(mo'ven" ;
samePlace_to_Adv = ss "o(mo'se" ;
home_Adv = ss "oi)'koi" ;
home_from_Adv = ss "oi)'koven" ;
home_to_Adv = ss "oi)'kade" ;
outside_Adv = ss "vy'rasi" ;
outside_from_Adv = ss "vy'raven" ;
outside_to_Adv = ss "vy'raze" ;
ground_at_Adv = ss "camai'" ;
ground_from_Adv = ss "cama~ven" ;
ground_to_Adv = ss "cama~ze" ;
how8often_IAdv = ss "posa'kis*" ; -- BR 73 4
one8times_Adv = ss "a('pax" ;
two8times_Adv = ss "di's*" ;
three8times_Adv = ss "tri's*" ;
four8times_Adv = ss "tetra'kis*" ;
five8times_Adv = ss "penta'kis*" ;
six8times_Adv = ss "e(xa'kis*" ;
seven8times_Adv = ss "e(pta'kis*" ;
eight8times_Adv = ss "o)kta'kis*" ;
nine8times_Adv = ss "e)na'kis*" ;
ten8times_Adv = ss "deka'kis*" ;
initially_Adv = { s = variants{ "prw~ton" ; "th'n" ++ "prw'thn" } } ; -- BR 174
somehow_Adv = ss "ti" ; -- BR 174
in_order_to_Subj = ss "i('na" ; -- BR 276 : ws, o'pws
--2 Numeral
-- number nouns: BR 73.4 dis myriades anvrwpwn
unit_N2 = P.mkN2 (P.mkN "mona's" "mona'dos" Fem) P.genPrep ;
ten_N2 = P.mkN2 (P.mkN "deka's" "deka'dos" Fem) P.genPrep ;
hundred_N2 = P.mkN2 (P.mkN "e(katosty's" "e(katosty'os" Fem) P.genPrep ;
thousand_N2 = P.mkN2 (P.mkN "cilia's" "cilia'dos" Fem) P.genPrep ;
tenthousand_N2 = P.mkN2 (P.mkN "myria's" "myria'dos" Fem) P.genPrep ;
lincat
Sub10000 = {s : CardOrd => Str ; n : Number} ; -- TODO: constructors
lin -- d * 10000
pot4 d = { s = \\f => d.s ! NAdv ++ (tenthousand ! f) ; n = Pl } ;
pot4plus d m = {
s = \\f => d.s ! NAdv ++ tenthousand ! f ++ "kai`" ++ m.s ! f ; n = Pl} ;
{- Maybe add some transformations to the Lang-fragment, cf abstract/Transfer.gf:
In particular, what about Medium voice? Or do we need a verbtype, and
- select the form depending on the verbtype?
- choose the voice depending on the reflexive pronoun
-}
MedVP v = predVmed v ;
MedV2 v = { act = v.med ;
med = v.med ; pass = v.pass ;
vadj1 = v.vadj1 ; vadj2 = v.vadj2 ;
vtype = DepMed ;
c2 = v.c2 } ;
oper
predVmed : Verb -> ResGrc.VP = \v ->
{
s = table { VPFin t n p => v.med ! Fin t n p ;
VPInf tmp => v.med ! Inf tmp ;
VPPart tmp af => v.med ! (Part tmp af) ;
VPImp (M.ImpF IPres n_p) => v.med ! M.Imp IPres n_p ;
VPImp (M.ImpF IAor n_p) => v.med ! M.Imp IAor n_p ;
VPImp (M.ImpF IPerf n_p) => v.med ! M.Imp IPerf n_p ;
VPAdj1 a => v.vadj1.s ! a ;
VPAdj2 a => v.vadj2.s ! a
} ;
neg = Pos ;
obj = \\_ => [] ;
adj = \\_,_ => [] ;
adv = [] ;
ext = []
} ;
-- TODO: add whoeverSgFem : RP etc. whoever + ClSlash : Cl
whoever : Number => Gender => Case => Str = -- BR 69 2
let uncanonize : Str -> Str = \str -> case str of { s + "*" => s ; _ => str }
in
\\n,g,c => case <n,g,c> of {
<Sg,Neutr,Nom|Acc> =>
uncanonize (Rel.relPron ! n ! g ! c) ++ (M.dA (M.indefPron ! n ! g ! c)) ;
_ => uncanonize (Rel.relPron ! n ! g ! c) + (M.dA (M.indefPron ! n ! g ! c))
} ;
appPrepRefl : Preposition -> { s : Agr => Case => Str ;
e : Case => Str ;
isPron : Bool } -> Agr -> Str =
\p,np,a -> if_then_Str np.isPron (p.s ++ np.e ! p.c) (p.s ++ np.s ! a ! p.c) ;
-- TODO: reflexive arguments (and those with a possessive) depend on agreement parameters
-- add this to emphasized forms!
oper -- (nonreflexive) adjectival attributive use of participle
partTmpVP : VTmp -> Pol -> CatGrc.VP -> Agr => AForm => Str = \vtmp,pol,vp ->
let neg = negation ! pol.p ++ pol.s
in \\agr,af => vp.obj ! agr ++ vp.adv ++ neg ++ vp.s ! VPPart vtmp af ;
-- (reflexive) adverbial use of particple
partNP : NP -> VTmp -> Pol -> CatGrc.VP -> NP = \np,vtmp,pol,vp ->
let
ap : AForm => Str = partTmpVP vtmp pol vp ! np.a ;
g = genderAgr np.a ; n = numberAgr np.a ;
in lin NP {
s = \\c => (if_then_Str np.isPron (np.e ! c) (np.s ! c)) ++ ap ! AF g n c ;
isPron = False ;
e = \\c => [];
a = np.a
} ;
-- lincat
-- PartP = { s : VTmp => Polarity => Agr => AForm => Str } ;
-- lin UsePart : VTmp -> Pol -> Part -> APRefl
-- lin PartTmpVP vp =
-- { s = \\vtmp,pol,agr,af => vp.obj ! agr ++ negation ! pol ++ vp.s ! VPPart vtmp af } ;
}

162
lib/src/ancient_greek/ExtraGrcAbs.gf Normal file
View File

@@ -0,0 +1,162 @@
--# -path=.:../abstract:../common:../prelude
abstract ExtraGrcAbs = Extra, Numeral[Sub1000000] ** {
cat
DemPron ;
CNRefl ; -- CN with reflexive attribute or object
NPRefl ; -- NP depending on another NPs agreement: reflexive object, reflexive possessive
-- herself ; her own CN ; many CN of her own CN
-- o emayths adelfos = her own brother
-- o tautys adelfos = her brother
APRefl ; -- AP depending on Agr
PartP ; -- Participle phrase, AP depending on VTmp (or aspect), Polarity, Agr
-- fun
-- UsePart : VTmp -> Pol -> PartP -> APRefl ;
-- PartTmpVP : VP -> PartP ;
-- PartAPRefl : VP -> APRefl ;
fun
NumDl : Num ;
DetCNpost : Det -> CN -> NP ; -- o anvropos o agavos + RelS
-- Construct NPs depending on another NPs agreement features:
DetCNRefl : Det -> CNRefl -> NPRefl ;
AdvNPRefl : NPRefl -> Adv -> NPRefl ;
RelNPRefl : NPRefl -> RS -> NPRefl ;
ComplN2Refl : N2 -> NP -> CNRefl ;
PossNPRefl : CNRefl -> NPRefl -> CNRefl ;
PossCNRefl : Pron -> CNRefl -> CNRefl ; -- (o) emos filos
ComplSlashRefl : VPSlash -> NPRefl -> VP ; -- to V2 (one's own CN)
-- Participles exist in the main tenses only, leaving the temporal relation to the matrix
-- verb undetermined. Roughly, the aspect of the main tense determines the relation (BR 220):
-- PartPres = TSimul, PartAor = TAnter, PartPerf = TSimul, PartFut = inverse TAnter
-- PartVP = PartPresVP : VP -> AP of Extra.gf is implemented here using a default Agr (bad)
PartPresVP : Pol -> VP -> AP ; -- for adjectival usage
PartAorVP : Pol -> VP -> AP ;
PartPerfVP : Pol -> VP -> AP ;
PartFutVP : Pol -> VP -> AP ;
-- NP + active participle in main tense (adverbial usage with NP as implicit subject)
PartPresNP : NP -> Pol -> VP -> NP ;
PartAorNP : NP -> Pol -> VP -> NP ;
PartPerfNP : NP -> Pol -> VP -> NP ;
PartFutNP : NP -> Pol -> VP -> NP ;
-- TODO: NP + medium or passive participle
SlashV2VNPRefl : V2V -> NPRefl -> VPSlash -> VPSlash ;
-- Additional pronouns are needed since ReflPron agrees with the subject in gender.
iFem_Pron, youSgFem_Pron, weFem_Pron, youPlFem_Pron, theyFem_Pron, theyNeutr_Pron : Pron ;
-- Additional NP-constructions:
-- UsePronEmph : Pron -> NP ; -- emphasized personal pronoun
-- UsePronUnEmph : Pron -> NP ; -- unemphasized personal pronoun
-- DefArtAPNP : AP -> NP ;
InfPres : VP -> NP ;
InfAor : VP -> NP ;
InfPerf : VP -> NP ;
ApposPN : PN -> CN -> NP ; -- Pyvagoras o filosofos
ApposPron : Pron -> CN -> NP ; -- hmeis oi strathgoi
PossCN : Pron -> CN -> CN ; -- (o) emos filos
ReflCN : CN -> CNRefl ; -- (ton) emautoy filon, one's own CN
PartCN : PartP -> CN -> CN ; -- BR 241 (but dont: DefArt + PartP + CN)
DemNumPre: DemPron -> Num -> CN -> NP ; -- BR 68 5 oytos o anvrwpos
DemNumPost: DemPron -> Num -> CN -> NP ; -- BR 68 5 o anvrwpos ekeinos
ACP : V2 -> NP -> Pol -> VP -> VP ; -- accusative cum participle
-- For AcI, NcI, Agr = Ag Gender Number Person also needs Case, BR 257
-- Additional VP-constructions:
ReciVP : VPSlash -> VP ;
MedVP : V2 -> VP ;
MedV2 : V2 -> V2 ;
-- Additional AP-constructions:
so8big_AP : AP ; -- positive forms { s : AForm => Str } only
such_AP : AP ;
-- Additional Pronouns:
this_Pron, that_Pron, yonder_Pron : DemPron ;
tosoytos_Pron, toioytos_Pron : DemPron ; -- BR 68 6 better toioytos_A : A
-- Additional adverbs:
immediately_Adv : Adv ;
near_Adv : Adv ;
hardly_Adv : Adv ;
enough_Adv : Adv ;
for8free_Adv : Adv ;
in8vain_Adv : Adv ;
too8much_Adv : Adv ;
nowhere_Adv : Adv ;
together_Adv : Adv ;
elsewhere_Adv : Adv ;
elsewhere_to_Adv : Adv ;
elsewhere_from_Adv : Adv ;
same_there_Adv : Adv ;
same_there_to_Adv : Adv ;
same_there_from_Adv : Adv ;
samePlace_Adv : Adv ;
samePlace_from_Adv : Adv ;
samePlace_to_Adv : Adv ;
home_Adv : Adv ;
home_from_Adv : Adv ;
home_to_Adv : Adv ;
outside_Adv : Adv ;
outside_from_Adv : Adv ;
outside_to_Adv : Adv ;
ground_at_Adv : Adv ;
ground_from_Adv : Adv ;
ground_to_Adv : Adv ;
how8often_IAdv : IAdv ;
one8times_Adv : Adv ;
two8times_Adv : Adv ;
three8times_Adv : Adv ;
four8times_Adv : Adv ;
five8times_Adv : Adv ;
six8times_Adv : Adv ;
seven8times_Adv : Adv ;
eight8times_Adv : Adv ;
nine8times_Adv : Adv ;
ten8times_Adv : Adv ;
initially_Adv : Adv ;
somehow_Adv : Adv ;
-- Numerals:
-- BR 73.4: numeral adjectives a(ploy~s, diploy~s one-fold, two-fold, ...
-- numeral nouns: h( mona's, deka's, chilia's, myria's
unit_N2 : N2 ;
ten_N2 : N2 ;
hundred_N2 : N2 ;
thousand_N2 : N2 ;
tenthousand_N2 : N2 ;
cat
Sub10000 ; -- 1..9999
data
pot4 : Sub10000 -> Sub1000000 ; -- m * 10000
pot4plus : Sub10000 -> Sub10000 -> Sub1000000 ; -- m * 10000 + n
-- Conjunctions:
in_order_to_Subj : Subj ;
}

19
lib/src/ancient_greek/GrammarGrc.gf Normal file
View File

@@ -0,0 +1,19 @@
--# -path=.:../abstract:../common:prelude
concrete GrammarGrc of Grammar =
NounGrc,
VerbGrc,
AdjectiveGrc,
AdverbGrc,
NumeralGrc,
SentenceGrc,
QuestionGrc,
RelativeGrc,
ConjunctionGrc,
PhraseGrc,
TextX-[Tense,Temp],
TenseGrc,
StructuralGrc
-- IdiomGrc
** {
} ;

30
lib/src/ancient_greek/IdiomGrc.gf Normal file
View File

@@ -0,0 +1,30 @@
--concrete IdiomGrc of Idiom = CatGrc ** open Prelude, ResGrc 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 (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)} ;
--
--}
--

62
lib/src/ancient_greek/IrregGrc.gf Normal file
View File

@@ -0,0 +1,62 @@
--# -path=.:prelude:../abstract:../common
concrete IrregGrc of IrregGrcAbs = CatGrc ** open ParadigmsGrc in {
-- BR 121 (partial) TODO: uncomment IrregGrc in LexiconGrc.gf
lin
-- verba vocalia, simple ones
paideyw_V = mkV "paidey'w" "paidey'sw" "e)pai'deysa" "pepai'deyka" "pepai'deymai" "e)paidey'vhn" "paideyto's" ; -- educate
mhnyw_V = mkV "mhny_'w" "mhny_'sw" "e)mh'ny_sa" "memh'ny_ka" "memh'ny_mai" "emhny_'vhn" "mhny_to's" ; -- zeige an
payw_V = mkV "pay'w" "pay'sw" "e)'paysa" "pe'payka" "pe'paymai" "e)pay'vhn" "payste'on" ; -- mache aufhoeren
vhraw_V = mkV "vhra'w" "vhra_'sw" "e)vh'ra_sa" "tevh'ra_ka" "tevh'ra_mai" "e)vhra_'vhn" "vhra_vo's" ; -- jage
timaw_V = mkV "ti_ma'w" "ti_mh'sw" "e)ti_'mhsa" "teti_'mhka" "teti_'mhmai" "e)ti_mh'vhn" "ti_mhto's" ; -- ehre
poiew_V = mkV "poie'w" "poih'sw" "e)poi'hsa" "pepoi'hka" "pepoi'hmai" "e)poih'vhn" "poihto's" ; -- tue
doylow_V = mkV "doylo'w" "doylw'sw" "e)doy'lwsa" "dedoy'lwka" "dedoy'lwmai" "e)doylw'vhn" "doylwto's" ; -- knechte
-- verba vocalia, with exceptions
eaw_V = mkV "e)a'w" "ea_'sw" "ei)'a_sa" "ei)'a_ka" "ei)'a_mai" "ei)a_'vhn" "e)a_to's" ; -- lasse zu
dew_V = mkV "de'w" "dh'sw" "e)'dhsa" "de'deka" "de'demai" "e)de'vhn" "deto's" ; -- binde
lyw_V = mkV "ly_'w" "ly_'sw" "e)'ly_sa" "le'ly.ka" "le'ly.mai" "e)ly.'vhn" "ly.vo's" ; -- loese
vyw_V = mkV "vy_'w" "vy_'sw" "e)'vy_sa" "ve'vy.ka" "ve'vy.mai" "e)ty.'vhn" "vy.te'on" ; -- opfere
dyw_V = mkV "dy'w" "dy_'sw" "e)'dvy_sa" "de'dy.ka" "de'dy.mai" "e)dy.'vhn" "dy.to's" ; -- versenke
-- med. "dy_'somai" "e)'dy_n" "de'dy_ka" -- versinke
-- fyw_V = mkV "fy_'w" "fy_'sw" "e)'fy_sa" nonExists nonExists nonExists "fy.to'n" ; -- erzeuge
-- med. "fy_'somai" "e)'fy_n" "pe'fy_ka" -- entstehe
epainew_V = prefixV "e)p"
(mkV "ai)ne'w" "ai)ne'somai" "h|)'nesa" "h|)'neka" "h|)'nhmai" "h|)ne'vhn" "ai)neto's") ; -- lobe
-- crhsvai_V = mkV "crh~svai" "crh'somai" "e)crhsa'mhn" nonExists "ke'crhmai" " e)crh'svhn" "crhsto's" ; -- gbrauche
spaw_V = mkV "spa'w" "spa'sw" "e)'spasa" "e)'spaka" "e)'spasmai" "e)spa'svhn" "spasvo's" ; -- ziehe
-- gelaw_V = mkV "gela'w" "gela'somai" "e)ge'lasa" nonExists "gege'lasmai" "e)gela'svhn" "gelasvo's" ; -- lache aus
telew_V = mkV "tele'w" "telw~" "e)te'lesa" "tete'leka" "tete'lesmai" "e)tele'svhn" "telesto's" ; -- vollende
-- aideomai_V = mkV "ai)de'omai" "ai)de'somai" nonExists nonExists "h|)'desmai" "h|)de'svhn" nonExists ; -- scheue mich
-- arkew_V = mkV "a)rke'w" "a)rke'sw" "h)'rkesa" nonExists nonExists nonExists nonExists ; -- genuege
kalew_V = mkV "kale'w" "kalw~" "e)ka'lhsa" "ke'klhka" "ke'klhmai" "e)klh'vhn" "klhto's" ; -- rufe, nenne
keleyw_V = mkV "keley'w" "keley'sw" "e)ke'leysa" "keke'leyka" "keke'leysmai" "e)keley'svhn" "keleyso's" ; -- befehle
kleiw_V = mkV "klei'w" "klei'sw" "e)'kleisa" "ke'kleika" "ke'kleimai" "e)klei'svhn" "kleisto's" ; -- schliesse
criw_V = mkV "cri_'w" "cri_'sw" "e)'cri_sa" "ke'cri_ka" "ke'cri_mai" "e)cri_'svhn" "cri_sto's" ; -- salbe
akoyw_V = mkV "a)koy'w" "a)koy'somai" "h)'koysa" "a)kh'koa" "h)'koysmai" "h)koy'svhn" "a)koysto's" ; -- hoere
-- kaiw_V = mkV2 "kai'w" "kay'sw" "e)'kaysa" "ke'kayka" "ke'kaymai" "e)kay'vhn"
-- (variants {"kaysto's"; "kayto's"}) ; -- brenne
-- klaiw_V = mkV "klai'w" "klay'somai" "e)'klaysa" nonExists "ke'klaymai" "e)klay'vn" "klaysto's" ; -- weine
-- plew_V = mkV "ple'w" "pley'somai" "e)'pleysa" "pe'pleyka" nonExists nonExists nonExists ; -- fahre zur See
-- pnew_V = mkV "pne'w" "pney'somai" "e)'pneysa" "pe'pneyka" nonExists nonExists nonExists ; -- hauche
-- rew_V = mkV "re'w" "ryh'somai" "e)rry'hn" "e)rry'hka" nonExists nonExists nonExists ; -- fliesse
cew_V = mkV "ce'w" "ce'w" "e)'cea" "ke'cyka" "ke'cymai" "e)cy'vhn" "cyto's" ; -- giesse
-- verba muta, labialia 32-42
pempw_V = mkV "pe'mpw" "pe'mqw" "e)'pemqa" "pe'pompa" "pepemmai" "e)pemfvhn" "pempto's" ; -- schicke
grafw_V = mkV "gra'fw" "gra'qw" "e)'grafa" "ge'grafa" "ge'grammai" "e)gra'fhn" "grapto's" ; -- schreibe
-- verba muta, gutturalia 43-55
-- verba muta, dentalia 56-65
-- verba liquida, 66-80
-- BR 123, nasal class, 1-17
-- temnw_V = mkV "te'mnw" "temw~" "e)'temon" "te'tmhka" "te'tmhmai" "e)tmh'vhn" "tmhto's" ; -- schneide
-- BR 124, -skw -class, 1-9
-- BR 125, reduplication class 1-7
-- BR 126, E-class, 1-11
-- BR 127, mix class 1-17
oper nonExists : Str = "BUG" ;
}

37
lib/src/ancient_greek/IrregGrcAbs.gf Normal file
View File

@@ -0,0 +1,37 @@
abstract IrregGrcAbs = Cat ** {
fun
paideyw_V : V ;
mhnyw_V : V ;
payw_V : V ;
vhraw_V : V ;
timaw_V : V ;
poiew_V : V ;
doylow_V : V ;
eaw_V : V ;
dew_V : V ;
lyw_V : V ;
vyw_V : V ;
dyw_V : V ;
fyw_V : V ;
epainew_V : V ;
crhsvai_V : V ;
spaw_V : V ;
gelaw_V : V ;
telew_V : V ;
aideomai_V : V ;
arkew_V : V ;
kalew_V : V ;
keleyw_V : V ;
kleiw_V : V ;
criw_V : V ;
akoyw_V : V ;
kaiw_V : V ;
klaiw_V : V ;
plew_V : V ;
pnew_V : V ;
rew_V : V ;
cew_V : V ;
pempw_V : V ;
grafw_V : V ;
temnw_V : V ;
}

12
lib/src/ancient_greek/LangExtra.gf Normal file
View File

@@ -0,0 +1,12 @@
--# -path=.:../abstract:../common:../prelude
abstract LangExtra =
Grammar,
Lexicon,
Bornemann
** {
flags startcat=Phr ;
oper
NumDl : Num ;
} ;

5
lib/src/ancient_greek/LangExtraGrc.gf Normal file
View File

@@ -0,0 +1,5 @@
--# -path=.:../abstract:../common:../prelude
concrete LangExtraGrc of LangExtra =
LangGrc,
ExtraGrc ;

14
lib/src/ancient_greek/LangGrc.gf Normal file
View File

@@ -0,0 +1,14 @@
---# -path=.:../../gf/lib/src/abstract:../common:../prelude
--# -path=.:abstract:../common:../prelude
concrete LangGrc of Lang =
GrammarGrc,
LexiconGrc -- use AllGrc to have Extra and BornemannGrc-words
-- ,ConstructionGrc -- too much to be added ad-hoc HL
-- ,DocumentationGrc --# notpresent
** {
flags startcat = Phr ;
unlexer = text ; lexer = text ;
-- unlexer = unlexgreek ; lexer = lexgreek ; -- effect?
} ;

419
lib/src/ancient_greek/LexiconGrc.gf Normal file
View File

@@ -0,0 +1,419 @@
--# -path=.:../abstract:../common:../prelude
-- Entries taken from Bornemann/Risch and Woodhouse
-- English to Attic Greek dictionary:
-- http://www.lib.uchicago.edu/efts/Woodhouse/
-- Author: H.Leiss, CIS, LMU Muenchen
-- TODO: check the mkN,mkA,mkV on the entries from Woodhouse (Wh)
concrete LexiconGrc of Lexicon = CatGrc ** open
ParadigmsGrc,
IrregGrc, -- with additional verbs in IrregGrcAbs.gf
ResGrc, -- for mkPrep only,
Prelude in {
flags
optimize=values ;
lin
-- add_V3 : V3 ;
airplane_N = mkN "h(liko'pthr" "h(liko'pteros" masculine ; -- HL
-- alas_Interj : Interj ;
-- already_Adv : Adv ;
animal_N = mkN "vh'r" "vhro's" masculine ;
-- animal_N = mkN "zw|~on" "zw|'oy" neuter ; -- TODO check
answer_V2S = mkV2S (mkV "a)pokri'nw") datPrep ; -- medium
apartment_N = mkN "oi)~kos" ; -- Woodhouse
apple_N = mkN "mh~lon" ;
art_N = mkN "te'cnh" ;
ashes_N = mkN "te'fra" ; -- Woodhouse
ask_V2Q = mkV2Q (mkV "e)rwta'w") accPrep ;
baby_N = mkN "tekni'dion" ;
back_N = mkN "nw~ton" ; -- Woodhouse
bad_A = mkA "kako's" ;
bank_N = mkN "tra'peza" ; -- Woodhouse
bark_N = mkN "ploi~on" ; -- Woodhouse
beautiful_A = mkA "kalo's" ;
-- become_VA : VA ;
-- beer_N : N ; "o)i~nos kri_'vinos" -- Gerstenwein
-- beg_V2V : V2V ; "ai)tei~n" tina ti -- Wh
-- belly_N : N ; -- h koili'a, -as -- Bauchhoehle
belly_N = mkN "gasth'r" "gastro's" "gaste'ra" feminine ; -- Wh
big_A = mkA "makro's" ;
bike_N = mkN "dyozy'klon" ; -- HL
bird_N = mkN "oi)wno's" ;
black_A = mkA "me'la_s" "me'lanos" ; -- TODO: correct to me'las*, me'laina, me'lan
blue_A = mkA "kyanoy~s" ; -- Wh
boat_N = mkN "ploi~on" ; -- Wh
book_N = mkN "bi'blos" "bi'bloy" feminine ;
boot_N = mkN "ko'vornos" ; -- Wh
boss_N = mkN "o)mfa.lo's" ; -- Wh mkN human (...)
boy_N = mkN "pai~s" "paido's" masculine ;
bread_N = mkN "a)'rtos" ;
break_V2 = mkV2 (prefixV "a)po" (mkV "kla'w")) ;
-- broad_A = mkA "ey)ry's" ; -- Wh TODO
brother_N2 = mkN2 (mkN "a)delfo's") genPrep ;
brown_A = mkA "xanvo's" ; -- Wh
-- butter_N = mkN "butter" ;
-- buy_V2 = dirV2 (mkV "w)nei~svai") ; -- Aor: pri'asvai, Wh -- TODO Comp.Bug
-- camera_N = mkN "camera" ;
cap_N = mkN "ky.nh~" ; -- Wh
car_N = mkN "zey~gos" "zey'goys" neuter ;
-- carpet_N = mkN "da.'pi.s" ; -- Wh BUG mkN does not apply
cat_N = mkN feminine (mkN "ai)'loyros") ; -- Wh, Masc|Fem
ceiling_N = mkN "o)rofh'" ; -- Wh
chair_N = mkN "di'fros" ; -- Wh
cheese_N = mkN "ty.ro's" ; -- Wh
child_N = mkN2 (mkN "te'knon") genPrep ;
-- church_N = mkN "new's" ; -- TODO to i('dry_ma, -atos ??
city_N = mkN "po'lis" "po'lews" feminine ; -- polis
clean_A = mkA "ka.va.ro's" ; -- Wh
clever_A = mkA "fro'nimos" "froni'moy" ; -- TODO: froni'moy
close_V2 = dirV2 (mkV "klh|'w") ; -- Wh
coat_N = mkN "i(ma'tion" ;
cold_A = mkA "qycro's" ; -- Wh TODO: correct forms/accents
come_V = mkV "e)'rcomai" ; -- Wh TODO
-- computer_N = mkN "computer" ;
country_N = mkN "cw'ra" ;
-- cousin_N = mkN human (mkN "cousin") ;
cow_N = mkN "boy~s" "boo's" feminine ; -- TODO: correct dual from boy~ to bo'e
die_V = prefixV "a)po'" (mkV "vnh'skw") ; -- TODO: check forms -- teleyta'w
dirty_A = mkA "volero's" ; -- Wh
distance_N3 = mkN3 (mkN feminine (mkN "o(do's")) fromP toP ;
doctor_N = mkN "i)atro's" ; -- TODO check
dog_N = mkNoun "ky'wn" "kyno's*" "kyni'" "ky'na" "ky'on"
"ky'nes*" "kynw~n" "kysi'" "ky'nas*" -- BR 55.4
"ky'ne" "kynoi~n" masculine ;
door_N = mkN "vy'ra" ;
drink_V2 = dirV2 (mkV "pi_'nw" "pi'omai" "e('pion" "pe'pwka" "pe'pomai" "e)po'vhn" "poto's") ;
-- easy_A2V = mk_A2V (mkA "ra|'dios" "ra|di'oy") ; - Wh TODO
eat_V2 = mkV2 (mkV "e)svi'w" "fa'gomai" "e)'fagon" "e)dh'dwka" "e)dh'desmai" "e)de'svhn" "e)desto's") ;
-- eat_V2 fut: (variants{"e)'domai" ; "fa'gomai"}) -- TODO: correct Fut-forms
empty_A = mkA "keno's" ; -- Wh
enemy_N = mkN "pole'mios" "polemi'oi" masculine ; -- ecvro's
factory_N = mkN "e)rgasth'rion" ; -- Wh
father_N2 = mkN2 (mkN "path'r" "patro's" "pate'ra" masculine) genPrep ;
fear_VS = mkVS (mkV "fobe'w") ; -- fear_N = mkN "fo'bos" "fo'boy" masculine
find_V2 = dirV2 (mkV "ey(ri'skw") ; -- Wh
fish_N = mkN "i)cvy~s" "i)cvy'os" masculine ;
floor_N = mkN neuter (mkN "e)'dafos") ; -- Wh
forget_V2 = dirV2 (mkV "e)pilanva.'nomai") ; -- Wh TODO
-- fridge_N = mkN "fridge" ;
friend_N = mkN "fi'los" ;
fruit_N = mkN "karpo's" ;
-- fun_AV = mkAV (regA "fun") ;
-- garden_N = mkN "paradei~son" ;
garden_N = mkN "kh~pos" ; -- Wh
girl_N = mkN "pai~s" "paido's" feminine ;
-- glove_N = mkN "ceiri's" ; -- Wh TODO
glove_N = mkN "ceiri's" "ceiri~dos" feminine ; -- HL guessed
gold_N = mkN "cry's" "cryso's" neuter ; -- TODO check (accents missing in Pl)
good_A = mkA "a)gavo's" ;
go_V = mkV "e)'rxomai" ;
-- green_A = mkA "di'kaios" "dikai'a_s" ; -- Testword
green_A = mkA "clwro's" ; -- Wh
harbour_N = mkN "limh'n" "lime'nos" masculine ;
hate_V2 = dirV2 (mkV "mise'w") ; -- tina', ti' fut mish'sw
hat_N = mkN "ky.nh~" ; -- Wh
have_V2 = dirV2 (mkV "e('cw") ; -- Wh TODO
hear_V2 = dirV2 (mkV "a)koy'w") ;
hill_N = mkN "lo'fos" ; -- Wh
hope_VS = mkVS (mkV "e)lpi'zw" "e)lpiw~" "h)'lpisa" "h)'lpika" "h)'lpismai" "h)lpi'svhn" "h)lpisto's") ; -- TODO check aorist
horse_N = mkN "i('ppos" ; --hippos
hot_A = mkA "vermo's" ;
house_N = mkN "oi)~kos" "oi)'koy" masculine ;
important_A = mkA "a)xio'logos" ;
industry_N = mkN "filoponi'a_" ; -- Wh -- a_ added HL
iron_N = mkN "si.'dhros" ; -- Wh
king_N = mkN "basiley's" "basile'ws" masculine ;
know_V2 = dirV2 (mkV "manva.'nw") ; -- Wh, better: eide'nai
lake_N = mkN "li'mnh" ;
lamp_N = mkN "lampvh'r" "lampth~ros" masculine ;
-- lamp_N = mkN "ly'cnos" ; -- Wh
learn_V2 = mkV2 "dida'skw" ; -- medium
leather_N = mkN neuter (mkN "sky~tos") ; -- Wh
leave_V2 = dirV2 (prefixV "a)po'" (mkV "bai'nw")) ;
like_V2 = mkV2 "file'w" ;
-- listen_V2 = mkV2 (prefixV "e)p" (mkV "a.koy'w")) genitive ; -- Wh tinos, ti BUGs
live_V = mkV "paidey'w" ; -- TESTWORD
long_A = mkA "makro's" ; -- Wh
lose_V2 = dirV2 (mkV "a.)poly.'nomai") ; -- Wh, BUGs
love_N = mkN "a)ga'ph" ;
love_V2 = mkV2 "a)gapa'w" ; -- TODO check
man_N = let man : N = mkN "a)nh'r" "a)ndro's" "a)'ndra" masculine
in { s = table{ Sg => table{ Voc => "a)'ner" ;
c => man.s ! Sg ! c };
n => man.s ! n } ;
g = man.g } ;
-- man_N = mkN "a)'nvrwpos" "a)nvrw'poy" masculine ;
married_A2 = mkA2 (mkA "gegamhme'nos") datPrep ;
meat_N = mkN "e)nai'monon" "e)naimo'noy" neuter ; -- e)aimos_A : having blood
milk_N = mkN "ga'la" "ga'laktos" neuter ; -- TODO: correct Sg Nom|Akk
moon_N = mkN "seilh~nh" ; -- TODO check
mother_N2 = mkN2 (mkN "mh'thr" "mhtro's" "mhte'ra" feminine) genPrep ;
mountain_N = mkN "o)'ros" "o)'roys" neuter ;
music_N = mkN "moysikh'" ;
narrow_A = mkA "steno's" ; -- Wh
new_A = mkA "ne'os" "ne'a_s" ;
-- newspaper_N = mkN "newspaper" ;
oil_N = mkN neuter (mkN "e)'laion") ; -- Wh
-- old_A = mkA "presby's" "presbei~a" "presby'" ; -- TODO mkA
-- old_A = mkA "presby's" "presby'teros" ; -- fake entry TODO
open_V2 = dirV2 (prefixV "a.)n" (mkV "oi'gw")) ; -- Wh
paint_V2A = mkV2A (mkV "zwgrafe'w") noPrep ; -- TODO noPrep?
paper_N = mkN "pa'py_ros" ;
-- paris_PN = mkPN (mkN nonhuman (mkN "Paris")) singular ;
peace_N = mkN "ei)rh'nh" ;
-- pen_N = mkN "grafi's" ; -- Wh TODO: BUG
planet_N = mkN "pla'nhs" "pla'nhtos" masculine ; -- TODO check accents
plastic_N = mkN "plastiko'n" ;
-- play_V2 = dirV2 (mkV "y(pokri'nomai")) ; -- Wh (as actor) TODO prefixV
-- policeman_N = mkN masculine (mkN "policeman" "policemen") ;
priest_N = mkN "i(erey's" "i(ere'ws" masculine;
-- priest_N = mkN "i(eromnh'mwn" "i(ieromnh'monos" masculine ;
probable_AS = (mkA "ey)'logos") ; -- Wh TODO mkAS
queen_N = mkN "basi'lea_" ;
-- radio_N = mkN "radio" ;
rain_V0 = mkV "y('w" ; -- Wh TODO V0?
read_V2 = mkV2 "a)nagignw'skw" ;
red_A = mkA "a(loyrgo's" ; -- purpur ; mkA "pyrro's" ; mkA "ko'kkinos"
-- religion_N = mkN "religion" ;
-- restaurant_N = mkN "restaurant" ;
river_N = mkN "potamo's" ;
rock_N = mkN "li.'vos" ; -- TODO: check
roof_N = mkN "o)'rofos" ; -- Wh
-- rubber_N = mkN "rubber" ;
-- run_V = mkV "tre'cw" "dramoy~mai" "e)'dramon" "dedra'mhka" ; -- BR 127 8
-- TODO: why compiler error NonExist
say_VS = mkVS (mkV "le'gw") ;
school_N = mkN "scolh'" ;
science_N = mkN "ma'vhsis" "mate'sews" feminine ; -- TODO check
sea_N = mkN "va'latta" "vala'tths" ;
-- 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 = mkN "o)'is" "oi)o's" "oi)i'" "oi)~n" "oi)~es" "oi)w~n" "oi)si'n" "oi)~s" ; -- TODO
ship_N = mkN "nay~s" "new's" feminine ;
shirt_N = mkN "ci.twni'skos" ; -- Wh
shoe_N = mkN "krhpi's" "krhpi~dos" feminine ;
-- shop_N = mkN "shop" ;
-- short_A = mkA "di'kaios" ; -- TODO accent shift!
-- short_A = mkA "bra.cy.'s" ; -- Wh TODO BUG
silver_N = mkN "a)'rgyron" ; -- TODO check
sister_N = mkN2 (mkN "a)delfh'") genPrep ;
sleep_V = mkV "kavey'dw" ;
small_A = mkA "mikro's" ;
snake_N = mkN "dra_'kwn" "dra'kontos" masculine ; -- mkN "o)'fis" "o)'fews" masculine
-- sock_N = mkN "sock" ;
speak_V2 = mkV2 (mkV "le'gw" "le'xw" "e)'lexa" "le'lega" "le'legmai" "e)le'kthn" "lekto's*") aboutP ;
star_N = mkN "a)sth'r" "a)ste'ros" masculine ; -- TODO a)stra'si
steel_N = mkN "si.'dhros" ; -- Wh
stone_N = mkN "li'vos" ;
stove_N = mkN "kri_'banos" ;
student_N = mkN masculine (mkN "mavhth's") ; -- TODO check
stupid_A = mkA "a)'frwn" "a)'fronos" ; -- or "mw~ros"
sun_N = mkN "h('lios" ; -- TODO check accents?
-- switch8off_V2 = dirV2 (partV (regV "switch") "off") ;
-- switch8on_V2 = dirV2 (partV (regV "switch") "on") ;
table_N = mkN "tra'peza" ; -- Wh (TODO glyph a.' and i.' in Cardo)
talk_V3 = mkV3 (mkV "diale'gw") datPrep (mkPrep "pro's" accusative) ;
teacher_N = mkN "dida'skalos" ;
teach_V2 = mkV2 "paidey'w" ; -- "dida'skw"
-- television_N = mkN "television" ;
thick_A = mkA "pykno's" ; -- Wh
thin_A = mkA "mano's" ; -- Wh
-- train_N = mkN "train" ;
travel_V = mkV "porey'omai" ; -- Wh TODO Part
tree_N = mkN "de'ndron" ;
---- trousers_N = mkN "trousers" ;
-- trousers_N = TODO mkN "a)naxyri'des" feminine plural -- Wh
ugly_A = mkA "ai)scro's" ;
understand_V2 = mkV2 "gignw'skw" ;
university_N = mkN "a)kademi'a" "a)kademi'as" ;
village_N = mkN "xwri'on" ; -- mkN "w'ra"
wait_V2 = mkV2 "me'nw" ; -- Wh a)na-me'nw
watch_V2 = dirV2 (mkV "fy.lattw") ; -- Wh fy.lassein
water_N = mkN "y('dwr" "y('datos" masculine ; -- TODO check
white_A = mkA "leyko's" ; -- TODO accent?
-- window_N = mkN "vy.ri.'s" ; -- Wh feminine TODO mkN
window_N = mkN "vy.ri.'s" "vy.ri~dos" feminine ; -- Wh, HL guessed gen
wine_N = mkN "oi)~nos" ;
-- win_V2 = dirV2 (irregDuplV "win" "won" "won") ;
-- woman_N = mkN "gynai'ka" ; -- "gynh'" "gynaiko's*" ; -- TODO correct BR 55
woman_N = mkNoun "gynh'" "gynaiko's*" "gynaiki'" "gynai~ka" "gy'nai"
"gynai~kes*" "gynaikw~n" "gynaixi'" "gynai~kas*"
"gynai~ke" "gynaikoi~n" feminine ; -- BR 55
-- wonder_VQ = mkVQ (mkV "vayma'zw") ; -- Wh
wood_N = mkN "xy'lon" ;
write_V2 = mkV2 "gra'fw" ;
yellow_A = mkA "xanvo's" ; -- Wh
young_A = mkA "ne'os" ; -- TODO: vowel lengths neo'tatos => new'tatos etc.
-- do_V2 = dirV2 (mkV "dra'w") ;
do_V2 = dirV2 (mkV "dra'w" "dra_'sw" "e)'dra_sa" "de'dra_ka" "de'dramai" "e)dra'svhn" "drasto's") ;
now_Adv = mkAdv "ny~n" ;
already_Adv = mkAdv "h)'dh" ; -- Wh
song_N = mkN "w)dh'" ;
-- add_V3 = mkV3 (prefixV "syn" (mkV "logi'zw")) accPrep toP ;
number_N = mkN "a)rivmo's" ; -- ?? guessed
-- put_V2 = TODO Wh ti.ve'nai
stop_V = mkV "pay'w" ;
-- jump_V = regV "jump" ;
--
left_Ord = { s = (mkA "a.)ristero's").s ! Posit } ; -- Wh
right_Ord = { s = (mkA "dexio's").s ! Posit } ;
far_Adv = mkAdv "po'rrw" ; -- BR 63 3
correct_A = mkA "o)rto's" ; -- Wh
dry_A = mkA "xhro's" ; -- Wh
dull_A = mkA "skaio's" ; -- Wh (not intelligent)
-- full_A = mkA "ple'ws" ; -- Wh -- TODO mkA
-- heavy_A = mkA "a)rgyroy~s*" ; -- TESTWORD (silvern) bary's
-- heavy_A = mkA "ba.ry.'s" ; -- Wh -- Bug
-- near_A = mkA "crysoy~s*" ; -- TESTWORD (golden)
near_A = mkA "pro'scwros" ; -- Wh
rotten_A = mkA "savro's" ; -- Wh
-- round_A = mkA "kykloterh's" ; -- Wh -- TODO mkA
-- sharp_A = mkA "o)xy's" "o)xei~a" "o)xy'" ; -- TODO: improve mkA to accept this
smooth_A = mkA "lei~os" ; -- Wh
-- straight_A = mkA "ey)vy.'s" ; -- Wh -- TODO mkA
wet_A = mkA "y(gro's" ; -- Wh
-- wide_A = mkA "ey)ry.'s" ; -- Wh -- TODO mkA
blood_N = mkN "ai('ma" "ai('matos" neuter ;
bone_N = mkN "o)stoy~n" ; -- Ok
-- bone_N = mkN "o)ste'on" ;
-- breast_N = mkN "breast" ;
cloud_N = mkN "nefe'lh" ;
day_N = mkN "h(me'ra_" ;
dust_N = mkN "koni'a_" ; -- TODO: check forms
ear_N = mkN "oy)~s" "w)to's" neuter ; -- TODO correct Sg Nom|Acc
earth_N = mkN "gh~" ; -- Pl and DL ???
egg_N = mkN "w|)o'n" ; -- Wh
eye_N = mkN "o(fvalmo's" ;
fat_N = mkN "dhmo's" ; -- Wh
feather_N = mkN "ptero'n" ; -- Wh
fingernail_N = mkN "o)'nyx" "o)'nycos" masculine ;
fire_N = mkN "py~r" "pyro's" neuter ; -- TODO correct Pl, BR 55 6: pyrsi > pyrois
flower_N = mkN "a)'nvos" "a)'nvoys" neuter ;
fog_N = mkN "nefe'lh" ; -- Wh ; o)mi'clh
foot_N = mkN "poy's" "podo's" masculine ; -- BR 44 3
forest_N = mkN "dry_mo's" ;
grass_N = mkN "clo'h" ; -- Wh -- TODO mkN "po'a" ; -- Wh
-- guts_N = mkN "spla'gxna" neuter plural ; -- WH pl -- FIXME: no singular
guts_N = mkN "spla'ngxnon" ; -- Wh with pl only
hair_N = mkN "tri'x" "trico's" feminine ;
hand_N = mkN "cei~r" "ceiro's" feminine ; -- TODO exception PlDat cersi'
head_N = mkN "ke'falos" ; -- TODO check
-- heart_N = mkN "kardi'a" "kardi'as" feminine ; -- TODO mkN does not recognize -as*
heart_N = mkN "kardi'a_" ;
horn_N = mkN "ke'ras" "ke'ratos" neuter ; --
husband_N = mkN "game'ths" ;
-- ice_N = mkN "ice" ;
knee_N = mkN "go'ny" "go'natos" neuter ; -- TODO BR 44 3
leaf_N = mkN "fy'llon" "fy'lloy" neuter ;
leg_N = mkN neuter (mkN "ske'los") ; -- We
liver_N = mkN "h(~par" "h('patos" neuter ; -- TODO Sg Nom|Acc
louse_N = mkN "fvei'r" "fveiro's" masculine ; -- Wh
mouth_N = mkN "sto'ma" "st'omatos" neuter ; -- TODO check
name_N = mkN "o)'noma" "o)no'matos" neuter ; -- TODO check
neck_N = mkN "tra'chlos" ;
night_N = mkN "ny'x" "nykto's" feminine ;
-- nose_N = mkN "nose" ; h r(i-s ths r(inos
nose_N = mkN "ri~s" "ri_no's" feminine ; -- Wh, HL guessed
person_N = mkN "a)'nvrwpos" "a)nvrw'poy" masculine ; -- HL
rain_N = mkN "y(eto's" ; -- Wh ; ggf TODO mkN "y('dwr" ;
road_N = mkN feminine (mkN "o(do's") ;
-- root_N = mkN "ri'za." ; -- Wh TODO mkN fem
-- rope_N = mkN "ka.'lws" ; -- Wh masculine TODO mkN
salt_N = mkN "a('ls" "a(lo's" masculine ;
sand_N = mkN "a)'mmos" "a)'mmoy" feminine ; -- Wh
seed_N = mkN "spe'rma" "spe'rmatos" neuter ; -- Wh
skin_N = mkN "de'rma" "de'rmatos" neuter ; -- TODO check
sky_N = mkN "oy)ra.no's" ; -- Wh
smoke_N = mkN "kapno's" ; -- Wh
snow_N = mkN "nifa's" "nifa'dos" feminine ;
stick_N = mkN "ra'bdos" "ra'bdoy" feminine ;
tail_N = mkN "ke'rkos" ; -- Wh ; h( ou)ra'
tongue_N = mkN "glw~tta" "glw'tths" ; -- ok
tooth_N = mkN "o)doy's" "o)do'ntos" masculine ;
wife_N = mkN "gameth'" ;
wind_N = mkN "a)'nemos" ; -- TODO check
wing_N = mkN "pte'ryx" "pte'rycos" feminine ; -- Wh, HL gen
worm_N = mkN "ey)lh'" ; -- Wh
year_N = mkN "e)'tos" "e)'toys" neuter ;
--
blow_V = mkV "pne'w" ; -- TODO check
breathe_V = mkV "pne'w" ;
-- burn_V = IrregGrc.burn_V ;
-- dig_V = IrregGrc.dig_V ;
fall_V = mkV "pi'ptw" "pesoy~mai" "e)'peson" "pe'ptwka" ; -- GMOLL
-- "pe'ptwmai" "e)pe'pthn" "pepto's" ; -- HL guessed
-- float_V = regV "float" ;
-- flow_V = regV "flow" ;
-- fly_V = IrregGrc.fly_V ;
-- freeze_V = IrregGrc.freeze_V ;
give_V3 = dirV3 (mkV "di'dwmi" "dw'sw" "e)'dwka" "de'dwka"
"de'domai" "e)do'vhn" "doto's") datPrep ; -- didwmi_V
laugh_V = mkV "gela'w" ; -- TODO: check
-- lie_V = IrregGrc.lie_V ;
-- play_V = regV "play" ;
-- sew_V = IrregGrc.sew_V ;
-- sing_V = IrregGrc.sing_V ;
-- sit_V = IrregGrc.sit_V ;
-- smell_V = regV "smell" ;
-- spit_V = IrregGrc.spit_V ;
-- stand_V = IrregGrc.stand_V ;
-- swell_V = IrregGrc.swell_V ;
-- swim_V = mkV ;
think_V = mkV "frone'w" ; -- TODO: check forms
-- turn_V = regV "turn" ;
-- vomit_V = regV "vomit" ;
--
-- bite_V2 = dirV2 IrregGrc.bite_V ;
-- count_V2 = dirV2 (regV "count") ;
cut_V2 = dirV2 (mkV "te'mnw") ; -- TODO: correct forms Fut e.a.
-- 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 = mkV2 (prefixV "a)po" (mkV "ktei'nw")) ; -- TODO: special forms for passive
-- pull_V2 = dirV2 (regV "pull") ;
-- push_V2 = dirV2 (regV "push") ;
-- rub_V2 = dirV2 (regDuplV "rub") ;
-- scratch_V2 = dirV2 (regV "scratch") ; -- TODO se'scimai => Bug
split_V2 = dirV2 (mkV "sci'zw" "sci'sw" "e)'scisa" "se'scika" "se'scimmai" "e)sci'svhn" "scisto's") ;
-- squeeze_V2 = dirV2 (regV "squeeze") ;
-- stab_V2 = dirV2 (regDuplV "stab") ;
-- suck_V2 = dirV2 (regV "suck") ;
throw_V2 = datV2 (mkV "ba'llw") ;
-- tie_V2 = dirV2 (regV "tie") ;
-- wash_V2 = dirV2 (regV "wash") ;
-- wipe_V2 = dirV2 (regV "wipe") ;
--
---- other_A = regA "other" ;
grammar_N = mkN "grammatikh'" ;
language_N = mkN "glw~ssa" "glw'sshs" ; -- TODO: accents??
-- rule_N = mkN "rule" ;
--
---- added 4/6/2007
john_PN = mkPN (mkN masculine (mkN "Ia'nnas")) singular ;
question_N = mkN "e)rw'thsis" "e)rwth'sews" feminine ; -- Wh
-- gen guessed HL -- Wh TODO mkN "e)rw'thma" neuter;
ready_A = mkA "e(toi~mos" ; -- Wh
reason_N = mkN "lo'gos" ; -- mkN "ai)ti'a"
-- today_Adv = mkAdv "today" ;
-- uncertain_A = regA "uncertain" ;
oper
aboutP = mkPrep "peri'" Gen;
atP = mkPrep "para'" Dat ;
forP = mkPrep "pro'" Gen ;
inP = mkPrep "e)n" Dat ;
onP = mkPrep "e)pi'" Gen ;
toP = mkPrep "e)pi'" Acc ; -- mkPrep "para'" Acc ;
fromP = mkPrep "e)x" Gen ;
noPrep = mkPrep [] Acc ;
}

69
lib/src/ancient_greek/Makefile Normal file
View File

@@ -0,0 +1,69 @@
nouns:
grep N bornemann > nounsBR
gf < nounsBR.gfs > nounsBR.out
rm nounsBR
ediff-nouns:
emacs --eval "(ediff-files \"nounsBR.gold\" \"nounsBR.out\" \
(set-default-font \"-unknown-New Athena Unicode-normal-normal-normal-*-*-*-*-*-*-0-iso10646-1\"))" &
adjectives:
grep A bornemann > adjectivesBR
gf < adjectivesBR.gfs > adjectivesBR.out
rm adjectivesBR
ediff-adjectives:
emacs --eval "(ediff-files \"adjectivesBR.gold\" \"adjectivesBR.out\" \
(set-default-font \"-unknown-New Athena Unicode-normal-normal-normal-*-*-*-*-*-*-0-iso10646-1\"))" &
verbs:
grep V bornemann > verbsBR
gf < verbsBR.gfs > verbsBR.out
rm verbsBR
ediff-verbs:
emacs --eval "(ediff-files \"verbsBR.gold\" \"verbsBR.out\" \
(set-default-font \"-unknown-New Athena Unicode-normal-normal-normal-*-*-*-*-*-*-0-iso10646-1\"))" &
# Paradigmen fuer alle Woerter aus lexicon.abstract erstellen (Lexicon.gf)
paradigms:
gf < paradigms.gfs > paradigms.out
ediff-paradigms:
emacs --eval "(ediff-files \"paradigms.gold\" \"paradigms.out\")" &
examples:
gf -run < examples.gfs > examples.out
emacs --eval "(ediff-files \"examples.gold\" \"examples.out\")" &
example-schemata:
gf -run < schemata.gfs > schemata.out
emacs --eval "(ediff-files \"schemata.gold\" \"schemata.out\" \
(set-default-font \"-unknown-New Athena Unicode-normal-normal-normal-*-*-*-*-*-*-0-iso10646-1\"))" &
examplesLang:
gf -run < examplesLang.gfs > examplesLang.out
emacs --eval "(ediff-files \"examplesLang.gold\" \"examplesLang.out\")" &
# school tablet example
school-tablet:
gf -run < school-tablet.gfs > school-tablet.out
emacs --eval "(ediff-files \"school-tablet.gold\" \"school-tablet.out\")" &
# emacs --eval "(ediff-files \"school-tablet.gold\" \"school-tablet.out\" (set-font \"-unknown-New Athena Unicode-normal-normal-normal-*-*-*-*-*-*-0-iso10646-1\")" &
school-tablet-2:
gf -run < school-tablet-2.gfs > school-tablet-2.out
toGrc:
gf -run < examples.tr.gfs
slides:
noweave -delay langGrc.slides.thessaloniki-2016.nw > langGrc.slides.thessaloniki-2016.tex
latex -output-format=dvi -interaction=nonstopmode langGrc.slides.thessaloniki-2016.tex
xdvi -s 6 -expert -offsets 2.5cm -paper a4 -geometry 550x400+1300+0
clean:
rm -i *~
rm -i *.aux
rm -i *.log

1837
lib/src/ancient_greek/MorphoGrc.gf Normal file
View File

File diff suppressed because it is too large Load Diff

237
lib/src/ancient_greek/NounGrc.gf Normal file
View File

@@ -0,0 +1,237 @@
--# -path=.:../abstract:../common:../prelude
concrete NounGrc of Noun = CatGrc ** open Prelude, ResGrc, (M = MorphoGrc) in {
flags optimize=all_subs ;
lin
DetCN det cn = { -- different attribute order in ExtraGrc.DetCNpost
s = \\c => let n = det.n ; g = cn.g
in det.s ! g ! c ++ cn.s2 ! n ! c ++ cn.s ! n ! c ++ cn.rel ! n ;
isPron = False ;
e = \\_ => [] ;
a = Ag cn.g det.n P3
} ;
UsePN pn = {
s = pn.s ;
isPron = False ;
e = \\c => [] ;
a = Ag pn.g pn.n P3
} ;
UsePron pron = {
s = table{ c => pron.s ! NPCase Aton c } ; -- for Nom: like ProDrop
isPron = True ;
e = table{ c => pron.s ! NPCase Ton c } ; -- emphasized form after prep etc.
a = pron.a
} ;
-- PredetNP pred np = {
-- s = \\c => pred.s ++ np.s ! c ;
-- a = np.a
-- } ;
--
-- PPartNP np v2 = { -- the man seen
-- s = \\c => np.s ! c ++ v2.s ! VPPart ;
-- a = np.a
-- } ;
--
AdvNP np adv = {
s = \\c => np.s ! c ++ adv.s ;
isPron = False ;
e = \\c => [] ;
a = np.a
} ;
RelNP np rs = {
s = \\c => np.s ! c ++ "," ++ rs.s ! np.a ;
isPron = False ;
e = \\c => [] ;
a = np.a
} ;
-- Mar 2,2012
-- The sp field is for determiners used as NP's, which are sometimes different
-- from their use as Det's. Omitted for Greek.
{-
DetNP det = {
s = \\o => det.s ! Neutr ;
r = \\agr,c => case agr of {Ag g n p => det.s ! g ! c ++ autos.s ! g ! n ! c};
isPron = False ;
e = \\_ => [] ;
a = Ag Neutr det.n P3
} ;
-}
DetQuant quant num = {
s = \\g,c => quant.s ! num.n ! g ! c ++ num.s ! g ! c ;
n = num.n
} ;
DetQuantOrd quant num ord = {
s = \\g,c => quant.s ! num.n ! g ! c ++ num.s !g ! c ++ ord.s ! AF g num.n c ; -- TODO check
n = num.n
} ;
NumSg = {s = \\_,_ => [] ; n = Sg ; isCard = False} ;
NumPl = {s = \\_,_ => [] ; n = Pl ; isCard = False} ;
-- NumDl: in ExtraGrc
NumCard n = n ** {isCard = True} ;
-- TODO: check the following two:
NumDigits digits = let num : Number = case digits.unit of {one => Sg ; _ => Pl}
in {s = \\g,c => digits.s ++ "'"; n = num ; isCard = True} ;
NumNumeral numeral = {s = \\g,c => numeral.s ! NCard g c; n = numeral.n } ;
AdNum adn num = {s = \\g,c => adn.s ++ num.s ! g ! c ; n = num.n} ;
OrdDigits digits = {s = \\af => digits.s } ;
OrdNumeral numeral = {s = \\af => numeral.s ! NOrd af} ;
OrdSuperl a = {s = a.s ! Superl} ;
-- Greek has a definite article, but no indefinite article.
DefArt = {
s = \\n,g,c => artDef ! g ! n ! c
} ;
{-
-- An empty IndefArt produces empty NPgen-attributes:
-- like (PrepNP part_Prep (DetNP (DetQuant InDefArt NumDl)))
-}
IndefArt = {
s = \\n,g,c => [] -- for linearization
} ;
MassNP cn = {
s = \\c => cn.s2 ! Sg ! c ++ cn.s ! Sg ! c ++ cn.rel ! Sg ;
isPron = False ;
e = \\_ => [] ;
a = agrP3 Sg
} ;
-- TODO: the possPron is rather an adjective than a det:
-- oi emoi agathoi philoi
PossPron p = {
s = \\n,g,c => artDef ! g ! n ! c ++ p.s ! NPPoss g n c ;
} ;
--2 Common Nouns
-- We keep the head noun separate in field s, collect attributes in s2, and
-- relative clauses in rel. (Combine the components properly when using the CN!)
UseN n = {
s = n.s ;
s2 = \\n,c => [] ;
isMod = False ;
rel = \\n => [] ;
g = n.g
} ;
ComplN2 n2 np = { -- sketch
s = n2.s ;
s2 = -- noun + (refl) object + indir obj ; -- attribute
\\n,c => (appPrep n2.c2 np) ++ n2.obj ! Ag n2.g n P3 ;
isMod = True ;
rel = \\n => [] ;
g = n2.g
} ;
ComplN3 n3 np = {
s = n3.s ;
obj = \\a => (appPrep n3.c2 np) ; -- TODO NPRefl ?
g = n3.g ;
c2 = n3.c3
} ;
-- UseN2 = UseN ;
UseN2 n2 = {
s = \\n,c => n2.s ! n ! c ++ n2.obj ! (Ag n2.g n P3);
s2 = \\n,c => [] ;
isMod = False ;
rel = \\n => [] ;
g = n2.g
} ;
Use2N3 n3 = {
s = n3.s ;
g = n3.g ;
obj = \\a => [] ;
c2 = n3.c2
} ;
Use3N3 n3 = {
s = n3.s ;
g = n3.g ;
obj = \\a => [] ;
c2 = n3.c3
} ;
AdjCN ap cn = {
s = cn.s ;
s2 = \\n,c => (ap.s ! AF cn.g n c) ++ (cn.s2 ! n ! c) ; -- attributes
isMod = True ;
rel = cn.rel ;
g = cn.g
} ;
RelCN cn rs = {
s = cn.s ;
s2 = cn.s2 ;
isMod = True ;
rel = \\n => "," ++ rs.s ! Ag cn.g n P3 ; -- TODO: ++ (kai) ++ cn.rs
g = cn.g
} ;
AdvCN cn adv = {
s = cn.s ;
s2 = \\n,c => cn.s2 ! n ! c ++ adv.s ; -- ???
isMod = True ;
rel = cn.rel ;
g = cn.g
} ;
SentCN cn sc = {
s = \\n,c => cn.s ! n ! c ;
s2 = \\n,c => cn.s2 ! n ! c ++ sc.s ; -- TODO: use the attribute!
isMod = cn.isMod ;
rel = cn.rel ;
g = cn.g } ;
-- abstract/Noun.gf: city Paris, but possibly overgenerating
-- ApposCN cn np = {s = \\n,c => np.s ! Pre ! c ++ cn.s ! n ! c ; -- test: epi ton Psaron potamon
-- s2 = \\n,c => [] ; isMod = cn.isMod ; g = cn.g} ; -- Pythagoras philosophos
-- Better use ExtraGrc.gf: ApposPN, ApposPron
-- BR 67 2: The non-reflexive possessive relation, when expressed by a genitive np (including pron):
{-
PossNP cn np = { -- house of mine -- BR 67 2 a (unemphasized pronoun only)
s = \\a,n,c => case np.isPron of {
True => cn.s ! a ! n ! c ++ np.s ! a ! Pre ! Gen ; -- unemphasized persPron!Gen
False => np.s ! a ! Pre ! Gen ++ cn.s ! a ! n ! c } ;
s2= \\a,n,c => case np.isPron of { True => [] ; -- don't count the unemph.pron as attribute
False => np.s ! a ! Pre ! Gen } ;
isMod = case np.isPron of { True => cn.isMod ; _ => True } ;
rel = cn.rel ;
g = cn.g
} ;
-}
-- BR 67 2a (ensure that the unemphasized pronoun follows then n)
PossNP cn np = { -- house of mine -- BR 67 2 a (unemphasized pronoun only)
s = \\n,c => cn.s ! n ! c ++ case <np.isPron, np.a> of {
<True,Ag g na p> => (M.mkPersPron g na p) ! Aton ! Gen ; _ => [] } ;
s2= \\n,c => case <np.isPron, np.a> of { <True,Ag g na p> => [] ;
_ => np.s ! Gen } ++ cn.s2 ! n ! c ;
isMod = True ;
rel = cn.rel ;
g = cn.g
} ;
-- The reflexive possessive relation, i.e. CN of one's own = eautoy CN, is treated by
-- PossRefl : CN -> CN in ExtraGrc; note that reflPron is not a Pron or NP.
-- PartNP cn np = :cn -- glass of wine
-- CountNP det no = :np -- some of the boys
}

97
lib/src/ancient_greek/NumeralGrc.gf Normal file
View File

@@ -0,0 +1,97 @@
--# -path=.:../abstract:../common:../prelude:
concrete NumeralGrc of Numeral = CatGrc ** open ResGrc, MorphoGrc 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 ;
oper -- n1 not in abstract
thousand : CardOrd => Str = cardOrd "ci'lioi" "ciliosto's" "cilia'kis" ;
tenthousand : CardOrd => Str = cardOrd "my'rioi" "myriosto's" "myria'kis" ;
n1 = mkDigit "ei(~s" "e('ndeka" "de'ka" "prw~tos" "a('pax" ;
lin -- mkDigit d (d+10) (d*10) d-th d-times
-- -----------------------------------------------------------------------
n2 = mkDigit "dy'o" "dw'deka" "ei)'kosi" "dey'teros" "di's" ;
n3 = mkDigit "trei~s" ("trei~s"++"kai`"++"de'ka")
"tria'konta" "tri'tos" "tri's" ;
n4 = mkDigit "te'ttares" ("te'ttares"++"kai`"++"de'ka")
"tettara'konta" "te'tartos" "tetra'kis" ;
n5 = mkDigit "pe'nte" "pentekai'deka" "penth'konta" "pe'mptos" "penta'kis" ;
n6 = mkDigit "e('x" "e(kkai'deka" "e(xh'konta" "e('ktos" "e(xa'kis" ;
n7 = mkDigit "e(pta'" "e(ptakai'deka" "e(bdomh'konta" "e('bdomos" "e(pta'kis" ;
n8 = mkDigit "o)ktw'" "o)ktwkai'deka" "o)gdoh'konta" "o)'gdoos" "o)kta'kis" ;
n9 = mkDigit "e)nne'a" "e)nneakai'deka" "e)nenh'konta" "e)'natos" "e)na'kis" ;
pot01 = n1 ** {n = Sg} ; -- 1
pot0 d = d ** {n = Pl} ; -- d * 1
pot1 d = {s = d.s ! DTen} ** {n = Pl} ; -- d * 10
pot110 = pot1 n1 ; -- 10
pot1to19 d = {s = d.s ! DTeen} ** {n = Pl} ; -- 10 + d
pot111 = pot1to19 n1 ; -- 11
pot0as1 n = {s = n.s ! DUnit} ** {n = n.n} ; -- coerce : Sub10 -> Sub100
pot1plus d e = -- d * 10 + e
-- let kai : Str = ("kai`" | "") in -- too expensive! -- BR 73.2
{ s = \\f => d.s ! DTen ! f ++ "kai`" ++ e.s ! DUnit ! f ; n = Pl} ;
pot1as2 n = n ; -- coerce : Sub100 -> Sub1000
pot2 d = { s = \\f => d.s ! DHundred ! f ; n = Pl} ; -- d * 100
pot2plus d m = { -- d * 100 + m
s = \\f => d.s ! DHundred ! f ++ "kai`" ++ m.s ! f ; n = Pl} ; -- BR 73.2
pot2as3 n = n ;
-- d * 1000
pot3 d = { s = \\f => d.s ! NAdv ++ (thousand ! f) ; n = Pl} ;
pot3plus d m = {
s = \\f => d.s ! NAdv ++ thousand ! f ++ "kai`" ++ m.s ! f ; n = Pl} ;
-- numerals as sequences of digits
lincat
Dig = TDigit ;
lin
IDig d = {s = d.s ! one; unit = ten} ;
IIDig d i = {
s = d.s ! i.unit ++ i.s ;
unit = inc i.unit
} ;
D_0 = mkDig "-" "-" "-" ; -- avoid empty Dig
D_1 = mkDig "a" "i" "r" ;
D_2 = mkDig "b" "k" "s" ;
D_3 = mkDig "g" "l" "t" ;
D_4 = mkDig "d" "m" "y" ;
D_5 = mkDig "e" "n" "f" ;
D_6 = mkDig "s*" "x" "c" ; -- TODO: replace s* by stigma (not in ut -ancientgreek)
D_7 = mkDig "z" "o" "q" ;
D_8 = mkDig "h" "p" "w" ;
D_9 = mkDig "v" "K" "P" ; -- TODO: replace K by koppa, P by sampi (not in ut -ancientgreek)
oper
TDigit = {
s : Unit => Str
} ;
mkDig : Str -> Str -> Str -> TDigit =
\one,ten,hundred -> { s = table Unit [one;ten;hundred] } ;
inc : Unit -> Unit = \u ->
case u of {
one => ten ;
ten => hundred ;
-- hundred => thousand ;
-- thousand => myriad ;
-- myriad => myriad
hundred => hundred
} ;
}

1
lib/src/ancient_greek/OverloadGrc.gf Normal file
View File

@@ -0,0 +1 @@
--resource OverloadGrc = Overload with (Grammar = GrammarGrc) ;

308
lib/src/ancient_greek/ParadigmsGrc.gf Normal file
View File

@@ -0,0 +1,308 @@
--# -path=.:../abstract:../prelude:../common
--1 Greek Lexical Paradigms
--
-- Hans Leiß, using Aarne Ranta's files for Latin as starting point 2011, 2012
--
-- 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$.
resource ParadigmsGrc = open
Prelude,
ResGrc, -- TODO: suppress later, when the inflections are moved to Morpho
(M = MorphoGrc),
(Ph = PhonoGrc),
CatGrc
in {
flags
optimize=noexpand ;
--2 Parameters
oper
-- To abstract over gender and number names, we define the following.
-- Gender : Type ;
masculine : Gender ;
feminine : Gender ;
neuter : Gender ;
-- Number : Type ;
singular : Number ;
plural : Number ;
dual : Number ;
-- VType : Type
depMed : VType ;
depPass : VType ;
--2 Nouns
mkN = overload {
mkN : (logos : Str) -> N
= \n -> lin N (noun n) ;
mkN : Gender -> N -> N = \g,n -> lin N {s = n.s ; g=g } ;
mkN : (va'latta, vala'tths : Str) -> N
= \x,y -> lin N (noun2 x y) ;
mkN : (valatta, valatths, valattai : Str) -> N
= \x,y,z -> lin N (case x of { _ + ("a"|"h") => noun3A x y z }) ;
mkN : (a'mpelos, ampe'loy : Str) -> Gender -> N
= \x,y,g -> lin N (case x of { _ + ("os" | "os*")
=> (case g of {
Masc|Fem => noun3O x y g ;
_ => noun3 x y g }) ;
_ + "on" => noun3O x y g ;
_ => noun3 x y g }) ;
mkN : (path'r, patro's, pate'ra : Str) -> Gender -> N
= \x,y,z,g -> lin N (noun3r3 x y z g) ;
} ;
mkN2 : N -> Prep -> N2 ; -- relational nouns
--3 Proper names
--
-- To inherit the inflection from nouns, proper names are built from nouns and a fixed number.
mkPN = overload {
mkPN : Noun -> Number -> PN =
\n,num -> lin PN {s = n.s!num ; n=num ; g=n.g } ;
mkPN : Str -> Gender -> PN =
\diogenhs,g -> lin PN (pn3s diogenhs g) ;
mkPN : (_,_,_,_,_5:Str) -> Gender -> PN =
\nom,gen,dat,acc,voc,g ->
lin PN {s = table Case [nom ; gen ; dat ; acc ; voc] ;
n = Sg ; g = g} ;
} ;
--2 Adjectives
-- Status: preliminary
-- - Adjective inflection is done by building three nouns;
-- - no special accentuation rules are built in,
-- - comparative and superlative: incorrect stems, wrong accents
mkA = overload {
-- for adjectives with accent on the ending, or triple-ended ones without accent shift,
-- provide SgNomMasc:
mkA : (agavo's : Str) -> A
= \x -> lin A (mkAdjective (case x of {
y + ("w's*"|"w's") => adj3 x (y + "o'tos*") ;
_ => adjAO x })) ;
-- for adjectives with accent not on the ending, provide SgNomMasc and SgGenFem:
mkA : (di'kaios, dikai'as : Str) -> A
= \x,y -> lin A (mkAdjective (case y of { _ + ("os*"|"os") => adj3 x y ;
_ + ("nto's*"|"nto's") => adj3 x y ;
_ => adj2AO x y })) ;
} ;
mkA2 : A -> Prep -> A2 ; -- relational adjectives
--2 Adverbs TODO
-- Many adverbs are derived from adjectives by replacing the Masc.Sg.Gen-ending
-- "w~n" | "wn" by "w~s" | "wn". These forms can be found as A.adv.
-- Adverbs derived from adjectives inflect for Degree, others don't.
mkAdV : Str -> AdV = \x -> lin AdV (ss x) ;
--2 Prepositions
-- A preposition is formed from a string and a case.
mkPrep : Str -> Case -> Prep = \s,c -> lin Prep {s = canonize s ; c = c} ;
-- Often just a case with the empty string is enough:
accPrep, datPrep, genPrep : Prep ;
--2 Verbs
mkV = overload {
-- for regular verbs whose aspect/tempus stems can be derived
mkV : (paideyw : Str) -> V =
\v -> case v of { _ + "w" => lin V (M.mkVerbW1 v) ;
_ + ("mi"|"mi'") => lin V (M.mkVerbMi1 v) ;
_ + "omai" => lin V (M.mkVerbDep v DepMed) -- default dep.
} ;
mkV : (paideyomai : Str) -> (vt : VType) -> V =
\v,vt -> case v of { _ + "omai" => lin V (M.mkVerbDep v vt) ;
_ => Predef.error ("verb does not end in -omai") } ;
-- for intransitive verbs having no medium and passiv:
mkV : (_,_,_,v4 : Str) -> V = -- TODO
\piptw,pesoymai,epeson,peptwka ->
lin V { act = M.mkActW piptw pesoymai epeson peptwka ;
med, pass = table { vf => Predef.nonExist } ;
vadj1, vadj2 = { s = table { af => Predef.nonExist } ;
adv = Predef.nonExist } ;
vtype = VFull } ;
-- for verbs whose aspect/tempus stems must be provided by:
-- ActPres, ActFut, ActAor, ActPerf, MedPerf, PassAor, VAdj
-- paideyw paideysw epaideysa pepaideyka pepaideymai epaideyvhn paideytos
-- lei'pw lei'psw le'lipa le'loipa le'leipmai lelei'fvhn leipt'os
mkV : (_,_,_,_,_,_,v7 : Str) -> V =
\leipw,leipsw,elipsa,leloipa,leleipmai,leleifvhn,leiptos ->
case leipw of {
_ + "w" => lin V (M.mkVerbW7 leipw leipsw elipsa leloipa
leleipmai leleifvhn leiptos) ;
_ + "nymi" => lin V (M.mkVerbNyMi7 leipw leipsw elipsa leloipa
leleipmai leleifvhn leiptos) ;
_ => lin V (M.mkVerbRedupMi leipw leipsw elipsa leloipa
leleipmai leleifvhn leiptos)
} ;
} ;
-- Verbs with prepositional (and other) prefix reduplicate and augment after
-- the prefix, and assimilate prefix and main verb:
-- (It's faster if we do elision by indicating where the prefix ends)
prefixV : Str -> V -> V = \sy'n, v -> lin V -- BR 85
(let -- TODO: admit u@diphthong; else?
syn = M.dA sy'n ;
nC : Str -> Str -> Str = Ph.nasalConsonant ;
elision : (Str * Str) -> Str = \str -> case str of {
<x + "r" + i@("i'"|"i"|"o'"|"o"), u@#Ph.vowel + #Ph.aspirate + y>
=> x + "r" + i + u + y ; -- don't elide in peri|pro
<x + ("a'"|"a"|"o'"|"o"|"i'"|"i"), u@#Ph.vowel + #Ph.aspirate + y>
=> x + u + y ; -- elide vowel of prefix, and aspirate
<x + c@#Ph.consonant, u@#Ph.vowel + #Ph.aspirate + y>
=> x + c + u + y ;
_ => nC str.p1 str.p2
} ;
assim : Str -> Str -> Str = \str1,str2 -> elision <str1,str2> ;
in
{ act = table { form => assim syn (v.act!form) } ; -- syn + (part ++ einai) TODO
med = table { Fin (VPerf VConj) n p => syn ++ v.med ! (Fin (VPerf VConj) n p) ;
Fin (VPerf VOpt) n p => syn ++ v.med ! (Fin (VPerf VOpt ) n p) ;
form => assim syn (v.med ! form) } ;
pass = table { Fin (VPerf VConj) n p => syn ++ v.pass ! (Fin (VPerf VConj) n p) ;
Fin (VPerf VOpt) n p => syn ++ v.pass ! (Fin (VPerf VOpt ) n p) ;
form => assim syn (v.pass ! form) } ;
imp = table { form => assim syn (v.imp ! form) } ;
part = table { Act => \\t => { s = \\aform => assim syn ((v.part ! Act ! t).s ! aform) ;
adv = assim syn (v.part ! Act ! t).adv } ;
dia => \\t => { s = \\aform => assim syn ((v.part ! dia ! t).s ! aform) ; -- guessed
adv = assim syn (v.part ! dia ! t).adv }
} ;
vadj1 = { s = \\aform => assim syn (v.vadj1.s ! aform) ;
adv = assim syn v.vadj1.adv } ;
vadj2 = { s = \\aform => assim syn (v.vadj2.s ! aform) ;
adv = assim syn v.vadj2.adv } ;
vtype = v.vtype ;
}) ;
--3 Two-place verbs
mkV2 = overload {
-- Two-place regular verbs with direct object (accusative, transitive verbs).
mkV2 : Str -> V2 = strV2 ;
mkV2 : V -> V2 = dirV2 ; -- add a direct object
-- Two-place verbs with a prepositional or nominal complement
mkV2 : V -> Prep -> V2 = prepV2 ; -- preposition for complement
mkV2 : V -> Case -> V2 = caseV2 ; -- just case for complement
} ;
--3 Three-place verbs
--
-- Three-place (ditransitive) verbs need two prepositions, of which
-- the first one or both can be just a case.
mkV3 : V -> Prep -> Prep -> V3 ;
--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 -> 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 $AS, A2S, AV, A2V$ are just $A$,
-- and the second argument is given as an adverb. Likewise
-- $V0$ is just $V$.
-- V0 : Type ; --%
-- AS, A2S, AV, A2V : Type ; --%
--3 Adverbs
mkAdv = overload {
mkAdv : Str -> Adv = \str -> lin Adv { s = str } ;
mkAdv : Prep -> NP -> Adv = \p,np -> lin Adv { s = p.s ++ np.s ! p.c } ;
mkAdv : A -> Adv = \a -> lin Adv { s = a.adv ! Posit } ;
} ;
-- LexiconGrc should not use the short forms below.
masculine = Masc ;
feminine = Fem ;
neuter = Neutr ;
singular = Sg ;
plural = Pl ;
dual = Dl ;
genitive = Gen ;
dative = Dat ;
accusative = Acc ;
depMed = DepMed ;
depPass = DepPass ;
-- Definitions of the operations: ===================================================
mkN2 : N -> Prep -> N2 = \n,p -> lin N2 (n ** {c2 = p ; obj = \\r => []}) ;
mkN3 : N -> Prep -> Prep -> N3 = \n,p,q -> lin N3 (n ** {c2 = p ; c3 = q}) ;
mkA2 : A -> Prep -> A2 = \a,p -> lin A2 (a ** {c2 = p}) ;
prepV2 : V -> Prep -> V2 = \v,c -> lin V2 (v ** {c2 = c}) ;
dirV2 : V -> V2 = \v -> prepV2 v accPrep ;
datV2 : V -> V2 = \v -> prepV2 v datPrep ;
strV2 : Str -> V2 = \s -> dirV2 (mkV s) ;
caseV2 : V -> Case -> V2 = \v,c -> prepV2 v (mkPrep [] c) ;
mkV3 : V -> Prep -> Prep -> V3 = \v,c,d -> lin V3 (v ** {c2 = c; c3 = d}) ;
dirV3 : V -> Prep -> V3 = \v,d -> lin V3 (v ** {c2 = accPrep; c3 = d}) ;
mkVS : V -> VS = \v -> lin VS (v ** {s = v.act ! (Fin (VPres VConj) Sg P3)}) ; -- prelim, TEST
mkV2S = \v,p -> lin V2S (prepV2 v p ** {isAux = False});
mkV2V = \v,p -> lin V2V (prepV2 v p ** {isAux = False});
mkV2Q = \v,p -> lin V2Q (prepV2 v p ** {isAux = False});
mkVV : V -> VV = \v -> lin VV v ; -- ??
mkV2A v p = lin V2A (prepV2 v p ** {isAux = False}) ;
accPrep = mkPrep [] accusative; -- just dative case
genPrep = mkPrep [] genitive ; -- just genitive case
datPrep = mkPrep [] dative ; -- just dative case
}

528
lib/src/ancient_greek/PhonoGrc.gf Normal file
View File

@@ -0,0 +1,528 @@
resource PhonoGrc = open Prelude in {
flags coding=utf8 ;
optimize=all ;
oper
-- consonants:
labial : pattern Str = #("p" | "b" | "f") ;
dental : pattern Str = #("t" | "d" | "v") ;
guttural : pattern Str = #("k" | "g" | "c") ;
nasal : pattern Str = #("n" | "m") ;
liquid : pattern Str = #("l" | "r") ;
-- spirans : pattern Str = #("s") ;
consonant : pattern Str =
#("p"|"b"|"f"|"t"|"d"|"v"|"k"|"g"|"c"
|"l"|"r"|"m"|"n"|"s"|"x"|"q"|"z") ;
-- vowels:
shortDiphthong : pattern Str = #( "ai" | "ei" | "oi" | "yi" | "ay" | "ey" | "oy" ) ;
longDiphthong : pattern Str = #("a_i" | "hi" | "wi" | "a_y" | "hy" | "wy" |
"a|" | "h|" | "w|" | -- iota subscriptum
"Ai" | "Hi" | "Wi" ) ; -- iota adscriptum
diphthong : pattern Str = #("ai"|"ei"|"oi"|"yi"|"ay"|"ey"|"hy"|"oy" -- rare: "a_y", "wy"
|"a|"|"h|"|"w|") ; -- with iota subscriptum
longV : pattern Str = #("h"|"w"|"a_"|"i_"|"y_") ; -- i-,y- translit: i=' = i ??
shortV : pattern Str = #("e"|"o"|"a."|"i."|"y.") ; -- a,i,y short by default
restV : pattern Str = #("a"|"e"|"i"|"o"|"y"|"i-"|"y-"|"i="|"y=") ;
diphthongCap : pattern Str = #("Ai"|"Ei"|"Oi"|"Yi"|"Ay"|"Ey"|"Hy"|"Oy" -- rare: "a_y", "wy"
|"Hi"|"Wi") ; -- with iota adscriptum
longVCap : pattern Str = #("H"|"W"|"A_"|"I_"|"Y_") ;
shortVCap : pattern Str = #("E"|"O"|"A."|"I."|"Y.") ;
restVCap : pattern Str = #("a"|"e"|"i"|"o"|"y"|"i-"|"y-"|"i="|"y=") ;
vowel : pattern Str =
#("h"|"w"|"a_"|"i_"|"y_"| -- long vowels
"e"|"o"|"a."|"i."|"y."|"a" |"i" |"y" ) ; -- short vowels +default
-- TODO: trema, aspirates
consonant : pattern Str =
#("p"|"b"|"f"|"t"|"d"|"v"|"k"|"g"|"c"
|"l"|"r"|"m"|"n"|"s"|"x"|"q"|"z") ;
consonantCap : pattern Str =
#("P"|"B"|"F"|"T"|"D"|"V"|"K"|"G"|"C"
|"L"|"R"|"M"|"N"|"S"|"X"|"Q"|"Z") ;
aspirate : pattern Str = #(")"|"(") ;
accent : pattern Str = #("'"|"~") ;
acute : pattern Str = #("'") ;
circum : pattern Str = #("~") ;
nonvowels : pattern Str = -- sequence of nonvowels and accents
#(("p"|"b"|"f"|"t"|"d"|"v"|"k"|"g"|"c" -- Does NOT cover aspirate asper/lenis
|"l"|"r"|"m"|"n"|"s"|"x"|"q"|"z"|"s*" -- consonants
|"'"|"~"|"`")*) ; -- accents
-- TODO: iota capitals
{- see below
-- BR 13 -- TODO: add accents
shortenVowel : Str -> Str = \str ->
let short : Str -> Str = \s -> case s of { "h" => "e" ;
"w" => "o" ;
"a_" => "a" ;
"i_" => "i" ;
"y_" => "y" ;
"a_i" => "ai" ;
"hi" => "ei" ;
"wi" => "oi" ;
"hy" => "ey" ;
"a_y" => "ay" ;
"wy" => "oy" ;
_ => s } ;
in
case str of { x + d@#longDiphthong + y@(#consonant + _) => x+(short d)+y ;
x + v@#longV + y@(n@#nasal + c@#consonant + _) => x+(short v)+y ;
x + v@#longV + y@(#longV + _) => x+(short v)+y ;
x + "h~a." + y => x + "e'a_" + y ;
x + "h~o" + y => x + "e'w" + y ;
x + "ha." + y => x + "ea_" + y ;
x + "ho" + y => x + "ew" + y ;
_ => str
} ;
-- BR 15
contractVowels : Str -> Str = \str ->
case str of { x + "aa" + y => x + "a_" + y ; -- a)
x + "ee" + y => x + "ei" + y ;
x + ("eh"|"he") + y => x + "h" + y ;
x + "oo" + y => x + "oy" + y ;
x + ("ow"|"wo") + y => x + "w" + y ;
x + ("oa"|"ao"|"wa"|"aw") + y => x + "w" + y ; -- b)
x + ("oe"|"eo") + y => x + "oy" + y ;
x + "a" + ("e"|"h") + y => x + "a_" + y ; -- c)
x + ("e"|"h") + "a" + y => x + "h" + y ;
x + "e"+"ei" + y => x + "ei" + y ; -- d)
x + "o"+"oi" + y => x + "oi" + y ;
x + "e"+"h|" + y => x + "h|" + y ;
x + "e"+"ai" + y => x + "h|" + y ;
x + "a"+"ei" + y => x + "a|" + y ;
x + "a"+"oi" + y => x + "w|" + y ;
_ => str
} ;
-- TODO: add accents according to BR 9
-- v1+v2 contracted to u resp. last syllable u:
-- v1+v2' => u' resp. u'
-- v1+v2~ => u' resp. u'
-- v1'+v2 => u' resp. u~
-- v1~+v2 => u' resp. u~
-}
-- BR 24
punctuation : Strs = strs { "." ; ";" } ; -- + greek semicolon?
vowelLenis : Strs = strs {
"h)" ; "w)" ; "a_)" ; "i_)" ; "y_)" ; "e)" ; "o)" ; "a)" ; "i)" ; "y)" ; -- "a.)" ; "i.)" ; "y.)" ;
"ai)" ; " ei)" ; "oi)" ; "yi)" ; "ay)" ; "ey)" ; "oy)" } ;
vowelAsper : Strs = strs {
"h(" ; "w(" ; "a_(" ; "i_(" ; "y_(" ; "e(" ; "o(" ; "a(" ; "i(" ; "y(" ; -- "a.(" ; "i.(" ; "y.(" ;
"ai(" ; " ei(" ; "oi(" ; "yi(" ; "ay(" ; "ey(" ; "oy(" } ;
ersatzdehnung1 : Str -> Str = \str -> case str of {
("a."|"a") => "a_" ; -- variants{"a_" ; "h"} ; -- BR 12: x@(e|i|r)+a > x+a_ else x+h
"e" => "ei" ; ("i."|"i") => "i_" ; -- see mkVerbW1liq: efansa > efhna, but melans > mela_s
"o" => "oy" ; ("y."|"y") => "y_" ; _ => str} ; -- BR 14
ersatzdehnung = overload {
ersatzdehnung22 : (Str*Str) -> (Str*Str) =
\xy -> case xy of {
<x + v@#vowel +a@(#accent|"")
+ c@#consonant + n@#nonvowels, y> => -- need: new accent
<x + ersatzdehnung1(v) +a + c + n, y> ; -- depending on y
_ => xy } ;
ersatzdehnung : Str -> Str = ersatzdehnung1
} ;
auslaut : Str -> Str = \str -> case str of { -- BR 23
_ + ("n"|"r"|"s*") => str ; -- allowed consonants at word ending
_ + ("x"|"q") => str ; --
stm + "s" => stm + "s*" ;
stm + #consonant => stm ; -- drop consonant (several?)
_ => str } ;
ablaut : Str -> Str =\str -> case str of { -- BR 27b
x + ("fh"|"fw") + y => x + "fa" + y ;
x + "sth" + y => x + "sta" + y ;
x + ("vh"|"vw") + y => x + "ve" + y ;
x + "dw" + y => x + "do" + y ;
x + "ih" + y => x + "ie" + y ;
x + "i('h" + y => x + "i('e" + y ;
_ => str } ;
-- Assume that the vowel lengths in the user provided forms are explicitly
-- marked, or unmarked vowels a,i,y which count as short. Then the paradigms
-- can be produced correctly with length indications; however:
--
-- (i) length indications combined with accent have no utf-8 representation,
-- so the length indication must be removed in the paradigm;
-- (or can we keep the indications and extend the transliteration?)
-- (ii) decisions based on pattern matching have to treat the diphthongs
-- before the short vowels, since diphthongs contain the unmarked vowels.
dropLength : Str -> Str = \str -> case str of {
"a_" | "a." => "a" ; "i_" | "i." => "i" ; "y_" | "y." => "y" ; x => x } ;
dropShortness : Str -> Str = \str -> case str of { -- apply to a stem/form
x + v@("a"|"i"|"y") + "." + y => x + v + y ; x => x } ;
-- BR 15 1.
-- For the paradigms, we'd better only contract where stem + ending combine:
-- Kleomenes+os > Kleomene+os > Kleomenoys (dropS + contractVowels)
-- This would be more accurate and more efficient, but clumsier to use.
contractVowels = overload {
-- Version that operates on strings and contracts the first occurrence:
contractVowels : Str -> Str = \str ->
case str of { -- TODO: check accents according to BR 15 2. + BR 9
x + "e'ei" + y => x + "ei~" + y ; -- 2.
x + "o'oi" + y => x + "oi~" + y ;
x + "o'h|" + y => x + "w|~" + y ;
x + "e'h|" + y => x + "h|~" + y ;
x + "e'ai" + y => x + "h|~" + y ;
x + "e'oy" + y => x + "oy~" + y ; -- HL: poie'oy = poioy~
x + "a'ei" + y => x + "a|~" + y ;
x + "a'h|" + y => x + "a|~" + y ; -- HL: tima'h|=>tima|~
x + "a'oi" + y => x + "w|~" + y ;
x + "a'oy" + y => x + "w~" + y ; -- HL: tima'oysi=>timw~si
x + "e'oi" + y => x + "oi~" + y ;
x + "eei" + y => x + "ei" + y ; -- d) V.+Dipht => Dipht
x + "ooi" + y => x + "oi" + y ;
x + "eh|" + y => x + "h|" + y ;
x + "eai" + y => x + "h|" + y ;
x + "aei" + y => x + "a|" + y ;
x + "aoi" + y => x + "w|" + y ;
x + "eoi" + y => x + "oi" + y ;
x + "a'a" + y => x + "a~" + y ; -- a) VV => V_, EE => EI, OO => OY
x + "aa" + y => x + "a_" + y ; -- a)
x + "e'eo" + y => x + "e'oy" + y ;
x + "e'ea" + y => x + "e'a" + y ;
x + "e'e" + y => x + "ei~" + y ;
x + "ee" + y => x + "ei" + y ;
x + "h'h|" + y => x + "h|~" + y ;
x + "h'h" + y => x + "h~" + y ;
x + "h'w" + y => x + "w~" + y ;
x + "h('h|" + y => x + "h|(~" + y ; -- HL e('-
x + "h('h" + y => x + "h(~" + y ; -- HL
x + "h('w" + y => x + "w(~" + y ; -- HL i('hmi
x + "h(o'" + y => x + "w('" + y ; -- HL e(-o'meva
x + ("e'h"|"h'e") + y => x + "h~" + y ;
x + ("eh"|"he") + y => x + "h" + y ;
x + "o'o" + y => x + "oy~" + y ;
x + "oo" + y => x + "oy" + y ;
x + ("o'w"|"w'o"|"w'w") + y => x + "w~" + y ;
x + ("ow"|"wo") + y => x + "w" + y ;
x + ("o'a"|"a'o"|"o'h"|"w'a"|"a'w") + y -- b) O+(A|E) => O|OY
=> x + "w~" + y ; -- (A|E)+O => O|OY
x + ("oa"|"ao"|"wa"|"aw") + y
=> x + "w" + y ;
x + ("o'e"|"e'o") + y => x + "oy~" + y ;
x + ("oe"|"eo") + y => x + "oy" + y ;
x + ("w'h|") + y => x + "w|~" + y ;
x + ("w'e"|"e'w"|"w'h") + y => x + "w~" + y ;
x + ("we"|"ew") + y => x + "w" + y ;
x + "a'" + ("e"|"h") + y => x + "a~" + y ;
x + "ae'" + y => x + "a'" + y ; -- for: a_'
x + "a" + ("e"|"h") + y => x + "a_" + y ; -- c) A+E => A
x + ("e"|"h") + "a" + y => x + "h" + y ; -- E+A => E
_ => str
} ;
-- 'Positioned' version that operates on a split string, but produces
-- a string; hence cannot be followed by another 'positioned' sound law.
contractVowels2 : Str -> Str -> Str = \s1,s2 ->
case <s1,s2> of { -- TODO: check accents according to BR 15 2. + BR 9
<x + "e'", "ei" + y> => x + "ei~" + y ; -- 2.
<x + "o'", "oi" + y> => x + "oi~" + y ;
<x + "o'", "h|" + y> => x + "w|~" + y ;
<x + "e'", "h|" + y> => x + "h|~" + y ;
<x + "e'", "ai" + y> => x + "h|~" + y ;
<x + "e'", "oy" + y> => x + "oy~" + y ; -- HL: poie'oy> = poioy~
<x + "a'", "ei" + y> => x + "a|~" + y ;
<x + "a'", "h|" + y> => x + "a|~" + y ; -- HL: tima'h|=>tima|~
<x + "a'", "oi" + y> => x + "w|~" + y ;
<x + "a'", "oy" + y> => x + "w~" + y ; -- HL: tima'oysi=>timw~si
<x + "e'", "oi" + y> => x + "oi~" + y ;
<x + "e", "ei" + y> => x + "ei" + y ; -- d) V.+Dipht => Dipht
<x + "o", "oi" + y> => x + "oi" + y ;
<x + "e", "h|" + y> => x + "h|" + y ;
<x + "e", "ai" + y> => x + "h|" + y ;
<x + "a", "ei" + y> => x + "a|" + y ;
<x + "a", "oi" + y> => x + "w|" + y ;
<x + "e", "oi" + y> => x + "oi" + y ;
<x + "a'", "a" + y> => x + "a~" + y ; -- a) VV => V_, EE => EI, OO => OY
<x + "a", "a" + y> => x + "a_" + y ; -- a)
<x + "e'", "eo" + y> => x + "e'oy" + y ;
<x + "e'", "ea" + y> => x + "e'a" + y ;
<x + "e'", "e" + y> => x + "ei~" + y ;
<x + "e", "e" + y> => x + "ei" + y ;
<x + "h'", "h|" + y> => x + "h|~" + y ;
<x + "h'", "h" + y> => x + "h~" + y ;
<x + "h'", "w" + y> => x + "w~" + y ;
<x + "h('", "h|" + y> => x + "h|(~" + y ; -- HL e('-
<x + "h('", "h" + y> => x + "h(~" + y ; -- HL
<x + "h('", "w" + y> => x + "w(~" + y ; -- HL i('hmi
<x + "h(", "o'" + y> => x + "w('" + y ; -- HL e(-o'meva
<x + "e'", "h" + y> => x + "h~" + y ;
<x + "h'", "e" + y> => x + "h~" + y ;
<x + "e", "h" + y> => x + "h" + y ;
<x + "h", "e" + y> => x + "h" + y ;
<x + "o'", "o" + y> => x + "oy~" + y ;
<x + "o", "o" + y> => x + "oy" + y ;
<x + "o'", "w" + y> => x + "w~" + y ;
<x + "w'", ("o"|"w") + y> => x + "w~" + y ;
<x + "o", "w" + y> => x + "w" + y ;
<x + "w", "o" + y> => x + "w" + y ;
<x + "o'", ("a"|"h") + y> => x + "w~" + y ; -- b) O+(A|E) => O|OY
<x + "w'", "a" + y> => x + "w~" + y ;
<x + "a'", ("o"|"w") + y> => x + "w~" + y ; -- (A|E)+O => O|OY
<x + ("o"|"w"), "a" + y> => x + "w" + y ;
<x + "a", ("o"|"w") + y> => x + "w" + y ;
<x + "o'", "e" + y> => x + "oy~" + y ;
<x + "e'", "o" + y> => x + "oy~" + y ;
<x + "o", "e" + y> => x + "oy" + y ;
<x + "e", "o" + y> => x + "oy" + y ;
<x + "w'", "h|" + y> => x + "w|~" + y ;
<x + "w'", ("e"|"h") + y> => x + "w~" + y ;
<x + "e'", "w" + y> => x + "w~" + y ;
<x + "w", "e" + y> => x + "w" + y ;
<x + "e", "w" + y> => x + "w" + y ;
<x + "a'", ("e"|"h") + y> => x + "a~" + y ;
<x + "a", "e'" + y> => x + "a'" + y ; -- for: a_'
<x + "a", ("e"|"h") + y> => x + "a_" + y ; -- c) A+E => A
<x + ("e"|"h"), "a" + y> => x + "h" + y ; -- E+A => E
_ => s1 + s2
} ; -- Do we need h~e => h~ etc.??
contractVowels22 : (Str*Str) -> (Str*Str) = \se ->
-- for soundlaws, but where to put the contraction in the result: <x+v,y> vs. <x,v+y>
-- Treat the accent in the translated Soundlaw: if one of the vowels had an accent,
-- the contracted one gets an accent, and then the accent rules may decide which one!
case se of { -- short vowels followed by a diphthong beginning with the short vowel
-- are swallowed:
<x + "a", "ai" + y> => <x, "ai" + y> ; -- BR 15 d)
<x + "a", "ay" + y> => <x, "ay" + y> ;
<x + "e", "ei" + y> => <x, "ei" + y> ;
<x + "e", "ey" + y> => <x, "ey" + y> ;
<x + "o", "oi" + y> => <x, "oi" + y> ;
<x + "o", "oy" + y> => <x, "oy" + y> ;
<x + "y", "yi" + y> => <x, "yi" + y> ;
<x + "e", "h|" + y> => <x, "h|" + y> ; -- <x + h|, y> ??
<x + "o", "h|" + y> => <x, "w|" + y> ;
<x + "w", "h|" + y> => <x, "w|" + y> ;
<x + "a", "h|" + y> => <x, "a|" + y> ;
<x + "h", "h|" + y> => <x, "h|" + y> ;
-- short vowels followed by a diphthong beginning with another vowel
-- usually make a long diphthong: -- BR 15 d)
<x + "a", "ei" + y> => <x, "a|" + y> ;
<x + "a", "oi" + y> => <x, "w|" + y> ;
<x + "a", "oy" + y> => <x, "w" + y> ; -- HL?
<x + "e", "ai" + y> => <x, "h|" + y> ;
<x + "e", "oi" + y> => <x, "oi" + y> ; -- ?
<x + "e", "oy" + y> => <x, "oy" + y> ; -- ? w|
-- Two equal or similar vowels are turned into the long one:
<x + "a", "a" + y> => <x + "a_", y> ; -- BR 15 a)
<x + "e", "e" + y> => <x + "ei", y> ;
<x + "e", "h" + y> => <x, "h" + y> ; -- in verb inflection,
<x + "h", "e" + y> => <x + "h", y> ; -- shorten the ending or
<x + "o", "o" + y> => <x + "oy", y> ; -- better shorten the stem?
<x + "o", "w" + y> => <x, "w" + y> ;
<x + "w", "o" + y> => <x + "w", y> ;
<x + "w", "w" + y> => <x + "w", y> ; -- TODO: a_a > a_ etc ??
<x + "h", "h" + y> => <x, "h" + y> ; -- ??
-- O+E. or E.+O give OY, else O -- BR 15 b)
<x + "o", "e" + y> => <x + "oy", y> ; -- but: E.+O:Y > O:Y
<x + "e", "o" + y> => <x, "oy"+ y> ;
<x + "w", "e" + y> => <x + "w", y> ;
<x + "e", "w" + y> => <x, "w" + y> ;
<x + "h", "w" + y> => <x, "w" + y> ;
<x + "w", "h" + y> => <x + "w", y> ;
-- O+A or A+O give O_
<x + "o", "a" + y> => <x + "w", y> ;
<x + "a", "o" + y> => <x, "w" + y> ;
<x + "w", "a" + y> => <x + "w", y> ;
<x + "a", "w" + y> => <x, "w" + y> ;
-- A+E gives A_, E+A gives E_ -- BR 15 c)
<x + "a", "e" + y> => <x + "a_", y> ;
<x + "a", "h" + y> => <x + "a_", y> ;
<x + "e", "a" + y> => <x + "h", y> ;
<x + "h", "a" + y> => <x + "h", y> ;
-- Dubious cases I needed at the beginning of a word
<x + "h(", "h|"+ y> => <x + "h|(", y> ; -- HL e('-
<x + "h(", "h" + y> => <x + "h(", y> ; -- HL
<x + "h(", "w" + y> => <x + "w(", y> ; -- HL i('hmi
<x + "h(", "o" + y> => <x + "w(", y> ; -- HL e(-o'meva
_ => se
} ;
-- Note: contractVowels22 should be the end version, if the accents are
-- built into the derived souldlaws SL : Word*Ending -> Word*Ending
-- BR 15 2. (see ResGrc.toSL')
-- the accentuation follows from: new syllable gets an accent if one had
-- <x "v'", "u" + y> => <x, "(v+u)'" + y>
-- <x "v", "u'" + y> => <x, "(v+u)'" + y>
-- and for end syllables:
-- <x "v'", "u" + y> => <x, "(v+u)~" + y>
-- <x "v", "u'" + y> => <x, "(v+u)'" + y>
--
-- Remaining cases with accents that would not follow: (where from?)
-- <x + "e'", "eo" + y> => <x + "e'oy" + y> ;
-- <x + "e'", "ea" + y> => <x + "e'a" + y> ;
} ;
-- contractConsonants
mutaConsonant = overload {
mutaConsonant : Str -> Str = \str -> case str of { -- BR 19 1.
x + #labial + "m" + y => x + "mm" + y ;
x + #labial + "s" + y => x + "q" + y ;
x + #labial + "t" + y => x + "pt" + y ;
x + #labial + "v" + y => x + "fv" + y ;
x + #guttural + "m" + y => x + "gm" + y ;
x + #guttural + "s" + y => x + "x" + y ;
x + #guttural + "t" + y => x + "kt" + y ;
x + #guttural + "v" + y => x + "cv" + y ;
x + #dental + "m" + y => x + "sm" + y ;
x + #dental + "s" + y => x + "s" + y ;
x + #dental + "t" + y => x + "st" + y ;
x + #dental + "v" + y => x + "sv" + y ;
_ => str
} ; -- BR 19 2. psv => ps => q usw.
mutaConsonant2 : (Str*Str) -> (Str*Str) = \str ->
case str of { -- BR 19 1.
<x + #labial, "m" + y> => <x + "m", "m" + y> ;
<x + #labial, "s" + y> => <x + "q", y> ;
<x + #labial, "t" + y> => <x + "p", "t" + y> ;
<x + #labial, "v" + y> => <x + "f", "v" + y> ;
<x + #guttural, "m" + y> => <x + "g", "m" + y> ;
<x + #guttural, "s" + y> => <x + "x", y> ;
-- <x + #guttural, "s" + y> => <x, "x" + y> ;
<x + #guttural, "t" + y> => <x + "k", "t" + y> ;
<x + #guttural, "v" + y> => <x + "c", "v" + y> ;
<x + #dental, "m" + y> => <x + "s", "m" + y> ;
<x + #dental, "s" + y> => <x, "s" + y> ;
<x + #dental, "t" + y> => <x + "s", "t" + y> ;
<x + #dental, "v" + y> => <x + "s", "v" + y> ;
_ => str
} ; -- BR 19 2. psv => ps => q usw.
} ;
dropMSC : Str -> Str = \str -> case str of {
x + m@(#labial | #guttural | #dental) + "s" + c@#consonant + y => x + m + c + y ;
_ => str } ;
mutaSConsonant : Str -> Str = \str -> mutaConsonant (dropMSC str) ;
nasalConsonant = overload {
-- operating on a string, deprecated:
nasalConsonant1 : Str -> Str = \str -> case str of { -- BR 20.1
x + "n" + c@#guttural + y => x + "g" + c + y ; -- n+guttural
x + "n" + c@#labial + y => x + "m" + c + y ; -- n+labial
x + "n" + c@("l"|"r"|"m") + y => x + c + c + y ; -- n+(liquid | m)
_ => str
} ;
nasalConsonant2 : Str -> Str -> Str = \s1,s2 -> case <s1,s2> of { -- BR 20.1
<x + "n", c@#guttural + y> => x + "g" + c + y ;
<x + "n", c@#labial + y> => x + "m" + c + y ;
<x + "n", c@("l"|"r"|"m") + y> => x + c + c + y ;
_ => s1 + s2
} ;
nasalConsonant22 : (Str * Str) -> (Str * Str) = \str -> case str of { -- BR 20.1
<x + "n", c@#guttural + y> => <x + "g", c + y> ;
<x + "n", c@#labial + y> => <x + "m", c + y> ;
<x + "n", c@("l"|"r"|"m") + y> => <x + c, c + y> ;
_ => str
} ;
} ;
-- short vowel + (n|m|r|l) + s > long vowel + (n|m|r|l)
nasalSVowel = overload { -- TODO: and if there is an accent on the short vowel?
nasalSVowel22 : (Str*Str) -> (Str*Str) = \str -> case str of { -- BR 20 2.
<x + v@("a"|"e"|"i"|"o"|"y") -- BR 20 4.
+ "n" + ("t"|""), "s*"> => <x + ersatzdehnung(v), "s"> ; -- logons > logoys
<x + v@("a"|"e"|"i"|"o"|"y") -- gigants> gigas
+ n@(#nasal|#liquid),
"s" + y@vowel + z> => <x + ersatzdehnung(v) + n, y+z> ; -- efansa > efhna
_ => str }
} ;
-- instance of mutaConsonant, used in noun3LGL:
-- c@(guttural or labial) + si > - + (cs)i where cs is a consonant depending on c,s
gutlabS = overload {
gutlabS22 : (Str*Str) -> (Str*Str) = \str -> case str of { -- BR 41 6.
<x + c@#guttural, "si" + y> => <x, "xi" + y> ;
<x + c@#labial, "si" + y> => <x, "qi" + y> ;
_ => str }
} ;
dropS = overload {
dropS1 : Str -> Str = \str -> case str of { -- BR 16 1.
x + v@#vowel + "s" + u@#vowel + y => x + v+u + y ;
_ => str
} ;
dropS22 : (Str*Str) -> (Str*Str) = \str -> case str of { -- BR 16 1.
<x + v@#vowel, "s" + u@#vowel + y> => <x + v, u + y> ;
<x + v@#vowel + "s", u@#vowel + y> => <x + v, u + y> ;
_ => str
} ;
} ;
swapLengths = overload {
swapLengths1 : Str -> Str = \str -> case str of { -- BR 13 4. Quantitaetentausch
x + "ha_" + y => str ;
x + "h'a_" + y => str ;
x + "h~a_" + y => str ;
x + "ha" + y => x + "ea_" + y ;
x + "h'a" + y => x + "e'a_" + y ;
x + "h~a" + y => x + "e'a_" + y ;
x + "ho" + y => x + "ew" + y ;
x + "h'o" + y => x + "e'w" + y ;
x + "h~o" + y => x + "e'w" + y ;
_ => str } ;
swapLengths22 : (Str*Str) -> (Str*Str) = \str -> case str of { -- BR 13 4. Quantitaetentausch
<x + "h", "a_" + y> => str ;
<x + "h'", "a_" + y> => str ;
<x + "h~", "a_" + y> => str ;
<x + "h", "a" + y> => <x + "e", "a_" + y> ;
<x + "h'", "a" + y> => <x + "e'", "a_" + y> ;
<x + "h~", "a" + y> => <x + "e'", "a_" + y> ;
<x + "h", "oi" + y> => <x + "e", "oi" + y> ;
<x + "h'", "oi" + y> => <x + "e'", "oi" + y> ;
<x + "h~", "oi" + y> => <x + "e'", "oi" + y> ;
<x + "h", "o" + y> => <x + "e", "w" + y> ;
<x + "h'", "o" + y> => <x + "e'", "w" + y> ;
<x + "h~", "o" + y> => <x + "e'", "w" + y> ;
<x + "h", "w" + y> => <x + "e", "w" + y> ; -- BR 13 3.
<x + "h'", "w" + y> => <x + "e'", "w" + y> ;
<x + "h~", "w" + y> => <x + "e'", "w" + y> ;
_ => str } ;
} ;
{-
iotaConsonant : Str -> Str = \str -> -- BR 21.1-6
case str of { x + v@("e"|"i"|"y") +a@("'"|[]) + c@("n"|"r") + "j" + y =>
x + (ersatzdehnung v) + a + c + y ;
x + v@("a"|"o") +a@("'"|[]) + c@("n"|"r") + "j" + y =>
x + (v + "i") + a + c + y ;
x + "l" + "j" + y => x + "ll" + y ;
x + ("t"|"v") + "j" + y => x + "s" + y ; -- + Edehnung: pantja > pansa > pa~sa
x + ("k"|"c") + "j" + y => x + "ss" + y ;
x + ("d"|"g") + "j" + y => x + "x" + y ;
x + ("p"|"b"|"f") + "j" + y => x + "pt" + y ;
x + v@#vowel +"s" + "j" + y => x + v + "i" + y
} ;
-}
}

24
lib/src/ancient_greek/PhraseGrc.gf Normal file
View File

@@ -0,0 +1,24 @@
concrete PhraseGrc of Phrase = CatGrc ** open Prelude, ResGrc 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 ! ... ! 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 ! ResGrc.Voc} ;
}

56
lib/src/ancient_greek/QuestionGrc.gf Normal file
View File

@@ -0,0 +1,56 @@
concrete QuestionGrc of Question = CatGrc ** open ResGrc, Prelude in {
flags optimize=all_subs ;
lin
QuestCl cl = {
s = \\t,pol =>
let cls = cl.s ! t ! pol
in table {
QDir => cls ! VSO ; -- Order ok?
QIndir => "ei)" ++ cls ! VSO -- Order ok?
}
} ;
QuestVP qp vp =
let cl = mkClause (qp.s ! Nom) (agrP3 qp.n) vp
in {s = \\t,pol,qf => cl.s ! t ! pol ! SVO } ; -- TODO: ignore qf? Order?
-- QuestSlash ip slash =
-- mkQuestion (ss (slash.c2 ++ ip.s ! Acc)) slash ;
-- --- stranding in ExratGrc
-- 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 = { -- (attributive) ti's as IDet inflects for gender
-- s = \\c => idet.s ! cn.g ! c ++ cn.s ! (Ag cn.g idet.n P3) ! idet.n ! c ;
s = \\c => idet.s ! cn.g ! c ++ cn.s ! idet.n ! c ;
n = idet.n
} ;
IdetIP idet = {
s = \\c => idet.s ! Neutr ! c ;
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) ;
}

56
lib/src/ancient_greek/RelativeGrc.gf Normal file
View File

@@ -0,0 +1,56 @@
concrete RelativeGrc of Relative = CatGrc ** open ResGrc 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 =>
s = \\t,b,agr => -- TODO: anteriority, tense/vtense
let
cl = mkClause (rp.s ! (genderAgr agr) ! numberAgr agr ! Nom) agr vp
in
-- cl.s ! t ! ant ! b ! ODir ;
cl.s ! t ! b ! SVO ; --ODir ;
c = Nom
} ;
-- Pied piping: "at which we are looking".
RelSlash rp slash = {
-- s = \\t,a,p,agr =>
-- slash.c2 ++ rp.s ! RPrep (fromAgr agr).g ++ slash.s ! t ! a ! p ! ODir ;
s = \\t,p,agr => -- TODO: anteriority, tense/vtense
slash.c2.s
++ rp.s ! (genderAgr agr) ! (numberAgr agr) ! (slash.c2.c)
++ slash.s ! t ! p ! OSV
;
c = Acc -- ??
} ;
-- FunRP : Prep -> NP -> RP -> RP ; -- the mother of whom
-- FunRP p np rp = {
-- s = \\c => np.s ! Acc ++ p.s ++ rp.s ! RPrep (fromAgr np.a).g ;
-- a = RAg np.a
-- } ;
IdRP = { s = \\g,n,c => relPron ! n ! g ! c } ;
oper
relPron : Number => Gender => Case => Str = -- BR 69
table { Sg => table { Masc => cases "o('s*" "o('n" "oy(~" "w|(~" ;
Fem => cases "h('" "h('n" "h(~s*" "h|(~" ;
Neutr=> cases "o('" "o('" "oy(~" "w|(~"
} ;
Pl | Dl => -- are there dual forms ??
table { Masc => cases "oi('" "oy('s*" "w(~n" "oi(~s*" ;
Fem => cases "ai('" "a('s*" "w(~n" "ai(~s*" ;
Neutr=> cases "a('" "a('" "w(~n" "oi(~s*"
}
} ;
}

2320
lib/src/ancient_greek/ResGrc.gf Normal file
View File

File diff suppressed because it is too large Load Diff

78
lib/src/ancient_greek/SentenceGrc.gf Normal file
View File

@@ -0,0 +1,78 @@
concrete SentenceGrc of Sentence = CatGrc ** open Prelude, ResGrc, (T=TenseGrc) in {
flags
optimize=all_subs ;
lin
PredVP np vp = let agr = np.a in mkClause (np.s ! Nom) agr vp ;
PredSCVP sc vp = mkClause sc.s (agrP3 Sg) vp ;
ImpVP vp = { -- Sketch only TODO
s = \\pol,f =>
let
imp = vp.s ! (VPImp f) ;
dont = case pol of { Pos => [] ; Neg => "mh'" } ;
pn = case f of {ImpF IPres SgP2 => <Sg, P2> ;
ImpF IPres SgP3 => <Sg, P3> ;
ImpF IPres PlP2 => <Pl, P2> ;
ImpF IPres PlP3 => <Pl, P3> ;
ImpF IAor SgP2 => <Sg, P2> ;
ImpF IAor SgP3 => <Sg, P3> ;
ImpF IAor PlP2 => <Pl, P2> ;
ImpF IAor PlP3 => <Pl, P3> ;
ImpF IPerf SgP2 => <Sg, P2> ;
ImpF IPerf SgP3 => <Sg, P3> ;
ImpF IPerf PlP2 => <Pl, P2> ;
ImpF IPerf PlP3 => <Pl, P3> } ;
n = pn.p1 ;
p = pn.p2
in
dont ++ imp ++ vp.obj ! (Ag Masc n p) ++ vp.adj ! Masc ! n;
} ;
SlashVP np vp = -- : NP -> VPSlash -> ClSlash ; -- (whom) he sees
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} ;
SlashVS np vs slash = -- TODO: Check with Greek grammar
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 p cl =
let ta = antTense t.t t.a
in lin S { s = t.s ++ p.s ++ cl.s ! ta ! p.p ! SVO } ; -- TODO: Order
UseQCl t p cl = {
s = \\q => t.s ++ p.s ++ cl.s ! (antTense t.t t.a) ! p.p ! q
} ;
UseRCl temp p cl = let ta = antTense temp.t temp.a in {
s = \\agr => temp.s ++ p.s ++ cl.s ! ta ! p.p ! agr ;
c = cl.c
} ;
UseSlash t p cl = let ta = antTense t.t t.a in {
s = t.s ++ p.s ++ cl.s ! ta ! p.p ! OSV ; -- TODO: Order
c2 = cl.c2
} ;
AdvS a s = {s = a.s ++ s.s} ; -- TODO: check with Greek grammar
RelS s r = {s = s.s ++ "," ++ r.s ! agrP3 Sg} ; -- TODO: check with Greek grammar
}

156
lib/src/ancient_greek/StructuralGrc.gf Normal file
View File

@@ -0,0 +1,156 @@
--# -path=.:../abstract:prelude:../common
concrete StructuralGrc of Structural = CatGrc **
open ResGrc, (M = MorphoGrc), (P = ParadigmsGrc), Prelude, (N = NounGrc) in
{
flags optimize=all ;
lin
above_Prep = P.mkPrep "y(pe'r" Acc ;
after_Prep = P.mkPrep "meta'" Acc ;
-- all_Predet = ss "all" ;
-- almost_AdA = ss "almost" ;
-- almost_AdN = ss "quasi" ;
although_Subj = ss "kai'per" ;
always_AdV = P.mkAdV "a)ei'" ; -- Adv or AdV ??
and_Conj = sd2 [] "kai'" ** {n = Pl} ;
because_Subj = ss "a('te" ; -- ss "w(s*" -- ss "dio'ti"
before_Prep = P.mkPrep "pro'" Gen ;
behind_Prep = P.mkPrep "o)'pisven" Gen ; -- BR 198
between_Prep = P.mkPrep "metaxy'" Gen ; -- BR 198
both7and_DConj = sd2 "kai'" "kai'" ** {n = Pl} ; -- resp.: te - kai
but_PConj = ss "de'" ;
by8agent_Prep = P.mkPrep "y(po'" Gen ; -- TESTWORD
by8means_Prep = P.mkPrep "dia'" Acc ;
-- 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 = P.mkPrep "e)n" Dat ;
either7or_DConj = sd2 "h)'" "h)'" ** {n = Sg} ;
-- everybody_NP = regNP "everybody" Sg ;
every_Det = M.detLikeAdj Sg "pa~s" "panto's" ; -- TODO: Accent in Neutr
-- everything_NP = regNP "everything" Sg ;
everywhere_Adv = ss "pantacoy~" ;
few_Det = M.detLikeAdj Pl "o)li'gos" ; -- TODO: check accents
-- first_Ord = ss "first" ; DEPRECATED
for_Prep = P.mkPrep "pro'" Gen ;
from_Prep = P.mkPrep "e)x" Gen ; -- from_Prep = mkPrep "a)po'" Gen ;
he_Pron = M.mkPron Masc Sg P3 ;
here_Adv = ss "e)nva'de" ;
here7to_Adv = ss "e)nva'de" ;
here7from_Adv = ss "e)nve'nde" ;
how_IAdv = ss "pw~s*" ;
how8many_IDet = M.detLikeAdj Pl "po'sos" ; -- BR 73 1
if_Subj = ss "e(i" ; -- "ea'n"
-- in8front_Prep = mkPrep "coram" Abl ;
i_Pron = M.mkPron Masc Sg P1 ;
in_Prep = P.mkPrep "e)n" Dat ;
it_Pron = M.mkPron Neutr Sg P3 ;
-- less_CAdv = ss "less" ;
many_Det = lin Det (M.detLikeAdj Pl "pollo's") ; -- Sg exception Nom|Acc polly'(s|n)
-- more_CAdv = ss "more" ;
-- most_Predet = ss "most" ;
much_Det = let det : Determiner = M.detLikeAdj Sg "pollo's"
in { s = \\g,c => case <g,c> of { <Masc,Nom> => "polly's*" ;
<Masc,Acc> => "polly'n" ;
<Neutr,Nom|Acc> => "polly'" ;
_ => det.s ! g ! c } ;
n = det.n } ;
-- 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
-- } ;
no_Utt = ss (variants{ "oy)'" ; "pw~s* ga'r ;" ; "oy) dh~ta" }) ;
on_Prep = P.mkPrep "e)pi'" Dat;
-- one_Quant = mkDeterminer Sg "one" ; -- DEPRECATED
-- only_Predet = ss "tantum" ;
or_Conj = sd2 [] "h)'" ** {n = Sg} ;
-- otherwise_PConj = ss "otherwise" ;
part_Prep = P.mkPrep [] Gen ; -- TODO: postnominal
-- please_Voc = ss "please" ;
possess_Prep = P.mkPrep [] Gen ; -- TODO: prenominal
-- quite_Adv = ss "quite" ;
she_Pron = M.mkPron Fem Sg P3 ;
-- so_AdA = ss "sic" ;
somebody_NP = M.indefPronNP Masc Sg ;
someSg_Det = M.mkDeterminer2 Sg (cases "tis*" "tina'" "tino's*" "tini'")
(cases "ti" "ti" "tino's*" "tini'") ;
somePl_Det = M.mkDeterminer2 Pl (cases "tine's*" "tina's*" "tinw~n" "tisi'")
(cases "tina'" "tina'" "tinw~n" "tisi'") ;
something_NP = M.indefPronNP Neutr Sg ;
somewhere_Adv = ss "poy" ;
that_Quant = ekeinos_Quantifier ; -- TODO correct accents
that_Subj = ss "o('ti" ;
there_Adv = ss "ay)toy~" ; -- ss "e)ntay~va" ; ss "e)kei~"
there7to_Adv = ss "e)ntay~va" ; -- ss "ay)to'se" ; ss "e)kei~se"
there7from_Adv = ss "e)ntey~ven" ; -- ss "ay)t'ven" ; ss "e)kei~ven"
therefore_PConj = ss "kai'toi" ; -- BR 253.24
they_Pron = M.mkPron Masc Pl P3 ;
this_Quant = hode_Quantifier ;
through_Prep = P.mkPrep "dia'" Gen;
too_AdA = ss "a)'gan" ;
to_Prep = P.mkPrep "pro's" Acc ;
under_Prep = P.mkPrep "y(po'" Gen ;
-- very_AdA = ss "valde" ;
want_VV = P.mkVV (P.mkV "boy'lomai") ; -- TODO: fut boylh'somai, e)boylh'vhn -- me'llw
we_Pron = M.mkPron Masc Pl P1 ;
whatPl_IP = M.mkIP Pl Neutr ;
whatSg_IP = M.mkIP Sg Neutr ;
when_IAdv = ss "po'te" ;
when_Subj = ss "o('te" ; -- "o(po'te" "h(ni'ka" "e)pei'" "e)peidh'" "w(s*" BR 286
where_IAdv = ss "poy~" ;
which_IQuant = {s = \\n,g,c => M.iPron ! n ! g ! c} ;
whoPl_IP = M.mkIP Pl Masc ;
whoSg_IP = M.mkIP Sg Masc ;
why_IAdv = ss "dio'ti" ;
without_Prep = P.mkPrep "a)'ney" Gen ;
with_Prep = P.mkPrep "sy'n" Dat ; -- P.mkPrep "meta'" Gen
yes_Utt = ss "nai'" ;
youSg_Pron = M.mkPron Masc Sg P2 ;
youPl_Pron = M.mkPron Masc Pl P2 ;
youPol_Pron = M.mkPron Masc Sg P2 ; -- Is there a polite form in ancient greek?
-- no_Quant : Quant ;
-- not_Predet : Predet ;
-- if_then_Conj : Conj ;
-- at_least_AdN : AdN ;
-- at_most_AdN : AdN ;
-- nobody_NP : NP ; -- "oy)dei's*" BR 73 1
nobody_NP = quantNP oydeis_Quantifier mhdeis_Quantifier Masc Sg ;
nothing_NP = quantNP oydeis_Quantifier mhdeis_Quantifier Neutr Sg ; -- "oy)de'n"
except_Prep = P.mkPrep "a)'ney" Gen ;
-- as_CAdv : CAdv ;
-- have_V2 : V2 ;
-- have_V3 : V3 ;
-- have_not_V3 : V3;
lin language_title_Utt = ss "ancientgreek" ;
oper
quantNP : Quantifier -> Quantifier -> Gender -> Number -> NP = \p,q,g,n ->
lin NP { s = \\c => p.s ! n ! g ! c ;
isPron = False ;
e = \\c => q.s ! n ! g ! c ;
a = Ag g n P3 } ;
}

39
lib/src/ancient_greek/SymbolGrc.gf Normal file
View File

@@ -0,0 +1,39 @@
--# -path=.:abstract:common
concrete SymbolGrc of Symbol = CatGrc ** open Prelude, ResGrc in {
--
--lin
-- SymbPN i = {s = \\c => i.s ; g = Neutr} ; --- c
-- IntPN i = {s = \\c => i.s ; g = Neutr} ; --- c
-- FloatPN i = {s = \\c => i.s ; g = Neutr} ; --- c
-- NumPN i = {s = \\c => i.s ; g = Neutr} ; --- c
-- CNIntNP cn i = {
-- s = \\c => (cn.s ! Sg ! Nom ++ i.s) ;
-- a = agrgP3 Sg cn.g
-- } ;
-- CNSymbNP det cn xs = {
-- s = \\c => det.s ++ cn.s ! det.n ! c ++ xs.s ;
-- a = agrgP3 det.n cn.g
-- } ;
-- CNNumNP cn i = {
-- s = \\c => (cn.s ! Sg ! Nom ++ i.s) ;
-- a = agrgP3 Sg cn.g
-- } ;
--
-- SymbS sy = sy ;
--
-- SymbNum sy = {s = sy.s ; n = Pl ; hasCard = True} ;
-- SymbOrd sy = {s = sy.s ++ "th"} ;
--
--lincat
--
-- Symb, [Symb] = SS ;
--
--lin
--
-- MkSymb s = s ;
--
-- BaseSymb = infixSS "and" ;
-- ConsSymb = infixSS "," ;
--
}

5
lib/src/ancient_greek/SymbolicGrc.gf Normal file
View File

@@ -0,0 +1,5 @@
--# -path=.:../german:../common:../abstract:../prelude
resource SymbolicGrc = Symbolic with
(Symbol = SymbolGrc),
(Grammar = GrammarGrc) ;

4
lib/src/ancient_greek/SyntaxGrc.gf Normal file
View File

@@ -0,0 +1,4 @@
--# -path=.:alltenses:prelude
instance SyntaxGrc of Syntax = ConstructorsGrc, CatGrc, StructuralGrc, CombinatorsGrc ;

12
lib/src/ancient_greek/TenseGrc.gf Normal file
View File

@@ -0,0 +1,12 @@
concrete TenseGrc of Tense =
CatGrc [Tense,Temp], TenseX [Ant,Pol,AAnter,ASimul,PNeg,PPos] ** open ResGrc in {
lin
TTAnt t a = {s = t.s ++ a.s ; t = t.t ; a = a.a } ;
TPres = {s = [] ; t = VPres VInd } ; -- or: VPerf VInd BR 220
TPast = {s = [] ; t = VImpf} ; -- or: VAor VInd, VPlqm
TFut = {s = [] ; t = VFut FInd} ; -- and: VFut Opt, Inf, Part
TCond = {s = "a)'n" ; t = VPres VInd} ; -- ???
}

22
lib/src/ancient_greek/TerminologyGrc.gf Normal file
View File

@@ -0,0 +1,22 @@
--# -path=.:../abstract:../common
concrete TerminologyGrc of Terminology = CatGrc ** open
ResGrc,
ParadigmsGrc,
(G = GrammarGrc),
(S = SyntaxGrc),
(L = LexiconGrc),
Prelude
in {
flags coding=utf8 ;
lincat
Category = G.N ;
ParameterType = G.N ;
Parameter = G.N ;
Heading = {s : Str} ;
-- stolen from Ger, incomplete
}

34
lib/src/ancient_greek/TransferGrcAbs.gf Normal file
View File

@@ -0,0 +1,34 @@
abstract TransferGrcAbs = Sentence, Noun, Verb, Structural, ExtraGrcAbs ** {
fun refl2medium : Cl -> Cl ;
def refl2medium (PredVP subj (ReflVP (SlashV2a v))) = PredVP subj (MedVP v) ;
-- The transformation of a (PossPron pron):Quant to an adjective or Adv is impossible,
-- since it would need data DetCN rather than fun DetCN !
--
-- data DetCN : Cat.Det -> Cat.CN -> Cat.NP ;
--
-- fun possAdj : NP -> NP ;
-- def possAdj (DetCN (DetQuant (PossPron pers) num) cn) =
-- (DetCN (DetQuant DefArt num) (AdvCN cn (PrepNP possess_Prep (UsePron pers)))) ;
-- Likewise, PartVP is not a data constructor!
-- fun partAP : AP -> AP ;
-- def partAP (PartVP vp) = PartPresVP PPos vp ;
}
{-
-- Expl. > i AllGrc.gf
-- > p "e)gw' le'gw e)mayto'n" | pt -transfer=refl2medium | l
-- PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron i_Pron) (ReflVP (SlashV2a read_V2))))) NoVoc
AllGrcAbs> pt (PredVP (UsePron i_Pron) (ReflVP (SlashV2a read_V2))) | l
e)gw' le'gw e)mayto'n
AllGrcAbs> pt -transfer=refl2medium (PredVP (UsePron i_Pron) (ReflVP (SlashV2a read_V2))) | l
e)gw' le'gomai
-}

70
lib/src/ancient_greek/VerbGrc.gf Normal file
View File

@@ -0,0 +1,70 @@
--# -path=.:../abstract:../prelude:../common:
concrete VerbGrc of Verb = CatGrc ** open Prelude, ResGrc, (M=MorphoGrc) in {
flags optimize=all_subs ;
--2 Complementization rules
lin
UseV = predV ;
SlashV2a v = predV2 v ;
Slash2V3 v np = insertObjc (\\a => v.c2.s ++ np.s ! v.c2.c) (predV v ** {c2 = v.c3}) ;
Slash3V3 v np = insertObjc (\\a => v.c3.s ++ np.s ! v.c2.c) (predV2 v) ;
ComplVV v vp = insertObj (\\a => infVP vp a) (predV v) ; -- predVV? Need this for the tablet sent. TODO
ComplVS v s = insertObj (\\_ => conjThat ++ s.s) (predV v) ;
ComplVQ v q = insertObj (\\_ => q.s ! QIndir) (predV v) ;
ComplVA v ap = insertObj (\\a => ap.s ! AF (genderAgr a) (numberAgr a) Nom) (predV v) ; -- TODO check
SlashV2V v vp = insertObjc (\\a => infVP vp a) (predV2 v) ;
SlashV2S v s = insertObjc (\\_ => conjThat ++ s.s) (predV2 v) ;
SlashV2Q v q = insertObjc (\\_ => q.s ! QIndir) (predV2 v) ;
-- SlashV2A v ap = insertObjc (\\a => ap.s ! AF (genderAgr a) (numberAgr a) Nom) (predV2 v) ; -- TODO
ComplSlash vp np = insertObj (\\a => appPrep vp.c2 np) vp ;
-- SlashVV vv vp =
-- insertObj (\\a => infVP vv.isAux vp a) (predVV vv) ** {c2 = vp.c2} ;
-- Need SlashV2V for the Greek school tablet example: advise the students to abstain from meat
-- abstract/Verb.gf: SlashV2V : V2V -> VP -> VPSlash ; -- beg (her) to go
-- SlashV2VNP : V2V -> NP -> VPSlash -> VPSlash ; -- beg me to buy
SlashV2VNP vv np vp =
insertObjPre (\\_ => vv.c2.s ++ np.s ! vv.c2.c)
(insertObjc (\\a => infVP vp a) (predV2 vv)) ** {c2 = vp.c2} ;
--2 Other ways of forming verb phrases:
UseComp comp = insertObj comp.s (predV einai_V) ;
ReflVP v = insertObjPre (\\a => v.c2.s ++ M.reflPron ! a ! v.c2.c) v ;
-- experimental: Med/Pass
PassV2 v = insertObjPre (\\a => case a of {Ag g n p => v.med ! Part GPres (AF g n Nom)})
-- Irrefl => v.med ! Part GPres (AF Masc Sg Nom) }) -- default?? TODO
(predV M.eimi_V) ;
--- UseVS, UseVQ = \vv -> {s = vv.s ; c2 = [] ; isRefl = vv.isRefl} ; -- no "to"
AdvVP vp adv = insertAdv adv.s vp ;
AdVVP adv vp = insertObj (\\a => adv.s) vp ;
--2 Complements to copula
CompAP ap = {s = \\agr => case agr of {Ag g n p => ap.s ! AF g n Nom} } ;
CompNP np = {s = \\agr => np.s ! Nom} ; -- TODO: How to drop defArt?
CompAdv a = {s = \\agr => a.s} ;
CompCN cn = {s = \\agr => let n = numberAgr agr
in cn.s ! n ! Nom ++ cn.s2 ! n ! Nom} ;
-- Copula alone
UseCopula = predV einai_V ;
oper
einai_V = (lin V M.eimi_V) ;
}

6
lib/src/ancient_greek/adjectivesBR.gfs Normal file
View File

@@ -0,0 +1,6 @@
-- For gf-3.2, do everything in the greek directory, without gf*/testsuite and Setup.hs
i -path=.:alltenses AllGrc.gfo
rf -file=adjectivesBR -lines -tree | l -table -to_ancientgreek

1841
lib/src/ancient_greek/adjectivesBR.gold Normal file
View File

File diff suppressed because it is too large Load Diff

155
lib/src/ancient_greek/bornemann Normal file
View File

@@ -0,0 +1,155 @@
-- Note: Comments at the end of the line makes the whole line ignored! 4/11
-- A-declension
idea_N
chora_N
stratia_N
doxa_N
glotta_N
macha_N
nika_N
tima_N
thalatta_N
gephyra_N
neanias_N
polita_N
dikasta_N
atreida_N
athena_N
gea_N
hermea_N
-- O-declension
logos_N
demos_N
anthropos_N
hodos_N
doron_N
-- ergon_N
agathos_A
dikaios_A
nous_N
osteon_N
eunous_A
argyrous_A
chrysous_A
neos_N
news_N
Meneleos_PN
ilews_A
-- Noun declension III
krathr_N
rhtwr_N
als_N
vhr_N
-- gutturals -k, -g, -x
fylax_N
aix_N
gyps_N
fleps_N
-- dentals -t, -d, -v
esvhs_N
elpis_N
caris_N
swma_N
ellhn_N
agwn_N
poimhn_N
daimwn_N
eydaimwn_A
-- kakion_A
-- stems ending in -nt:
gigas_N
odoys_N
gerwn_N
-- adjectives and participles
pas_A
ekwn_A
lywn_A
lysas_A
theis_A
dys_A
carieis_A
-- stems ending in -r with 3 ablautlevels
pathr_N
mhthr_N
vygathr_N
gasthr_N
anhr_N
-- s-stems
genos_N
eugenhs_A
diogenhs_N
periklhs_N
philosopher_N
polis_N
dynamis_N
phcys_N
asty_N
icvys_N
sys_N
pitys_N
erinys_N
basileys_N
-- verbs
paideyw_V
timaw_V
poiew_V
doylow_V
leipw_V
elleipw_V
tivhmi_V
ihmi_V
didwmi_V
isthmi_V
deiknymi_V
--verbsWmut
leipw_V
elleipw_V
trepw_V
grafw_V
tribw_V
diwkw_V
arcw_V
legw_V
anytw_V
peivw_V
pseudw_V
typtw_V
kryptw_V
blabtw_V
fylattw_V
ktizw_V
nomizw_V
swzw_V
scizw_V
evizw_V
-- verbsWliq
derw_V
menw_V
nemw_V
angellw_V
fainw_V

10
lib/src/ancient_greek/nounsBR.gfs Normal file
View File

@@ -0,0 +1,10 @@
-- For gf-3.2, do it in the greek directory, without gf*/testsuite/libraries and Setup.hs
-- rf -file=bornemann -lines -tree | l -table -to_ancientgreek | ?grep s
-- Use Makefile and 'make nouns', then 'make ediff-nouns' to create nounsBR, nounsBR.out
se utf8
i -path=.:alltenses AllGrc.gfo
rf -file=nounsBR -lines -tree | l -table -to_ancientgreek

1264
lib/src/ancient_greek/nounsBR.gold Normal file
View File

File diff suppressed because it is too large Load Diff

6
lib/src/ancient_greek/verbsBR.gfs Normal file
View File

@@ -0,0 +1,6 @@
-- For gf-3.2, do everything in the greek directory, without gf*/testsuite and Setup.hs
i -path=.:alltenses AllGrc.gfo
rf -file=verbsBR -lines -tree | l -table -to_ancientgreek

33705
lib/src/ancient_greek/verbsBR.gold Normal file
View File

File diff suppressed because it is too large Load Diff