1
0
forked from GitHub/gf-core

shrinking the size of some Fin datatypes (in general RGL) results in pgf size reduction to 25% of previous size

This commit is contained in:
aarne
2014-02-09 17:38:24 +00:00
parent 8b9daedc14
commit d60db9a4c3
11 changed files with 148 additions and 98 deletions

View File

@@ -85,8 +85,8 @@ concrete CatFin of Cat = CommonX ** open ResFin, StemFin, Prelude in {
V, VS, VQ = SVerb1 ; V, VS, VQ = SVerb1 ;
V2, VA, V2Q, V2S = SVerb1 ** {c2 : Compl} ; V2, VA, V2Q, V2S = SVerb1 ** {c2 : Compl} ;
V2A = SVerb1 ** {c2, c3 : Compl} ; V2A = SVerb1 ** {c2, c3 : Compl} ;
VV = SVerb1 ** {vi : InfForm} ; ---- infinitive form VV = SVerb1 ** {vi : VVType} ; ---- infinitive form
V2V = SVerb1 ** {c2 : Compl ; vi : InfForm} ; ---- infinitive form V2V = SVerb1 ** {c2 : Compl ; vi : VVType} ; ---- infinitive form
V3 = SVerb1 ** {c2, c3 : Compl} ; V3 = SVerb1 ** {c2, c3 : Compl} ;
A = {s : Degree => SAForm => Str ; h : Harmony} ; A = {s : Degree => SAForm => Str ; h : Harmony} ;
@@ -98,22 +98,22 @@ concrete CatFin of Cat = CommonX ** open ResFin, StemFin, Prelude in {
PN = SPN ; PN = SPN ;
linref linref
SSlash = \ss -> ss.s ++ ss.c2.s ! False ; SSlash = \ss -> ss.s ++ ss.c2.s.p1 ;
ClSlash = \cls -> cls.s ! Pres ! Simul ! Pos ++ cls.c2.s ! False ; ClSlash = \cls -> cls.s ! Pres ! Simul ! Pos ++ cls.c2.s.p1 ;
NP = \np -> np.s ! NPSep ; NP = \np -> np.s ! NPAcc ; ----NPSep ;
VP = vpRef ; VP = vpRef ;
VPSlash = \vps -> vpRef vps ++ vps.c2.s ! False ; VPSlash = \vps -> vpRef vps ++ vps.c2.s.p1 ;
V, VS, VQ, VA = \v -> vpRef (predV v) ; V, VS, VQ, VA = \v -> vpRef (predV v) ;
V2, V2A, V2Q, V2S = \v -> vpRef (predV v) ++ v.c2.s ! False ; V2, V2A, V2Q, V2S = \v -> vpRef (predV v) ++ v.c2.s.p1 ;
V3 = \v -> vpRef (predV v) ++ v.c2.s ! False ++ v.c3.s ! False ; V3 = \v -> vpRef (predV v) ++ v.c2.s.p1 ++ v.c3.s.p1 ;
VV = \v -> vpRef (predV v) ; VV = \v -> vpRef (predV v) ;
V2V = \v -> vpRef (predV v) ++ v.c2.s ! False ; V2V = \v -> vpRef (predV v) ++ v.c2.s.p1 ;
Conj = \c -> c.s1 ++ c.s2 ; Conj = \c -> c.s1 ++ c.s2 ;
oper oper
vpRef : StemFin.VP -> Str = \vp -> infVP (NPCase Nom) Pos (agrP3 Sg) vp Inf1 ; vpRef : StemFin.VP -> Str = \vp -> infVP SCNom Pos (agrP3 Sg) vp Inf1 ;
} }

View File

@@ -30,27 +30,27 @@ concrete ExtraFin of ExtraFinAbs = CatFin **
} ; } ;
lincat lincat
VPI = {s : InfForm => Str} ; VPI = {s : VVType => Str} ;
[VPI] = {s1,s2 : InfForm => Str} ; [VPI] = {s1,s2 : VVType => Str} ;
lin lin
BaseVPI = twoTable InfForm ; BaseVPI = twoTable VVType ;
ConsVPI = consrTable InfForm comma ; ConsVPI = consrTable VVType comma ;
MkVPI vp = {s = \\i => infVP (NPCase Nom) Pos (agrP3 Sg) vp i} ; MkVPI vp = {s = \\i => infVP SCNom Pos (agrP3 Sg) vp (vvtype2infform i)} ;
ConjVPI = conjunctDistrTable InfForm ; ConjVPI = conjunctDistrTable VVType ;
ComplVPIVV vv vpi = ComplVPIVV vv vpi =
insertObj (\\_,_,_ => vpi.s ! vv.vi) (predSV vv) ; insertObj (\\_,_,_ => vpi.s ! vv.vi) (predSV vv) ;
lincat lincat
VPS = { VPS = {
s : Agr => Str ; s : Agr => Str ;
sc : NPForm ; --- can be different for diff parts sc : SubjCase ; --- can be different for diff parts
h : Harmony --- can be different for diff parts h : Harmony --- can be different for diff parts
} ; } ;
[VPS] = { [VPS] = {
s1,s2 : Agr => Str ; s1,s2 : Agr => Str ;
sc : NPForm ; --- take the first: minä osaan kutoa ja täytyy virkata sc : SubjCase ; --- take the first: minä osaan kutoa ja täytyy virkata
h : Harmony --- take the first: osaanko minä kutoa ja käyn koulua h : Harmony --- take the first: osaanko minä kutoa ja käyn koulua
} ; } ;
@@ -112,7 +112,7 @@ concrete ExtraFin of ExtraFinAbs = CatFin **
IAdvPredNP iadv v np = IAdvPredNP iadv v np =
let cl = mkClause (\_ -> iadv.s) np.a (insertObj let cl = mkClause (\_ -> iadv.s) np.a (insertObj
(\\_,b,_ => np.s ! v.sc) (predSV v)) ; (\\_,b,_ => np.s ! subjcase2npform v.sc) (predSV v)) ;
in { in {
s = \\t,a,p => cl.s ! t ! a ! p ! SDecl s = \\t,a,p => cl.s ! t ! a ! p ! SDecl
} ; } ;
@@ -255,7 +255,7 @@ concrete ExtraFin of ExtraFinAbs = CatFin **
-- advantage though: works for all V2 verbs, need not be transitive -- advantage though: works for all V2 verbs, need not be transitive
PassAgentVPSlash vp np = { PassAgentVPSlash vp np = {
s = {s = vp.s.s ; h = vp.s.h ; p = vp.s.p ; sc = vp.c2.c} ; s = {s = vp.s.s ; h = vp.s.h ; p = vp.s.p ; sc = npform2subjcase vp.c2.c} ;
s2 = \\b,p,a => np.s ! NPCase Nom ++ vp.s2 ! b ! p ! a ; s2 = \\b,p,a => np.s ! NPCase Nom ++ vp.s2 ! b ! p ! a ;
adv = vp.adv ; adv = vp.adv ;
ext = vp.ext ; ext = vp.ext ;

View File

@@ -16,7 +16,7 @@ concrete IdiomFin of Idiom = CatFin **
ExistIP ip = ExistIP ip =
let let
cas : NPForm = NPCase Nom ; ---- also partitive in Extra cas : SubjCase = SCNom ; ---- also partitive in Extra
vp = insertObj (\\_,b,_ => "olemassa") (predV olla) ; vp = insertObj (\\_,b,_ => "olemassa") (predV olla) ;
cl = mkClause (subjForm (ip ** {isPron = False ; a = agrP3 ip.n}) cas) (agrP3 ip.n) vp cl = mkClause (subjForm (ip ** {isPron = False ; a = agrP3 ip.n}) cas) (agrP3 ip.n) vp
in { in {
@@ -61,7 +61,7 @@ concrete IdiomFin of Idiom = CatFin **
ImpP3 np vp = ImpP3 np vp =
let vps = (sverb2verbSep vp.s).s ! ImperP3 (verbAgr np.a).n let vps = (sverb2verbSep vp.s).s ! ImperP3 (verbAgr np.a).n
in in
{s = np.s ! vp.s.sc ++ vps ++ {s = np.s ! subjcase2npform vp.s.sc ++ vps ++
vp.s2 ! True ! Pos ! np.a ++ vp.adv ! Pos ++ vp.ext vp.s2 ! True ! Pos ! np.a ++ vp.adv ! Pos ++ vp.ext
} ; } ;

View File

@@ -943,7 +943,7 @@ caseTable : Number -> CommonNoun -> Case => Str = \n,cn ->
a = Predef.dp 1 minuna a = Predef.dp 1 minuna
} in } in
{s = table { {s = table {
NPCase Nom | NPSep => mina ; NPCase Nom => mina ; ----- NPSep
NPCase Gen => minun ; NPCase Gen => minun ;
NPCase Part => minua ; NPCase Part => minua ;
NPCase Transl => minu + "ksi" ; NPCase Transl => minu + "ksi" ;

View File

@@ -85,7 +85,7 @@ oper
} ; } ;
accusative : Prep accusative : Prep
= {c = NPAcc ; s : Bool => Str = \\_ => [] ; isPre = True ; h = Back ; lock_Prep = <>} ; = lin Prep {c = NPAcc ; s = <[],[],\\_ => []>} ;
NK : Type ; -- Noun from DictFin (Kotus) NK : Type ; -- Noun from DictFin (Kotus)
AK : Type ; -- Adjective from DictFin (Kotus) AK : Type ; -- Adjective from DictFin (Kotus)
@@ -279,7 +279,7 @@ mkVS = overload {
mkV2V : V -> Prep -> V2V -- e.g. "käskeä" genitive mkV2V : V -> Prep -> V2V -- e.g. "käskeä" genitive
= \v,p -> mkV2Vf v p infIllat ; = \v,p -> mkV2Vf v p infIllat ;
mkV2Vf : V -> Prep -> InfForm -> V2V -- e.g. "kieltää" partitive infElatv mkV2Vf : V -> Prep -> InfForm -> V2V -- e.g. "kieltää" partitive infElatv
= \v,p,f -> mk2V2 v p ** {vi = f ; lock_V2V = <>} ; = \v,p,f -> mk2V2 v p ** {vi = infform2vvtype f ; lock_V2V = <>} ;
} ; } ;
mkV0 : V -> V0 ; --% mkV0 : V -> V0 ; --%
@@ -367,21 +367,28 @@ mkVS = overload {
infFirst = Inf1 ; infElat = Inf3Elat ; infIllat = Inf3Illat ; infIness = Inf3Iness ; infPresPart = InfPresPart ; infPresPartAgr = InfPresPartAgr ; infFirst = Inf1 ; infElat = Inf3Elat ; infIllat = Inf3Illat ; infIness = Inf3Iness ; infPresPart = InfPresPart ; infPresPartAgr = InfPresPartAgr ;
prePrep : Case -> Str -> Prep = prePrep : Case -> Str -> Prep =
\c,p -> lin Prep {c = NPCase c ; s = \\_ => p ; isPre = True ; h = Back} ; --- no possessive suffix \c,p -> lin Prep {c = NPCase c ; s = <p, [],\\_ => []>} ; -- no possessive suffix
postPrep : Case -> Str -> Prep = postPrep : Case -> Str -> Prep =
\c,p -> let h = guessHarmony p in case p of { \c,p ->
mukaa + "n" => lin Prep {c = NPCase c ; s = table {False => p ; True => mukaa} ; isPre = False ; h = h} ; let
_ => lin Prep {c = NPCase c ; s : Bool => Str = \\_ => p ; isPre = False ; h = h} h = guessHarmony p ;
} ; a2p : Agr => Str = case c of {
Gen => \\a => p ++ Predef.BIND ++ possSuffixGen h a ;
_ => \\a => p
} ;
in case p of {
mukaa + "n" => lin Prep {c = NPCase c ; s = <[],p, a2p>} ;
_ => lin Prep {c = NPCase c ; s = <[],p, a2p>}
} ;
postGenPrep = postPrep genitive ; postGenPrep = postPrep genitive ;
casePrep : Case -> Prep = casePrep : Case -> Prep =
\c -> lin Prep {c = NPCase c ; s : Bool => Str = \\_ => [] ; isPre = True ; h = Back} ; \c -> lin Prep {c = NPCase c ; s = <[],[],\\_ => []>} ;
accPrep = accPrep : Prep =
lin Prep {c = NPAcc ; s : Bool => Str = \\_ => [] ; isPre = True ; h = Back} ; lin Prep {c = NPAcc ; s = <[],[],\\_ => []>} ;
NK = {s : NForms ; lock_NK : {}} ; NK = {s : NForms ; lock_NK : {}} ;
AK = {s : NForms ; lock_AK : {}} ; AK = {s : NForms ; lock_AK : {}} ;
@@ -574,8 +581,11 @@ mkVS = overload {
} ; } ;
mkIsPre : Prep -> Bool = \p -> case p.c of { mkIsPre : Prep -> Bool = \p -> case p.c of {
NPCase Gen => notB p.isPre ; -- Jussin veli (prep is <Gen,"",True>, isPre becomes False) NPCase Gen => case p.s.p2 of {
_ => True -- syyte Jussia vastaan, puhe Jussin puolesta "" => False ; -- Jussin veli
_ => True -- puhe Jussin puolesta
} ;
_ => True -- syyte Jussia vastaan ; puhe Jussille
} ; } ;
mkPN = overload { mkPN = overload {
@@ -631,22 +641,22 @@ mkVS = overload {
mkV : ( mkV : (
huutaa,huudan,huutaa,huutavat,huutakaa,huudetaan, huutaa,huudan,huutaa,huutavat,huutakaa,huudetaan,
huusin,huusi,huusisi,huutanut,huudettu,huutanee : Str) -> V = mk12V ; huusin,huusi,huusisi,huutanut,huudettu,huutanee : Str) -> V = mk12V ;
mkV : (sana : VK) -> V = \w -> vforms2sverb w.s ** {sc = NPCase Nom ; lock_V = <> ; p = []} ; mkV : (sana : VK) -> V = \w -> vforms2sverb w.s ** {sc = SCNom ; lock_V = <> ; p = []} ;
mkV : V -> Str -> V = \w,p -> {s = w.s ; sc = w.sc ; lock_V = <> ; h = w.h ; p = p} ; mkV : V -> Str -> V = \w,p -> {s = w.s ; sc = w.sc ; lock_V = <> ; h = w.h ; p = p} ;
mkV : Str -> V -> V = \s,v -> {s = \\f => s + v.s ! f ; sc = v.sc ; lock_V = <> ; h = v.h ; p = v.p} ; mkV : Str -> V -> V = \s,v -> {s = \\f => s + v.s ! f ; sc = v.sc ; lock_V = <> ; h = v.h ; p = v.p} ;
} ; } ;
mk1V : Str -> V = \s -> mk1V : Str -> V = \s ->
let vfs = vforms2sverb (vForms1 s) in let vfs = vforms2sverb (vForms1 s) in
vfs ** {sc = NPCase Nom ; lock_V = <> ; p = []} ; vfs ** {sc = SCNom ; lock_V = <> ; p = []} ;
mk2V : (_,_ : Str) -> V = \x,y -> mk2V : (_,_ : Str) -> V = \x,y ->
let vfs = vforms2sverb (vForms2 x y) in vfs ** {sc = NPCase Nom ; lock_V = <> ; p = []} ; let vfs = vforms2sverb (vForms2 x y) in vfs ** {sc = SCNom ; lock_V = <> ; p = []} ;
mk3V : (huutaa,huudan,huusi : Str) -> V = \x,_,y -> mk2V x y ; ---- mk3V : (huutaa,huudan,huusi : Str) -> V = \x,_,y -> mk2V x y ; ----
mk12V : ( mk12V : (
huutaa,huudan,huutaa,huutavat,huutakaa,huudetaan, huutaa,huudan,huutaa,huutavat,huutakaa,huudetaan,
huusin,huusi,huusisi,huutanut,huudettu,huutanee : Str) -> V = huusin,huusi,huusisi,huutanut,huudettu,huutanee : Str) -> V =
\a,b,c,d,e,f,g,h,i,j,k,l -> \a,b,c,d,e,f,g,h,i,j,k,l ->
vforms2sverb (vForms12 a b c d e f g h i j k l) ** {sc = NPCase Nom ; lock_V = <> ; p = []} ; vforms2sverb (vForms12 a b c d e f g h i j k l) ** {sc = SCNom ; lock_V = <> ; p = []} ;
vForms1 : Str -> VForms = \ottaa -> vForms1 : Str -> VForms = \ottaa ->
let let
@@ -709,11 +719,11 @@ mkVS = overload {
caseV c v = {s = v.s ; sc = NPCase c ; h = v.h ; lock_V = <> ; p = v.p} ; caseV c v = {s = v.s ; sc = npform2subjcase (NPCase c) ; h = v.h ; lock_V = <> ; p = v.p} ;
vOlla = { vOlla = {
s = ollaSVerbForms ; s = ollaSVerbForms ;
sc = NPCase Nom ; h = Back ; lock_V = <> ; p = []} ; ---- lieneekö sc = SCNom ; h = Back ; lock_V = <> ; p = []} ; ---- lieneekö
mk2V2 : V -> Prep -> V2 = \v,c -> v ** {c2 = c ; lock_V2 = <>} ; mk2V2 : V -> Prep -> V2 = \v,c -> v ** {c2 = c ; lock_V2 = <>} ;
caseV2 : V -> Case -> V2 = \v,c -> mk2V2 v (casePrep c) ; caseV2 : V -> Case -> V2 = \v,c -> mk2V2 v (casePrep c) ;
@@ -730,7 +740,7 @@ mkVS = overload {
mkV2 : V -> V2 = dirV2 ; mkV2 : V -> V2 = dirV2 ;
mkV2 : V -> Case -> V2 = caseV2 ; mkV2 : V -> Case -> V2 = caseV2 ;
mkV2 : V -> Prep -> V2 = mk2V2 ; mkV2 : V -> Prep -> V2 = mk2V2 ;
mkV2 : VK -> V2 = \w -> dirV2 (vforms2sverb w.s ** {sc = NPCase Nom ; lock_V = <> ; p = []}) ; mkV2 : VK -> V2 = \w -> dirV2 (vforms2sverb w.s ** {sc = SCNom ; lock_V = <> ; p = []}) ;
} ; } ;
mk2V2 : V -> Prep -> V2 ; mk2V2 : V -> Prep -> V2 ;
@@ -741,7 +751,7 @@ mkVS = overload {
dirdirV3 v = dirV3 v allative ; dirdirV3 v = dirV3 v allative ;
mkVVf v f = v ** {vi = f ; lock_VV = <>} ; mkVVf v f = v ** {vi = infform2vvtype f ; lock_VV = <>} ;
mkVQ v = v ** {lock_VQ = <>} ; mkVQ v = v ** {lock_VQ = <>} ;
V0 : Type = V ; V0 : Type = V ;
@@ -754,7 +764,7 @@ mkVS = overload {
mkV2S v p = mk2V2 v p ** {lock_V2S = <>} ; mkV2S v p = mk2V2 v p ** {lock_V2S = <>} ;
mkV2Vbare : V -> V2V = \v -> mkV2Vf v (casePrep partitive) infIllat ; ---- mkV2Vbare : V -> V2V = \v -> mkV2Vf v (casePrep partitive) infIllat ; ----
-- mkV2V v p = mkV2Vf v p infIllat ; -- mkV2V v p = mkV2Vf v p infIllat ;
mkV2Vf v p f = mk2V2 v p ** {vi = f ; lock_V2V = <>} ; mkV2Vf v p f = mk2V2 v p ** {vi = infform2vvtype f ; lock_V2V = <>} ;
mkVAbare : V -> VA = \v -> mkVA v (casePrep partitive) ; ---- mkVAbare : V -> VA = \v -> mkVA v (casePrep partitive) ; ----
mkVA v p = v ** {c2 = p ; lock_VA = <>} ; mkVA v p = v ** {c2 = p ; lock_VA = <>} ;

View File

@@ -11,8 +11,8 @@ concrete PhraseFin of Phrase = CatFin ** open ResFin, StemFin, (P = Prelude) in
UttIP ip = {s = ip.s ! NPCase Nom} ; UttIP ip = {s = ip.s ! NPCase Nom} ;
UttIAdv iadv = iadv ; UttIAdv iadv = iadv ;
UttNP np = {s = np.s ! NPSep} ; UttNP np = {s = np.s ! NPAcc} ; ----NPSep} ;
UttVP vp = {s = infVP (NPCase Nom) Pos (agrP3 Sg) vp Inf1} ; UttVP vp = {s = infVP SCNom Pos (agrP3 Sg) vp Inf1} ;
UttAdv adv = adv ; UttAdv adv = adv ;
UttCN np = {s = np.s ! NCase Sg Nom} ; UttCN np = {s = np.s ! NCase Sg Nom} ;
UttAP np = {s = np.s ! P.False ! NCase Sg Nom} ; UttAP np = {s = np.s ! P.False ! NCase Sg Nom} ;

View File

@@ -28,9 +28,34 @@ resource ResFin = ParamX ** open Prelude in {
| NPossTransl Number | NPossIllat Number | NPossTransl Number | NPossIllat Number
| NCompound ; -- special compound form, e.g. "nais" | NCompound ; -- special compound form, e.g. "nais"
--- These cases are possible for subjects.
SubjCase = SCNom | SCGen | SCPart | SCElat | SCAdess | SCAblat ;
oper
appSubjCase : SubjCase -> ResFin.NP -> Str = \sc,np -> np.s ! subjcase2npform sc ;
subjcase2npform : SubjCase -> NPForm = \sc -> case sc of {
SCNom => NPCase Nom ;
SCGen => NPCase Gen ;
SCPart => NPCase Part ;
SCElat => NPCase Elat ;
SCAdess => NPCase Adess ;
SCAblat => NPCase Ablat
} ;
npform2subjcase : NPForm -> SubjCase = \sc -> case sc of {
NPCase Gen => SCGen ;
NPCase Part => SCPart ;
NPCase Elat => SCElat ;
NPCase Adess => SCAdess ;
NPCase Ablat => SCAblat ;
_ => SCNom
} ;
-- Agreement of $NP$ has number*person and the polite second ("te olette valmis"). -- Agreement of $NP$ has number*person and the polite second ("te olette valmis").
param
Agr = Ag Number Person | AgPol ; Agr = Ag Number Person | AgPol ;
@@ -72,7 +97,7 @@ oper
-- have a uniform, special accusative form ("minut", etc). -- have a uniform, special accusative form ("minut", etc).
param param
NPForm = NPCase Case | NPAcc | NPSep ; -- NPSep is NP used alone, e.g. in an Utt. Equals NPCase Nom except for pro-drop NPForm = NPCase Case | NPAcc ; -- | NPSep ; -- NPSep is NP used alone, e.g. in an Utt. Equals NPCase Nom except for pro-drop
oper oper
npform2case : Number -> NPForm -> Case = \n,f -> npform2case : Number -> NPForm -> Case = \n,f ->
@@ -81,8 +106,8 @@ oper
case <<f,n> : NPForm * Number> of { case <<f,n> : NPForm * Number> of {
<NPCase c,_> => c ; <NPCase c,_> => c ;
<NPAcc,Sg> => Gen ;-- appCompl does the job <NPAcc,Sg> => Gen ;-- appCompl does the job
<NPAcc,Pl> => Nom ; <NPAcc,Pl> => Nom
<NPSep,_> => Nom ---- <NPSep,_> => Nom
} ; } ;
n2nform : NForm -> NForm = \nf -> case nf of { n2nform : NForm -> NForm = \nf -> case nf of {
@@ -142,6 +167,25 @@ param
| InfPresPartAgr -- puhuva(mme) | InfPresPartAgr -- puhuva(mme)
; ;
-- These forms appear in complements to VV and V2V.
VVType = VVInf | VVIness | VVIllat | VVPresPart ;
oper
vvtype2infform : VVType -> InfForm = \vt -> case vt of {
VVInf => Inf1 ;
VVIness => Inf3Iness ;
VVIllat => Inf3Illat ;
VVPresPart => InfPresPart
} ;
infform2vvtype : InfForm -> VVType = \vt -> case vt of {
Inf3Iness => VVIness ;
Inf3Illat => VVIllat ;
InfPresPart => VVPresPart ;
_ => VVInf
} ;
param
SType = SDecl | SQuest ; SType = SDecl | SQuest ;
--2 For $Relative$ --2 For $Relative$
@@ -168,13 +212,11 @@ param
--- ---
Compl : Type = { Compl : Type = {
s : Bool => Str ; -- perää(n) s : Str * Str * (Agr => Str) ;
c : NPForm ; -- NP Gen c : NPForm ;
isPre : Bool ; -- False postposition
h : Harmony -- hänen peräänsä
} ; } ;
appCompl : Bool -> Polarity -> Compl -> NP -> Str = \isFin,b,co,np -> appCompl : Bool -> Polarity -> Compl -> ResFin.NP -> Str = \isFin,b,co,np ->
let let
c = case co.c of { c = case co.c of {
NPAcc => case b of { NPAcc => case b of {
@@ -190,18 +232,16 @@ param
_ => co.c _ => co.c
} ; } ;
nps = np.s ! c ; nps = np.s ! c ;
cos = case c of { cos1 = co.s.p1 ;
cos2 = case c of {
NPCase Gen => case np.isPron of { NPCase Gen => case np.isPron of {
True => co.s ! True ++ BIND ++ case co.h of { True => co.s.p3 ! np.a ;
Back => possSuffix np.a ; False => co.s.p2
Front => possSuffixFront np.a
} ;
False => co.s ! False
} ; } ;
_ => co.s ! False _ => co.s.p2
} ; } ;
in in
preOrPost co.isPre cos nps ; cos1 ++ nps ++ cos2 ;
-- For $Verb$. -- For $Verb$.
@@ -268,8 +308,8 @@ oper
-- This is used for subjects of passives: therefore isFin in False. -- This is used for subjects of passives: therefore isFin in False.
subjForm : NP -> NPForm -> Polarity -> Str = \np,sc,b -> subjForm : NP -> SubjCase -> Polarity -> Str = \np,sc,b ->
appCompl False b {s = \\_ => [] ; c = sc ; isPre = True ; h = Back} np ; appCompl False b {s = <[],[],\\_ => []> ; c = subjcase2npform sc} np ;
questPart : Harmony -> Str = \b -> case b of {Back => "ko" ; _ => "kö"} ; questPart : Harmony -> Str = \b -> case b of {Back => "ko" ; _ => "kö"} ;
@@ -519,7 +559,7 @@ oper
nsa = possSuffixFront agr nsa = possSuffixFront agr
in { in {
s = table { s = table {
NPCase Nom | NPSep => itse ! NPossNom Sg ; NPCase Nom => itse ! NPossNom Sg ;
NPCase Gen | NPAcc => itse ! NPossNom Sg + nsa ; NPCase Gen | NPAcc => itse ! NPossNom Sg + nsa ;
NPCase Transl => itse ! NPossTransl Sg + nsa ; NPCase Transl => itse ! NPossTransl Sg + nsa ;
NPCase Illat => itse ! NPossIllat Sg + nsa ; NPCase Illat => itse ! NPossIllat Sg + nsa ;

View File

@@ -47,7 +47,7 @@ concrete SentenceFin of Sentence = CatFin ** open Prelude, ResFin, StemFin in {
EmbedS s = {s = etta_Conj ++ s.s} ; EmbedS s = {s = etta_Conj ++ s.s} ;
EmbedQS qs = {s = qs.s} ; EmbedQS qs = {s = qs.s} ;
EmbedVP vp = {s = infVP (NPCase Nom) Pos (agrP3 Sg) vp Inf1} ; --- case,pol,agr,infform EmbedVP vp = {s = infVP SCNom Pos (agrP3 Sg) vp Inf1} ; --- case,pol,agr,infform
UseCl t p cl = {s = t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p ! SDecl} ; UseCl t p cl = {s = t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p ! SDecl} ;
UseQCl t p cl = {s = t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p} ; UseQCl t p cl = {s = t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p} ;

View File

@@ -100,7 +100,7 @@ oper
ollaSVerbForms : SVForm => Str = verbOlla.s ; ollaSVerbForms : SVForm => Str = verbOlla.s ;
-- used in Cat -- used in Cat
SVerb1 = {s : SVForm => Str ; sc : NPForm ; h : Harmony ; p : Str} ; SVerb1 = {s : SVForm => Str ; sc : SubjCase ; h : Harmony ; p : Str} ;
sverb2verbBind : SVerb -> Verb = sverb2verb True ; sverb2verbBind : SVerb -> Verb = sverb2verb True ;
sverb2verbSep : SVerb -> Verb = sverb2verb False ; sverb2verbSep : SVerb -> Verb = sverb2verb False ;
@@ -161,12 +161,12 @@ oper
---- a hack to make VerbFin compile accurately for library (here), ---- a hack to make VerbFin compile accurately for library (here),
---- and in a simplified way for ParseFin (in stemmed/) ---- and in a simplified way for ParseFin (in stemmed/)
slashV2VNP : (SVerb1 ** {c2 : Compl ; vi : InfForm}) -> (NP ** {isNeg : Bool}) -> slashV2VNP : (SVerb1 ** {c2 : Compl ; vi : VVType}) -> (NP ** {isNeg : Bool}) ->
(VP ** {c2 : Compl}) -> (VP ** {c2 : Compl}) (VP ** {c2 : Compl}) -> (VP ** {c2 : Compl})
= \v, np, vp -> = \v, np, vp ->
insertObjPre np.isNeg insertObjPre np.isNeg
(\fin,b,a -> appCompl fin b v.c2 np ++ (\fin,b,a -> appCompl fin b v.c2 np ++
infVP v.sc b a vp v.vi) infVP v.sc b a vp (vvtype2infform v.vi))
(predSV v) ** {c2 = vp.c2} ; (predSV v) ** {c2 = vp.c2} ;
@@ -182,7 +182,7 @@ oper
defaultVPTyp = {isNeg = False ; isPass = False} ; defaultVPTyp = {isNeg = False ; isPass = False} ;
HVerb : Type = Verb ** {sc : NPForm ; h : Harmony ; p : Str} ; HVerb : Type = Verb ** {sc : SubjCase ; h : Harmony ; p : Str} ;
predV : HVerb -> VP = \verb -> { predV : HVerb -> VP = \verb -> {
s = verb ; s = verb ;
@@ -197,7 +197,7 @@ oper
s2 : Bool => Polarity => Agr => Str ; -- talo/talon/taloa s2 : Bool => Polarity => Agr => Str ; -- talo/talon/taloa
adv : Polarity => Str ; -- ainakin/ainakaan adv : Polarity => Str ; -- ainakin/ainakaan
ext : Str ; ext : Str ;
sc : NPForm ; sc : SubjCase ;
isNeg : Bool ; -- True if some complement is negative isNeg : Bool ; -- True if some complement is negative
h : Harmony h : Harmony
} ; } ;
@@ -316,8 +316,8 @@ oper
} ; } ;
passVP : VP -> Compl -> VP = \vp,pr -> { passVP : VP -> Compl -> VP = \vp,pr -> {
s = {s = vp.s.s ; h = vp.s.h ; p = vp.s.p ; sc = pr.c} ; -- minusta pidetään ---- TODO minun katsotaan päälle s = {s = vp.s.s ; h = vp.s.h ; p = vp.s.p ; sc = npform2subjcase pr.c} ; -- minusta pidetään ---- TODO minun katsotaan päälle
s2 = \\b,p,a => pr.s ! False ++ vp.s2 ! b ! p ! a ; ---- prep after verb s2 = \\b,p,a => pr.s.p1 ++ vp.s2 ! b ! p ! a ++ pr.s.p2 ; ---- possessive suffix
ext = vp.ext ; ext = vp.ext ;
adv = vp.adv ; adv = vp.adv ;
vptyp = {isNeg = vp.vptyp.isNeg ; isPass = True} ; vptyp = {isNeg = vp.vptyp.isNeg ; isPass = True} ;
@@ -362,7 +362,7 @@ oper
s = \\t,a,b => s = \\t,a,b =>
let let
agrfin = case vp.sc of { agrfin = case vp.sc of {
NPCase Nom => <agr,True> ; SCNom => <agr,True> ;
_ => <agrP3 Sg,False> -- minun täytyy, minulla on _ => <agrP3 Sg,False> -- minun täytyy, minulla on
} ; } ;
verb = vp.s ! VIFin t ! a ! b ! agrfin.p1 ; verb = vp.s ! VIFin t ! a ! b ! agrfin.p1 ;
@@ -387,17 +387,17 @@ oper
-- the first Polarity is VP-internal, the second comes form the main verb: -- the first Polarity is VP-internal, the second comes form the main verb:
-- ([main] tahdon | en tahdo) ([internal] nukkua | olla nukkumatta) -- ([main] tahdon | en tahdo) ([internal] nukkua | olla nukkumatta)
infVPGen : Polarity -> NPForm -> Polarity -> Agr -> VP -> InfForm -> Str = infVPGen : Polarity -> SubjCase -> Polarity -> Agr -> VP -> InfForm -> Str =
\ipol,sc,pol,agr,vp0,vi -> \ipol,sc,pol,agr,vp0,vi ->
let let
vp = vp2old_vp vp0 ; vp = vp2old_vp vp0 ;
fin = case sc of { -- subject case fin = case sc of { -- subject case
NPCase Nom => True ; -- minä tahdon nähdä auton SCNom => True ; -- minä tahdon nähdä auton
_ => False -- minun täytyy nähdä auto _ => False -- minun täytyy nähdä auto
} ; } ;
verb = case ipol of { verb = case ipol of {
Pos => <vp.s ! VIInf vi ! Simul ! Pos ! agr, []> ; -- nähdä/näkemään Pos => <vp.s ! VIInf vi ! Simul ! Pos ! agr, []> ; -- nähdä/näkemään
Neg => <(vp2old_vp (predV (verbOlla ** {sc = NPCase Nom ; h = Back ; p = []}))).s ! VIInf vi ! Simul ! Pos ! agr, Neg => <(vp2old_vp (predV (verbOlla ** {sc = SCNom ; h = Back ; p = []}))).s ! VIInf vi ! Simul ! Pos ! agr,
(vp.s ! VIInf Inf3Abess ! Simul ! Pos ! agr).fin> -- olla/olemaan näkemättä (vp.s ! VIInf Inf3Abess ! Simul ! Pos ! agr).fin> -- olla/olemaan näkemättä
} ; } ;
vph = vp.h ; vph = vp.h ;
@@ -409,8 +409,8 @@ oper
in in
verb.p1.fin ++ verb.p1.inf ++ poss ++ verb.p2 ++ compl ; verb.p1.fin ++ verb.p1.inf ++ poss ++ verb.p2 ++ compl ;
infVP : NPForm -> Polarity -> Agr -> VP -> InfForm -> Str = infVPGen Pos ; infVP : SubjCase -> Polarity -> Agr -> VP -> InfForm -> Str = infVPGen Pos ;
vpVerbOlla : HVerb = verbOlla ** {sc = NPCase Nom ; h = Back ; p = []} ; vpVerbOlla : HVerb = verbOlla ** {sc = SCNom ; h = Back ; p = []} ;
} }

View File

@@ -19,10 +19,10 @@ concrete VerbFin of Verb = CatFin ** open Prelude, ResFin, StemFin in {
ComplVV v vp = ComplVV v vp =
insertObj insertObj
(\\_,b,a => infVP v.sc b a vp v.vi) (\\_,b,a => infVP v.sc b a vp (vvtype2infform v.vi))
(predSV {s = v.s ; (predSV {s = v.s ;
sc = case vp.s.sc of { sc = case vp.s.sc of {
NPCase Nom => v.sc ; -- minun täytyy pestä auto SCNom => v.sc ; -- minun täytyy pestä auto
c => c -- minulla täytyy olla auto c => c -- minulla täytyy olla auto
} ; } ;
h = v.h ; p = v.p h = v.h ; p = v.p
@@ -43,7 +43,7 @@ concrete VerbFin of Verb = CatFin ** open Prelude, ResFin, StemFin in {
SlashV2Q v q = SlashV2Q v q =
insertExtrapos ("," ++ q.s) (predSV v) ** {c2 = v.c2} ; insertExtrapos ("," ++ q.s) (predSV v) ** {c2 = v.c2} ;
SlashV2V v vp = SlashV2V v vp =
insertObj (\\_,b,a => infVP v.sc b a vp v.vi) (predSV v) ** {c2 = v.c2} ; insertObj (\\_,b,a => infVP v.sc b a vp (vvtype2infform v.vi)) (predSV v) ** {c2 = v.c2} ;
SlashV2A v ap = SlashV2A v ap =
insertObj insertObj
(\\fin,b,_ => (\\fin,b,_ =>
@@ -59,7 +59,7 @@ concrete VerbFin of Verb = CatFin ** open Prelude, ResFin, StemFin in {
SlashVV v vp = { SlashVV v vp = {
s = v ; s = v ;
s2 = \\_,b,a => infVP v.sc b a vp v.vi ; s2 = \\_,b,a => infVP v.sc b a vp (vvtype2infform v.vi) ;
adv = \\_ => v.p ; adv = \\_ => v.p ;
vptyp = vp.vptyp ; vptyp = vp.vptyp ;
ext = [] ; ext = [] ;

View File

@@ -183,7 +183,7 @@ oper
ollaSVerbForms : SVForm => Str = table SVForm ["oll";"ole";"on";"o";"olk";"olla";"oli";"oli";"olisi";"oll";"olt";"ollu";"liene";"ole"] ; ollaSVerbForms : SVForm => Str = table SVForm ["oll";"ole";"on";"o";"olk";"olla";"oli";"oli";"olisi";"oll";"olt";"ollu";"liene";"ole"] ;
-- used in Cat -- used in Cat
SVerb1 = {s : SVForm => Str ; sc : NPForm ; h : Harmony ; p : Str} ; SVerb1 = {s : SVForm => Str ; sc : SubjCase ; h : Harmony ; p : Str} ;
sverb2verbBind : SVerb -> Verb = sverb2verb True ; sverb2verbBind : SVerb -> Verb = sverb2verb True ;
sverb2verbSep : SVerb -> Verb = sverb2verb False ; sverb2verbSep : SVerb -> Verb = sverb2verb False ;
@@ -412,7 +412,7 @@ oper
AgentPart AAdv => plus tulema "sti" AgentPart AAdv => plus tulema "sti"
} ; } ;
sc = NPCase Nom ; sc = SCNom ;
lock_V = <> lock_V = <>
} ; } ;
@@ -506,11 +506,11 @@ oper
---- a hack to make VerbFin compile accurately for library (in ../), ---- a hack to make VerbFin compile accurately for library (in ../),
---- and in a simplified way for ParseFin (here) ---- and in a simplified way for ParseFin (here)
slashV2VNP : (SVerb1 ** {c2 : Compl ; vi : InfForm}) -> (NP ** {isNeg : Bool}) -> slashV2VNP : (SVerb1 ** {c2 : Compl ; vi : VVType}) -> (NP ** {isNeg : Bool}) ->
(VP ** {c2 : Compl}) -> (VP ** {c2 : Compl}) = (VP ** {c2 : Compl}) -> (VP ** {c2 : Compl}) =
\v, np, vp -> { \v, np, vp -> {
s = v ; s = v ;
s2 = \\fin,b,a => np.s ! v.c2.c ++ vp.c2.s ! False ++ v.s ! SVInf ; s2 = \\fin,b,a => appCompl fin b v.c2 np ++ v.s ! SVInf ;
---- infVP v.sc b a vp v.vi ; ---- infVP v.sc b a vp v.vi ;
-- ignoring Acc variation and pre/postposition and proper inf form -- ignoring Acc variation and pre/postposition and proper inf form
ext = [] ; ext = [] ;
@@ -546,7 +546,7 @@ oper
s2 : Bool => Polarity => Agr => Str ; -- talo/talon/taloa s2 : Bool => Polarity => Agr => Str ; -- talo/talon/taloa
adv : Polarity => Str ; -- ainakin/ainakaan adv : Polarity => Str ; -- ainakin/ainakaan
ext : Str ; ext : Str ;
sc : NPForm ; sc : SubjCase ;
isNeg : Bool ; -- True if some complement is negative isNeg : Bool ; -- True if some complement is negative
h : Harmony h : Harmony
} ; } ;
@@ -666,8 +666,8 @@ oper
} ; } ;
passVP : VP -> Compl -> VP = \vp,pr -> { passVP : VP -> Compl -> VP = \vp,pr -> {
s = {s = vp.s.s ; h = vp.s.h ; p = vp.s.p ; sc = pr.c} ; -- minusta pidetään s = {s = vp.s.s ; h = vp.s.h ; p = vp.s.p ; sc = npform2subjcase pr.c} ; -- minusta pidetään
s2 = \\b,p,a => pr.s ! False ++ vp.s2 ! b ! p ! a ; ---- prep after verb ---- TODO minun päälleni katsotaan s2 = \\b,p,a => pr.s.p1 ++ vp.s2 ! b ! p ! a ++ pr.s.p2 ; ---- possessive suffix
ext = vp.ext ; ext = vp.ext ;
adv = vp.adv ; adv = vp.adv ;
vptyp = {isNeg = vp.vptyp.isNeg ; isPass = True} ; vptyp = {isNeg = vp.vptyp.isNeg ; isPass = True} ;
@@ -712,9 +712,9 @@ oper
s = \\t,a,b => s = \\t,a,b =>
let let
agrfin = case vp.sc of { agrfin = case vp.sc of {
NPCase Nom => <agr,True> ; SCNom => <agr,True> ;
_ => <agrP3 Sg,False> -- minun täytyy, minulla on _ => <agrP3 Sg,False> -- minun täytyy, minulla on
} ; } ;
verb = vp.s ! VIFin t ! a ! b ! agrfin.p1 ; verb = vp.s ! VIFin t ! a ! b ! agrfin.p1 ;
in {subj = sub b ; in {subj = sub b ;
fin = verb.fin ; fin = verb.fin ;
@@ -737,12 +737,12 @@ oper
-- the first Polarity is VP-internal, the second comes form the main verb: -- the first Polarity is VP-internal, the second comes form the main verb:
-- ([main] tahdon | en tahdo) ([internal] nukkua | olla nukkumatta) -- ([main] tahdon | en tahdo) ([internal] nukkua | olla nukkumatta)
infVPGen : Polarity -> NPForm -> Polarity -> Agr -> VP -> InfForm -> Str = infVPGen : Polarity -> SubjCase -> Polarity -> Agr -> VP -> InfForm -> Str =
\ipol,sc,pol,agr,vp0,vi -> \ipol,sc,pol,agr,vp0,vi ->
let let
vp = vp2old_vp vp0 ; vp = vp2old_vp vp0 ;
fin = case sc of { -- subject case fin = case sc of { -- subject case
NPCase Nom => True ; -- minä tahdon nähdä auton SCNom => True ; -- minä tahdon nähdä auton
_ => False -- minun täytyy nähdä auto _ => False -- minun täytyy nähdä auto
} ; } ;
verb = case ipol of { verb = case ipol of {
@@ -759,10 +759,10 @@ oper
in in
verb.p1.fin ++ verb.p1.inf ++ poss ++ verb.p2 ++ compl ; verb.p1.fin ++ verb.p1.inf ++ poss ++ verb.p2 ++ compl ;
infVP : NPForm -> Polarity -> Agr -> VP -> InfForm -> Str = infVPGen Pos ; infVP : SubjCase -> Polarity -> Agr -> VP -> InfForm -> Str = infVPGen Pos ;
vpVerbOlla : SVerb1 = { vpVerbOlla : SVerb1 = {
s = ollaSVerbForms ; s = ollaSVerbForms ;
sc = NPCase Nom ; h = Back ; lock_V = <> ; p = [] sc = SCNom ; h = Back ; lock_V = <> ; p = []
} ; } ;
} }