initial version, only nouns

This commit is contained in:
inari
2015-07-15 14:01:45 +00:00
parent 270ba6887f
commit 25fff39f79
2 changed files with 34 additions and 35 deletions

View File

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

View File

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