mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 03:32:51 -06:00
initial version, only nouns
This commit is contained in:
@@ -1,19 +1,20 @@
|
|||||||
-- opers implementing the API of stem-based morphology in finnish/stemmed for tagged Finnish
|
-- opers implementing the API of stem-based morphology in finnish/tagged for tagged Finnish
|
||||||
|
|
||||||
resource StemFin = open TagFin, MorphoFin, Prelude in {
|
resource StemFin = open TagFin, MorphoFin, Prelude in {
|
||||||
|
|
||||||
flags coding = utf8 ;
|
flags coding = utf8 ;
|
||||||
|
|
||||||
oper
|
oper
|
||||||
SNForm : Type = {} ;
|
SNForm : Type = Predef.Ints 0 ;
|
||||||
SNoun : Type = {s : Str} ;
|
SNoun : Type = {s : SNForm => Str ; h : Harmony } ;
|
||||||
|
|
||||||
nforms2snoun : NForms -> SNoun = \nfs => {s = nfs ! 0} ;
|
nforms2snoun : NForms -> SNoun = \nfs -> {s = nfs ; h = Back} ;
|
||||||
|
|
||||||
snoun2nounBind : SNoun -> Noun = snoun2noun True ;
|
snoun2nounBind : SNoun -> Noun = snoun2noun True ;
|
||||||
snoun2nounSep : SNoun -> Noun = snoun2noun False ;
|
snoun2nounSep : SNoun -> Noun = snoun2noun False ;
|
||||||
|
|
||||||
snoun2noun : Bool -> SNoun -> Noun = \b,sn -> {s = \\nf => sn.s ++ mkTag "N" + tagNForm nf ; h = Back} ;
|
snoun2noun : Bool -> SNoun -> Noun = \b,sn -> {s = \\nf => sn.s ! 0++ mkTag "N" + tagNForm nf ; h = Back} ;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
snoun2np : Number -> SPN -> NPForm => Str = \n,sn ->
|
snoun2np : Number -> SPN -> NPForm => Str = \n,sn ->
|
||||||
@@ -32,14 +33,11 @@ oper
|
|||||||
|
|
||||||
SPN : Type = {s : Case => Str} ;
|
SPN : Type = {s : Case => Str} ;
|
||||||
|
|
||||||
snoun2spn : SNoun -> SPN = \n -> {s = \\c => n.s ! NCase Sg c} ;
|
snoun2spn : SNoun -> SPN = \n -> {s = \\c => n.s ! 0 ++ tagCase c} ;
|
||||||
|
|
||||||
exceptNomSNoun : SNoun -> Str -> SNoun = \noun,nom -> {
|
exceptNomSNoun : SNoun -> Str -> SNoun = \noun,nom -> {
|
||||||
s = table {
|
s = \\_ => nom ;
|
||||||
NCase Sg Nom => nom ;
|
h = noun.h
|
||||||
f => noun.s ! f
|
|
||||||
} ;
|
|
||||||
h = noun.h
|
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
|
|
||||||
@@ -56,40 +54,40 @@ oper
|
|||||||
|
|
||||||
snoun2sadjComp : Bool -> SNoun -> SAdj = \isPos,tuore ->
|
snoun2sadjComp : Bool -> SNoun -> SAdj = \isPos,tuore ->
|
||||||
let
|
let
|
||||||
tuoree = init (tuore.s ! NCase Sg Gen) ;
|
tuoree = init (tuore.s ! 0) ;
|
||||||
tuoreesti = tuoree + "sti" ;
|
tuoreesti = tuoree + "sti" ;
|
||||||
tuoreemmin = init tuoree ;
|
tuoreemmin = init tuoree ;
|
||||||
in {s = table {
|
in {s = table {
|
||||||
AN f => tuore.s ! f ;
|
AN f => tuoree ;
|
||||||
AAdv => if_then_Str isPos tuoreesti tuoreemmin
|
AAdv => if_then_Str isPos tuoreesti tuoreemmin
|
||||||
} ;
|
} ;
|
||||||
h = tuore.h
|
h = Back
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
sAN : SNForm -> SAForm = \n -> AN n ; ---- without eta exp gives internal error 6/8/2013
|
sAN : SNForm -> SAForm = \n -> AN (NCase Sg Nom) ; ---- without eta exp gives internal error 6/8/2013
|
||||||
sAAdv : SAForm = AAdv ;
|
sAAdv : SAForm = AAdv ;
|
||||||
sANGen : (SAForm => Str) -> Str = \a -> a ! AN (NCase Sg Gen) ;
|
sANGen : (SAForm => Str) -> Str = \a -> a ! AN (NCase Sg Gen) ;
|
||||||
|
|
||||||
mkAdj : (hyva,parempi,paras : SNoun) -> (hyvin,paremmin,parhaiten : Str) -> {s : Degree => SAForm => Str ; h : Harmony} = \h,p,ps,hn,pn,ph -> {
|
mkAdj : (hyva,parempi,paras : SNoun) -> (hyvin,paremmin,parhaiten : Str) -> {s : Degree => SAForm => Str ; h : Harmony} = \h,p,ps,hn,pn,ph -> {
|
||||||
s = table {
|
s = table {
|
||||||
Posit => table {
|
Posit => table {
|
||||||
AN nf => h.s ! nf ;
|
AN nf => h.s ! 0 ++ tagNForm nf ;
|
||||||
AAdv => hn
|
AAdv => hn
|
||||||
} ;
|
} ;
|
||||||
Compar => table {
|
Compar => table {
|
||||||
AN nf => p.s ! nf ;
|
AN nf => p.s ! 0 ++ tagNForm nf ;
|
||||||
AAdv => pn
|
AAdv => pn
|
||||||
} ;
|
} ;
|
||||||
Superl => table {
|
Superl => table {
|
||||||
AN nf => ps.s ! nf ;
|
AN nf => ps.s ! 0 ++ tagNForm nf ;
|
||||||
AAdv => ph
|
AAdv => ph
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
h = h.h
|
h = Back ---- TODO: just get rid of h ?
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
snoun2compar : SNoun -> Str = \n -> init (n.s ! NCase Sg Gen) + "mpi" ; ---- kivempi
|
snoun2compar : SNoun -> Str = \n -> n.s ! 0 + "Comp" ; ---- TODO
|
||||||
snoun2superl : SNoun -> Str = \n -> n.s ! NInstruct ; ---- kivin vs. kivoin
|
snoun2superl : SNoun -> Str = \n -> n.s ! 0 + "Superl" ; ---- TODO
|
||||||
|
|
||||||
-- verbs
|
-- verbs
|
||||||
|
|
||||||
@@ -145,15 +143,16 @@ oper
|
|||||||
-- for Symbol
|
-- for Symbol
|
||||||
|
|
||||||
addStemEnding : Str -> SPN = \i ->
|
addStemEnding : Str -> SPN = \i ->
|
||||||
{s = \\c => i ++ bindColonIfS (NCase Sg c) ++ defaultCaseEnding c} ;
|
{s = \\c => i ++ BIND ++ defaultCaseEnding c} ;
|
||||||
|
-- {s = \\c => i ++ bindColonIfS (NCase Sg c) ++ defaultCaseEnding c} ;
|
||||||
|
|
||||||
bindIfS : SNForm -> Str = \c -> case c of {
|
bindIfS : SNForm -> Str = \c -> case c of {
|
||||||
NCase Sg Nom => [] ;
|
--NCase Sg Nom => [] ;
|
||||||
_ => BIND
|
_ => BIND
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
bindColonIfS : SNForm -> Str = \c -> case c of {
|
bindColonIfS : SNForm -> Str = \c -> case c of {
|
||||||
NCase Sg Nom => [] ;
|
--NCase Sg Nom => [] ;
|
||||||
_ => BIND ++ ":" ++ BIND
|
_ => BIND ++ ":" ++ BIND
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
|
|||||||
@@ -7,8 +7,8 @@ oper
|
|||||||
|
|
||||||
tagNForm : NForm -> Str = \nf -> case nf of {
|
tagNForm : NForm -> Str = \nf -> case nf of {
|
||||||
NCase n c => tagNumber n + tagCase c ;
|
NCase n c => tagNumber n + tagCase c ;
|
||||||
NComit => tagNumber Pl + mkTag "Comit" ;
|
NComit => tagNumber Pl + mkTag "Com" ;
|
||||||
NInstruct => tagNumber Pl + mkTag "Instr" ;
|
NInstruct => tagNumber Pl + mkTag "Ins" ;
|
||||||
NPossNom n => tagNumber n + tagCase Nom ;
|
NPossNom n => tagNumber n + tagCase Nom ;
|
||||||
NPossGen n => tagNumber n + tagCase Gen ;
|
NPossGen n => tagNumber n + tagCase Gen ;
|
||||||
NPossTransl n => tagNumber n + tagCase Transl ;
|
NPossTransl n => tagNumber n + tagCase Transl ;
|
||||||
@@ -19,16 +19,16 @@ oper
|
|||||||
tagCase : Case -> Str = \c -> case c of {
|
tagCase : Case -> Str = \c -> case c of {
|
||||||
Nom => mkTag "Nom" ;
|
Nom => mkTag "Nom" ;
|
||||||
Gen => mkTag "Gen" ;
|
Gen => mkTag "Gen" ;
|
||||||
Part => mkTag "Part" ;
|
Part => mkTag "Par" ;
|
||||||
Transl => mkTag "Transl" ;
|
Transl => mkTag "Tra" ;
|
||||||
Ess => mkTag "Ess" ;
|
Ess => mkTag "Ess" ;
|
||||||
Iness => mkTag "Iness" ;
|
Iness => mkTag "Ine" ;
|
||||||
Elat => mkTag "Elat" ;
|
Elat => mkTag "Ela" ;
|
||||||
Illat => mkTag "Illat" ;
|
Illat => mkTag "Ill" ;
|
||||||
Adess => mkTag "Adess" ;
|
Adess => mkTag "Ade" ;
|
||||||
Ablat => mkTag "Ablat" ;
|
Ablat => mkTag "Abl" ;
|
||||||
Allat => mkTag "Allat" ;
|
Allat => mkTag "All" ;
|
||||||
Abess => mkTag "Abess"
|
Abess => mkTag "Abe"
|
||||||
} ;
|
} ;
|
||||||
tagNumber : Number -> Str = \n -> case n of {
|
tagNumber : Number -> Str = \n -> case n of {
|
||||||
Sg => mkTag "Sg" ;
|
Sg => mkTag "Sg" ;
|
||||||
|
|||||||
Reference in New Issue
Block a user