1
0
forked from GitHub/gf-rgl
This commit is contained in:
Krasimir Angelov
2018-06-16 07:09:17 +02:00
18 changed files with 186 additions and 364 deletions

1
doc/browse/.gitignore vendored Normal file
View File

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

2
doc/browse/build-tags.sh Normal file → Executable file
View File

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

View File

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

View File

@@ -41,9 +41,26 @@ resource ParadigmsAra = open
--2 Nouns --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 --This is used for loan words or anything that has untreated irregularities
--in the interdigitization process of its words --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 --Takes a root string, a singular pattern string, a broken plural
--pattern string, a gender, and species. Gives a noun. --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 --and species. Gives a noun whose plural is sound masculine
sdmN : Str -> Str -> Gender -> Species -> N ; 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 --3 Relational nouns
@@ -65,13 +94,26 @@ resource ParadigmsAra = open
mkN3 : N -> Preposition -> Preposition -> N3 ; mkN3 : N -> Preposition -> Preposition -> N3 ;
--2 Adjectives --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 --Takes a root string and a pattern string
sndA : Str -> Str -> A ; sndA : (root,patt : Str) -> A ;
--Takes a root string only --Takes a root string only
clrA : Str -> A ; clrA : (root : Str) -> A ; -- forms adjectives of type aFCal
--3 Two-place adjectives --3 Two-place adjectives
-- --
@@ -96,13 +138,26 @@ resource ParadigmsAra = open
-- A preposition as used for rection in the lexicon, as well as to -- A preposition as used for rection in the lexicon, as well as to
-- build $PP$s in the resource API, just requires a string. -- 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 --2 Verbs
--The verb in the imperfect tense gives the most information -- 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 ; regV : Str -> V ;
@@ -296,7 +351,7 @@ resource ParadigmsAra = open
Preposition = Str ; Preposition = Str ;
mkN nsc gen spec = mkFullN nsc gen spec =
{ s = nsc; --NTable { s = nsc; --NTable
g = gen; g = gen;
h = spec; h = spec;
@@ -307,7 +362,7 @@ resource ParadigmsAra = open
\root,sg,pl,gen,spec -> \root,sg,pl,gen,spec ->
let { kitAb = mkWord sg root; let { kitAb = mkWord sg root;
kutub = mkWord pl 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 = brkN root sg pl gen spec =
let { raw = brkN' root sg pl gen spec} in let { raw = brkN' root sg pl gen spec} in
@@ -323,14 +378,14 @@ resource ParadigmsAra = open
sdfN = sdfN =
\root,sg,gen,spec -> \root,sg,gen,spec ->
let { kalima = mkWord sg root; let { kalima = mkWord sg root;
} in mkN (sndf kalima) gen spec; } in mkFullN (sndf kalima) gen spec;
sdmN = sdmN =
\root,sg,gen,spec -> \root,sg,gen,spec ->
let { mucallim = mkWord sg root; 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 ; { s = \\c => str + indecl!c ;
g = gen; g = gen;
h = species; h = species;
@@ -401,6 +456,9 @@ resource ParadigmsAra = open
lock_Quant = <> lock_Quant = <>
}; };
degrA : (posit,compar,plur : Str) -> A
= \posit,compar,plur -> lin A {s = clr posit compar plur} ;
sndA root pat = sndA root pat =
let raw = sndA' root pat in { let raw = sndA' root pat in {
s = \\af => s = \\af =>
@@ -467,4 +525,28 @@ resource ParadigmsAra = open
mkA2V v p = mkA2 v p ** {lock_A2 = <>} ; 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 ;
} ; } ;

View File

@@ -2,7 +2,7 @@
concrete ConstructionDut of Construction = CatDut ** concrete ConstructionDut of Construction = CatDut **
open SyntaxDut, SymbolicDut, ParadigmsDut, 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 lin
@@ -49,9 +49,9 @@ lin
monthAdv m = SyntaxDut.mkAdv in_Prep (mkNP the_Det m) ; monthAdv m = SyntaxDut.mkAdv in_Prep (mkNP the_Det m) ;
yearAdv y = SyntaxDut.mkAdv (mkPrep "in jaar") y ; ---- 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 ; intYear = symb ;
intMonthday = symb ; intMonthday = symb ;

View File

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

View File

@@ -1,5 +1,5 @@
concrete ExtraDut of ExtraDutAbs = CatDut ** 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 ; flags coding=utf8 ;
@@ -19,9 +19,9 @@ concrete ExtraDut of ExtraDutAbs = CatDut **
predVGen v.isAux BeforeObjs v) ; ---- predVGen v.isAux BeforeObjs v) ; ----
lin lin
ICompAP ap = {s = \\agr => "hoe" ++ ap.s ! agr ! APred} ; ICompAP = E.ICompAP ;
IAdvAdv adv = {s = "hoe" ++ adv.s} ; IAdvAdv = E.IAdvAdv ;
lincat lincat
VPS = {s : Order => Agr => Str} ; VPS = {s : Order => Agr => Str} ;
@@ -109,7 +109,7 @@ lin
inf : Str = vp.inf.p1 ; inf : Str = vp.inf.p1 ;
extra : Str = vp.ext extra : Str = vp.ext
in 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 lin

View File

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

View File

@@ -169,7 +169,7 @@ lin weven_V = mkV "weven" "weefde" "weefden" "geweven" ;
lin wijken_V = mkZijnV "wijken" "week" "weken" "geweken" ; lin wijken_V = mkZijnV "wijken" "week" "weken" "geweken" ;
lin wijten_V = mkV "wijten" "weet" "weten" "geweten" ; lin wijten_V = mkV "wijten" "weet" "weten" "geweten" ;
lin wijzen_V = mkV "wijzen" "wees" "wezen" "gewezen" ; 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 winden_V = mkV "winden" "wond" "wonden" "gewonden" ;
lin winnen_V = mkV "winnen" "won" "wonnen" "gewonnen" ; lin winnen_V = mkV "winnen" "won" "wonnen" "gewonnen" ;
lin worden_V = mkV "worden" "werd" "werden" "geworden" ; lin worden_V = mkV "worden" "werd" "werden" "geworden" ;

View File

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

View File

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

View File

@@ -9,22 +9,17 @@ concrete NounDut of Noun = CatDut ** open ResDut, Prelude in {
isPron = False ; isPron = False ;
} ; } ;
DetNP det = { DetNP det = det ** {
s = \\_ => det.sp ! Neutr ; s = \\_ => det.sp ! Neutr ;
a = agrP3 det.n ; 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} ; 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} ; s = table {NPNom => pron.stressed.nom ; NPAcc => pron.stressed.acc} ;
a = pron.a ;
isPron = True ; isPron = True ;
mergesWithPrep = pron.mergesWithPrep ;
mergeForm = pron.mergeForm
} ; } ;
PredetNP pred np = heavyNP { PredetNP pred np = heavyNP {
@@ -50,33 +45,30 @@ concrete NounDut of Noun = CatDut ** open ResDut, Prelude in {
DetQuantOrd quant num ord = DetQuantOrd quant num ord =
let 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 = DetQuant quant num =
let let
n = num.n ; n = num.n ;
a = quant.a a = quant.a
in { in quant ** {
s = \\g => quant.s ! num.isNum ! n ! g ++ num.s ; s = \\g => quant.s ! num.isNum ! n ! g ++ num.s ;
sp = \\g => case num.isNum of { sp = \\g => case num.isNum of {
False => quant.sp ! n ! g ++ num.s ; 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 ; n = n ;
a = a ; a = a ;
mergesWithPrep = quant.mergesWithPrep ;
mergeForm = quant.mergeForm
} ; } ;
PossPron p = noMerge ** { PossPron p = noMerge ** {

View File

@@ -327,169 +327,14 @@ oper
} ; } ;
mkmaxV3 : V -> Prep -> Prep -> V3 = \v,c,d -> lin V3 (v ** {c2 = <c,True> ; c3 = <d,True>}) ; 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 invarA = \s -> lin A {s = \\_,_ => s} ; ---- comparison
mkA2 = \a,p -> lin A2 (a ** {c2 = p}) ; mkA2 = \a,p -> lin A2 (a ** {c2 = p}) ;
mkAdv s = {s = s ; lock_Adv = <>} ; mkAdv s = {s = s ; lock_Adv = <>} ;
--
-- mkPrep s c = {s = s ; c = c ; lock_Prep = <>} ;
noPrep = nomergePrep [] ; 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 -> Prep -> V2 ;
prepV2 v c = lin V2 (v ** {c2 = <c,True>}) ; --if it has prep, needed for word order (place of negation) prepV2 v c = lin V2 (v ** {c2 = <c,True>}) ; --if it has prep, needed for word order (place of negation)

View File

@@ -20,6 +20,13 @@ resource ResDut = ParamX ** open Prelude, Predef in {
NPCase = NPNom | NPAcc ; NPCase = NPNom | NPAcc ;
oper 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} ; Noun = {s : NForm => Str ; g : Gender} ;
mkNoun : (_,_ : Str) -> Gender -> Noun = \sg,pl,g -> { mkNoun : (_,_ : Str) -> Gender -> Noun = \sg,pl,g -> {
@@ -33,17 +40,17 @@ resource ResDut = ParamX ** open Prelude, Predef in {
} ; } ;
regNoun : Str -> Noun = \s -> case s of { regNoun : Str -> Noun = \s -> case s of {
_ + ("a" | "o" | "y" | "u" | "oe" | "é") => mkNoun s (s + "'s") Utr ; _ + ("a"|"o"|"y"|"u"|"oe"|"é") => mkNoun s (s + "'s") Utr ;
_ + ("oir" | "ion" | "je" | "c") => mkNoun s (s + "s") Neutr ; _ + ("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. _ + ("ie"|"ee") => mkNoun s (s + "ën") Utr ; -- zee→zeeën, knie→knieën.
-- olie→oliën, industrie→industrieën with 2-arg constructor. -- 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 _ + "e" => mkNoun s (s + "s") Utr ; -- vrede→vredes. Might not be a good generalisation though. /IL2018
_ => mkNoun s (endCons s + "en") Utr _ => mkNoun s (endCons s + "en") Utr
} ; } ;
@@ -62,7 +69,6 @@ resource ResDut = ParamX ** open Prelude, Predef in {
_ => s _ => s
} ; } ;
dupCons : pattern Str = #("b"|"d"|"f"|"g"|"k"|"l"|"m"|"n"|"p"|"r"|"s"|"t") ;
add_s : Str -> Str = \s -> case s of { add_s : Str -> Str = \s -> case s of {
_ + "s" => s ; _ + "s" => s ;
@@ -99,12 +105,13 @@ resource ResDut = ParamX ** open Prelude, Predef in {
regAdjective : Str -> Adjective = \s -> regAdjective : Str -> Adjective = \s ->
let let
se : Str = case s of { se : Str = case s of {
_ + ("er"|"en"|"ig") => s + "e" ; --- for unstressed adjective suffixes _ + ("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" _ => endCons s + "e"
} ; } ;
in reg2Adjective s se ; in reg2Adjective s se ;
@@ -215,8 +222,6 @@ param
_ => d_regVerb vergeten vergeet _ => 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 -- 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 'v' then the 'v' changes into a 'f'
-- If a stem ends in a 'z' then the 'z' changes into an 's' -- 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 -- Penultimate is vowel, but it doesn't double: either because
_+ #vowel + _ + #vowel + #consonant => kerf ; -- a) ≥2 syllables, e.g. ademen, rekenen, schakelen _+ #vowel + _ + #vowel + #consonant => kerf ; -- a) ≥2 syllables, e.g. ademen, rekenen, schakelen
-- b) diphthong, e.g. vriezen (ij + #consonant falls into the default case!) -- 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?) _ + #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" ; VInf => "zullen" ;
VInfFull => "zullen" ; VInfFull => "zullen" ;
VPresSg1 => "zal" ; VPresSg1 => "zal" ;
VPresSg2 => "zult" ; VPresSg2 => "zal" ;
VPresSg3 => "zal" ; VPresSg3 => "zal" ;
VPresPl => "zullen" ; VPresPl => "zullen" ;
VPastSg => "zou" ; --# notpresent VPastSg => "zou" ; --# notpresent
@@ -378,7 +383,7 @@ param
VInf => "kunnen" ; VInf => "kunnen" ;
VInfFull => "kunnen" ; VInfFull => "kunnen" ;
VPresSg1 => "kan" ; VPresSg1 => "kan" ;
VPresSg2 => "kunt" ; VPresSg2 => "kan" ;
VPresSg3 => "kan" ; ---- kun je VPresSg3 => "kan" ; ---- kun je
VPresPl => "kunnen" ; VPresPl => "kunnen" ;
VPastSg => "kon" ; --# notpresent VPastSg => "kon" ; --# notpresent

View File

@@ -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)))) ; rc = (np.rc ++ embedInCommas (rs.s ! RGenNum (gennum (genderAgr np.a) (numberAgr np.a)))) ;
isPron = False } ; 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 ** { ApposCN cn np = let g = cn.g in cn ** {
s = \\a,n,c => cn.s ! a ! n ! c ++ np.s ! NPC c ++ bigNP np } ; s = \\a,n,c => cn.s ! a ! n ! c ++ np.s ! NPC c ++ bigNP np } ;

View File

@@ -1,7 +1,7 @@
--# -path=.:../abstract --# -path=.:../abstract
concrete ExtensionsDut of Extensions = 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 ; flags literal=Symb ; coding = utf8 ;
@@ -70,14 +70,13 @@ lin
} ; } ;
CompoundAP noun adj = { 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 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 GerundAdv vp = { -- Bier trinkend
@@ -85,33 +84,31 @@ lin
} ; } ;
WithoutVP vp = { -- ohne Bier zu trinken WithoutVP vp = { -- ohne Bier zu trinken
s = "zonder" ++ useInfVP False vp s = "zonder" ++ useInfVP False vp ! agrP3 Sg
} ; } ;
InOrderToVP vp = { -- um Bier zu trinken InOrderToVP vp = { -- um Bier zu trinken
s = "om" ++ useInfVP False vp s = "om" ++ useInfVP False vp ! agrP3 Sg
} ; } ;
ByVP vp = { ---- durch Bier zu drinken 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 = 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 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 lin
that_RP = which_RP ; that_RP = which_RP ;
UttAdV adv = adv ; UttAdV adv = adv ;
ApposNP np1 np2 = { ApposNP np1 np2 = np1 ** {
s = \\c => np1.s ! c ++ SOFT_BIND ++ "," ++ np2.s ! NPNom ; s = \\c => np1.s ! c ++ SOFT_BIND ++ "," ++ np2.s ! NPNom ;
a = np1.a ;
isPron = False isPron = False
} ; } ;

View File

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

View File

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