forked from GitHub/gf-core
resources and new instantiation syntax
This commit is contained in:
aarne
@@ -26,7 +26,7 @@ abstract Basic = Categories ** {
|
||||
bread_N : N ;
|
||||
break_V2 : V2 ;
|
||||
broad_ADeg : ADeg ;
|
||||
brother_N : N ;
|
||||
brother_N2 : N2 ;
|
||||
brown_ADeg : ADeg ;
|
||||
butter_N : N ;
|
||||
buy_V2 : V2 ;
|
||||
@@ -61,7 +61,7 @@ abstract Basic = Categories ** {
|
||||
eat_V2 : V2 ;
|
||||
enemy_N : N ;
|
||||
factory_N : N ;
|
||||
father_N : N ;
|
||||
father_N2 : N2 ;
|
||||
fear_VS : VS ;
|
||||
find_V2 : V2 ;
|
||||
fish_N : N ;
|
||||
@@ -110,7 +110,7 @@ abstract Basic = Categories ** {
|
||||
meat_N : N ;
|
||||
milk_N : N ;
|
||||
moon_N : N ;
|
||||
mother_N : N ;
|
||||
mother_N2 : N2 ;
|
||||
mountain_N : N ;
|
||||
music_N : N ;
|
||||
narrow_ADeg : ADeg ;
|
||||
@@ -181,7 +181,7 @@ abstract Basic = Categories ** {
|
||||
train_N : N ;
|
||||
travel_V : V ;
|
||||
tree_N : N ;
|
||||
trousers_N : N ;
|
||||
---- trousers_N : N ;
|
||||
ugly_ADeg : ADeg ;
|
||||
understand_V2 : V2 ;
|
||||
university_N : N ;
|
||||
@@ -202,4 +202,15 @@ abstract Basic = Categories ** {
|
||||
write_V2 : V2 ;
|
||||
yellow_ADeg : ADeg ;
|
||||
young_ADeg : ADeg ;
|
||||
|
||||
do_V2 : V2 ;
|
||||
now_Adv : Adv ;
|
||||
already_Adv : Adv ;
|
||||
song_N : N ;
|
||||
add_V3 : V3 ;
|
||||
number_N : N ;
|
||||
put_V2 : V2 ;
|
||||
stop_V : V ;
|
||||
jump_V : V ;
|
||||
|
||||
}
|
||||
|
||||
@@ -56,6 +56,11 @@ fun
|
||||
QPredObjA2V : IP -> A2V -> NP ->VPI ->QCl ; -- "who is easy for us to convince"
|
||||
|
||||
|
||||
IPredV : Ant -> V -> VPI ; -- "walk"
|
||||
IPredV2 : Ant -> V2 -> NP -> VPI ; -- "see Mary"
|
||||
IPredAP : Ant -> AP -> VPI ; -- "be old"
|
||||
|
||||
|
||||
{-
|
||||
-- These rules *use* verb phrases.
|
||||
|
||||
|
||||
@@ -136,6 +136,8 @@ fun
|
||||
IntSlash : IP -> Slash -> QCl ; -- "whom does John see"
|
||||
QuestAdv : IAdv -> Cl -> QCl ; -- "why do you walk"
|
||||
|
||||
PosImpVP, NegImpVP : VPI -> Imp ; -- "(don't) be a man"
|
||||
|
||||
----rename these ??
|
||||
IndicPhrase : S -> Phr ; -- "I walk."
|
||||
QuestPhrase : QS -> Phr ; -- "Do I walk?"
|
||||
@@ -213,7 +215,6 @@ fun
|
||||
--- The type signatures of these ones should be changed from VP to VPI.
|
||||
|
||||
ProgVG : VP -> VP ; -- he is eating
|
||||
PosImperVP, NegImperVP : VP -> Imp ; -- "(don't) be a man"
|
||||
OneVP : VP -> Cl ; -- "one walks"
|
||||
|
||||
} ;
|
||||
|
||||
@@ -72,12 +72,12 @@ oper
|
||||
mkVerb : (_,_,_,_,_,_ : Str) -> Verbum =
|
||||
\spise,spiser,spises,spiste,spist,spis -> {s = table {
|
||||
VI (Inf v) => mkVoice v spise ;
|
||||
VF (Pres m Act) => spiser ;
|
||||
VF (Pres m Pass) => spises ;
|
||||
VF (Pret m v) => mkVoice v spiste ;
|
||||
VF (Pres Act) => spiser ;
|
||||
VF (Pres Pass) => spises ;
|
||||
VF (Pret v) => mkVoice v spiste ;
|
||||
VI (Supin v) => mkVoice v spist ;
|
||||
VI (PtPret c) => mkCase spist ! c ;
|
||||
VF Imper => spis
|
||||
VI (PtPret _ c) => mkCase spist ! c ; ---- GenNum
|
||||
VF (Imper v) => mkVoice v spis
|
||||
}
|
||||
} ;
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
--# -path=.:../scandinavian:../abstract:../../prelude
|
||||
|
||||
concrete RulesDan of Rules =
|
||||
concrete RulesDan of Rules = CategoriesDan **
|
||||
RulesScand with (SyntaxScand=SyntaxDan) ;
|
||||
|
||||
@@ -14,7 +14,6 @@ instance SyntaxDan of SyntaxScand = TypesDan **
|
||||
npMan : NounPhrase = nameNounPhrase (mkProperName "man" NUtr) ;
|
||||
npDet : NounPhrase = nameNounPhrase (mkProperName "det" NNeutr) ;
|
||||
|
||||
|
||||
mkAdjForm : Species -> Number -> NounGender -> AdjFormPos = \b,n,g ->
|
||||
case <b,n> of {
|
||||
<Indef,Sg> => Strong (ASg (genNoun g)) ;
|
||||
@@ -22,17 +21,6 @@ instance SyntaxDan of SyntaxScand = TypesDan **
|
||||
<Def, _> => Weak
|
||||
} ;
|
||||
|
||||
deponentVerb : Verb -> Verb = \finna -> {
|
||||
s = table {
|
||||
VF (Pres m _) => finna.s ! VF (Pres m Pass) ;
|
||||
VF (Pret m _) => finna.s ! VF (Pret m Pass) ;
|
||||
VI (Inf _) => finna.s ! VI (Inf Pass) ;
|
||||
VI (Supin _) => finna.s ! VI (Supin Pass) ;
|
||||
v => finna.s ! v --- Imper !
|
||||
} ;
|
||||
s1 = finna.s1
|
||||
} ;
|
||||
|
||||
verbFinnas : Verb =
|
||||
deponentVerb (mkVerb "finde" "finder" "findes" "fandt" "fundet" "find" ** {s1 = []}) ;
|
||||
verbVara = mkVerb "være" "er" nonExist "var" "været" "vær" ** {s1 = []} ;
|
||||
@@ -112,10 +100,6 @@ instance SyntaxDan of SyntaxScand = TypesDan **
|
||||
mkDeterminerSgGender3 : Str -> Str -> Str -> SpeciesP -> Determiner = \en,_,ett ->
|
||||
mkDeterminerSgGender (table {Utr => en ; Neutr => ett}) ;
|
||||
|
||||
adjPastPart : Verb -> Adjective = \verb -> {
|
||||
s = \\af,c => verb.s1 ++ verb.s ! VI (PtPret c) ---- af
|
||||
} ;
|
||||
|
||||
reflPron : Number -> Person -> Str = \n,p -> case <n,p> of {
|
||||
<Sg,P1> => "mig" ;
|
||||
<Sg,P2> => "dig" ;
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
--# -path=.:../scandinavian:../abstract:../../prelude
|
||||
|
||||
concrete TestResourceDan of TestResource = RulesDan, StructuralDan **
|
||||
concrete TestResourceDan of TestResource = RulesDan, ClauseDan, StructuralDan **
|
||||
open Prelude, MorphoDan, SyntaxDan in {
|
||||
|
||||
flags startcat=Phr ; lexer=text ; unlexer=text ;
|
||||
|
||||
@@ -23,14 +23,4 @@ oper
|
||||
param
|
||||
AdjFormPos = Strong GenNum | Weak ;
|
||||
|
||||
VFin =
|
||||
Pres Mode Voice
|
||||
| Pret Mode Voice
|
||||
| Imper ; --- no passive
|
||||
|
||||
VInf =
|
||||
Inf Voice
|
||||
| Supin Voice
|
||||
| PtPret Case ; ---- number and gender
|
||||
|
||||
}
|
||||
|
||||
@@ -31,7 +31,7 @@ lin
|
||||
bread_N = regN "bread" ;
|
||||
break_V2 = dirV2 (irregV "break" "broke" "broken") ;
|
||||
broad_ADeg = regADeg "broad" ;
|
||||
brother_N = regN "brother" ;
|
||||
brother_N2 = regN2 "brother" ;
|
||||
brown_ADeg = regADeg "brown" ;
|
||||
butter_N = regN "butter" ;
|
||||
buy_V2 = dirV2 (irregV "buy" "bought" "bought") ;
|
||||
@@ -66,7 +66,7 @@ lin
|
||||
eat_V2 = dirV2 (irregV "eat" "ate" "eaten") ;
|
||||
enemy_N = regN "enemy" ;
|
||||
factory_N = regN "factory" ;
|
||||
father_N = regN "father" ;
|
||||
father_N2 = regN2 "father" ;
|
||||
fear_VS = mkVS (regV "fear") ;
|
||||
find_V2 = dirV2 (irregV "find" "found" "found") ;
|
||||
fish_N = mk2N "fish" "fish" ;
|
||||
@@ -80,7 +80,7 @@ lin
|
||||
girl_N = regN "girl" ;
|
||||
glove_N = regN "glove" ;
|
||||
gold_N = regN "gold" ;
|
||||
good_ADeg = regADeg "good" ;
|
||||
good_ADeg = mkADeg "good" "better" "best" "well" ;
|
||||
go_V = (mkV "go" "goes" "went" "gone" "going") ;
|
||||
green_ADeg = regADeg "green" ;
|
||||
harbour_N = regN "harbour" ;
|
||||
@@ -93,7 +93,7 @@ lin
|
||||
horse_N = regN "horse" ;
|
||||
hot_ADeg = regADeg "hot" ;
|
||||
house_N = regN "house" ;
|
||||
important_ADeg = regADeg "important" ;
|
||||
important_ADeg = compoundADeg (regA "important") ;
|
||||
industry_N = regN "industry" ;
|
||||
iron_N = regN "iron" ;
|
||||
king_N = regN "king" ;
|
||||
@@ -115,7 +115,7 @@ lin
|
||||
meat_N = regN "meat" ;
|
||||
milk_N = regN "milk" ;
|
||||
moon_N = regN "moon" ;
|
||||
mother_N = regN "mother" ;
|
||||
mother_N2 = regN2 "mother" ;
|
||||
mountain_N = regN "mountain" ;
|
||||
music_N = regN "music" ;
|
||||
narrow_ADeg = regADeg "narrow" ;
|
||||
@@ -186,12 +186,12 @@ lin
|
||||
train_N = regN "train" ;
|
||||
travel_V = (regDuplV "travel") ;
|
||||
tree_N = regN "tree" ;
|
||||
trousers_N = regN "trousers" ;
|
||||
---- trousers_N = regN "trousers" ;
|
||||
ugly_ADeg = regADeg "ugly" ;
|
||||
understand_V2 = dirV2 (irregV "understand" "understood" "understood") ;
|
||||
university_N = regN "university" ;
|
||||
village_N = regN "village" ;
|
||||
wait_V2 = dirV2 (regV "wait") ;
|
||||
wait_V2 = mkV2 (regV "wait") "for" ;
|
||||
walk_V = (regV "walk") ;
|
||||
warm_ADeg = regADeg "warm" ;
|
||||
war_N = regN "war" ;
|
||||
@@ -207,4 +207,14 @@ lin
|
||||
write_V2 = dirV2 (irregV "write" "wrote" "written") ;
|
||||
yellow_ADeg = regADeg "yellow" ;
|
||||
young_ADeg = regADeg "young" ;
|
||||
|
||||
do_V2 = dirV2 (mkV "do" "does" "did" "done" "doing") ;
|
||||
now_Adv = mkAdv "now" ;
|
||||
already_Adv = mkAdv "already" ;
|
||||
song_N = regN "song" ;
|
||||
add_V3 = dirV3 (regV "add") "to" ;
|
||||
number_N = regN "number" ;
|
||||
put_V2 = mkV2 (irregDuplV "put" "put" "put") [] ;
|
||||
stop_V = regV "stop" ;
|
||||
jump_V = regV "jump" ;
|
||||
} ;
|
||||
|
||||
@@ -20,7 +20,8 @@ concrete ClauseEng of Clause = CategoriesEng **
|
||||
SPredV2S np v x y = predVerbGroupClause np (complDitransSentVerb v x y) ;
|
||||
SPredV2Q np v x y = predVerbGroupClause np (complDitransQuestVerb v x y) ;
|
||||
|
||||
SPredAP np v = predVerbGroupClause np (predAdjective v) ;
|
||||
SPredAP np v = predBeGroup np (\\_ => v.s ! AAdj) ;
|
||||
-- SPredAP np v = predVerbGroupClause np (predAdjective v) ;
|
||||
SPredSuperl np a = predVerbGroupClause np (predAdjective (superlAdjPhrase a)) ;
|
||||
SPredCN np v = predVerbGroupClause np (predCommNoun v) ;
|
||||
SPredNP np v = predVerbGroupClause np (predNounPhrase v) ;
|
||||
@@ -28,7 +29,6 @@ concrete ClauseEng of Clause = CategoriesEng **
|
||||
SPredAV np v x = predVerbGroupClause np (complVerbAdj v x) ;
|
||||
SPredObjA2V np v x y = predVerbGroupClause np (complVerbAdj2 True v x y) ;
|
||||
|
||||
|
||||
QPredV np v = intVerbPhrase np (predVerb v) ;
|
||||
QPredPassV np v = intVerbPhrase np (passVerb v) ;
|
||||
QPredV2 np v x = intVerbPhrase np (complTransVerb v x) ;
|
||||
@@ -53,6 +53,11 @@ concrete ClauseEng of Clause = CategoriesEng **
|
||||
QPredAV np v x = intVerbPhrase np (complVerbAdj v x) ;
|
||||
QPredObjA2V np v x y = intVerbPhrase np (complVerbAdj2 True v x y) ;
|
||||
|
||||
IPredV a v = predVerbGroupI True a (predVerb v) ;
|
||||
IPredV2 a v x = predVerbGroupI True a (complTransVerb v x) ;
|
||||
---- SPredAP np v = predBeGroup np (\\_ => v.s ! AAdj) ;
|
||||
IPredAP a v = predVerbGroupI True a (predAdjective v) ;
|
||||
|
||||
{-
|
||||
-- Use VPs
|
||||
|
||||
|
||||
@@ -142,8 +142,8 @@ lin
|
||||
IntSlash = intSlash ;
|
||||
QuestAdv = questAdverbial ;
|
||||
|
||||
PosImperVP = imperVerbPhrase True ;
|
||||
NegImperVP = imperVerbPhrase False ;
|
||||
PosImpVP = imperVerbPhrase True ;
|
||||
NegImpVP = imperVerbPhrase False ;
|
||||
|
||||
IndicPhrase = indicUtt ;
|
||||
QuestPhrase = interrogUtt ;
|
||||
|
||||
@@ -393,6 +393,22 @@ oper
|
||||
}
|
||||
in negAux b has ;
|
||||
|
||||
auxBe : Bool -> Tense -> Agr -> Str = \b,t,a ->
|
||||
let is =
|
||||
case t of {
|
||||
Present => case a of {
|
||||
ASgP3 _ => "is" ;
|
||||
ASgP1 => "am" ;
|
||||
_ => "are"
|
||||
} ;
|
||||
Past => case a of {
|
||||
ASgP3 _ => "was" ;
|
||||
_ => "were"
|
||||
} ;
|
||||
_ => "be" --- never used
|
||||
}
|
||||
in negAux b is ; ---- amn't
|
||||
|
||||
auxTense : Bool -> Tense -> Agr -> Str = \b,t,a ->
|
||||
case t of {
|
||||
Present => negAux b (case a of {
|
||||
@@ -451,6 +467,13 @@ oper
|
||||
s1 = if_then_Str b [] "not"
|
||||
} ;
|
||||
|
||||
predVerbGroupI : Bool -> {s : Str ; a : Anteriority} -> VerbGroup -> VerbPhrase =
|
||||
\b,ant,vg ->
|
||||
let vp = predVerbGroup b ant.a vg in
|
||||
{s = \\a => ant.s ++ vp.s ! a ;
|
||||
s1 = vp.s1
|
||||
} ;
|
||||
|
||||
-- A simple verb can be made into a verb phrase with an empty complement.
|
||||
-- There are two versions, depending on if we want to negate the verb.
|
||||
-- N.B. negation is *not* a function applicable to a verb phrase, since
|
||||
@@ -476,11 +499,58 @@ oper
|
||||
predAdverb : PrepPhrase -> VerbGroup = \elsewhere ->
|
||||
beGroup (\\_ => elsewhere.s) ;
|
||||
|
||||
{- --- compiles to 25k lines gfr 3/2/2005
|
||||
predAdjSent : Adjective -> Sentence -> Clause = \bra,hansover ->
|
||||
predVerbGroupClause
|
||||
(pronNounPhrase pronIt)
|
||||
(beGroup (
|
||||
\\n => bra.s ! AAdj ++ "that" ++ hansover.s)) ;
|
||||
-}
|
||||
|
||||
predAdjSent : Adjective -> Sentence -> Clause = \bra,hansover ->
|
||||
predBeGroup (pronNounPhrase pronIt) (\\n => bra.s ! AAdj ++ "that" ++ hansover.s) ;
|
||||
|
||||
predBeGroup : NounPhrase -> (Agr => Str) -> Clause = \itt,goo ->
|
||||
let
|
||||
it = itt.s ! NomP ;
|
||||
good = goo ! itt.a ;
|
||||
begood : Tense -> Str = \t -> case t of {
|
||||
Present => good ;
|
||||
Past => good ;
|
||||
_ => "be" ++ good
|
||||
} ;
|
||||
beengood : Tense -> Str = \t -> case t of {
|
||||
Future => "have" ++ "been" ++ good ;
|
||||
Conditional => "have" ++ "been" ++ good ;
|
||||
_ => "been" ++ good
|
||||
} ;
|
||||
has : Bool -> Tense -> Str = \b,t -> case t of {
|
||||
Future => if_then_Str b "will" "won't" ;
|
||||
Conditional => negAux b "would" ;
|
||||
_ => auxHave b t itt.a
|
||||
} ;
|
||||
is : Bool -> Tense -> Str = \b,t -> case t of {
|
||||
Future => if_then_Str b "will" "won't" ;
|
||||
Conditional => negAux b "would" ;
|
||||
_ => auxBe b t itt.a
|
||||
}
|
||||
in
|
||||
{s = \\o,b,sf =>
|
||||
case sf of {
|
||||
VFinite t Simul => case o of {
|
||||
Dir => it ++ is b t ++ begood t ;
|
||||
Inv => is b t ++ it ++ begood t
|
||||
} ;
|
||||
VFinite t Anter => case o of {
|
||||
Dir => it ++ has b t ++ beengood t ;
|
||||
Inv => has b t ++ it ++ beengood t
|
||||
} ;
|
||||
VInfinit Simul => it ++ begood Future ;
|
||||
VInfinit Anter => it ++ beengood Future ;
|
||||
VPresPart => it ++ "being" ++ good
|
||||
}
|
||||
} ;
|
||||
|
||||
|
||||
predAdjSent2 : AdjCompl -> NounPhrase -> Adjective = \bra,han ->
|
||||
{s = \\af => bra.s ! af ++ bra.s2 ++ han.s ! AccP} ;
|
||||
@@ -652,6 +722,7 @@ oper
|
||||
|
||||
param Order = Dir | Inv ;
|
||||
|
||||
---- compiles to 4k lines gfr. also relSlash, relVerbPhrase are bad
|
||||
oper
|
||||
predVerbGroupClause : NounPhrase -> VerbGroup -> Clause =
|
||||
\yo,dosleep -> {
|
||||
@@ -1050,10 +1121,13 @@ oper
|
||||
|
||||
Imperative = SS1 Number ;
|
||||
|
||||
imperVerbPhrase : Bool -> VerbGroup -> Imperative = \b,walk ->
|
||||
imperVerbPhrase : Bool -> VerbPhrase -> Imperative = \b,walk ->
|
||||
{s = \\n =>
|
||||
let a = toAgr n P2 human in
|
||||
walk.s ! b ! VInfinit Simul ! a ++ walk.s2 ! b ! VInfinit Simul ! a
|
||||
let
|
||||
a = toAgr n P2 human ;
|
||||
dont = if_then_Str b [] "don't"
|
||||
in
|
||||
dont ++ walk.s ! a
|
||||
} ;
|
||||
|
||||
imperUtterance : Number -> Imperative -> Utterance = \n,I ->
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
--# -path=.:../romance:../abstract:../../prelude
|
||||
|
||||
concrete RulesFre of Rules =
|
||||
concrete RulesFre of Rules = CategoriesFre **
|
||||
RulesRomance with (SyntaxRomance=SyntaxFre) ;
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
--# -path=.:../romance:../abstract:../../prelude
|
||||
--# -path=.:../romance:../oldabstract:../abstract:../../prelude
|
||||
|
||||
concrete TestResourceFre of TestResource = RulesFre, StructuralFre **
|
||||
open Prelude, TypesFre, MorphoFre, SyntaxFre in {
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
--# -path=.:../romance:../abstract:../../prelude
|
||||
|
||||
concrete RulesIta of Rules =
|
||||
concrete RulesIta of Rules = CategoriesIta **
|
||||
RulesRomance with (SyntaxRomance=SyntaxIta) ;
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
--# -path=.:../romance:../abstract:../../prelude
|
||||
--# -path=.:../romance:../oldabstract:../abstract:../../prelude
|
||||
|
||||
concrete TestResourceIta of TestResource =
|
||||
RulesIta, StructuralIta ** open Prelude, TypesIta, MorphoIta, SyntaxIta in {
|
||||
|
||||
@@ -79,12 +79,12 @@ oper
|
||||
mkVerb : (_,_,_,_,_,_ : Str) -> Verbum =
|
||||
\spise,spiser,spises,spiste,spist,spis -> {s = table {
|
||||
VI (Inf v) => mkVoice v spise ;
|
||||
VF (Pres m Act) => spiser ;
|
||||
VF (Pres m Pass) => spises ;
|
||||
VF (Pret m v) => mkVoice v spiste ;
|
||||
VF (Pres Act) => spiser ;
|
||||
VF (Pres Pass) => spises ;
|
||||
VF (Pret v) => mkVoice v spiste ;
|
||||
VI (Supin v) => mkVoice v spist ;
|
||||
VI (PtPret c) => mkCase spist ! c ;
|
||||
VF Imper => spis
|
||||
VI (PtPret _ c) => mkCase spist ! c ; ---- GenNum
|
||||
VF (Imper v) => mkVoice v spis
|
||||
}
|
||||
} ;
|
||||
|
||||
|
||||
@@ -22,17 +22,6 @@ instance SyntaxNor of SyntaxScand = TypesNor **
|
||||
<Def, _> => Weak
|
||||
} ;
|
||||
|
||||
deponentVerb : Verb -> Verb = \finna -> {
|
||||
s = table {
|
||||
VF (Pres m _) => finna.s ! VF (Pres m Pass) ;
|
||||
VF (Pret m _) => finna.s ! VF (Pret m Pass) ;
|
||||
VI (Inf _) => finna.s ! VI (Inf Pass) ;
|
||||
VI (Supin _) => finna.s ! VI (Supin Pass) ;
|
||||
v => finna.s ! v --- Imper !
|
||||
} ;
|
||||
s1 = finna.s1
|
||||
} ;
|
||||
|
||||
verbFinnas : Verb =
|
||||
deponentVerb (mkVerb "finne" "finner" "finnes" "fant" "funnet" "finn" ** {s1 = []}) ;
|
||||
verbVara = mkVerb "være" "er" nonExist "var" "vært" "vær" ** {s1 = []} ;
|
||||
@@ -112,10 +101,6 @@ instance SyntaxNor of SyntaxScand = TypesNor **
|
||||
mkDeterminerSgGender3 : Str -> Str -> Str -> SpeciesP -> Determiner = \en,ei,ett ->
|
||||
mkDeterminerSgGender (table {Utr Masc => en ; Utr NoMasc => ei ; Neutr => ett}) ;
|
||||
|
||||
adjPastPart : Verb -> Adjective = \verb -> {
|
||||
s = \\af,c => verb.s1 ++ verb.s ! VI (PtPret c) ---- af
|
||||
} ;
|
||||
|
||||
reflPron : Number -> Person -> Str = \n,p -> case <n,p> of {
|
||||
<Sg,P1> => "meg" ;
|
||||
<Sg,P2> => "deg" ;
|
||||
|
||||
@@ -25,14 +25,5 @@ oper
|
||||
param
|
||||
AdjFormPos = Strong GenNum | Weak ;
|
||||
|
||||
VFin =
|
||||
Pres Mode Voice
|
||||
| Pret Mode Voice
|
||||
| Imper ; --- no passive
|
||||
|
||||
VInf =
|
||||
Inf Voice
|
||||
| Supin Voice
|
||||
| PtPret Case ; ---- number and gender
|
||||
|
||||
}
|
||||
|
||||
@@ -35,8 +35,7 @@ lincat
|
||||
-- = {s : VerbForm => Str ; s1 : Str} ;
|
||||
VP = {s : SForm => Str ; s2 : Bool => Str ;
|
||||
s3 : SForm => Gender => Number => Person => Str} ;
|
||||
VPI = {s : Str ; s2 : Str ;
|
||||
s3 : Gender => Number => Person => Str} ;
|
||||
VPI = {s : VIForm => Gender => Number => Person => Str} ;
|
||||
V2 = TransVerb ;
|
||||
-- = Verb ** {s2 : Preposition} ;
|
||||
V3 = TransVerb ** {s3 : Preposition} ;
|
||||
|
||||
@@ -53,6 +53,11 @@ incomplete concrete ClauseScand of Clause = CategoriesScand **
|
||||
QPredAV np v x = intVerbPhrase np (complVerbAdj v x) ;
|
||||
QPredObjA2V np v x y = intVerbPhrase np (complVerbAdj2 True v x y) ;
|
||||
|
||||
IPredV a v = predVerbGroupI True a (predVerb v) ;
|
||||
IPredV2 a v x = predVerbGroupI True a (complTransVerb v x) ;
|
||||
---- SPredAP np v = predBeGroup np (\\_ => v.s ! AAdj) ;
|
||||
IPredAP a v = predVerbGroupI True a (predAdjective v) ;
|
||||
|
||||
{-
|
||||
-- Use VPs
|
||||
|
||||
|
||||
@@ -126,8 +126,8 @@ lin
|
||||
IntSlash = intSlash ;
|
||||
QuestAdv = questAdverbial ;
|
||||
|
||||
PosImperVP = imperVerbPhrase True ;
|
||||
NegImperVP = imperVerbPhrase False ;
|
||||
PosImpVP = imperVerbPhrase True ;
|
||||
NegImpVP = imperVerbPhrase False ;
|
||||
|
||||
IndicPhrase = indicUtt ;
|
||||
QuestPhrase = interrogUtt ;
|
||||
|
||||
@@ -283,8 +283,10 @@ oper
|
||||
extAdjective : Adj -> Adjective = \adj ->
|
||||
{s = table {f => table {c => adj.s ! AF (Posit f) c}}} ;
|
||||
|
||||
adjPastPart : Verb -> Adjective ;
|
||||
|
||||
adjPastPart : Verb -> Adjective = \verb -> {
|
||||
s = \\af,c => verb.s1 ++ verb.s ! VI (PtPret af c) --- på slagen
|
||||
} ;
|
||||
|
||||
|
||||
-- Coercions between the compound gen-num type and gender and number:
|
||||
|
||||
@@ -365,12 +367,12 @@ oper
|
||||
--3 Two-place adjectives
|
||||
--
|
||||
-- A two-place adjective is an adjective with a preposition used before
|
||||
-- the complement. (Rem. $Preposition = Str$).
|
||||
-- the complement.
|
||||
|
||||
AdjCompl = Adjective ** {s2 : Preposition} ;
|
||||
|
||||
complAdj : AdjCompl -> NounPhrase -> AdjPhrase = \förtjust,dig ->
|
||||
{s = \\a,c => förtjust.s ! a ! c ++ förtjust.s2 ++ dig.s ! PAcc ;
|
||||
{s = \\a,c => förtjust.s ! a ! c ++ {-strPrep-} förtjust.s2 ++ dig.s ! PAcc ;
|
||||
p = True
|
||||
} ;
|
||||
|
||||
@@ -408,6 +410,13 @@ oper
|
||||
-- preposition prefixed to its argument ("mor till x").
|
||||
-- The type is analogous to two-place adjectives and transitive verbs.
|
||||
|
||||
param ComplPrep = CPnoPrep | CPav | CPför | CPi | CPom | CPpå | CPtill ;
|
||||
|
||||
oper
|
||||
Preposition = Str ; ---- ComplPrep ; ---
|
||||
|
||||
strPrep : ComplPrep -> Str ;
|
||||
|
||||
Function = CommNoun ** {s2 : Preposition} ;
|
||||
|
||||
mkFun : CommNoun -> Preposition -> Function = \f,p ->
|
||||
@@ -425,7 +434,7 @@ oper
|
||||
noun2CommNounPhrase
|
||||
{s = \\n,b => table {
|
||||
Gen => nonExist ;
|
||||
_ => värde.s ! n ! b ! Nom ++ värde.s2 ++ x.s ! PAcc
|
||||
_ => värde.s ! n ! b ! Nom ++ {-strPrep-} värde.s2 ++ x.s ! PAcc
|
||||
} ;
|
||||
g = värde.g ;
|
||||
} ;
|
||||
@@ -454,7 +463,7 @@ oper
|
||||
-- Their application starts by filling the first place.
|
||||
|
||||
appFun2 : Function2 -> NounPhrase -> Function = \flyg, paris ->
|
||||
{s = \\n,d,c => flyg.s ! n ! d ! c ++ flyg.s2 ++ paris.s ! PAcc ;
|
||||
{s = \\n,d,c => flyg.s ! n ! d ! c ++ {-strPrep-} flyg.s2 ++ paris.s ! PAcc ;
|
||||
g = flyg.g ;
|
||||
s2 = flyg.s3
|
||||
} ;
|
||||
@@ -496,15 +505,15 @@ oper
|
||||
hasett : Voice -> Str = \v -> auxHa ++ sett v
|
||||
|
||||
in case sf of {
|
||||
VFinite Present Simul => simple (VF (Pres Ind vo)) ;
|
||||
VFinite Present Simul => simple (VF (Pres vo)) ;
|
||||
VFinite Present Anter => compound auxHar (sett vo) ;
|
||||
VFinite Past Simul => simple (VF (Pret Ind vo)) ;
|
||||
VFinite Past Simul => simple (VF (Pret vo)) ;
|
||||
VFinite Past Anter => compound auxHade (sett vo) ;
|
||||
VFinite Future Simul => compound auxSka (see vo) ;
|
||||
VFinite Future Anter => compound auxSka (hasett vo) ;
|
||||
VFinite Condit Simul => compound auxSkulle (see vo) ;
|
||||
VFinite Condit Anter => compound auxSkulle (hasett vo) ;
|
||||
VImperat => simple (VF Imper) ; --- no passive
|
||||
VImperat => simple (VF (Imper vo)) ;
|
||||
VInfinit Simul => compound [] (se.s ! VI (Inf vo)) ;
|
||||
VInfinit Anter => compound [] (auxHa ++ sett vo)
|
||||
} ;
|
||||
@@ -521,11 +530,13 @@ oper
|
||||
-- (s3) complement. This discontinuity is needed in sentence formation
|
||||
-- to account for word order variations. No particle needs to be retained.
|
||||
|
||||
param VIForm = VIInfinit | VIImperat Bool ;
|
||||
|
||||
oper
|
||||
VerbPhrase : Type = {
|
||||
s : Str ;
|
||||
s2 : Str ;
|
||||
s3 : Gender => Number => Person => Str
|
||||
s : VIForm => Gender => Number => Person => Str
|
||||
} ;
|
||||
|
||||
VerbGroup : Type = {
|
||||
s : SForm => Str ;
|
||||
s2 : Bool => Str ;
|
||||
@@ -537,11 +548,21 @@ oper
|
||||
vgs = vg.s ;
|
||||
vgs3 = vg.s3
|
||||
in
|
||||
{s = vg.s ! VInfinit a ;
|
||||
s2 = vg.s2 ! b ;
|
||||
s3 = vg.s3 ! VInfinit a ;
|
||||
{s = table {
|
||||
VIInfinit => \\g,n,p =>
|
||||
vg.s ! VInfinit a ++ vg.s2 ! b ++ vg.s3 ! VInfinit a ! g ! n ! p ;
|
||||
VIImperat bo => \\g,n,p =>
|
||||
vg.s ! VImperat ++ vg.s2 ! bo ++ vg.s3 ! VImperat ! g ! n ! p
|
||||
} ---- bo shadows b
|
||||
} ;
|
||||
|
||||
predVerbGroupI : Bool -> {s : Str ; a : Anteriority} -> VerbGroup -> VerbPhrase =
|
||||
\b,ant,vg ->
|
||||
let vp = predVerbGroup b ant.a vg in
|
||||
{s = \\i,g,n,p => ant.s ++ vp.s ! i ! g ! n ! p
|
||||
} ;
|
||||
|
||||
|
||||
-- A simple verb can be made into a verb phrase with an empty complement.
|
||||
-- There are two versions, depending on if we want to negate the verb.
|
||||
-- N.B. negation is *not* a function applicable to a verb phrase, since
|
||||
@@ -586,7 +607,7 @@ oper
|
||||
\\g,n,_ => bra.s ! predFormAdj g n ! Nom ++ infinAtt ++ hansover.s ! Sub)) ;
|
||||
|
||||
predAdjSent2 : AdjCompl -> NounPhrase -> Adjective = \bra,han ->
|
||||
{s = \\af,c => bra.s ! af ! c ++ bra.s2 ++ han.s ! PAcc} ;
|
||||
{s = \\af,c => bra.s ! af ! c ++ {-strPrep-} bra.s2 ++ han.s ! PAcc} ;
|
||||
|
||||
|
||||
--3 Transitive verbs
|
||||
@@ -605,7 +626,7 @@ oper
|
||||
mkDirectVerb : Verb -> TransVerb = \v ->
|
||||
mkTransVerb v nullPrep ;
|
||||
|
||||
nullPrep : Preposition = [] ;
|
||||
nullPrep : Preposition = [] ; ---- CPnoPrep ;
|
||||
|
||||
|
||||
extTransVerb : Verbum -> Preposition -> TransVerb = \v,p ->
|
||||
@@ -615,7 +636,7 @@ oper
|
||||
-- The rule for using transitive verbs is the complementization rule:
|
||||
|
||||
complTransVerb : TransVerb -> NounPhrase -> VerbGroup = \se,dig ->
|
||||
useVerb se (\\_,_,_ => se.s1 ++ se.s2 ++ dig.s ! PAcc) ;
|
||||
useVerb se (\\_,_,_ => se.s1 ++ {-strPrep-} se.s2 ++ dig.s ! PAcc) ;
|
||||
|
||||
-- Transitive verbs with accusative objects can be used passively.
|
||||
-- The function does not check that the verb is transitive.
|
||||
@@ -638,7 +659,7 @@ oper
|
||||
love ;
|
||||
|
||||
reflTransVerb : TransVerb -> VerbGroup = \se ->
|
||||
useVerb se (\\_,n,p => se.s1 ++ se.s2 ++ reflPron n p) ;
|
||||
useVerb se (\\_,n,p => se.s1 ++ {-strPrep-} se.s2 ++ reflPron n p) ;
|
||||
|
||||
reflPron : Number -> Person -> Str ;
|
||||
|
||||
@@ -654,7 +675,7 @@ oper
|
||||
complDitransVerb :
|
||||
DitransVerb -> NounPhrase -> TransVerb = \ge,dig ->
|
||||
{s = ge.s ;
|
||||
s1 = ge.s1 ++ ge.s2 ++ dig.s ! PAcc ;
|
||||
s1 = ge.s1 ++ {-strPrep-} ge.s2 ++ dig.s ! PAcc ;
|
||||
s2 = ge.s3
|
||||
} ;
|
||||
|
||||
@@ -673,7 +694,7 @@ oper
|
||||
DitransAdjVerb -> NounPhrase -> AdjPhrase -> VerbGroup = \gor,dig,sur ->
|
||||
useVerb
|
||||
gor
|
||||
(\\_,_,_ => gor.s1 ++ gor.s2 ++ dig.s ! PAcc ++
|
||||
(\\_,_,_ => gor.s1 ++ {-strPrep-} gor.s2 ++ dig.s ! PAcc ++
|
||||
sur.s ! predFormAdj dig.g dig.n ! Nom) ;
|
||||
|
||||
complAdjVerb :
|
||||
@@ -713,7 +734,7 @@ oper
|
||||
-- The rule for creating locative noun phrases by the preposition "i"
|
||||
-- is a little shaky: "i Sverige" but "på Island".
|
||||
|
||||
prepPhrase : Preposition -> NounPhrase -> Adverb = \i,huset ->
|
||||
prepPhrase : Str -> NounPhrase -> Adverb = \i,huset ->
|
||||
advPost (i ++ huset.s ! PAcc) ;
|
||||
|
||||
locativeNounPhrase : NounPhrase -> Adverb =
|
||||
@@ -799,12 +820,12 @@ oper
|
||||
complDitransSentVerb : TransVerb -> NounPhrase -> Sentence -> VerbGroup =
|
||||
\sa,honom,duler ->
|
||||
useVerb sa
|
||||
(\\_,_,_ => sa.s1 ++ sa.s2 ++ honom.s ! PAcc ++ optStr infinAtt ++ duler.s ! Main) ;
|
||||
(\\_,_,_ => sa.s1 ++ {-strPrep-} sa.s2 ++ honom.s ! PAcc ++ optStr infinAtt ++ duler.s ! Main) ;
|
||||
|
||||
complDitransQuestVerb : TransVerb -> NounPhrase -> QuestionSent -> VerbGroup =
|
||||
\sa,honom,omduler ->
|
||||
useVerb sa
|
||||
(\\_,_,_ => sa.s1 ++ sa.s2 ++ honom.s ! PAcc ++ omduler.s ! IndirQ) ;
|
||||
(\\_,_,_ => sa.s1 ++ {-strPrep-} sa.s2 ++ honom.s ! PAcc ++ omduler.s ! IndirQ) ;
|
||||
|
||||
--3 Verb-complement verbs
|
||||
--
|
||||
@@ -820,8 +841,7 @@ oper
|
||||
(\\g,n,p =>
|
||||
vilja.s1 ++
|
||||
vilja.s3 ++
|
||||
simma.s ++ simma.s2 ++ ---- Anter!
|
||||
simma.s3 ! g ! n ! p) ;
|
||||
simma.s ! VIInfinit ! g ! n ! p) ;
|
||||
|
||||
transVerbVerb : VerbVerb -> TransVerb -> TransVerb = \vilja,hitta ->
|
||||
{s = vilja.s ;
|
||||
@@ -835,8 +855,7 @@ oper
|
||||
(\\g,n,p =>
|
||||
grei.s ! predFormAdj g n ! Nom ++
|
||||
infinAtt ++
|
||||
simma.s ++ simma.s2 ++
|
||||
simma.s3 ! g ! n ! p) ;
|
||||
simma.s ! VIInfinit ! g ! n ! p) ;
|
||||
|
||||
-- Notice agreement to object vs. subject:
|
||||
|
||||
@@ -846,11 +865,10 @@ oper
|
||||
Bool -> DitransVerbVerb -> NounPhrase -> VerbPhrase -> VerbGroup =
|
||||
\obj,be,dig,simma ->
|
||||
useVerb be
|
||||
(\\g,n,p => be.s1 ++ be.s2 ++ dig.s ! PAcc ++ be.s3 ++
|
||||
simma.s ++ simma.s2 ++
|
||||
(\\g,n,p => be.s1 ++ {-strPrep-} be.s2 ++ dig.s ! PAcc ++ be.s3 ++
|
||||
if_then_Str obj
|
||||
(simma.s3 ! dig.g ! dig.n ! dig.p)
|
||||
(simma.s3 ! g ! n ! p)
|
||||
(simma.s ! VIInfinit ! dig.g ! dig.n ! dig.p)
|
||||
(simma.s ! VIInfinit ! g ! n ! p)
|
||||
) ;
|
||||
|
||||
complVerbAdj2 :
|
||||
@@ -859,12 +877,11 @@ oper
|
||||
vara
|
||||
(\\g,n,p =>
|
||||
grei.s ! predFormAdj g n ! Nom ++
|
||||
grei.s2 ++ dig.s ! PAcc ++
|
||||
{-strPrep-} grei.s2 ++ dig.s ! PAcc ++
|
||||
infinAtt ++
|
||||
simma.s ++ simma.s2 ++
|
||||
if_then_Str obj
|
||||
(simma.s3 ! dig.g ! dig.n ! dig.p)
|
||||
(simma.s3 ! g ! n ! p)
|
||||
(simma.s ! VIInfinit ! dig.g ! dig.n ! dig.p)
|
||||
(simma.s ! VIInfinit ! g ! n ! p)
|
||||
) ;
|
||||
|
||||
--2 Sentences missing noun phrases
|
||||
@@ -932,7 +949,7 @@ oper
|
||||
{s = \\c,gn =>
|
||||
variants {
|
||||
vilken.s ! RGen ! gn ++ värde.s ! numGN gn ! Indef ! relCase c ;
|
||||
värde.s ! numGN gn ! Def ! Nom ++ värde.s2 ++ vilken.s ! RPrep ! gn
|
||||
värde.s ! numGN gn ! Def ! Nom ++ {-strPrep-} värde.s2 ++ vilken.s ! RPrep ! gn
|
||||
} ;
|
||||
g = RG (genNoun värde.g)
|
||||
} ;
|
||||
@@ -954,7 +971,7 @@ oper
|
||||
{s = \\b,sf,gn,p =>
|
||||
let
|
||||
jagtalar = jagTalar.s ! b ! s2cl sf Sub ;
|
||||
om = jagTalar.s2
|
||||
om = {-strPrep-} jagTalar.s2
|
||||
in variants {
|
||||
som.s ! RAcc ! gn ++ jagtalar ++ om ;
|
||||
om ++ som.s ! RPrep ! gn ++ jagtalar
|
||||
@@ -1117,7 +1134,7 @@ oper
|
||||
intSlash : IntPron -> ClauseSlashNounPhrase -> Question = \Vem, jagTalar ->
|
||||
let
|
||||
vem = Vem.s ! PAcc ;
|
||||
om = jagTalar.s2
|
||||
om = {-strPrep-} jagTalar.s2
|
||||
in
|
||||
{s = \\b,sf =>
|
||||
let
|
||||
@@ -1148,7 +1165,7 @@ oper
|
||||
|
||||
IntAdverb = SS ;
|
||||
|
||||
prepIntAdverb : Preposition -> IntPron -> IntAdverb =
|
||||
prepIntAdverb : Str -> IntPron -> IntAdverb =
|
||||
prepPhrase ;
|
||||
|
||||
-- A question adverbial can be applied to anything, and whether this makes
|
||||
@@ -1164,9 +1181,9 @@ oper
|
||||
|
||||
Imperative = {s : Number => Str} ;
|
||||
|
||||
imperVerbPhrase : Bool -> VerbGroup -> Imperative = \b,titta ->
|
||||
imperVerbPhrase : Bool -> VerbPhrase -> Imperative = \b,titta ->
|
||||
{s = \\n =>
|
||||
titta.s ! VImperat ++ titta.s2 ! b ++ titta.s3 ! VImperat ! utrum ! n ! P2
|
||||
titta.s ! VIImperat b ! utrum ! n ! P2
|
||||
} ;
|
||||
|
||||
imperUtterance : Number -> Imperative -> Utterance = \n,I ->
|
||||
@@ -1371,15 +1388,12 @@ oper
|
||||
-- "What do you want to do? - Wash myself."
|
||||
|
||||
verbUtterance : VerbPhrase -> Utterance = \vp ->
|
||||
ss (vp.s ++ vp.s2 ++ vp.s3 ! utrum ! Sg ! P1) ;
|
||||
ss (vp.s ! VIInfinit ! utrum ! Sg ! P1) ;
|
||||
|
||||
----------- changes when parametrizing 20/1/2005
|
||||
|
||||
---- moved from Morphology
|
||||
|
||||
-- Prepositions are just strings.
|
||||
Preposition = Str ;
|
||||
|
||||
-- Relative pronouns have a special case system. $RPrep$ is the form used
|
||||
-- after a preposition (e.g. "det hus i vilket jag bor").
|
||||
param
|
||||
@@ -1395,7 +1409,18 @@ oper
|
||||
|
||||
pronNågon : GenNum => Str ;
|
||||
|
||||
deponentVerb : Verb -> Verb ;
|
||||
deponentVerb : Verb -> Verb = \finna -> {
|
||||
s = table {
|
||||
VF (Pres _) => finna.s ! VF (Pres Pass) ;
|
||||
VF (Pret _) => finna.s ! VF (Pret Pass) ;
|
||||
VF (Imper _) => finna.s ! VF (Imper Pass) ;
|
||||
VI (Inf _) => finna.s ! VI (Inf Pass) ;
|
||||
VI (Supin _) => finna.s ! VI (Supin Pass) ;
|
||||
v => finna.s ! v
|
||||
} ;
|
||||
s1 = finna.s1
|
||||
} ;
|
||||
|
||||
|
||||
verbFinnas : Verb ;
|
||||
verbVara : Verb ;
|
||||
|
||||
@@ -96,9 +96,16 @@ oper
|
||||
oper Verbum : Type = {s : VerbForm => Str} ;
|
||||
|
||||
param
|
||||
VFin ;
|
||||
|
||||
VInf ;
|
||||
VFin =
|
||||
Pres Voice
|
||||
| Pret Voice
|
||||
| Imper Voice ;
|
||||
|
||||
VInf =
|
||||
Inf Voice
|
||||
| Supin Voice
|
||||
| PtPret AdjFormPos Case
|
||||
;
|
||||
|
||||
VerbForm =
|
||||
VF VFin
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
--# -path=.:../romance:../abstract:../../prelude
|
||||
|
||||
concrete RulesSpa of Rules =
|
||||
concrete RulesSpa of Rules = CategoriesSpa **
|
||||
RulesRomance with (SyntaxRomance=SyntaxSpa) ;
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
--# -path=.:../romance:../abstract:../../prelude
|
||||
--# -path=.:../romance:../oldabstract:../abstract:../../prelude
|
||||
|
||||
concrete TestResourceSpa of TestResource =
|
||||
RulesSpa, StructuralSpa ** open Prelude, TypesSpa, MorphoSpa, SyntaxSpa in {
|
||||
|
||||
222
lib/resource/swedish/BasicSwe.gf
Normal file
222
lib/resource/swedish/BasicSwe.gf
Normal file
@@ -0,0 +1,222 @@
|
||||
--# -path=.:../scandinavian:../abstract:../../prelude
|
||||
|
||||
concrete BasicSwe of Basic = CategoriesSwe ** open NewParadigmsSwe in {
|
||||
|
||||
flags startcat=Phr ; lexer=textlit ; parser=chart ; unlexer=text ;
|
||||
|
||||
lin
|
||||
airplane_N = regN "flygplan" neutrum ;
|
||||
answer_V2S = mkV2S (regV "svara") "till" ;
|
||||
apartment_N = mk2N "lägenhet" "lägenheter" ;
|
||||
apple_N = regN "äpple" neutrum ;
|
||||
art_N = mk2N "konst" "konster" ;
|
||||
ask_V2Q = mkV2Q (regV "fråga") [] ;
|
||||
baby_N = regN "bebis" utrum ;
|
||||
bad_ADeg = irregADeg "dålig" "sämre" "sämst";
|
||||
bank_N = mk2N "bank" "banker" ;
|
||||
beautiful_ADeg = mk3ADeg "vacker" "vackert" "vackrast" ;
|
||||
become_VA = mkVA (mkV "bli" "blir""bli" "blev" "blivit" "bliven") ;
|
||||
beer_N = regN "öl" neutrum ;
|
||||
beg_V2V = mkV2V (mkV "be" "ber""be" "blad" "bett" "bedd") [] "att" ;
|
||||
big_ADeg = irregADeg "stor" "större" "störst";
|
||||
bike_N = mk2N "cykel" "cyklar" ;
|
||||
bird_N = mk2N "fågel" "fåglar" ;
|
||||
black_ADeg = mk2ADeg "svart" "svart" ;
|
||||
blue_ADeg = mk2ADeg "blå" "blått";
|
||||
boat_N = regN "båt" utrum ;
|
||||
book_N = mk2N "bok" "böcker" ;
|
||||
boot_N = mk2N "stövel" "stövlar" ;
|
||||
boss_N = mk2N "chef" "chefer" ;
|
||||
boy_N = regN "pojke" utrum ;
|
||||
bread_N = regN "bröd" neutrum ;
|
||||
break_V2 = dirV2 (partV (mkV "slå" "slår" "slå" "slog" "slagit" "slagen") "sönder") ;
|
||||
broad_ADeg = mk2ADeg "bred" "brett" ;
|
||||
brother_N2 = mkN2 (mascN (mkN "bror" "brodern" "bröder" "bröderna")) "till" ;
|
||||
brown_ADeg = regADeg "brun" ;
|
||||
butter_N = regN "smör" neutrum ;
|
||||
buy_V2 = dirV2 (mk2V "köpa" "köper") ;
|
||||
camera_N = regN "kamera" utrum ;
|
||||
cap_N = regN "mössa" utrum ;
|
||||
car_N = regN "bil" utrum ;
|
||||
carpet_N = regN "matta" utrum ;
|
||||
cat_N = mk2N "katt" "katter" ;
|
||||
ceiling_N = regN "tak" neutrum ;
|
||||
chair_N = regN "stol" utrum ;
|
||||
cheese_N = regN "ost" utrum ;
|
||||
child_N = regN "barn" neutrum ;
|
||||
church_N = regN "kyrka" utrum ;
|
||||
city_N = mk2N "stad" "städer" ;
|
||||
clean_ADeg = regADeg "ren" ;
|
||||
clever_ADeg = regADeg "klok" ;
|
||||
close_V2 = dirV2 (regV "stänga") ;
|
||||
coat_N = regN "rock" utrum ;
|
||||
cold_ADeg = regADeg "kall" ;
|
||||
come_V = (mkV "komma" "kommer" "kom" "kom" "kommit" "kommen") ;
|
||||
computer_N = mk2N "dator" "datorer" ;
|
||||
country_N = mkN "land" "landet" "länder" "länderna" ;
|
||||
cousin_N = mk2N "kusin" "kusinerna" ;
|
||||
cow_N = mk2N "ko" "kor" ;
|
||||
die_V = (mkV "dö" "dör" "dö" "dog" "dött" "dödd") ; ----
|
||||
dirty_ADeg = regADeg "smutsig" ;
|
||||
doctor_N = mk2N "läkare" "läkare" ;
|
||||
dog_N = regN "hund" utrum ;
|
||||
door_N = regN "dörr" utrum ;
|
||||
drink_V2 = dirV2 (irregV "dricka" "drack" "druckit") ;
|
||||
easy_A2V = mkA2V (mk2A "lätt" "lätt") "för" ;
|
||||
eat_V2 = dirV2 (irregV "äta" "åt" "ätit") ;
|
||||
enemy_N = regN "fiende" neutrum ;
|
||||
factory_N = mk2N "fabrik" "fabriker" ;
|
||||
father_N2 = mkN2 (mascN (mkN "far" "fadern" "fäder" "fäderna")) "till" ;
|
||||
fear_VS = mkVS (regV "frukta") ;
|
||||
find_V2 = dirV2 (irregV "finna" "fann" "funnit") ;
|
||||
fish_N = mk2N "fisk" "fiskar" ;
|
||||
floor_N = regN "golv" neutrum ;
|
||||
forget_V2 = dirV2 (mkV "glömma" "glömmer" "glöm" "glömde" "glömt" "glömd") ;
|
||||
fridge_N = regN "kylskåp" neutrum ;
|
||||
friend_N = mkN "vän" "vännen" "vänner" "vännerna" ;
|
||||
fruit_N = mk2N "frukt" "frukter" ;
|
||||
fun_AV = mkAV (regA "rolig") ;
|
||||
garden_N = regN "trädgård" utrum ;
|
||||
girl_N = regN "flicka" utrum ;
|
||||
glove_N = regN "handske" utrum ;
|
||||
gold_N = regN "guld" neutrum ;
|
||||
good_ADeg = mkADeg "god" "gott" "goda" "goda" "bättre" "bäst" "bästa" ;
|
||||
go_V = (mkV "gå" "går" "gå" "gick" "gått" "gången") ;
|
||||
green_ADeg = regADeg "grön" ;
|
||||
harbour_N = regN "hamn" utrum;
|
||||
hate_V2 = dirV2 (regV "hata") ;
|
||||
hat_N = regN "hatt" utrum ;
|
||||
have_V2 = dirV2 (mkV "ha" "har" "ha" "hade" "haft" "haft") ; ---- pp
|
||||
hear_V2 = dirV2 (mkV "höra" "hör" "hör" "hörde" "hört" "hörd") ;
|
||||
hill_N = regN "kulle" utrum ;
|
||||
hope_VS = mkVS (depV (regV "hoppas")) ;
|
||||
horse_N = regN "häst" utrum ;
|
||||
hot_ADeg = regADeg "het" ;
|
||||
house_N = regN "hus" neutrum ;
|
||||
important_ADeg = regADeg "viktig" ;
|
||||
industry_N = mk2N "industri" "industrier" ; ---- "ien" ??
|
||||
iron_N = regN "järn" neutrum ;
|
||||
king_N = mascN (regN "kung" utrum) ;
|
||||
know_V2 = dirV2 (mkV "veta" "vet" "vet" "visste" "vetat" "visst") ;
|
||||
lake_N = mkN "sjö" "sjön" "sjöar" "sjöarna" ;
|
||||
lamp_N = regN "lampa" utrum;
|
||||
learn_V2 = dirV2 (mkV "lära" "lär" "lär" "lärde" "lärt" "lärd") ; ---- refl!
|
||||
leather_N = mkN "läder" "lädret" "läder" "lädren" ;
|
||||
leave_V2 = dirV2 (regV "lämna") ;
|
||||
like_V2 = mkV2 (mk2V "tycka" "tycker") "om" ;
|
||||
listen_V2 = dirV2 (regV "lyssna") ;
|
||||
live_V = (irregV "leva" "levde" "levt") ; ---- ?
|
||||
long_ADeg = irregADeg "lång" "längre" "längst" ;
|
||||
lose_V2 = dirV2 (regV "förlora") ;
|
||||
love_N = regN "kärlek" utrum ;
|
||||
love_V2 = dirV2 (regV "älska") ;
|
||||
man_N = mascN (mkN "man" "mannen" "män" "männen") ;
|
||||
married_A2 = mkA2 (mk2A "gift" "gift") "med" ;
|
||||
meat_N = regN "kött" neutrum ;
|
||||
milk_N = regN "mjölk" utrum ; ---- -ar?
|
||||
moon_N = regN "måne" utrum ;
|
||||
mother_N2 = mkN2 (mkN "mor" "modern" "mödrar" "mödrarna") "till" ;
|
||||
mountain_N = regN "berg" neutrum ;
|
||||
music_N = mk2N "musik" "musiker" ; ---- er ?
|
||||
narrow_ADeg = regADeg "smal" ;
|
||||
new_ADeg = mkADeg "ny" "nytt" "nya" "nya" "nyare" "nyast" "nyaste" ;
|
||||
newspaper_N = regN "tidning" utrum ;
|
||||
|
||||
oil_N = regN "olja" utrum ;
|
||||
old_ADeg = mkADeg "gammal" "gammalt" "gamla" "gamla" "äldre" "äldst" "äldsta" ;
|
||||
open_V2 = dirV2 (regV "öppna") ;
|
||||
paint_V2A = mkV2A (regV "måla") [] ;
|
||||
paper_N = mkN "papper" "pappret" "papper" "pappren" ;
|
||||
peace_N = regN "fred" utrum ; ---- ar?
|
||||
pen_N = regN "penna" utrum ;
|
||||
planet_N = mk2N "planet" "planeter" ;
|
||||
plastic_N = mk2N "plastic" "plastiker" ;
|
||||
play_V2 = dirV2 (regV "spela") ;
|
||||
policeman_N = mk2N "polis" "poliser" ;
|
||||
priest_N = mk2N "präst" "präster" ;
|
||||
probable_AS = mkAS (regA "sannolik") ;
|
||||
queen_N = regN "drottning" utrum ;
|
||||
radio_N = regN "radio" utrum ; ----
|
||||
rain_V0 = mkV0 (regV "regna") ;
|
||||
read_V2 = dirV2 (mk2V "läsa" "läser") ;
|
||||
red_ADeg = mk2ADeg "röd" "rött" ;
|
||||
religion_N = mk2N "religion" "religioner" ;
|
||||
restaurant_N = mk2N "restaurang" "restauranger" ;
|
||||
river_N = mkN "å" "ån" "åar" "åarna" ;
|
||||
rock_N = regN "sten" utrum ;
|
||||
roof_N = regN "tak" neutrum ;
|
||||
rubber_N = mkN "gummi" "gummit" "gummin" "gummina" ;
|
||||
run_V = (irregV "springa" "sprang" "sprungit") ;
|
||||
say_VS = mkVS (mkV "säga" "säger" "säg" "sade" "sagt" "sagd") ;
|
||||
school_N = regN "skola" utrum;
|
||||
science_N = mk2N "vetenskap" "vetenskaper" ;
|
||||
sea_N = mkN "sjö" "sjön" "sjöar" "sjöarna" ;
|
||||
seek_V2 = dirV2 (mk2V "söka" "söker") ;
|
||||
see_V2 = dirV2 (mkV "se" "ser" "se" "såg" "sett" "sedd") ;
|
||||
sell_V3 = dirV3 (irregV "sälja" "sålde" "sålt") "to" ;
|
||||
send_V3 = dirV3 (regV "skicka") "till" ;
|
||||
sheep_N = mk2N "får" "får" ;
|
||||
ship_N = regN "skepp" neutrum ;
|
||||
shirt_N = regN "skjorta" utrum ;
|
||||
shoe_N = regN "sko" utrum ;
|
||||
shop_N = mk2N "affär" "affären" ;
|
||||
short_ADeg = regADeg "kort" ;
|
||||
silver_N = mkN "silver" "silvret" "silver" "silvren" ;
|
||||
sister_N = mk2N "syster" "systrar" ;
|
||||
sleep_V = (irregV "sova" "sov" "sovit") ;
|
||||
small_ADeg = mkADeg "liten" "litet" "lilla" "små" "mindre" "minst" "minsta" ;
|
||||
snake_N = regN "orm" utrum ;
|
||||
sock_N = regN "strumpa" utrum ;
|
||||
speak_V2 = dirV2 (regV "tala") ;
|
||||
star_N = regN "stjärna" utrum ;
|
||||
steel_N = regN "stål" utrum ;
|
||||
stone_N = regN "sten" utrum ;
|
||||
stove_N = regN "spis" utrum ;
|
||||
student_N = mk2N "student" "studenter" ;
|
||||
stupid_ADeg = mk3ADeg "dum" "dumt" "dumma" ;
|
||||
sun_N = regN "sol" utrum ;
|
||||
switch8off_V2 = dirV2 (partV (irregV "stänga" "stängde" "stängt") "av") ;
|
||||
switch8on_V2 = dirV2 (partV (irregV "slå" "slog" "slagit") "på") ;
|
||||
table_N = regN "bord" neutrum ;
|
||||
talk_V3 = mkV3 (regV "prata") "till" "om" ;
|
||||
teacher_N = mk2N "lärare" "lärare" ;
|
||||
teach_V2 = dirV2 (regV "undervisa") ;
|
||||
television_N = mk2N "television" "televisioner" ;
|
||||
thick_ADeg = regADeg "tjock" ;
|
||||
thin_ADeg = mk2ADeg "tunn" "tunt" ;
|
||||
train_N = regN "tåg" neutrum ;
|
||||
travel_V = mk2V "resa" "reser" ;
|
||||
tree_N = regN "träd" neutrum ;
|
||||
---- trousers_N = regN "trousers" ; ---- pl t !
|
||||
ugly_ADeg = regADeg "ful" ;
|
||||
understand_V2 = dirV2 (mkV "förstå" "förstår" "förstå" "förstod" "förstått" "förstådd") ;
|
||||
university_N = regN "universitet" neutrum ;
|
||||
village_N = mkN "by" "byn" "byar" "byarna" ;
|
||||
wait_V2 = mkV2 (regV "vänta") "på" ;
|
||||
walk_V = (mkV "gå" "går" "gå" "gick" "gått" "gången") ;
|
||||
warm_ADeg = regADeg "varm" ;
|
||||
war_N = regN "krig" neutrum ;
|
||||
watch_V2 = mkV2 (regV "titta") "på" ;
|
||||
water_N = mkN "vatten" "vattnet" "vatten" "vattnen" ;
|
||||
white_ADeg = regADeg "vit" ;
|
||||
window_N = mkN "fönster" "fönstret" "fönster" "fönstren" ;
|
||||
wine_N = mkN "vin" "vinet" "viner" "vinerna" ; ----
|
||||
win_V2 = dirV2 (irregV "vinna" "vann" "vunnit") ;
|
||||
woman_N = regN "kvinna" utrum ;
|
||||
wonder_VQ = mkVQ (regV "undra") ;
|
||||
wood_N = mkN "trä" "träet" "träen" "träena" ; ---- ?
|
||||
write_V2 = dirV2 (irregV "skriva" "skrev" "skrivit") ;
|
||||
yellow_ADeg = regADeg "gul" ;
|
||||
young_ADeg = irregADeg "ung" "yngre" "yngst" ;
|
||||
|
||||
do_V2 = dirV2 (mkV "göra" "gör" "gör" "gjorde" "gjort" "gjord") ;
|
||||
now_Adv = mkAdv "nu" ;
|
||||
already_Adv = mkAdv "redan" ;
|
||||
song_N = mk2N "sång" "sånger" ;
|
||||
add_V3 = mkV3 (partV (irregV "lägga" "lade" "lagt") "till") [] "till" ;
|
||||
number_N = mkN "nummer" "numret" "numren" "numren" ;
|
||||
put_V2 = mkV2 (irregV "sätta" "satte" "satt") [] ;
|
||||
stop_V = regV "stanna" ;
|
||||
jump_V = regV "hoppa" ;
|
||||
|
||||
} ;
|
||||
@@ -1,3 +1,4 @@
|
||||
--# -path=.:../scandinavian:../abstract:../../prelude
|
||||
|
||||
concrete ClauseSwe of Clause = ClauseScand with (SyntaxScand=SyntaxSwe) ;
|
||||
concrete ClauseSwe of Clause = CategoriesSwe **
|
||||
ClauseScand with (SyntaxScand=SyntaxSwe) ;
|
||||
|
||||
@@ -10,69 +10,268 @@
|
||||
|
||||
resource MorphoSwe = TypesSwe ** open Prelude in {
|
||||
|
||||
-- Nouns
|
||||
|
||||
oper
|
||||
mkVerbPart : (supa,super,sup,söp,supit,supen,upp : Str) -> Verb =
|
||||
\finna,finner,finn,fann,funnit,funnen,upp ->
|
||||
mkNoun : (apa,apan,apor,aporna : Str) -> Subst =
|
||||
\apa,apan,apor,aporna ->
|
||||
{s = table {
|
||||
SF Sg Indef c => mkCase c apa ;
|
||||
SF Sg Def c => mkCase c apan ;
|
||||
SF Pl Indef c => mkCase c apor ;
|
||||
SF Pl Def c => mkCase c aporna
|
||||
} ;
|
||||
h1 = case last apan of {
|
||||
"n" => Utr ;
|
||||
_ => Neutr
|
||||
}
|
||||
} ;
|
||||
|
||||
reg2Noun : Str -> Str -> Subst = \bil,bilar ->
|
||||
let
|
||||
l = last bil ;
|
||||
b = Predef.tk 2 bil ;
|
||||
ar = Predef.dp 2 bilar
|
||||
in
|
||||
case ar of {
|
||||
"or" => case l of {
|
||||
"a" => decl1Noun bil ;
|
||||
"r" => sLik bil ;
|
||||
"o" => mkNoun bil (bil + "n") bilar (bilar + "na") ;
|
||||
_ => mkNoun bil (bil + "en") bilar (bilar + "na")
|
||||
} ;
|
||||
"ar" => ifTok Subst (Predef.tk 2 bilar) bil
|
||||
(decl2Noun bil)
|
||||
(case l of {
|
||||
"e" => decl2Noun bil ;
|
||||
_ => mkNoun bil (bil + "n") bilar (bilar + "na")
|
||||
}
|
||||
) ;
|
||||
"er" => decl3Noun bil ;
|
||||
"en" => ifTok Subst bil bilar (sLik bil) (sRike bil) ; -- ben-ben
|
||||
_ => ifTok Subst bil bilar (
|
||||
case Predef.dp 3 bil of {
|
||||
"are" => sKikare (init bil) ;
|
||||
_ => decl5Noun bil
|
||||
}
|
||||
)
|
||||
(decl5Noun bil) --- rest case with lots of garbage
|
||||
} ;
|
||||
|
||||
--- this is a very rough heuristic as regards "ar/er"
|
||||
|
||||
regNoun : Str -> Gender -> Subst = \bil,g -> case g of {
|
||||
Utr => case last bil of {
|
||||
"a" => decl1Noun bil ;
|
||||
_ => decl2Noun bil
|
||||
} ;
|
||||
Neutr => case last bil of {
|
||||
"e" => sRike bil ;
|
||||
_ => decl5Noun bil
|
||||
}
|
||||
} ;
|
||||
|
||||
|
||||
decl1Noun : Str -> Subst = \apa -> sApa (init apa) ;
|
||||
|
||||
decl2Noun : Str -> Subst = \bil ->
|
||||
case last bil of {
|
||||
"e" => sPojke (init bil) ;
|
||||
_ => mkNoun bil (bil + "en") (bil + "ar") (bil + "arna")
|
||||
} ;
|
||||
|
||||
decl3Noun : Str -> Subst = \sak ->
|
||||
case last sak of {
|
||||
"e" => sVarelse (init sak) ;
|
||||
"å" => sNivå sak ;
|
||||
_ => mkNoun sak (sak + "en") (sak + "er") (sak + "erna")
|
||||
} ;
|
||||
|
||||
decl5Noun : Str -> Subst = \lik ->
|
||||
mkNoun lik (lik + "et") lik (lik + "en") ;
|
||||
|
||||
|
||||
-- Adjectives
|
||||
|
||||
|
||||
mkAdjPos : Str -> Str -> Str -> Str -> AdjFormPos -> Str ;
|
||||
mkAdjPos liten litet lilla sma a = case a of {
|
||||
Strong gn => case gn of {
|
||||
ASg Utr => liten ;
|
||||
ASg Neutr => litet ;
|
||||
APl => sma
|
||||
} ;
|
||||
Weak sn => case sn of {
|
||||
AxSg NoMasc => lilla ;
|
||||
AxSg Masc => init lilla + "e" ;
|
||||
AxPl => sma
|
||||
}
|
||||
} ;
|
||||
|
||||
-- The worst-case macro for the full declension (including comparison forms)
|
||||
-- is not so much worse.
|
||||
|
||||
mkAdjective : Str -> Str -> Str -> Str ->
|
||||
Str -> Str -> Str -> Adj ;
|
||||
mkAdjective liten litet lilla sma mindre minst minsta = {s = table {
|
||||
AF (Posit p) c => mkCase c (mkAdjPos liten litet lilla sma p) ;
|
||||
AF Compar c => mkCase c mindre ;
|
||||
AF (Super SupStrong) c => mkCase c minst ;
|
||||
AF (Super SupWeak) c => mkCase c minsta
|
||||
}
|
||||
} ;
|
||||
|
||||
-- It is handy to extract the positive part of a declension only, if
|
||||
-- the other comparicon forms aren't needed or don't make sense.
|
||||
|
||||
extractPositive : Adj -> {s : AdjFormPos => Case => Str} ;
|
||||
extractPositive adj = {s = \\a,c => adj.s ! (AF (Posit a) c)} ;
|
||||
|
||||
-- The notion of 'moderately irregular adjective' covers almost all adjectives.
|
||||
|
||||
adjIrreg : (_,_,_,_ : Str) -> Adj ;
|
||||
adjIrreg god gott battre bast =
|
||||
mkAdjective god gott (god + "a") (god + "a") battre bast (bast + "a") ;
|
||||
|
||||
-- Often it is possible to derive the $Pos Sg Neutr$ form even if the
|
||||
-- comparison forms are irregular.
|
||||
|
||||
adjIrreg3 : (_,_,_: Str) -> Adj ;
|
||||
adjIrreg3 ung yngre yngst = adjIrreg ung (ung + "t") yngre yngst ;
|
||||
|
||||
-- Some adjectives must be given $Pos Sg Utr$ $Pos Sg Neutr$, and $Pos Pl$,
|
||||
-- e.g. those ending with unstressed "en".
|
||||
|
||||
adjAlmostReg : (_,_,_: Str) -> Adj ;
|
||||
adjAlmostReg ljummen ljummet ljumma =
|
||||
mkAdjective ljummen ljummet ljumma ljumma
|
||||
(ljumma + "re") (ljumma + "st") (ljumma + "ste") ;
|
||||
|
||||
adjReg : Str -> Adj = \fin -> adjAlmostReg fin (fin + "t") (fin + "a") ;
|
||||
|
||||
adj2Reg : Str -> Str -> Adj = \vid,vitt -> adjAlmostReg vid vitt (vid + "a") ;
|
||||
|
||||
|
||||
-- Verbs
|
||||
|
||||
mkVerb : (supa,super,sup,söp,supit,supen : Str) -> Verb =
|
||||
\finna,finner,finn,fann,funnit,funnen ->
|
||||
let funn = ptPretForms funnen in
|
||||
{s = table {
|
||||
VF (Pres Ind Act) => finner ;
|
||||
VF (Pres Ind Pass) => finn + "s" ;
|
||||
VF (Pres Cnj Act) => finn + "e" ;
|
||||
VF (Pres Cnj Pass) => finn + "es" ;
|
||||
VF (Pret Ind Act) => fann ;
|
||||
VF (Pret Ind Pass) => fann + "s" ;
|
||||
VF (Pret Cnj Act) => fann ; --- = ind
|
||||
VF (Pret Cnj Pass) => fann + "s" ; ---
|
||||
VF Imper => finn ;
|
||||
VI (Inf Act) => finna ;
|
||||
VI (Inf Pass) => finna + "s" ;
|
||||
VI (Supin Act) => funnit ;
|
||||
VI (Supin Pass) => funnit + "s" ;
|
||||
VI (PtPres Nom) => finn + "ande" ;
|
||||
VI (PtPres Gen) => finn + "andes" ;
|
||||
VF (Pres Act) => finner ;
|
||||
VF (Pres Pass) => mkVoice Pass finn ;
|
||||
VF (Pret v) => mkVoice v fann ;
|
||||
VF (Imper v) => mkVoice v finn ;
|
||||
VI (Inf v) => mkVoice v finna ;
|
||||
VI (Supin v) => mkVoice v funnit ;
|
||||
VI (PtPret a c) => funn ! a ! c
|
||||
} ;
|
||||
s1 = upp
|
||||
} ;
|
||||
s1 = []
|
||||
} ;
|
||||
|
||||
ptPretForms : Str -> AdjFormPos => Case => Str = \funnen -> \\a,c =>
|
||||
mkCase c (
|
||||
{- ----
|
||||
case Predef.dp 2 funnen of {
|
||||
"en" => let funn : Str = Predef.tk 2 funnen in
|
||||
case a of {
|
||||
(Strong (ASg Utr)) => funn + "en" ;
|
||||
(Strong (ASg Neutr)) => funn + "et" ;
|
||||
(Strong APl) => funn + "a" ;
|
||||
(Weak (AxSg NoMasc)) => funn + "a" ;
|
||||
(Weak (AxSg Masc)) => funn + "e" ;
|
||||
(Weak AxPl) => funn + "a"
|
||||
} ;
|
||||
"ad" => let funn : Str = Predef.tk 2 funnen in
|
||||
case a of {
|
||||
(Strong (ASg Utr)) => funn + "ad" ;
|
||||
(Strong (ASg Neutr)) => funn + "at" ;
|
||||
(Strong APl) => funn + "ade" ;
|
||||
(Weak _) => funn + "ade"
|
||||
} ;
|
||||
vFinna : (_,_,_ : Str) -> Verb = \finn, fann, funn ->
|
||||
mkVerb (finn + "a") (finn + "er") finn fann (funn + "it") (funn + "en") ;
|
||||
|
||||
_ =>
|
||||
-}
|
||||
funnen ---- to be completed
|
||||
---- }
|
||||
) ;
|
||||
-- Now this is more general and subsumes $vFinna$.
|
||||
|
||||
vSälja : (_,_,_ : Str) -> Verb = \sälja, sålde, sålt ->
|
||||
let
|
||||
a = last sälja ;
|
||||
sälj = case a of {
|
||||
"a" => init sälja ;
|
||||
_ => sälja
|
||||
} ;
|
||||
er = case a of {
|
||||
"a" => "er" ;
|
||||
_ => "r"
|
||||
} ;
|
||||
såld = case Predef.dp 2 sålt of {
|
||||
"it" => Predef.tk 2 sålt + "en" ;
|
||||
_ => init sålt + "d"
|
||||
}
|
||||
in
|
||||
mkVerb sälja (sälj + er) sälj sålde sålt såld ;
|
||||
|
||||
regVerb : (_,_ : Str) -> Verb = \tala,talar ->
|
||||
let
|
||||
ar = Predef.dp 2 talar ;
|
||||
tal = Predef.tk 2 talar ;
|
||||
forms = case ar of {
|
||||
"ar" => vTala tal ;
|
||||
"er" => vLeka tal ;
|
||||
_ => case last tala of {
|
||||
"a" => mkVerb tala talar tal (tal + "de") (tala + "t") (tala + "d") ;
|
||||
_ => mkVerb tala talar tala (tala + "dde") (tala + "tt") (tala + "dd")
|
||||
}
|
||||
}
|
||||
in forms ** {s1 = []} ;
|
||||
|
||||
ptPretForms : Str -> AdjFormPos => Case => Str = \funnen -> \\a,c =>
|
||||
let
|
||||
funn = Predef.tk 2 funnen ;
|
||||
en = Predef.dp 2 funnen ;
|
||||
funne = init funnen ;
|
||||
n = last funnen ;
|
||||
m = case last funn of {
|
||||
"n" => [] ;
|
||||
_ => "n"
|
||||
} ;
|
||||
funna = case en of {
|
||||
"en" => case a of {
|
||||
(Strong (ASg Utr)) => funn + "en" ;
|
||||
(Strong (ASg Neutr)) => funn + "et" ;
|
||||
(Weak (AxSg Masc)) => funn + m + "e" ;
|
||||
_ => funn + m + "a"
|
||||
} ;
|
||||
"dd" => case a of {
|
||||
(Strong (ASg Utr)) => funn + "dd" ;
|
||||
(Strong (ASg Neutr)) => funn + "tt" ;
|
||||
(Weak (AxSg Masc)) => funn + "dde" ;
|
||||
_ => funn + "dda"
|
||||
} ;
|
||||
"ad" => case a of {
|
||||
(Strong (ASg Utr)) => funn + "ad" ;
|
||||
(Strong (ASg Neutr)) => funn + "at" ;
|
||||
_ => funn + "ade"
|
||||
} ;
|
||||
_ => case n of {
|
||||
"d" => case a of {
|
||||
(Strong (ASg Utr)) => funne + "d" ;
|
||||
(Strong (ASg Neutr)) => funne + "t" ;
|
||||
(Weak (AxSg Masc)) => funne + "de" ;
|
||||
_ => funne + "da"
|
||||
} ;
|
||||
_ => case a of {
|
||||
(Strong (ASg Utr)) => funne + "t" ;
|
||||
(Strong (ASg Neutr)) => funne + "t" ;
|
||||
(Weak (AxSg Masc)) => funne + "te" ;
|
||||
_ => funne + "ta"
|
||||
}
|
||||
}
|
||||
}
|
||||
in
|
||||
mkCase c funna ;
|
||||
|
||||
mkCase : Case -> Str -> Str = \c,f -> case c of {
|
||||
Nom => f ;
|
||||
Gen => f + "s"
|
||||
Gen => f + case last f of {
|
||||
"s" => [] ;
|
||||
_ => "s"
|
||||
}
|
||||
} ;
|
||||
|
||||
mkVoice : Voice -> Str -> Str = \c,f -> case c of {
|
||||
Act => f ;
|
||||
Pass => f + case last f of {
|
||||
"s" => "es" ;
|
||||
_ => "s"
|
||||
}
|
||||
} ;
|
||||
|
||||
-- The most common is a verb without a particle.
|
||||
|
||||
mkVerb : (_,_,_,_,_,_ : Str) -> Verb = \supa,super,sup,söp,supit,supen ->
|
||||
mkVerbPart supa super sup söp supit supen [] ;
|
||||
|
||||
mkVerbPart : (_,_,_,_,_,_,_ : Str) -> Verb = \supa,super,sup,söp,supit,supen,upp ->
|
||||
{s = (mkVerb supa super sup söp supit supen).s} ** {s1 = upp} ;
|
||||
|
||||
-- Prepositions are just strings.
|
||||
Preposition = Str ;
|
||||
@@ -524,21 +723,16 @@ oper aAbstrakt : Str -> Adj = \abstrakt ->
|
||||
|
||||
oper vTala : Str -> Verbum = \tal ->
|
||||
{s = table {
|
||||
VF (Pres Ind Act) => tal + "ar" ;
|
||||
VF (Pres Ind Pass) => tal + "as" ;
|
||||
VF (Pres Cnj Act) => tal + "e" ;
|
||||
VF (Pres Cnj Pass) => tal + "es" ;
|
||||
VF (Pret Ind Act) => tal + "ade" ;
|
||||
VF (Pret Ind Pass) => tal + "ades" ;
|
||||
VF (Pret Cnj Act) => tal + "ade" ;
|
||||
VF (Pret Cnj Pass) => tal + "ades" ;
|
||||
VF Imper => tal + "a" ;
|
||||
VF (Pres Act) => tal + "ar" ;
|
||||
VF (Pres Pass) => tal + "as" ;
|
||||
VF (Pret Act) => tal + "ade" ;
|
||||
VF (Pret Pass) => tal + "ades" ;
|
||||
VF (Imper Act) => tal + "a" ;
|
||||
VF (Imper Pass) => tal + "as" ;
|
||||
VI (Inf Act) => tal + "a" ;
|
||||
VI (Inf Pass) => tal + "as" ;
|
||||
VI (Supin Act) => tal + "at" ;
|
||||
VI (Supin Pass) => tal + "ats" ;
|
||||
VI (PtPres Nom) => tal + "ande" ;
|
||||
VI (PtPres Gen) => tal + "andes" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Nom) => tal + "ad" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Gen) => tal + "ads" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Nom) => tal + "at" ;
|
||||
@@ -556,21 +750,15 @@ oper vTala : Str -> Verbum = \tal ->
|
||||
|
||||
oper vLeka : Str -> Verbum = \lek ->
|
||||
{s = table {
|
||||
VF (Pres Ind Act) => lek + "er" ;
|
||||
VF (Pres Ind Pass) => variants {lek + "s" ; lek + "es"} ;
|
||||
VF (Pres Cnj Act) => lek + "e" ;
|
||||
VF (Pres Cnj Pass) => lek + "es" ;
|
||||
VF (Pret Ind Act) => lek + "te" ;
|
||||
VF (Pret Ind Pass) => lek + "tes" ;
|
||||
VF (Pret Cnj Act) => lek + "te" ;
|
||||
VF (Pret Cnj Pass) => lek + "tes" ;
|
||||
VF Imper => lek ;
|
||||
VF (Pres Act) => lek + "er" ;
|
||||
VF (Pres Pass) => mkVoice Pass lek ;
|
||||
VF (Pret Act) => lek + "te" ;
|
||||
VF (Pret Pass) => lek + "tes" ;
|
||||
VF (Imper v) => mkVoice v lek ;
|
||||
VI (Inf Act) => lek + "a" ;
|
||||
VI (Inf Pass) => lek + "as" ;
|
||||
VI (Supin Act) => lek + "t" ;
|
||||
VI (Supin Pass) => lek + "ts" ;
|
||||
VI (PtPres Nom) => lek + "ande" ;
|
||||
VI (PtPres Gen) => lek + "andes" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Nom) => lek + "t" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Gen) => lek + "ts" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Nom) => lek + "t" ;
|
||||
@@ -588,21 +776,16 @@ oper vLeka : Str -> Verbum = \lek ->
|
||||
|
||||
oper vTyda : Str -> Verbum = \ty ->
|
||||
{s = table {
|
||||
VF (Pres Ind Act) => ty + "der" ;
|
||||
VF (Pres Ind Pass) => variants {ty + "ds" ; ty + "des"} ;
|
||||
VF (Pres Cnj Act) => ty + "de" ;
|
||||
VF (Pres Cnj Pass) => ty + "des" ;
|
||||
VF (Pret Ind Act) => ty + "dde" ;
|
||||
VF (Pret Ind Pass) => ty + "ddes" ;
|
||||
VF (Pret Cnj Act) => ty + "dde" ;
|
||||
VF (Pret Cnj Pass) => ty + "ddes" ;
|
||||
VF Imper => ty + "d" ;
|
||||
VF (Pres Act) => ty + "der" ;
|
||||
VF (Pres Pass) => variants {ty + "ds" ; ty + "des"} ;
|
||||
VF (Pret Act) => ty + "dde" ;
|
||||
VF (Pret Pass) => ty + "ddes" ;
|
||||
VF (Imper Act) => ty + "d" ;
|
||||
VF (Imper Pass) => ty + "ds" ;
|
||||
VI (Inf Act) => ty + "da" ;
|
||||
VI (Inf Pass) => ty + "das" ;
|
||||
VI (Supin Act) => ty + "tt" ;
|
||||
VI (Supin Pass) => ty + "tts" ;
|
||||
VI (PtPres Nom) => ty + "dande" ;
|
||||
VI (PtPres Gen) => ty + "dandes" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Nom) => ty + "dd" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Gen) => ty + "dds" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Nom) => ty + "tt" ;
|
||||
@@ -620,21 +803,16 @@ oper vTyda : Str -> Verbum = \ty ->
|
||||
|
||||
oper vVända : Str -> Verbum = \vän ->
|
||||
{s = table {
|
||||
VF (Pres Ind Act) => vän + "der" ;
|
||||
VF (Pres Ind Pass) => variants {vän + "ds" ; vän + "des"} ;
|
||||
VF (Pres Cnj Act) => vän + "de" ;
|
||||
VF (Pres Cnj Pass) => vän + "des" ;
|
||||
VF (Pret Ind Act) => vän + "de" ;
|
||||
VF (Pret Ind Pass) => vän + "des" ;
|
||||
VF (Pret Cnj Act) => vän + "de" ;
|
||||
VF (Pret Cnj Pass) => vän + "des" ;
|
||||
VF Imper => vän + "d" ;
|
||||
VF (Pres Act) => vän + "der" ;
|
||||
VF (Pres Pass) => variants {vän + "ds" ; vän + "des"} ;
|
||||
VF (Pret Act) => vän + "de" ;
|
||||
VF (Pret Pass) => vän + "des" ;
|
||||
VF (Imper Act) => vän + "d" ;
|
||||
VF (Imper Pass) => vän + "ds" ;
|
||||
VI (Inf Act) => vän + "da" ;
|
||||
VI (Inf Pass) => vän + "das" ;
|
||||
VI (Supin Act) => vän + "t" ;
|
||||
VI (Supin Pass) => vän + "ts" ;
|
||||
VI (PtPres Nom) => vän + "dande" ;
|
||||
VI (PtPres Gen) => vän + "dandes" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Nom) => vän + "d" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Gen) => vän + "ds" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Nom) => vän + "t" ;
|
||||
@@ -652,21 +830,16 @@ oper vV
|
||||
|
||||
oper vByta : Str -> Verbum = \by ->
|
||||
{s = table {
|
||||
VF (Pres Ind Act) => by + "ter" ;
|
||||
VF (Pres Ind Pass) => variants {by + "ts" ; by + "tes"} ;
|
||||
VF (Pres Cnj Act) => by + "te" ;
|
||||
VF (Pres Cnj Pass) => by + "tes" ;
|
||||
VF (Pret Ind Act) => by + "tte" ;
|
||||
VF (Pret Ind Pass) => by + "ttes" ;
|
||||
VF (Pret Cnj Act) => by + "tte" ;
|
||||
VF (Pret Cnj Pass) => by + "ttes" ;
|
||||
VF Imper => by + "t" ;
|
||||
VF (Pres Act) => by + "ter" ;
|
||||
VF (Pres Pass) => variants {by + "ts" ; by + "tes"} ;
|
||||
VF (Pret Act) => by + "tte" ;
|
||||
VF (Pret Pass) => by + "ttes" ;
|
||||
VF (Imper Act) => by + "t" ;
|
||||
VF (Imper Pass) => by + "ts" ;
|
||||
VI (Inf Act) => by + "ta" ;
|
||||
VI (Inf Pass) => by + "tas" ;
|
||||
VI (Supin Act) => by + "tt" ;
|
||||
VI (Supin Pass) => by + "tts" ;
|
||||
VI (PtPres Nom) => by + "tande" ;
|
||||
VI (PtPres Gen) => by + "tandes" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Nom) => by + "tt" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Gen) => by + "tts" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Nom) => by + "tt" ;
|
||||
@@ -682,55 +855,18 @@ oper vByta : Str -> Verbum = \by ->
|
||||
}
|
||||
} ;
|
||||
|
||||
oper vGömma : Str -> Verbum = \göm ->
|
||||
{s = table {
|
||||
VF (Pres Ind Act) => göm + "mer" ;
|
||||
VF (Pres Ind Pass) => variants {göm + "s" ; göm + "mes"} ;
|
||||
VF (Pres Cnj Act) => göm + "me" ;
|
||||
VF (Pres Cnj Pass) => göm + "mes" ;
|
||||
VF (Pret Ind Act) => göm + "de" ;
|
||||
VF (Pret Ind Pass) => göm + "des" ;
|
||||
VF (Pret Cnj Act) => göm + "de" ;
|
||||
VF (Pret Cnj Pass) => göm + "des" ;
|
||||
VF Imper => göm ;
|
||||
VI (Inf Act) => göm + "ma" ;
|
||||
VI (Inf Pass) => göm + "mas" ;
|
||||
VI (Supin Act) => göm + "t" ;
|
||||
VI (Supin Pass) => göm + "ts" ;
|
||||
VI (PtPres Nom) => göm + "mande" ;
|
||||
VI (PtPres Gen) => göm + "mandes" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Nom) => göm + "d" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Gen) => göm + "ds" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Nom) => göm + "t" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Gen) => göm + "ts" ;
|
||||
VI (PtPret (Strong APl) Nom) => göm + "da" ;
|
||||
VI (PtPret (Strong APl) Gen) => göm + "das" ;
|
||||
VI (PtPret (Weak (AxSg NoMasc)) Nom) => göm + "da" ;
|
||||
VI (PtPret (Weak (AxSg NoMasc)) Gen) => göm + "das" ;
|
||||
VI (PtPret (Weak (AxSg Masc)) Nom) => göm + "de" ;
|
||||
VI (PtPret (Weak (AxSg Masc)) Gen) => göm + "des" ;
|
||||
VI (PtPret (Weak AxPl) Nom) => göm + "da" ;
|
||||
VI (PtPret (Weak AxPl) Gen) => göm + "das"
|
||||
}
|
||||
} ;
|
||||
|
||||
oper vHyra : Str -> Verbum = \hyr ->
|
||||
{s = table {
|
||||
VF (Pres Ind Act) => hyr ;
|
||||
VF (Pres Ind Pass) => variants {hyr + "s" ; hyr + "es"} ;
|
||||
VF (Pres Cnj Act) => hyr + "e" ;
|
||||
VF (Pres Cnj Pass) => hyr + "es" ;
|
||||
VF (Pret Ind Act) => hyr + "de" ;
|
||||
VF (Pret Ind Pass) => hyr + "des" ;
|
||||
VF (Pret Cnj Act) => hyr + "de" ;
|
||||
VF (Pret Cnj Pass) => hyr + "des" ;
|
||||
VF Imper => hyr ;
|
||||
VF (Pres Act) => hyr ;
|
||||
VF (Pres Pass) => variants {hyr + "s" ; hyr + "es"} ;
|
||||
VF (Pret Act) => hyr + "de" ;
|
||||
VF (Pret Pass) => hyr + "des" ;
|
||||
VF (Imper Act) => hyr ;
|
||||
VF (Imper Pass) => hyr + "s" ;
|
||||
VI (Inf Act) => hyr + "a" ;
|
||||
VI (Inf Pass) => hyr + "as" ;
|
||||
VI (Supin Act) => hyr + "t" ;
|
||||
VI (Supin Pass) => hyr + "ts" ;
|
||||
VI (PtPres Nom) => hyr + "ande" ;
|
||||
VI (PtPres Gen) => hyr + "andes" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Nom) => hyr + "d" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Gen) => hyr + "ds" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Nom) => hyr + "t" ;
|
||||
@@ -746,70 +882,6 @@ oper vHyra : Str -> Verbum = \hyr ->
|
||||
}
|
||||
} ;
|
||||
|
||||
oper vTåla : Str -> Verbum = \tål ->
|
||||
{s = table {
|
||||
VF (Pres Ind Act) => tål ;
|
||||
VF (Pres Ind Pass) => variants {tål + "s" ; tål + "es"} ;
|
||||
VF (Pres Cnj Act) => tål + "e" ;
|
||||
VF (Pres Cnj Pass) => tål + "es" ;
|
||||
VF (Pret Ind Act) => tål + "de" ;
|
||||
VF (Pret Ind Pass) => tål + "des" ;
|
||||
VF (Pret Cnj Act) => tål + "de" ;
|
||||
VF (Pret Cnj Pass) => tål + "des" ;
|
||||
VF Imper => tål ;
|
||||
VI (Inf Act) => tål + "a" ;
|
||||
VI (Inf Pass) => tål + "as" ;
|
||||
VI (Supin Act) => tål + "t" ;
|
||||
VI (Supin Pass) => tål + "ts" ;
|
||||
VI (PtPres Nom) => tål + "ande" ;
|
||||
VI (PtPres Gen) => tål + "andes" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Nom) => tål + "d" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Gen) => tål + "ds" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Nom) => tål + "t" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Gen) => tål + "ts" ;
|
||||
VI (PtPret (Strong APl) Nom) => tål + "da" ;
|
||||
VI (PtPret (Strong APl) Gen) => tål + "das" ;
|
||||
VI (PtPret (Weak (AxSg NoMasc)) Nom) => tål + "da" ;
|
||||
VI (PtPret (Weak (AxSg NoMasc)) Gen) => tål + "das" ;
|
||||
VI (PtPret (Weak (AxSg Masc)) Nom) => tål + "de" ;
|
||||
VI (PtPret (Weak (AxSg Masc)) Gen) => tål + "des" ;
|
||||
VI (PtPret (Weak AxPl) Nom) => tål + "da" ;
|
||||
VI (PtPret (Weak AxPl) Gen) => tål + "das"
|
||||
}
|
||||
} ;
|
||||
|
||||
oper vFinna : (_,_,_ : Str) -> Verbum = \finn, fann, funn ->
|
||||
{s = table {
|
||||
VF (Pres Ind Act) => finn + "er" ;
|
||||
VF (Pres Ind Pass) => variants {finn + "s" ; finn + "es"} ;
|
||||
VF (Pres Cnj Act) => finn + "e" ;
|
||||
VF (Pres Cnj Pass) => finn + "es" ;
|
||||
VF (Pret Ind Act) => fann ;
|
||||
VF (Pret Ind Pass) => fann + "s" ;
|
||||
VF (Pret Cnj Act) => funn + "e" ;
|
||||
VF (Pret Cnj Pass) => funn + "es" ;
|
||||
VF Imper => finn ;
|
||||
VI (Inf Act) => finn + "a" ;
|
||||
VI (Inf Pass) => finn + "as" ;
|
||||
VI (Supin Act) => funn + "it" ;
|
||||
VI (Supin Pass) => funn + "its" ;
|
||||
VI (PtPres Nom) => finn + "ande" ;
|
||||
VI (PtPres Gen) => finn + "andes" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Nom) => funn + "en" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Gen) => funn + "ens" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Nom) => funn + "et" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Gen) => funn + "ets" ;
|
||||
VI (PtPret (Strong APl) Nom) => funn + "a" ;
|
||||
VI (PtPret (Strong APl) Gen) => funn + "as" ;
|
||||
VI (PtPret (Weak (AxSg NoMasc)) Nom) => funn + "a" ;
|
||||
VI (PtPret (Weak (AxSg NoMasc)) Gen) => funn + "as" ;
|
||||
VI (PtPret (Weak (AxSg Masc)) Nom) => funn + "e" ;
|
||||
VI (PtPret (Weak (AxSg Masc)) Gen) => funn + "es" ;
|
||||
VI (PtPret (Weak AxPl) Nom) => funn + "a" ;
|
||||
VI (PtPret (Weak AxPl) Gen) => funn + "as"
|
||||
}
|
||||
} ;
|
||||
|
||||
-- machine-generated exceptional inflection tables from rules.Swe.gf
|
||||
|
||||
oper mor_1 : Subst =
|
||||
@@ -1065,86 +1137,18 @@ oper liten_1146 : Adj =
|
||||
}
|
||||
} ;
|
||||
|
||||
oper giva_1147 : Verbum =
|
||||
{s = table {
|
||||
VF (Pres Ind Act) => variants {"giver" ; "ger"} ;
|
||||
VF (Pres Ind Pass) => variants {"gives" ; "givs" ; "ges"} ;
|
||||
VF (Pres Conj Act) => "give" ;
|
||||
VF (Pres Conj Pass) => "gives" ;
|
||||
VF (Pret Ind Act) => "gav" ;
|
||||
VF (Pret Ind Pass) => "gavs" ;
|
||||
VF (Pret Conj Act) => "give" ;
|
||||
VF (Pret Conj Pass) => "gives" ;
|
||||
VF Imper => variants {"giv" ; "ge"} ;
|
||||
VI (Inf Act) => variants {"giva" ; "ge"} ;
|
||||
VI (Inf Pass) => variants {"givas" ; "ges"} ;
|
||||
VI (Supin Act) => "givit" ;
|
||||
VI (Supin Pass) => "givits" ;
|
||||
VI (PtPres Nom) => "givande" ;
|
||||
VI (PtPres Gen) => "givandes" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Nom) => "given" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Gen) => "givens" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Nom) => "givet" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Gen) => "givets" ;
|
||||
VI (PtPret (Strong APl) Nom) => "givna" ;
|
||||
VI (PtPret (Strong APl) Gen) => "givnas" ;
|
||||
VI (PtPret (Weak (AxSg NoMasc)) Nom) => "givna" ;
|
||||
VI (PtPret (Weak (AxSg NoMasc)) Gen) => "givnas" ;
|
||||
VI (PtPret (Weak (AxSg Masc)) Nom) => "givne" ;
|
||||
VI (PtPret (Weak (AxSg Masc)) Gen) => "givnes" ;
|
||||
VI (PtPret (Weak AxPl) Nom) => "givna" ;
|
||||
VI (PtPret (Weak AxPl) Gen) => "givnas"
|
||||
}
|
||||
} ;
|
||||
|
||||
oper gå_1174 : Verbum =
|
||||
{s = table {
|
||||
VF (Pres Ind Act) => "går" ;
|
||||
VF (Pres Ind Pass) => "gås" ;
|
||||
VF (Pres Cnj Act) => "gå" ;
|
||||
VF (Pres Cnj Pass) => "gås" ;
|
||||
VF (Pret Ind Act) => "gick" ;
|
||||
VF (Pret Ind Pass) => "gicks" ;
|
||||
VF (Pret Cnj Act) => "ginge" ;
|
||||
VF (Pret Cnj Pass) => "ginges" ;
|
||||
VF Imper => "gå" ;
|
||||
VI (Inf Act) => "gå" ;
|
||||
VI (Inf Pass) => "gås" ;
|
||||
VI (Supin Act) => "gått" ;
|
||||
VI (Supin Pass) => "gåtts" ;
|
||||
VI (PtPres Nom) => "gående" ;
|
||||
VI (PtPres Gen) => "gåendes" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Nom) => "gången" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Gen) => "gångens" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Nom) => "gånget" ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Gen) => "gångets" ;
|
||||
VI (PtPret (Strong APl) Nom) => "gångna" ;
|
||||
VI (PtPret (Strong APl) Gen) => "gångnas" ;
|
||||
VI (PtPret (Weak (AxSg NoMasc)) Nom) => "gångna" ;
|
||||
VI (PtPret (Weak (AxSg NoMasc)) Gen) => "gångnas" ;
|
||||
VI (PtPret (Weak (AxSg Masc)) Nom) => "gångne" ;
|
||||
VI (PtPret (Weak (AxSg Masc)) Gen) => "gångnes" ;
|
||||
VI (PtPret (Weak AxPl) Nom) => "gångna" ;
|
||||
VI (PtPret (Weak AxPl) Gen) => "gångnas"
|
||||
}
|
||||
} ;
|
||||
oper hava_1198 : Verbum =
|
||||
{s = table {
|
||||
VF (Pres Ind Act) => variants {"haver" ; "har"} ;
|
||||
VF (Pres Ind Pass) => variants {"havs" ; "has"} ;
|
||||
VF (Pres Conj Act) => "have" ;
|
||||
VF (Pres Conj Pass) => "haves" ;
|
||||
VF (Pret Ind Act) => "hade" ;
|
||||
VF (Pret Ind Pass) => "hades" ;
|
||||
VF (Pret Conj Act) => "hade" ;
|
||||
VF (Pret Conj Pass) => "hades" ;
|
||||
VF Imper => variants {"hav" ; "ha"} ;
|
||||
VI (Inf Act) => variants {"hava" ; "ha"} ;
|
||||
VI (Inf Pass) => variants {"havas" ; "has"} ;
|
||||
VF (Pres Act) => "har" ;
|
||||
VF (Pres Pass) => "has" ;
|
||||
VF (Pret Act) => "hade" ;
|
||||
VF (Pret Pass) => "hades" ;
|
||||
VF (Imper Act) => "ha" ;
|
||||
VF (Imper Pass) => "has" ;
|
||||
VI (Inf Act) => "ha" ;
|
||||
VI (Inf Pass) => "has" ;
|
||||
VI (Supin Act) => "haft" ;
|
||||
VI (Supin Pass) => "hafts" ;
|
||||
VI (PtPres Nom) => "havande" ;
|
||||
VI (PtPres Gen) => "havandes" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Nom) => variants {} ;
|
||||
VI (PtPret (Strong (ASg Utr)) Gen) => variants {} ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Nom) => variants {} ;
|
||||
@@ -1162,21 +1166,15 @@ oper hava_1198 : Verbum =
|
||||
|
||||
oper vara_1200 : Verbum =
|
||||
{s = table {
|
||||
VF (Pres Ind Act) => "är" ;
|
||||
VF (Pres Ind Pass) => variants {} ;
|
||||
VF (Pres Conj Act) => "vare" ;
|
||||
VF (Pres Conj Pass) => variants {} ;
|
||||
VF (Pret Ind Act) => "var" ;
|
||||
VF (Pret Ind Pass) => variants {} ;
|
||||
VF (Pret Conj Act) => "vore" ;
|
||||
VF (Pret Conj Pass) => variants {} ;
|
||||
VF Imper => "var" ;
|
||||
VF (Pres Act) => "är" ;
|
||||
VF (Pres Pass) => variants {} ;
|
||||
VF (Pret Act) => "var" ;
|
||||
VF (Pret Pass) => variants {} ;
|
||||
VF (Imper _) => "var" ;
|
||||
VI (Inf Act) => "vara" ;
|
||||
VI (Inf Pass) => variants {} ;
|
||||
VI (Supin Act) => "varit" ;
|
||||
VI (Supin Pass) => variants {} ;
|
||||
VI (PtPres Nom) => "varande" ;
|
||||
VI (PtPres Gen) => "varandes" ;
|
||||
VI (PtPret (Strong (ASg Utr)) Nom) => variants {} ;
|
||||
VI (PtPret (Strong (ASg Utr)) Gen) => variants {} ;
|
||||
VI (PtPret (Strong (ASg Neutr)) Nom) => variants {} ;
|
||||
@@ -1205,6 +1203,4 @@ oper
|
||||
regTal : Str -> LinDigit = \fem ->
|
||||
mkTal fem (fem + "ton") (fem + "tio") ;
|
||||
|
||||
|
||||
|
||||
}
|
||||
|
||||
348
lib/resource/swedish/NewParadigmsSwe.gf
Normal file
348
lib/resource/swedish/NewParadigmsSwe.gf
Normal file
@@ -0,0 +1,348 @@
|
||||
--# -path=.:../scandinavian:../abstract:../../prelude
|
||||
|
||||
--1 Swedish Lexical Paradigms UNDER RECONSTRUCTION!
|
||||
--
|
||||
-- Aarne Ranta 2003
|
||||
--
|
||||
-- This is an API to the user of the resource grammar
|
||||
-- for adding lexical items. It gives functions for forming
|
||||
-- expressions of open categories: nouns, adjectives, verbs.
|
||||
--
|
||||
-- Closed categories (determiners, pronouns, conjunctions) are
|
||||
-- accessed through the resource syntax API, $Structural.gf$.
|
||||
--
|
||||
-- The main difference with $MorphoEng.gf$ is that the types
|
||||
-- referred to are compiled resource grammar types. We have moreover
|
||||
-- had the design principle of always having existing forms, rather
|
||||
-- than stems, as string arguments of the paradigms.
|
||||
--
|
||||
-- The structure of functions for each word class $C$ is the following:
|
||||
-- first we give a handful of patterns that aim to cover all
|
||||
-- regular cases. Then we give a worst-case function $mkC$, which serves as an
|
||||
-- escape to construct the most irregular words of type $C$.
|
||||
-- However, this function should only seldom be needed: we have a
|
||||
-- separate module $IrregularEng$, which covers all irregularly inflected
|
||||
-- words.
|
||||
--
|
||||
-- The following modules are presupposed:
|
||||
|
||||
resource NewParadigmsSwe =
|
||||
open (Predef=Predef), Prelude, TypesSwe, MorphoSwe, SyntaxSwe, ResourceSwe in {
|
||||
|
||||
--2 Parameters
|
||||
--
|
||||
-- To abstract over gender names, we define the following identifiers.
|
||||
|
||||
oper
|
||||
Gender : Type ;
|
||||
|
||||
utrum : Gender ;
|
||||
neutrum : Gender ;
|
||||
|
||||
-- To abstract over number names, we define the following.
|
||||
|
||||
Number : Type ;
|
||||
|
||||
singular : Number ;
|
||||
plural : Number ;
|
||||
|
||||
-- To abstract over case names, we define the following.
|
||||
|
||||
Case : Type ;
|
||||
|
||||
nominative : Case ;
|
||||
genitive : Case ;
|
||||
|
||||
-- Prepositions used in many-argument functions are just strings.
|
||||
|
||||
Preposition : Type = Str ;
|
||||
|
||||
--2 Nouns
|
||||
|
||||
-- Worst case: give all four forms. The gender is computed from the
|
||||
-- last letter of the second form (if "n", then $utrum$, otherwise $neutrum$).
|
||||
|
||||
mkN : (apa,apan,apor,aporna : Str) -> N ;
|
||||
|
||||
-- The regular function takes the singular indefinite form and the gender,
|
||||
-- and computes the other forms by a heuristic.
|
||||
-- If in doubt, use the $cc$ command to test!
|
||||
|
||||
regN : Str -> Gender -> N ;
|
||||
|
||||
-- In practice the worst case is often just: give singular and plural indefinite.
|
||||
|
||||
mk2N : (nyckel,nycklar : Str) -> N ;
|
||||
|
||||
-- All nouns created by the previous functions are marked as
|
||||
-- $nonmasculine$. If you want a $masculine$ noun, wrap it with the following
|
||||
-- function:
|
||||
|
||||
mascN : N -> N ;
|
||||
|
||||
--3 Compound nouns
|
||||
--
|
||||
-- All the functions above work quite as well to form compound nouns,
|
||||
-- such as "fotboll".
|
||||
|
||||
|
||||
--3 Relational nouns
|
||||
--
|
||||
-- Relational nouns ("daughter of x") need a preposition.
|
||||
|
||||
mkN2 : N -> Preposition -> N2 ;
|
||||
|
||||
-- The most common preposition is "av", and the following is a
|
||||
-- shortcut for regular, $nonhuman$ relational nouns with "av".
|
||||
|
||||
regN2 : Str -> Gender -> N2 ;
|
||||
|
||||
-- Use the function $mkPreposition$ or see the section on prepositions below to
|
||||
-- form other prepositions.
|
||||
--
|
||||
-- Three-place relational nouns ("the connection from x to y") need two prepositions.
|
||||
|
||||
mkN3 : N -> Preposition -> Preposition -> N3 ;
|
||||
|
||||
|
||||
--3 Relational common noun phrases
|
||||
--
|
||||
-- In some cases, you may want to make a complex $CN$ into a
|
||||
-- relational noun (e.g. "the old town hall of").
|
||||
|
||||
cnN2 : CN -> Preposition -> N2 ;
|
||||
cnN3 : CN -> Preposition -> Preposition -> N3 ;
|
||||
|
||||
--
|
||||
--3 Proper names and noun phrases
|
||||
--
|
||||
-- Proper names, with a regular genitive, are formed as follows
|
||||
|
||||
regPN : Str -> Gender -> PN ; -- John, John's
|
||||
|
||||
-- To form a noun phrase that can also be plural and have an irregular
|
||||
-- genitive, you can use the worst-case function.
|
||||
|
||||
mkNP : Str -> Str -> Number -> Gender -> NP ;
|
||||
|
||||
--2 Adjectives
|
||||
|
||||
-- Non-comparison one-place adjectives need for forms:
|
||||
|
||||
mkA : (galen,galet,galna : Str) -> A ;
|
||||
|
||||
-- For regular adjectives, the other forms are derived.
|
||||
|
||||
regA : Str -> A ;
|
||||
|
||||
-- In practice, two forms are enough.
|
||||
|
||||
mk2A : (bred,brett : Str) -> A ;
|
||||
|
||||
--3 Two-place adjectives
|
||||
--
|
||||
-- Two-place adjectives need a preposition for their second argument.
|
||||
|
||||
mkA2 : A -> Preposition -> A2 ;
|
||||
|
||||
-- Comparison adjectives may need as many as seven forms.
|
||||
|
||||
mkADeg : (liten, litet, lilla, sma, mindre, minst, minsta : Str) -> ADeg ;
|
||||
|
||||
-- The regular pattern works for many adjectives, e.g. those ending
|
||||
-- with "ig".
|
||||
|
||||
regADeg : Str -> ADeg ;
|
||||
|
||||
-- Just the comparison forms can be irregular.
|
||||
|
||||
irregADeg : (tung,tyngre,tyngst : Str) -> ADeg ;
|
||||
|
||||
-- Sometimes just the positive forms are irregular.
|
||||
|
||||
mk3ADeg : (galen,galet,galna : Str) -> ADeg ;
|
||||
mk2ADeg : (bred,brett : Str) -> ADeg ;
|
||||
|
||||
-- If comparison is formed by "more, "most", as in general for
|
||||
-- long adjective, the following pattern is used:
|
||||
|
||||
compoundADeg : A -> ADeg ; -- -/more/most ridiculous
|
||||
|
||||
-- From a given $ADeg$, it is possible to get back to $A$.
|
||||
|
||||
adegA : ADeg -> A ;
|
||||
|
||||
|
||||
--2 Adverbs
|
||||
|
||||
-- Adverbs are not inflected. Most lexical ones have position
|
||||
-- after the verb. Some can be preverbal (e.g. "always").
|
||||
|
||||
mkAdv : Str -> Adv ;
|
||||
mkAdV : Str -> AdV ;
|
||||
|
||||
-- Adverbs modifying adjectives and sentences can also be formed.
|
||||
|
||||
mkAdA : Str -> AdA ;
|
||||
|
||||
--2 Prepositions
|
||||
--
|
||||
-- A preposition is just a string.
|
||||
|
||||
mkPreposition : Str -> Preposition ;
|
||||
|
||||
--2 Verbs
|
||||
--
|
||||
-- The worst case needs five forms.
|
||||
|
||||
mkV : (supa,super,sup,söp,supit,supen : Str) -> V ;
|
||||
|
||||
-- The 'regular verb' function is the first conjugation.
|
||||
|
||||
regV : (tala : Str) -> V ;
|
||||
|
||||
-- The almost regular verb function needs the infinitive and the present.
|
||||
|
||||
mk2V : (leka,leker : Str) -> V ;
|
||||
|
||||
-- There is an extensive list of irregular verbs in the module $IrregularSwe$.
|
||||
-- In practice, it is enough to give three forms, as in school books.
|
||||
|
||||
irregV : (dricka, drack, druckit : Str) -> V ;
|
||||
|
||||
|
||||
--3 Verbs with a particle.
|
||||
--
|
||||
-- The particle, such as in "switch on", is given as a string.
|
||||
|
||||
partV : V -> Str -> V ;
|
||||
|
||||
--3 Deponent verbs.
|
||||
--
|
||||
-- Some words are used in passive forms only, e.g. "hoppas".
|
||||
|
||||
depV : V -> V ;
|
||||
|
||||
--3 Two-place verbs
|
||||
--
|
||||
-- Two-place verbs need a preposition, except the special case with direct object.
|
||||
-- (transitive verbs). Notice that a particle comes from the $V$.
|
||||
|
||||
mkV2 : V -> Preposition -> V2 ;
|
||||
|
||||
dirV2 : V -> V2 ;
|
||||
|
||||
--3 Three-place verbs
|
||||
--
|
||||
-- Three-place (ditransitive) verbs need two prepositions, of which
|
||||
-- the first one or both can be absent.
|
||||
|
||||
mkV3 : V -> Str -> Str -> V3 ; -- speak, with, about
|
||||
dirV3 : V -> Str -> V3 ; -- give,_,to
|
||||
dirdirV3 : V -> V3 ; -- give,_,_
|
||||
|
||||
--3 Other complement patterns
|
||||
--
|
||||
-- Verbs and adjectives can take complements such as sentences,
|
||||
-- questions, verb phrases, and adjectives.
|
||||
|
||||
mkV0 : V -> V0 ;
|
||||
mkVS : V -> VS ;
|
||||
mkV2S : V -> Str -> V2S ;
|
||||
mkVV : V -> VV ;
|
||||
mkV2V : V -> Str -> Str -> V2V ;
|
||||
mkVA : V -> VA ;
|
||||
mkV2A : V -> Str -> V2A ;
|
||||
mkVQ : V -> VQ ;
|
||||
mkV2Q : V -> Str -> V2Q ;
|
||||
|
||||
mkAS : A -> AS ;
|
||||
mkA2S : A -> Str -> A2S ;
|
||||
mkAV : A -> AV ;
|
||||
mkA2V : A -> Str -> A2V ;
|
||||
|
||||
|
||||
--2 Definitions of the paradigms
|
||||
--
|
||||
-- The definitions should not bother the user of the API. So they are
|
||||
-- hidden from the document.
|
||||
--.
|
||||
|
||||
Gender = SyntaxSwe.NounGender ;
|
||||
Number = TypesSwe.Number ;
|
||||
Case = TypesSwe.Case ;
|
||||
utrum = NUtr NoMasc ;
|
||||
neutrum = NNeutr ;
|
||||
singular = Sg ;
|
||||
plural = Pl ;
|
||||
nominative = Nom ;
|
||||
genitive = Gen ;
|
||||
|
||||
mkN x y z u = extCommNoun (mkNoun x y z u) ** {lock_N = <>} ;
|
||||
regN x g = extCommNoun (regNoun x (genNoun g)) ** {lock_N = <>} ;
|
||||
mk2N x g = extCommNoun (reg2Noun x g) ** {lock_N = <>} ;
|
||||
mascN n = {s = n.s ; g = NUtr Masc ; lock_N = <>} ;
|
||||
|
||||
mkN2 = \n,p -> UseN n ** {lock_N2 = <> ; s2 = p} ;
|
||||
regN2 n g = mkN2 (regN n g) (mkPreposition "av") ;
|
||||
mkN3 = \n,p,q -> UseN n ** {lock_N3 = <> ; s2 = p ; s3 = q} ;
|
||||
cnN2 = \n,p -> n ** {lock_N2 = <> ; s2 = p} ;
|
||||
cnN3 = \n,p,q -> n ** {lock_N3 = <> ; s2 = p ; s3 = q} ;
|
||||
|
||||
regPN n g = {s = \\c => mkCase c n ; g = g} ** {lock_PN = <>} ;
|
||||
mkNP x y n g =
|
||||
{s = table {PGen _ => x ; _ => y} ; g = genNoun g ; n = n ; p = P3 ;
|
||||
lock_NP = <>} ;
|
||||
|
||||
mkA a b c = extractPositive (adjAlmostReg a b c) ** {lock_A = <>} ;
|
||||
mk2A a b = extractPositive (adj2Reg a b) ** {lock_A = <>} ;
|
||||
regA a = extractPositive (adjReg a) ** {lock_A = <>} ;
|
||||
|
||||
mkA2 a p = a ** {s2 = p ; lock_A2 = <>} ;
|
||||
|
||||
mkADeg a b c d e f g = mkAdjective a b c d e f g ** {lock_ADeg = <>} ;
|
||||
regADeg a = adjReg a ** {lock_ADeg = <>} ;
|
||||
irregADeg a b c = adjIrreg3 a b c ** {lock_ADeg = <>} ;
|
||||
mk3ADeg a b c = adjAlmostReg a b c ** {lock_ADeg = <>} ;
|
||||
mk2ADeg a b = adj2Reg a b ** {lock_ADeg = <>} ;
|
||||
|
||||
mkAdv x = ss x ** {lock_Adv = <>} ;
|
||||
mkAdV x = ss x ** {lock_AdV = <>} ;
|
||||
mkAdA x = ss x ** {lock_AdA = <>} ;
|
||||
|
||||
mkPreposition p = p ;
|
||||
|
||||
mkV a b c d e f = mkVerb a b c d e f ** {s1 = [] ; lock_V = <>} ;
|
||||
|
||||
regV a = mk2V a (a + "r") ;
|
||||
mk2V a b = regVerb a b ** {s1 = [] ; lock_V = <>} ;
|
||||
|
||||
irregV x y z = vSälja x y z
|
||||
** {s1 = [] ; lock_V = <>} ;
|
||||
|
||||
partV v p = {s = v.s ; s1 = p ; lock_V = <>} ;
|
||||
depV v = deponentVerb v ** {lock_V = <>} ;
|
||||
|
||||
mkV2 v p = v ** {s = v.s ; s1 = v.s1 ; s2 = p ; lock_V2 = <>} ;
|
||||
dirV2 v = mkV2 v [] ;
|
||||
|
||||
mkV3 v p q = v ** {s = v.s ; s1 = v.s1 ; s2 = p ; s3 = q ; lock_V3 = <>} ;
|
||||
dirV3 v p = mkV3 v [] p ;
|
||||
dirdirV3 v = dirV3 v [] ;
|
||||
|
||||
mkV0 v = v ** {lock_V0 = <>} ;
|
||||
mkVS v = v ** {lock_VS = <>} ;
|
||||
mkV2S v p = mkV2 v p ** {lock_V2S = <>} ;
|
||||
mkVV v = v ** {s3 = "att" ; lock_VV = <>} ;
|
||||
mkV2V v p t = mkV2 v p ** {s3 = t ; lock_V2V = <>} ;
|
||||
mkVA v = v ** {lock_VA = <>} ;
|
||||
mkV2A v p = mkV2 v p ** {lock_V2A = <>} ;
|
||||
mkVQ v = v ** {lock_VQ = <>} ;
|
||||
mkV2Q v p = mkV2 v p ** {lock_V2Q = <>} ;
|
||||
|
||||
mkAS v = v ** {lock_AS = <>} ;
|
||||
mkA2S v p = mkA2 v p ** {lock_A2S = <>} ;
|
||||
mkAV v = v ** {lock_AV = <>} ;
|
||||
mkA2V v p = mkA2 v p ** {lock_A2V = <>} ;
|
||||
|
||||
} ;
|
||||
@@ -1,4 +1,4 @@
|
||||
--# -path=.:../scandinavian:../abstract:../../prelude
|
||||
|
||||
concrete RulesSwe of Rules =
|
||||
concrete RulesSwe of Rules = CategoriesSwe **
|
||||
RulesScand with (SyntaxScand=SyntaxSwe) ;
|
||||
|
||||
@@ -26,17 +26,6 @@ instance SyntaxSwe of SyntaxScand = TypesSwe **
|
||||
<Def, Pl> => Weak AxPl
|
||||
} ;
|
||||
|
||||
deponentVerb : Verb -> Verb = \finna -> {
|
||||
s = table {
|
||||
VF (Pres m _) => finna.s ! VF (Pres m Pass) ;
|
||||
VF (Pret m _) => finna.s ! VF (Pret m Pass) ;
|
||||
VI (Inf _) => finna.s ! VI (Inf Pass) ;
|
||||
VI (Supin _) => finna.s ! VI (Supin Pass) ;
|
||||
v => finna.s ! v --- Imper !
|
||||
} ;
|
||||
s1 = finna.s1
|
||||
} ;
|
||||
|
||||
verbVara = vara_1200 ** {s1 = []} ;
|
||||
verbHava = hava_1198 ** {s1 = []};
|
||||
|
||||
@@ -118,10 +107,6 @@ instance SyntaxSwe of SyntaxScand = TypesSwe **
|
||||
|
||||
-- next
|
||||
|
||||
adjPastPart : Verb -> Adjective = \verb -> {
|
||||
s = \\af,c => verb.s1 ++ verb.s ! VI (PtPret af c) --- på slagen
|
||||
} ;
|
||||
|
||||
reflPron : Number -> Person -> Str = \n,p -> case <n,p> of {
|
||||
<Sg,P1> => "mig" ;
|
||||
<Sg,P2> => "dig" ;
|
||||
@@ -135,4 +120,14 @@ instance SyntaxSwe of SyntaxScand = TypesSwe **
|
||||
(mkVerb "hålla" "håller" "håll" "höll" "hållit" "hållen" **
|
||||
{s3 = ["på att"]})
|
||||
(predVerbGroup True Simul verb) ;
|
||||
|
||||
strPrep : ComplPrep -> Str = \p -> case p of {
|
||||
CPnoPrep => [] ;
|
||||
CPav => "av" ;
|
||||
CPför => "för" ;
|
||||
CPi => "i" ;
|
||||
CPom => "om" ;
|
||||
CPpå => "på" ;
|
||||
CPtill => "till"
|
||||
} ;
|
||||
}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
--# -path=.:../scandinavian:../abstract:../../prelude
|
||||
|
||||
concrete TestResourceSwe of TestResource =
|
||||
-- RulesSwe,
|
||||
RulesSwe,
|
||||
ClauseSwe,
|
||||
StructuralSwe
|
||||
**
|
||||
@@ -28,17 +28,17 @@ lin
|
||||
House = extCommNoun (sHus "hus") ;
|
||||
Light = extCommNoun (sHus "ljus") ;
|
||||
Wine = extCommNoun (sParti "vin") ;
|
||||
Walk = vNopart gå_1174 ;
|
||||
Walk = vNopart (mkVerb "gå" "går" "gå" "gick" "gått" "gången") ;
|
||||
Run = vNopart (vFinna "spring" "sprang" "sprung") ;
|
||||
Drink = extTransVerb (vFinna "drick" "drack" "druck") [] ;
|
||||
Love = extTransVerb (vNopart (vTala "älsk")) [] ;
|
||||
Send = extTransVerb (vNopart (vTala "skick")) [] ;
|
||||
Wait = extTransVerb (vNopart (vTala "vänt")) "på" ;
|
||||
Give = extTransVerb (vNopart (vFinna "giv" "gav" "giv")) [] ** {s3 = "till"} ; --- ge
|
||||
Give = extTransVerb (vNopart (mkVerb "ge" "ger" "ge" "gav" "givit" "given")) [] ** {s3 = "till"} ;
|
||||
Prefer = extTransVerb (vNopart (vFinna "föredrag" "föredrog" "föredrag")) [] **
|
||||
{s3 = "framför"} ; --- föredra
|
||||
|
||||
Say = vNopart (vLeka "säg") ; --- works in present tense...
|
||||
Say = vNopart (mkVerb "säga" "säger" "säg" "sade" "sagt" "sagd") ;
|
||||
Prove = vNopart (vTala "bevis") ;
|
||||
SwitchOn = mkDirectVerb (vFinna "sätt" "satte" "satt" ** {s1 = "på"}) ;
|
||||
SwitchOff = mkDirectVerb (vLeka "stäng" ** {s1 = "av"}) ;
|
||||
|
||||
@@ -23,14 +23,4 @@ oper
|
||||
param
|
||||
AdjFormPos = Strong GenNum | Weak SexNum ;
|
||||
|
||||
VFin =
|
||||
Pres Mode Voice
|
||||
| Pret Mode Voice
|
||||
| Imper ; --- no passive
|
||||
|
||||
VInf =
|
||||
Inf Voice
|
||||
| Supin Voice
|
||||
| PtPres Case
|
||||
| PtPret AdjFormPos Case ;
|
||||
}
|
||||
|
||||
@@ -165,12 +165,13 @@ extendCompileEnvCanon ((k,s,c),fts) cgr ft =
|
||||
type TimedCompileEnv = (CompileEnv,[(FilePath,ModTime)])
|
||||
|
||||
compileOne :: Options -> TimedCompileEnv -> FullPath -> IOE TimedCompileEnv
|
||||
compileOne opts env file = do
|
||||
compileOne opts env@((_,srcgr,_),_) file = do
|
||||
|
||||
let putp = putPointE opts
|
||||
let gf = fileSuffix file
|
||||
let path = justInitPath file
|
||||
let name = fileBody file
|
||||
let mos = modules srcgr
|
||||
|
||||
case gf of
|
||||
-- for multilingual canonical gf, just read the file and update environment
|
||||
@@ -188,12 +189,13 @@ compileOne opts env file = do
|
||||
|
||||
-- for compiled resource, parse and organize, then update environment
|
||||
"gfr" -> do
|
||||
sm0 <- putp ("| parsing" +++ file) $ getSourceModule file
|
||||
let mos = case env of ((_,gr,_),_) -> modules gr
|
||||
sm0 <- putp ("| parsing" +++ file) $ getSourceModule file
|
||||
sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm0
|
||||
---- experiment with not optimizing gfr
|
||||
---- sm:_ <- putp " optimizing " $ ioeErr $ evalModule mos sm1
|
||||
let gfc = gfcFile name
|
||||
cm <- putp ("+ reading" +++ gfc) $ getCanonModule gfc
|
||||
ft <- getReadTimes file
|
||||
cm <- putp ("+ reading" +++ gfc) $ getCanonModule gfc
|
||||
ft <- getReadTimes file
|
||||
extendCompileEnv env (sm,cm) ft
|
||||
|
||||
-- for gf source, do full compilation
|
||||
@@ -202,7 +204,12 @@ compileOne opts env file = do
|
||||
(k',sm) <- makeSourceModule opts (fst env) sm0
|
||||
cm <- putp " generating code... " $ generateModuleCode opts path sm
|
||||
ft <- getReadTimes file
|
||||
extendCompileEnvInt env (k',sm,cm) ft
|
||||
|
||||
sm':_ <- case snd sm of
|
||||
---- ModMod n | isModRes n -> putp " optimizing " $ ioeErr $ evalModule mos sm
|
||||
_ -> return [sm]
|
||||
|
||||
extendCompileEnvInt env (k',sm',cm) ft
|
||||
|
||||
-- dispatch reused resource at early stage
|
||||
|
||||
@@ -255,8 +262,11 @@ compileSourceModule opts env@(k,gr,can) mo@(i,mi) = do
|
||||
|
||||
(k',mo3r:_) <- ioeErr $ refreshModule (k,mos) mo3
|
||||
|
||||
mo4:_ <- putp " optimizing " $ ioeErr $ evalModule mos mo3r
|
||||
|
||||
mo4:_ <-
|
||||
---- case snd mo1b of
|
||||
---- ModMod n | isModCnc n ->
|
||||
putp " optimizing " $ ioeErr $ evalModule mos mo3r
|
||||
---- _ -> return [mo3r]
|
||||
return (k',mo4)
|
||||
where
|
||||
---- prDebug mo = ioeIO $ putStrLn $ prGrammar $ MGrammar [mo] ---- debug
|
||||
|
||||
@@ -31,6 +31,12 @@ import Monad
|
||||
|
||||
extendModule :: [SourceModule] -> SourceModule -> Err SourceModule
|
||||
extendModule ms (name,mod) = case mod of
|
||||
|
||||
---- Just to allow inheritance in incomplete concrete (which are not
|
||||
---- compiled anyway), extensions are not built for them.
|
||||
---- Should be replaced by real control. AR 4/2/2005
|
||||
ModMod m | mstatus m == MSIncomplete && isModCnc m -> return (name,mod)
|
||||
|
||||
ModMod m -> do
|
||||
mod' <- foldM extOne m (extends m)
|
||||
return (name,ModMod mod')
|
||||
@@ -42,10 +48,11 @@ extendModule ms (name,mod) = case mod of
|
||||
-- test that the module types match, and find out if the old is complete
|
||||
testErr (sameMType (mtype m) mt)
|
||||
("illegal extension type to module" +++ prt name)
|
||||
return (m,isCompleteModule m)
|
||||
return (m, isCompleteModule m)
|
||||
---- return (m, if (isCompleteModule m) then True else not (isCompleteModule mod))
|
||||
|
||||
-- build extension in a way depending on whether the old module is complete
|
||||
js1 <- extendMod isCompl n (jments m0) js
|
||||
js1 <- extendMod isCompl n name (jments m0) js
|
||||
|
||||
-- if incomplete, throw away extension information
|
||||
let me' = if isCompl then es else (filter (/=n) es)
|
||||
@@ -55,11 +62,11 @@ extendModule ms (name,mod) = case mod of
|
||||
-- and the process is interrupted if unification fails.
|
||||
-- If the extended module is incomplete, its judgements are just copied.
|
||||
|
||||
extendMod :: Bool -> Ident -> BinTree (Ident,Info) -> BinTree (Ident,Info) ->
|
||||
extendMod :: Bool -> Ident -> Ident -> BinTree (Ident,Info) -> BinTree (Ident,Info) ->
|
||||
Err (BinTree (Ident,Info))
|
||||
extendMod isCompl name old new = foldM try new $ tree2list old where
|
||||
extendMod isCompl name base old new = foldM try new $ tree2list old where
|
||||
try t i@(c,_) = errIn ("constant" +++ prt c) $
|
||||
tryInsert (extendAnyInfo isCompl name) indirIf t i
|
||||
tryInsert (extendAnyInfo isCompl name base) indirIf t i
|
||||
indirIf = if isCompl then indirInfo name else id
|
||||
|
||||
indirInfo :: Ident -> Info -> Info
|
||||
@@ -76,8 +83,9 @@ perhIndir n p = case p of
|
||||
Yes _ -> May n
|
||||
_ -> p
|
||||
|
||||
extendAnyInfo :: Bool -> Ident -> Info -> Info -> Err Info
|
||||
extendAnyInfo isc n i j = errIn ("building extension for" +++ prt n) $ case (i,j) of
|
||||
extendAnyInfo :: Bool -> Ident -> Ident -> Info -> Info -> Err Info
|
||||
extendAnyInfo isc n o i j =
|
||||
errIn ("building extension for" +++ prt n +++ "in" +++ prt o) $ case (i,j) of
|
||||
(AbsCat mc1 mf1, AbsCat mc2 mf2) ->
|
||||
liftM2 AbsCat (updn isc n mc1 mc2) (updn isc n mf1 mf2) --- add cstrs
|
||||
(AbsFun mt1 md1, AbsFun mt2 md2) ->
|
||||
@@ -107,7 +115,8 @@ extendAnyInfo isc n i j = errIn ("building extension for" +++ prt n) $ case (i,j
|
||||
|
||||
--- where
|
||||
|
||||
updn isc n = if isc then (updatePerhaps n) else (updatePerhapsHard n)
|
||||
updn isc n = if isc then (updatePerhaps n) else (updatePerhapsHard n)
|
||||
updc isc n = if True then (updatePerhaps n) else (updatePerhapsHard n)
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
--
|
||||
-- (Description of the module)
|
||||
-- Rebuild a source module from incomplete and its with-instance.
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module Rebuild where
|
||||
@@ -45,7 +45,7 @@ rebuildModule ms mo@(i,mi) = do
|
||||
m1 <- lookupModMod gr i0
|
||||
testErr (isModRes m1) ("interface expected instead of" +++ prt i0)
|
||||
m' <- do
|
||||
js' <- extendMod False i0 (jments m1) (jments m)
|
||||
js' <- extendMod False i0 i (jments m1) (jments m)
|
||||
--- to avoid double inclusions, in instance I of I0 = J0 ** ...
|
||||
case extends m of
|
||||
[] -> return $ replaceJudgements m js'
|
||||
@@ -60,14 +60,14 @@ rebuildModule ms mo@(i,mi) = do
|
||||
_ -> return mi
|
||||
|
||||
-- add the instance opens to an incomplete module "with" instances
|
||||
ModWith mt stat ext ops -> do
|
||||
ModWith mt stat ext me ops -> do
|
||||
let insts = [(inf,inst) | OQualif _ inf inst <- ops]
|
||||
let infs = map fst insts
|
||||
let stat' = ifNull MSComplete (const MSIncomplete)
|
||||
[i | i <- is, notElem i infs]
|
||||
testErr (stat' == MSComplete || stat == MSIncomplete)
|
||||
("module" +++ prt i +++ "remains incomplete")
|
||||
Module mt0 _ fs me ops0 js <- lookupModMod gr ext
|
||||
Module mt0 _ fs me' ops0 js <- lookupModMod gr ext
|
||||
let ops1 = ops ++ [o | o <- ops0, notElem (openedModule o) infs]
|
||||
++ [oQualif i i | i <- map snd insts] ----
|
||||
++ [oSimple i | i <- map snd insts] ----
|
||||
|
||||
@@ -192,14 +192,17 @@ mapP f p = case p of
|
||||
Nope -> Nope
|
||||
|
||||
-- this is what happens when matching two values in the same module
|
||||
unifPerhaps :: (Eq a, Eq b) => Perhaps a b -> Perhaps a b -> Err (Perhaps a b)
|
||||
unifPerhaps :: (Eq a, Eq b, Show a, Show b) =>
|
||||
Perhaps a b -> Perhaps a b -> Err (Perhaps a b)
|
||||
unifPerhaps p1 p2 = case (p1,p2) of
|
||||
(Nope, _) -> return p2
|
||||
(_, Nope) -> return p1
|
||||
_ -> if p1==p2 then return p1 else Bad "update conflict"
|
||||
_ -> if p1==p2 then return p1
|
||||
else Bad ("update conflict between" ++++ show p1 ++++ show p2)
|
||||
|
||||
-- this is what happens when updating a module extension
|
||||
updatePerhaps :: (Eq a,Eq b) => b -> Perhaps a b -> Perhaps a b -> Err (Perhaps a b)
|
||||
updatePerhaps :: (Eq a,Eq b, Show a, Show b) =>
|
||||
b -> Perhaps a b -> Perhaps a b -> Err (Perhaps a b)
|
||||
updatePerhaps old p1 p2 = case (p1,p2) of
|
||||
(Yes a, Nope) -> return $ may old
|
||||
(May older,Nope) -> return $ may older
|
||||
@@ -207,7 +210,7 @@ updatePerhaps old p1 p2 = case (p1,p2) of
|
||||
_ -> unifPerhaps p1 p2
|
||||
|
||||
-- here the value is copied instead of referred to; used for oper types
|
||||
updatePerhapsHard :: (Eq a, Eq b) => b ->
|
||||
updatePerhapsHard :: (Eq a, Eq b, Show a, Show b) => b ->
|
||||
Perhaps a b -> Perhaps a b -> Err (Perhaps a b)
|
||||
updatePerhapsHard old p1 p2 = case (p1,p2) of
|
||||
(Yes a, Nope) -> return $ yes a
|
||||
|
||||
@@ -33,7 +33,7 @@ data MGrammar i f a = MGrammar {modules :: [(i,ModInfo i f a)]}
|
||||
data ModInfo i f a =
|
||||
ModMainGrammar (MainGrammar i)
|
||||
| ModMod (Module i f a)
|
||||
| ModWith (ModuleType i) ModuleStatus i [OpenSpec i]
|
||||
| ModWith (ModuleType i) ModuleStatus i [i] [OpenSpec i]
|
||||
deriving Show
|
||||
|
||||
data Module i f a = Module {
|
||||
|
||||
@@ -254,10 +254,18 @@ getModuleHeader ws = case ws of
|
||||
((MTyResource,name),(m,MUInstance):(n,MUComplete):[(n,MUOther) | n <- ms])
|
||||
ms -> ((MTyResource,name),(m,MUInstance):[(n,MUOther) | n <- ms])
|
||||
|
||||
"concrete":name:a:ws2 -> case span (/= "with") ws2 of
|
||||
|
||||
(es,_:ms) -> ((MTyOther,name),
|
||||
[(m,MUOther) | m <- es] ++
|
||||
[(n,MUComplete) | n <- ms])
|
||||
--- m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms])
|
||||
(ms,[]) -> ((MTyOther,name),[(n,MUOther) | n <- a:ms])
|
||||
|
||||
_:name:ws2 -> case ws2 of
|
||||
"reuse":m:_ -> ((MTyOther,name),[(m,MUReuse)])
|
||||
m:n:"with":ms ->
|
||||
((MTyOther,name),(m,MUInstance):(n,MUOther):[(n,MUComplete) | n <- ms])
|
||||
---- m:n:"with":ms ->
|
||||
---- ((MTyOther,name),(m,MUInstance):(n,MUOther):[(n,MUComplete) | n <- ms])
|
||||
m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms])
|
||||
ms -> ((MTyOther,name),[(n,MUOther) | n <- ms])
|
||||
|
||||
|
||||
@@ -54,6 +54,7 @@ data ModType =
|
||||
data ModBody =
|
||||
MBody Extend Opens [TopDef]
|
||||
| MWith Ident [Open]
|
||||
| MWithE [Ident] Ident [Open]
|
||||
| MReuse Ident
|
||||
| MUnion [Included]
|
||||
deriving (Eq,Ord,Show)
|
||||
@@ -65,7 +66,7 @@ data Extend =
|
||||
|
||||
data Opens =
|
||||
NoOpens
|
||||
| Opens [Open]
|
||||
| OpenIn [Open]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Open =
|
||||
@@ -138,7 +139,7 @@ data DataConstr =
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ParDef =
|
||||
ParDef Ident [ParConstr]
|
||||
ParDefDir Ident [ParConstr]
|
||||
| ParDefIndir Ident Ident
|
||||
| ParDefAbs Ident
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
@@ -39,7 +39,8 @@ MTInstance. ModType ::= "instance" Ident "of" Ident ;
|
||||
MTTransfer. ModType ::= "transfer" Ident ":" Open "->" Open ;
|
||||
|
||||
MBody. ModBody ::= Extend Opens "{" [TopDef] "}" ;
|
||||
MWith. ModBody ::= Ident "with" [Open] ;
|
||||
MWith. ModBody ::= Ident "with" [Open] ;
|
||||
MWithE. ModBody ::= [Ident] "**" Ident "with" [Open] ;
|
||||
MReuse. ModBody ::= "reuse" Ident ;
|
||||
MUnion. ModBody ::= "union" [Included] ;
|
||||
|
||||
@@ -50,7 +51,7 @@ NoExt. Extend ::= ;
|
||||
|
||||
separator Open "," ;
|
||||
NoOpens. Opens ::= ;
|
||||
Opens. Opens ::= "open" [Open] "in" ;
|
||||
OpenIn. Opens ::= "open" [Open] "in" ;
|
||||
|
||||
OName. Open ::= Ident ;
|
||||
OQualQO. Open ::= "(" QualOpen Ident ")" ;
|
||||
@@ -105,7 +106,7 @@ DataQId. DataConstr ::= Ident "." Ident ;
|
||||
separator DataConstr "|" ;
|
||||
|
||||
|
||||
ParDef. ParDef ::= Ident "=" [ParConstr] ;
|
||||
ParDefDir. ParDef ::= Ident "=" [ParConstr] ;
|
||||
ParDefIndir. ParDef ::= Ident "=" "(" "in" Ident ")" ;
|
||||
ParDefAbs. ParDef ::= Ident ;
|
||||
|
||||
|
||||
@@ -62,7 +62,7 @@ trQualOpen q = case q of
|
||||
OQInterface -> P.QOInterface
|
||||
|
||||
|
||||
mkOpens ds = if null ds then P.NoOpens else P.Opens ds
|
||||
mkOpens ds = if null ds then P.NoOpens else P.OpenIn ds
|
||||
mkTopDefs ds = ds
|
||||
|
||||
trAnyDef :: (Ident,Info) -> [P.TopDef]
|
||||
@@ -80,7 +80,7 @@ trAnyDef (i,info) = let i' = tri i in case info of
|
||||
|
||||
ResOper pty ptr -> [P.DefOper [trDef i' pty ptr]]
|
||||
ResParam pp -> [P.DefPar [case pp of
|
||||
Yes ps -> P.ParDef i' [P.ParConstr (tri c) (map trDecl co) | (c,co) <- ps]
|
||||
Yes ps -> P.ParDefDir i' [P.ParConstr (tri c) (map trDecl co) | (c,co) <- ps]
|
||||
May b -> P.ParDefIndir i' $ tri b
|
||||
_ -> P.ParDefAbs i']]
|
||||
|
||||
|
||||
@@ -62,20 +62,18 @@ prToken t = case t of
|
||||
|
||||
_ -> show t
|
||||
|
||||
data BTree = N | B String Tok BTree BTree deriving (Show)
|
||||
|
||||
eitherResIdent :: (String -> Tok) -> String -> Tok
|
||||
eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where
|
||||
isResWord s = isInTree s $
|
||||
B "lincat" (B "def" (B "Type" (B "Str" (B "PType" (B "Lin" N N) N) (B "Tok" (B "Strs" N N) N)) (B "cat" (B "case" (B "abstract" N N) N) (B "data" (B "concrete" N N) N))) (B "include" (B "fun" (B "fn" (B "flags" N N) N) (B "in" (B "grammar" N N) N)) (B "interface" (B "instance" (B "incomplete" N N) N) (B "lin" (B "let" N N) N)))) (B "resource" (B "out" (B "of" (B "lintype" (B "lindef" N N) N) (B "oper" (B "open" N N) N)) (B "pattern" (B "param" (B "package" N N) N) (B "printname" (B "pre" N N) N))) (B "union" (B "table" (B "strs" (B "reuse" N N) N) (B "transfer" (B "tokenizer" N N) N)) (B "where" (B "variants" (B "var" N N) N) (B "with" N N))))
|
||||
eitherResIdent tv s = treeFind resWords
|
||||
where
|
||||
treeFind N = tv s
|
||||
treeFind (B a t left right) | s < a = treeFind left
|
||||
| s > a = treeFind right
|
||||
| s == a = t
|
||||
|
||||
data BTree = N | B String BTree BTree deriving (Show)
|
||||
|
||||
isInTree :: String -> BTree -> Bool
|
||||
isInTree x tree = case tree of
|
||||
N -> False
|
||||
B a left right
|
||||
| x < a -> isInTree x left
|
||||
| x > a -> isInTree x right
|
||||
| x == a -> True
|
||||
resWords = b "lincat" (b "def" (b "Type" (b "Str" (b "PType" (b "Lin" N N) N) (b "Tok" (b "Strs" N N) N)) (b "cat" (b "case" (b "abstract" N N) N) (b "data" (b "concrete" N N) N))) (b "include" (b "fun" (b "fn" (b "flags" N N) N) (b "in" (b "grammar" N N) N)) (b "interface" (b "instance" (b "incomplete" N N) N) (b "lin" (b "let" N N) N)))) (b "resource" (b "out" (b "of" (b "lintype" (b "lindef" N N) N) (b "oper" (b "open" N N) N)) (b "pattern" (b "param" (b "package" N N) N) (b "printname" (b "pre" N N) N))) (b "union" (b "table" (b "strs" (b "reuse" N N) N) (b "transfer" (b "tokenizer" N N) N)) (b "where" (b "variants" (b "var" N N) N) (b "with" N N))))
|
||||
where b s = B s (TS s)
|
||||
|
||||
unescapeInitTail :: String -> String
|
||||
unescapeInitTail = unesc . tail where
|
||||
|
||||
@@ -68,20 +68,18 @@ prToken t = case t of
|
||||
|
||||
_ -> show t
|
||||
|
||||
data BTree = N | B String Tok BTree BTree deriving (Show)
|
||||
|
||||
eitherResIdent :: (String -> Tok) -> String -> Tok
|
||||
eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where
|
||||
isResWord s = isInTree s $
|
||||
B "lincat" (B "def" (B "Type" (B "Str" (B "PType" (B "Lin" N N) N) (B "Tok" (B "Strs" N N) N)) (B "cat" (B "case" (B "abstract" N N) N) (B "data" (B "concrete" N N) N))) (B "include" (B "fun" (B "fn" (B "flags" N N) N) (B "in" (B "grammar" N N) N)) (B "interface" (B "instance" (B "incomplete" N N) N) (B "lin" (B "let" N N) N)))) (B "resource" (B "out" (B "of" (B "lintype" (B "lindef" N N) N) (B "oper" (B "open" N N) N)) (B "pattern" (B "param" (B "package" N N) N) (B "printname" (B "pre" N N) N))) (B "union" (B "table" (B "strs" (B "reuse" N N) N) (B "transfer" (B "tokenizer" N N) N)) (B "where" (B "variants" (B "var" N N) N) (B "with" N N))))
|
||||
eitherResIdent tv s = treeFind resWords
|
||||
where
|
||||
treeFind N = tv s
|
||||
treeFind (B a t left right) | s < a = treeFind left
|
||||
| s > a = treeFind right
|
||||
| s == a = t
|
||||
|
||||
data BTree = N | B String BTree BTree deriving (Show)
|
||||
|
||||
isInTree :: String -> BTree -> Bool
|
||||
isInTree x tree = case tree of
|
||||
N -> False
|
||||
B a left right
|
||||
| x < a -> isInTree x left
|
||||
| x > a -> isInTree x right
|
||||
| x == a -> True
|
||||
resWords = b "lincat" (b "def" (b "Type" (b "Str" (b "PType" (b "Lin" N N) N) (b "Tok" (b "Strs" N N) N)) (b "cat" (b "case" (b "abstract" N N) N) (b "data" (b "concrete" N N) N))) (b "include" (b "fun" (b "fn" (b "flags" N N) N) (b "in" (b "grammar" N N) N)) (b "interface" (b "instance" (b "incomplete" N N) N) (b "lin" (b "let" N N) N)))) (b "resource" (b "out" (b "of" (b "lintype" (b "lindef" N N) N) (b "oper" (b "open" N N) N)) (b "pattern" (b "param" (b "package" N N) N) (b "printname" (b "pre" N N) N))) (b "union" (b "table" (b "strs" (b "reuse" N N) N) (b "transfer" (b "tokenizer" N N) N)) (b "where" (b "variants" (b "var" N N) N) (b "with" N N))))
|
||||
where b s = B s (TS s)
|
||||
|
||||
unescapeInitTail :: String -> String
|
||||
unescapeInitTail = unesc . tail where
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -158,6 +158,7 @@ instance Print ModBody where
|
||||
prt i e = case e of
|
||||
MBody extend opens topdefs -> prPrec i 0 (concatD [prt 0 extend , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
|
||||
MWith id opens -> prPrec i 0 (concatD [prt 0 id , doc (showString "with") , prt 0 opens])
|
||||
MWithE ids id opens -> prPrec i 0 (concatD [prt 0 ids , doc (showString "**") , prt 0 id , doc (showString "with") , prt 0 opens])
|
||||
MReuse id -> prPrec i 0 (concatD [doc (showString "reuse") , prt 0 id])
|
||||
MUnion includeds -> prPrec i 0 (concatD [doc (showString "union") , prt 0 includeds])
|
||||
|
||||
@@ -171,7 +172,7 @@ instance Print Extend where
|
||||
instance Print Opens where
|
||||
prt i e = case e of
|
||||
NoOpens -> prPrec i 0 (concatD [])
|
||||
Opens opens -> prPrec i 0 (concatD [doc (showString "open") , prt 0 opens , doc (showString "in")])
|
||||
OpenIn opens -> prPrec i 0 (concatD [doc (showString "open") , prt 0 opens , doc (showString "in")])
|
||||
|
||||
|
||||
instance Print Open where
|
||||
@@ -282,7 +283,7 @@ instance Print DataConstr where
|
||||
|
||||
instance Print ParDef where
|
||||
prt i e = case e of
|
||||
ParDef id parconstrs -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 parconstrs])
|
||||
ParDefDir id parconstrs -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 parconstrs])
|
||||
ParDefIndir id0 id -> prPrec i 0 (concatD [prt 0 id0 , doc (showString "=") , doc (showString "(") , doc (showString "in") , prt 0 id , doc (showString ")")])
|
||||
ParDefAbs id -> prPrec i 0 (concatD [prt 0 id])
|
||||
|
||||
|
||||
@@ -96,9 +96,14 @@ transModDef x = case x of
|
||||
GM.ModMod (GM.Module (GM.MTUnion mtyp' imps') mstat' [] [] [] NT))
|
||||
|
||||
MWith m opens -> do
|
||||
m' <- transIdent m
|
||||
opens' <- mapM transOpen opens
|
||||
return (id', GM.ModWith mtyp' mstat' m' opens')
|
||||
m' <- transIdent m
|
||||
opens' <- mapM transOpen opens
|
||||
return (id', GM.ModWith mtyp' mstat' m' [] opens')
|
||||
MWithE extends m opens -> do
|
||||
extends' <- mapM transIdent extends
|
||||
m' <- transIdent m
|
||||
opens' <- mapM transOpen opens
|
||||
return (id', GM.ModWith mtyp' mstat' m' extends' opens')
|
||||
where
|
||||
mkModRes id mtyp body = do
|
||||
id' <- transIdent id
|
||||
@@ -159,7 +164,7 @@ transExtend x = case x of
|
||||
transOpens :: Opens -> Err [GM.OpenSpec Ident]
|
||||
transOpens x = case x of
|
||||
NoOpens -> return []
|
||||
Opens opens -> mapM transOpen opens
|
||||
OpenIn opens -> mapM transOpen opens
|
||||
|
||||
transOpen :: Open -> Err (GM.OpenSpec Ident)
|
||||
transOpen x = case x of
|
||||
@@ -257,7 +262,7 @@ transResDef x = case x of
|
||||
|
||||
transParDef :: ParDef -> Err (Ident, [G.Param])
|
||||
transParDef x = case x of
|
||||
ParDef id params -> liftM2 (,) (transIdent id) (mapM transParConstr params)
|
||||
ParDefDir id params -> liftM2 (,) (transIdent id) (mapM transParConstr params)
|
||||
ParDefAbs id -> liftM2 (,) (transIdent id) (return [])
|
||||
_ -> Bad $ "illegal definition in resource:" ++++ printTree x
|
||||
|
||||
@@ -549,12 +554,12 @@ transOldGrammar opts name0 x = case x of
|
||||
DefPrintOld printdefs -> (a,r,d:c,ps)
|
||||
DefPackage m ds -> (a,r,c,(m,ds):ps)
|
||||
_ -> (a,r,c,ps)
|
||||
mkAbs a = MModule q (MTAbstract absName) (MBody ne (Opens []) (topDefs a))
|
||||
mkRes ps r = MModule q (MTResource resName) (MBody ne (Opens ops) (topDefs r))
|
||||
mkAbs a = MModule q (MTAbstract absName) (MBody ne (OpenIn []) (topDefs a))
|
||||
mkRes ps r = MModule q (MTResource resName) (MBody ne (OpenIn ops) (topDefs r))
|
||||
where ops = map OName ps
|
||||
mkCnc ps r = MModule q (MTConcrete cncName absName)
|
||||
(MBody ne (Opens (map OName (resName:ps))) (topDefs r))
|
||||
mkPack (m, ds) = MModule q (MTResource m) (MBody ne (Opens []) (topDefs ds))
|
||||
(MBody ne (OpenIn (map OName (resName:ps))) (topDefs r))
|
||||
mkPack (m, ds) = MModule q (MTResource m) (MBody ne (OpenIn []) (topDefs ds))
|
||||
topDefs t = t
|
||||
ne = NoExt
|
||||
q = CMCompl
|
||||
|
||||
Reference in New Issue
Block a user