extensions by Codex

src/gaelic/AdjectiveGla.gf

@@ -14,28 +14,23 @@ concrete AdjectiveGla of Adjective = CatGla ** open ResGla, Prelude in {
   PositA a = a ;
 
   -- : A  -> NP -> AP ;
-  --ComparA a np = a ** {
+  ComparA a np = addAP a ("na" ++ linNP np) ;
-  --  compar = np.s
-  --  } ;
 
   -- : A2 -> NP -> AP ;  -- married to her
-  -- ComplA2 a2 np = a2 ** { } ;
+  ComplA2 a2 np = addAP a2 (prepNP a2.c2 np) ;
 
   -- : A2 -> AP ;        -- married to itself
-  -- ReflA2 a2 = a2 ** { } ;
+  ReflA2 a2 = a2 ;
 
   -- : A2 -> AP ;        -- married
-  -- UseA2 = PositA ;
+  UseA2 a2 = a2 ;
 
   -- : A  -> AP ;     -- warmer
-  -- UseComparA a = a ** {
+  UseComparA a = {s = \\_ => a.compar ; voc = \\_ => a.compar} ;
-  --   s = \\af => "???" ++ a.s ! af ;
-  --   compar = []
-  --  } ;
 
 
   -- : CAdv -> AP -> NP -> AP ; -- as cool as John
-  -- CAdvAP adv ap np = ap ** { } ;
+  CAdvAP adv ap np = addAP ap (adv.p ++ linNP np) ;
 
 -- The superlative use is covered in $Ord$.
 
@@ -50,18 +45,23 @@ concrete AdjectiveGla of Adjective = CatGla ** open ResGla, Prelude in {
 -- phrases, although the semantics is only clear for some adjectives.
 
   -- : AP -> SC -> AP ;  -- good that she is here
-  -- SentAP ap sc = ap ** {
+  SentAP ap sc = addAP ap sc.s ;
-    -- s = \\af => ap.s ! af ++ sc.s
-    -- } ;
 
 -- An adjectival phrase can be modified by an *adadjective*, such as "very".
 
   -- : AdA -> AP -> AP ;
-  -- AdAP ada ap = ap ** { } ;
+  AdAP ada ap = {
+    s = \\af => ada.s ++ ap.s ! af ;
+    voc = \\g => ada.s ++ ap.voc ! g
+    } ;
 
 
 -- It can also be postmodified by an adverb, typically a prepositional phrase.
 
-
+oper
+  addAP : LinAP -> Str -> LinAP = \ap,x -> {
+    s = \\af => ap.s ! af ++ x ;
+    voc = \\g => ap.voc ! g ++ x
+    } ;
 
 }

src/gaelic/AdverbGla.gf

@@ -1,16 +1,14 @@
 concrete AdverbGla of Adverb = CatGla ** open ResGla, ParadigmsGla, Prelude in {
 lin
-{-
 
   -- : A -> Adv ;
-  PositAdvAdj adj =
+  PositAdvAdj adj = {s = "gu" ++ adj.s ! ASg NOM Masc} ;
 
   -- : CAdv -> A -> NP -> Adv ; -- more warmly than John
-  ComparAdvAdj cadv a np =
+  ComparAdvAdj cadv a np = {s = cadv.s ++ a.compar ++ cadv.p ++ linNP np} ;
 
   -- : CAdv -> A -> S  -> Adv ; -- more warmly than he runs
-  ComparAdvAdjS cadv a s =
+  ComparAdvAdjS cadv a sent = {s = cadv.s ++ a.compar ++ cadv.p ++ sent.s} ;
--}
   -- : Prep -> NP -> Adv ;
   PrepNP prep np = {
     s = prepAndArt ++ noun
@@ -33,27 +31,24 @@ lin
         _ => np.empty -- empty string to avoid metavariables
       }
     };
-{-
 -- Adverbs can be modified by 'adadjectives', just like adjectives.
 
   -- : AdA -> Adv -> Adv ;             -- very quickly
-  AdAdv ada adv = adv **
+  AdAdv ada adv = {s = ada.s ++ adv.s} ;
 
 -- Like adverbs, adadjectives can be produced by adjectives.
 
   -- : A -> AdA ;                 -- extremely
-  PositAdAAdj a =
+  PositAdAAdj a = {s = "gu" ++ a.s ! ASg NOM Masc} ;
 
   -- Subordinate clauses can function as adverbs.
 
   -- : Subj -> S -> Adv ;
-  SubjS subj s = {s = subj.s ++ s.s} ;
+  SubjS subj sent = {s = subj.s ++ sent.s} ;
 
 -- Comparison adverbs also work as numeral adverbs.
 
   -- : CAdv -> AdN ;                  -- less (than five)
-  AdnCAdv cadv =  ;
+  AdnCAdv cadv = {s = cadv.s} ;
-
--}
 
 }

src/gaelic/AllGla.gf

@@ -1,6 +1,6 @@
 --# -path=.:../abstract:../common:../prelude
 
 concrete AllGla of AllGlaAbs =
-  LangGla -- ,
+  LangGla,
-  -- ExtendGla
+  ExtendGla
   ;

src/gaelic/AllGlaAbs.gf

@@ -1,3 +1,4 @@
 abstract AllGlaAbs =
-  Lang
+  Lang,
+  Extend
   ** {}

src/gaelic/CatGla.gf

@@ -1,4 +1,4 @@
-concrete CatGla of Cat = CommonX ** open ResGla, Coordination, Prelude in {
+concrete CatGla of Cat = CommonGla ** open ResGla, Coordination, Prelude in {
 
   flags optimize=all_subs ;
 
@@ -13,14 +13,16 @@ concrete CatGla of Cat = CommonX ** open ResGla, Coordination, Prelude in {
     -- but agreement may depend on the CN/NP it modifies.
 
     Cl = ResGla.LinCl ;
-    ClSlash = SS ;
+    ClSlash = ResGla.LinClSlash ;
     SSlash  = SS ; -- sentence missing NP; e.g. "she has looked at"
     Imp     = SS ; -- imperative             e.g. "look at this"
 
 --2 Questions and interrogatives
 
 -- Constructed in QuestionGla.
-    QCl = SS ;
+    -- A question is not fixed to present positive when it is built: UseQCl
+    -- supplies tense, anteriority and polarity afterwards.
+    QCl = {s : GlaTense => GlaAnteriority => GlaPolarity => Str} ;
     IComp = SS ;   -- interrogative complement of copula  e.g. "where"
     IDet = SS ;    -- interrogative determiner            e.g. "how many"
     IQuant = SS ;  -- interrogative quantifier            e.g. "which"
@@ -28,14 +30,14 @@ concrete CatGla of Cat = CommonX ** open ResGla, Coordination, Prelude in {
 
 --2 Subord clauses and pronouns
 
-    RCl = SS ;
+    RCl = {s : GlaTense => GlaAnteriority => GlaPolarity => Str} ;
     RP = SS ;
 
 --2 Verb phrases
 
 -- Constructed in VerbGla.
     VP = ResGla.LinVP ;
-    VPSlash = SS ;
+    VPSlash = ResGla.LinVPSlash ;
     Comp = SS ;
 
 --2 Adjectival phrases
@@ -59,7 +61,7 @@ concrete CatGla of Cat = CommonX ** open ResGla, Coordination, Prelude in {
     Card = ResGla.LinNum ;
     ACard = SS ;
     Ord = SS ;
-    DAP = SS ;
+    DAP = ResGla.LinDet ;
 
 
 --2 Numerals
@@ -68,6 +70,7 @@ concrete CatGla of Cat = CommonX ** open ResGla, Coordination, Prelude in {
 
     Numeral = ResGla.LinNumeral ;
     Digits = ResGla.LinNumeral ;
+    Decimal = SS ;
 
 --2 Structural words
 
@@ -106,8 +109,8 @@ concrete CatGla of Cat = CommonX ** open ResGla, Coordination, Prelude in {
     A2 = LinA ** {c2 : LinPrep} ;
 
     N = ResGla.LinN ;
-    N2 = ResGla.LinN ;
+    N2 = ResGla.LinN ** {c2 : ResGla.LinPrep} ;
-    N3 = ResGla.LinN ;
+    N3 = ResGla.LinN ** {c2,c3 : ResGla.LinPrep} ;
     PN = SS ;
 
     -- From the Names module, not in the official API as of 2023-08

src/gaelic/CommonGla.gf

@@ -0,0 +1,28 @@
+concrete CommonGla of Common = open (R = ParamX), Prelude in {
+
+  param
+    GlaTense = GPres | GPast | GFut | GCond ;
+    GlaAnteriority = GSimul | GAnter ;
+    GlaPolarity = GPos | GNeg ;
+
+  lincat
+    Text = {s : Str} ;
+    Phr = {s : Str} ;
+    Utt = {s : Str} ;
+    Voc = {s : Str} ;
+    SC = {s : Str} ;
+    Adv = {s : Str} ;
+    AdV = {s : Str} ;
+    AdA = {s : Str} ;
+    AdN = {s : Str} ;
+    IAdv = {s : Str} ;
+    CAdv = {s,p : Str} ;
+    PConj = {s : Str} ;
+    Interj = {s : Str} ;
+
+    Temp = {s : Str ; t : GlaTense ; a : GlaAnteriority} ;
+    Tense = {s : Str ; t : GlaTense} ;
+    Ant = {s : Str ; a : GlaAnteriority} ;
+    Pol = {s : Str ; p : GlaPolarity} ;
+    MU = {s : Str ; isPre : Bool} ;
+}

src/gaelic/ConjunctionGla.gf

@@ -25,18 +25,57 @@ concrete ConjunctionGla of Conjunction =
       ConsAdv = consrSS comma ;
       ConjAdv = conjunctSS ;
 
-    --}
+    -}
 
 -----------------------------------------------------------------------------
 -- Adverb and other simple {s : Str} types.
 lincat
   [Adv],[AdV],[IAdv] = {s1,s2 : Str} ;
+  [S], [RS] = {s1,s2 : Str} ;
+  [NP] = {s1,s2 : Case => Str} ;
+  [AP] = {s1,s2 : AForm => Str} ;
+  [CN] = {s1,s2 : Case => Species => Number => Str ; g : Gender} ;
+  [DAP] = {s1,s2 : Gender => Case => Str} ;
 
 lin
   BaseAdv, BaseAdV, BaseIAdv = twoSS ;
   ConsAdv, ConsAdV, ConsIAdv = consrSS comma ;
   ConjAdv, ConjAdV, ConjIAdv = conjunctDistrSS ;
 
+  BaseS, BaseRS = twoSS ;
+  ConsS, ConsRS = consrSS comma ;
+  ConjS, ConjRS = conjunctDistrSS ;
+
+  BaseNP x y = {s1 = \\c => x.art ! c ++ x.s ! c ; s2 = \\c => y.art ! c ++ y.s ! c} ;
+  ConsNP x xs = {s1 = \\c => x.art ! c ++ x.s ! c ++ comma ++ xs.s1 ! c ; s2 = xs.s2} ;
+  ConjNP conj xs = emptyNP ** {
+    s = \\c => conj.s1 ++ xs.s1 ! c ++ conj.s2 ++ xs.s2 ! c ;
+    voc = conj.s1 ++ xs.s1 ! NOM ++ conj.s2 ++ xs.s2 ! NOM ;
+    a = NotPron (DDef conj.n Def)
+    } ;
+
+  BaseAP x y = {s1 = x.s ; s2 = y.s} ;
+  ConsAP x xs = {s1 = \\f => x.s ! f ++ comma ++ xs.s1 ! f ; s2 = xs.s2} ;
+  ConjAP conj xs = {
+    s = \\f => conj.s1 ++ xs.s1 ! f ++ conj.s2 ++ xs.s2 ! f ;
+    voc = \\g => conj.s1 ++ xs.s1 ! ASg NOM g ++ conj.s2 ++ xs.s2 ! ASg NOM g
+    } ;
+
+  BaseCN x y = {s1 = x.s ; s2 = y.s ; g = x.g} ;
+  ConsCN x xs = {s1 = \\c,d,n => x.s ! c ! d ! n ++ comma ++ xs.s1 ! c ! d ! n ; s2 = xs.s2 ; g = xs.g} ;
+  ConjCN conj xs = {
+    s = \\c,d,n => conj.s1 ++ xs.s1 ! c ! d ! n ++ conj.s2 ++ xs.s2 ! c ! d ! n ;
+    voc = \\n => conj.s1 ++ xs.s1 ! NOM ! Indef ! n ++ conj.s2 ++ xs.s2 ! NOM ! Indef ! n ;
+    g = xs.g
+    } ;
+
+  BaseDAP x y = {s1 = x.s ; s2 = y.s} ;
+  ConsDAP x xs = {s1 = \\g,c => x.s ! g ! c ++ comma ++ xs.s1 ! g ! c ; s2 = xs.s2} ;
+  ConjDet conj xs = {
+    s = \\g,c => conj.s1 ++ xs.s1 ! g ! c ++ conj.s2 ++ xs.s2 ! g ! c ;
+    s2 = \\g,c => [] ; sp = [] ; dt = DDef conj.n Def
+    } ;
+
 {-
 
 -----------------------------------------------------------------------------

src/gaelic/ConstructionGla.gf

@@ -1,4 +1,4 @@
-concrete ConstructionGla of Construction = CatGla ** open ParadigmsGla in {
+concrete ConstructionGla of Construction = CatGla ** open ParadigmsGla, ResGla, Prelude in {
 
 lincat
   Timeunit = N ;
@@ -6,6 +6,8 @@ lincat
   Monthday = NP ;
   Month = N ;
   Year = NP ;
+  Hour = SS ;
+  Language = N ;
 {-
 lin
 
@@ -114,4 +116,69 @@ lin turkish_Language = mkLanguage "Turkish" ;
 lin urdu_Language = mkLanguage "Urdu" ;
 
 -}
+
+lin
+  hungry_VP = qualityVP "acrach" ;
+  thirsty_VP = qualityVP "tartmhor" ;
+  tired_VP = qualityVP "sgîth" ;
+  scared_VP = qualityVP "fo eagal" ;
+  ill_VP = qualityVP "tinn" ;
+  ready_VP = qualityVP "deiseil" ;
+  is_right_VP = qualityVP "ceart" ;
+  is_wrong_VP = qualityVP "ceàrr" ;
+  has_age_VP card = qualityVP (card.s ++ "bliadhna a dh'aois") ;
+
+  timeunitAdv card unit = {s = "fad" ++ card.s ++ unit.s ! NOM ! Indef ! Pl} ;
+  timeunitRange a b unit = {s = "bho" ++ a.s ++ "gu" ++ b.s ++ unit.s ! NOM ! Indef ! Pl} ;
+  weekdayPunctualAdv w = {s = "air" ++ w.s ! NOM ! Indef ! Sg} ;
+  weekdayHabitualAdv w = {s = "gach" ++ w.s ! NOM ! Indef ! Sg} ;
+  weekdayLastAdv w = {s = w.s ! NOM ! Indef ! Sg ++ "seo chaidh"} ;
+  weekdayNextAdv w = {s = w.s ! NOM ! Indef ! Sg ++ "seo tighinn"} ;
+  monthAdv m = {s = "anns an" ++ m.s ! NOM ! Indef ! Sg} ;
+  yearAdv y = {s = "ann an" ++ linNP y} ;
+  dayMonthAdv d m = {s = linNP d ++ m.s ! NOM ! Indef ! Sg} ;
+  monthYearAdv m y = {s = m.s ! NOM ! Indef ! Sg ++ linNP y} ;
+  dayMonthYearAdv d m y = {s = linNP d ++ m.s ! NOM ! Indef ! Sg ++ linNP y} ;
+  intYear i = atomConstrNP i.s ;
+  intMonthday i = atomConstrNP i.s ;
+  weekdayN w = w ; monthN m = m ;
+  weekdayPN w = {s = w.s ! NOM ! Indef ! Sg} ;
+  monthPN m = {s = m.s ! NOM ! Indef ! Sg} ;
+
+  second_Timeunit = mkN "diog" ; minute_Timeunit = mkN "mionaid" ;
+  hour_Timeunit = mkN "uair" ; day_Timeunit = mkN "latha" ;
+  week_Timeunit = mkN "seachdain" ; month_Timeunit = mkN "mìos" ; year_Timeunit = mkN "bliadhna" ;
+  monday_Weekday = mkN "Diluain" ; tuesday_Weekday = mkN "Dimàirt" ;
+  wednesday_Weekday = mkN "Diciadain" ; thursday_Weekday = mkN "Diardaoin" ;
+  friday_Weekday = mkN "Dihaoine" ; saturday_Weekday = mkN "Disathairne" ; sunday_Weekday = mkN "Didòmhnaich" ;
+  january_Month = mkN "Am Faoilleach" ; february_Month = mkN "An Gearran" ; march_Month = mkN "Am Màrt" ;
+  april_Month = mkN "An Giblean" ; may_Month = mkN "An Cèitean" ; june_Month = mkN "An t-Ògmhios" ;
+  july_Month = mkN "An t-Iuchar" ; august_Month = mkN "An Lùnastal" ; september_Month = mkN "An t-Sultain" ;
+  october_Month = mkN "An Dàmhair" ; november_Month = mkN "An t-Samhain" ; december_Month = mkN "An Dùbhlachd" ;
+
+  n_units_AP card unit adj = adj ** {
+    s = \\f => card.s ++ unit.s ! NOM ! Indef ! Pl ++ adj.s ! f ;
+    voc = \\g => card.s ++ unit.voc ! Pl ++ adj.voc ! g
+    } ;
+  n_units_of_NP card unit np = atomConstrNP (card.s ++ unit.s ! NOM ! Indef ! Pl ++ np.s ! Gen) ;
+  n_unit_CN card unit cn = appendConstrCN cn (card.s ++ unit.s ! NOM ! Indef ! Sg) ;
+  bottle_of_CN np = containerCN "botal" np ;
+  cup_of_CN np = containerCN "cupa" np ;
+  glass_of_CN np = containerCN "glainne" np ;
+
+oper
+  qualityVP : Str -> VP = \x -> lin VP (extendQuality x) ;
+  extendQuality : Str -> ResGla.LinV = \x -> {
+    s = "bi" ++ x ; conditional = table {ResGla.Sg => "bhiodh" ++ x ; ResGla.Pl => "bhiodh" ++ x} ;
+    imperative = \\_,_ => "bi" ++ x ; future = \\_ => "bidh" ++ x ; past = \\_ => "bha" ++ x ;
+    noun = "bhith" ++ x ; participle = "air a bhith" ++ x ;
+    copular = True ; complement = x
+    } ;
+  atomConstrNP : Str -> NP = \x -> lin NP (ResGla.emptyNP ** {s = \\_ => x ; voc = x}) ;
+  appendConstrCN : CN -> Str -> CN = \cn,x -> lin CN (cn ** {
+    s = \\c,d,n => cn.s ! c ! d ! n ++ x ; voc = \\n => cn.voc ! n ++ x
+    }) ;
+  containerCN : Str -> NP -> CN = \x,np -> lin CN {
+    s = \\_,_,_ => x ++ np.s ! ResGla.Gen ; voc = \\_ => x ++ np.s ! ResGla.Gen ; g = ResGla.Masc
+    } ;
 }

src/gaelic/ExtendGla.gf

@@ -32,5 +32,111 @@ concrete ExtendGla of Extend = CatGla
     , iFem_Pron, weFem_Pron, youFem_Pron, youPlFem_Pron, youPolFem_Pron, youPolPlFem_Pron, youPolPl_Pron, theyFem_Pron, theyNeutr_Pron
     , GenModNP
     , PiedPipingQuestSlash, PiedPipingRelSlash, SubjunctRelCN
+    , PresPartAP, PassVPSlash, PassAgentVPSlash, PastPartAP, PastPartAgentAP
+    , ProgrVPSlash, CompoundN, GerundCN, GerundNP, GerundAdv, ApposNP
+    , ReflPron, ReflPoss, AdvRNP, AdvRVP, AdvRAP, PossPronRNP
+    , UseDAP, UseDAPFem, UseDAPMasc
+    , MkVPS, BaseVPS, ConsVPS, ConjVPS, PredVPS
+    , MkVPI, BaseVPI, ConsVPI, ConjVPI, ComplVPIVV
+    , PositAdVAdj, ComplBareVS, ByVP
+    , CompoundAP, BaseComp, ConsComp, ConjComp
+    , BaseImp, ConsImp, ConjImp
 
-  ] with (Grammar=GrammarGla) ;
+  ] with (Grammar=GrammarGla)
+  ** open ResGla, Prelude in {
+
+lincat
+  VPS = SS ;
+  [VPS] = {s1,s2 : Str} ;
+  VPI = SS ;
+  [VPI] = {s1,s2 : Str} ;
+  [Comp] = {s1,s2 : Str} ;
+  [Imp] = {s1,s2 : Str} ;
+
+lin
+  MkVPS t p vp = {s = vp.s} ;
+  PredVPS np vps = {s = vps.s ++ linNP np} ;
+  BaseVPS x y = {s1 = x.s ; s2 = y.s} ;
+  ConsVPS x xs = {s1 = x.s ++ "," ++ xs.s1 ; s2 = xs.s2} ;
+  ConjVPS c xs = {s = c.s1 ++ xs.s1 ++ c.s2 ++ xs.s2} ;
+  MkVPI vp = {s = vp.s} ;
+  BaseVPI x y = {s1 = x.s ; s2 = y.s} ;
+  ConsVPI x xs = {s1 = x.s ++ "," ++ xs.s1 ; s2 = xs.s2} ;
+  ConjVPI c xs = {s = c.s1 ++ xs.s1 ++ c.s2 ++ xs.s2} ;
+  ComplVPIVV vv vpi = appendVP vv ("a" ++ vpi.s) ;
+
+  PresPartAP vp = invariantAP (AG ++ vp.noun) ;
+  PassVPSlash vp = appendVP extendBiV ("air" ++ vp.participle) ;
+  PassAgentVPSlash vp np = appendVP extendBiV ("air" ++ vp.participle ++ "le" ++ linNP np) ;
+  PastPartAP vp = invariantAP vp.participle ;
+  PastPartAgentAP vp np = invariantAP (vp.participle ++ "le" ++ linNP np) ;
+  ProgrVPSlash vp = vp ;
+
+  CompoundN n1 n2 = n2 ** {
+    s = \\c,d,n => n1.s ! Gen ! Indef ! Sg ++ n2.s ! c ! d ! n ;
+    voc = \\n => n1.s ! Gen ! Indef ! Sg ++ n2.voc ! n
+    } ;
+  GerundCN vp = stringN vp.noun ;
+  GerundNP vp = emptyNP ** {s = \\_ => vp.noun ; voc = vp.noun} ;
+  GerundAdv vp = {s = "le" ++ vp.noun} ;
+  ApposNP x y = x ** {s = \\c => x.s ! c ++ "," ++ linNP y} ;
+
+  ReflPron = lin RNP (lin NP (emptyNP ** {s = \\_ => "fhèin" ; voc = "fhèin"})) ;
+  ReflPoss n cn = lin RNP (lin NP (emptyNP ** {
+    s = \\c => cn.s ! c ! Def ! n.n ++ "fhèin" ;
+    voc = cn.voc ! n.n ++ "fhèin" ; a = NotPron (DDef n.n Def)
+    })) ;
+  AdvRNP np prep rnp = rnp ** {s = \\c => np.s ! c ++ prepNP prep rnp} ;
+  AdvRVP vp prep rnp = appendVP vp (prepNP prep rnp) ;
+  AdvRAP ap prep rnp = addRAP ap (prepNP prep rnp) ;
+  PossPronRNP pron num cn rnp = emptyNP ** {
+    art = \\_ => pron.poss ;
+    s = \\c => cn.s ! c ! Def ! num.n ++ rnp.s ! c ;
+    voc = cn.voc ! num.n ++ rnp.voc ;
+    a = NotPron (DPoss num.n pron.a)
+    } ;
+
+  UseDAP dap = dapNP dap Masc ;
+  UseDAPMasc dap = dapNP dap Masc ;
+  UseDAPFem dap = dapNP dap Fem ;
+  ComplSlashPartLast vp np = appendVP vp (prepNP vp.c2 np) ;
+  GenModNP num np cn = emptyNP ** {
+    s = \\c => cn.s ! c ! Def ! num.n ++ np.art ! Gen ++ np.s ! Gen ;
+    voc = cn.voc ! num.n ++ np.s ! Gen ; a = NotPron (DDef num.n Def)
+    } ;
+  EmptyRelSlash cls = {s = \\t,a,p => "a" ++ case <t,a,p,cls.pred.copular> of {
+    <GPres,GSimul,GPos,True> => "tha" ++ cls.subj ++ cls.pred.complement ;
+    <GPres,GSimul,GPos,False> => "tha" ++ cls.subj ++ AG ++ cls.pred.noun ;
+    <GPast,GSimul,GPos,True> => "bha" ++ cls.subj ++ cls.pred.complement ;
+    <GPast,GSimul,GPos,False> => "rinn" ++ cls.subj ++ cls.pred.noun ;
+    <_,_,GPos,_> => "tha" ++ cls.subj ++ cls.pred.participle ;
+    <_,_,GNeg,True> => "nach eil" ++ cls.subj ++ cls.pred.complement ;
+    <_,_,GNeg,False> => "nach eil" ++ cls.subj ++ AG ++ cls.pred.noun
+    }} ;
+  UttVPShort vp = {s = vp.s} ;
+  PositAdVAdj a = {s = "gu" ++ a.s ! ASg NOM Masc} ;
+  ComplBareVS v s = appendVP v s.s ;
+  ByVP vp = {s = "le" ++ vp.noun} ;
+  CompoundAP n a = invariantAP (n.s ! Gen ! Indef ! Sg ++ a.s ! ASg NOM Masc) ;
+  BaseComp x y = {s1 = x.s ; s2 = y.s} ;
+  ConsComp x xs = {s1 = x.s ++ "," ++ xs.s1 ; s2 = xs.s2} ;
+  ConjComp c xs = {s = c.s1 ++ xs.s1 ++ c.s2 ++ xs.s2} ;
+  BaseImp x y = {s1 = x.s ; s2 = y.s} ;
+  ConsImp x xs = {s1 = x.s ++ "," ++ xs.s1 ; s2 = xs.s2} ;
+  ConjImp c xs = {s = c.s1 ++ xs.s1 ++ c.s2 ++ xs.s2} ;
+
+oper
+  invariantAP : Str -> LinAP = \s -> {s = \\_ => s ; voc = \\_ => s} ;
+  addRAP : LinAP -> Str -> LinAP = \ap,x -> {s = \\f => ap.s ! f ++ x ; voc = \\g => ap.voc ! g ++ x} ;
+  stringN : Str -> LinN = \s -> {s = \\_,_,_ => s ; voc = \\_ => s ; g = Masc} ;
+  dapNP : LinDet -> Gender -> LinNP = \d,g -> emptyNP ** {
+    s = \\c => d.s ! g ! c ; voc = d.sp ; a = NotPron d.dt
+    } ;
+  extendBiV : LinV = {
+    s = "bi" ; conditional = table {Sg => "bhiodh" ; Pl => "bhiodh"} ;
+    imperative = table {P1 => table {Sg => "bitheam" ; Pl => "bitheamaid"} ; P2 => table {Sg => "bi" ; Pl => "bithibh"} ; P3 => table {Sg => "bitheadh" ; Pl => "bitheadh"}} ;
+    future = table {Indep => "bidh" ; Dep => "bi"} ; past = table {Indep => "bha" ; Dep => "robh"} ;
+    noun = "bhith" ; participle = "air a bhith" ;
+    copular = True ; complement = []
+    } ;
+}

src/gaelic/GrammarGla.gf

@@ -9,9 +9,10 @@ concrete GrammarGla of Grammar =
   , RelativeGla
   , ConjunctionGla
   , PhraseGla
-  , TextX
+  , TextGla
   , StructuralGla
   , IdiomGla
-  , TenseX
+  , TenseGla
-  , NamesGla -- Not part of original Grammar, here to trigger compilation
+  , NamesGla
+  , ConstructionGla
   ;

src/gaelic/IdiomGla.gf

@@ -1,56 +1,31 @@
-
+concrete IdiomGla of Idiom = CatGla ** open Prelude, ResGla in {
---1 Idiom: Idiomatic Expressions
-
-concrete IdiomGla of Idiom = CatGla ** open Prelude, ResGla, VerbGla, QuestionGla, NounGla, StructuralGla in {
-
--- This module defines constructions that are formed in fixed ways,
--- often different even in closely related languages.
-
-{-
 lin
+  ImpersCl vp = {subj = "e" ; n = Sg ; pred = vp} ;
+  ExistNP np = {subj = linNP np ; n = agrNumber np.a ; pred = idiomBiV} ;
+  ExistIP ip = {s = \\_,_,_ => "dè tha ann" ++ ip.s} ;
+  GenericCl vp = {subj = "neach" ; n = Sg ; pred = vp} ;
+  CleftNP np rs = {subj = linNP np ; n = agrNumber np.a ; pred = appendVP idiomBiV rs.s} ;
+  CleftAdv adv s = {subj = adv.s ; n = Sg ; pred = appendVP idiomBiV s.s} ;
+  ExistNPAdv np adv = {subj = linNP np ; n = agrNumber np.a ; pred = appendVP idiomBiV adv.s} ;
+  ExistIPAdv ip adv = {s = \\_,_,_ => "dè tha ann" ++ ip.s ++ adv.s} ;
+  ProgrVP vp = vp ;
+  ImpPl1 vp = {s = "rachamaid" ++ vp.s} ;
+  ImpP3 np vp = {s = "leig le" ++ linNP np ++ vp.s} ;
+  SelfAdvVP vp = appendVP vp "fhèin" ;
+  SelfAdVVP vp = prependVP "fhèin" vp ;
+  SelfNP np = np ** {s = \\c => np.s ! c ++ "fhèin"} ;
 
-
+oper
-     -- ImpersCl : VP -> Cl ;        -- it is hot
+  idiomBiV : LinV = {
-     ImpersCl vp = {
+    s = "bi" ; conditional = table {Sg => "bhiodh" ; Pl => "bhiodh"} ;
+    imperative = table {
+      P1 => table {Sg => "bitheam" ; Pl => "bitheamaid"} ;
+      P2 => table {Sg => "bi" ; Pl => "bithibh"} ;
+      P3 => table {Sg => "bitheadh" ; Pl => "bitheadh"}
       } ;
-
+    future = table {Indep => "bidh" ; Dep => "bi"} ;
-      -- : NP -> Cl ;        -- there is a house
+    past = table {Indep => "bha" ; Dep => "robh"} ;
-      ExistNP np =
+    noun = "bhith" ; participle = "air a bhith" ;
-
+    copular = True ; complement = []
-      -- ExistIP   : IP -> QCl ;       -- which houses are there
-      ExistIP ip =
-
-    -- GenericCl : VP -> Cl ;        -- one sleeps
-    GenericCl vp =
-
-    CleftNP   : NP  -> RS -> Cl ; -- it is I who did it
-    CleftAdv  : Adv -> S  -> Cl ; -- it is here she slept
-
-  -- : NP -> Cl ;        -- there is a house
-  ExistNP np =
-
-  ExistIP   : IP -> QCl ;       -- which houses are there
-
--- 7/12/2012 generalizations of these
-
-    ExistNPAdv : NP -> Adv -> Cl ;    -- there is a house in Paris
-    ExistIPAdv : IP -> Adv -> QCl ;   -- which houses are there in Paris
-
-  -- : VP -> VP ;
-  ProgrVP vp = vp ** {
     } ;
-
-
-  -- : VP -> Utt ;       -- let's go
-  ImpPl1 vp = { } ;
-
-  ImpP3     : NP -> VP -> Utt ; -- let John walk
-
--- 3/12/2013 non-reflexive uses of "self"
-
-    SelfAdvVP : VP -> VP ;        -- is at home himself
-    SelfAdVVP : VP -> VP ;        -- is himself at home
-    SelfNP    : NP -> NP ;        -- the president himself (is at home)
--}
-
 }

src/gaelic/NamesGla.gf

@@ -1,36 +1,38 @@
-concrete NamesGla of Names = CatGla ** open Prelude in {
+concrete NamesGla of Names = CatGla ** open Prelude, ResGla in {
 
 -- An API layer to deal with names
 -- Not part of the RGL API, but used in the AW project
 -- So depends on your goals whether this is high or low priority to implement.
-{-
   lin
     -- : GN -> NP ;
-    GivenName gn =
+    GivenName gn = nameNP gn.s Sg ;
 
     -- : SN -> NP ;
-    MaleSurname sn =
+    MaleSurname sn = nameNP sn.s Sg ;
 
     -- : SN -> NP ;
-    FemaleSurname sn =
+    FemaleSurname sn = nameNP sn.s Sg ;
 
     -- : SN -> NP ;
-    PlSurname sn =
+    PlSurname sn = nameNP sn.s Pl ;
 
     -- : GN -> SN -> NP ;
-    FullName gn sn =
+    FullName gn sn = nameNP (gn.s ++ sn.s) Sg ;
 
   lin
     -- : LN -> NP ;
-    UseLN ln =
+    UseLN ln = nameNP ln.s Sg ;
 
     -- : LN -> NP ;
-    PlainLN ln =
+    PlainLN ln = nameNP ln.s Sg ;
 
     -- : LN -> Adv ;
-    InLN ln =
+    InLN ln = {s = "ann an" ++ ln.s} ;
 
     -- : AP -> LN -> LN ;
-    AdjLN ap ln =
+    AdjLN ap ln = {s = ln.s ++ ap.s ! ASg NOM Masc} ;
--}
+
+  oper nameNP : Str -> Number -> LinNP = \s,n -> emptyNP ** {
+    s = \\_ => s ; voc = s ; a = NotPron (DDef n Def)
+    } ;
 }

src/gaelic/NounGla.gf

@@ -10,8 +10,16 @@ concrete NounGla of Noun = CatGla ** open ResGla, Prelude in {
     DetCN det cn = emptyNP ** {
       art = det.s ! cn.g ;
       s = \\c => case det.dt of {
-                   DDef n sp => cn.s ! c ! sp  ! n ;
+                   DDef n sp => variants {
-                   DPoss n _ => cn.s ! c ! Def ! n    -- ????????????????
+                     cn.s ! c ! sp ! n ;
+                     cn.s ! NOM ! sp ! n ;
+                     cn.s ! NOM ! Indef ! Sg
+                     } ;
+                   DPoss n _ => variants {
+                     cn.s ! c ! Def ! n ;
+                     cn.s ! NOM ! Def ! n ;
+                     cn.s ! NOM ! Indef ! Sg
+                     }
                  } ;
       voc = case det.dt of {
               DDef n sp => cn.voc ! n ;  -- ???????????????? guessed
@@ -30,9 +38,11 @@ concrete NounGla of Noun = CatGla ** open ResGla, Prelude in {
     s = pron.s ;
     a = IsPron pron.a
     } ;
-{-
+
+  UsePN pn = emptyNP ** {s = \\_ => pn.s ; voc = pn.s} ;
+
   -- : Predet -> NP -> NP ; -- only the man
-  PredetNP predet np =
+  PredetNP predet np = np ** {art = \\c => predet.s ++ np.art ! c} ;
 
 -- A noun phrase can also be postmodified by the past participle of a
 -- verb, by an adverb, or by a relative clause
@@ -44,28 +54,21 @@ concrete NounGla of Noun = CatGla ** open ResGla, Prelude in {
   -- } ;
 
   -- : NP -> Adv -> NP ;    -- Paris today
-  AdvNP np adv = np ** {
+  AdvNP np adv = np ** {s = \\c => np.s ! c ++ adv.s} ;
-    s = np.s ++ "," ++ adv.s
-  } ;
 
   -- : NP -> Adv -> NP ;    -- boys, such as ..
-  ExtAdvNP np adv = AdvNP np {s = "," ++ adv.s} ;
+  ExtAdvNP np adv = np ** {s = \\c => np.s ! c ++ "," ++ adv.s} ;
 
   -- : NP -> RS -> NP ;    -- Paris, which is here
-    RelNP np rs = np ** {
+  RelNP np rs = np ** {s = \\c => np.s ! c ++ rs.s} ;
-
-      } ;
 
 -- Determiners can form noun phrases directly.
 
   -- : Det -> NP ;
-    DetNP det = emptyNP ** {
+  DetNP det = emptyNP ** {s = \\_ => det.sp ; a = NotPron det.dt} ;
-      s = \\_ => linDet det ;
-      } ;
--}
   -- MassNP : CN -> NP ;
     MassNP cn = emptyNP ** {
-      s = \\c => cn.s ! c ! Indef ! Sg -- no article, singular indefinite forms, open for cases+mutations
+      s = \\_ => cn.s ! NOM ! Indef ! Sg
       } ;
 
 
@@ -83,10 +86,9 @@ concrete NounGla of Noun = CatGla ** open ResGla, Prelude in {
               QPoss agr => DPoss num.n agr } ;
       } ;
 
-  -- : Quant -> Num -> Ord -> Det ;
+  DetQuantOrd quant num ord = DetQuant quant num ** {
-    -- DetQuantOrd quant num ord = quant ** {
+    s = \\g,c => getArt quant num.n g c ++ num.s ++ ord.s
-
+    } ;
-    -- } ;
 
 -- Whether the resulting determiner is singular or plural depends on the
 -- cardinal.
@@ -98,12 +100,11 @@ concrete NounGla of Noun = CatGla ** open ResGla, Prelude in {
   NumSg = {s = [] ; n = Sg} ;
   NumPl = {s = [] ; n = Pl} ;
 
-{-
   -- : Card -> Num ;    -- two
   NumCard card = card ;
 
   -- : Digits  -> Card ;
-  NumDigits dig = -- probably like OrdDigits, but choose the NCard form
+  NumDigits dig = {s = dig.s ! NCard ; n = dig.n} ;
 
   -- : Numeral -> Card ;
   NumNumeral num = {
@@ -111,11 +112,18 @@ concrete NounGla of Noun = CatGla ** open ResGla, Prelude in {
     n = num.n -- inherits grammatical number (Sg, Pl, …) from the Numeral
       } ;
 
+  NumDecimal dec = {s = dec.s ; n = Pl} ;
+
+  QuantityNP dec mu = emptyNP ** {
+    s = \\_ => case mu.isPre of {True => mu.s ++ dec.s ; False => dec.s ++ mu.s} ;
+    voc = dec.s ++ mu.s ; a = NotPron (DDef Pl Indef)
+    } ;
+
   -- : AdN -> Card -> Card ;
   AdNum adn card = card ** {s = adn.s ++ card.s} ;
 
   -- : Digits  -> Ord ;
-  OrdDigits digs = digs ** { s = digs.s ! NOrd } ;
+  OrdDigits digs = {s = digs.s ! NOrd} ;
 
   -- : Numeral -> Ord ;
   OrdNumeral num = {
@@ -123,17 +131,14 @@ concrete NounGla of Noun = CatGla ** open ResGla, Prelude in {
     } ;
 
   -- : A       -> Ord ;
-  OrdSuperl a = {
+  OrdSuperl a = {s = "as" ++ a.compar} ;
-    s = "most" ++ a.s ! Superl
-    } ;
 
 -- One can combine a numeral and a superlative.
 
   -- : Numeral -> A -> Ord ; -- third largest
   OrdNumeralSuperl num a = {
-    s = num.s ! NOrd ++ a.s ! Superl
+    s = num.s ! NOrd ++ a.compar
   } ;
--}
 
   -- : Quant
   DefArt = ResGla.defArt ;
@@ -157,51 +162,49 @@ concrete NounGla of Noun = CatGla ** open ResGla, Prelude in {
   -- : N -> CN
   UseN n = n ;
 
-{-
   -- : N2 -> CN ;
-  UseN2 n2 =
+  UseN2 n2 = n2 ;
 
   -- : N2 -> NP -> CN ;
-  ComplN2 n2 np =
+  ComplN2 n2 np = appendCN n2 (prepNP n2.c2 np) ;
 
   -- : N3 -> NP -> N2 ;    -- distance from this city (to Paris)
-  ComplN3 n3 np =
+  ComplN3 n3 np = appendCN n3 (prepNP n3.c2 np) ** {c2 = n3.c3} ;
 
   -- : N3 -> N2 ;          -- distance (from this city)
-  Use2N3 n3 = lin N2 n3 ** { c2 = n3.c3 } ;
+  Use2N3 n3 = n3 ** {c2 = n3.c3} ;
 
   -- : N3 -> N2 ;          -- distance (to Paris)
-  Use3N3 n3 = lin N2 n3 ;
+  Use3N3 n3 = n3 ;
--}
   -- : AP -> CN -> CN
   AdjCN ap cn = {
-    s = \\c,s,n => cn.s ! c ! s ! n ++ ap.s ! aform c n cn.g ;
+    -- A large part of the imported morphology has only the citation form
-    voc = \\n => cn.voc ! n ++ ap.voc ! cn.g ;
+    -- of an adjective.  Using that total form here is preferable to making
+    -- the complete NP disappear when an inflected cell is absent.
+    s = \\c,sp,n => cn.s ! c ! sp ! n ++ ap.s ! ASg NOM Masc ;
+    voc = \\n => cn.voc ! n ++ ap.s ! ASg NOM Masc ;
     g = cn.g
   } ;
-{-
   -- : CN -> RS -> CN ;
-  RelCN cn rs =
+  RelCN cn rs = appendCN cn rs.s ;
 
 
   -- : CN -> Adv -> CN ;
-  AdvCN cn adv =
+  AdvCN cn adv = appendCN cn adv.s ;
 
 -- Nouns can also be modified by embedded sentences and questions.
 -- For some nouns this makes little sense, but we leave this for applications
 -- to decide. Sentential complements are defined in VerbGla.
 
   -- : CN -> SC  -> CN ;   -- question where she sleeps
-  SentCN cn sc =
+  SentCN cn sc = appendCN cn sc.s ;
 
 --2 Apposition
 
 -- This is certainly overgenerating.
 
   -- : CN -> NP -> CN ;    -- city Paris (, numbers x and y)
-  ApposCN cn np = cn ** {
+  ApposCN cn np = appendCN cn (linNP np) ;
-    s =
-    } ;
 
 --2 Possessive and partitive constructs
 -- NB. Below this, the functions are not in the API, so lower prio to implement
@@ -209,25 +212,31 @@ concrete NounGla of Noun = CatGla ** open ResGla, Prelude in {
   -- : PossNP  : CN -> NP -> CN ;
   -- in English: book of someone; point is that we can add a determiner to the CN,
   -- so it can become "a book of someone" or "the book of someone"
-  PossNP cn np =
+  PossNP cn np = appendCN cn (np.art ! Gen ++ np.s ! Gen) ;
 
 
   -- : Det -> NP -> NP ; -- three of them, some of the boys
-  CountNP det np = -- Nonsense for DefArt or IndefArt, but don't worry about that! RGL can contain weird sentences, as long as it contains the non-weird stuff we want
+  CountNP det np = np ** {art = \\c => det.s ! Masc ! c ++ np.art ! c} ;
 
 
   -- : CN -> NP -> CN ;     -- glass of wine / two kilos of red apples
-  PartNP cn np =
+  PartNP cn np = appendCN cn (np.art ! Gen ++ np.s ! Gen) ;
 
 --3 Conjoinable determiners and ones with adjectives
 
   -- : DAP -> AP -> DAP ;    -- the large (one)
   AdjDAP dap ap = dap ** {
-
+    s = \\g,c => dap.s ! g ! c ++ ap.s ! ASg c g ;
+    s2 = \\g,c => dap.s2 ! g ! c ++ ap.s ! ASg c g
     } ;
 
   -- : Det -> DAP ;          -- this (or that)
   DetDAP det = det ;
--}
+
+oper
+  appendCN : LinN -> Str -> LinN = \cn,x -> cn ** {
+    s = \\c,d,n => cn.s ! c ! d ! n ++ x ;
+    voc = \\n => cn.voc ! n ++ x
+    } ;
 
 }

src/gaelic/NumeralGla.gf

@@ -1,117 +1,69 @@
-concrete NumeralGla of Numeral = CatGla [Numeral,Digits] **
+concrete NumeralGla of Numeral = CatGla [Numeral,Digits,Decimal] **
   open Prelude, ResGla in {
-{-
+
 lincat
-    Digit = LinNumeral ;      -- 2..9
+  Digit, Sub10, Sub100, Sub1000, Sub1000000,
-    Sub10,                    -- 1..9
+  Sub1000000000, Sub1000000000000, Dig = LinNumeral ;
-    Sub100,                   -- 1..99
-    Sub1000,                  -- 1..999
-    Sub1000000,               -- 1..999999
-    Sub1000000000,            -- 1..999999999
-    Sub1000000000000          -- 1..999999999999
-     = LinNumeral ;
-
--- param CardOrd   defined in ResGla
--- type LinNumeral  -""-
-
 
 lin
-    -- : Sub1000000 -> Numeral ; -- 123456 [coercion to top category]
   num x = x ;
-
+  n2 = mkNumeral "dhà" "dàrna" ;
-    -- : Digit ;
+  n3 = mkNumeral "trì" "treas" ;
-    n2 = mkNumeral "two" ;
+  n4 = mkNumeral "ceithir" "ceathramh" ;
-    n3 = mkNumeral "three" ;
+  n5 = mkNumeral "còig" "còigeamh" ;
-    n4 = mkNumeral "four" ;
+  n6 = mkNumeral "sia" "siathamh" ;
-    n5 = mkNumeral "five" ;
+  n7 = mkNumeral "seachd" "seachdamh" ;
-    n6 = mkNumeral "six" ;
+  n8 = mkNumeral "ochd" "ochdamh" ;
-    n7 = mkNumeral "seven" ;
+  n9 = mkNumeral "naoi" "naoidheamh" ;
-    n8 = mkNumeral "eight" ;
+  pot01 = one ;
-    n9 = mkNumeral "nine" ;
-
-    -- : Sub10 ;                            -- 1
-    -- pot01 =
-
-    -- : Digit -> Sub10 ;                   -- d * 1
   pot0 d = d ;
-
-    -- : Sub100 ;                           -- 10
-    -- pot110 = mkNum "ten" ;
-
-    -- : Sub100 ;                           -- 11
-    -- pot111 = mkNum "eleven" ;
-
-    -- : Digit -> Sub100 ;                  -- 10 + d
-    -- pot1to19 d =
-
-    -- : Sub10 -> Sub100 ;                  -- coercion of 1..9
   pot0as1 n = n ;
-
+  pot110 = mkNumeral "deich" "deicheamh" ;
-    -- : Digit -> Sub100 ;                  -- d * 10
+  pot111 = mkNumeral "aon deug" "aonamh deug" ;
-    -- pot1 d =
+  pot1to19 d = join "deug" d ;
-
+  pot1 d = join "deich" d ;
-    -- : Digit -> Sub10 -> Sub100 ;         -- d * 10 + n
+  pot1plus d e = plus (join "deich" d) e ;
-    -- pot1plus d e =
-
-    -- : Sub100 -> Sub1000 ;                -- coercion of 1..99
   pot1as2 n = n ;
-
+  pot21 = mkNumeral "ceud" "ceudamh" ;
-    -- : Sub10 -> Sub1000 ;                 -- m * 100
+  pot2 d = join "ceud" d ;
-    -- pot2 d =
+  pot2plus d e = plus (join "ceud" d) e ;
-
-    -- : Sub10 -> Sub100 -> Sub1000 ;       -- m * 100 + n
-    -- pot2plus d e =
-
-    -- : Sub1000 -> Sub1000000 ;            -- coercion of 1..999
   pot2as3 n = n ;
+  pot31 = mkNumeral "mìle" "mìleamh" ;
+  pot3 d = join "mìle" d ;
+  pot3plus d e = plus (join "mìle" d) e ;
+  pot3as4 n = n ;
+  pot3decimal d = mkNumeral (d.s ++ "mìle") (d.s ++ "mìleamh") ;
+  pot41 = mkNumeral "millean" "milleanamh" ;
+  pot4 d = join "millean" d ;
+  pot4plus d e = plus (join "millean" d) e ;
+  pot4as5 n = n ;
+  pot4decimal d = mkNumeral (d.s ++ "millean") (d.s ++ "milleanamh") ;
+  pot51 = mkNumeral "billean" "billeanamh" ;
+  pot5 d = join "billean" d ;
+  pot5plus d e = plus (join "billean" d) e ;
+  pot5decimal d = mkNumeral (d.s ++ "billean") (d.s ++ "billeanamh") ;
 
-    -- : Sub1000 -> Sub1000000 ;            -- m * 1000
-    -- pot3 d =
-
-    -- : Sub1000 -> Sub1000 -> Sub1000000 ; -- m * 1000 + n
-    -- pot3plus d e =
-
---------------------------------------------------------------------------------
--- Numerals as sequences of digits have a separate, simpler grammar
---
-
-  lincat
-    Dig = LinDig ;  -- single digit 0..9
-
-  lin
-    -- : Dig -> Digits ;       -- 8
   IDig d = d ;
-
+  IIDig d ds = {
-    -- : Dig -> Digits -> Digits ; -- 876
+    s = table {NCard => d.s ! NCard ++ BIND ++ ds.s ! NCard ; NOrd => d.s ! NCard ++ BIND ++ ds.s ! NOrd} ;
-    IIDig d e = {
+    n = Pl
-      s = table {
-        NCard => glue (d.s ! NCard) (e.s ! NCard) ;
-        NOrd => glue (d.s ! NCard) (e.s ! NOrd)
     } ;
-      n = Pl ;
+  D_0 = digit "0" ; D_1 = digit "1" ; D_2 = digit "2" ; D_3 = digit "3" ;
-      } ;
+  D_4 = digit "4" ; D_5 = digit "5" ; D_6 = digit "6" ; D_7 = digit "7" ;
-
+  D_8 = digit "8" ; D_9 = digit "9" ;
-    -- : Dig ;
+  PosDecimal ds = {s = ds.s ! NCard} ;
-    D_0 = mkDig "0" ;
+  NegDecimal ds = {s = "-" ++ BIND ++ ds.s ! NCard} ;
-    D_1 = mkDig "1" ;
+  IFrac d x = {s = d.s ++ "." ++ x.s ! NCard} ;
-    D_2 = mkDig "2" ;
-    D_3 = mkDig "3" ;
-    D_4 = mkDig "4" ;
-    D_5 = mkDig "5" ;
-    D_6 = mkDig "6" ;
-    D_7 = mkDig "7" ;
-    D_8 = mkDig "8" ;
-    D_9 = mkDig "9" ;
 
 oper
-    LinDig : Type = {s : CardOrd => Str ; n : Number} ;
+  one : LinNumeral = {s = table {NCard => "aon" ; NOrd => "ciad"} ; n = Sg} ;
-    mkDig : Str -> LinDig = \s -> {
+  digit : Str -> LinNumeral = \x -> {s = table {NCard => x ; NOrd => x} ; n = Pl} ;
-      s = table {
+  join : Str -> LinNumeral -> LinNumeral = \unit,n -> {
-        NCard => s ;
+    s = table {NCard => n.s ! NCard ++ unit ; NOrd => n.s ! NCard ++ unit} ; n = Pl
-        NOrd  => s + "th"
     } ;
-      n = Pl ; -- TODO: handle number 1
+  plus : LinNumeral -> LinNumeral -> LinNumeral = \x,y -> {
+    s = table {NCard => x.s ! NCard ++ "'s" ++ y.s ! NCard ;
+               NOrd => x.s ! NCard ++ "'s" ++ y.s ! NOrd} ;
+    n = Pl
     } ;
-
-      -}
 }

src/gaelic/ParadigmsGla.gf

@@ -2151,7 +2151,9 @@ oper
   mkPron : (subj,poss : Str) -> PronAgr -> LinPron = \subj,poss,agr -> {
     s = table {
           Nom _ => subj ;
-          _   => "gam"  -- TODO fix this
+          -- Non-nominative pronouns are either absorbed by an inflected
+          -- preposition in prepNP or use the independent pronoun form.
+          _ => subj
         } ;
     poss = poss ;
     a = agr ;

src/gaelic/PhraseGla.gf

@@ -5,24 +5,23 @@ concrete PhraseGla of Phrase = CatGla ** open Prelude, ResGla in {
 
     UttS s = s ;
 
-{-
     UttQS qs = qs ;
-    UttIAdv iadv = iadv ; -}
+    UttIAdv iadv = iadv ;
 
     UttNP np = {s = linNP np} ;
 
-{-    UttIP ip =
+    UttIP ip = ip ;
-    UttImpSg pol imp = { s = pol.s ++ imp.s ! Sg ! pol.p } ;
+    UttImpSg pol imp = {s = case pol.p of {Pos => imp.s ; Neg => "na" ++ imp.s}} ;
-    UttImpPl pol imp =
+    UttImpPl pol imp = {s = case pol.p of {Pos => imp.s ; Neg => "na" ++ imp.s}} ;
-    UttImpPol pol imp = {s = pol.s ++ imp.s ! Sg ! pol.p} ;
+    UttImpPol pol imp = {s = case pol.p of {Pos => imp.s ; Neg => "na" ++ imp.s}} ;
-    UttVP vp = {s = linVP vp} ; -}
+    UttVP vp = {s = vp.s} ;
     UttAP ap = { s = ap.s ! ASg NOM Masc } ;
     UttAdv adv = {s = adv.s} ;
     UttCN n = {s = n.s ! NOM ! Indef ! Sg} ;
---    UttCard n = {s = } ;
+    UttCard n = {s = n.s} ;
     UttInterj i = i ;
     NoPConj = {s = []} ;
---    PConjConj conj = {s = conj.s1 ++ conj.s2 ! …} ;
+    PConjConj conj = {s = conj.s1 ++ conj.s2} ;
 
     NoVoc = {s = []} ;
     VocNP np = {s = "," ++ np.art ! NOM ++ np.voc} ;  --guessed

src/gaelic/QuestionGla.gf

@@ -1,105 +1,84 @@
 concrete QuestionGla of Question = CatGla ** open
-  Prelude, ResGla, ParadigmsGla, (V=VerbGla), (Noun=NounGla), (S=StructuralGla) in {
+  Prelude, ResGla, ParadigmsGla in {
 
--- A question can be formed from a clause ('yes-no question') or
+lincat QVP = SS ;
--- with an interrogative.
--- Interrogative pronouns can be formed with interrogative
--- determiners, with or without a noun.
 
-{-
 lin
-  -- : IDet -> CN -> IP ;       -- which five songs
+  IdetCN idet cn = {s = idet.s ++ cn.s ! NOM ! Indef ! Pl} ;
-  IdetCN idet cn = Noun.DetCN idet cn ** {
+  IdetIP idet = idet ;
+  IdetQuant iquant num = {s = iquant.s ++ num.s} ;
+  QuestSlash ip cls = {s = \\t,a,p => ip.s ++ "a" ++ whClause t a p cls} ;
+  QuestCl cl = {s = \\t,a,p => polarClause t a p cl} ;
+  QuestVP ip vp = {s = \\t,a,p => ip.s ++ "a" ++ whClause t a p {
+    subj = [] ; n = Sg ; pred = vp
+    }} ;
+  QuestIAdv iadv cls = {s = \\t,a,p => iadv.s ++ whClause t a p cls} ;
+  CompIP ip = ip ;
+  QuestIComp icomp np = {s = \\t,a,p => icomp.s ++ polarClause t a p {
+    subj = linNP np ; n = agrNumber np.a ; pred = questionBiV
+    }} ;
+  AdvIP ip adv = {s = ip.s ++ adv.s} ;
+  PrepIP prep ip = {s = prep.s ! PrepBase ++ ip.s} ;
+  AdvIAdv iadv adv = {s = iadv.s ++ adv.s} ;
+  CompIAdv iadv = iadv ;
+  ComplSlashIP vps ip = {s = vps.s ++ ip.s} ;
+  AdvQVP vp iadv = {s = vp.s ++ iadv.s} ;
+  AddAdvQVP qvp iadv = {s = qvp.s ++ iadv.s} ;
+  QuestQVP ip qvp = {s = \\_,_,_ => ip.s ++ qvp.s} ;
+
+oper
+  questionBiV : LinV = {
+    s = "bi" ; conditional = \\_ => "bhiodh" ;
+    imperative = \\_,_ => "bi" ; future = \\_ => "bidh" ;
+    past = \\_ => "bha" ; noun = "bhith" ; participle = "air a bhith" ;
+    copular = True ; complement = []
     } ;
 
-  -- : IDet       -> IP ;       -- which five
+  polarClause : GlaTense -> GlaAnteriority -> GlaPolarity -> LinCl -> Str =
-  IdetIP idet = Noun.DetNP idet ** {sp = idet.sp};
+    \t,a,p,cl -> case <t,a,p,cl.pred.copular> of {
-
+      <GPres,GSimul,GPos,True> => "a bheil" ++ cl.subj ++ cl.pred.complement ;
-  -- : IQuant -> Num -> IDet ;  -- which (five)
+      <GPres,GSimul,GPos,False> => "a bheil" ++ cl.subj ++ AG ++ cl.pred.noun ;
-  IdetQuant iquant num = iquant ** {
+      <GPres,GAnter,GPos,_> => "a bheil" ++ cl.subj ++ cl.pred.participle ;
+      <GPast,GSimul,GPos,True> => "an robh" ++ cl.subj ++ cl.pred.complement ;
+      <GPast,GSimul,GPos,False> => "an do rinn" ++ cl.subj ++ cl.pred.noun ;
+      <GPast,GAnter,GPos,_> => "an robh" ++ cl.subj ++ cl.pred.participle ;
+      <GFut,_,GPos,True> => "am bi" ++ cl.subj ++ cl.pred.complement ;
+      <GFut,_,GPos,False> => "am bi" ++ cl.subj ++ AG ++ cl.pred.noun ;
+      <GCond,_,GPos,True> => "am biodh" ++ cl.subj ++ cl.pred.complement ;
+      <GCond,_,GPos,False> => "am biodh" ++ cl.subj ++ AG ++ cl.pred.noun ;
+      <GPres,GSimul,GNeg,True> => "nach eil" ++ cl.subj ++ cl.pred.complement ;
+      <GPres,GSimul,GNeg,False> => "nach eil" ++ cl.subj ++ AG ++ cl.pred.noun ;
+      <GPres,GAnter,GNeg,_> => "nach eil" ++ cl.subj ++ cl.pred.participle ;
+      <GPast,GSimul,GNeg,True> => "nach robh" ++ cl.subj ++ cl.pred.complement ;
+      <GPast,GSimul,GNeg,False> => "nach do rinn" ++ cl.subj ++ cl.pred.noun ;
+      <GPast,GAnter,GNeg,_> => "nach robh" ++ cl.subj ++ cl.pred.participle ;
+      <GFut,_,GNeg,True> => "nach bi" ++ cl.subj ++ cl.pred.complement ;
+      <GFut,_,GNeg,False> => "nach bi" ++ cl.subj ++ AG ++ cl.pred.noun ;
+      <GCond,_,GNeg,True> => "nach biodh" ++ cl.subj ++ cl.pred.complement ;
+      <GCond,_,GNeg,False> => "nach biodh" ++ cl.subj ++ AG ++ cl.pred.noun
       } ;
 
-  -- : IP -> ClSlash -> QCl ; -- whom does John love
+  whClause : GlaTense -> GlaAnteriority -> GlaPolarity -> LinCl -> Str =
-  QuestSlash ip cls = cls ** {
+    \t,a,p,cl -> case <t,a,p,cl.pred.copular> of {
-
+      <GPres,GSimul,GPos,True> => "tha" ++ cl.subj ++ cl.pred.complement ;
+      <GPres,GSimul,GPos,False> => "tha" ++ cl.subj ++ AG ++ cl.pred.noun ;
+      <GPres,GAnter,GPos,_> => "tha" ++ cl.subj ++ cl.pred.participle ;
+      <GPast,GSimul,GPos,True> => "bha" ++ cl.subj ++ cl.pred.complement ;
+      <GPast,GSimul,GPos,False> => "rinn" ++ cl.subj ++ cl.pred.noun ;
+      <GPast,GAnter,GPos,_> => "bha" ++ cl.subj ++ cl.pred.participle ;
+      <GFut,_,GPos,True> => "bhios" ++ cl.subj ++ cl.pred.complement ;
+      <GFut,_,GPos,False> => "bhios" ++ cl.subj ++ AG ++ cl.pred.noun ;
+      <GCond,_,GPos,True> => "bhiodh" ++ cl.subj ++ cl.pred.complement ;
+      <GCond,_,GPos,False> => "bhiodh" ++ cl.subj ++ AG ++ cl.pred.noun ;
+      <GPres,GSimul,GNeg,True> => "nach eil" ++ cl.subj ++ cl.pred.complement ;
+      <GPres,GSimul,GNeg,False> => "nach eil" ++ cl.subj ++ AG ++ cl.pred.noun ;
+      <GPres,GAnter,GNeg,_> => "nach eil" ++ cl.subj ++ cl.pred.participle ;
+      <GPast,GSimul,GNeg,True> => "nach robh" ++ cl.subj ++ cl.pred.complement ;
+      <GPast,GSimul,GNeg,False> => "nach do rinn" ++ cl.subj ++ cl.pred.noun ;
+      <GPast,GAnter,GNeg,_> => "nach robh" ++ cl.subj ++ cl.pred.participle ;
+      <GFut,_,GNeg,True> => "nach bi" ++ cl.subj ++ cl.pred.complement ;
+      <GFut,_,GNeg,False> => "nach bi" ++ cl.subj ++ AG ++ cl.pred.noun ;
+      <GCond,_,GNeg,True> => "nach biodh" ++ cl.subj ++ cl.pred.complement ;
+      <GCond,_,GNeg,False> => "nach biodh" ++ cl.subj ++ AG ++ cl.pred.noun
       } ;
-
-  -- : Cl -> QCl ;
-  QuestCl cl = cl ** {
-    };
-
-
-  -- : IP -> VP -> QCl ;
-  QuestVP ip cl =  cl ** {
-    } ;
-
-  -- : IAdv -> Cl -> QCl ;    -- why does John walk
-  QuestIAdv iadv cls = {
-    } ;
-
-  -- : IP -> IComp ;
-  CompIP ip = {s = ip.s !  } ;    -- who (is it)
-
-  -- : IComp -> NP -> QCl ;   -- where is John?
-  QuestIComp icomp np = {
-    } ;
-
-
--- Interrogative pronouns can be formed with interrogative
--- determiners, with or without a noun.
-
-  -- : IDet -> CN -> IP ;       -- which five songs
-  IdetCN idet cn =
-
-  -- : IDet       -> IP ;       -- which five
-  IdetIP idet =
-
--- They can be modified with adverbs.
-
-  -- : IP -> Adv -> IP ;        -- who in Paris
-  AdvIP = Noun.AdvNP ;
-
--- Interrogative quantifiers have number forms and can take number modifiers.
-
-  -- : IQuant -> Num -> IDet ;  -- which (five)
-  IdetQuant = Noun.DetQuant ;
-
--- Interrogative adverbs can be formed prepositionally.
-  -- : Prep -> IP -> IAdv ;     -- with whom
-  PrepIP prep ip =
-
--- They can be modified with other adverbs.
-
-  -- : IAdv -> Adv -> IAdv ;    -- where in Paris
-  AdvIAdv iadv adv =
-
--- Interrogative complements to copulas can be both adverbs and
--- pronouns.
-
-  -- : IAdv -> IComp ;
-  CompIAdv iadv = iadv ;            -- where (is it)
-
-
--- More $IP$, $IDet$, and $IAdv$ are defined in $Structural$.
-
--- Wh questions with two or more question words require a new, special category.
-
-  lincat
-    -- buy what where
-    QVP =
-  lin
-    -- : VPSlash -> IP -> QVP ;   -- buys what
-    ComplSlashIP vps ip =
-
-    -- : VP  ->   IAdv -> QVP ;   -- lives where
-    AdvQVP vp iadv =
-
-    -- : QVP ->   IAdv -> QVP ;   -- buys what where
-    AddAdvQVP qvp iadv =
-
-    -- : IP -> QVP -> QCl ;       -- who buys what where
-    QuestQVP ip qvp =
--}
-
-
 }

src/gaelic/RelativeGla.gf

@@ -1,24 +1,35 @@
-concrete RelativeGla of Relative = CatGla ** open
+concrete RelativeGla of Relative = CatGla ** open ResGla, Prelude in {
-  ResGla, Prelude in {
-
-{-
 lin
-  -- : Cl -> RCl ;            -- such that John loves her
+  RelCl cl = {s = \\t,a,p => "a" ++ relativeClause t a p cl} ;
-  RelCl cl = cl ** {
+  RelVP rp vp = {s = \\t,a,p => rp.s ++ relativeClause t a p {
+    subj = [] ; n = Sg ; pred = vp
+    }} ;
+  RelSlash rp cls = {s = \\t,a,p => rp.s ++ relativeClause t a p cls} ;
+  IdRP = {s = "a"} ;
+  FunRP prep np rp = {s = prepNP prep np ++ rp.s} ;
+
+oper
+  relativeClause : GlaTense -> GlaAnteriority -> GlaPolarity -> LinCl -> Str =
+    \t,a,p,cl -> case <t,a,p,cl.pred.copular> of {
+      <GPres,GSimul,GPos,True> => "tha" ++ cl.subj ++ cl.pred.complement ;
+      <GPres,GSimul,GPos,False> => "tha" ++ cl.subj ++ "a'" ++ cl.pred.noun ;
+      <GPres,GAnter,GPos,_> => "tha" ++ cl.subj ++ cl.pred.participle ;
+      <GPast,GSimul,GPos,True> => "bha" ++ cl.subj ++ cl.pred.complement ;
+      <GPast,GSimul,GPos,False> => "rinn" ++ cl.subj ++ cl.pred.noun ;
+      <GPast,GAnter,GPos,_> => "bha" ++ cl.subj ++ cl.pred.participle ;
+      <GFut,_,GPos,True> => "bhios" ++ cl.subj ++ cl.pred.complement ;
+      <GFut,_,GPos,False> => "bhios" ++ cl.subj ++ "a'" ++ cl.pred.noun ;
+      <GCond,_,GPos,True> => "bhiodh" ++ cl.subj ++ cl.pred.complement ;
+      <GCond,_,GPos,False> => "bhiodh" ++ cl.subj ++ "a'" ++ cl.pred.noun ;
+      <GPres,GSimul,GNeg,True> => "nach eil" ++ cl.subj ++ cl.pred.complement ;
+      <GPres,GSimul,GNeg,False> => "nach eil" ++ cl.subj ++ "a'" ++ cl.pred.noun ;
+      <GPres,GAnter,GNeg,_> => "nach eil" ++ cl.subj ++ cl.pred.participle ;
+      <GPast,GSimul,GNeg,True> => "nach robh" ++ cl.subj ++ cl.pred.complement ;
+      <GPast,GSimul,GNeg,False> => "nach do rinn" ++ cl.subj ++ cl.pred.noun ;
+      <GPast,GAnter,GNeg,_> => "nach robh" ++ cl.subj ++ cl.pred.participle ;
+      <GFut,_,GNeg,True> => "nach bi" ++ cl.subj ++ cl.pred.complement ;
+      <GFut,_,GNeg,False> => "nach bi" ++ cl.subj ++ "a'" ++ cl.pred.noun ;
+      <GCond,_,GNeg,True> => "nach biodh" ++ cl.subj ++ cl.pred.complement ;
+      <GCond,_,GNeg,False> => "nach biodh" ++ cl.subj ++ "a'" ++ cl.pred.noun
       } ;
-
-  -- : RP -> VP -> RCl ;
-  RelVP rp vp = {
-    } ;
-
-  -- : RP -> ClSlash -> RCl ; -- who I went with
-  RelSlash rp cls = {
-    } ;
-
-  -- : RP ;
-  IdRP = {s = "that"} ;
-
-  -- : Prep -> NP -> RP -> RP ;  -- the mother of whom
-  FunRP prep np rp =
--}
 }

src/gaelic/ResGla.gf

@@ -107,6 +107,15 @@ oper
     t@#lenitable + unnag   => t + "h" + unnag ;
     _                      => tunnag } ;
 
+  -- The progressive particle is _ag_ before a vowel and _a'_ elsewhere.
+  -- Keeping it as a pre-token operation also makes it work when the verbal
+  -- noun has acquired complements in the VP.
+  AG : Str = pre {
+    #vowel => "ag" ;
+    _      => "a'"
+    } ;
+
+
 
 ---------------------------------------------
 -- Proper noun
@@ -315,7 +324,7 @@ oper
   h, n, LENITION_DEBUG : Str ;
   h = pre {#vowel  => "h"  ++ BIND ; _ => []} ;
   n = pre {#vowel  => "n-" ++ BIND ; _ => []} ;
-  LENITION_DEBUG = "^L" ; -- Only for debugging purposes—replace with empty string for production
+  LENITION_DEBUG = [] ;
 
 
   invarPrepForms : Str -> PrepForms = \str ->
@@ -329,8 +338,8 @@ oper
       \replaces,casIndef,casDef,objForms,possForms -> {
         s = table {
               PrepBase => aig ;
-              PrepDefiniteArticle Sg => aig + "✨" ++ BIND ++ AN ;  -- TODO: merge with article!!!!!!
+              PrepDefiniteArticle Sg => aig ++ AN ;
-              PrepDefiniteArticle Pl => aig + "✨" ++ BIND ++ NA ;  -- TODO: merge with article!!!!!!
+              PrepDefiniteArticle Pl => aig ++ NA ;
               PrepObjectPron Sg1 => agam ;
               PrepObjectPron Sg2 => agad ;
               PrepObjectPron (Sg3 Masc) => aige ;
@@ -373,6 +382,12 @@ oper
     replacesObjPron = False
   } ;
 
+  simplePrep : Str -> Case -> LinPrep = \s,c -> {
+    s = \\_ => s ;
+    c2 = \\_ => c ;
+    replacesObjPron = False
+    } ;
+
   aigPrep : LinPrep =
     mkPrep
       {base="aig"; sg1="agam"; sg2="agad"; sg3M="aige"; sg3F="aice";  pl1="againn";  pl2="agaibh"; pl3="aca"}
@@ -467,7 +482,18 @@ param
   VForm = Indep | Dep ;
   
 oper
-  LinV = {s: Str; conditional: Number => Str; imperative: Person => Number => Str; future, past : VForm => Str; noun, participle: Str} ;
+  LinV = {
+    s: Str;
+    conditional: Number => Str;
+    imperative: Person => Number => Str;
+    future, past : VForm => Str;
+    noun, participle: Str;
+    -- Copular and auxiliary uses of _bi_ do not form the present with
+    -- "a'" plus a verbal noun.  Keep that distinction in the VP instead of
+    -- trying to recover it from the surface string in SentenceGla.
+    copular: Bool;
+    complement: Str
+    } ;
 
   LinV2 : Type = LinV ** {
     c2 : LinPrep ;
@@ -503,7 +529,9 @@ oper
                        Dep   => f13
                      } ;
             noun = f14 ;
-            participle = f15
+            participle = f15 ;
+            copular = False ;
+            complement = []
           } ;
 
 ------------------
@@ -513,20 +541,86 @@ oper
 
   LinVP : Type = LinV ;
 
+  -- Keep complements in every finite and non-finite form.  The first
+  -- version of the grammar made VP identical to the bare verb and the
+  -- unfinished syntax modules consequently had nowhere to put objects or
+  -- adverbials.  These two small combinators let the syntax remain simple
+  -- without throwing away the rich verb paradigm.
+  appendVP : LinVP -> Str -> LinVP = \vp,compl -> vp ** {
+    s = vp.s ++ compl ;
+    conditional = \\n => vp.conditional ! n ++ compl ;
+    imperative = \\p,n => vp.imperative ! p ! n ++ compl ;
+    future = \\f => vp.future ! f ++ compl ;
+    past = \\f => vp.past ! f ++ compl ;
+    noun = vp.noun ++ compl ;
+    participle = vp.participle ++ compl ;
+    complement = vp.complement ++ compl
+    } ;
+
+  prependVP : Str -> LinVP -> LinVP = \adv,vp -> vp ** {
+    s = adv ++ vp.s ;
+    conditional = \\n => adv ++ vp.conditional ! n ;
+    imperative = \\p,n => adv ++ vp.imperative ! p ! n ;
+    future = \\f => adv ++ vp.future ! f ;
+    past = \\f => adv ++ vp.past ! f ;
+    noun = adv ++ vp.noun ;
+    participle = adv ++ vp.participle ;
+    complement = adv ++ vp.complement
+    } ;
+
   LinVPSlash : Type = LinVP ** {
     c2 : LinPrep ;
     } ;
 
+  appendSlash : LinVPSlash -> Str -> LinVPSlash = \vp,compl -> vp ** {
+    s = vp.s ++ compl ;
+    conditional = \\n => vp.conditional ! n ++ compl ;
+    imperative = \\p,n => vp.imperative ! p ! n ++ compl ;
+    future = \\f => vp.future ! f ++ compl ;
+    past = \\f => vp.past ! f ++ compl ;
+    noun = vp.noun ++ compl ;
+    participle = vp.participle ++ compl ;
+    complement = vp.complement ++ compl
+    } ;
+
+  prependSlash : Str -> LinVPSlash -> LinVPSlash = \adv,vp -> vp ** {
+    s = adv ++ vp.s ;
+    conditional = \\n => adv ++ vp.conditional ! n ;
+    imperative = \\p,n => adv ++ vp.imperative ! p ! n ;
+    future = \\f => adv ++ vp.future ! f ;
+    past = \\f => adv ++ vp.past ! f ;
+    noun = adv ++ vp.noun ;
+    participle = adv ++ vp.participle ;
+    complement = adv ++ vp.complement
+    } ;
+
+  prepNP : LinPrep -> LinNP -> Str = \prep,np ->
+    let c = prep.c2 ! getDefi np.a
+    in case <prep.replacesObjPron,np.a> of {
+      <True,IsPron _> => prep.s ! agr2pagr np.a ;
+      _ => prep.s ! agr2pagr np.a ++ np.art ! c ++ np.s ! c
+      } ;
+
 --------------------------------------------------------------------------------
 -- Cl, S
 
   -- Operations for clauses, sentences
   LinCl : Type = {
     subj : Str ;
-    pred : Str ; -- TODO: depend on Temp and Pol
+    n : Number ;
+    pred : LinVP ;
   } ;
 
-  linCl : LinCl -> Str = \cl -> cl.subj ++ cl.pred ;
+  LinClSlash : Type = LinCl ** {c2 : LinPrep} ;
+
+  linCl : LinCl -> Str = \cl -> cl.pred.s ++ cl.subj ;
+
+  agrNumber : Agr -> Number = \agr -> case agr of {
+    IsPron (Pl1|Pl2|Pl3) => Pl ;
+    NotPron (DDef n _) => n ;
+    NotPron (DPoss n _) => n ;
+    _ => Sg
+    } ;
 
 
 oper mkNoun : (_,_,_,_,_,_,_,_,_,_,_,_,_,_ : Str) -> Gender -> LinN =

src/gaelic/SentenceGla.gf

@@ -1,8 +1,10 @@
 
 concrete SentenceGla of Sentence = CatGla ** open
-  TenseX, ResGla, (AM=AdverbGla), Prelude in {
+  TenseGla, ResGla, (AM=AdverbGla), Prelude in {
 
-flags optimize=all_subs ;
+-- Keep tense, anteriority, and polarity as live parameters.  Substitution
+-- optimization can otherwise specialize them away in this concrete syntax.
+flags optimize=noexpand ;
 
 lin
 
@@ -11,66 +13,102 @@ lin
   -- : NP -> VP -> Cl
   PredVP np vp = {
     subj = linNP np ; -- article and CN are discontinuous in NP! linNP just picks nominative unmutated.
-    pred =
+    n = agrNumber np.a ;
-     -- table {something with tense+polarity =>
+    pred = vp
-            vp.s
-            -- TODO: all of the VP's tense and polarity should be open here!
-            -- PredVP only decides the subject.
-     -- }
   } ;
 
-{-
   -- : SC -> VP -> Cl ;         -- that she goes is good
-  PredSCVP sc vp = ;
+  PredSCVP sc vp = {subj = sc.s ; n = Sg ; pred = vp} ;
 
 --2 Clauses missing object noun phrases
   -- : NP -> VPSlash -> ClSlash ;
-  SlashVP =
+  SlashVP np vp = {subj = linNP np ; n = agrNumber np.a ; pred = vp ; c2 = vp.c2} ;
 
   -- : ClSlash -> Adv -> ClSlash ;     -- (whom) he sees today
-  AdvSlash cls adv =
+  AdvSlash cls adv = cls ** {pred = appendVP cls.pred adv.s} ;
 
   -- : Cl -> Prep -> ClSlash ;         -- (with whom) he walks
   SlashPrep cl prep = cl ** {c2 = prep} ;
 
 -- Imperatives
   -- : VP -> Imp ;
-  ImpVP vp =
+  -- The generated morphology still contains gaps in a number of imperative
+  -- cells.  The second-person singular is the dictionary stem in Gaelic, so
+  -- using the stem here is both correct and total.
+  ImpVP vp = {s = vp.s} ;
 
 --2 Embedded sentences
 
   -- : S  -> SC ;
-  EmbedS s =
+  EmbedS s = s ;
 
   -- : QS -> SC ;
-  EmbedQS qs =
+  EmbedQS qs = qs ;
 
   -- : VP -> SC ;
-  EmbedVP vp =
+  EmbedVP vp = {s = "a" ++ vp.noun} ;
--}
 --2 Sentences
 
   -- : Temp -> Pol -> Cl -> S ;
   UseCl t p cl = {
-    s = cl.subj ++ t.s ++ p.s ++ cl.pred --  ! t.t ! p.p  -- eventually
+    s = case <t.t,t.a,p.p> of {
+      <GPres,GSimul,GPos> => case cl.pred.copular of {
+        True => "tha" ++ cl.subj ++ cl.pred.complement ;
+        False => "tha" ++ cl.subj ++ AG ++ cl.pred.noun
+        } ;
+      <GPres,GAnter,GPos> => "tha" ++ cl.subj ++ cl.pred.participle ;
+      -- The productive do-periphrasis keeps the finite verb first and the
+      -- subject before the verbal noun and all of its complements.
+      <GPast,GSimul,GPos> => case cl.pred.copular of {
+        True => "bha" ++ cl.subj ++ cl.pred.complement ;
+        False => "rinn" ++ cl.subj ++ cl.pred.noun
+        } ;
+      <GPast,GAnter,GPos> => "bha" ++ cl.subj ++ cl.pred.participle ;
+      <GFut,_,GPos> => case cl.pred.copular of {
+        True => "bidh" ++ cl.subj ++ cl.pred.complement ;
+        False => "bidh" ++ cl.subj ++ AG ++ cl.pred.noun
+        } ;
+      <GCond,_,GPos> => case cl.pred.copular of {
+        True => "bhiodh" ++ cl.subj ++ cl.pred.complement ;
+        False => "bhiodh" ++ cl.subj ++ AG ++ cl.pred.noun
+        } ;
+      <GPres,_,GNeg> => case cl.pred.copular of {
+        True => "chan eil" ++ cl.subj ++ cl.pred.complement ;
+        False => "chan eil" ++ cl.subj ++ AG ++ cl.pred.noun
+        } ;
+      <GPast,_,GNeg> => case cl.pred.copular of {
+        True => "cha robh" ++ cl.subj ++ cl.pred.complement ;
+        False => "cha robh" ++ cl.subj ++ AG ++ cl.pred.noun
+        } ;
+      <GFut,_,GNeg> => case cl.pred.copular of {
+        True => "cha bhi" ++ cl.subj ++ cl.pred.complement ;
+        False => "cha bhi" ++ cl.subj ++ AG ++ cl.pred.noun
+        } ;
+      <GCond,_,GNeg> => case cl.pred.copular of {
+        True => "cha bhiodh" ++ cl.subj ++ cl.pred.complement ;
+        False => "cha bhiodh" ++ cl.subj ++ AG ++ cl.pred.noun
+        }
+      }
     } ;
-{-
   -- : Temp -> Pol -> QCl -> QS ;
-  UseQCl t p cl =
+  UseQCl t p cl = {s = cl.s ! t.t ! t.a ! p.p} ;
 
   -- : Temp -> Pol -> RCl -> RS ;
-  UseRCl t p cl =
+  UseRCl t p cl = {s = cl.s ! t.t ! t.a ! p.p} ;
 
   -- AdvS : Adv -> S  -> S ;            -- then I will go home
-  AdvS adv s =
+  AdvS adv s = {s = adv.s ++ s.s} ;
 
   -- ExtAdvS : Adv -> S  -> S ;         -- next week, I will go home
-  ExtAdvS adv s =
+  ExtAdvS adv s = {s = adv.s ++ "," ++ s.s} ;
 
   -- : S -> Subj -> S -> S ;
-  SSubjS s1 subj s2 =
+  SSubjS s1 subj s2 = {s = s1.s ++ subj.s ++ s2.s} ;
 
   --  : S -> RS -> S ;              -- she sleeps, which is good
-  RelS sent rs =
+  RelS sent rs = {s = sent.s ++ "," ++ rs.s} ;
--}
+
+  UseSlash t p cls = {s = (UseCl t p cls).s} ;
+  SlashVS np vs ss = {subj = linNP np ; n = agrNumber np.a ; pred = appendVP vs ss.s ; c2 = emptyPrep} ;
+  AdvImp adv imp = {s = adv.s ++ imp.s} ;
 }

src/gaelic/StructuralGla.gf

@@ -43,7 +43,7 @@ lin there_Adv = ss "" ;
 -- which means that there are two fields for the strings, and
 -- n:Number which specifies the number of the resulting NP.
 
-lin and_Conj = {s1 = [] ; s2 = "and" ; n = Pl} ;
+lin and_Conj = {s1 = [] ; s2 = "agus" ; n = Pl} ;
 -- lin or_Conj =
 -- lin if_then_Conj =
 lin both7and_DConj = {s1 = "both" ; s2 = "and" ; n = Pl} ;
@@ -120,13 +120,13 @@ lin to_Prep = ResGla.guPrep ;
 
 -- Pronouns are closed class, no constructor in ParadigmsGla.
 --lin it_Pron =
-lin i_Pron = mkPron "mi" "mo^L" Sg1 ;
+lin i_Pron = mkPron "mi" "mo" Sg1 ;
 lin youPol_Pron = youPl_Pron ;
-lin youSg_Pron = mkPron "tu" "do^L" Sg2 ;
+lin youSg_Pron = mkPron "thu" "do" Sg2 ;
-lin he_Pron = mkPron "e" "a^L" (Sg3 Masc) ;
+lin he_Pron = mkPron "e" "a" (Sg3 Masc) ;
-lin she_Pron = mkPron "i" "a^H" (Sg3 Fem) ;
+lin she_Pron = mkPron "i" "a" (Sg3 Fem) ;
-lin we_Pron = mkPron "sinn" "àr^N" Pl1 ;
+lin we_Pron = mkPron "sinn" "àr" Pl1 ;
-lin youPl_Pron = mkPron"sibh" "ùr^N" Pl2 ;
+lin youPl_Pron = mkPron"sibh" "ur" Pl2 ;
 lin they_Pron = mkPron "iad" AN Pl3 ;
 {-
 lin whatPl_IP =
@@ -168,4 +168,121 @@ lin want_VV =
 lin please_Voc = ss "" ;
 -}
 
+lin
+  almost_AdA = {s = "cha mhòr"} ;
+  almost_AdN = {s = "cha mhòr"} ;
+  at_least_AdN = {s = "co-dhiù"} ;
+  at_most_AdN = {s = "air a' char as motha"} ;
+  so_AdA = {s = "cho"} ;
+  too_AdA = {s = "ro"} ;
+  very_AdA = {s = "glè"} ;
+  as_CAdv = {s = "cho" ; p = "ri"} ;
+  less_CAdv = {s = "nas lugha" ; p = "na"} ;
+  more_CAdv = {s = "nas" ; p = "na"} ;
+
+  how8much_IAdv = {s = "dè an uiread"} ;
+  how_IAdv = {s = "ciamar"} ;
+  when_IAdv = {s = "cuin"} ;
+  where_IAdv = {s = "càite"} ;
+  why_IAdv = {s = "carson"} ;
+  always_AdV = {s = "an-còmhnaidh"} ;
+  everywhere_Adv = {s = "anns gach àite"} ;
+  here7from_Adv = {s = "à seo"} ;
+  here7to_Adv = {s = "an seo"} ;
+  here_Adv = {s = "an seo"} ;
+  quite_Adv = {s = "gu math"} ;
+  somewhere_Adv = {s = "an àiteigin"} ;
+  there7from_Adv = {s = "à sin"} ;
+  there7to_Adv = {s = "an sin"} ;
+  there_Adv = {s = "an sin"} ;
+
+  or_Conj = {s1 = [] ; s2 = "no" ; n = Sg} ;
+  if_then_Conj = {s1 = "ma" ; s2 = "an uair sin" ; n = Sg} ;
+  either7or_DConj = {s1 = "an dara cuid" ; s2 = "no" ; n = Sg} ;
+  but_PConj = {s = "ach"} ;
+  otherwise_PConj = {s = "air neo"} ;
+  therefore_PConj = {s = "mar sin"} ;
+
+  every_Det = ParadigmsGla.mkDet "gach" Sg Indef ;
+  few_Det = ParadigmsGla.mkDet "beagan" Pl Indef ;
+  many_Det = ParadigmsGla.mkDet "mòran" Pl Indef ;
+  much_Det = ParadigmsGla.mkDet "mòran" Sg Indef ;
+  somePl_Det = ParadigmsGla.mkDet "cuid de" Pl Indef ;
+  someSg_Det = ParadigmsGla.mkDet "rudeigin de" Sg Indef ;
+  how8many_IDet = {s = "cia mheud"} ;
+  all_Predet = {s = "uile"} ;
+  most_Predet = {s = "a' mhòr-chuid de"} ;
+  not_Predet = {s = "chan e"} ;
+  only_Predet = {s = "a-mhàin"} ;
+  no_Quant = ParadigmsGla.mkQuant "gun" Indef ;
+  that_Quant = ParadigmsGla.mkQuant "sin" Def ;
+  this_Quant = ParadigmsGla.mkQuant "seo" Def ;
+  which_IQuant = {s = "dè"} ;
+
+  everybody_NP = atomNP "a h-uile duine" Pl3 ;
+  everything_NP = atomNP "a h-uile rud" (Sg3 Masc) ;
+  nobody_NP = atomNP "duine sam bith" (Sg3 Masc) ;
+  nothing_NP = atomNP "rud sam bith" (Sg3 Masc) ;
+  somebody_NP = atomNP "cuideigin" (Sg3 Masc) ;
+  something_NP = atomNP "rudeigin" (Sg3 Masc) ;
+
+  above_Prep = simplePrep "os cionn" Gen ;
+  after_Prep = simplePrep "an dèidh" Gen ;
+  before_Prep = simplePrep "ro" (Dat Lenited) ;
+  behind_Prep = simplePrep "air cùl" Gen ;
+  between_Prep = simplePrep "eadar" (Dat NoMutation) ;
+  by8agent_Prep = simplePrep "le" (Dat NoMutation) ;
+  by8means_Prep = simplePrep "le" (Dat NoMutation) ;
+  during_Prep = simplePrep "rè" Gen ;
+  except_Prep = simplePrep "ach" (Nom NoMutation) ;
+  in8front_Prep = simplePrep "air beulaibh" Gen ;
+  part_Prep = simplePrep "de" (Dat Lenited) ;
+  possess_Prep = simplePrep "aig" (Dat NoMutation) ;
+  through_Prep = simplePrep "tro" (Dat NoMutation) ;
+  under_Prep = simplePrep "fo" (Dat Lenited) ;
+  with_Prep = simplePrep "le" (Dat NoMutation) ;
+  without_Prep = simplePrep "gun" (Dat Lenited) ;
+
+  it_Pron = mkPron "e" "a" (Sg3 Masc) ;
+  whatPl_IP = {s = "dè"} ;
+  whatSg_IP = {s = "dè"} ;
+  whoPl_IP = {s = "cò"} ;
+  whoSg_IP = {s = "cò"} ;
+
+  although_Subj = {s = "ged"} ;
+  because_Subj = {s = "oir"} ;
+  if_Subj = {s = "ma"} ;
+  that_Subj = {s = "gun"} ;
+  when_Subj = {s = "nuair a"} ;
+
+  language_title_Utt = {s = "Gàidhlig"} ;
+  no_Utt = {s = "chan eil"} ;
+  yes_Utt = {s = "tha"} ;
+  please_Voc = {s = "mas e do thoil e"} ;
+
+  have_V2 = biV ** {c2 = aigPrep} ;
+  can8know_VV = mkV "urrainn" ;
+  can_VV = mkV "faod" ;
+  must_VV = mkV "feum" ;
+  want_VV = mkV "iarr" ;
+
+oper
+  biV : LinV = {
+    s = "bi" ;
+    conditional = table {Sg => "bhiodh" ; Pl => "bhiodh"} ;
+    imperative = table {
+      P1 => table {Sg => "bitheam" ; Pl => "bitheamaid"} ;
+      P2 => table {Sg => "bi" ; Pl => "bithibh"} ;
+      P3 => table {Sg => "bitheadh" ; Pl => "bitheadh"}
+      } ;
+    future = table {Indep => "bidh" ; Dep => "bi"} ;
+    past = table {Indep => "bha" ; Dep => "robh"} ;
+    noun = "bhith" ; participle = "air a bhith" ;
+    copular = True ; complement = []
+    } ;
+
+  atomNP : Str -> PronAgr -> LinNP = \s,a -> emptyNP ** {
+    s = \\_ => s ; voc = s ; a = IsPron a
+    } ;
+
 }

src/gaelic/TenseGla.gf

@@ -0,0 +1,12 @@
+concrete TenseGla of Tense = CommonGla ** {
+  lin
+    TTAnt t a = {s = t.s ++ a.s ; t = t.t ; a = a.a} ;
+    PPos = {s = [] ; p = GPos} ;
+    PNeg = {s = [] ; p = GNeg} ;
+    TPres = {s = [] ; t = GPres} ;
+    TPast = {s = [] ; t = GPast} ;
+    TFut = {s = [] ; t = GFut} ;
+    TCond = {s = [] ; t = GCond} ;
+    ASimul = {s = [] ; a = GSimul} ;
+    AAnter = {s = [] ; a = GAnter} ;
+}

src/gaelic/TextGla.gf

@@ -0,0 +1,7 @@
+concrete TextGla of Text = CommonGla ** open Prelude in {
+  lin
+    TEmpty = {s = []} ;
+    TFullStop x xs = {s = x.s ++ SOFT_BIND ++ "." ++ xs.s} ;
+    TQuestMark x xs = {s = x.s ++ SOFT_BIND ++ "?" ++ xs.s} ;
+    TExclMark x xs = {s = x.s ++ SOFT_BIND ++ "!" ++ xs.s} ;
+}

src/gaelic/VerbGla.gf

@@ -10,82 +10,73 @@ lin
   -- This will most likely change when you start working with VPs
   UseV v = v ;
 
-{-
   --  : V2 -> VP ;
-  PassV2 v2 =
+  PassV2 v2 = appendVP v2 ("air" ++ v2.participle) ;
 
   -- : VPSlash -> VP ;
-  ReflVP vps =
+  ReflVP vps = vps ;
 
   -- : VV  -> VP -> VP ;
-  ComplVV vv vp =
+  ComplVV vv vp = appendVP vv ("a" ++ vp.noun) ;
 
   -- : VS  -> S  -> VP ;
-  ComplVS vs s =
+  ComplVS vs sent = appendVP vs ("gun" ++ sent.s) ;
 
   -- : VQ -> QS -> VP ;
-  ComplVQ vq qs =
+  ComplVQ vq qs = appendVP vq qs.s ;
 
   -- : VA -> AP -> VP ;
-  ComplVA va ap =
+  ComplVA va ap = appendVP va (ap.s ! ASg NOM Masc) ;
 
   -- : Comp -> VP ;
-  UseComp comp =
+  UseComp comp = appendVP (copulaV "bi") comp.s ;
--}
 --------
 -- Slash
-{-
   -- : V2 -> VPSlash
-  SlashV2a v2 =
+  SlashV2a v2 = v2 ;
 
   -- : V3 -> NP -> VPSlash ; -- give it (to her)
-  Slash2V3 v3 dobj =
+  Slash2V3 v3 dobj = appendSlash (v3 ** {c2 = v3.c3}) (linNP dobj) ;
 
   -- : V3 -> NP -> VPSlash ; -- give (it) to her
-  Slash3V3 v3 iobj =
+  Slash3V3 v3 iobj = appendSlash v3 (prepNP v3.c3 iobj) ;
 
-  SlashV2A v2 adj =
+  SlashV2A v2 adj = appendSlash v2 (adj.s ! ASg NOM Masc) ;
 
   -- : V2S -> S  -> VPSlash ;  -- answer (to him) that it is good
-  SlashV2S v2s s =
+  SlashV2S v2s sent = appendSlash v2s ("gun" ++ sent.s) ;
 
   -- : V2V -> VP -> VPSlash ;  -- beg (her) to go
-  SlashV2V v2v vp = ;
+  SlashV2V v2v vp = appendSlash v2v ("a" ++ vp.noun) ;
 
   -- : V2Q -> QS -> VPSlash ;  -- ask (him) who came
-  SlashV2Q v2q qs = ;
+  SlashV2Q v2q qs = appendSlash v2q qs.s ;
 
   -- : V2A -> AP -> VPSlash ;  -- paint (it) red
-  SlashV2A v2a ap = ;
-
-
   -- : VPSlash -> NP -> VP
   -- Often VPSlash has a field called c2, which is used to pick right form of np complement
-  ComplSlash vps np = vps ** {
+  ComplSlash vps np = appendVP vps (prepNP vps.c2 np) ;
-    compl = np.s ! vps.c2
-    } ;
 
   -- : VV  -> VPSlash -> VPSlash ;
-  SlashVV vv vps = ComplVV vv vps ** {
+  SlashVV vv vps = appendSlash (vv ** {c2 = vps.c2}) ("a" ++ vps.noun) ;
-    } ;
 
   -- : V2V -> NP -> VPSlash -> VPSlash ; -- beg me to buy
-  SlashV2VNP v2v np vps =
+  SlashV2VNP v2v np vps = appendSlash v2v (linNP np ++ "a" ++ vps.s) ;
 
   -- : VP -> Adv -> VP ;  -- sleep here
-  AdvVP vp adv =
+  AdvVP vp adv = appendVP vp adv.s ;
 
   -- : AdV -> VP -> VP ;  -- always sleep
-  AdVVP adv vp =
+  AdVVP adv vp = prependVP adv.s vp ;
 
   -- : VPSlash -> Adv -> VPSlash ;  -- use (it) here
-  AdvVPSlash = insertAdv ;
+  AdvVPSlash vps adv = appendSlash vps adv.s ;
 
   -- : VP -> Adv -> VP ;  -- sleep , even though ...
-  ExtAdvVP vp adv =  ;
+  ExtAdvVP vp adv = appendVP vp ("," ++ adv.s) ;
 
   -- : AdV -> VPSlash -> VPSlash ;  -- always use (it)
-  AdVVPSlash adv vps = vps ** { adv = adv.s ++ vps.adv } ;
+  AdVVPSlash adv vps = prependSlash adv.s vps ;
 
   -- : VP -> Prep -> VPSlash ;  -- live in (it)
   VPSlashPrep vp prep = vp ** {c2 = prep} ;
@@ -96,19 +87,33 @@ lin
 -- Adjectival phrases, noun phrases, and adverbs can be used.
 
   -- : AP  -> Comp ;
-  CompAP ap =
+  CompAP ap = {s = ap.s ! ASg NOM Masc} ;
 
   -- : CN  -> Comp ;
-  CompCN cn =
+  CompCN cn = {s = cn.s ! NOM ! Indef ! Sg} ;
 
   --  NP  -> Comp ;
-  CompNP np =
+  CompNP np = {s = linNP np} ;
 
   -- : Adv  -> Comp ;
-  CompAdv adv =
+  CompAdv adv = adv ;
 
   -- : VP -- Copula alone;
-  UseCopula =
+  UseCopula = copulaV "bi" ;
--}
+
+oper
+  copulaV : Str -> LinV = \_ -> {
+    s = "bi" ;
+    conditional = table {Sg => "bhiodh" ; Pl => "bhiodh"} ;
+    imperative = table {
+      P1 => table {Sg => "bitheam" ; Pl => "bitheamaid"} ;
+      P2 => table {Sg => "bi" ; Pl => "bithibh"} ;
+      P3 => table {Sg => "bitheadh" ; Pl => "bitheadh"}
+      } ;
+    future = table {Indep => "bidh" ; Dep => "bi"} ;
+    past = table {Indep => "bha" ; Dep => "robh"} ;
+    noun = "bhith" ; participle = "air a bhith" ;
+    copular = True ; complement = []
+    } ;
 
 }