GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-16 00:09:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

tagged/LangFin.gf now compiles but conversion to tags is not yet complete

Browse Source
This commit is contained in:
aarne
2016-09-21 12:28:09 +00:00
parent 9a069e9c2b
commit 11978b4f29
3 changed files with 155 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
lib/src/finnish/tagged/LangFin.gf Normal file
View File

@@ -0,0 +1,12 @@
--# -path=.:..:../../abstract:../../common:../../api
concrete LangFin of Lang =
GrammarFin,
LexiconFin
, ConstructionFin
, DocumentationFin --# notpresent
** {
flags startcat = Phr ; unlexer = text ; lexer = finnish ;
} ;

96
lib/src/finnish/tagged/StemFin.gf
View File

@@ -5,15 +5,20 @@ resource StemFin = open TagFin, MorphoFin, Prelude in {
flags coding = utf8 ;
oper
SNForm : Type = Predef.Ints 0 ;
SNoun : Type = {s : SNForm => Str ; h : Harmony } ;
SNForm : Type = Predef.Ints 0 ; --- not really needed
SNoun : Type = {s : SNForm => Str ; h : Harmony} ; --- Harmony needed only for API compatibility
nforms2snoun : NForms -> SNoun = \nfs -> {s = nfs ; h = Back} ;
mkSNoun : Str -> SNoun = \s -> {s = \\_ => s ; h = Back} ; --- Harmony not used
nforms2snoun : NForms -> SNoun = \nfs -> mkSNoun (nfs ! 0) ;
snoun2nounBind : SNoun -> Noun = snoun2noun True ;
snoun2nounSep : SNoun -> Noun = snoun2noun False ;
snoun2noun : Bool -> SNoun -> Noun = \b,sn -> {s = \\nf => sn.s ! 0++ mkTag "N" + tagNForm nf ; h = Back} ;
snoun2noun : Bool -> SNoun -> Noun = \b,sn -> {
s = \\nf => tagWord (nounTag ++ tagNForm nf) (sn.s ! 0) ;
h = sn.h --- not used
} ;
@@ -35,78 +40,54 @@ oper
snoun2spn : SNoun -> SPN = \n -> {s = \\c => n.s ! 0 ++ tagCase c} ;
exceptNomSNoun : SNoun -> Str -> SNoun = \noun,nom -> {
s = \\_ => nom ;
h = noun.h
} ;
exceptNomSNoun : SNoun -> Str -> SNoun = \noun,nom -> mkSNoun nom ;
-- Adjectives --- could be made more compact by pressing comparison forms down to a few
oper
SAForm : Type = AForm ;
oper
SAdj = {s : SAForm => Str ; h : Harmony} ;
SAForm : Type = SNForm ;
SAdj : Type = SNoun ;
snoun2sadj : SNoun -> SAdj = snoun2sadjComp True ;
snoun2sadjComp : Bool -> SNoun -> SAdj = \isPos,tuore ->
let
tuoree = init (tuore.s ! 0) ;
tuoreesti = tuoree + "sti" ;
tuoreemmin = init tuoree ;
in {s = table {
AN f => tuoree ;
AAdv => if_then_Str isPos tuoreesti tuoreemmin
} ;
h = Back
} ;
snoun2sadjComp : Bool -> SNoun -> SAdj = \_,tuore -> tuore ;
sAN : SNForm -> SAForm = \n -> AN (NCase Sg Nom) ; ---- without eta exp gives internal error 6/8/2013
sAAdv : SAForm = AAdv ;
sANGen : (SAForm => Str) -> Str = \a -> a ! AN (NCase Sg Gen) ;
sAN : SNForm -> SAForm = \n -> n ;
sAAdv : SAForm = 0 ;
sANGen : (SAForm => Str) -> Str = \a -> a ! 0 ;
mkAdj : (hyva,parempi,paras : SNoun) -> (hyvin,paremmin,parhaiten : Str) -> {s : Degree => SAForm => Str ; h : Harmony} = \h,p,ps,hn,pn,ph -> {
s = table {
Posit => table {
AN nf => h.s ! 0 ++ tagNForm nf ;
AAdv => hn
} ;
Compar => table {
AN nf => p.s ! 0 ++ tagNForm nf ;
AAdv => pn
} ;
Superl => table {
AN nf => ps.s ! 0 ++ tagNForm nf ;
AAdv => ph
}
} ;
h = Back ---- TODO: just get rid of h ?
s = \\degr,aform => tagWord (adjectiveTag ++ tagDegree degr) (h.s ! 0) ; ---- where is AForm added?
h = h.h --- not needed
} ;
snoun2compar : SNoun -> Str = \n -> n.s ! 0 + "Comp" ; ---- TODO
snoun2superl : SNoun -> Str = \n -> n.s ! 0 + "Superl" ; ---- TODO
---- where are these needed?
snoun2compar : SNoun -> Str = \n -> n.s ! 0 ++ "?Comp" ; ---- TODO
snoun2superl : SNoun -> Str = \n -> n.s ! 0 ++ "?Superl" ; ---- TODO
-- verbs
oper
SVForm : Type = VForm ;
SVerb : Type = {s : SVForm => Str ; h : Harmony} ;
SVForm : Type = SNForm ;
SVerb : Type = SNoun ;
ollaSVerbForms : SVForm => Str = verbOlla.s ;
mkSVerb = mkSNoun ;
ollaSVerbForms : SVForm => Str = \\_ => "olla" ;
-- used in Cat
SVerb1 = {s : SVForm => Str ; sc : SubjCase ; h : Harmony ; p : Str} ;
SVerb1 = SVerb ** {sc : SubjCase ; p : Str} ;
sverb2verbBind : SVerb -> Verb = sverb2verb True ;
sverb2verbSep : SVerb -> Verb = sverb2verb False ;
vforms2sverb : VForms -> SVerb = \v ->
{s = (vforms2V v).s ; h = case (last (v ! 0)) of {"a" => Back ; _ => Front}} ;
vforms2sverb : VForms -> SVerb = \v -> mkSVerb (v ! 0) ;
sverb2verb : Bool -> SVerb -> Verb = \b,sverb -> {s = sverb.s} ;
sverb2verb : Bool -> SVerb -> Verb = \b,sverb -> {
s = \\vf => tagWord (verbTag ++ tagVForm vf) (sverb.s ! 0)
} ;
predSV : SVerb1 -> VP = \sv ->
predV sv ;
@@ -114,8 +95,9 @@ oper
-- word formation functions
sverb2snoun : SVerb1 -> SNoun = \v -> -- syöminen
let tekem = Predef.tk 4 (v.s ! Inf Inf3Iness) in
let tekem = Predef.tk 4 ((sverb2verb True v).s ! Inf Inf3Iness) in
nforms2snoun (dNainen (tekem + "inen")) ;
{-
@@ -181,11 +163,11 @@ oper
defaultVPTyp = {isNeg = False ; isPass = False} ;
HVerb : Type = Verb ** {sc : SubjCase ; h : Harmony ; p : Str} ;
HVerb : Type = SVerb1 ;
predV : HVerb -> VP = \verb -> {
s = verb ;
s2 = \\_,_,_ => [] ;
s = verb ;
s2 = \\_,_,_ => [] ;
adv = \\_ => verb.p ; -- the particle of the verb
ext = [] ;
vptyp = defaultVPTyp ;
@@ -203,7 +185,7 @@ oper
vp2old_vp : VP -> old_VP = \vp ->
let
verb = vp.s ;
verb = vp.s ** sverb2verb True vp.s ;
sverb : VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} = \\vi,ant,b,agr0 =>
let
agr = verbAgr agr0 ;
@@ -396,7 +378,7 @@ oper
} ;
verb = case ipol of {
Pos => <vp.s ! VIInf vi ! Simul ! Pos ! agr, []> ; -- nähdä/näkemään
Neg => <(vp2old_vp (predV (verbOlla ** {sc = SCNom ; h = Back ; p = []}))).s ! VIInf vi ! Simul ! Pos ! agr,
Neg => <(vp2old_vp (predV vpVerbOlla)).s ! VIInf vi ! Simul ! Pos ! agr,
(vp.s ! VIInf Inf3Abess ! Simul ! Pos ! agr).fin> -- olla/olemaan näkemättä
} ;
vph = vp.h ;
@@ -410,6 +392,6 @@ oper
infVP : SubjCase -> Polarity -> Agr -> VP -> InfForm -> Str = infVPGen Pos ;
vpVerbOlla : HVerb = verbOlla ** {sc = SCNom ; h = Back ; p = []} ;
vpVerbOlla : HVerb = {s = \\_ => "olla" ; sc = SCNom ; h = Back ; p = []} ;
}

115
lib/src/finnish/tagged/TagFin.gf
View File

@@ -3,20 +3,94 @@ resource TagFin = open ResFin, Prelude in {
oper
Tag : Type = Str ;
mkTag : Str -> Tag = \t -> "+" + t ;
tagWord : Tag -> Str -> Str = \tag,lemma -> "[" ++ lemma ++ tag ++ "]" ;
mkTag = overload {
mkTag : Str -> Tag = \t -> "+" + t ;
mkTag : Str -> Str -> Tag = \t,v -> t ++ "=" + v ;
} ;
tagNForm : NForm -> Str = \nf -> case nf of {
NCase n c => tagNumber n + tagCase c ;
NComit => tagNumber Pl + mkTag "Com" ;
NInstruct => tagNumber Pl + mkTag "Ins" ;
NPossNom n => tagNumber n + tagCase Nom ;
NPossGen n => tagNumber n + tagCase Gen ;
NPossTransl n => tagNumber n + tagCase Transl ;
NPossIllat n => tagNumber n + tagCase Illat ;
NCompound => mkTag "Comp"
NCase n c => tagNumber n ++ tagCase c ;
NComit => tagNumber Pl ++ mkTag "Com" ;
NInstruct => tagNumber Pl ++ mkTag "Ins" ;
NPossNom n => tagNumber n ++ tagCase Nom ;
NPossGen n => tagNumber n ++ tagCase Gen ;
NPossTransl n => tagNumber n ++ tagCase Transl ;
NPossIllat n => tagNumber n ++ tagCase Illat ;
NCompound => mkTag "Comp"
} ;
tagCase : Case -> Str = \c -> case c of {
tagAForm : AForm -> Str = \af -> case af of {
AN nf => tagNForm nf ;
AAdv => mkTag "Adv"
} ;
tagVForm : VForm -> Str = \vf -> case vf of {
Inf infform => tagInfForm infform ;
Presn num pers => activeTag ++ presentTag ++ tagNumber num ++ tagPerson pers ;
Impf num pers => activeTag ++ imperfectTag ++ tagNumber num ++ tagPerson pers ;
Condit num pers => activeTag ++ conditionalTag ++ tagNumber num ++ tagPerson pers ;
Potent num pers => activeTag ++ potentialTag ++ tagNumber num ++ tagPerson pers ;
PotentNeg => activeTag ++ potentialTag ++ negativeTag ;
Imper num => activeTag ++ imperativeTag ++ tagNumber num ++ tagPerson P2 ;
ImperP3 num => activeTag ++ imperativeTag ++ tagNumber num ++ tagPerson P3 ;
ImperP1Pl => activeTag ++ imperativeTag ++ tagNumber Pl ++ tagPerson P1 ;
ImpNegPl => activeTag ++ imperativeTag ++ negativeTag ++ tagNumber Pl ;
PassPresn bool => passiveTag ++ presentTag ++ tagBool bool ;
PassImpf bool => passiveTag ++ presentTag ++ tagBool bool ;
PassCondit bool => passiveTag ++ imperfectTag ++ tagBool bool ;
PassPotent bool => passiveTag ++ potentialTag ++ tagBool bool ;
PassImper bool => passiveTag ++ imperativeTag ++ tagBool bool ;
PastPartAct af => participleTag ++ activeTag ++ pastTag ++ tagAForm af ;
PastPartPass af => participleTag ++ activeTag ++ pastTag ++ tagAForm af ;
PresPartAct af => participleTag ++ activeTag ++ presentTag ++ tagAForm af ;
PresPartPass af => participleTag ++ activeTag ++ presentTag ++ tagAForm af ;
AgentPart af => participleTag ++ agentTag ++ tagAForm af
} ;
tagInfForm : InfForm -> Str = \vf -> case vf of {
Inf1 => infinitiveTag ;
Inf1Long => infinitiveTag ;
Inf2Iness => infinitiveTag ;
Inf2Instr => infinitiveTag ;
Inf2InessPass => infinitiveTag ;
Inf3Iness => infinitiveTag ;
Inf3Elat => infinitiveTag ;
Inf3Illat => infinitiveTag ;
Inf3Adess => infinitiveTag ;
Inf3Abess => infinitiveTag ;
Inf3Instr => infinitiveTag ;
Inf3InstrPass => infinitiveTag ;
Inf4Nom => infinitiveTag ;
Inf4Part => infinitiveTag ;
Inf5 => infinitiveTag ;
InfPresPart => infinitiveTag ;
InfPresPartAgr => infinitiveTag
} ;
nounTag = mkTag "N" ;
adjectiveTag = mkTag "A" ;
verbTag = mkTag "V" ;
activeTag = mkTag "Act" ;
passiveTag = mkTag "Pass" ;
imperativeTag = mkTag "Imp" ;
participleTag = mkTag "Part" ;
agentTag = mkTag "Agent" ;
infinitiveTag = mkTag "Inf" ;
negativeTag = mkTag "Neg" ;
presentTag = mkTag "Pres" ;
imperfectTag = mkTag "Impf" ;
conditionalTag = mkTag "Cond" ;
potentialTag = mkTag "Pot" ;
pastTag = mkTag "Past" ; -- for participles
tagCase : Case -> Tag = \c -> case c of {
Nom => mkTag "Nom" ;
Gen => mkTag "Gen" ;
Part => mkTag "Par" ;
@@ -30,8 +104,27 @@ oper
Allat => mkTag "All" ;
Abess => mkTag "Abe"
} ;
tagNumber : Number -> Str = \n -> case n of {
tagNumber : Number -> Tag = \n -> case n of {
Sg => mkTag "Sg" ;
Pl => mkTag "Pl"
} ;
tagDegree : Degree -> Tag = \n -> case n of {
Posit => mkTag "Pos" ;
Compar => mkTag "Com" ;
Superl => mkTag "Sup"
} ;
tagPerson : Person -> Tag = \p -> case p of {
P1 => mkTag "Person1" ;
P2 => mkTag "Person2" ;
P3 => mkTag "Person3"
} ;
tagBool : Bool -> Tag = \b -> case b of {
True => "Pos" ;
False => "Neg"
} ;
}