Merge branch 'master' of https://github.com/GrammaticalFramework/GF

doc/browse/.gitignore

@@ -0,0 +1 @@
+tags/*.gf-tags

doc/browse/build-tags.sh

@@ -49,7 +49,7 @@ do
         $FIND | while read -r file
         do
             echo "    \""`echo $file | sed 's|./||;s|.gf||'`"\"," >> $index
-            filemtime=`$STAT "${tagsdir}/${file}-tags"` 2>/dev/null
+            filemtime=`$STAT "${tagsdir}/${file}-tags" 2>/dev/null`
             if [ -z "$filemtime" ] || [ "$filemtime" -lt "$start" ]
             then
                 gf --batch --quiet --tags --output-dir=${tagsdir} $file 2>/dev/null

doc/browse/index.json

@@ -400,7 +400,6 @@
     "CatDut",
     "ExtDut",
     "GrammarDut",
-    "MorphoDut",
     "NumeralDut",
     "StructuralDut",
     "IdiomDut",

src/arabic/ParadigmsAra.gf

@@ -41,9 +41,26 @@ resource ParadigmsAra = open
 
 --2 Nouns
 
+-- Overloaded operator for main cases
+
+ mkN = overload {
+   mkN : (sg : Str) -> N                                     -- non-human regular nouns
+     = smartN ;
+   mkN : Species -> N -> N
+     = \p,n -> n ** {h = p} ;
+   mkN : (sg,pl : Str) -> Gender -> Species -> N
+     = \sg,pl -> mkFullN (reg sg pl) ;  
+   mkN : NTable -> Gender -> Species -> N                             -- loan words, irregular
+     = mkFullN ;
+   mkN : (root,sgPatt,brokenPlPatt : Str) -> Gender -> Species -> N   -- broken plural
+    = brkN ;
+---   mkN : (root,sgPatt : Str) -> Gender -> Species -> N                -- sound feminine plural
+---    = sdfN ;
+   } ;
+
 --This is used for loan words or anything that has untreated irregularities
 --in the interdigitization process of its words
-  mkN : NTable -> Gender -> Species -> N ;
+  mkFullN : NTable -> Gender -> Species -> N ;
   
 --Takes a root string, a singular pattern string, a broken plural 
 --pattern string, a gender, and species. Gives a noun.
@@ -57,7 +74,19 @@ resource ParadigmsAra = open
 --and species. Gives a noun whose plural is sound masculine
   sdmN : Str -> Str -> Gender -> Species -> N ; 
 
-  mkPN : Str -> Gender -> Species -> PN ;
+
+--3 Proper names
+
+  mkPN = overload {
+    mkPN : Str -> PN        -- Fem Hum if ends with ة, otherwise Masc Hum
+     = smartPN ;
+    mkPN : Str -> Gender -> Species -> PN
+     = mkFullPN ;
+    } ;
+
+  mkFullPN : Str -> Gender -> Species -> PN ;
+
+
 
 --3 Relational nouns 
 
@@ -65,13 +94,26 @@ resource ParadigmsAra = open
 
   mkN3 : N -> Preposition -> Preposition -> N3 ;
 
+
 --2 Adjectives
 
+-- Overloaded operator for main cases
+
+ mkA = overload {
+   mkA : (root,patt : Str) -> A
+    = sndA ;
+   mkA : (root : Str) -> A                -- forms adjectives with positive form aFCal
+    = clrA ;
+   mkA : (posit,compar,plur : Str) -> A
+    = degrA ;
+   } ;
+
+
 --Takes a root string and a pattern string
-  sndA : Str -> Str -> A ;
+  sndA : (root,patt : Str) -> A ;
     
 --Takes a root string only
-  clrA : Str -> A ;
+  clrA : (root : Str) -> A ;  -- forms adjectives of type aFCal
 
 --3 Two-place adjectives
 --
@@ -96,12 +138,25 @@ resource ParadigmsAra = open
 -- A preposition as used for rection in the lexicon, as well as to
 -- build $PP$s in the resource API, just requires a string.
 
-  mkPreposition : Str -> Preposition ;
+  mkPrep : Str -> Prep
+    = \s -> lin Prep {s = mkPreposition s} ; -- preposition in the sense of RGL abstract syntax
+    
+  mkPreposition : Str -> Preposition ;  -- just a string, for internal use
 
--- (These two functions are synonyms.)
 
 --2 Verbs
 
+-- Overloaded operations
+
+  mkV = overload {
+    mkV : (imperfect : Str) -> V
+      = regV ;
+    mkV : (root : Str) -> (perf,impf : Vowel) -> V  -- verb form I ; vowel = a|i|u
+      = v1 ;
+    mkV : (root : Str) -> VerbForm -> V             -- FormI .. FormVIII (no VII) ; default vowels a u for I
+      = formV ;
+    } ;
+
 -- The verb in the imperfect tense gives the most information
 
   regV : Str -> V ;
@@ -296,7 +351,7 @@ resource ParadigmsAra = open
   
   Preposition = Str ;
   
-  mkN nsc gen spec =
+  mkFullN nsc gen spec =
     { s = nsc; --NTable
       g = gen; 
       h = spec;
@@ -307,7 +362,7 @@ resource ParadigmsAra = open
     \root,sg,pl,gen,spec ->
     let { kitAb = mkWord sg root;
           kutub = mkWord pl root
-    } in mkN (reg kitAb kutub) gen spec;
+    } in mkFullN (reg kitAb kutub) gen spec;
   
   brkN root sg pl gen spec =
     let { raw = brkN' root sg pl gen spec} in
@@ -323,14 +378,14 @@ resource ParadigmsAra = open
   sdfN =
     \root,sg,gen,spec ->
     let { kalima = mkWord sg root;
-    } in mkN (sndf kalima) gen spec;
+    } in mkFullN (sndf kalima) gen spec;
   
   sdmN =
     \root,sg,gen,spec ->
     let { mucallim = mkWord sg root;
-    } in mkN (sndm mucallim) gen spec;
+    } in mkFullN (sndm mucallim) gen spec;
 
-  mkPN = \str,gen,species -> 
+  mkFullPN = \str,gen,species -> 
     { s = \\c => str + indecl!c ;
       g = gen;
       h = species;
@@ -401,6 +456,9 @@ resource ParadigmsAra = open
       lock_Quant = <>
     };
 
+  degrA : (posit,compar,plur : Str) -> A
+    = \posit,compar,plur -> lin A {s = clr posit compar plur} ;
+  
   sndA root pat =
     let  raw = sndA' root pat in { 
       s = \\af =>
@@ -467,4 +525,28 @@ resource ParadigmsAra = open
   mkA2V v p = mkA2 v p ** {lock_A2 = <>} ;
 
 
+smartN : Str -> N = \s -> case last s of {
+  "ة" => mkFullN (sndf s) Fem NoHum ;
+  _ => mkFullN (sndm s) Masc NoHum
+  } ;
+
+smartPN : Str -> PN = \s -> case last s of {
+  "ة" => mkFullPN s Fem Hum ;
+  _ => mkFullPN s Masc Hum
+  } ;
+
+formV : (root : Str) -> VerbForm -> V = \s,f -> case f of {
+   FormI   => v1 s a u ;
+   FormII  => v2 s ;
+   FormIII => v3 s ;
+   FormIV  => v4 s ;
+   FormV   => v5 s ;
+   FormVI  => v6 s ;
+---   FormVII  => v7 s ;
+   FormVIII => v8 s
+   } ;
+
+param VerbForm =
+  FormI |  FormIII |  FormIII |  FormIV |  FormV |  FormVI | FormVIII  ;
+
 } ;

src/dutch/ConstructionDut.gf

@@ -2,7 +2,7 @@
 
 concrete ConstructionDut of Construction = CatDut ** 
   open SyntaxDut, SymbolicDut, ParadigmsDut, 
-       (L = LexiconDut), (E = ExtraDut), (G = GrammarDut), (I = IrregDut), (R = ResDut), (N = NounDut), Prelude in {
+       (L = LexiconDut), (E = ExtendDut), (G = GrammarDut), (I = IrregDut), (R = ResDut), (N = NounDut), (P=ParamX), Prelude in {
 
 
 lin
@@ -49,9 +49,9 @@ lin
 
   monthAdv m = SyntaxDut.mkAdv in_Prep (mkNP the_Det m) ;
   yearAdv y = SyntaxDut.mkAdv (mkPrep "in jaar") y ; ----
-  dayMonthAdv d m = ParadigmsDut.mkAdv ("op" ++ d.s ! R.NPNom ++ BIND ++ "." ++ m.s ! R.NF R.Sg R.Nom) ; -- op 17 Mai
+  dayMonthAdv d m = ParadigmsDut.mkAdv ("op" ++ d.s ! R.NPNom ++ m.s ! R.NF R.Sg R.Nom) ; -- op 17 mei
-  monthYearAdv m y = SyntaxDut.mkAdv in_Prep (mkNP the_Det (mkCN m y)) ; -- im Mai 2012
+  monthYearAdv m y = SyntaxDut.mkAdv in_Prep (mkNP the_Det (mkCN m y)) ; -- in mei 2012
-  dayMonthYearAdv d m y = ParadigmsDut.mkAdv ("op" ++ d.s ! R.NPNom ++ BIND ++ "." ++ m.s ! R.NF R.Sg R.Nom ++ y.s ! R.NPNom) ; -- am 17 Mai 2013
+  dayMonthYearAdv d m y = ParadigmsDut.mkAdv ("op" ++ d.s ! R.NPNom ++ m.s ! R.NF R.Sg R.Nom ++ y.s ! R.NPNom ) ; -- op 17 mei 2013
 
   intYear = symb ;
   intMonthday = symb ;

src/dutch/ExtendDut.gf

@@ -2,7 +2,7 @@
 
 concrete ExtendDut of Extend =
   CatDut ** ExtendFunctor
-   - [PastPartAP]
+   - [PastPartAP,ICompAP,IAdvAdv]
   with
     (Grammar = GrammarDut) **
   open
@@ -12,7 +12,7 @@ concrete ExtendDut of Extend =
     Prelude,
     ParadigmsDut in {
 
-lin --# notpresent
+lin
 
   PastPartAP vp = { --# notpresent
     s = \\agr,af => let aForm = case vp.isHeavy of { --# notpresent
@@ -22,4 +22,7 @@ lin --# notpresent
     isPre = notB vp.isHeavy ; --# notpresent
    } ; --# notpresent
     
+  ICompAP ap = {s = \\agr => "hoe" ++ ap.s ! agr ! APred} ; 
+
+  IAdvAdv adv = {s = "hoe" ++ adv.s} ;
 }

src/dutch/ExtraDut.gf

@@ -1,5 +1,5 @@
 concrete ExtraDut of ExtraDutAbs = CatDut ** 
-  open ResDut, MorphoDut, Coordination, Prelude, IrregDut, (P = ParadigmsDut), NounDut in 
+  open ResDut, Coordination, Prelude, IrregDut, (P = ParadigmsDut), (E=ExtendDut), NounDut in 
 {
 
   flags coding=utf8 ;
@@ -19,9 +19,9 @@ concrete ExtraDut of ExtraDutAbs = CatDut **
            predVGen v.isAux BeforeObjs v) ; ----
 
 lin
-    ICompAP ap = {s = \\agr => "hoe" ++ ap.s ! agr ! APred} ; 
+    ICompAP = E.ICompAP ;
 
-    IAdvAdv adv = {s = "hoe" ++ adv.s} ;
+    IAdvAdv = E.IAdvAdv ;
 
   lincat
     VPS   = {s : Order => Agr => Str} ;
@@ -109,7 +109,7 @@ lin
                 inf : Str = vp.inf.p1 ;
                 extra : Str = vp.ext
             in       
-            lin NP (MorphoDut.mkNP (vp.s.s ! VInf ++ "van" ++ compl ++ inf ++ extra ) Utr Sg) ;  
+            lin NP (mkNP (vp.s.s ! VInf ++ "van" ++ compl ++ inf ++ extra ) Utr Sg) ;  
 
 
 lin

src/dutch/IdiomDut.gf

@@ -1,5 +1,5 @@
 concrete IdiomDut of Idiom = CatDut ** 
-  open MorphoDut, (P = ParadigmsDut), IrregDut, Prelude in {
+  open ResDut, (P = ParadigmsDut), IrregDut, Prelude in {
 
   flags optimize=all_subs ;
 

src/dutch/IrregDut.gf

@@ -169,7 +169,7 @@ lin weven_V = mkV "weven" "weefde" "weefden" "geweven" ;
 lin wijken_V = mkZijnV "wijken" "week" "weken" "geweken" ;
 lin wijten_V = mkV "wijten" "weet" "weten" "geweten" ;
 lin wijzen_V = mkV "wijzen" "wees" "wezen" "gewezen" ;
-lin willen_V = mkV "wil" "wilt" "wil" "willen" "wilde" "wilde" "wilden" "gewild" ; -- mkV "wil" "wilt" "wil" "willen" "wou" "wou" "wouden" "gewild" ;
+lin willen_V = mkV "wil" "wil" "wil" "willen" "wilde" "wilde" "wilden" "gewild" ; -- mkV "wil" "wilt" "wil" "willen" "wou" "wou" "wouden" "gewild" ;
 lin winden_V = mkV "winden" "wond" "wonden" "gewonden" ;
 lin winnen_V = mkV "winnen" "won" "wonnen" "gewonnen" ;
 lin worden_V = mkV "worden" "werd" "werden" "geworden" ;

src/dutch/MakeStructuralDut.gf

@@ -1,6 +1,6 @@
 --# -path=.:../common:../abstract
 
-resource MakeStructuralDut = open CatDut, ParadigmsDut, MorphoDut, Prelude in 
+resource MakeStructuralDut = open CatDut, ParadigmsDut, Prelude in 
 {
 --{
 --

src/dutch/MorphoDut.gf

@@ -1,101 +0,0 @@
---# -path=.:../common:../../prelude
---
-----1 A Simple Dutman Resource Morphology
-----
----- Aarne Ranta & Harald Hammarström 2002 -- 2006
-----
----- This resource morphology contains definitions needed in the resource
----- syntax. To build a lexicon, it is better to use $ParadigmsDut$, which
----- gives a higher-level access to this module.
---
-resource MorphoDut = ResDut ** open Prelude, (Predef=Predef) in 
-{
-flags coding=utf8 ;
---{
---
---  flags optimize=all ;
---
---oper
---
----- For $StructuralDut$.
---
---  mkPrep : Str -> Case -> Preposition = \s,c -> 
---    {s = s ; c = c} ;
---
---  nameNounPhrase : {s : Case => Str} ->  {s : Case => Str ; a : Agr} = \name ->
---    name ** {a = agrP3 Sg} ;
---
---  detLikeAdj : Number -> Str -> 
---    {s,sp : Gender => Case => Str ; n : Number ; a : Adjf} = \n,dies -> 
---      {s,sp = appAdj (regA dies) ! n ; n = n ; a = Weak} ;
---
---  mkOrd : {s : Degree => AForm => Str} -> {s : AForm => Str} = \a ->
---    {s = a.s ! Posit} ;
---
----- For $ParadigmsDut$.
---
---  genitS : Str -> Str = \hund -> case hund of {
---    _ + ("el" | "en" | "er") => hund + "s" ;
---    _ + ("s" | "ß" | "sch" | "st" | "x" | "z") => hund + "es" ;
---    _ => hund + variants {"s" ; "es"}
---    } ;
---  pluralN : Str -> Str = \hund -> case hund of {
---    _ + ("el" | "er" | "e") => hund + "n" ;
---    _ + "en" => hund ;
---    _ => hund + "en"
---    } ;
---  dativE : Str -> Str = \hund -> case hund of {
---    _ + ("el" | "en" | "er" | "e") => hund ;
---    _ => variants {hund ; hund + "e"}
---    } ;
---
----- Duden, p. 119
---
---  verbT : Str -> Str = \v -> case v of {
---    _ + ("t" | "d") => v + "et" ; -- gründen, reden, betten
---    _ + ("ch" | "k" | "p" | "t" | "g" | "b" | "d" | "f" | "s") + 
---        ("m" | "n") => v + "et" ; -- atmen, widmen, öffnen, rechnen
---    _ => v + "t"                  -- lernen, lärmen, qualmen etc
---    } ;
---
---  verbST : Str -> Str = \v -> case v of {
---    _ + ("s" | "ss" | "ß" | "sch" | "x" | "z") => v + "t" ;
---    _ => v + "st"
---    } ;
---
---  stemVerb : Str -> Str = \v -> case v of {
---    _ + ("rn" | "ln") => init v ;
---    _ => Predef.tk 2 v
---    } ;
---
----- For $Numeral$.
---
---  LinDigit = {s : DForm => CardOrd => Str} ;
---
---  cardOrd : Str -> Str -> CardOrd => Str = \drei,dritte ->
---    table {
---      NCard _ _ => drei ;
---      NOrd a => (regA (init dritte)).s ! Posit ! a
---      } ;
---
---  cardReg : Str -> CardOrd => Str = \zehn ->
---    cardOrd zehn (zehn + "te") ;
---
---  mkDigit : (x1,_,_,x4 : Str) -> LinDigit = 
---    \drei,dreizehn,dreissig,dritte ->
---    {s = table {
---           DUnit => cardOrd drei dritte ;
---           DTeen => cardReg dreizehn ;
---           DTen  => cardOrd dreissig (dreissig + "ste")
---           }
---     } ;
---
---  regDigit : Str -> LinDigit = \vier -> 
---    mkDigit vier (vier + "zehn") (vier + "zig") (vier + "te") ;
---
---  invNum : CardOrd = NCard Masc Nom ;
---
---} ;
---
-
-}

src/dutch/NounDut.gf

@@ -9,22 +9,17 @@ concrete NounDut of Noun = CatDut ** open ResDut, Prelude in {
       isPron = False ;
       } ;
 
-    DetNP det = {
+    DetNP det = det ** {
       s = \\_ => det.sp ! Neutr ;
       a = agrP3 det.n ;
-      isPron = False ;
+      isPron = False
-      mergesWithPrep = det.mergesWithPrep ;
-      mergeForm = det.mergeForm
       } ;
 
     UsePN pn = noMerge ** {s = pn.s ; a = agrP3 Sg ; isPron = False} ;
 
-    UsePron pron = {
+    UsePron pron = pron ** {
       s = table {NPNom => pron.stressed.nom ; NPAcc => pron.stressed.acc} ;
-      a = pron.a ;
       isPron = True ;
-      mergesWithPrep = pron.mergesWithPrep ;
-      mergeForm = pron.mergeForm
       } ;
 
     PredetNP pred np = heavyNP {
@@ -50,33 +45,30 @@ concrete NounDut of Noun = CatDut ** open ResDut, Prelude in {
 
     DetQuantOrd quant num ord = 
       let 
-        n = num.n ;
+        detQuant = DetQuant quant num ;
-        a = quant.a
+        af : Gender -> AForm = \g -> agrAdj g quant.a (NF num.n Nom) ;
-      in {
+      in detQuant ** {
-        s  = \\g => quant.s ! num.isNum ! n ! g ++ 
+        -- When combined with an ord, don't use the sp form of the quant.
-                      num.s ++ ord.s ! agrAdj g quant.a (NF n Nom) ;
+        -- Works the same way in English:
-        sp = \\g => quant.sp ! n ! g ++ 
+        -- e.g. s="your", sp="yours" -> s,sp="your youngest", not sp="*yours youngest"
-                      num.s ++ ord.s ! agrAdj g quant.a (NF n Nom) ;
+        s,sp  = \\g => detQuant.s ! g ++ ord.s ! af g ;
-        n = n ;
+
-        a = a ;
+        -- Even if the original quant merges; when you add an ord, it doesn't.
-        mergesWithPrep = quant.mergesWithPrep ;
+        mergesWithPrep = False
-        mergeForm = quant.mergeForm
         } ;
 
     DetQuant quant num = 
       let 
         n = num.n ;
         a = quant.a
-      in {
+      in quant ** {
         s = \\g => quant.s ! num.isNum ! n ! g ++ num.s ;
         sp = \\g => case num.isNum of {
 	  False => quant.sp ! n ! g ++ num.s ;
-	  True  => quant.s ! True ! n ! g ++ num.s
+	  True  => quant.s ! True ! n ! g ++ num.s -- to prevent "een 5 …"
 	  } ;
         n = n ;
         a = a ;
-        mergesWithPrep = quant.mergesWithPrep ;
-        mergeForm = quant.mergeForm
         } ;
 
     PossPron p = noMerge ** {

src/dutch/ParadigmsDut.gf

@@ -327,169 +327,14 @@ oper
     } ;
   mkmaxV3 : V -> Prep -> Prep -> V3 = \v,c,d -> lin V3 (v ** {c2 = <c,True> ; c3 = <d,True>}) ;
 
-
-
-
-
-----2 Definitions of paradigms
-----
----- The definitions should not bother the user of the API. So they are
----- hidden from the document.
---
---
---
---  Gender = MorphoDut.Gender ;
---  Case = MorphoDut.Case ;
---  Number = MorphoDut.Number ;
---  masculine = Masc ;
---  feminine  = Fem ;
---  neuter = Neutr ;
---  nominative = Nom ;
---  accusative = Acc ;
---  dative = Dat ;
---  genitive = Gen ;
---  singular = Sg ;
---  plural = Pl ;
---
---  mk6N a b c d e f g = MorphoDut.mkN a b c d e f g ** {lock_N = <>} ;
---
---  regN : Str -> N = \hund -> case hund of {
---    _ + "e" => mk6N hund hund hund hund (hund + "n") (hund + "n") Fem ;
---    _ + ("ion" | "ung") => mk6N hund hund hund hund (hund + "en") (hund + "en") Fem ;
---    _ + ("er" | "en" | "el") => mk6N hund hund hund (genitS hund) hund (pluralN hund) Masc ; 
---    _  => mk6N hund hund hund (genitS hund) (hund + "e") (pluralN hund) Masc
---    } ;
---
---  reg2N : (x1,x2 : Str) -> Gender -> N = \hund,hunde,g -> 
---    let
---      hunds = genitS hund ;
---      hundE = dativE hund ;
---      hunden = pluralN hunde
---    in
---    case <hund,hunde,g> of {                                        -- Duden p. 223
---      <_,_ + ("e" | "er"), Masc | Neutr> =>                         -- I,IV 
---        mk6N hund hund hundE hunds hunde hunden g ;
---      <_ + ("el"|"er"|"en"),_ + ("el"|"er"|"en"), Masc | Neutr> =>  -- II
---        mk6N hund hund hund hunds hunde hunden g ;
---      <_,_ + "s", Masc | Neutr> =>                                  -- V 
---        mk6N hund hund hund (hund + "s") hunde hunde g ;
---      <_,_ + "en", Masc> =>                                         -- VI 
---        mk6N hund hunde hunde hunde hunde hunde g ;
---      <_,_ + ("e" | "er"), Fem> =>                                  -- VII,VIII 
---        mk6N hund hund hund hund hunde hunden g ;
---      <_,_ + ("n" | "s"), Fem> =>                                   -- IX,X 
---        mk6N hund hund hund hund hunde hunde g ;
---      _ => {s = (regN hund).s ; g = g ; lock_N = <>}
---    } ;
---   
---  mkN2 = overload {
---    mkN2 : Str -> N2 = \s -> vonN2 (regN s) ;
---    mkN2 : N ->   N2 = vonN2 ;
---    mkN2 : N -> Prep -> N2 = mmkN2
---    } ;   
---
---
---  mmkN2  : N -> Prep -> N2 = \n,p -> n ** {c2 = p ; lock_N2 = <>} ;
---  vonN2 : N -> N2 = \n -> n ** {c2 = {s = "von" ; c = dative} ; lock_N2 = <>} ;
---
---  mkN3 = \n,p,q -> n ** {c2 = p ; c3 = q ; lock_N3 = <>} ;
---
---  mk2PN = \karolus, karoli -> 
---    {s = table {Gen => karoli ; _ => karolus} ; lock_PN = <>} ;
---  regPN = \horst -> 
---    mk2PN horst (ifTok Tok (Predef.dp 1 horst) "s" horst (horst + "s")) ;
---
---  mkPN = overload {
---    mkPN : Str -> PN = regPN ;
---    mkPN : (nom,gen : Str) -> PN = mk2PN ;
---    mkPN : (nom,acc,dat,gen : Str) -> PN = \nom,acc,dat,gen ->
---      {s = table {Nom => nom ; Acc => acc ; Dat => dat ; Gen => gen} ; lock_PN = <>} 
---    } ;
---
---  mk2PN  : (karolus, karoli : Str) -> PN ; -- karolus, karoli
---  regPN : (Johann : Str) -> PN ;  
---    -- Johann, Johanns ; Johannes, Johannes
---
---
---  mk3A : (gut,besser,beste : Str) -> A = \a,b,c ->
---    let aa : Str = case a of {
---      teu + "er" => teu + "r" ;
---      mud + "e" => mud ;
---      _ => a
---    } in 
---    MorphoDut.mkA a aa b (init c) ** {lock_A = <>} ;
---  mk4A : (gut,gute,besser,beste : Str) -> A = \a,aa,b,c ->
---    MorphoDut.mkA a aa b (init c) ** {lock_A = <>} ;
---
---  regA : Str -> A = \a -> case a of {
---    teu + "er" => mk3A a (teu + "rer") (teu + "reste") ;
---    _ + "e"    => mk3A a (a + "r") (a + "ste") ;
---    _          => mk3A a (a + "er") (a + "este")
---    } ;
-
   invarA = \s -> lin A {s = \\_,_ => s} ; ---- comparison
 
   mkA2 = \a,p -> lin A2 (a ** {c2 = p}) ;
 
   mkAdv s = {s = s ; lock_Adv = <>} ;
---
+
---  mkPrep s c = {s = s ; c = c ; lock_Prep = <>} ;
   noPrep = nomergePrep [] ;
---  datPrep = mkPrep [] dative ;
+
---  genPrep = mkPrep [] genitive ;
---  von_Prep = mkPrep "von" dative ;
---  zu_Prep = mkPrep "zu" dative ;
---
---  mk6V geben gibt gib gab gaebe gegeben = 
---    let
---      geb   = stemVerb geben ;
---      gebe  = geb + "e" ;
---      gibst = verbST (init gibt) ;
---      gebt  = verbT geb ;
---      gabst = verbST gab ;
---      gaben = pluralN gab ;
---      gabt  = verbT gab
---    in 
---    MorphoDut.mkV 
---      geben gebe gibst gibt gebt gib gab gabst gaben gabt gaebe gegeben
---      [] VHaben ** {lock_V = <>} ;
---
---  regV fragen = 
---    let
---      frag    = stemVerb fragen ;
---      fragt   = verbT frag ;
---      fragte  = fragt + "e" ;
---      gefragt = "ge" + fragt ;
---    in
---    mk6V fragen fragt (frag + "e") fragte fragte gefragt ;
---
---  irregV singen singt sang saenge gesungen = 
---    let
---      sing = stemVerb singen ;
---    in
---    mk6V singen singt sing sang saenge gesungen ;
---
---  prefixV p v = MorphoDut.prefixV p v ** {lock_V = v.lock_V} ;
---
---  habenV v = 
---    {s = v.s ; prefix = v.prefix ; lock_V = v.lock_V ; aux = VHaben ; vtype = v.vtype} ;
---  seinV v = 
---    {s = v.s ; prefix = v.prefix ; lock_V = v.lock_V ; aux = VSein ; vtype = v.vtype} ;
---  reflV v c = 
---    {s = v.s ; prefix = v.prefix ; lock_V = v.lock_V ; aux = VHaben ; vtype = VRefl c} ;
---
---  no_geV v = let vs = v.s in {
---    s = table {
---      p@(VPastPart _) => Predef.drop 2 (vs ! p) ;
---      p => vs ! p
---      } ;
---    prefix = v.prefix ; lock_V = v.lock_V ; aux = v.aux ; vtype = v.vtype
---    } ;
---
---  haben_V = MorphoDut.haben_V ** {lock_V = <>} ;
---  sein_V = MorphoDut.sein_V ** {lock_V = <>} ;
---  werden_V = MorphoDut.werden_V ** {lock_V = <>} ;
---
   prepV2 : V -> Prep -> V2 ;
   prepV2 v c = lin V2 (v ** {c2 = <c,True>}) ; --if it has prep, needed for word order (place of negation)
 

src/dutch/ResDut.gf

@@ -20,6 +20,13 @@ resource ResDut = ParamX ** open Prelude, Predef in {
     NPCase = NPNom | NPAcc ;
 
   oper
+    consonant : pattern Str = #("b"|"c"|"d"|"f"|"g"|"h"|"j"|"k"|"l"|"m"|"n"|"p"|"q"|"r"|"s"|"t"|"v"|"w"|"x"|"y"|"z") ;
+    vowel : pattern Str = #("a"|"e"|"i"|"o"|"u") ;
+
+    dupCons : pattern Str = #("b"|"d"|"f"|"g"|"k"|"l"|"m"|"n"|"p"|"r"|"s"|"t") ; -- duplicable consonant
+    dupVow  : pattern Str = #("aa"|"ee"|"oo"|"uu") ; -- actually duplicated vowel
+    diphthong : pattern Str = #("ei"|"eu"|"oe"|"ou"|"ie"|"ij"|"ui") ;
+
     Noun = {s : NForm => Str ; g : Gender} ;
 
     mkNoun : (_,_ : Str) -> Gender -> Noun = \sg,pl,g -> {
@@ -35,15 +42,15 @@ resource ResDut = ParamX ** open Prelude, Predef in {
     regNoun : Str -> Noun = \s -> case s of {
       _ + ("a"|"o"|"y"|"u"|"oe"|"é") => mkNoun s (s + "'s") Utr ;
       _ + ("oir"|"ion"|"je"|"c")     => mkNoun s (s + "s") Neutr ;
-      ? + ? + ? + _ + 
+      ? + ? + ? + _ + ("el" | "em" | "en" | "er" | "erd" | "aar" | "aard" | "ie")  -- unstressed
-        ("el" | "em" | "en" | "er" | "erd" | "aar" | "aard" | "ie") => -- unstressed
+                                     => mkNoun s (s + "s") Utr ;
-                                            mkNoun s (s + "s") Utr ;
-      _ +                     ("i"|"u")  => mkNoun s (endCons s + "en") Utr ;
-      b + v@("aa"|"ee"|"oo"|"uu") + c@?  => mkNoun s (b + shortVoc v c + "en") Utr ; 
-      b + ("ei"|"eu"|"oe"|"ou"|"ie"|"ij"|"ui") + ? => mkNoun s (endCons s + "en") Utr ;
       _ + ("ie"|"ee") => mkNoun s (s + "ën") Utr ; -- zee→zeeën, knie→knieën. 
                                                    -- olie→oliën, industrie→industrieën with 2-arg constructor.
-      b + v@("a"|"e"|"i"|"o"|"u") + c@? => mkNoun s (b + v + c + c + "en") Utr ;
+      _ + ("i"|"u")   => mkNoun s (endCons s + "en") Utr ;
+
+      b + #diphthong + ?         => mkNoun s (endCons s + "en") Utr ; -- boek→boeken
+      b + v@#dupVow + c@?        => mkNoun s (b + shortVoc v c + "en") Utr ;
+      b + v@#vowel + c@#dupCons  => mkNoun s (b + v + c + c + "en") Utr ;
       _ + "e" => mkNoun s (s + "s") Utr ; -- vrede→vredes. Might not be a good generalisation though. /IL2018
       _       => mkNoun s (endCons s + "en") Utr
       } ;
@@ -62,7 +69,6 @@ resource ResDut = ParamX ** open Prelude, Predef in {
       _ => s
       } ;
 
-    dupCons : pattern Str = #("b"|"d"|"f"|"g"|"k"|"l"|"m"|"n"|"p"|"r"|"s"|"t") ;
 
     add_s : Str -> Str = \s -> case s of {
       _ + "s" => s ;
@@ -100,11 +106,12 @@ resource ResDut = ParamX ** open Prelude, Predef in {
       let 
         se : Str = case s of {
           _ + ("er"|"en"|"ig") => s + "e" ; --- for unstressed adjective suffixes 
-          _ + ("i"|"u"|"ij") => endCons s + "e" ;
+          _ + ("i"|"u"|"ij")   => endCons s + "e" ; -- ambigu-ambigue
-          b + v@("aa"|"ee"|"oo"|"uu") + c@?             => b + shortVoc v c + "e" ;
+          _ + ("a"|"e"|"o")    => s ; -- no e: lila-lila ; beige-beige ; indigo-indigo
-          b + ("ei"|"eu"|"oe"|"ou"|"ie"|"ij"|"ui") + ?  => endCons s + "e" ;
+
-          b + v@("a"|"e"|"i"|"o"|"u" )            + "w" => s + "e" ; -- to prevent *blauwwe -- does this happen to other end consonants?
+          b + v@#dupVow + c@?  => b + shortVoc v c + "e" ;
-          b + v@("a"|"e"|"i"|"o"|"u" )            + c@? => b + v + c + c + "e" ;
+          b + #diphthong + ?   => endCons s + "e" ;
+          b + v@#vowel + c@#dupCons  => b + v + c + c + "e" ;
           _ => endCons s + "e"
           } ;
       in reg2Adjective s se ;
@@ -215,8 +222,6 @@ param
          _ => d_regVerb vergeten vergeet
         };
 
-    consonant : pattern Str = #("b"|"c"|"d"|"f"|"g"|"h"|"j"|"k"|"l"|"m"|"n"|"p"|"q"|"r"|"s"|"t"|"v"|"w"|"x"|"y"|"z") ;
-    vowel : pattern Str = #("a"|"e"|"i"|"o"|"u") ;
     -- To make a stem out of a verb
     -- If a stem ends in a 'v' then the 'v' changes into a 'f'
     -- If a stem ends in a 'z' then the 'z' changes into an 's'
@@ -243,7 +248,7 @@ param
                                                     -- Penultimate is vowel, but it doesn't double: either because
       _+ #vowel + _ + #vowel + #consonant => kerf ; -- a) ≥2 syllables, e.g. ademen, rekenen, schakelen
                                                     -- b) diphthong, e.g. vriezen  (ij + #consonant falls into the default case!)
-                                                    -- OBS. will do the wrong thing, if you use it on prefix verbs
+                                                    -- NB. this will do the wrong thing, if you use it on prefix verbs
 
       _ + #vowel + ("w"|"j")  => werk ; -- Don't double a vowel before a w or j (are there other consonants?)
 
@@ -353,7 +358,7 @@ param
        VInf        => "zullen" ;
        VInfFull    => "zullen" ;
        VPresSg1    => "zal" ;
-       VPresSg2    => "zult" ;
+       VPresSg2    => "zal" ;
        VPresSg3    => "zal" ;
        VPresPl     => "zullen" ;
        VPastSg     => "zou" ; --# notpresent
@@ -378,7 +383,7 @@ param
        VInf        => "kunnen" ;
        VInfFull    => "kunnen" ;
        VPresSg1    => "kan" ;
-       VPresSg2    => "kunt" ;
+       VPresSg2    => "kan" ;
        VPresSg3    => "kan" ; ---- kun je
        VPresPl     => "kunnen" ;
        VPastSg     => "kon" ; --# notpresent

src/german/NounGer.gf

@@ -199,9 +199,9 @@ concrete NounGer of Noun = CatGer ** open ResGer, MorphoGer, Prelude in {
       rc = (np.rc ++ embedInCommas (rs.s ! RGenNum (gennum (genderAgr np.a) (numberAgr np.a)))) ;
       isPron = False } ;
 
-    SentCN cn s = cn ** {ext = embedInCommas s.s} ;
+    SentCN cn s = cn ** {ext = cn.ext ++ embedInCommas s.s} ;
 
-    AdvCN cn a = cn ** {adv = a.s} ;
+    AdvCN cn a = cn ** {adv = cn.adv ++ a.s} ;
 
     ApposCN  cn np = let g = cn.g in cn ** {
       s = \\a,n,c => cn.s ! a ! n ! c ++ np.s ! NPC c ++ bigNP np } ;

src/translator/ExtensionsDut.gf

@@ -1,7 +1,7 @@
 --# -path=.:../abstract
 
 concrete ExtensionsDut of Extensions = 
-  CatDut ** open MorphoDut, ResDut, ParadigmsDut, SyntaxDut, (E = ExtraDut), (G = GrammarDut), Prelude in {
+  CatDut ** open ResDut, ParadigmsDut, SyntaxDut, (E = ExtraDut), ExtendDut, (G = GrammarDut), Prelude in {
 
 flags literal=Symb ; coding = utf8 ;
 
@@ -70,14 +70,13 @@ lin
     } ;
 
   CompoundAP noun adj = {
-      s = \\af => glue (noun.s ! NF Sg Nom) (adj.s ! Posit ! af) ;
+      s = \\agr,af => glue (noun.s ! NF Sg Nom) (adj.s ! Posit ! af) ;
       isPre = True
       } ;
 
-  GerundNP vp = {  -- infinitive: Bier zu trinken
+  GerundNP vp = heavyNP {  -- infinitive: Bier zu trinken
-    s = \\c => useInfVP False vp  ; 
+    s = \\c => useInfVP False vp ! agrP3 Sg ; 
-    a = agrP3 Sg ;
+    a = agrP3 Sg
-    isPron = False
     } ;
 
   GerundAdv vp = {  -- Bier trinkend
@@ -85,33 +84,31 @@ lin
     } ;
 
   WithoutVP vp = {  -- ohne Bier zu trinken
-    s = "zonder" ++ useInfVP False vp 
+    s = "zonder" ++ useInfVP False vp ! agrP3 Sg
     } ;
 
   InOrderToVP vp = {  -- um Bier zu trinken
-    s = "om" ++ useInfVP False vp 
+    s = "om" ++ useInfVP False vp ! agrP3 Sg
     } ;
 
   ByVP vp = {  ---- durch Bier zu drinken
-    s = "door" ++ useInfVP False vp ----
+    s = "door" ++ useInfVP False vp ! agrP3 Sg ----
     } ;
 
-  PresPartAP vp = {
+  PastPartAP = ExtendDut.PastPartAP ;
-    s = \\af => vp.n0 ! agrP3 Sg ++ vp.n2 ! agrP3 Sg ++ vp.a2 ++ vp.a1 ! Pos ++ vp.inf.p1 ++ vp.ext ++ vp.s.s ! VPresPart ;
-    isPre = True
-    } ;
   
-  PastPartAP vp = {
+  PresPartAP vp = { --# notpresent
-    s = \\af => vp.n0 ! agrP3 Sg ++ vp.n2 ! agrP3 Sg ++ vp.a2 ++ vp.a1 ! Pos ++ vp.inf.p1 ++ vp.ext ++ vp.s.s ! VPerf ; ---- agr inflection?
+    s = \\agr,af => let aForm = case vp.isHeavy of { --# notpresent
-    isPre = True
+                          True  => APred ; --# notpresent
-    } ;
+                          False => af } ; --# notpresent
+                     in (infClause [] agr vp aForm).s ! Pres ! Simul ! Pos ! Sub ; --# notpresent
+    isPre = notB vp.isHeavy ; --# notpresent
+   } ; --# notpresent
 
   PastPartAgentAP vp np = 
-    let agent = (SyntaxDut.mkAdv (mkPrep "door") (lin NP np)).s
+    let agent = (SyntaxDut.mkAdv (mkPrep "door") (lin NP np)).s ;
-    in {
+        ap = ExtendDut.PastPartAP vp ;
-      s = \\af => vp.n0 ! agrP3 Sg ++ vp.n2 ! agrP3 Sg ++ vp.a2 ++ vp.a1 ! Pos ++ vp.inf.p1 ++ vp.ext ++ vp.s.s ! VPerf ; ---- agr inflection?
+    in ap ** { s = \\agr,af => ap.s ! agr ! af ++ agent } ;
-      isPre = True
-      } ;
 
 {-  
 
@@ -139,16 +136,15 @@ lin
     } ;
 -}
   CompS s = {s = \\_ => "dat" ++ s.s ! Main} ;  -- S -> Comp
-  CompVP ant p vp = {s = \\_ => useInfVP True vp} ; -- VP -> Comp
+  CompVP ant p vp = {s = useInfVP True vp} ; -- VP -> Comp
 
 lin
   that_RP = which_RP ;
 
   UttAdV adv = adv ;
 
-  ApposNP np1 np2 = {
+  ApposNP np1 np2 = np1 ** {
     s = \\c => np1.s ! c ++ SOFT_BIND ++ "," ++ np2.s ! NPNom ;
-    a = np1.a ;
     isPron = False
   } ;
   

src/translator/ExtensionsEng.gf

@@ -129,7 +129,7 @@ lin
 
   VPSlashVS vs vp = 
     insertObj (\\a => infVP VVInf vp Simul CPos a) (predV vs) **
-    {c2 = ""; gapInMiddle = False} ;
+    {c2 = ""; gapInMiddle = False ; missingAdv = True} ; ---- missingAdv?
 
   PastPartRS ant pol vps = {
     s = \\agr => vps.ad ! agr ++ vps.ptp ++ vps.p ++ vps.s2 ! agr ;

src/translator/TranslateDut.gf

@@ -30,7 +30,7 @@ concrete TranslateDut of Translate =
     , WithoutVP, InOrderToVP, ByVP
   ],
   DictionaryDut ** 
-open MorphoDut, ResDut, ParadigmsDut, SyntaxDut, (E = ExtraDut), Prelude in {
+open ResDut, ParadigmsDut, SyntaxDut, (E = ExtendDut), Prelude in {
 
 flags
   literal=Symb ;