Merge branch 'master' of github.com:GrammaticalFramework/gf-rgl

This commit is contained in:
Krasimir Angelov
2023-08-21 15:00:01 +02:00
34 changed files with 950 additions and 600 deletions

View File

@@ -1,7 +1,8 @@
name: Check that the RGL can successfully build
on:
push
- push
- pull_request
jobs:
build:

View File

@@ -1,4 +1,4 @@
--# -path=.:alltenses:prelude
--# -path=../abstract:.:alltenses:prelude:
instance SyntaxGer of Syntax = ConstructorsGer, CatGer, StructuralGer, CombinatorsGer ;

View File

@@ -1,12 +1,24 @@
abstract Infinitive =
Grammar - [VPSlashPrep], ---- to avoid certain spurious ambiguities, to be fixed
Grammar - [
VPSlashPrep, --- to avoid certain spurious ambiguities, to be fixed
PassV2 ---- temporarily disabled, to be fixed
],
Lexicon
** {
flags startcat = Utt ;
data
cat
RAdv ; -- reflexive adverbs, e.g. mennäkse (ni/si/...)
fun
UseV2 : V2 -> VP ; -- to use V2 intransitively, suppressing object
RAdvVP : VP -> RAdv -> VP ; -- syödä elääkseni
X_NP, Y_NP, Z_NP : NP ; -- unknown subjects and objects
tulla_VV : VV ; -- tulla (tekemään), explicit future tense
PresPartPassSubjVP : VP -> VP ; -- (minun) on mentävä
PresPartPassObjVP : VPSlash -> VP ; -- (oluesta) on pidettävä
@@ -19,13 +31,12 @@ data
AgentPartAP : NP -> VPSlash -> AP ; -- koiran syömä
Inf1LongRAdv : VP -> RAdv ; -- mennäkse (ni/si/...)
Inf2InessAdv : NP -> VP -> Adv ; -- junan mennessä
Inf2InessPassAdv : VP -> Adv ; -- odotettaessa (junaa), touhuttaessa (junan kanssa)
Inf2InessPassInvAdv : NP -> VPSlash -> Adv ; -- junaa odotettaessa, junan kanssa touhutessa
Inf2InstrAdv : VP -> Adv ; -- odottaen (junaa)
Inf2InstrInvAdv : NP -> VPSlash -> Adv ; -- junaa odottaen
Inf2InstrAdv : VP -> Adv ; -- odottaen (junaa)
Inf2InstrInvAdv : NP -> VPSlash -> Adv ; -- junaa odottaen

View File

@@ -1,15 +1,28 @@
--# -path=..:alltenses
concrete InfinitiveFin of Infinitive =
GrammarFin - [VPSlashPrep],
GrammarFin - [
VPSlashPrep,
PassV2],
LexiconFin
** open
ResFin,
StemFin,
Prelude
Prelude,
ParadigmsFin
in {
lincat
RAdv = {s : Agr => Str} ;
lin
UseV2 v2 = predSV v2 ;
RAdvVP vp radv = insertObj (\\_,_ => radv.s) vp ; ---- can be wrong word order
X_NP = MassNP (UseN (mkN "X" "X:n")) ;
Y_NP = MassNP (UseN (mkN "Y" "Z:n")) ;
Z_NP = MassNP (UseN (mkN "Z" "Z:n")) ;
PresPartPassSubjVP vp = vp ** {
s = vpVerbOlla ** {sc = SCGen} ;
s2 = \\b,p,a => vp.s.s ! PresPartPass (AN (NCase Sg Nom)) ++ vp.s2 ! b ! p ! a ;
@@ -64,6 +77,12 @@ lin
p = []
} ;
Inf1LongRAdv vp = {
s = \\a =>
infVP SCNom Pos infAdvAgr vp Inf1Long ++ BIND ++
case vp.s.h of {Back => possSuffix a ; Front => possSuffixFront a}
} ;
Inf2InessAdv np vp = {
s = np.s ! NPCase Gen ++
infVP SCNom Pos np.a vp Inf2Iness
@@ -159,7 +178,7 @@ oper
-- hänen syövän, häntä syödyn, häntä syötävän
subjPartVP : ResFin.NP -> StemFin.VP -> NPForm -> VForm -> Str = \np, vp, npform, vform ->
np.s ! NPCase Gen ++
np.s ! npform ++
vp.s.s ! vform ++
vp.s2 ! True ! Pos ! np.a ++
vp.adv ! Pos ++

View File

@@ -0,0 +1,116 @@
{-# LANGUAGE GADTs #-}
module Main where
import Infinitive
import PGF
import Data.List
data Fact = Fact {
content :: [Fact],
tense :: Maybe GTemp,
polarity :: Maybe GPol,
source :: Maybe GNP,
attitude :: Maybe GVS,
agent :: Maybe GNP,
action :: Maybe GVP
}
initFact = Fact [] Nothing Nothing Nothing Nothing Nothing Nothing
factTree fact = case action fact of
(Just vp) ->
GUttS $ GUseCl
(maybe presentTense id (tense fact))
(maybe positivePol id (polarity fact))
(GPredVP
(maybe (maybe Gsomebody_NP id (source fact)) id (agent fact))
vp)
_ -> GUttNP Gnothing_NP
presentTense = GTTAnt GTPres GASimul
pastTense = GTTAnt GTPast GASimul
perfectTense = GTTAnt GTPres GAAnter
pluperfectTense = GTTAnt GTPast GAAnter
positivePol = GPPos
negativePol = GPNeg
facts :: Infinitive.Tree a -> [Fact]
facts t = case t of
GAdjCN (GAgentPartAP np vpslash) cn ->
[initFact{
tense = Just perfectTense,
agent = Just np,
action = Just (GComplSlash vpslash (GMassNP cn))}]
GPredVP np (GComplPresPartActAgrVS vs vp) ->
[initFact{
attitude = Just vs,
source = Just np,
action = Just vp}]
GPredVP np (GComplPastPartActAgrVS vs vp) ->
[initFact{tense = Just perfectTense,
attitude = Just vs,
source = Just np,
action = Just vp}]
GPredVP np (GAdvVP vp adv) ->
[f{source = Just np} | f <- facts vp ++ facts adv]
GPredVP np vp ->
[f{source = Just np} | f <- facts vp]
GUseV v ->
[initFact{
action = Just t}]
GComplPresPartActVS vs np vp ->
[initFact{
attitude =
Just vs,
agent = Just np,
action = Just vp}]
GComplPastPartActVS vs np vp ->
[initFact{
tense = Just perfectTense,
attitude = Just vs,
agent = Just np,
action = Just vp}]
GInf3AbessAdv vp ->
[initFact{
polarity = Just negativePol,
action = Just vp}]
GComplPresPartPassVS vs np vpslash ->
[initFact{
attitude = Just vs,
action = Just (GComplSlash vpslash np)}]
GComplPastPartPassVS vs np vpslash ->
[initFact{
tense = Just perfectTense,
attitude = Just vs,
action = Just (GComplSlash vpslash np)}]
_ -> composOpMPlus facts t
shortest = take 1 . sortOn treesize
treesize t = case unApp t of
Just (f, xs) -> 1 + sum (map treesize xs)
_ -> 1
treat gr fin cat s = [
(showExpr [] t ++ "\t" ++ linearize gr fin t)
| pt <- shortest (parse gr fin cat s),
let gt = map (gf . factTree) (facts (fg pt :: GUtt)),
t <- gt
]
main = do
gr <- readPGF "Infinitive.pgf"
putStrLn "gr"
let Just fin = readLanguage "InfinitiveFin"
let typ = startCat gr
flip mapM_ [0..] $ \_ -> do
putStr "> "
s <- getLine
let ss = treat gr fin typ s
putStrLn $ unlines ss

View File

@@ -0,0 +1,7 @@
all: pgf hs
pgf:
gf --make -output-format=haskell -haskell=lexical -lexical=N,A,Adv,V,V2,VS,VV,PN --haskell=gadt InfinitiveFin.gf
hs:
ghc --make InterpretInfinitives.hs

View File

@@ -10,14 +10,18 @@ concrete AdjectiveGer of Adjective = CatGer ** open ResGer, Prelude in {
c = <[],[]> ;
ext = []
} ;
ComparA a np = {
s = \\af => a.s ! Compar ! af ++ conjThan ++ np.s ! NPC Nom ++ bigNP np ;
ComparA a np =
let nps = np.s ! False ! Nom ++ bigNP np
in {
s = \\af => a.s ! Compar ! af ++ conjThan ++ nps ;
isPre = True ;
c = <[],[]> ;
ext = []
} ;
CAdvAP ad ap np = ap ** {
s = \\af => ad.s ++ ap.s ! af ++ ad.p ++ np.s ! NPC Nom ++ bigNP np ;
CAdvAP ad ap np =
let nps = np.s ! False ! Nom ++ bigNP np in
ap ** {
s = \\af => ad.s ++ ap.s ! af ++ ad.p ++ nps ;
isPre = False
} ;
UseComparA a = {
@@ -38,8 +42,8 @@ concrete AdjectiveGer of Adjective = CatGer ** open ResGer, Prelude in {
ComplA2 a np =
let CExt = case a.c2.isPrep of {
False => <appPrepNP a.c2 np, []> ;
True => <[], appPrepNP a.c2 np> }
isCase => <appPrepNP a.c2 np, []> ;
_ => <[], appPrepNP a.c2 np> } -- HL: check 7/22
in {
s = a.s ! Posit ;
isPre = True ;
@@ -49,10 +53,9 @@ concrete AdjectiveGer of Adjective = CatGer ** open ResGer, Prelude in {
ReflA2 a =
let
compl = appPrep a.c2 (\\k => usePrepC k (\c -> reflPron ! agrP3 Sg ! c)) ;
compl = appPrep a.c2 (reflPron ! agrP3 Sg) ;
CExt = case a.c2.isPrep of
{False => <compl, []> ;
True => <[], compl> }
{isCase => <compl, []> ; _ => <[], compl> }
in {
s = a.s ! Posit ;
isPre = True ;

View File

@@ -3,8 +3,10 @@ concrete AdverbGer of Adverb = CatGer ** open ResGer, Prelude in {
lin
PositAdvAdj a = {s = a.s ! Posit ! APred} ;
ComparAdvAdj cadv a np = {
s = cadv.s ++ a.s ! Posit ! APred ++ cadv.p ++ np.s ! NPC Nom
ComparAdvAdj cadv a np =
let nps = np.s ! False ! Nom ++ bigNP np in
{
s = cadv.s ++ a.s ! Posit ! APred ++ cadv.p ++ nps
} ;
ComparAdvAdjS cadv a s = {
s = cadv.s ++ a.s ! Posit ! APred ++ cadv.p ++ s.s ! Sub

View File

@@ -5,6 +5,5 @@ concrete AllGer of AllGerAbs =
IrregGer,
---- ExtendGer, ---- to replace ExtraGer
ExtraGer
**
open ExtendGer in ---- to force compilation
{} ;
** open ExtendGer in {} ---- to force compilation
;

View File

@@ -1,3 +1,4 @@
--# -path=.:../abstract:../common:../prelude
concrete CatGer of Cat =
CommonX - [Tense,Temp] **
open ResGer, Prelude in {
@@ -41,7 +42,7 @@ concrete CatGer of Cat =
VPSlash = ResGer.VPSlash ;
Comp = {s : Agr => Str ; ext : Str} ;
-- Adjective
-- Adjective (HL 7/23: we need c : Agr => Str * Str to handle reflexive objects, cf ReflA2)
AP = {s : AForm => Str ; isPre : Bool ; c: Str * Str ; ext : Str} ;
-- ich bin [c1 ihm] treu
@@ -57,20 +58,28 @@ concrete CatGer of Cat =
adv : Str ; -- Haus [adv auf dem Hügel]
g : Gender
} ;
NP = ResGer.NP ;
Pron = {s : NPForm => Str ; a : Agr} ;
Det, DAP = {s,sp : Gender => PCase => Str ; n : Number ; a : Adjf ; isDef : Bool} ;
-- simplified PCase to Case in NP, Det, DAP, Quant, Predet HL 8/22
NP = ResGer.NP ;
Det = {s,sp : Bool => Gender => Case => Str ; -- True if DefArt is dropped HL 8/22
n : Number ; a : Adjf ; isDef, hasDefArt : Bool } ;
DAP = {s,sp : Gender => Case => Str ; n : Number ; a : Adjf ; isDef, hasDefArt : Bool } ;
-- HL 7/2022: first Bool = True if used to glue in Sg with preposition
-- second Bool is True if a cardinal number is present
Quant = {
s : Bool => Number => Gender => PCase => Str ; -- Bool is True if a cardinal number is present
sp : Bool => Number => Gender => PCase => Str ;
s, sp : Bool => Bool => Number => Gender => Case => Str ;
a : Adjf ;
aPl : Adjf ; --- to distinguish "meine guten Freunde" / "gute Freunde"
hasDefArt : Bool
} ;
Predet = {
s : Number => Gender => PCase => Str ;
s : Number => Gender => Case => Str ;
c : {p : Str ; k : PredetCase} ;
a : PredetAgr -- if an agr is forced, e.g. jeder von uns ist ...
} ;
Num = {s : Gender => Case => Str ; n : Number ; isNum : Bool} ;
Card = {s : Gender => Case => Str ; n : Number} ;
Ord = {s : AForm => Str} ;
@@ -111,24 +120,28 @@ concrete CatGer of Cat =
Tense = {s : Str ; t : ResGer.Tense ; m : Mood} ;
linref
NP = \np -> np.s!(NPC Nom) ++ np.ext ++ np.rc ; -- HL 6/2019
NP = \np -> np.s ! False ! Nom ++ np.ext ++ np.rc ; -- HL 7/2022 Bool added
CN = \cn -> cn.s ! Strong ! Pl ! Nom ++ cn.adv ++ cn.ext ++ cn.rc ! Pl ;
SSlash = \ss -> ss.s ! Main ++ ss.c2.s ;
ClSlash = \cls -> cls.s ! MIndic ! Pres ! Simul ! Pos ! Main ++ cls.c2.s ;
SSlash = \ss -> ss.s ! Main ++ ss.c2.s ! GPl ;
ClSlash = \cls -> cls.s ! MIndic ! Pres ! Simul ! Pos ! Main ++ cls.c2.s ! GPl ;
VP = \vp -> useInfVP False vp ;
VPSlash = \vps -> useInfVP False vps ++ vps.c2.s ++ vps.ext;
VPSlash = \vps -> useInfVP False vps ++ vps.c2.s ! GPl ++ vps.ext;
AP = \ap -> ap.c.p1 ++ ap.s ! APred ++ ap.c.p2 ++ ap.ext ;
A2 = \a2 -> a2.s ! Posit ! APred ++ a2.c2.s ;
A2 = \a2 -> a2.s ! Posit ! APred ++ a2.c2.s ! GPl ;
V, VS, VQ, VA = \v -> useInfVP False (predV v) ;
V2, V2A, V2Q, V2S = \v -> useInfVP False (predV v) ++ v.c2.s ;
V3 = \v -> useInfVP False (predV v) ++ v.c2.s ++ v.c3.s ;
V2, V2A, V2Q, V2S = \v -> useInfVP False (predV v) ++ v.c2.s ! GPl ;
V3 = \v -> useInfVP False (predV v) ++ v.c2.s ! GPl ++ v.c3.s ! GPl;
VV = \v -> useInfVP v.isAux (predVGen v.isAux v) ;
V2V = \v -> useInfVP v.isAux (predVGen v.isAux v) ++ v.c2.s ;
V2V = \v -> useInfVP v.isAux (predVGen v.isAux v) ++ v.c2.s ! GPl ;
Conj = \c -> c.s1 ++ c.s2 ;
Det = \det -> det.s ! False ! Masc ! Nom ;
Prep = \prep -> case prep.isPrep of {isPrepDefArt => prep.s ! GSg Masc ;
_ => prep.s ! GPl } ;
}

View File

@@ -9,9 +9,11 @@ concrete ConjunctionGer of Conjunction =
ConjAdv conj ss = conjunctDistrSS conj ss ;
ConjNP conj ss = heavyNP (conjunctDistrTable PCase conj ss ** {
-- ConjNP : Conj -> ListNP' -> NP' ; -- she or we
ConjNP conj ss = { s = \\_ => (conjunctDistrTable Case conj { s1 = ss.s1 ; s2 = ss.s2 }).s } ** {
a = Ag Fem (conjNumber conj.n (numberAgr ss.a)) (personAgr ss.a) ;
}) ;
w = WHeavy ; ext,rc = [] } ;
ConjAP conj ss = conjunctDistrTable AForm conj ss ** {
isPre = ss.isPre ; c = ss.c ; ext = ss.ext} ;
@@ -39,20 +41,20 @@ concrete ConjunctionGer of Conjunction =
BaseAdv = twoSS ;
ConsAdv = consrSS comma ;
BaseNP x y = {
s1 = \\c => x.s ! c ++ bigNP x ;
s2 = \\c => y.s ! c ++ bigNP y ;
s1 = \\c => x.s ! False ! c ++ bigNP x ;
s2 = \\c => y.s ! False ! c ++ bigNP y ;
a = conjAgr x.a y.a } ;
ConsNP xs x = {
s1 = \\c => xs.s ! c ++ bigNP xs ++ comma ++ x.s1 ! c ;
s1 = \\c => xs.s ! False ! c ++ bigNP xs ++ comma ++ x.s1 ! c ;
s2 = x.s2 ;
a = conjAgr xs.a x.a } ;
BaseAP x y = {
BaseAP x y = lin AP {
s1 = bigAP x ;
s2 = bigAP y ;
isPre = andB x.isPre y.isPre ;
c = <[],[]> ;
ext = []} ;
ConsAP xs x = {
ConsAP xs x = lin AP {
s1 = \\a => (bigAP xs) ! a ++ comma ++ x.s1 ! a ;
s2 = x.s2 ;
isPre = andB x.isPre xs.isPre ;
@@ -60,12 +62,12 @@ concrete ConjunctionGer of Conjunction =
ext = []} ;
BaseRS x y = twoTable RelGenNum x y ** {c = y.c} ;
ConsRS xs x = consrTable RelGenNum comma xs x ** {c = xs.c} ;
BaseCN x y = {
BaseCN x y = lin CN {
s1 = bigCN x ;
s2 = bigCN y ;
g = x.g ; --- gender of first CN, used e.g. in articles
} ;
ConsCN x xs = {
ConsCN x xs = lin CN {
s1 = \\a,n,c => bigCN x ! a ! n ! c ++ comma ++ xs.s1 ! a ! n ! c ;
s2 = xs.s2 ;
g = x.g ; --- gender of first CN, used e.g. in articles
@@ -75,7 +77,7 @@ concrete ConjunctionGer of Conjunction =
lincat
[S] = {s1,s2 : Order => Str} ;
[Adv] = {s1,s2 : Str} ;
[NP] = {s1,s2 : PCase => Str ; a : Agr} ;
[NP] = {s1,s2 : Case => Str ; a : Agr} ;
[AP] = {s1,s2 : AForm => Str ; isPre : Bool; c : Str * Str ; ext : Str} ;
[RS] = {s1,s2 : RelGenNum => Str ; c : Case} ;
[CN] = {s1,s2 : Adjf => Number => Case => Str ; g : Gender} ;

View File

@@ -1,28 +1,42 @@
--# -path=.:../abstract
concrete ConstructionGer of Construction = CatGer **
open SyntaxGer, SymbolicGer, ParadigmsGer,
open SyntaxGer, SymbolicGer, (P = ParadigmsGer),
(L = LexiconGer), (E = ExtraGer), (G = GrammarGer), (I = IrregGer), (R = ResGer), (N = NounGer), Prelude in {
flags coding=utf8 ;
oper
mkPrep : Str -> P.Case -> Prep = P.mkPrep ;
mkV2 : V -> V2 = P.mkV2 ;
accPrep = P.accPrep ;
datPrep = P.datPrep ;
anDat_Prep = P.anDat_Prep ;
inDat_Prep = P.inDat_Prep ;
dative = P.dative ;
accusative = P.accusative ;
feminine = P.feminine ;
neuter = P.neuter ;
regV = P.regV ;
invarA = P.invarA ;
lin
hungry_VP = mkVP (mkA "hungrig") ;
thirsty_VP = mkVP (mkA "durstig") ;
tired_VP = mkVP (mkA "müde") ;
scared_VP = mkVP have_V2 (mkNP (mkN "Angst" "Ängste" feminine)) ;
ill_VP = mkVP (mkA "krank") ;
ready_VP = mkVP (mkA "bereit") ;
hungry_VP = mkVP (P.mkA "hungrig") ;
thirsty_VP = mkVP (P.mkA "durstig") ;
tired_VP = mkVP (P.mkA "müde") ;
scared_VP = mkVP have_V2 (mkNP (P.mkN "Angst" "Ängste" feminine)) ;
ill_VP = mkVP (P.mkA "krank") ;
ready_VP = mkVP (P.mkA "bereit") ;
has_age_VP card = mkVP (lin AP (mkAP (lin AdA (mkUtt (mkNP <lin Card card : Card> L.year_N))) L.old_A)) ;
have_name_Cl x y = mkCl (lin NP x) (mkV2 I.heißen_V) (lin NP y) ;
married_Cl x y = ----mkCl (lin NP x) L.married_A2 (lin NP y) |
mkCl (mkNP and_Conj (lin NP x) (lin NP y)) (mkA "verheiratet") ;
mkCl (mkNP and_Conj (lin NP x) (lin NP y)) (P.mkA "verheiratet") ;
what_name_QCl x = mkQCl how_IAdv (mkCl (lin NP x) I.heißen_V) ;
---- how_old_QCl x = mkQCl (E.ICompAP (mkAP L.old_A)) (lin NP x) ; ---- compilation slow
how_old_QCl x = mkQCl (E.IAdvAdv (ParadigmsGer.mkAdv "alt")) (mkCl (lin NP x) G.UseCopula) ; ----
how_old_QCl x = mkQCl (E.IAdvAdv (P.mkAdv "alt")) (mkCl (lin NP x) G.UseCopula) ; ----
how_far_QCl x = mkQCl (E.IAdvAdv L.far_Adv) (mkCl (mkVP (SyntaxGer.mkAdv to_Prep (lin NP x)))) ;
-- some more things
@@ -31,12 +45,24 @@ lin
is_right_VP = mkVP have_V2 (mkNP (ParadigmsGer.mkN "Recht")) ;
is_wrong_VP = mkVP have_V2 (mkNP (ParadigmsGer.mkN "Unrecht")) ;
n_units_AP card cn a = mkAP (lin AdA (mkUtt (mkNP <lin Card card : Card> (lin CN cn)))) (lin A a) ;
n_unit_CN card unit cn = mkCN (invarA (mkUtt (mkNP <lin Card card : Card> (lin CN unit))).s) cn ;
-- n_units_AP card cn a = mkAP (lin AdA (mkUtt (mkNP <lin Card card : Card> (lin CN cn)))) (lin A a) ;
n_units_AP card cn a = mkAP (lin AdA (mkUtt (mkNP card cn))) a ;
bottle_of_CN np = N.ApposCN (mkCN (mkN "Flasche")) np ;
cup_of_CN np = N.ApposCN (mkCN (mkN "Tasse")) np ;
glass_of_CN np = N.ApposCN (mkCN (mkN "Glas" "Gläser" neuter)) np ;
-- n_unit_CN card unit cn = mkCN (invarA (mkUtt (mkNP <lin Card card : Card> (lin CN unit))).s) cn ;
n_unit_CN card unit cn = mkCN (invarA ((mkUtt card).s ++ (mkUtt unit).s)) cn ;
bottle_of_CN np = N.ApposCN (mkCN (P.mkN "Flasche")) np ;
cup_of_CN np = N.ApposCN (mkCN (P.mkN "Tasse")) np ;
glass_of_CN np = N.ApposCN (mkCN (P.mkN "Glas" "Gläser" neuter)) np ;
few_X_short_of_Y np x y = -- np.dat fehlen (wenige x).nom an y
let
xs : NP = (mkNP G.few_Det x) ;
ys : NP = (mkNP G.IndefArt y) ;
fehlen_V3 : V3 = P.mkV3 (regV "fehlen") datPrep (mkPrep "an" dative) ;
vp : VP = mkVP (mkVPSlash fehlen_V3 np) ys
in
mkS (mkCl xs vp) ;
-- spatial deixis and motion verbs
where_go_QCl np = mkQCl (lin IAdv (ss "wohin")) (mkCl np (mkVP L.go_V)) ;
@@ -46,15 +72,103 @@ lin
come_here_VP = mkVP (mkVP L.come_V) (ParadigmsGer.mkAdv "her") ;
come_from_here_VP = mkVP (mkVP L.come_V) (ParadigmsGer.mkAdv "von hier") ;
go_there_VP = mkVP (mkVP L.go_V) (ParadigmsGer.mkAdv "hin") ;
go_there_VP = SyntaxGer.mkVP (SyntaxGer.mkVP L.go_V) (ParadigmsGer.mkAdv "hin") ;
come_there_VP = mkVP (mkVP L.come_V) (ParadigmsGer.mkAdv "hin") ;
come_from_there_VP = mkVP (mkVP L.come_V) (ParadigmsGer.mkAdv "von dort") ;
lincat
Timeunit = N ;
Hour = {short:Str ; long:Str ; adv:Adv} ;
Weekday = N ;
Monthday = NP ;
Month = N ;
Year = NP ;
-- timeunitAdv : Card -> Timeunit -> Adv ; -- (for) three hours
-- timeunitRange : Card -> Card -> Timeunit -> Adv ; -- (cats live) ten to twenty years
lin
timeunitAdv n time =
let n_hours_NP : NP = mkNP n time
in SyntaxGer.mkAdv (for_Prep | accPrep) n_hours_NP ;
timeunitRange l u time =
{s = l.s ! R.Masc ! R.Nom ++ "bis" ++ u.s ! R.Masc ! R.Nom ++ time.s ! R.Pl ! R.Nom} ;
oper
mkHour : Str -> Str -> Str -> Hour
= \n,m,daytime ->
let numeral : Str -> Str = \k -> (SyntaxGer.mkUtt (SyntaxGer.mkCard k)).s
in lin Hour {short = numeral n ; long = numeral m ; adv = P.mkAdv daytime} ;
lin
oneHour = mkHour "1" "1" "nachts" ;
twoHour = mkHour "2" "2" "nachts" ;
threeHour = mkHour "3" "3" "nachts" ;
fourHour = mkHour "4" "4" "morgens" ;
fiveHour = mkHour "5" "5" "morgens" ;
sixHour = mkHour "6" "6" "morgens" ;
sevenHour = mkHour "7" "7" "morgens" ;
eightHour = mkHour "8" "8" "vormittags" ;
nineHour = mkHour "9" "9" "vormittags" ;
tenHour = mkHour "10" "10" "vormittags" ;
elevenHour = mkHour "11" "11" "vormittags" ;
twelveHour = mkHour "12" "12" "mittags" ;
thirteenHour = mkHour "13" "1" "mittags" ;
fourteenHour = mkHour "14" "2" "mittags" ;
fifteenHour = mkHour "15" "3" "nachmittags" ;
sixteenHour = mkHour "16" "4" "nachmittags" ;
seventeenHour = mkHour "17" "5" "nachmittags" ;
eighteenHour = mkHour "18" "6" "nachmittags" ;
nineteenHour = mkHour "19" "7" "abends" ;
twentyHour = mkHour "20" "8" "abends" ;
twentyOneHour = mkHour "21" "9" "abends" ;
twentyTwoHour = mkHour "22" "10" "abends" ;
twentyThreeHour = mkHour "23" "11" "abends" ;
twentyFourHour = mkHour "24" "12" "nachts" ;
-- timeHour : Hour -> Adv -- at three a.m./p.m.
-- um drei Uhr nachts/nachmittags
timeHour h = let ada : AdA = lin AdA {s = "um" ++ h.long ++ "Uhr"}
in SyntaxGer.mkAdv ada h.adv ;
-- timeHourMinute : Hour -> Card -> Adv ; -- at six forty a.m./p.m.
-- um sechs/achtzehn Uhr vierzig
timeHourMinute h card =
let min : Str = (SyntaxGer.mkUtt card).s
in P.mkAdv ("um" ++ h.short ++ "Uhr" ++ min) ;
{- -- Remark (HL 7/2023):
-- To avoid massive overgeneration, we'd better replace Card here by
cat
Minute ;
fun
timeHourMinute : Hour -> Minute -> Adv ; -- at six forty a.m./p.m.
min_1 : Minute ;
min_2 : Minute ; -- ... min_60 : Minute ;
lastMinute : Minute ;
oper
Min : PType = Predef.Ints 3 ; -- short for 60
minutes : Min => Str = table {0 => "0" ; 1 => "1" ; 2 => "2" ; 3 => "3"} ;
mkMinute : Min -> Minute = \j -> lin Minute {s = minutes ! j ; i = j} ;
lincat
Minute = { s : Str ; i : Min } ;
lin
min_1 = mkMinute 1 ;
min_2 = mkMinute 2 ;
lastMinute = mkMinute 3 ;
timeHourMinute h m = P.mkAdv ("um" ++ h.short ++ ":" ++ m.s ++ "Uhr") ;
-- But this definition of timeHourMinute causes a compiler error! In
-- timeHourMinute = \h,m -> mkAdv (... ++ m.s ++ ..)
-- the argument m is not really restricted to Min, but an unbounded Int, so
-- m.s = {s = minutes ! j ; i = j}.s = (table (Ints 3) [...]) ! j
-- cannot be reduced in Compute.ConcreteNew, as *the compiler does not enforce*
-- 0 =< j =< 3.
-}
lin
weekdayPunctualAdv w = SyntaxGer.mkAdv anDat_Prep (mkNP the_Det w) ; -- am Montag
weekdayHabitualAdv w = SyntaxGer.mkAdv (mkPrep "" accusative) (mkNP every_Det w) ; ---- jeden Montag
@@ -63,9 +177,9 @@ lin
monthAdv m = SyntaxGer.mkAdv inDat_Prep (mkNP the_Det m) ;
yearAdv y = SyntaxGer.mkAdv (mkPrep "im Jahr" dative) y ; ----
dayMonthAdv d m = ParadigmsGer.mkAdv ("am" ++ d.s ! dative ++ BIND ++ "." ++ m.s ! R.Sg ! R.Nom) ; -- am 17 Mai
dayMonthAdv d m = ParadigmsGer.mkAdv ("am" ++ d.s ! True ! dative ++ BIND ++ "." ++ m.s ! R.Sg ! R.Nom) ; -- am 17 Mai
monthYearAdv m y = SyntaxGer.mkAdv inDat_Prep (mkNP the_Det (mkCN m y)) ; -- im Mai 2012
dayMonthYearAdv d m y = ParadigmsGer.mkAdv ("am" ++ d.s ! dative ++ BIND ++ "." ++ m.s ! R.Sg ! R.Nom ++ y.s ! accusative) ; -- am 17 Mai 2013
dayMonthYearAdv d m y = ParadigmsGer.mkAdv ("am" ++ d.s ! True ! dative ++ BIND ++ "." ++ m.s ! R.Sg ! R.Nom ++ y.s ! False ! accusative) ; -- am 17 Mai 2013
intYear = symb ;
intMonthday = symb ;
@@ -78,37 +192,45 @@ lin
weekdayN w = w ;
monthN m = m ;
weekdayPN w = mkPN w ;
monthPN m = mkPN m ;
weekdayPN w = P.mkPN w ;
monthPN m = P.mkPN m ;
languageNP l = mkNP l ;
languageCN l = mkCN l ;
oper mkLanguage : Str -> N = \s -> mkN s neuter ; ---- produces Neuter
oper mkLanguage : Str -> N = \s -> P.mkN s neuter ; ---- produces Neuter
----------------------------------------------
---- lexicon of special names
lin monday_Weekday = mkN "Montag" ;
lin tuesday_Weekday = mkN "Dienstag" ;
lin wednesday_Weekday = mkN "Mittwoch" ;
lin thursday_Weekday = mkN "Donnerstag" ;
lin friday_Weekday = mkN "Freitag" ;
lin saturday_Weekday = mkN "Samstag" ;
lin sunday_Weekday = mkN "Sonntag" ;
lin second_Timeunit = P.mkN "Sekunde" ;
lin minute_Timeunit = P.mkN "Minute" ;
lin hour_Timeunit = P.mkN "Stunde" ;
lin day_Timeunit = P.mkN "Tag" ;
lin week_Timeunit = P.mkN "Woche" ;
lin month_Timeunit = P.mkN "Monat";
lin year_Timeunit = P.mkN "Jahr" "Jahre" neuter ;
lin january_Month = mkN "Januar" ;
lin february_Month = mkN "Februar" ;
lin march_Month = mkN "März" ;
lin april_Month = mkN "April" ;
lin may_Month = mkN "Mai" ;
lin june_Month = mkN "Juni" ;
lin july_Month = mkN "Juli" ;
lin august_Month = mkN "August" ;
lin september_Month = mkN "September" ;
lin october_Month = mkN "Oktober" ;
lin november_Month = mkN "November" ;
lin december_Month = mkN "Dezember" ;
lin monday_Weekday = P.mkN "Montag" ;
lin tuesday_Weekday = P.mkN "Dienstag" ;
lin wednesday_Weekday = P.mkN "Mittwoch" ;
lin thursday_Weekday = P.mkN "Donnerstag" ;
lin friday_Weekday = P.mkN "Freitag" ;
lin saturday_Weekday = P.mkN "Samstag" ;
lin sunday_Weekday = P.mkN "Sonntag" ;
lin january_Month = P.mkN "Januar" ;
lin february_Month = P.mkN "Februar" ;
lin march_Month = P.mkN "März" ;
lin april_Month = P.mkN "April" ;
lin may_Month = P.mkN "Mai" ;
lin june_Month = P.mkN "Juni" ;
lin july_Month = P.mkN "Juli" ;
lin august_Month = P.mkN "August" ;
lin september_Month = P.mkN "September" ;
lin october_Month = P.mkN "Oktober" ;
lin november_Month = P.mkN "November" ;
lin december_Month = P.mkN "Dezember" ;
lin afrikaans_Language = mkLanguage "Afrikaans" ;
lin amharic_Language = mkLanguage "Amharisch" ;

View File

@@ -223,7 +223,7 @@ oper
let
vfin : VForm -> Str = \f ->
verb.s ! f ++ verb.prefix ;
gforms : Number -> Person -> Str = \n,p ->
gforms : ParadigmsGer.Number -> Person -> Str = \n,p ->
td (vfin (VFin False (VPresInd n p))) ++
td (vfin (VFin False (VPresSubj n p)))
++ td (vfin (VFin False (VImpfInd n p))) --# notpresent

View File

@@ -7,6 +7,7 @@ concrete ExtendGer of Extend =
VPS, ListVPS, VPI, ListVPI,
MkVPS, BaseVPS, ConsVPS, ConjVPS, PredVPS,
MkVPI, BaseVPI, ConsVPI, ConjVPI, ComplVPIVV,
GenModNP,
CardCNCard, CompoundN,
PassVPSlash, PassAgentVPSlash, PastPartAP, PastPartAgentAP
]
@@ -25,7 +26,7 @@ concrete ExtendGer of Extend =
VPS = {s : Order => Agr => Str} ;
[VPS] = {s1,s2 : Order => Agr => Str} ;
lin
lin
InOrderToVP vp = {s = "um" ++ useInfVP False vp} ;
@@ -44,7 +45,7 @@ lin
PredVPS np vpi =
let
subj = np.s ! NPC Nom ++ bigNP np ;
subj = np.s ! False ! Nom ++ bigNP np ;
agr = np.a ;
in {
s = \\o =>
@@ -115,33 +116,33 @@ lin
ConjVPS = conjunctDistrTable2 Order Agr ;
UseDAP det = {
s = \\c => det.sp ! Neutr ! c ;
s = \\b,c => det.sp ! Neutr ! c ;
a = agrP3 det.n ;
w = case det.isDef of { True => WLight ; _ => WHeavy } ;
rc, ext = []
} ;
UseDAPMasc det = {
s = \\c => det.sp ! Masc ! c ;
s = \\_,c => det.sp ! Masc ! c ;
a = agrP3 det.n ;
w = WLight ;
rc, ext = []
} ;
UseDAPFem det = {
s = \\c => det.sp ! Fem ! c ;
s = \\_,c => det.sp ! Fem ! c ;
a = agrP3 det.n ;
w = WLight ;
rc, ext = []
} ;
lin
CardCNCard card cn = {
s = \\g,c =>
(Grammar.DetCN (Grammar.DetQuant Grammar.IndefArt (Grammar.NumCard card)) cn).s ! NPC c ;
(Grammar.DetCN (Grammar.DetQuant Grammar.IndefArt (Grammar.NumCard card)) cn).s ! False ! c ;
n = Pl
} ;
lin PassVPSlash vp =
insertObj (\\_ => (PastPartAP vp).s ! APred) (predV werdenPass) **
{ c1 = subjPrep vp.c2 } ;
@@ -166,7 +167,7 @@ lin PastPartAgentAP vp np =
in {
s = \\af => (vp.nn ! a).p1 ++ (vp.nn ! a).p2 ++ (vp.nn ! a).p3
++ vp.a2 ++ agent ++ vp.adj ++ vp.inf.inpl.p2
++ vp.c2.s -- junk if not TV
++ vp.c2.s ! GPl -- junk if not TV
++ vp.ext ++ (vp.inf.extr ! a) ++ vp.s.s ! VPastPart af ;
isPre = True ;
c = <[],[]> ;

View File

@@ -1,5 +1,6 @@
concrete ExtraGer of ExtraGerAbs = CatGer **
open ResGer, Coordination, Prelude, IrregGer, (P = ParadigmsGer), (N = NounGer) in {
flags coding=utf8 ;
lincat
@@ -34,29 +35,30 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
IAdvAdv adv = {s = "wie" ++ adv.s} ;
DetNPMasc det = {
s = \\c => det.sp ! Masc ! c ;
s = \\b,c => det.sp ! b ! Masc ! c ;
a = agrgP3 Masc det.n ;
w = WLight ;
w = case det.isDef of { True => WLight ; _ => WHeavy } ;
ext, rc = []
} ;
DetNPFem det = {
s = \\c => det.sp ! Fem ! c ;
s = \\b,c => det.sp ! b ! Fem ! c ;
a = agrgP3 Fem det.n ;
w = WLight ;
w = case det.isDef of { True => WLight ; _ => WHeavy } ;
ext, rc = []
} ;
EmptyRelSlash slash = {
s = \\m,t,a,p,gn =>
appPrep slash.c2 (\\k => usePrepC k (\c -> relPron ! gn ! c)) ++
slash.s ! m ! t ! a ! p ! Sub ;
c = (prepC slash.c2.c).c
appPrep slash.c2 (relPron ! gn) ++ slash.s ! m ! t ! a ! p ! Sub ;
c = slash.c2.c
} ;
PassVPSlash vp =
insertObj (\\_ => (PastPartAP vp).s ! APred) (predV werdenPass) **
{ c1 = subjPrep vp.c2 } ;
let c = case <vp.c2.c,vp.c2.isPrep> of {<Acc,isCase> => Nom ; _ => vp.c2.c}
in insertObj (\\_ => (PastPartAP vp).s ! APred) (predV werdenPass) **
{ c1 = vp.c2 ** {c = c} } ;
-- regulates passivised object: accusative objects -> nom; all others: same case
-- this also gives "mit dir wird gerechnet" ;
-- the alternative linearisation ("es wird mit dir gerechnet") is not implemented
@@ -83,7 +85,7 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
in {
s = \\af => (vp.nn ! a).p1 ++ (vp.nn ! a).p2 ++ (vp.nn ! a).p3
++ vp.a2 ++ agent ++ vp.adj ++ vp.inf.inpl.p2
++ vp.c2.s -- junk if not TV
++ vp.c2.s ! GPl -- junk if not TV
++ vp.ext ++ (vp.inf.extr ! a) ++ vp.s.s ! VPastPart af ;
isPre = True ;
c = <[],[]> ;
@@ -100,7 +102,7 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
PredVPS np vpi =
let
subj = np.s ! NPC Nom ++ bigNP np ;
subj = np.s ! False ! Nom ++ bigNP np ;
agr = np.a ;
in {
s = \\o =>
@@ -181,7 +183,7 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
lin
ReflRNP vps rnp =
insertObjReflNP vps rnp ;
insertObj (\\a => appPrep vps.c2 (rnp.s ! a)) vps ;
ReflPron = { -- personal pronoun, with "sich" in P3 Sg
s = ResGer.reflPron ; rc,ext = [] ; isPron = True } ;
@@ -208,36 +210,36 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
PredetRNP pred rnp = rnp ** { -- HL 5/2022
s = \\a,c => let n = case pred.a of {PAg n => n ; _ => numberAgr a} ;
g = genderAgr a ;
d = case pred.c.k of {NoCase => c ; PredCase k => (prepC k).c} ;
d = case pred.c.k of {NoCase => c ; PredCase k => k} ;
in case rnp.isPron of {
True => pred.s ! Pl ! Masc ! (NPC c) ++ "von" ++ rnp.s ! a ! Dat ;
_ => pred.s ! n ! genderAgr a ! (NPC c) ++ pred.c.p ++ rnp.s ! a ! d} ;
True => pred.s ! Pl ! Masc ! c ++ "von" ++ rnp.s ! a ! Dat ;
_ => pred.s ! n ! genderAgr a ! c ++ pred.c.p ++ rnp.s ! a ! d} ;
ext = rnp.ext ; rc = rnp.rc ;
isPron = False} ;
-- ok: alle von uns; die meisten von uns ; wrong: *nur von uns =/= nur wir
AdvRNP np prep rnp = {s = \\a,c => np.s ! (NPC c)
++ appPrepC prep (rnp.s ! a) ++ rnp.ext ++ rnp.rc ;
AdvRNP np prep rnp = {s = \\a,c => np.s ! False ! c
++ appPrep prep (rnp.s ! a) ++ rnp.ext ++ rnp.rc ;
ext = np.ext ; rc = np.rc ; isPron = False} ;
AdvRAP ap prep rnp =
let -- ? adv ++ ap.s ! af
adv = appPrepC prep (rnp.s ! agrP3 Sg) ; -- bug: fixed agreement
adv = appPrep prep (rnp.s ! agrP3 Sg) ; -- bug: fixed agreement
in ap ** { s = \\af => ap.s ! af ++ adv } ; -- e.g. unknown in one's youth
ReflA2RNP adj rnp = -- would need AP.c : Agr => Str*Str, not AP.c : Str*Str
let -- as we have no reflexive AP,
compl = appPrepC adj.c2 (rnp.s ! agrP3 Sg) ; -- we use a fixed agreement
compl = appPrep adj.c2 (rnp.s ! agrP3 Sg) ; -- we use a fixed agreement
in {
s = adj.s ! Posit ;
isPre = True ;
c = case adj.c2.isPrep of {False => <compl, []> ; True => <[], compl>} ;
c = case adj.c2.isPrep of {isCase => <compl, []> ; _ => <[], compl>} ;
ext = rnp.ext ++ rnp.rc
} ;
PossPronRNP pron num cn rnp =
N.DetCN (N.DetQuant (N.PossPron pron) num)
(N.PossNP cn (lin NP {s = \\pc => usePrepC pc (\c -> rnp.s ! pron.a ! c) ;
(N.PossNP cn (lin NP {s = \\_,c => rnp.s ! pron.a ! c ;
a = pron.a ;
w = WLight ;
ext = rnp.ext ;
@@ -251,11 +253,11 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
** {isPron = False ; ext,rc = []} ;
Base_rr_RNP x y = twoTable2 Agr Case x y ;
Base_nr_RNP x y = twoTable2 Agr Case {s = \\_,c => x.s ! (NPC c) ++ x.ext ++ x.rc} y ;
Base_rn_RNP x y = twoTable2 Agr Case x {s = \\_,c => y.s ! (NPC c) ++ y.ext ++ y.rc} ;
Base_nr_RNP x y = twoTable2 Agr Case {s = \\_,c => x.s ! False ! c ++ x.ext ++ x.rc} y ;
Base_rn_RNP x y = twoTable2 Agr Case x {s = \\_,c => y.s ! False ! c ++ y.ext ++ y.rc} ;
Cons_rr_RNP x xs = consrTable2 Agr Case comma x xs ;
Cons_nr_RNP x xs = consrTable2 Agr Case comma {s = \\_,c => x.s ! (NPC c) ++ x.ext ++ x.rc} xs ;
Cons_nr_RNP x xs = consrTable2 Agr Case comma {s = \\_,c => x.s ! False ! c ++ x.ext ++ x.rc} xs ;
oper
reflPronSelf : Agr => Case => Str = \\a => \\c => reflPron ! a ! c ++ "selbst" ;
@@ -267,16 +269,16 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
insertObjReflNP : ResGer.VPSlash -> RNP -> ResGer.VP = -- HL 5/2022
\vp,rnp -> -- generalize ResGer.insertObjRefl
let prep = vp.c2 ;
c = case prep.c of { NPC cc => cc ; _ => Acc } ; -- put rnp.ext ++ rnp.rc to vp.ext ?
obj : Agr => Str = \\a => prep.s ++ rnp.s ! a ! c ++ rnp.ext ++ rnp.rc
c = case prep.isPrep of { isCase => prep.c ; _ => Acc } ; -- put rnp.ext ++ rnp.rc to vp.ext ?
obj : Agr => Str = \\a => prep.s ! GPl ++ rnp.s ! a ! c ++ rnp.ext ++ rnp.rc
in vp ** {
nn = \\a =>
let vpnn = vp.nn ! a in
case <prep.isPrep, rnp.isPron, c> of { -- consider non-pron rnp as light, add to vpnn.p2
<False,True,Acc> => <obj ! a ++ vpnn.p1, vpnn.p2, vpnn.p3, vpnn.p4> ; -- pronoun switch:
<False,True,_> => <vpnn.p1 ++ obj ! a, vpnn.p2, vpnn.p3, vpnn.p4> ; -- accPron < pron
<False,False,_> => <vpnn.p1, vpnn.p2 ++ obj ! a, vpnn.p3, vpnn.p4> ; -- < non-pron nominal
<True,_,_> => <vpnn.p1, vpnn.p2, vpnn.p3 ++ obj ! a, vpnn.p4> } -- or prepositional
<isCase,True,Acc> => <obj ! a ++ vpnn.p1, vpnn.p2, vpnn.p3, vpnn.p4> ; -- pronoun switch:
<isCase,True,_> => <vpnn.p1 ++ obj ! a, vpnn.p2, vpnn.p3, vpnn.p4> ; -- accPron < pron
<isCase,False,_> => <vpnn.p1, vpnn.p2 ++ obj ! a, vpnn.p3, vpnn.p4> ; -- < non-pron nominal
<_,_,_> => <vpnn.p1, vpnn.p2, vpnn.p3 ++ obj ! a, vpnn.p4> } -- or prepositional
} ;
-- SS: implementation of some of the relevant Foc rules from Extra
@@ -298,8 +300,8 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
-- "treu ist sie ihm"
-- "froh ist sie dass er da ist"
-- "stolz ist sie auf ihn"
subj = mkSubj np vp.c1 ;
cl = mkClause subj.p1 subj.p2 vp
subj = mkSubject np vp.c1 ;
cl = mkClause subj.s subj.a vp
in mkFoc adj cl ;
UseFoc t p f = {s = t.s ++ p.s ++ f.s ! t.m ! t.t ! t.a ! p.p} ;
@@ -323,7 +325,7 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
-- "es wird gelacht"; generating formal sentences
lincat
FClause = ResGer.VP ** {subj : ResGer.NP} ;
FClause = ResGer.VP ** {subj : ResGer.NP ; lock_FClause : {}} ;
lin
VPass v =
@@ -334,8 +336,8 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
AdvFor adv fcl = fcl ** {a2 = adv.s} ;
FtoCl cl =
let subj = mkSubj cl.subj cl.c1
in DisToCl subj.p1 subj.p2 cl ;
let subj = mkSubject cl.subj cl.c1
in DisToCl subj.s subj.a cl ;
oper -- extra operations for ExtraGer
@@ -344,7 +346,7 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
lin Foc {s = \\m,t,a,p => focus ++ cl.s ! m ! t ! a ! p ! Inv} ;
esSubj : CatGer.NP = lin NP {
s = \\_ => "es" ;
s = \\_,_ => "es" ;
rc, ext = [] ;
a = Ag Neutr Sg P3 ;
w = WPron

View File

@@ -13,9 +13,9 @@ concrete GrammarGer of Grammar =
PhraseGer,
TextX - [Tense,Temp],
IdiomGer,
StructuralGer,
TenseGer,
NamesGer
StructuralGer - [part_Prep,possess_Prep], -- use PartNP, PossNP instead
TenseGer
---- NamesGer -- notYet!
** {
flags startcat = Phr ; unlexer = text ; lexer = text ;

View File

@@ -10,7 +10,7 @@ concrete IdiomGer of Idiom = CatGer **
CleftNP np rs = mkClause "es" (agrP3 Sg)
(insertExtrapos (rs.s ! RGenNum (gennum (genderAgr np.a) (numberAgr np.a))) ----
(insertObj (\\_ => np.s ! NPC rs.c ++ bigNP np) (predV MorphoGer.sein_V))) ;
(insertObj (\\_ => (np.s ! False ! rs.c ++ bigNP np)) (predV MorphoGer.sein_V))) ; --HL
CleftAdv ad s = mkClause "es" (agrP3 Sg)
(insertExtrapos (conjThat ++ s.s ! Sub)
@@ -19,14 +19,13 @@ concrete IdiomGer of Idiom = CatGer **
ExistNP np =
mkClause "es" (agrP3 Sg)
(insertObj (\\_ => appPrep geben.c2 np.s ++ bigNP np)
(insertObj (\\_ => appPrep geben.c2 (np.s ! False) ++ bigNP np)
(predV geben)) ;
ExistIP ip = {
s = \\m,t,a,p =>
let
cls =
(mkClause "es" (agrP3 Sg) (predV geben)).s ! m ! t ! a ! p ;
cls = (mkClause "es" (agrP3 Sg) (predV geben)).s ! m ! t ! a ! p ;
who = ip.s ! Acc
in table {
QDir => who ++ cls ! Inv ;
@@ -36,7 +35,7 @@ concrete IdiomGer of Idiom = CatGer **
ExistNPAdv np adv=
mkClause "es" (agrP3 Sg)
(insertAdv adv.s (insertObj (\\_ => appPrep geben.c2 np.s ++ bigNP np)
(insertAdv adv.s (insertObj (\\_ => appPrep geben.c2 (np.s ! False) ++ bigNP np)
(predV geben))) ;
ExistIPAdv ip adv = {
@@ -59,14 +58,14 @@ concrete IdiomGer of Idiom = CatGer **
} ;
ImpP3 np vp = {
s = (mkClause ((mkSubj np vp.c1).p1) np.a vp).s !
s = (mkClause ((mkSubject np vp.c1).s) np.a vp).s !
MConjunct ! Pres ! Simul ! Pos ! Inv
} ;
SelfAdvVP vp = insertAdv "selbst" vp ;
SelfAdVVP vp = insertAdv "selbst" vp ;
SelfNP np = np ** {
s = \\c => np.s ! c ++ "selbst" ++ bigNP np ;
s = \\_,c => np.s ! False ! c ++ "selbst" ++ bigNP np ;
isPron = False ;
} ;

View File

@@ -13,6 +13,7 @@ flags
lin
add_V3 = dirV3 (prefixV "hinzu" (regV "fügen")) zu_Prep ;
airplane_N = mkN "Flugzeug" "Flugzeuge" neuter ;
alas_Interj = {s = "ach" } ;
already_Adv = mkAdv "schon" ;
answer_V2S = mkV2S (regV "antworten") datPrep ;
apartment_N = mkN "Wohnung" ;
@@ -58,7 +59,7 @@ lin
clever_A = mk3A "klug" "klüger" "klügste" ;
close_V2 = dirV2 Irreg.schließen_V ;
coat_N = mkN "Jacke" | mkN "Mantel" "Mantel" masculine;
cold_A = regA "kalt" ;
cold_A = mk3A "kalt" "kälter" "kälteste" ;
come_V = seinV (mk6V "kommen" "kommt" "komm" "kam" "käme" "gekommen") ;
computer_N = reg2N "Rechner" "Rechner" masculine ;
country_N = reg2N "Land" "Länder" neuter ;
@@ -185,7 +186,8 @@ lin
sock_N = reg2N "Strumpf" "Strümpfe" masculine ;
song_N = reg2N "Lied" "Lieder" neuter ;
speak_V2 = dirV2 Irreg.sprechen_V ;
star_N = mkN "Sterne" ;
-- star_N = mkN "Sterne" ;
star_N = mkN "Stern" ; -- HL 7/22
steel_N = mkN "Stahl" ;
stone_N = mkN "Stein" ;
stop_V = seinV Irreg.halten_V ;
@@ -211,7 +213,9 @@ lin
dirV2 (irregV "verstehen" "versteht" "verstand" "verstände" "verstanden") ;
university_N = reg2N "Universität" "Universitäten" feminine ;
village_N = reg2N "Dorf" "Dörfer" neuter ;
wait_V2 = prepV2 (regV "warten") (mkPrep "auf" accusative) ;
-- wait_V2 = prepV2 (regV "warten") (mkPrep "auf" accusative) ;
-- wait_V2 = prepV2 (regV "warten") ((mkPrep "auf" "auf den" "auf die" "aufs" accusative) | (mkPrep "auf" accusative));
wait_V2 = prepV2 (regV "warten") (mkPrep "auf" "auf den" "auf die" ("aufs" | "auf das") accusative);
walk_V = seinV Irreg.gehen_V ;
warm_A = mk3A "warm" "wärmer" "wärmste" ;
war_N = mkN "Krieg" ;
@@ -235,14 +239,14 @@ lin
dry_A = regA "trocken" ;
dull_A = regA "stumpf" ;
full_A = regA "voll" ;
heavy_A = mkA "schwer" "schwere" "schwerer" "schwerste" ;
heavy_A = mkA "schwer" "schwerer" "schwerste" ;
near_A = mk3A "nahe" "näher" "nächste" ;
rotten_A = regA "verdorben" ;
round_A = regA "rund" ;
sharp_A = mk3A "scharf" "schärfer" "schärfste" ;
smooth_A = regA "glatt" ;
straight_A = regA "gerade" ;
wet_A = regA "naß" ;
wet_A = mk4A "naß" "nass" "nasser" "nasseste" ;
wide_A = regA "breit" ;
animal_N = reg2N "Tier" "Tiere" neuter ;
ashes_N = mkN "Asche" ;

View File

@@ -17,7 +17,7 @@ oper
c = noCase ;
a = PAgNone
} ;
mkPredet : A -> Str -> PCase -> Bool -> Number -> Predet = \a,p,c,b,n ->
mkPredet : A -> Str -> Case -> Bool -> Number -> Predet = \a,p,c,b,n ->
lin Predet {
s = appAdj a ;
c = {p = p ; k = PredCase c} ;
@@ -27,11 +27,11 @@ oper
-- e.g. das selbe
mmkQuant : Quant -> A -> Quant = \q,a -> q ** {
s,sp = \\x,n,g,c => q.s ! x ! n ! g ! c ++ a.s ! Posit ! agrAdj g q.a n ((prepC c).c)
s,sp = \\b,x,n,g,c => q.s ! b ! x ! n ! g ! c ++ a.s ! Posit ! agrAdj g q.a n c
} ;
-- e.g. derjenige
mmbQuant : Quant -> A -> Quant = \q,a -> q ** {
s,sp = \\x,n,g,c => q.s ! x ! n ! g ! c + a.s ! Posit ! agrAdj g q.a n ((prepC c).c)
s,sp = \\b,x,n,g,c => q.s ! b ! x ! n ! g ! c + a.s ! Posit ! agrAdj g q.a n c
} ;
}

View File

@@ -1,10 +1,10 @@
--# -path=.:../abstract:../common
--# -path=.:../abstract:../common:../prelude:
concrete MarkupGer of Markup = CatGer, MarkHTMLX ** {
concrete MarkupGer of Markup = CatGer, MarkHTMLX ** open Prelude in {
lin
MarkupCN m cn = cn ** {s = \\a,n,c => appMark m (cn.s ! a ! n ! c)} ; --- other fields e.g ext intact
MarkupNP m np = np ** {s = \\c => appMark m (np.s ! c)} ;
MarkupNP m np = np ** {s = \\b,c => appMark m (np.s ! b ! c)} ;
MarkupAP m ap = ap ** {s = \\a => appMark m (ap.s ! a)} ;
MarkupAdv m adv = {s = appMark m adv.s} ;
MarkupS m s = {s = \\o => appMark m (s.s ! o)} ;

View File

@@ -17,24 +17,25 @@ oper
-- For $StructuralGer$.
mkPrep : Str -> PCase -> Preposition = \s,c ->
{s = s ; s2 = [] ; c = c ; isPrep = True} ;
mkPrep : Str -> Case -> Preposition = \s,c ->
{s = \\_ => s ; s2 = [] ; c = c ; isPrep = isPrep} ;
nameNounPhrase : Gender -> {s : Case => Str} -> {s : PCase => Str ;
nameNounPhrase : Gender -> {s : Case => Str} -> {s : Bool => Case => Str ;
a : Agr ;
w : Weight ;
ext,rc : Str} =
\g,name -> heavyNP {
s = \\c => usePrepC c (\k -> name.s ! k) ;
a = agrgP3 g Sg
\g,name -> {
s = \\_,c => name.s ! c ;
a = agrgP3 g Sg ;
ext,rc = [] ;
w = WHeavy -- ok?
} ;
detLikeAdj : Bool -> Number -> Str ->
{s,sp : Gender => PCase => Str ; n : Number ; a : Adjf ; isDef : Bool} = \isDef,n,dies ->
{s,sp : Gender => Case => Str ; n : Number ; a : Adjf ; isDef : Bool} = \isDef,n,dies ->
{s,sp = appAdj (regA dies) ! n ; n = n ; a = Weak ; isDef = isDef} ;
detUnlikeAdj : Bool -> Number -> Str ->
{s,sp : Gender => PCase => Str ; n : Number ; a : Adjf ; isDef : Bool} = \isDef,n,dies ->
{s,sp : Gender => Case => Str ; n : Number ; a : Adjf ; isDef : Bool} = \isDef,n,dies ->
{s,sp = appAdj (regDetA dies) ! n ; n = n ; a = Weak ; isDef = isDef} ;
mkOrd : {s : Degree => AForm => Str} -> {s : AForm => Str} = \a ->

View File

@@ -1,41 +1,43 @@
concrete NamesGer of Names = CatGer ** open ResGer, Prelude in {
lin GivenName gn = {
s = \\c => usePrepC c (\k -> gn.s ! k) ;
s = \\_,c => gn.s ! c ;
a = agrgP3 (sex2gender gn.g) Sg ;
w = WLight ;
rc, ext = []
} ;
lin MaleSurname sn = {
s = \\c => usePrepC c (\k -> sn.s ! Male ! k) ;
s = \\_,c => sn.s ! Male ! c ;
a = agrgP3 Masc Sg ;
w = WLight ;
rc, ext = []
} ;
lin FemaleSurname sn = {
s = \\c => usePrepC c (\k -> sn.s ! Female ! k) ;
s = \\_,c => sn.s ! Female ! c ;
a = agrgP3 Fem Sg ;
w = WLight ;
rc, ext = []
} ;
lin PlSurname sn = {
s = \\c => usePrepC c (\k -> sn.s ! Male ! k) ;
s = \\_,c => sn.s ! Male ! c ;
a = agrgP3 Masc Pl ;
w = WLight ;
rc, ext = []
} ;
lin FullName gn sn = {
s = \\c => usePrepC c (\k -> gn.s ! Nom ++ sn.s ! gn.g ! k) ;
s = \\_,c => gn.s ! Nom ++ sn.s ! gn.g ! c ;
a = agrgP3 (sex2gender gn.g) Sg ;
w = WLight ;
rc, ext = []
} ;
lin UseLN ln = {
-- UseLN : LN -> NP ;
lin UseLN ln = notYet "UseLN" ;
{- Old version by Krasimir: {
s = \\c => case ln.hasArt of {
True => artDefContr (gennum ln.g ln.n) c ++ usePrepC c (\k -> ln.s ! Weak ! k) ;
False => usePrepC c (\k -> ln.s ! adjfCase Strong k ! k)
@@ -44,22 +46,30 @@ lin UseLN ln = {
w = WLight ;
rc, ext = []
} ;
-}
lin PlainLN ln = {
-- PlainLN : LN -> NP ;
lin PlainLN ln = notYet "PlainLN" ;
{- {
s = \\c => usePrepC c (\k -> ln.s ! adjfCase Strong k ! k) ;
a = agrgP3 ln.g ln.n ;
w = WLight ;
rc, ext = []
} ;
-}
lin InLN ln = {
-- InLN : LN -> Adv ;
lin InLN ln = notYet "InLN" ;
{- {
s = let c = NPP CInDat
in case ln.hasArt of {
True => artDefContr (gennum ln.g ln.n) c ++ usePrepC c (\k -> ln.s ! Weak ! k) ;
False => usePrepC c (\k -> ln.s ! adjfCase Strong k ! k)
} ;
} ;
-}
-- AdjLN : AP -> LN -> LN ;
lin AdjLN ap ln = ln ** {
s = \\a,c =>
preOrPost ap.isPre

View File

@@ -1,80 +1,73 @@
--# -path=.:../abstract:../common:
concrete NounGer of Noun = CatGer ** open ResGer, MorphoGer, Prelude in {
flags optimize=all_subs ;
-- Remark: np.isLight makes ResGer.insertObjNP expensive, for ComplSlash, SlashVP
-- np.isLight = True and np.isPron = True are now part of np.w
-- HL 21.7.2022: the dropping of DefArt in Prep+DefArt works by selecting from
-- np.s via b = det.hasDefArt = True the forms without det.s and from prep.s
-- the preposition glued with definite article singular, depending on gender, case.
lin
DetCN det cn = {
s = \\c => det.s ! cn.g ! c ++
(let k = (prepC c).c in cn.s ! adjfCase det.a k ! det.n ! k ++ cn.adv) ;
s = \\b,c => det.s ! b ! cn.g ! c ++ cn.s ! (adjfCase det.a c) ! det.n ! c ++ cn.adv ;
a = agrgP3 cn.g det.n ;
-- isLight = det.isDef ; -- ich sehe den Mann nicht vs. ich sehe nicht einen Mann
-- isPron = False ; -- HL 6/2019 (but:) sehe (die|einige) Männer nicht
-- don't see a|no man = sehe keinen Mann
w = case det.isDef of { True => WLight ; _ => WHeavy } ;
-- HL 6/2019 (but:) sehe (die|einige) Männer nicht; don't see a|no man = sehe keinen Mann
w = case det.isDef of { True => case det.hasDefArt of { True => WDefArt ;
_ => WLight } ;
_ => WHeavy } ;
rc = cn.rc ! det.n ;
ext = cn.ext
} ;
DetNP det = {
s = \\c => det.sp ! Neutr ! c ; -- more genders in ExtraGer -- HL: der+er,den+en ; der drei,den drei+en
DetNP det = { -- more genders in ExtraGer -- HL: der+er,den+en ; der drei,den drei+en
s = \\b,c => det.sp ! b ! Neutr ! c ;
a = agrP3 det.n ;
-- isLight = det.isDef ;
-- isPron = False ; -- HL 6/2019: don't apply pronoun switch: ich gebe ihr das vs. ich gebe es ihr
w = case det.isDef of { True => WLight ; _ => WHeavy } ;
rc, ext = []
} ;
UsePN pn = {
s = \\c => usePrepC c (\k -> pn.s ! k) ;
a = agrgP3 pn.g pn.n ;
-- isLight = True ; -- means: this is not a heavy NP, but comes before negation
-- isPron = False ; -- HL 6/2019: to regulate Pron/NonPronNP order
w = WLight ;
rc, ext = []
s = \\_,c => pn.s ! c ;
a = agrgP3 pn.g Sg ;
w = WLight ; -- means: this is not a heavy NP, but comes before negation
rc, ext = [] -- Pron => Light HL 6/2019: to regulate Pron/NonPronNP order
} ;
UsePron pron = {
s = \\c => usePrepC c (\k -> pron.s ! NPCase k) ;
s = \\_,c => pron.s ! NPCase c ;
a = pron.a ;
-- isLight = True ;
-- isPron = True ;
w = WPron ;
rc, ext = []
} ;
PredetNP pred np =
let ag = case pred.a of {PAg n => agrP3 n ; _ => np.a} in np ** {
s = \\c0 =>
s = \\b,c0 =>
let c = case pred.c.k of {NoCase => c0 ; PredCase k => k} in
pred.s ! numberAgr ag ! genderAgr np.a ! c0 ++ pred.c.p ++ np.s ! c ;
pred.s ! numberAgr ag ! genderAgr np.a ! c0 ++ pred.c.p ++ np.s ! b ! c ;
a = ag ;
-- isLight = False ;
-- isPron = False
w = WHeavy
} ;
PPartNP np v2 = np ** {
s = \\c => np.s ! c ++ embedInCommas (v2.s ! VPastPart APred) ; --- invar part
-- isPron = False
s = \\b,c => np.s ! b ! c ++ (embedInCommas (v2.s ! VPastPart APred)) ; --- invar part
w = WHeavy
} ;
{- "eine erfolgreiche Frau, geliebt von vielen," but only with v2 not possible in German?
HL: PPartNP np vps|vp: "der Autor, heute vergessen" , "der Mond, gerade aufgegangen,"
-}
-- SS: "eine erfolgreiche Frau, geliebt von vielen," but only with v2 not possible in German?
-- HL: PPartNP np vps|vp: "der Autor, heute vergessen" , "der Mond, gerade aufgegangen,"
AdvNP np adv = np ** {
s = \\c => np.s ! c ++ adv.s ;
-- isLight = False ;
-- isPron = False
s = \\b,c => np.s ! b ! c ++ adv.s ;
w = WHeavy
} ;
ExtAdvNP np adv = np ** {
s = \\c => np.s ! c ++ embedInCommas adv.s ;
-- isLight = False ;
-- isPron = False
s = \\b,c => np.s ! b ! c ++ (embedInCommas adv.s) ;
w = WHeavy
} ;
@@ -83,35 +76,37 @@ concrete NounGer of Noun = CatGer ** open ResGer, MorphoGer, Prelude in {
n = num.n ;
a = quant.a
in {
s = \\g,c => quant.s ! num.isNum ! n ! g ! c ++ (let k = (prepC c).c in
num.s!g!k ++ ord.s ! agrAdj g (adjfCase a k) n k) ;
sp = \\g,c => quant.sp ! num.isNum ! n ! g ! c ++ (let k = (prepC c).c in
num.s!g!k ++ ord.s ! agrAdj g (adjfCase quant.aPl k) n k) ;
s = \\b,g,c => quant.s ! b ! num.isNum ! n ! g ! c ++ num.s!g!c ++
ord.s ! agrAdj g (adjfCase a c) n c ;
sp = \\b,g,c => quant.sp ! b ! num.isNum ! n ! g ! c ++ num.s!g!c ++
ord.s ! agrAdj g (adjfCase quant.aPl c) n c ;
n = n ;
a = case n of {Sg => a ; Pl => quant.aPl} ;
isDef = case <quant.a, quant.aPl> of {<Strong,Strong> => False ; _ => True} ;
hasDefArt = quant.hasDefArt ;
} ;
DetQuant quant num =
let
n = num.n ;
a = quant.a
a = quant.a ;
b = andB quant.hasDefArt (case num.n of {Sg => True ; _ => False}) ;
in {
s = \\g,c => quant.s ! num.isNum ! n ! g ! c ++ (let k = (prepC c).c in
num.s!g!k) ;
sp = \\g,c => quant.sp ! num.isNum ! n ! g ! c ++ (let k = (prepC c).c in
num.s!g!k) ; -- HL: der+er,den+en ; der drei,den drei+en
s = \\b,g,c => quant.s ! b ! num.isNum ! n ! g ! c ++ num.s ! g ! c ;
sp = \\_,g,c => quant.sp ! False ! num.isNum ! n ! g ! c ++ num.s!g!c ;
-- HL: der+er,den+en ; der drei,den drei+en
n = n ;
a = case n of {Sg => a ; Pl => quant.aPl} ;
isDef = case <quant.a, quant.aPl> of {<Strong,Strong> => False ; _ => True} ;
hasDefArt = quant.hasDefArt ;
} ;
PossPron p = {
s = \\_,n,g,c => usePrepC c (\k -> p.s ! NPPoss (gennum g n) k) ;
sp = \\_,n,g,c => usePrepC c (\k -> p.s ! NPPoss (gennum g n) k) ;
s = \\_,_,n,g,c => p.s ! NPPoss (gennum g n) c ;
sp = \\_,_,n,g,c => p.s ! NPPoss (gennum g n) c ;
a = Strong ;
aPl = Weak ;
hasDefArt = False ;
} ;
NumCard n = n ** {isNum = True} ;
@@ -134,46 +129,41 @@ concrete NounGer of Noun = CatGer ** open ResGer, MorphoGer, Prelude in {
OrdNumeralSuperl n a = {s = \\af => n.s ! NOrd APred ++ Predef.BIND ++ a.s ! Superl ! af} ; -- drittbeste
DefArt = {
s = \\_,n,g,c => artDefContr (gennum g n) c ;
-- sp = \\_,n,g,c => artDefContr (gennum g n) c ; ---- deren, denen ...
sp = \\_,n,g,c => case <n,c> of {
<Sg,NPP p> => let sp = prepC c ; gn = gennum g n
in sp.s ++ artDef ! gn ! sp.c ;
<Pl,NPP CInAcc> => let sp = prepC c in sp.s ++ "die" ;
<Pl,NPP p> => let sp = prepC c ; gn = gennum g n
in sp.s ++ (artDef ! gn ! sp.c + "en") ;
<Pl,NPC Dat> => "denen" ; -- HL 6/2019
<Pl,NPC Gen> => "derer" ; -- HL 6/2019
_ => artDefContr (gennum g n) c } ; -- von den+en
a, aPl = Weak
s = table{True => \\_,n,g,c => [] ; -- defart dropped
False => \\_,n,g,c => artDef ! (gennum g n) ! c} ;
sp = \\_,_,n,g,c => case <n,c> of {
<Pl,Dat> => "denen" ; -- HL 6/2019
<Pl,Gen> => "derer" ; -- HL 6/2019
_ => artDef ! (gennum g n) ! c } ;
a, aPl = Weak ;
hasDefArt = True
} ;
IndefArt = {
s = table {
True => \\_,_,c => usePrepC c (\k -> []) ;
s = \\_ => table {
True => \\_,_,c => [] ;
False => table {
Sg => \\g,c => usePrepC c (\k -> "ein" + pronEnding ! GSg g ! k) ;
Pl => \\_,c => usePrepC c (\k -> [])
Sg => \\g,c => "ein" + pronEnding ! GSg g ! c ;
Pl => \\_,c => []
}
} ;
sp = table {
True => \\_,_,c => usePrepC c (\k -> []) ;
sp = \\_ => table {
True => \\_,_,c => [] ;
False => table {
Sg => \\g,c => usePrepC c (\k -> (detUnlikeAdj False Sg "ein").s ! g ! NPC k) ;
Pl => \\_,c => usePrepC c (\k -> caselist "einige" "einige" "einigen" "einiger" ! k)
Sg => \\g,c => (detUnlikeAdj False Sg "ein").s ! g ! c ;
Pl => \\_,c => caselist "einige" "einige" "einigen" "einiger" ! c
}
} ;
a, aPl = Strong
a, aPl = Strong ;
hasDefArt = False
} ;
MassNP cn = {
s = \\c => usePrepC c (\k -> cn.s ! Strong ! Sg ! k) ++ cn.adv ;
s = \\_,c => cn.s ! Strong ! Sg ! c ++ cn.adv ;
a = agrgP3 cn.g Sg ;
-- isLight = True ; -- ich trinke Bier nicht vs. ich trinke kein Bier
-- isPron = False ;
w = WLight ;
w = WLight ; -- ich trinke Bier nicht vs. ich trinke kein Bier
rc = cn.rc ! Sg ;
ext = cn.ext
ext = cn.ext ;
hasDefArt = False
} ;
UseN, UseN2 = \n -> {
@@ -223,8 +213,7 @@ concrete NounGer of Noun = CatGer ** open ResGer, MorphoGer, Prelude in {
---- another layer of embedInCommas needed if there is a non-empty rc
RelNP np rs = np ** {
rc = (np.rc ++ embedInCommas (rs.s ! RGenNum (gennum (genderAgr np.a) (numberAgr np.a)))) ;
-- isPron = False
rc = np.rc ++ embedInCommas (rs.s ! RGenNum (gennum (genderAgr np.a) (numberAgr np.a))) ;
w = case isPron np of { True => WLight ; _ => np.w }
} ;
@@ -233,15 +222,40 @@ concrete NounGer of Noun = CatGer ** open ResGer, MorphoGer, Prelude in {
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 } ;
s = \\a,n,c => cn.s ! a ! n ! c ++ np.s ! False ! c ++ bigNP np } ;
-- PossNP cn np = cn ** {
-- s = \\a,n,c => cn.s ! a ! n ! c ++ np.s ! NPP CVonDat ++ bigNP np } ;
PossNP cn np = cn ** {
s = \\a,n,c => cn.s ! a ! n ! c ++ np.s ! NPP CVonDat ++ bigNP np } ;
s = \\a,n,c => cn.s ! a ! n ! c ++ appPrep vonDat (np.s ! False) ++ bigNP np } ; -- HL, ad hoc
PartNP cn np = case np.w of {
WPron => cn ** {s = \\a,n,c => cn.s ! a ! n ! c ++ appPrep vonDat (np.s ! False) ++ np.rc} ;
_ => cn ** {s = \\a,n,c => cn.s ! a ! n ! c ++ np.s ! False ! Gen} -- HL 7/2022, ad hoc
}; -- glass of wine
CountNP det np = -- drei der Kinder | drei von den Kindern -- HL 7/22, ad-hoc TODO
-- det or numeral? np or rather (DefArt +) cn? drei (einiger Kinder) ?
let g = genderAgr np.a
in {
s = \\b,c => det.s ! b ! g ! c ++ appPrepNP vonDat np ++ bigNP np ;
a = agrgP3 g det.n ;
w = case det.isDef of { True => WLight ; _ => WHeavy } ;
rc = np.rc ;
ext = np.ext
} ;
AdjDAP dap ap = -- the large (one) -- HL 8/22 der auf dich stolze; die ihm treue; der so dumme, infzu
{s, sp = \\g,c => dap.s ! g ! c ++ ap.c.p1 ++ ap.c.p2 ++ ap.s ! (AMod (gennum g dap.n) c) ++ ap.ext ;
a = dap.a ; n = dap.n ; isDef = dap.isDef ; hasDefArt = dap.hasDefArt } ;
DetDAP det = {s = \\g,c => det.s ! False ! g ! c ; -- HL 7/22 todo: check
sp = \\g,c => det.sp ! False ! g ! c ;
n = det.n ; a = det.a ; isDef = det.isDef ; hasDefArt = det.hasDefArt} ;
DetDAP det = det ;
QuantityNP dig m = {
s = \\c => preOrPost m.isPre m.s (dig.s ! invNum) ;
s = \\_,c => preOrPost m.isPre m.s (dig.s ! invNum) ;
a = agrP3 Pl ;
w = WLight ;
rc = "" ;
@@ -249,7 +263,7 @@ concrete NounGer of Noun = CatGer ** open ResGer, MorphoGer, Prelude in {
} ;
QuantityFloatNP dig1 dig2 m = {
s = \\c => preOrPost m.isPre m.s (dig1.s ! invNum ++ BIND ++ "." ++ BIND ++ dig2.s ! invNum) ;
s = \\_,c => preOrPost m.isPre m.s (dig1.s ! invNum ++ BIND ++ "." ++ BIND ++ dig2.s ! invNum) ;
a = agrP3 Pl ;
w = WLight ;
rc = "" ;

View File

@@ -51,12 +51,6 @@ oper
dative : Case ;
genitive : Case ;
anDat_Case : Case ; -- preposition "an" dative with contraction "am" --%
inAcc_Case : Case ; -- preposition "in" accusative with contraction "ins" --%
inDat_Case : Case ; -- preposition "in" dative with contraction "im" --%
zuDat_Case : Case ; -- preposition "zu" dative with contractions "zum", "zur" --%
vonDat_Case : Case ;
-- To abstract over number names, we define the following.
Number : Type ;
@@ -147,6 +141,7 @@ mkN : overload {
} ;
mkGN : overload {
mkGN : Str -> Sex -> GN ; -- regular name with genitive in "s"
mkGN : (nom,gen : Str) -> Sex -> GN ; -- name with other genitive
@@ -193,8 +188,8 @@ mkN : overload {
-- To extract the number of a noun phrase
ifPluralNP : NP -> Bool
= \np -> case (numberAgr np.a) of {Sg => False ; Pl => True} ;
-- ifPluralNP : NP -> Bool
-- = \np -> case (numberAgr np.a) of {Sg => False ; Pl => True} ;
--2 Adjectives
@@ -239,6 +234,10 @@ mkN : overload {
mkPrep : Str -> Case -> Prep ; -- e.g. "durch" + accusative
mkPrep : Case -> Str -> Prep ; -- postposition
mkPrep : Str -> Case -> Str -> Prep ; -- both sides
-- for preposition glued with DefArt in singular:
-- e.g. "auf" "auf den" "auf die" "aufs" + accusative
mkPrep : Str -> Str -> Str -> Str-> Case -> Prep ;
mkPrep : Case -> Prep ; -- convert case to preposition
} ;
-- Often just a case with the empty string is enough.
@@ -247,13 +246,15 @@ mkN : overload {
datPrep : Prep ; -- no string, just dative case
genPrep : Prep ; -- no string, just genitive case
-- A couple of common prepositions (the first two always with the dative).
-- A couple of common prepositions (the first three always with the dative).
von_Prep : Prep ; -- von + dative
von_Prep : Prep ; -- von + dative, with contraction vom
zu_Prep : Prep ; -- zu + dative, with contractions zum, zur
bei_Prep : Prep ; -- bei + dative, with contraction beim
anDat_Prep : Prep ; -- an + dative, with contraction am
inDat_Prep : Prep ; -- in + dative, with contraction ins
inAcc_Prep : Prep ; -- in + accusative, with contraction im
inDat_Prep : Prep ; -- in + dative, with contraction im
inAcc_Prep : Prep ; -- in + accusative, with contraction ins
aufAcc_Prep : Prep ; -- auf + accusative, with contraction aufs
--2 Verbs
@@ -409,25 +410,20 @@ mkV2 : overload {
-- The definitions should not bother the user of the API. So they are
-- hidden from the document.
Gender = MorphoGer.Gender ;
Case = MorphoGer.PCase ;
Case = MorphoGer.Case ;
Number = MorphoGer.Number ;
masculine = Masc ;
feminine = Fem ;
neuter = Neutr ;
male = Male ;
female = Female ;
nominative = NPC Nom ;
accusative = NPC Acc ;
dative = NPC Dat ;
genitive = NPC Gen ;
anDat_Case = NPP CAnDat ;
inAcc_Case = NPP CInAcc ;
inDat_Case = NPP CInDat ;
zuDat_Case = NPP CZuDat ;
vonDat_Case = NPP CVonDat ;
nominative = Nom ;
accusative = Acc ;
dative = Dat ;
genitive = Gen ;
singular = Sg ;
plural = Pl ;
@@ -570,7 +566,7 @@ mkV2 : overload {
dunk + "el" => mk3A a (dunk + "ler") (dunk + "leste") ;
te + "uer" => mk3A a (te + "urer") (te + "ureste") ;
_ + "e" => mk3A a (a + "r") (a + "ste") ;
_ + ("t" | "d" | "s" | "sch" | "z") => mk3A a (a + "er") (a + "este") ;
_ + ("t" | "d" | "s" | "ß" | "sch" | "z" | "au" | "eu") => mk3A a (a + "er") (a + "este") ;
_ => mk3A a (a + "er") (a + "ste")
} ;
@@ -581,20 +577,32 @@ mkV2 : overload {
mkAdv s = {s = s ; lock_Adv = <>} ;
mkPrep = overload {
mkPrep : Str -> PCase -> Prep = \s,c -> {s = s ; s2 = [] ; c = c ; isPrep = True ; lock_Prep = <>} ;
mkPrep : PCase -> Str -> Prep = \c,s -> {s = [] ; s2 = s ; c = c ; isPrep = True ; lock_Prep = <>} ;
mkPrep : Str -> PCase -> Str -> Prep = \s,c,t -> {s = s ; s2 = t ; c = c ; isPrep = True ; lock_Prep = <>}
mkPrep : Str -> Case -> Prep = \s,c ->
{s = \\_ => s ; s2 = [] ; c = c ; isPrep = isPrep ; lock_Prep = <>} ;
mkPrep : Case -> Str -> Prep = \c,s ->
{s = \\_ => [] ; s2 = s ; c = c ; isPrep = isPrep ; lock_Prep = <>} ;
mkPrep : Str -> Case -> Str -> Prep = \s,c,t ->
{s = \\_ => s ; s2 = t ; c = c ; isPrep = isPrep ; lock_Prep = <>} ;
mkPrep : Str -> Str -> Str -> Str-> Case -> Prep = \s,masc,fem,neutr, c ->
{s = table{GPl => s ; GSg Masc => masc ; GSg Fem => fem ; GSg Neutr => neutr} ;
s2 = [] ; c = c ; isPrep = isPrepDefArt ; lock_Prep = <>} ;
mkPrep : Case -> Prep = \c ->
{s = \\_ => [] ; s2 = [] ; c = c ; isPrep = isCase ; lock_Prep = <>} ;
} ;
accPrep = {s,s2 = [] ; c = accusative ; isPrep = False ; lock_Prep = <>} ;
datPrep = {s,s2 = [] ; c = dative ; isPrep = False ; lock_Prep = <>} ;
genPrep = {s,s2 = [] ; c = genitive ; isPrep = False ; lock_Prep = <>} ;
--von_Prep = mkPrep "von" dative ;
von_Prep = mkPrep [] vonDat_Case ;
zu_Prep = mkPrep [] zuDat_Case ;
anDat_Prep = mkPrep [] anDat_Case ;
inDat_Prep = mkPrep [] inDat_Case ;
inAcc_Prep = mkPrep [] inAcc_Case ;
accPrep = mkPrep accusative ;
datPrep = mkPrep dative ;
genPrep = mkPrep genitive ;
--von_Prep = mkPrep "von" dative ;
von_Prep = mkPrep "von" "vom" "von der" "vom" dative ;
zu_Prep = mkPrep "zu" "zum" "zur" "zum" dative ;
bei_Prep = mkPrep "bei" "beim" "bei der" "beim" dative ;
inDat_Prep = mkPrep "in" "im" "in der" "im" dative ;
inAcc_Prep = mkPrep "in" "in den" "in die" "ins" accusative ;
anDat_Prep = mkPrep "an" "am" "an der" "am" dative ;
anAcc_Prep = mkPrep "an" "an den" "an die" "ans" accusative ;
aufAcc_Prep = mkPrep "auf" "auf den" "auf die" "aufs" accusative ;
mk6V geben gibt gib gab gaebe gegeben =
let
@@ -635,7 +643,7 @@ mkV2 : overload {
habenV v = v ** {aux = VHaben} ;
seinV v = v ** {aux = VSein} ;
reflV v c = v ** {aux = VHaben ; vtype = VRefl (prepC c).c} ;
reflV v c = v ** {aux = VHaben ; vtype = VRefl c} ;
no_geV v = let vs = v.s in v ** {
s = table {
@@ -664,7 +672,7 @@ mkV2 : overload {
= \v,c,d -> lin V3 (v ** {c2 = c ; c3 = d}) ;
} ;
dirV3 v p = mkV3 v accPrep p ; -- accPrep sets isPrep=False
dirV3 v p = mkV3 v accPrep p ;
accdatV3 v = mkV3 v datPrep accPrep ; -- to fit to Eng ditransitives (no preposition):
-- give sb(indir) sth(dir) = geben jmdm(dat) etwas(acc)
mkVS v = v ** {lock_VS = <>} ;
@@ -693,8 +701,7 @@ mkV2 : overload {
subjV2V v = v ** {objCtrl = False} ;
mkV2A = overload {
mkV2A : V -> V2A
= \v -> dirV2 v ** {isAux = False ; lock_V2A = <>} ;
mkV2A : V -> V2A = \v -> dirV2 v ** {isAux = False ; lock_V2A = <>} ;
mkV2A : V -> Prep -> V2A
= \v,p -> prepV2 v p ** {isAux = False ; lock_V2A = <>} ;
} ;
@@ -794,7 +801,7 @@ mkV2 : overload {
mkV2 : Str -> V2 = \s -> dirV2 (regV s) ;
mkV2 : V -> V2 = dirV2 ;
mkV2 : V -> Prep -> V2 = prepV2;
mkV2 : V -> Case -> V2 = \v,c -> prepV2 v (lin Prep {s,s2 = [] ; c = c ; isPrep = False}) ;
mkV2 : V -> Case -> V2 = \v,c -> prepV2 v (mkPrep c) ;
} ;
mkMU : Str -> MU = \s -> lin MU {s=s; isPre=False} ;

View File

@@ -1,3 +1,4 @@
--# -path=.:../abstract:../common:prelude -- HL
concrete PhraseGer of Phrase = CatGer ** open Prelude, ResGer in {
flags optimize=all_subs ;
@@ -13,7 +14,7 @@ concrete PhraseGer of Phrase = CatGer ** open Prelude, ResGer in {
UttIP ip = {s = ip.s ! Nom} ; --- Acc also
UttIAdv iadv = iadv ;
UttNP np = {s = np.s ! NPC Nom ++ bigNP np} ;
UttNP np = {s = np.s ! False ! Nom ++ bigNP np} ;
UttVP vp = {s = useInfVP True vp} ; -- without zu
UttAdv adv = adv ;
UttCN n = {s = n.s ! Strong ! Sg ! Nom ++ n.adv ++ n.ext ++ n.rc ! Sg} ;
@@ -25,6 +26,6 @@ concrete PhraseGer of Phrase = CatGer ** open Prelude, ResGer in {
PConjConj conj = ss (conj.s2) ;
NoVoc = {s = []} ;
VocNP np = {s = "," ++ np.s ! NPC Nom ++ bigNP np} ;
VocNP np = {s = "," ++ np.s ! False ! Nom ++ bigNP np} ;
}

View File

@@ -13,14 +13,14 @@ concrete QuestionGer of Question = CatGer ** open ResGer in {
}
} ;
QuestVP qp vp = {
s = \\m,t,a,b,q =>
QuestVP ip vp = {
s = \\m,t,a,p =>
let
cl = (mkClause (qp.s ! Nom) (agrP3 qp.n) vp).s ! m ! t ! a ! b
in
case q of {
QIndir => cl ! Sub ;
_ => cl ! Main
who = appPrep vp.c1 ip.s ;
cl = (mkClause who (agrP3 ip.n) vp).s ! m ! t ! a ! p
in table {
QDir => cl ! Main ;
QIndir => cl ! Sub
}
} ;
@@ -28,7 +28,7 @@ concrete QuestionGer of Question = CatGer ** open ResGer in {
s = \\m,t,a,p =>
let
cls = slash.s ! m ! t ! a ! p ;
who = appPrep slash.c2 (\\k => usePrepC k (\c -> ip.s ! c)) ;
who = appPrep slash.c2 ip.s ;
in table {
QDir => who ++ cls ! Inv ;
QIndir => who ++ cls ! Sub
@@ -50,8 +50,8 @@ concrete QuestionGer of Question = CatGer ** open ResGer in {
s = \\m,t,a,p =>
let
vp = predV sein_V ** {ext = icomp.ext};
subj = mkSubj np vp.c1 ;
cls = (mkClause subj.p1 subj.p2 vp).s ! m ! t ! a ! p ;
subj = mkSubject np vp.c1 ;
cls = (mkClause subj.s subj.a vp).s ! m ! t ! a ! p ;
why = icomp.s ! np.a
in table {
QDir => why ++ cls ! Inv ;
@@ -60,7 +60,7 @@ concrete QuestionGer of Question = CatGer ** open ResGer in {
} ;
PrepIP p ip = {
s = appPrep p (\\k => usePrepC k (\c -> ip.s ! c)) ;
s = appPrep p ip.s ;
} ;
AdvIP ip adv = {

View File

@@ -1,4 +1,4 @@
concrete RelativeGer of Relative = CatGer ** open ResGer in {
concrete RelativeGer of Relative = CatGer ** open Prelude, ResGer in {
flags optimize=all_subs ;
@@ -28,13 +28,12 @@ concrete RelativeGer of Relative = CatGer ** open ResGer in {
RelSlash rp slash = {
s = \\m,t,a,p,gn =>
appPrep slash.c2 (\\k => usePrepC k (\c -> rp.s ! gn ! c)) ++
slash.s ! m ! t ! a ! p ! Sub ;
c = (prepC slash.c2.c).c
appPrep slash.c2 (rp.s ! gn) ++ slash.s ! m ! t ! a ! p ! Sub ;
c = slash.c2.c
} ;
FunRP p np rp = {
s = \\gn,c => np.s ! NPC c ++ appPrep p (\\k => usePrepC k (\c -> rp.s ! gn ! c)) ;
s = \\gn,c => np.s ! False ! c ++ appPrep p (rp.s ! gn) ;
a = RAg (numberAgr np.a) (personAgr np.a)
} ;

View File

@@ -39,31 +39,6 @@ resource ResGer = ParamX ** open Prelude in {
Agr = Ag Gender Number Person ;
-- Case of $NP$ extended to deal with contractions like "zur", "im".
PCase = NPC Case | NPP CPrep ;
CPrep = CAnDat | CInAcc | CInDat | CZuDat | CVonDat ;
oper
NPNom : PCase = NPC Nom ;
PrepNom : Preposition = {s,s2 = "" ; isPrep = False ; c = NPNom} ;
prepC : PCase -> {s : Str ; c : Case} = \cp -> case cp of {
NPC c => {s = [] ; c = c} ;
NPP CAnDat => {s = "an" ; c = Dat} ;
NPP CInAcc => {s = "in" ; c = Acc} ;
NPP CInDat => {s = "in" ; c = Dat} ;
NPP CZuDat => {s = "zu" ; c = Dat} ;
NPP CVonDat => {s = "von" ; c = Dat}
} ;
usePrepC : PCase -> (Case -> Str) -> Str = \c,fs ->
let sc = prepC c in sc.s ++ fs sc.c ;
appPrepC : Preposition -> (Case => Str) -> Str = \prep,arg ->
let sc = prepC prep.c
in prep.s ++ sc.s ++ arg ! sc.c ++ prep.s2 ;
oper
mkAgr : {g : Gender ; n : Number ; p : Person} -> Agr = \r ->
Ag r.g r.n r.p ;
@@ -77,20 +52,22 @@ resource ResGer = ParamX ** open Prelude in {
param NPForm = NPCase Case | NPPoss GenNum Case ;
-- Predeterminers sometimes require a case ("ausser mir"), sometimes not ("nur ich").
-- A number is sometimes inherited ("alle Menschen"),
-- sometimes forced ("jeder von den Menschen").
-- A number is sometimes inherited ("alle Menschen"), sometimes forced ("jeder von
-- den Menschen").
param
PredetCase = NoCase | PredCase PCase ;
PredetCase = NoCase | PredCase Case ;
PredetAgr = PAg Number | PAgNone ;
oper
noCase : {p : Str ; k : PredetCase} = {p = [] ; k = NoCase} ;
-- Pronominal nps are ordered differently, and light nps come before negation in clauses.
-- (To save space, reduce isPron * isLight = 4 values to the following three.) HL 9/19
param
Weight = WPron | WLight | WHeavy ;
oper
Weight = WPron | WLight | WHeavy | WDefArt ; -- HL: may need WIndefArt for nicht+ein => kein
oper -- to handle clause negation properly
isPron : {w : Weight} -> Bool = \np ->
case np.w of {WPron => True ; _ => False} ;
isLight : {w : Weight} -> Bool = \np ->
@@ -251,12 +228,12 @@ resource ResGer = ParamX ** open Prelude in {
g : Gender
} ;
NP : Type = {
s : PCase => Str ;
NP : Type = { -- HL 7/22: Bool = True if DefArt is dropped to combine with prep of type isPrepDefArt
s : Bool => Case => Str ;
rc : Str ; -- die Frage , [rc die ich gestellt habe]
ext : Str ; -- die Frage , [sc wo sie schläft] ; die Regel , [vp kein Fleisch zu essen] | [s dass ...]
a : Agr ;
w : Weight } ; -- light NPs come before negation in simple clauses (expensive)
w : Weight } ; -- light NPs come before negation in simple clauses
mkN : (x1,_,_,_,_,x6,x7 : Str) -> Gender -> Noun =
\Mann, Mannen, Manne, Mannes, Maenner, Maennern, Mann_, g -> {
@@ -390,7 +367,7 @@ resource ResGer = ParamX ** open Prelude in {
regA : Str -> Adjective = \blau ->
let blauest : Str = case blau of {
_ + ("t" | "d" | "s" | "sch" | "z") => blau + "est" ;
_ + ("t" | "d" | "s" | "ß" | "sch" | "z" | "au" | "eu") => blau + "est" ;
_ => blau + "st"
}
in
@@ -420,41 +397,81 @@ resource ResGer = ParamX ** open Prelude in {
legte ("ge" + legt)
[] VHaben ;
-- Prepositions for complements indicate the complement case.
-- Prepositions indicate the case of their complement noun phrase.
Preposition : Type = {s : Str ; s2 : Str ; c : PCase ; isPrep : Bool} ;
-- There are three types: (i) cases, (ii) pure pre-, post- and circum-positions,
-- and (iii) prepositions glued with definite article in singular (using s!(GSg g)).
-- HL 7/19: German has very few circumpositions: um (Gen) Willen, von (Adv) an|ab|aus
-- ? bis (Adv) hin|her. So maybe we should skip s2 (and save readings with empty preps).
param
PrepType = isCase | isPrep | isPrepDefArt ; -- HL 7/2022
oper
Preposition : Type = {s : GenNum => Str ; s2:Str ; c : Case ; isPrep : PrepType} ;
isaCase : Preposition -> Bool = \p -> case p.isPrep of {isCase => True ; _ => False} ;
isaPrep : Preposition -> Bool = \p -> case p.isPrep of {isPrep => True ; _ => False} ;
isaPrepDefArt : Preposition -> Bool = \p -> case p.isPrep of {isPrepDefArt => True ; _ => False} ;
-- To apply a preposition to a complement.
appPrep : Preposition -> (PCase => Str) -> Str = \prep,arg ->
prep.s ++ arg ! prep.c ++ prep.s2 ;
appPrep : Preposition -> (Case => Str) -> Str = \prep,arg ->
prep.s ! GPl ++ arg ! prep.c ++ prep.s2 ;
appPrepNP : Preposition -> NP -> Str = \prep,np ->
prep.s ++ np.s ! prep.c ++ bigNP np ++ prep.s2 ;
-- revised appPrep for discontinuous NPs
let
g = (genderAgr np.a) ;
n = (numberAgr np.a) ;
glues = case <prep.isPrep,n> of {<isPrepDefArt,Sg> => True ; _ => False} ;
nps = np.s ! glues ! prep.c
in
case <glues, np.w> of {
<True, WDefArt> => -- e.g. "zum Hof|zur Tür|zum Fenster herein"
prep.s ! (GSg g) ++ nps ++ np.ext ++ prep.s2 ++ np.rc ;
_ => prep.s ! GPl ++ nps ++ np.ext ++ prep.s2 ++ np.rc
} ;
{-
-- Simplify to test the effect on grammar compilation complexity (without SlashV2VNP):
-- with glues = False: 27096 msec, 3,2M VerbGer.gfo, 854K SentenceGer.gfo
-- and SlashV2VNP:102597 msec, 16 M VerbGer.gfo, 854K SentenceGer.gfo (good!)
appPrepNP : Preposition -> NP -> Str = \prep,np ->
let
glues = False ;
nps = np.s ! glues ! prep.c
in prep.s ! GPl ++ nps ++ np.ext ++ prep.s2 ++ np.rc ;
-}
bigNP : NP -> Str = \np -> np.ext ++ np.rc ;
-- To build a preposition from just a case. -- HL 9/19: no longer used in RGL
-- To build a preposition from just a case. -- HL 9/19: moved to mkPrep in ParadigmsGer
noPreposition : Case -> Preposition = \c ->
{s,s2 = [] ; c = NPC c ; isPrep = False} ;
PrepNom : Preposition = {s = \\_ => []; isPrep = isCase ; c = Nom ; s2 = []} ;
vonDat : Preposition = {s=table{GPl => "von" ; GSg Fem => "von der"; _ => "vom"};
s2=[]; c=Dat; isPrep=isPrepDefArt} ;
-- for testing:
Dat' : Preposition = {s = \\_ => []; s2 = []; c=Dat; isPrep=isCase} ;
mit' : Preposition = {s = \\_ => "zusammen mit"; s2 = []; c=Dat; isPrep=isPrep} ;
zuDat' : Preposition = {s=\\_ => "zu"; s2="herein"; c=Dat; isPrep=isPrep} ;
zum' : Preposition = {s= table{GPl => "zu"; GSg Fem =>"zur"; _ => "zum"};
s2="herein"; c=Dat; isPrep=isPrepDefArt} ;
inDat' : Preposition = {s= \\_ => "in" ; s2="drin"; c=Dat; isPrep=isPrep} ;
im' : Preposition = {s= table{GPl => "in"; GSg Fem=>"in der"; _ =>"im"};
s2="drin"; c=Dat; isPrep=isPrepDefArt} ;
inAcc' : Preposition = {s=\\_ => "in"; s2="hinein"; c=Acc; isPrep=isPrep} ;
ins' : Preposition = {s=table{GPl => "in"; GSg Masc=>"in den"; GSg Fem=>"in die"; GSg Neutr=>"ins"};
s2="hinein"; c=Acc; isPrep=isPrepDefArt} ;
-- To build passive: accusative object -> nom subject; others -> same case or prep
subjPrep : Preposition -> Preposition = \prep ->
case <prep.c,prep.isPrep> of {
<NPC Acc,False> => prep ** {c = NPC Nom} ;
<Acc,isCase> => prep ** {c = Nom} ;
_ => prep
} ;
-- Pronouns and articles
-- Here we define personal and relative pronouns.
-- All personal pronouns, except "ihr", conform to the simple
-- pattern $mkPronPers$.
-- All personal pronouns, except "ihr", conform to the simple pattern $mkPronPers$.
mkPronPers : (x1,_,_,_,x5 : Str) -> Gender -> Number -> Person ->
{s : NPForm => Str ; a : Agr} =
@@ -486,6 +503,7 @@ resource ResGer = ParamX ** open Prelude in {
GPl => caselist "die" "die" "den" "der"
} ;
{- -- used in SymbolGer:
artDefContr : GenNum -> PCase -> Str = \gn,np -> case np of {
NPC c => artDef ! gn ! c ;
NPP p => case <p,gn> of {
@@ -499,19 +517,16 @@ resource ResGer = ParamX ** open Prelude in {
_ => let sp = prepC np in sp.s ++ artDef ! gn ! sp.c
}
} ;
-}
-- This is used when forming determiners that are like adjectives.
appAdj : Adjective -> Number => Gender => PCase => Str = \adj ->
appAdj : Adjective -> Number => Gender => Case => Str = \adj ->
let
ad : GenNum -> Case -> Str = \gn,c ->
adj.s ! Posit ! AMod gn c
in
\\n,g,c => usePrepC c (\k -> case n of {
Sg => ad (GSg g) k ;
_ => ad GPl k
}) ;
\\n,g,c => case n of {Sg => ad (GSg g) c ;_ => ad GPl c} ;
-- This auxiliary gives the forms in each degree of adjectives.
@@ -562,7 +577,6 @@ resource ResGer = ParamX ** open Prelude in {
extr: (Agr => Str)} ; -- e.g. ihn [] versuchen (lasse) [, ihr zu helfen]
c1 : Preposition -- case of subject
} ;
VPSlash = VP ** {c2 : Preposition ; objCtrl : Bool} ; -- HL 3/2019 objCtr added
-- objCtrl distinguishes object-control from subject-control verb v:V2V in VP.s:
@@ -715,14 +729,19 @@ resource ResGer = ParamX ** open Prelude in {
insertObj obj vp ** {c2 = vp.c2 ; objCtrl = vp.objCtrl } ;
insertObjNP : NP -> Preposition -> VPSlash -> VPSlash = \np,prep,vp ->
let c = case prep.c of { NPC cc => cc ; _ => Nom } ;
obj = appPrepNP prep np ;
in vp ** {
let obj = appPrepNP prep np ;
b : Bool = case prep.isPrep of {isPrep | isPrepDefArt => True ; _ => False} ;
w = np.w ;
c = prep.c
in insertObj' obj b w c vp ;
insertObj' : Str -> Bool -> Weight -> Case -> VPSlash -> VPSlash = \obj,isPrep,w,c,vp ->
vp ** {
nn = \\a =>
let vpnn = vp.nn ! a in
-- HL 11/6/19: rough object NP order (expensive):
-- vfin < accPron < refl < (gen|dat)Pron < lightNP < neg < heavyNP|PP < vinf|comp
case <prep.isPrep, np.w, c> of { -- 2 * 3 * 4 = 24 cases
case <isPrep, w, c> of { -- 2 * 3 * 4 = 24 cases
<True, _,_> => -- <prons, light, heavy++pp, compl>
<vpnn.p1, vpnn.p2, vpnn.p3 ++ obj, vpnn.p4> ;
<False,WPron, Acc> => -- <ihn ++ sich, light, heavy, comp>
@@ -732,24 +751,24 @@ resource ResGer = ParamX ** open Prelude in {
<False,WLight,Dat> => -- (assuming v.c2=acc) nonPron: dat < acc|gen
-- <prons, dat ++ np, heavy, comp>
<vpnn.p1, obj ++ vpnn.p2, vpnn.p3, vpnn.p4> ;
<False,WHeavy,Dat> => -- <prons, light, dat ++ np, comp>
<vpnn.p1, vpnn.p2, obj ++ vpnn.p3, vpnn.p4> ;
<False,WLight,_ > => -- <prons, np ++ gen|acc, heavy, comp>
<vpnn.p1, vpnn.p2 ++ obj, vpnn.p3, vpnn.p4> ;
<False,WHeavy,_ > => -- <prons, light, dat ++ np, comp>
<False,WHeavy|WDefArt,Dat> => -- <prons, light, dat ++ np, comp>
<vpnn.p1, vpnn.p2, obj ++ vpnn.p3, vpnn.p4> ;
<False,WHeavy|WDefArt,_ > => -- <prons, light, np ++ gen|acc, comp>
<vpnn.p1, vpnn.p2, vpnn.p3 ++ obj, vpnn.p4> }
} ; -- the ordering of objects of v:V3 (and v:V4) is also determined by Slash?V3 (and Slash?V4)
insertObjRefl : VPSlash -> VPSlash = \vp -> -- HL 6/2019, to order reflPron < neg < prep+reflPron
let prep = vp.c2 ;
c = case prep.c of { NPC cc => cc ; _ => Acc } ;
obj : Agr => Str = \\a => prep.s ++ reflPron ! a ! c ; -- HL: to test ReflVP: reflPronSelf
let prep = vp.c2 ; -- HL 7/22 reduced to c:Case
obj : Agr => Str = \\a => prep.s ! GPl ++ reflPron ! a ! prep.c ++ prep.s2 ;
in vp ** {
nn = \\a =>
let vpnn = vp.nn ! a in
case prep.isPrep of {
False => <obj ! a ++ vpnn.p1, vpnn.p2, vpnn.p3, vpnn.p4> ;
True => <vpnn.p1, obj ! a ++ vpnn.p2, vpnn.p3, vpnn.p4> }
isCase => <obj ! a ++ vpnn.p1, vpnn.p2, vpnn.p3, vpnn.p4> ;
_ => <vpnn.p1, obj ! a ++ vpnn.p2, vpnn.p3, vpnn.p4> }
} ;
insertAdV : Str -> VP -> VP = \adv,vp -> vp ** { -- not used in Ger, so VP.a1 can be skipped
@@ -986,7 +1005,7 @@ resource ResGer = ParamX ** open Prelude in {
infPart : Bool -> Str = \b -> if_then_Str b [] "zu" ;
heavyNP :
{s : PCase => Str ; a : Agr} -> {s : PCase => Str ; a : Agr ; w : Weight ; ext,rc : Str} = \np ->
{s : Bool => Case => Str ; a : Agr} -> {s : Bool => Case => Str ; a : Agr ; w : Weight ; ext,rc : Str} = \np ->
np ** {w = WHeavy ; ext,rc = []} ; -- this could be wrong
relPron : RelGenNum => Case => Str = \\rgn,c =>
@@ -1003,11 +1022,12 @@ resource ResGer = ParamX ** open Prelude in {
} ;
-- Function that allows the construction of non-nominative subjects.
mkSubj : NP -> Preposition -> Str * Agr = \np, prep ->
mkSubject : NP -> Preposition -> {s:Str ; a:Agr} = \np, prep ->
let
agr = case prep.c of { NPC Nom => np.a ; _ => Ag Masc Sg P3 } ;
subj = appPrepNP prep np
in <subj , agr> ;
subj = appPrepNP prep np ;
agr = case prep.c of { Nom => np.a ; _ => Ag Masc Sg P3 }
in {s = subj ; a = agr} ;
sex2gender : Sex -> Gender = \g ->
case g of {

View File

@@ -5,8 +5,8 @@ concrete SentenceGer of Sentence = CatGer ** open ResGer, Prelude in {
lin
PredVP np vp =
let subj = mkSubj np vp.c1
in mkClause subj.p1 subj.p2 vp ;
let subj = mkSubject np vp.c1
in mkClause subj.s subj.a vp ;
{- applies verb's subject case to subject ;
forces 3rd person sg agreement for any non-nom subjects -->
@@ -26,16 +26,24 @@ concrete SentenceGer of Sentence = CatGer ** open ResGer, Prelude in {
} ;
agr = Ag Fem (numImp n) ps.p1 ; --- g does not matter
verb = vps.s ! False ! agr ! VPImperat ps.p3 ;
neg = negation ! pol ;
inf = vp.inf.inpl.p2 ++ verb.inf ; -- HL .s/.inpl.p2
obj = (vp.nn ! agr).p2 ++ (vp.nn ! agr).p3 ++ (vp.nn ! agr).p4
obj = (vp.nn ! agr).p2 ++ (vp.nn ! agr).p3 ++ (vp.nn ! agr).p4 ++ vp.adj
in
-- verb.fin ++ ps.p2 ++ (vp.nn ! agr).p1 ++ vp.a1 ! pol ++ obj ++ vp.a2 ++ inf ++ vp.ext
verb.fin ++ ps.p2 ++ (vp.nn ! agr).p1 ++ vp.a1 ++ negation ! pol ++ obj ++ vp.a2 ++ inf ++ vp.ext
verb.fin ++ ps.p2 ++ (vp.nn ! agr).p1 ++ vp.a1 ++ neg ++ obj ++ vp.a2 ++ inf ++ vp.ext
} ;
AdvImp adv imp = {
s = \\pol,impform => adv.s ++ imp.s ! pol ! impform
} ;
-- to save compile time: HL 7/22, comment SlashVP out:
-- + SlashV2VNP 199065600 (46080,240)
-- + SlashVP 414720 (28224,204)
SlashVP np vp =
let subj = mkSubj np vp.c1 ; -- HL 3/2022: need a mkClSlash to prevent
in mkClause subj.p1 subj.p2 vp ** { c2 = vp.c2 } ; -- reflexives in vp instantiated to np.a
let subj = mkSubject np vp.c1 ; -- HL 3/2022: need a mkClSlash to prevent
in mkClause subj.s subj.a vp ** { c2 = vp.c2 } ; -- reflexives in vp instantiated to np.a
-- cf. tests/german/TestLangGer.gf
AdvSlash slash adv = {
s = \\m,t,a,b,o => slash.s ! m ! t ! a ! b ! o ++ adv.s ;
@@ -45,10 +53,9 @@ concrete SentenceGer of Sentence = CatGer ** open ResGer, Prelude in {
SlashPrep cl prep = cl ** {c2 = prep} ;
SlashVS np vs slash =
let subj = mkSubj np PrepNom
in mkClause subj.p1 subj.p2
(insertExtrapos (conjThat ++ slash.s ! Sub) (predV vs)) **
{c2 = slash.c2} ;
let subj = mkSubject np PrepNom ;
vp = (insertExtrapos (conjThat ++ slash.s ! Sub) (predV vs))
in mkClause subj.s subj.a vp ** {c2 = slash.c2} ;
EmbedS s = {s = conjThat ++ s.s ! Sub} ; -- no leading comma, if sentence-initial
EmbedQS qs = {s = qs.s ! QIndir} ;

View File

@@ -33,10 +33,12 @@ concrete StructuralGer of Structural = CatGer **
during_Prep = mkPrep "während" P.genitive ; --- no variants in the rgl | P.mkPrep P.accusative "über" ;
either7or_DConj = sd2 "entweder" "oder" ** {n = Sg} ;
everybody_NP = nameNounPhrase Masc {s = caselist "jeder" "jeden" "jedem" "jedes"} ;
every_Det = detUnlikeAdj False Sg "jed" ;
every_Det = let tab = (detUnlikeAdj False Sg "jed").s
in {s,sp = asQuant tab ; n = Sg ; a = Weak ; isDef = False ; hasDefArt = False} ;
everything_NP = nameNounPhrase Neutr {s = caselist "alles" "alles" "allem" "alles"} ;
everywhere_Adv = ss "überall" ;
few_Det = detLikeAdj False Pl "wenig" ;
few_Det = let tab = (detLikeAdj False Pl "wenig").s
in {s,sp = asQuant tab ; n = Pl ; a = Weak ; isDef = False ; hasDefArt = False} ;
---- first_Ord = {s = (regA "erst").s ! Posit} ;
for_Prep = mkPrep "für" P.accusative ;
from_Prep = mkPrep "aus" P.dative ;
@@ -46,25 +48,26 @@ concrete StructuralGer of Structural = CatGer **
here_Adv = ss "hier" ;
how_IAdv = ss "wie" ;
how8much_IAdv = ss "wieviel" ;
how8many_IDet = {s = \\g,c => (detUnlikeAdj False Pl "wie viel").s ! g ! NPC c ; n = Pl} ;
how8many_IDet = {s = \\g,c => (detUnlikeAdj False Pl "wie viel").s ! g ! c ; n = Pl} ;
if_Subj = ss "wenn" ; --- no variants in the RGL! | ss "falls" ;
in8front_Prep = mkPrep "vor" P.dative ;
i_Pron = mkPronPers "ich" "mich" "mir" "meiner" "mein" Masc Sg P1 ;
in_Prep = mkPrep [] (NPP CInDat) ;
-- in_Prep = mkPrep [] (NPP CInDat) ;
in_Prep = P.inDat_Prep ; -- HL 7/2022
it_Pron = mkPronPers "es" "es" "ihm" "seiner" "sein" Neutr Sg P3 ;
less_CAdv = X.mkCAdv "weniger" "als" ;
many_Det = detLikeAdj False Pl "viel" ;
many_Det = let tab = (detLikeAdj False Pl "viel").s
in {s,sp = asQuant tab ; n = Pl ; a = Weak ; isDef = False ; hasDefArt = False} ;
more_CAdv = X.mkCAdv "mehr" "als" ;
-- most_Predet = {s = appAdj (regA "meist") ; c = noCase ; a = PAgNone} ;
most_Predet = { -- HL 5/2022
s = \\n,g,c => let gn = R.gennum g n ;
k = (R.prepC c).c ;
adj = (P.mkA "viel" "mehr" "meiste").s ! Superl
in
R.usePrepC c (\k -> R.artDef ! gn ! k ++ adj ! (agrAdj g Weak n k)) ;
c = {p = [] ; k = PredCase (NPC Gen)} ;
R.artDef ! gn ! c ++ adj ! (agrAdj g Weak n c) ;
c = {p = [] ; k = PredCase Gen} ;
a = PAg Pl} ;
much_Det = {s = \\_,_ => "viel" ; sp = \\_,_ => "vieles" ; n = Sg ; a = Weak ; isDef = False} ;
much_Det = {s = asQuant (\\_,_ => "viel") ; sp = asQuant (\\_,_ => "vieles") ;
n = Sg ; a = Weak ; isDef = False ; hasDefArt = False} ;
must_VV = auxVV
(mkV
"müssen" "muss" "musst" "muss" "müsst" "müss"
@@ -78,27 +81,27 @@ concrete StructuralGer of Structural = CatGer **
on_Prep = mkPrep "auf" P.dative ;
or_Conj = {s1 = [] ; s2 = "oder" ; n = Sg} ;
otherwise_PConj = ss "sonst" ;
part_Prep = P.von_Prep ; -- mkPrep "von" P.dative ;
part_Prep = P.von_Prep ; -- obsolete, use PartNP cn np
please_Voc = ss "bitte" ;
possess_Prep = P.von_Prep ;-- mkPrep "von" P.dative ;
possess_Prep = P.von_Prep ; -- obsolete, use PossNP cn np
quite_Adv = ss "ziemlich" ;
she_Pron = mkPronPers "sie" "sie" "ihr" "ihrer" "ihr" Fem Sg P3 ;
so_AdA = ss "so" ;
somebody_NP = nameNounPhrase Masc {s = caselist "jemand" "jemanden" "jemandem" "jemands"} ;
somePl_Det = detLikeAdj True Pl "einig" ;
somePl_Det = let tab = (detLikeAdj True Pl "einig").s
in {s,sp = asQuant tab ; isDef = True ; n = Pl ; a = Weak ; hasDefArt = False} ;
someSg_Det = {
s,sp = \\g,c =>
usePrepC c (\k -> "ein" + pronEnding ! GSg g ! k) ; ---- einer,eines
s,sp = asQuant (\\g,c => "ein" + pronEnding ! GSg g ! c) ; ---- einer,eines
n = Sg ;
a = Strong ;
hasNum = True ;
isDef = False ;
isDef = False ; hasDefArt = False
} ;
something_NP = nameNounPhrase Neutr {s = \\_ => "etwas"} ;
somewhere_Adv = ss "irgendwo" ;
that_Quant = let
jener : Number => Gender => PCase => Str = \\n => (detUnlikeAdj True n "jen").s in
{s,sp = \\_ => jener ; a,aPl = Weak} ;
jener : Number => Gender => Case => Str = \\n => (detUnlikeAdj True n "jen").s in
{s,sp = \\_,_ => jener ; a,aPl = Weak ; hasDefArt = False} ;
---b that_NP = nameNounPhrase Neutr {s = caselist "das" "das" "dem" "dessen"} ; ----
there_Adv = ss "da" ; --- no variants in the rgl | ss "dort" ;
there7to_Adv = ss "dahin" ;
@@ -107,8 +110,8 @@ concrete StructuralGer of Structural = CatGer **
---b these_NP = {s = caselist "diese" "diese" "diesen" "dieser" ; a = agrP3 Pl} ;
they_Pron = mkPronPers "sie" "sie" "ihnen" "ihrer" "ihr" Fem Pl P3 ;
this_Quant = let
dieser : Number => Gender => PCase => Str = \\n => (detUnlikeAdj True n "dies").s in
{s,sp = \\_ => dieser ; a,aPl = Weak} ;
dieser : Number => Gender => Case => Str = \\n => (detUnlikeAdj True n "dies").s in
{s,sp = \\_,_ => dieser ; a,aPl = Weak ; hasDefArt = False} ;
---b this_NP = nameNounPhrase Neutr {s = caselist "dies" "dies" "diesem" "dieses"} ; ----
---b those_NP = {s = caselist "jene" "jene" "jenen" "jener" ; a = agrP3 Pl} ;
through_Prep = mkPrep "durch" P.accusative ;
@@ -130,7 +133,7 @@ concrete StructuralGer of Structural = CatGer **
when_IAdv = ss "wann" ;
when_Subj = ss "wenn" ;
where_IAdv = ss "wo" ;
which_IQuant = {s = \\n,g,c => (detUnlikeAdj True n "welch").s ! g ! NPC c} ;
which_IQuant = {s = \\n,g,c => (detUnlikeAdj True n "welch").s ! g ! c} ;
whoSg_IP = {s = caselist "wer" "wen" "wem" "wessen" ; n = Sg} ;
whoPl_IP = {s = caselist "wer" "wen" "wem" "wessen" ; n = Sg} ; -- HL 6/2016
@@ -144,12 +147,12 @@ concrete StructuralGer of Structural = CatGer **
not_Predet = {s = \\_,_,_ => "nicht" ; c = noCase ; a = PAgNone} ;
no_Quant = let
keiner : Number => Gender => PCase => Str = table {
Sg => \\g,c => usePrepC c (\k -> "kein" + pronEnding ! GSg g ! k) ;
keiner : Number => Gender => Case => Str = table {
Sg => \\g,c => "kein" + pronEnding ! GSg g ! c ;
Pl => (detUnlikeAdj False Pl "kein").s
}
in
{s,sp = \\_ => keiner ; a = Strong ; aPl = Weak} ; ---- sp
{s,sp = \\_,_ => keiner ; a = Strong ; aPl = Weak ; hasDefArt = False} ; ---- sp
if_then_Conj = {s1 = "wenn" ; s2 = "dann" ; n = Sg ; lock_Conj = <>} ;
nobody_NP =
nameNounPhrase Masc {s = caselist "niemand" "niemanden" "niemandem" "niemands"} ;
@@ -165,7 +168,15 @@ concrete StructuralGer of Structural = CatGer **
lin language_title_Utt = ss "Deutsch" ;
oper
appAdjDegAdjf : Adjective -> Degree -> Adjf -> Number => Gender => PCase => Str =
\adj,deg,adjf -> \\n,g,c => R.usePrepC c (\k -> adj.s ! deg ! (agrAdj g adjf n k)) ;
oper
asQuant : (Gender => Case => Str) -> (Bool => Gender => Case => Str) =
\tab -> \\_,g,c => tab ! g ! c ;
asNum : (Gender => Case => Str) -> (Gender => Case => {quant,num:Str}) =
\tab -> \\g,c => {quant = []; num = tab ! g ! c} ;
pairTable : (Gender => Case => Str) -> (Gender => Case => Str) -> (Gender => Case => {quant,num:Str})
= \qt,nt -> \\g,c => {quant = qt ! g ! c; num = nt ! g ! c} ;
appAdjDegAdjf : Adjective -> Degree -> Adjf -> Number => Gender => Case => Str =
\adj,deg,adjf -> \\n,g,c => adj.s ! deg ! (agrAdj g adjf n c) ;
}

View File

@@ -9,29 +9,23 @@ lin
NumPN i = {s = i.s ! Neutr ; g = Neutr ; n = Sg} ; --- c
CNIntNP cn i = {
s = \\c => cn.s ! Weak ! Sg ! Nom ++ i.s ;
s = \\b,c => cn.s ! Weak ! Sg ! Nom ++ i.s ;
a = agrP3 Sg ;
-- isPron = False ;
-- isLight = True ;
w = WLight ;
ext,rc = [] -- added
} ;
CNSymbNP det cn xs = let g = cn.g in {
s = \\c => det.s ! g ! c ++
(let k = (prepC c).c in cn.s ! adjfCase det.a k ! det.n ! k) ++ xs.s ;
s = \\b,c => det.s ! b ! g ! c ++ cn.s ! adjfCase det.a c ! det.n ! c ++ xs.s ;
a = agrP3 det.n ;
-- isPron = False ;
-- isLight = True ;
w = WLight ;
ext,rc = [] -- added
} ;
CNNumNP cn i = {
s = \\c => artDefContr (GSg cn.g) c ++ cn.s ! Weak ! Sg ! Nom ++ i.s ! Neutr ! (prepC c).c ;
-- s = \\c => artDefContr (GSg cn.g) c ++ cn.s ! Weak ! Sg ! Nom ++ i.s ! Neutr ! c ;
s = \\_,c => artDef ! (GSg cn.g) ! c ++ cn.s ! Weak ! Sg ! Nom ++ i.s ! Neutr ! c ; -- HL 8/22 ad hoc
a = agrP3 Sg ;
-- isPron = False ;
-- isLight = True ;
w = WLight ;
ext,rc = [] -- added
ext,rc = []
} ;
SymbS sy = {s = \\_ => sy.s} ;

View File

@@ -4,17 +4,6 @@ concrete VerbGer of Verb = CatGer ** open Prelude, ResGer, Coordination in {
lin
UseV = predV ;
{-
ComplVV v vp =
let
vpi = infVP v.isAux vp ;
vps = predVGen v.isAux v ;
in
insertExtrapos vpi.p4 (
insertInfExt vpi.p3 (
insertInf vpi.p2 (
insertObjc vpi.p1 vps))) ;
-}
ComplVV v vp = -- HL 3/22: leave inf-complement in-place, extract infzu-complement
let
@@ -39,18 +28,7 @@ concrete VerbGer of Verb = CatGer ** open Prelude, ResGer, Coordination in {
insertExtrapos (comma ++ conjThat ++ s.s ! Sub) (predV v) ** {c2 = v.c2; objCtrl = False} ;
SlashV2Q v q =
insertExtrapos (comma ++ q.s ! QIndir) (predV v) ** {c2 = v.c2; objCtrl = False} ;
{-
SlashV2V v vp =
let
vpi = infVP v.isAux vp ;
vps = predVGen v.isAux v ** {c2 = v.c2} ;
in vps **
insertExtrapos vpi.p4 ( -- inplace vp; better extract it!
insertInfExt vpi.p3 (
insertInf vpi.p2 (
insertObjc vpi.p1 vps))) ;
-}
SlashV2V v vp = -- (jmdn) bitten, sich zu waschen | sich waschen lassen HL 7/19
let
vps = predVGen v.isAux v ; -- e.g. verspricht|bittet.isAux=False | läßt.isAux=True
@@ -62,23 +40,14 @@ concrete VerbGer of Verb = CatGer ** open Prelude, ResGer, Coordination in {
SlashV2A v ap =
insertAdj (ap.s ! APred) ap.c ap.ext (predV v) ** {c2 = v.c2; objCtrl = False} ;
-- to save (83669 - 67299 = 16370 msec) compile time, comment out:
ComplSlash vps np =
-- IL 24/04/2018 force reflexive in the VPSlash to take the agreement of np.
-- HL 3/22 better before inserting np, using objCtrl
let vp = case vps.objCtrl of { True => objAgr np vps ; _ => vps }
** { c2 = vps.c2 ; objCtrl = vps.objCtrl } ;
in insertObjNP np vps.c2 vp ;
{-
SlashVV v vp =
let
vpi = infVP v.isAux vp ;
vps = predVGen v.isAux v ** {c2 = vp.c2 } ;
in vps **
insertExtrapos vpi.p3 (
insertInf vpi.p2 (
insertObj vpi.p1 vps)) ;
-}
-- compiler: + ComplSlash' 414720 (199680,352)
-- SlashVV v vps is like ComplVV v vp, but infinite vps should not be extracted
SlashVV v vp = -- HL 3/2022
@@ -123,9 +92,17 @@ concrete VerbGer of Verb = CatGer ** open Prelude, ResGer, Coordination in {
-- expensive: + SlashV2VNP 503.884.800 (2880,540), reaches memory limit with SlashVV
-- does not work for nested uses: the nn-levels are confused HL 3/22
-- to save a lot compile time and memory, avoid insertObjNP with glueing of prep+DefArt:
SlashV2VNP v np vp = -- bitte ihn, zu kaufen | lasse ihn kaufen HL 3/22
insertObjNP np v.c2 (ComplVV v vp ** {c2 = vp.c2 ; objCtrl = vp.objCtrl}) ;
-- insertObjNP np v.c2 (ComplVV v vp ** {c2 = vp.c2 ; objCtrl = vp.objCtrl}) ;
let prep = v.c2 ;
obj = appPrep prep (np.s!False) ; -- simplify: no glueing of prep+DefArt, HL 8/22
b : Bool = case prep.isPrep of {isPrep | isPrepDefArt => True ; _ => False} ;
c = prep.c ;
w = np.w ;
vps = (ComplVV v vp ** {c2 = vp.c2 ; objCtrl = vp.objCtrl})
in
insertObj' obj b w c vps ;
UseComp comp =
insertExtrapos comp.ext (insertObj comp.s (predV sein_V)) ; -- agr not used
@@ -135,7 +112,7 @@ concrete VerbGer of Verb = CatGer ** open Prelude, ResGer, Coordination in {
UseCopula = predV sein_V ;
CompAP ap = {s = \\_ => ap.c.p1 ++ ap.s ! APred ++ ap.c.p2 ; ext = ap.ext} ;
CompNP np = {s = \\_ => np.s ! NPC Nom ++ np.rc ; ext = np.ext} ;
CompNP np = {s = \\_ => np.s ! False ! Nom ++ np.rc ; ext = np.ext} ;
CompAdv a = {s = \\_ => a.s ; ext = []} ;
CompCN cn = {s = \\a => case numberAgr a of {
@@ -159,7 +136,7 @@ concrete VerbGer of Verb = CatGer ** open Prelude, ResGer, Coordination in {
PassV2 v = -- acc object -> nom subject; all others: same PCase
let c = case <v.c2.c, v.c2.isPrep> of {
<NPC Acc, False> => NPC Nom ; _ => v.c2.c}
<Acc, isCase> => Nom ; _ => v.c2.c}
in insertObj (\\_ => v.s ! VPastPart APred) (predV werdenPass) ** { c1 = v.c2 ** {c = c} } ;
{- HL: The construction VPSlashPrep : VP -> Prep -> VPSlash does not exist

View File

@@ -31,29 +31,37 @@ concrete TestLangGer of TestLang =
(insertObjRefl (predVc v3) ** {c2 = v3.c3});
PassV2Q v q =
let vp = insertObj (\\_ => v.s ! VPastPart APred) (predV werdenPass)
** { c1 = subjPrep v.c2 }
let c = case <v.c2.c, isaPrep v.c2> of {
<Acc, False> => Nom ; _ => v.c2.c} ; -- acc;pcase object -> nom;pcase subject
vp = insertObj (\\_ => v.s ! VPastPart APred) (predV werdenPass)
** { c1 = v.c2 ** {c = c} }
in insertExtrapos (bindComma ++ q.s ! QIndir) vp ;
PassV2S v s =
let vp = insertObj (\\_ => v.s ! VPastPart APred) (predV werdenPass)
** { c1 = subjPrep v.c2 }
let c = case <v.c2.c, isaPrep v.c2> of {
<Acc, False> => Nom ; _ => v.c2.c} ; -- acc;pcase object -> nom;pcase subject
vp = insertObj (\\_ => v.s ! VPastPart APred) (predV werdenPass)
** { c1 = v.c2 ** {c = c} }
in insertExtrapos (bindComma ++ conjThat ++ s.s ! Sub) vp ;
PassV2V v vp =
let -- ok for v.isAux=False,
inf = mkInf v.isAux Simul Pos vp ; -- v.c2.c=Acc, v.objCtrl=True HL 3/22
let
inf = mkInf v.isAux Simul Pos vp ; -- ok for v.isAux=False, v.c2.c=Acc
c = case <v.c2.c, isaPrep v.c2> of { -- v.objCtrl=True HL 3/22
<Acc, False> => Nom ; _ => v.c2.c} ; -- acc;pcase object -> nom;pcase subject
vp2 = insertObj (\\_ => v.s ! VPastPart APred) (predV werdenPass)
** { c1 = subjPrep v.c2 } ;
in insertInf inf vp2 ; -- v=lassen needs in-place inf instead
PassVPSlash vp = -- less correct in ExtraGer.gf with inserting
let -- (\\_ => (PastPartAP vp).s ! APred)
PassVPSlash vp =
let c = case <vp.c2.c, isaPrep vp.c2> of {
<Acc, False> => Nom ; _ => vp.c2.c} ;
ctrl = case vp.objCtrl of { True => False ; _ => True } -- always False?
in
insertObj (\\_ => vp.a2 ++ vp.adj ++ vp.s.s ! (VPastPart APred))
(predV werdenPass ** {nn = vp.nn ; c1 = subjPrep vp.c2})
** {ext = vp.ext ; inf = vp.inf ; c2 = vp.c2 ; objCtrl = ctrl } ; -- c2 ?
in -- insertObj (\\_ => (PastPartAP vp).s ! APred) (predV werdenPass ** {c1 = vp.c2 ** {c = c}})
insertObj (\\_ => vp.s.s ! (VPastPart APred))
(predV werdenPass ** {nn = vp.nn ; c1 = vp.c2 ** {c = c}})
** {ext = vp.ext ; inf = vp.inf ; c2 =vp.c2 ; objCtrl = ctrl } ; -- c2 ?
-- Scharolta: passivised object: acc object -> nom subject; all others: same case/prep
-- HL: does not work for vp = (Slash2V3 v np): uns wird *den Beweis erklärt
-- 3/22 works for vp = (SlashV2V v2v reflVP): wir werden gebeten, uns zu waschen
@@ -159,16 +167,16 @@ gr -tr (PredVP (UsePron ?) (ComplSlash (SlashV2V lassen_V2V (ReflVP (SlashV2a wa
} ;
lin
{- too expensive 60% memory, then killed:
SlashVP np vp =
let subj = mkSubj np vp.c1
in mkClSlash subj.p1 subj.p2 vp ** { c2 = vp.c2 } ;
let subj = mkSubject np vp.c1
in mkClSlash subj.s subj.a vp ** { c2 = vp.c2 } ;
-}
RelSlash rp cls = lin RCl {
s = \\m,t,a,p,gn =>
appPrepC cls.c2 (rp.s ! gn) ++
appPrep cls.c2 (rp.s ! gn) ++
cls.s ! m ! t ! a ! p ! Sub ! gn ;
c = (prepC cls.c2.c).c
c = cls.c2.c
} ;
QuestSlash ip slash = let gn : GenNum = case ip.n of {Sg => GSg Masc ; _ => GPl} in {
@@ -227,7 +235,7 @@ gr -tr (PredVP (UsePron ?) (ComplSlash (SlashV2V lassen_V2V (ReflVP (SlashV2a wa
obj2 = (vp.nn ! ag).p3 ; -- pp-objects and heavy nps
obj3 = (vp.nn ! ag).p4 ++ vp.adj ++ vp.a2 ; -- pred.AP|CN|Adv, via useComp HL 6/2019
compl : Str = obj1 ++ obj2 ++ neg ++ obj3 ;
infObjs = (vp.inf.inpl.p1) ! ag ;
infObjs = vp.inf.inpl.p1 ! ag ;
infPred = vp.inf.inpl.p2 ;
infCompl : Str = case <t,a,vp.isAux> of {
<Fut|Cond,Anter,True> => [] ; _ => infObjs ++ infPred } ;