
package IE_to_PG;
use Derive;
@IE_to_PG::ISA = qw{Derive};

sub inventory {
  return(<<'END');
p   C obstr stop lab 
b   C obstr stop lab  voiced
bh  C obstr stop lab  voiced asp
f   C obstr fric lab 
v   C obstr fric lab  voiced
m   C son   nas  lab  voiced
t   C obstr stop dent apic
d   C obstr stop dent apic voiced
dh  C obstr stop dent voiced asp
T   C obstr fric dent apic
D   C obstr fric dent apic voiced
s   C obstr fric dent lam
z   C obstr fric dent lam voiced
n   C son   nas  dent voiced
l   C son   liq  dent lat voiced
r   C son   liq  dent centr voiced
m.  C syll  nas  lab  voiced
m.' C syll  nas  lab  voiced str
n.  C syll  nas  dent voiced
n.' C syll  nas  dent voiced str
l.  C syll  liq  dent lat voiced
l.' C syll  liq  dent lat voiced str
r.  C syll  liq  dent centr voiced
r.' C syll  liq  dent centr voiced str
k'  C obstr stop pal
g'  C obstr stop pal voiced
g'h C obstr stop pal voiced asp
N'  C son   nas  pal voiced
j   C son   glide pal voiced
k   C obstr stop vel
g   C obstr stop vel voiced
x   C obstr fric vel
G   C obstr fric vel voiced
gh  C obstr stop vel voiced asp
N   C son   nas  vel voiced
kw  C obstr stop labiovel
gw  C obstr stop labiovel voiced
gwh C obstr stop labiovel voiced asp
xw  C obstr fric labiovel
Gw  C obstr fric labiovel voiced
Nw  C son   nas  labiovel voiced
w   C son   glide labiovel voiced
h   C obstr fric glot
hw  C obstr fric labiovel glot
H   V voiced
H'  V voiced str
a   V low back voiced
a'  V low back str voiced
a:  V low back long voiced
a:' V low back long str voiced
a~  V low back voiced trimoric
ae  V low front voiced
ae' V low front str voiced
ae: V low front long voiced
ae:' V low front long str voiced
e   V mid front voiced
e'  V mid front str voiced
e:  V mid front long voiced
e:' V mid front long str voiced
e~  V mid front voiced trimoric
i   V high front voiced
i'  V high front str voiced
i:  V high front long voiced
i:' V high front long str voiced
o   V mid back round voiced
o'  V mid back round str voiced
o:  V mid back round long voiced
o:' V mid back round long str voiced
o~  V mid back round voiced trimoric
u   V high back round voiced
u'  V high back round str voiced
u:  V high back round long voiced
u:' V high back round long str voiced
@   V voiced high
@'  V str voiced high
-   punct
END
}


## Rules:

sub Lower_Schwa {
  #PIE schwa becomes /a/ (Prokosch 38):
  Change q{ (<V,-front,-back,-high>) } => 
         q{ <$1(-front,+low,+back)>  };
}

sub Lower_Long_e {
  #PIE e: becomes ae: (Prokosch 37), whence NW a:, E e:
  # but not in diphthong e:is (Prokosch 39)
  Change q{ (<V,front,mid,long>) (?! <-obstr,-punct>)} =>
         q{  <$1(-mid,+low)>     };
}

sub Monophthongize_Long_ei {
  #PIE e:i becomes e:(2) (Prokosch 39):
  Change q{ (<V,front,mid,long>) {i} } =>
         q{         $1               };
}

sub Shorten_Long_Diphthongs {
  #PIE long diphthongs (other than e:i) normally shorten the first element 
  # (Prokosch 39):
  #he seems to be treating V:R as a diphthong if followed by a C
  Change q{ (<V,long>)  (?= <V,high> | <C,-obstr> <C> ) } =>
         q{ <$1(-long)> };
}

sub Depalatalize_Stops {
  #PIE palatal stops become plain velar stops (Prokosch 11): 
  # k' g' g'h > k  g  gh
  Change q{ (<stop, pal>)  } =>
         q{ <$1(-pal+vel)> };
}

sub Epenthesize_sr {
  #PIE sr becomes str (Prokosch 29):
  Change q{ {s}     (?= {r}) } =>
         q{ {s} {t} };
}

sub Stop_Nasal_Assimilation {
  #PIE pretonic pn will end up as pp; tn, dn as tt; kn, gn, ghn as kk.
  #I assume that at this point these are bb, dd, gg
  #Prokosch 22
  Change q{ <lab, stop> {n} (?= <str, V>) } =>
         q{     {b}     {b} };

  Change q{ <dent, stop> {n} (?= <str, V>) } =>
         q{     {d}      {d} };

  Change q{ <vel, stop> {n} (?= <str, V>) } =>
         q{     {g}     {g} };
}

sub Assimilate_Postlateral_n {
  #PIE ln => ll (Prokosch 29):
  Change q{ {l} {n} } =>
         q{ {l} {l} };
}

sub Assimilate_nw {
  #PIE nw => nn (Prokosch 29):
  Change q{ {n} {w} } =>
         q{ {n} {n} };
}

sub Delete_Internasal_Stop {
  #PIE stops are deleted between n (Prokosch 29):
  Change q{ {n} <stop> (?= {n}) } =>
         q{ {n}        };
}

sub Spirantize_tst {
  #PIE tst (the result of the contact of two dental stops) => ss (Prokosch 29):
  Change q{ {t} {s} {t} } =>
         q{   {s} {s}   };
}

sub Spirantize_Aspirates {
  #PIE voiced aspirate stops become unaspirated fricatives (Prokosch 18):
  # bh  dh  gh  gwh  =>  v  D  G  Gw
  Change q{    (<asp,dent>)              } =>
         q{ <$1(-asp -stop +fric +apic)> };

  Change q{    (<asp>)             } =>
         q{ <$1(-asp -stop +fric)> };
}

sub Spirantize_Voiceless_Stops {
  #PIE voiceless stops become voiceless fricatives, except after obstruents:
  # p  t  k  kw  =>  f  T  x  xw
  #Prokosch 19.
  Change q{ (^ | <-obstr>) (<stop -voiced>) } =>
         q{     $1        <$2(-stop +fric)> };
}

sub Devoice_Stops {
  #PIE unaspirated voiced stops become voiceless (Prokosch 21):
  #  b  d  g  gw  =>  p  t  k  kw
  #Must apply after Spirantize_Voiceless_Stops
  Change q{ (<stop, voiced>) } =>
         q{  <$1(-voiced)>   };
}

sub Segmentalize_Syllabics {
  #PIE voiced liquids and nasals become /u/ plus that same consonant
  #  m.  n.  l.  r.  =>  um un ul ur 
  # lu-, etc., initially?
  Change q{ ^ (<C, syll, str>)          } =>
         q{  <$1(-syll,+son,-str)> {u'} };

  Change q{ ^ (<C, syll>)         } =>
         q{   <$1(-syll+son)> {u} };

  Change q{      (<C, syll, str>)      } =>
         q{ {u'} <$1(-syll,+son,-str)> };

  Change q{      (<C, syll>)           } =>
         q{ {u} <$1(-syll,+son,+son)>  };
}

sub Lower_o {
  #PIE short o becomes a, even in diphthongs (Prokosch 38)
  Change q{ (<V,back,mid,-long,-trimoric>)  } =>
         q{    <$1(-mid,+low,-round)>       };
}

sub Raise_Long_a {
  #PIE a: becomes o: (Prokosch 37).
  Change q{ (<V,low,long,back>)    } =>
         q{ <$1(-low,+mid,+round)> };
}

sub Verner {
  #Germanic fricatives become voiced after voiced sounds, unless the
  #  previous vowel is high tone, or the following consonant is voiceless.
  # Prokosch 20: 1st or 2nd c. AD.
  Change q{ (<(V|syll), -str> <C,voiced>*) (<fric>)      (?! <C,-voiced>) } =>
         q{         $1                    <$2(+voiced)> };
}

sub Reaccent {
  #Get rid of PIE accent.  Institute initial accent.  Must follow Verner.
  Change q{ (<V, str>) } => 
         q{ <$1(-str)> };
  
  Change q{ ^ (<C -syll>*) (<syll | V>) } =>
         q{       $1        <$2(+str)>  };
}

sub Schwa_Secundum {
  #PIE schwa secundum becomes  u  in unaccented syllables or next to resonants,
  #  else e (Prokosch 38):
  Change q{ (<C,(nas|liq)>) {\@'} } =>
         q{      $1          {u'}  };

  Change q{ {\@'} (?= <C,(nas|liq)>) } =>
         q{  {u'} };
  
  Change q{ {\@} } =>
         q{ {u}  };

  Change q{ {\@'} } =>
         q{ {e'}  };
}

sub Assimilate_zm {
  # zm > mm (Prokosch 29):
  Change q{ {z} (?= {m}) } => 
         q{ {m} };
}

sub Assimilate_zl {
  # zl > ll (Prokosch 29):
  Change q{ {z} (?= {l}) } => 
         q{ {l} };
}

sub Assimilate_Dl {
  # Dl > ll (Prokosch 29):
  Change q{ {D} (?= {l}) } => 
         q{ {l} };
}

sub n_Deletion_before_x {
  #PIE n deletes before x, with compensatory lengthening (Prokosch 29):
  Change q{  ({V}) {n}  (?= {x}) } =>
         q{ <$1(+long)> };
}

sub Postheavy_Degemination {
  #Geminates degeminate after a heavy syllable (Prokosch 22): 
  Change q{ (<V, str> <V>) (<C>) (?= \2) } =>
         q{      $1              };

  Change q{ (<V, str, long>) (<C>) (?= \2) } =>
         q{      $1                };

  Change q{ (<V, str> <C>) (<C>) (?= \2) } =>
         q{      $1              };
}

sub Lower_Unstressed_Long_oN {
  #Prokosch 49
  Change q{ {o:} (?= <C,nas> <C>* $) } =>
         q{ {a:} };
}

sub Delete_Final_Mora {
  #Prokosch 49:
  # consonants other than r, s deleted when final in unstressed syllables
  # If no final consonant, short non-high vowels delete.
  # PIE diphthongs drop the second element finally unless it is long.
  
  #final short diphthongs => monophthong:
  Change q{ (<V,-str>) <V,high,-long> $ } =>
         q{    $1                       }
    or
  #final consonant other than r, s delete, and previous long vowel shortens:
  Change q{ (<V, -str>) (<C>*) <C,-((liq,centr)|(fric,lam))> $ } =>
         q{ <$1(-long)>   $2                                   }
    or
  #final postconsonantal a, e, o deletes:
  Change q{ (<C>) <V,-long,-str,-trimoric,-high> $ } =>
         q{  $1                                  }
    or
  #final long consonant shortens:
  Change q{ (<V,+long,-str>) $ } =>
         q{    <$1(-long)>   };
}

sub Raise_Short_e {
  #Prokosch 38 says e > i unless stressed before a consonant span 
  # (other than NC) followed by a non-high vowel.
  Change q{ {e'} (?= <C,nas> <C>) } =>
         q{ {i'} };

  Change q{ {e'} (?! <C>* <V,-high>) } =>
         q{ {i'} };

  Change q{ {e} } =>
         q{ {i} };

  Change q{ <V, high, front> <V, high, front> } =>
         q{                {i:'}              };
}

sub Shorten_Checked_V_in_Final_Syll {
  #Prokosch 49:
  # e: > e  (short unstressed e is already i)
  # PIE a: o: is already o: > o (orig. short o is already a)
  #  but /a/ before nasals
  # PIE trimoric diphthongs become  bimoric, e.g., oi: > oi
  Change q{ (<C>) (<V,-str,+long>) (?= <C>+ $) } =>
         q{   $1     <$2(-long)>   };
}

sub Shorten_Overlong_Vowels {
  #Prokosch 49: trimoric vowels shorten to long.
  # PIE overlong diphthongs become normal.
  Change q{   (<V,+trimoric>)     } =>
         q{ <$1(-trimoric,+long)> };

  Change q{ (<V>) (<V,+long,+high>) } =>
         q{   $1     <$2(-long)>    };
}

sub Lower_Short_u {
  #Prokosch 38 says u > o unless before a high vowel or NC:
  Change q{ {u'} (?! <C>* <V,+high> | <C,nas> <C>) } =>
         q{ {o'} };

  Change q{ {e'} {u} (?! <V,+high> | <C,nas> <C>) } =>
         q{ {e'} {o} };
}

sub Debuccalize_Initial_x {
  #Initial x(w)- is apparently [h(w)] in all the Germanic languages:
  #Must follow Spirantize_Voiceless_Stops, the source of x (from PIE k, kw)
  #Prokosch 27.
  Change q{^ (<(vel|labiovel), fric, -voiced>) } =>
         q{        <$1(-vel,+glot)>            };
}

sub Assimilate_Nasals {
  #Nasals agree in place with following obstruent.
  Change q{ <C, nas> (?= <dent, obstr>) } =>
         q{    {n}   };

  Change q{ <C, nas> (?= <lab, obstr>) } =>
         q{    {m}   };

  Change q{ <C, nas> (?= <(vel | labiovel), obstr>) } =>
         q{    {N}   };
}

sub Despirantize_Postnasal_Fricatives {
  # v D G  are  b d g after nasals: (Prokosch 24)
  Change q{ (<C,nas>) (<fric,+voiced>) } =>
         q{   $1    <$2(-fric,+stop)>  };
}

sub Despirantize_Geminates {
  # Voiced geminate fricatives become stops (Prokosch 24)
  Change q{ (<fric,voiced>)      \1     } =>
         q{  <$1(-fric)>    <$1(-fric)> };
}

sub Despirantize_Postlateral_D {
  # lD => ld (Prokosch 24):
  Change q{ {l} {D} } =>
         q{ {l} {d} };
}

sub Despirantize_Initial_BD {
  # B D => b, d word-initial (Prokosch 24):
  Change q{ ^ (<fric, voiced, -vel>) } =>
         q{      <$1(-fric,+stop)>   };
}

sub Delabialize_Labiovelars_before_Rounds {
  # kw  xw  Gw  become k  x  G before o u
  #Prokosch 23:
  Change q{   (<obstr,labiovel>) (?= <V, round>) } =>
         q{ <$1(-labiovel,+vel)> };
}

sub Delabialize_Nonprevocalic_Labiovelars {
  #Prokosch 23
  Change q{ (<obstr,labiovel>)    (?! <V | glide | punct>) } =>
         q{ <$1(-labiovel,+vel)> };
}

sub Lenite_Gw {
  #Prokosch 23.  Blocked by preceding nasal.
  Change q{ (^ | <-nas>) {Gw} } =>
         q{        $1    {w}  };
}

sub Final_m_to_n {
  #Prokosch 49
  Change q{ (<V,-str>) {m} $ } =>
         q{   $1       {n}   };
}

sub Vocalize_Final_Glides {
  #Prokosch 33:
  Change q{ {j} $ } =>
         q{ {i}   };
  Change q{ {w} $ } =>
         q{ {u}   };
}

sub Sievers {
  #Prokosch 33: -ji- becomes -i:- after initial short vowel + single C:
  Change q{ ^ (<C>*) (<V,-long>) (<C>) {j} {i} } =>
         q{     $1        $2       $3    {i:}  };
}

sub rules {[qw{
  Lower_Schwa
  Lower_Long_e
  Monophthongize_Long_ei
  Shorten_Long_Diphthongs
  Depalatalize_Stops
  Epenthesize_sr
  Delete_Internasal_Stop
  Stop_Nasal_Assimilation
  Spirantize_tst
  Spirantize_Aspirates
  Spirantize_Voiceless_Stops
  Devoice_Stops
  Despirantize_Postnasal_Fricatives
  Delabialize_Labiovelars_before_Rounds
  Lower_o
  Raise_Long_a
  Verner
  Reaccent
  Assimilate_zm
  Assimilate_zl
  Assimilate_Dl
  n_Deletion_before_x
  Lower_Short_u
  Delete_Internasal_Stop
  Postheavy_Degemination
  Lower_Unstressed_Long_oN
  Delete_Final_Mora
  Raise_Short_e
  Shorten_Checked_V_in_Final_Syll
  Shorten_Overlong_Vowels
  Segmentalize_Syllabics
  Assimilate_nw
  Assimilate_Postlateral_n
  Schwa_Secundum
  Debuccalize_Initial_x
  Assimilate_Nasals
  Despirantize_Geminates
  Despirantize_Postlateral_D
  Despirantize_Initial_BD
  Delabialize_Nonprevocalic_Labiovelars
  Lenite_Gw
  Final_m_to_n
  Vocalize_Final_Glides
}];
}

sub test_suite {[
  ["bhe'retai"  => "be'riDa"],
  ["bhe'roi:"   => "be'rai"],
  ["dhoghoi"    => "da'Ga"],
  ["ghostis"    => "Ga'stiz",    'guest'],
  ["woi'da"     => "wa'it",      'I know'],
  ["woi'de"     => "wa'it",      'he knows'],
  ["ne'me"      => "ni'm",       'take!'],
  ["ne'mete"    => "ne'miD",     'take ye!'],
  ["ne'monti"   => "ne'manDi",   'they take'],
  ["sunus"      => "su'nuz",     'son'],
  ["pe'k'u"     => "fi'xu",      'cattle'],
  ["ko:im-"     => "ha'im-",     'home'],
  ["tong-"      => "Ta'Nk-"],
  ["tn.g-"      => "Tu'Nk-"],
  ["plo:ir-"    => "fla'ir-",    'more'],
  ["a:iwos"     => "a'iwaz",     'time'],
  ["de:us"      => "te'oz",      'Zeus'],
  ["na:u-"      => "na'u-",      'ship'],
  ["dwo:u-"     => "twa'u-",     'two'],
  ["we:ntos"    => "wi'nDaz",    'wind'],
  ["we:nto~s"   => "wi'nDo:z",   'winds'],
  ["we:nto~m"   => "wi'nDo:",    'of winds'],
  ["bhe'udho-"  => "be'oDa-",    'order'],
  ["bho'udho-"  => "ba'uDa-"],
  ["bhudh-"     => "bo'D-",      'order'],
  ["we'rto-"    => "we'rTa-"],
  ["wo'rt-"     => "wa'rT-"],
  ["wr.t-"      => "wu'rD-"],
  ["bhendh-"    => "bi'nd-"],
  ["bhondh-"    => "ba'nd-"],
  ["bhn.dh-"    => "bu'nd-"],
  ["g'h\@mo:n-" => "Gu'mo:n-",     'man'],
  ['t@l-'       => "Tu'l-",      'suffer'],
  ['s@d-'       => "se't-",      'sat'],
  ["kelono-"    => "he'lana-",   'conceal'],
  ["swi:nos"    => "swi:'naz",   'swine'],
  ["su:ros"     => "su:'raz",    'sour'],
  ["se:-"       => "sae:'-",     'seed'],
  ["edo-"       => "e'ta-",      'eat'],
  ["e:d-"       => "ae:'t-",     'ate'],
  ["bhlo:-"     => "blo:'-",     'flower'],
  ["dho:mos"    => "do:'maz",    'doom'],
  ["plo:to's"   => "flo:'Das",   'flood'],
  ["ma:'ter"    => "mo:'Tir",    'mother'],
  ["tasm-"      => "Ta'mm-",     'him'],
  ["esmi"       => "i'mmi",      'am'],
  ["stHdhlos"   => "sta'llaz",   'stall'],
  ["mHtlo'-"    => "ma'lla-"],
  ["mH'tlo-"    => "ma'Tla-",    'meeting place'],
  ["sentno-"    => "si'nna-",    'go'],
  ["rinw-"      => "ri'nn-",     'flow'],
  ["minw-"      => "mi'nn-",     'less'],
  ["tn.w-"      => "Tu'nn-",     'thin'],
  ["pl.no's"    => "fu'llas",    'full'],
  ["pelno-"     => "fe'lla-"],
  ["sroumos"    => "stra'umaz",  'stream'],
  ["ausrom"     => "a'ustra",    'Easter'],
  ["swesro-"    => "swe'stra-",  'sister'],
  ["witsta:m"   => "wi'ssa",     'I knew'],
  ["mitsto-"    => "mi'ssa-",    'wrong'],
  ["weitsto-"   => "wi:'sa-",    'wise'],
  ["akwja:'"    => "a'wjo",      'island'],
  ["a'kwa:"     => "a'xwo",    'river'],
  ["makwu's"    => "ma'Gus",     'boy'],
  ["kwetwo:'res" => "hwe'Dwo:riz", 'four'],
  ["sekwti-"    => "si'xti-",    'sight'],
  ["kwe-"       => "hwi'-",      'who'],
  ["kwelo-"     => "hwe'la-",    'wheel'],
  ["kwekwlo'm"  => "hwe'Gla",    'wheel'],
  ["gwe'to-"    => "kwe'Ta-",    'quoth'],
  ["kneigwho-"  => "hni:'Ga-",   'bend'],
  ["seNgwh-"    => "si'Ngw-",    'sing'],
  ["kupna:'"    => "ho'ppo"],
  ["snitno'-"   => "sni'tta-"],
  ["studno'-"   => "sto'tta-"],
  ["l.kna:'"    => "lu'kko"],
  ["lugno's"    => "lo'kkas"],
  ["bhHgno'-"   => "ba'kka-",    'bake'],
  ["lighna:'-"  => "li'kko:-",   'lick'],
  ["haubno'-"   => "ha'upa-",    'heap'],
  ["kwi:dno'-"  => "hwi:'ta-",   'white'],
  ["k'm.t-"     => "hu'nD-",     'hundred'],
  ["g'eni-"     => "ki'ni-",     'kin'],
  ["g'neu-"     => "kne'o-",     'knee'],
  ["dhura:"     => "do'ro",      'door'],
  ["bhra:'ter"  => "bro:'Tir",   'brother'],
  ["bhero-"     => "be'ra-",     'carry'],
  ["nebho-"     => "ne'va-",     'fog'],
  ["dhe:-"      => "dae:'-",     'do'],
  ["roudhos"    => "ra'uDaz",    'red'],
  ["medhios"    => "mi'Diaz",    'mid'],
  ["g'hl.to's"  => "Gu'ldas",    'gold'],
  ["g'heud-"    => "Ge'ot-"],
  ["g'hongh-"   => "Ga'Ng-"],
  ["weg'ho-"    => "we'Ga-"],
  ["ghostis"    => "Ga'stiz"],
  ["ghorto's"   => "Ga'rDas"],
  ["steigh-"    => "sti:'G-",    'climb'],
  ["ste:igh-"   => "ste:'G-",    'stair'],
  ["skeiros"    => "ski:'raz",   'clear'],
  ["ske:iro-"   => "ske:'ra-",   'clever'],
  ["stoigh-"    => "sta'iG-"],
  ["stigh-"     => "sti'G-"],
  ["pHte:'r"    => "fa'Der",     'father'],
  ["po:d-"      => "fo:'t-",     'foot'],
  ["treies"     => "Tri:'iz",    'three'],
  ["tu:"        => "Tu:'",       'thou'],
  ["tod"        => "Ta't",       'that'],
  ["de'k'm."    => "ti'xun",     'ten'],
  ["dei'k'-"    => "ti:'x-"],
  ["kHn-"       => "ha'n-",      'rooster'],
  ["ka:ros"     => "ho:'raz",    'adulterer'],
  ["leu'k-"     => "le'ox-",     'light'],
  ["lei'kw-"    => "li:'xw-",    'lend'],
  ["tr.p-"      => "Tu'rv-",     'need'],
  ["alto's"     => "a'ldas",     'old'],
  ["duko-"      => "to'Ga-",     'lead'],
  ["kaNk-"      => "ha'NG-",     'hang'],
  ["au'ris"     => "a'uriz",     'ear'],
  ["wei'k-"     => "wi:'x-",     'fight'],
  ["skHb-"      => "ska'p-",     'shape'],
  ["g'eu's-"    => "ke'os-",     'choose'],
  ["aug-"       => "a'uk-",      'increase'],
  ["jugom"      => "jo'ka",      'yoke'],
  ["gwem-"      => "kwi'm-",     'come'],
  ["gwena:'"    => "kwe'no",     'woman'],
  ["gwi:wos"    => "kwi:'waz",   'alive'],
];
}

my $thing = IE_to_PG->new;
$thing->test;