partial implementation of Ancient Greek RGL

lib/src/ancient_greek/AccentsGrc.gf

@@ -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)
+-}
+
+} 

lib/src/ancient_greek/AdjectiveGrc.gf

@@ -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
+
+}

lib/src/ancient_greek/AdverbGrc.gf

@@ -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"} ;
+--
+}

lib/src/ancient_greek/AllGrc.gf

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

lib/src/ancient_greek/AllGrcAbs.gf

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

lib/src/ancient_greek/BackwardGrc.gf

@@ -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 ;
+--
+--}

lib/src/ancient_greek/Bornemann.gf

@@ -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 ;
+} ;

lib/src/ancient_greek/BornemannGrc.gf

@@ -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 ;
+} ;
+
+

lib/src/ancient_greek/BugGrc.gf

@@ -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 ;
+}

lib/src/ancient_greek/CatGrc.gf

@@ -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 ;
+
+}

lib/src/ancient_greek/CombinatorsGrc.gf

@@ -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) ; 
+}

lib/src/ancient_greek/ConjunctionGrc.gf

@@ -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 ;
+}
+

lib/src/ancient_greek/ConstructionGrc.gf

@@ -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 ;
+
+}

lib/src/ancient_greek/ConstructorsGrc.gf

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

lib/src/ancient_greek/DocumentationGrc.gf

@@ -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) ;

lib/src/ancient_greek/DocumentationGrcFunctor.gf

@@ -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
+}

lib/src/ancient_greek/ExtraGrc.gf

@@ -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  } ;
+
+}

lib/src/ancient_greek/ExtraGrcAbs.gf

@@ -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 ;
+}

lib/src/ancient_greek/GrammarGrc.gf

@@ -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
+  ** {
+} ;

lib/src/ancient_greek/IdiomGrc.gf

@@ -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)} ;
+--
+--}
+--

lib/src/ancient_greek/IrregGrc.gf

@@ -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" ;
+}
+
+
+

lib/src/ancient_greek/IrregGrcAbs.gf

@@ -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 ;
+}

lib/src/ancient_greek/LangExtra.gf

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

lib/src/ancient_greek/LangExtraGrc.gf

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

lib/src/ancient_greek/LangGrc.gf

@@ -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?
+} ;

lib/src/ancient_greek/LexiconGrc.gf

@@ -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 ;
+}

lib/src/ancient_greek/Makefile

@@ -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

lib/src/ancient_greek/NounGrc.gf

@@ -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
+
+}

lib/src/ancient_greek/NumeralGrc.gf

@@ -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 
+      } ;
+}

lib/src/ancient_greek/OverloadGrc.gf

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

lib/src/ancient_greek/ParadigmsGrc.gf

@@ -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
+ 
+}

lib/src/ancient_greek/PhonoGrc.gf

@@ -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 
+     } ;
+-}
+
+} 

lib/src/ancient_greek/PhraseGrc.gf

@@ -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} ;
+
+}

lib/src/ancient_greek/QuestionGrc.gf

@@ -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) ;
+
+}

lib/src/ancient_greek/RelativeGrc.gf

@@ -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*" 
+                          } 
+             } ;
+}

lib/src/ancient_greek/SentenceGrc.gf

@@ -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
+
+
+}
+

lib/src/ancient_greek/StructuralGrc.gf

@@ -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 } ;
+}
+

lib/src/ancient_greek/SymbolGrc.gf

@@ -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 "," ;
+--
+}

lib/src/ancient_greek/SymbolicGrc.gf

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

lib/src/ancient_greek/SyntaxGrc.gf

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

lib/src/ancient_greek/TenseGrc.gf

@@ -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} ;  -- ???
+
+}

lib/src/ancient_greek/TerminologyGrc.gf

@@ -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
+}

lib/src/ancient_greek/TransferGrcAbs.gf

@@ -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
+
+-} 
+
+

lib/src/ancient_greek/VerbGrc.gf

@@ -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) ;
+}

lib/src/ancient_greek/adjectivesBR.gfs

@@ -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
+
+
+

lib/src/ancient_greek/bornemann

@@ -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

lib/src/ancient_greek/nounsBR.gfs

@@ -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 
+
+

lib/src/ancient_greek/verbsBR.gfs

@@ -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 
+
+