mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-09 19:22:50 -06:00
788 lines
24 KiB
Plaintext
788 lines
24 KiB
Plaintext
--# -path=.:../scandinavian:../common:../abstract:../../prelude
|
|
--# -coding=latin1
|
|
|
|
--1 Swedish Lexical Paradigms
|
|
--
|
|
-- Aarne Ranta 2001 - 2006
|
|
--
|
|
-- This is an API for 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 $MorphoSwe.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 [``IrregSwe`` ../../swedish/IrregSwe],
|
|
-- which covers many irregular verbs.
|
|
|
|
|
|
resource ParadigmsSwe =
|
|
open
|
|
(Predef=Predef),
|
|
Prelude,
|
|
CommonScand,
|
|
ResSwe,
|
|
MorphoSwe,
|
|
CatSwe in {
|
|
|
|
--2 Parameters
|
|
--
|
|
-- To abstract over gender names, we define the following identifiers.
|
|
|
|
oper
|
|
Gender : Type ;
|
|
|
|
utrum : Gender ; -- the "en" gender
|
|
neutrum : Gender ; -- the "ett" 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 can be constructed from strings.
|
|
|
|
mkPrep : Str -> Prep ; -- e.g. "till"
|
|
noPrep : Prep ; -- empty string
|
|
|
|
|
|
--2 Nouns
|
|
|
|
-- The following overloaded paradigm takes care of all noun formation.
|
|
|
|
mkN : overload {
|
|
|
|
-- The one-argument case takes the singular indefinite form and computes
|
|
-- the other forms and the gender by a simple heuristic. The heuristic is currently
|
|
-- to treat all words ending with "a" like "apa-apor", with "e" like "rike-riken",
|
|
-- and otherwise like "bil-bilar".
|
|
|
|
mkN : (apa : Str) -> N ; -- predictable nouns: apa-apor, rike-riken, or bil-bilar
|
|
|
|
-- The case with a string and gender makes it possible to treat
|
|
-- "lik" (neutrum) and "pojke" (utrum).
|
|
|
|
mkN : (lik : Str) -> Gender -> N ; --%
|
|
|
|
-- Giving two forms - the singular and plural indefinite - is sufficient for
|
|
-- most nouns. The paradigm deals correctly with the vowel contractions in
|
|
-- "nyckel - nycklar" such as "pojke - pojkar".
|
|
|
|
mkN : (nyckel,nycklar : Str) -> N ; -- singular and plural suffice for most nouns
|
|
|
|
-- In the worst case, four forms are needed,
|
|
|
|
mkN : (museum,museet,museer,museerna : Str) -> N ; -- worst case for nouns
|
|
|
|
-- and perhaps a gender.
|
|
|
|
mkN : (museum,museet,museer,museerna : Str) -> Gender -> N ; -- even worse case for nouns
|
|
|
|
-- All the functions above work quite as well to form *compound nouns*,
|
|
-- such as "fotboll", just given as one argument. But compound nouns can be formed from their parts as well,
|
|
|
|
mkN : (regering, makt : N) -> N ; -- regeringsmakt, using the co form of regering
|
|
} ;
|
|
|
|
-- The default compound form can be changed:
|
|
|
|
changeCompoundN : Str -> N -> N ; -- kyrko + kyrka_N
|
|
|
|
|
|
--3 Relational nouns
|
|
--
|
|
-- Relational nouns ("kung av x") are nouns with a preposition.
|
|
-- As a special case, we provide regular nouns (formed with one-argument $mkN$)
|
|
-- with the preposition "av".
|
|
|
|
mkN2 : overload {
|
|
-- mkN2 : Str -> N2 ;
|
|
mkN2 : N -> N2 ; -- e.g. summan - av
|
|
mkN2 : N -> Prep -> N2 -- e.g. syster - till
|
|
} ;
|
|
|
|
-- Three-place relational nouns ("förbindelse från x till y")
|
|
-- need two prepositions.
|
|
|
|
mkN3 : N -> Prep -> Prep -> N3 ; -- e.g. flyg - från - till
|
|
|
|
|
|
--3 Relational common noun phrases
|
|
--
|
|
-- In some cases, you may want to make a complex $CN$ into a
|
|
-- relational noun (e.g. "den före detta maken till"). However, $N2$ and
|
|
-- $N3$ are purely lexical categories. But you can use the $AdvCN$
|
|
-- and $PrepNP$ constructions to build phrases like this.
|
|
|
|
--
|
|
--3 Proper names and noun phrases
|
|
--
|
|
-- Proper names, with a regular genitive, are formed from strings and
|
|
-- have the default gender utrum.
|
|
|
|
mkPN : overload {
|
|
mkPN : Str -> PN ; -- default gender utrum
|
|
mkPN : Str -> Gender -> PN ; -- set other gender
|
|
|
|
-- In the worst case, the genitive form is irregular.
|
|
|
|
mkPN : (jesus,jesu : Str) -> Gender -> PN -- irregular genitive
|
|
} ;
|
|
|
|
|
|
--2 Adjectives
|
|
|
|
-- Adjectives need one to seven forms.
|
|
|
|
mkA : overload {
|
|
|
|
-- Most adjectives are formed simply by adding endings to a stem.
|
|
|
|
mkA : (billig : Str) -> A ;
|
|
|
|
-- Some adjectives have a deviant neuter form. The following pattern
|
|
-- also recognizes the neuter formation "galen-galet" and forms the
|
|
-- proper plural and comparison forms "galna-galnare-galnast".
|
|
|
|
mkA : (bred,brett : Str) -> A ; -- predictable adjective
|
|
|
|
-- Umlaut in comparison forms is
|
|
|
|
mkA : (tung,tyngre,tyngst : Str) -> A ; -- irregular comparison
|
|
|
|
-- A few adjectives need 5 forms.
|
|
mkA : (god,gott,goda,battre,bast : Str) -> A ; -- very irregular
|
|
|
|
-- Hardly any other adjective than "liten" needs the full 7 forms.
|
|
|
|
mkA : (liten,litet,lilla,sma,mindre,minst,minsta : Str) -> A -- worst case
|
|
} ;
|
|
|
|
-- Comparison forms may be compound ("mera svensk" - "mest svensk");
|
|
-- this behaviour can be forced on any adjective.
|
|
|
|
compoundA : A -> A ; -- force comparison by mera - mest
|
|
|
|
-- Adjective with all positive forms the same.
|
|
|
|
invarA : Str -> A ; -- e.g. äkta
|
|
|
|
---- Adjective with deviant adverb.
|
|
|
|
---- deviantAdvA : Str -> A -> A ; -- e.g. bra, god
|
|
|
|
|
|
--3 Two-place adjectives
|
|
--
|
|
-- Two-place adjectives need a preposition for their second argument.
|
|
|
|
mkA2 : A -> Prep -> A2 ; -- e.g. delbar - med
|
|
|
|
|
|
--2 Adverbs
|
|
|
|
-- Adverbs are not inflected. Most lexical ones have position
|
|
-- after the verb. Some can be preverbal in subordinate position
|
|
-- (e.g. "alltid").
|
|
|
|
mkAdv : Str -> Adv ; -- postverbal, e.g. här
|
|
mkAdV : Str -> AdV ; -- preverbal, e.g. alltid
|
|
|
|
-- Adverbs modifying adjectives and sentences can also be formed.
|
|
|
|
mkAdA : Str -> AdA ; -- modify adjective, e.g. tämligen
|
|
|
|
--2 Verbs
|
|
--
|
|
-- All verbs can be defined by the overloaded paradigm $mkV$.
|
|
|
|
mkV : overload {
|
|
|
|
-- The 'regular verb' (= one-place) case is inspired by Lexin. It uses the
|
|
-- present tense indicative form. The value is the first conjugation if the
|
|
-- argument ends with "ar" ("tala" - "talar" - "talade" - "talat"),
|
|
-- the second with "er" ("leka" - "leker" - "lekte" - "lekt", with the
|
|
-- variations like in "gräva", "vända", "tyda", "hyra"), and
|
|
-- the third in other cases ("bo" - "bor" - "bodde" - "bott").
|
|
-- It is also possible to give the infinite form to it; they are treated
|
|
-- as if they were implicitly suffixed by "r". Moreover, deponent verbs
|
|
-- are recognized from the final "s" ("hoppas").
|
|
|
|
mkV : (stämmer : Str) -> V ; -- predictable verb: use present indicative
|
|
|
|
-- Most irregular verbs need just the conventional three forms.
|
|
|
|
mkV : (slita, slet : Str) -> V ; -- i/e/i, u/ö/u, u/a/u
|
|
|
|
mkV : (dricka,drack,druckit : Str) -> V ; -- the theme of an irregular verb
|
|
|
|
-- In the worst case, six forms are given.
|
|
|
|
mkV : (gå,går,gå,gick,gått,gången : Str) -> V ; -- worst case
|
|
|
|
-- Particle verbs, such as "passa på", are formed by adding a string to a verb.
|
|
|
|
mkV : V -> Str -> V -- particle verb, e.g. passa - på
|
|
} ;
|
|
|
|
|
|
--3 Deponent verbs.
|
|
--
|
|
-- Some words are used in passive forms only, e.g. "hoppas", some as
|
|
-- reflexive e.g. "ångra sig". Regular deponent verbs are also
|
|
-- handled by $mkV$ and recognized from the ending "s".
|
|
|
|
depV : V -> V ; -- deponent verb, e.g. andas
|
|
reflV : V -> V ; -- reflexive verb, e.g. ångra sig
|
|
|
|
|
|
--3 Two-place verbs
|
|
--
|
|
-- Two-place verbs need a preposition, which default to the 'empty preposition'
|
|
-- i.e. direct object. (transitive verbs). The simplest case is a regular
|
|
-- verb (as in $mkV$) with a direct object.
|
|
-- Notice that, if a particle is needed, it comes from the $V$.
|
|
|
|
mkV2 : overload {
|
|
mkV2 : Str -> V2 ; --%
|
|
mkV2 : V -> V2 ; -- direct transitive
|
|
mkV2 : Str -> Prep -> V2 ; --%
|
|
mkV2 : V -> Prep -> V2 ; -- preposition for complement
|
|
} ;
|
|
|
|
|
|
--3 Three-place verbs
|
|
--
|
|
-- Three-place (ditransitive) verbs need two prepositions, of which
|
|
-- the first one or both can be absent. The simplest case is a regular
|
|
-- verb (as in $mkV$) with no prepositions.
|
|
|
|
mkV3 : overload {
|
|
mkV3 : Str -> V3 ; --%
|
|
mkV3 : V -> V3 ; -- direct ditransitive
|
|
mkV3 : V -> Prep -> V3 ; -- preposition for last argument
|
|
mkV3 : V -> Prep -> Prep -> V3 -- prepositions for both complements
|
|
} ;
|
|
|
|
--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 : overload {
|
|
mkV2S : V -> V2S ;
|
|
mkV2S : V -> Prep -> V2S ;
|
|
} ;
|
|
|
|
mkVV : V -> VV ;
|
|
auxVV : V -> VV ;
|
|
mkV2V : overload {
|
|
mkV2V : V -> V2V ;
|
|
mkV2V : V -> Prep -> Prep -> V2V ;
|
|
} ;
|
|
mkVA : V -> VA ;
|
|
|
|
mkV2A : overload {
|
|
mkV2A : V -> V2A ;
|
|
mkV2A : V -> Prep -> V2A ;
|
|
} ;
|
|
|
|
mkVQ : V -> VQ ;
|
|
|
|
mkV2Q : overload {
|
|
mkV2Q : V -> V2Q ;
|
|
mkV2Q : V -> Prep -> V2Q ;
|
|
} ;
|
|
|
|
|
|
mkAS : A -> AS ; --%
|
|
mkA2S : A -> Prep -> A2S ; --%
|
|
mkAV : A -> AV ; --%
|
|
mkA2V : A -> Prep -> A2V ; --%
|
|
|
|
-- Notice: categories $AS, A2S, AV, A2V$ are just $A$.
|
|
-- $V0$ is just $V$.
|
|
|
|
V0 : Type ; --%
|
|
AS, A2S, AV, A2V : Type ; --%
|
|
|
|
mkInterj : Str -> Interj
|
|
= \s -> lin Interj {s = s} ;
|
|
|
|
--.
|
|
--2 Definitions of the paradigms
|
|
--
|
|
-- The definitions should not bother the user of the API. So they are
|
|
-- hidden from the document.
|
|
|
|
Gender = ResSwe.NGender ;
|
|
Number = CommonScand.Number ;
|
|
Case = CommonScand.Case ;
|
|
utrum = Utr ;
|
|
neutrum = Neutr ;
|
|
singular = Sg ;
|
|
plural = Pl ;
|
|
nominative = Nom ;
|
|
genitive = Gen ;
|
|
|
|
mkPrep p = {s = p ; lock_Prep = <>} ;
|
|
noPrep = mkPrep [] ;
|
|
|
|
mkN = overload {
|
|
mkN : (apa : Str) -> N = regN ;
|
|
mkN : Str -> Gender -> N = regGenN ;
|
|
mkN : (nyckel, nycklar : Str) -> N = mk2N ;
|
|
mkN : (museum,museet,museer,museerna : Str) -> N = mk4N ;
|
|
mkN : (museum,museet,museer,museerna : Str) -> Gender -> N = mk5N ;
|
|
mkN : (regering, makt : N) -> N = \a,b -> lin N {
|
|
s = \\n,d,c => a.co + b.s ! n ! d ! c ;
|
|
g = b.g ;
|
|
co = case b.co of {
|
|
_ + "s" => a.co + b.co ;
|
|
co => a.co + co + "s"
|
|
}
|
|
} ;
|
|
} ;
|
|
|
|
-- The default compound form can be changed:
|
|
|
|
changeCompoundN : Str -> N -> N = \co,n -> lin N {
|
|
s = n.s ;
|
|
g = n.g ;
|
|
co = co
|
|
} ;
|
|
|
|
|
|
mk4N : (museum,museet,museer,museerna : Str) -> N = \apa,apan,apor,aporna ->
|
|
mk5N apa apan apor aporna g
|
|
where {
|
|
g = case last apan of {
|
|
"n" => Utr ;
|
|
_ => Neutr
|
|
}
|
|
} ;
|
|
|
|
mk5N : (museum,museet,museer,museerna : Str) -> Gender -> N = \apa,apan,apor,aporna,g -> lin N {
|
|
s = nounForms apa apan apor aporna ;
|
|
g = g ;
|
|
co = case apa of {
|
|
ap + "e" => case g of {
|
|
Neutr => apa + "s" ; -- rikes
|
|
_ => ap -- pojk
|
|
} ;
|
|
ap + "a" => ap ; -- flick
|
|
? + ? + ? + _ + ("ing" | "ion" | "het") => apa + "s" ; -- regerings, stations, frihets
|
|
_ => apa
|
|
}
|
|
} ;
|
|
|
|
regN : Str -> N = \bil -> regGenN bil g where {
|
|
g = case <bil : Str> of {
|
|
_ + "e" => Neutr ;
|
|
_ => Utr
|
|
}
|
|
} ;
|
|
|
|
regGenN : Str -> Gender -> N = \bil, g -> case g of {
|
|
Utr => case bil of {
|
|
_ + "are" => decl5Noun bil ;
|
|
_ + "ion" => decl3Noun bil ;
|
|
_ + "a" => decl1Noun bil ;
|
|
_ => decl2Noun bil
|
|
} ;
|
|
Neutr => case last bil of {
|
|
"e" => decl4Noun bil ;
|
|
_ => decl5Noun bil
|
|
}
|
|
} ** {lock_N = <>} ;
|
|
|
|
mk1N : Str -> N = \bilarna -> case bilarna of {
|
|
ap + "orna" => decl1Noun (ap + "a") ;
|
|
bil + "arna" => decl2Noun bil ;
|
|
rad + "erna" => decl3Noun rad ;
|
|
rik + "ena" => decl4Noun (rik + "e") ;
|
|
husen => decl5Noun (Predef.tk 2 husen)
|
|
} ;
|
|
|
|
mk2N : Str -> Str -> N = \bil,bilar ->
|
|
ifTok N bil bilar (decl5Noun bil) (
|
|
case Predef.dp 2 bilar of {
|
|
"or" => case bil of {
|
|
_ + "a" => decl1Noun bil ; -- apa, apor
|
|
_ + "o" => mk4N bil (bil + "n") bilar (bilar + "na") ; -- ko,kor
|
|
_ => mk4N bil (bil + "en") bilar (bilar + "na") -- ros,rosor
|
|
} ;
|
|
"ar" => decl2Noun bil ;
|
|
"er" => case bil of {
|
|
_ + "or" => mk4N bil (bil + "n") bilar (bilar + "na") ; -- motor,motorn
|
|
_ => decl3gNoun bil bilar -- fot, fötter
|
|
} ;
|
|
"en" => decl4Noun bil ; -- rike, riken
|
|
_ => mk4N bil (bil + "et") bilar (bilar + "n") -- centrum, centra
|
|
}) ;
|
|
|
|
-- School declensions.
|
|
|
|
decl1Noun : Str -> N = \apa ->
|
|
let ap = init apa in
|
|
mk4N apa (apa + "n") (ap + "or") (ap + "orna") ;
|
|
|
|
decl2Noun : Str -> N = \bil ->
|
|
let
|
|
bb : Str * Str = case bil of {
|
|
br + ("o" | "u" | "ö" | "å") => <bil + "ar", bil + "n"> ;
|
|
pojk + "e" => <pojk + "ar", bil + "n"> ;
|
|
hi + "mme" + l@("l" | "r") => <hi + "m" + l + "ar",hi + "m" + l + "en"> ;
|
|
nyck@(_ + ("a"|"e"|"i"|"o"|"u"|"y"|"å"|"ä"|"ö") + _) + "e" + l@("l" | "r") => <nyck + l + "ar",bil + "n"> ;
|
|
sock + "e" + "n" => <sock + "nar", sock + "nen"> ;
|
|
_ => <bil + "ar", bil + "en">
|
|
} ;
|
|
in mk4N bil bb.p2 bb.p1 (bb.p1 + "na") ;
|
|
|
|
decl3Noun : Str -> N = \sak ->
|
|
case last sak of {
|
|
"e" => mk4N sak (sak + "n") (sak +"r") (sak + "rna") ;
|
|
"y" | "å" | "é" | "y" => mk4N sak (sak + "n") (sak +"er") (sak + "erna") ;
|
|
_ => mk4N sak (sak + "en") (sak + "er") (sak + "erna")
|
|
} ;
|
|
decl3gNoun : Str -> Str -> N = \sak,saker ->
|
|
case last sak of {
|
|
"e" => mk4N sak (sak + "n") saker (saker + "na") ;
|
|
"y" | "å" | "é" | "y" => mk4N sak (sak + "n") saker (saker + "na") ;
|
|
_ => mk4N sak (sak + "en") saker (saker + "na")
|
|
} ;
|
|
|
|
decl4Noun : Str -> N = \rike ->
|
|
mk4N rike (rike + "t") (rike + "n") (rike + "na") ;
|
|
|
|
decl5Noun : Str -> N = \lik ->
|
|
case lik of {
|
|
nu + "mme" + l@("l" | "r") =>
|
|
mk4N lik (nu + "m" + l + "et") lik (nu + "m" + l + "en") ;
|
|
vad@(?+?+?+_) + "e" + l@("l" | "r") =>
|
|
mk4N lik (vad + l + "et") lik (vad + l + "en") ;
|
|
_ + "are" => mk4N lik (lik + "n") lik (init lik + "na") ; -- kikare
|
|
_ => mk4N lik (lik + "et") lik (lik + "en")
|
|
} ;
|
|
|
|
mkN2 = overload {
|
|
mkN2 : Str -> N2 = \s -> mmkN2 (regN s) (mkPrep "av") ;
|
|
mkN2 : N -> N2 = \s -> mmkN2 s (mkPrep "av") ;
|
|
mkN2 : N -> Prep -> N2 = mmkN2
|
|
} ;
|
|
|
|
mmkN2 : N -> Prep -> N2 ;
|
|
regN2 : Str -> Gender -> N2 ;
|
|
|
|
|
|
mmkN2 = \n,p -> n ** {lock_N2 = <> ; c2 = mkComplement p.s} ;
|
|
regN2 n g = mmkN2 (regGenN n g) (mkPrep "av") ;
|
|
mkN3 = \n,p,q -> n **
|
|
{lock_N3 = <> ; c2 = mkComplement p.s ; c3 = mkComplement q.s} ;
|
|
|
|
mkPN = overload {
|
|
mkPN : Str -> PN = regPN ;
|
|
mkPN : Str -> Gender -> PN = regGenPN ;
|
|
mkPN : (jesus,jesu : Str) -> Gender -> PN = \jesus,jesu,g ->
|
|
{s = table {Nom => jesus ; Gen => jesu} ; g = g ; lock_PN = <>} ;
|
|
} ;
|
|
|
|
regPN n = regGenPN n utrum ;
|
|
regGenPN n g = {s = \\c => mkCase c n ; g = g} ** {lock_PN = <>} ;
|
|
nounPN n = {s = n.s ! singular ! Indef ; g = n.g ; lock_PN = <>} ;
|
|
makeNP x y n g =
|
|
{s = table {NPPoss _ _ => y ; _ => x} ; a = agrP3 g n ; p = P3 ;
|
|
lock_NP = <>} ;
|
|
|
|
mkA = overload {
|
|
mkA : (billig : Str) -> A = regA ;
|
|
mkA : (bred,brett : Str) -> A = mk2A ;
|
|
mkA : (tung,tyngre,tyngst : Str) -> A = irregA ;
|
|
mkA : (god,gott,goda,battre,bast : Str) -> A =
|
|
\liten,litet,lilla,mindre,minst ->
|
|
mk7A liten litet lilla lilla mindre minst (minst + "a") ;
|
|
mkA : (liten,litet,lilla,sma,mindre,minst,minsta : Str) -> A = mk7A
|
|
} ;
|
|
|
|
---- deviantAdvA s a =
|
|
|
|
regA : Str -> A ;
|
|
mk2A : (bred,brett : Str) -> A ;
|
|
irregA : (tung,tyngre,tyngst : Str) -> A ;
|
|
mk7A : (liten,litet,lilla,sma,mindre,minst,minsta : Str) -> A ;
|
|
|
|
mk7A a b c d e f g = mkAdjective a b c d e f g ** {isComp = False ; lock_A = <>} ;
|
|
regA fin =
|
|
let
|
|
fint = fin + "t" ;
|
|
fina = fin + "a" ;
|
|
in case fin of {
|
|
unk@(? + ? + ? + _) + "en" => mk3cA fin (unk + "et") (unk + "na") True ;
|
|
unk@(? + ? + ? + _) + "e" + n@("l" | "r") => mk3A fin fint (unk + n + "a") ;
|
|
kork@(? + ? + ? + _) + "ad" => mk3cA fin (kork + "at") (kork + "ade") True ;
|
|
se + "dd" => mk3cA fin (se + "tt") fina True ;
|
|
ru + "nd" => mk3A fin (ru + "nt") fina ;
|
|
pla + "tt" => mk3A fin (pla + "tt") fina ;
|
|
aekt + "a" => mk3A fin fin fin ;
|
|
puck + ("e"|"o") => mk3cA fin fin fin True ;
|
|
_ => mk3A fin fint fina
|
|
} ;
|
|
|
|
irregA ung yngre yngst =
|
|
mk7A ung (ung + "t") (ung + "a") (ung + "a") yngre yngst (yngst+"a") ;
|
|
|
|
mk3A ljummen ljummet ljumma =
|
|
mk7A
|
|
ljummen ljummet ljumma ljumma
|
|
(ljumma + "re") (ljumma + "st") (ljumma + "ste") ;
|
|
|
|
mk2A vid vitt =
|
|
case <vid,vitt> of {
|
|
<gal + "en", _ + "et"> => mk3cA vid vitt (gal + "na") True ;
|
|
<gal + "ad", _ + "at"> => mk3cA vid vitt (gal + "ade") True ;
|
|
_ => mk3A vid vitt (vid + "a")
|
|
} ;
|
|
|
|
compoundA adj = {s = adj.s ; isComp = True ; lock_A = <>} ;
|
|
|
|
invarA s = mk3cA s s s True ;
|
|
|
|
mkA2 a p = a ** {c2 = mkComplement p.s ; lock_A2 = <>} ;
|
|
|
|
mkAdv x = ss x ** {lock_Adv = <>} ;
|
|
mkAdV x = ss x ** {lock_AdV = <>} ;
|
|
mkAdA x = ss x ** {lock_AdA = <>} ;
|
|
|
|
mkV = overload {
|
|
mkV : (stämmer : Str) -> V = regV ;
|
|
mkV : (slita, slet : Str) -> V = reg2V ;
|
|
mkV : (dricka,drack,druckit : Str) -> V = irregV ;
|
|
mkV : (supa,super,sup,söp,supit,supen : Str) -> V = mk6V ;
|
|
mkV : (supa,super,sup,söp,supit,supen,supande : Str) -> V = mk7V ;
|
|
mkV : V -> Str -> V = partV
|
|
} ;
|
|
|
|
mk6V = \finna,finner,finn,fann,funnit,funnen ->
|
|
let finnande : Str = case finna of {
|
|
_ + "a" => finna + "nde" ;
|
|
_ => finna + "ende" -- gående; but bli - blivande must be given separately
|
|
}
|
|
in
|
|
mk7V finna finner finn fann funnit funnen finnande ;
|
|
|
|
mk7V = \finna,finner,finn,fann,funnit,funnen,finnande ->
|
|
let
|
|
funn = ptPretForms funnen ;
|
|
funnet = funn ! Strong (GSg Neutr) ! Nom ;
|
|
funna = funn ! Strong GPl ! Nom
|
|
in
|
|
mkVerb9 finna finner finn fann funnit funnen funnet funna finnande **
|
|
{part = [] ; vtype=VAct ; lock_V = <>} ;
|
|
|
|
regV leker = case leker of {
|
|
lek + "a" => conj1 leker ; --- bw compat
|
|
lek + "ar" => conj1 (lek + "a") ;
|
|
lek + "er" => conj2 (lek + "a") ;
|
|
bo + "r" => conj3 bo ;
|
|
ret + "as" => depV (conj1 (ret + "a")) ;
|
|
n + ("os" | "ys" | "ås" | "ös") => depV (conj3 (init leker)) ;
|
|
ret + "s" => depV (conj2 (ret + "a")) ;
|
|
_ => conj3 leker
|
|
} ;
|
|
|
|
mk2V leka lekte = case <leka,lekte> of {
|
|
<_, _ + "ade"> => conj1 leka ;
|
|
<_ + "a", _> => conj2 leka ;
|
|
_ => conj3 leka
|
|
} ;
|
|
|
|
-- school conjugations
|
|
|
|
conj1 : Str -> V = \tala ->
|
|
mk6V tala (tala + "r") tala (tala +"de") (tala +"t") (tala +"d") ;
|
|
|
|
conj2 : Str -> V = \leka ->
|
|
let lek = init leka in
|
|
case last lek of {
|
|
"l" | "m" | "n" | "v" | "g" =>
|
|
let gom = case <lek : Tok> of {
|
|
_ + "mm" => init lek ;
|
|
_ => lek
|
|
}
|
|
in mk6V leka (lek + "er") gom (gom +"de") (gom +"t") (gom +"d") ;
|
|
"r" =>
|
|
mk6V leka lek lek (lek +"de") (lek +"t") (lek +"d") ;
|
|
_ => case lek of {
|
|
_ + "nd" =>
|
|
mk6V leka (lek + "er") lek (lek +"e") (init lek +"t") lek ;
|
|
_ =>
|
|
mk6V leka (lek + "er") lek (lek +"te") (lek +"t") (lek +"t")
|
|
}
|
|
} ;
|
|
|
|
conj3 : Str -> V = \bo ->
|
|
mk6V bo (bo + "r") bo (bo +"dde") (bo +"tt") (bo +"dd") ;
|
|
|
|
reg2V : Str -> Str -> V = \sliter,slet -> (case <slita,slet> of {
|
|
<_ + "i" + ? + "a", sl + "e" + ?> => irregV slita slet (init slita + "it") ;
|
|
<_ + "u" + ? + "a", sl + "ö" + ?> => irregV slita slet (init slita + "it") ;
|
|
<_ + "u" + ? + ? + "a", sl + "ö" + ? + ?> => irregV slita slet (init slita + "it") ;
|
|
<_ + "i" + ? + ? + "a", sl + "a" + pp@(? + ?)> => irregV slita slet (sl + "u" + pp ++ "it") ;
|
|
_ => regV sliter
|
|
} where {
|
|
slita : Str = case sliter of {
|
|
slit + "er" => slit + "a" ;
|
|
_ => sliter
|
|
}
|
|
}) ;
|
|
|
|
irregV = \sälja, sålde, sålt ->
|
|
let
|
|
säljer = case last sälja of {
|
|
"a" => conj2 sälja ;
|
|
_ => conj3 sälja
|
|
} ;
|
|
såld = case Predef.dp 2 sålt of {
|
|
"it" => Predef.tk 2 sålt + "en" ;
|
|
"tt" => Predef.tk 2 sålt + "dd" ;
|
|
_ => init sålt + "d"
|
|
}
|
|
in
|
|
mk6V sälja (säljer.s ! VF (VPres Act)) (säljer.s ! (VF (VImper Act))) sålde sålt såld
|
|
** {s1 = [] ; lock_V = <>} ;
|
|
|
|
partV v p = case p of {
|
|
"sig" => {s = v.s ; part = [] ; vtype = VRefl ; lock_V = <>} ;
|
|
_ => {s = v.s ; part = p ; vtype = v.vtype ; lock_V = <>}
|
|
} ;
|
|
|
|
depV v = {s = v.s ; part = v.part ; vtype = VPass ; lock_V = <>} ;
|
|
reflV v = {s = v.s ; part = v.part ; vtype = VRefl ; lock_V = <>} ;
|
|
|
|
mkV2 = overload {
|
|
mkV2 : (läser : Str) -> V2 = \v -> dirV2 (regV v) ;
|
|
mkV2 : V -> V2 = dirV2 ;
|
|
mkV2 : Str -> Prep -> V2 = \v -> mmkV2 (regV v) ;
|
|
mkV2 : V -> Prep -> V2 = mmkV2
|
|
} ;
|
|
|
|
|
|
mmkV2 v p = v ** {c2 = mkComplement p.s ; lock_V2 = <>} ;
|
|
dirV2 v = mmkV2 v noPrep ;
|
|
|
|
mkV3 = overload {
|
|
mkV3 : Str -> V3 = \v -> dirdirV3 (regV v) ;
|
|
mkV3 : V -> V3 = dirdirV3 ;
|
|
mkV3 : V -> Prep -> V3 = dirV3 ;
|
|
mkV3 : V -> Prep -> Prep -> V3 = mmkV3
|
|
} ;
|
|
|
|
mmkV3 : V -> Prep -> Prep -> V3 ; -- tala, med, om
|
|
dirV3 : V -> Prep -> V3 ; -- ge, (acc),till
|
|
dirdirV3 : V -> V3 ; -- ge, (dat), (acc)
|
|
|
|
|
|
mmkV3 v p q = v ** {c2 = mkComplement p.s ; c3 = mkComplement q.s ; lock_V3 = <>} ;
|
|
dirV3 v p = mmkV3 v noPrep p ;
|
|
dirdirV3 v = dirV3 v noPrep ;
|
|
|
|
mkV0 v = v ** {lock_V0 = <>} ;
|
|
mkVS v = v ** {lock_VS = <>} ;
|
|
mkVV v = v ** {c2 = mkComplement "att" ; lock_VV = <>} ;
|
|
auxVV v = v ** {c2 = mkComplement [] ; lock_VV = <>} ;
|
|
mkVQ v = v ** {lock_VQ = <>} ;
|
|
|
|
mkVA v = v ** {lock_VA = <>} ;
|
|
|
|
mkV2A = overload {
|
|
mkV2A : V -> V2A = \v -> lin V2A (mmkV2 v (mkPrep [])) ;
|
|
mkV2A : V -> Prep -> V2A = \v, p -> lin V2A (mmkV2 v p) ;
|
|
} ;
|
|
|
|
V0 : Type = V ;
|
|
AS, A2S, AV : Type = A ;
|
|
A2V : Type = A2 ;
|
|
|
|
mkV2S = overload {
|
|
mkV2S : V -> V2S = \v -> lin V2S (mmkV2 v (mkPrep [])) ;
|
|
mkV2S : V -> Prep -> V2S = \v, p -> lin V2S (mmkV2 v p) ;
|
|
} ;
|
|
|
|
|
|
mkV2V = overload {
|
|
mkV2V : V -> V2V =
|
|
\v -> mmkV2 v (mkPrep []) ** {c3 = mkComplement "att" ; lock_V2V = <>} ;
|
|
mkV2V : V -> Prep -> Prep -> V2V =
|
|
\v, p, t -> mmkV2 v p ** {c3 = mkComplement p.s ; lock_V2V = <>} ;
|
|
} ;
|
|
|
|
mkV2Q = overload {
|
|
mkV2Q : V -> V2Q = \v -> lin V2Q (mmkV2 v (mkPrep [])) ;
|
|
mkV2Q : V -> Prep -> V2Q = \v, p -> lin V2Q (mmkV2 v p) ;
|
|
} ;
|
|
|
|
mkAS v = v ** {lock_A = <>} ;
|
|
mkA2S v p = mkA2 v p ** {lock_A = <>} ;
|
|
mkAV v = v ** {lock_A = <>} ;
|
|
mkA2V v p = mkA2 v p ** {lock_A = <>} ;
|
|
|
|
----------Obsolete
|
|
|
|
-- To form a noun phrase that can also be plural and have an irregular
|
|
-- genitive, you can use the worst-case function.
|
|
|
|
makeNP : Str -> Str -> Number -> Gender -> NP ;
|
|
|
|
|
|
|
|
regGenPN : Str -> Gender -> PN ;
|
|
regPN : Str -> PN ; -- utrum
|
|
|
|
-- Sometimes you can reuse a common noun as a proper name, e.g. "Bank".
|
|
|
|
nounPN : N -> PN ;
|
|
|
|
-- Sometimes just the positive forms are irregular.
|
|
|
|
mk3A : (galen,galet,galna : Str) -> A ;
|
|
|
|
mk3cA : (galen,galet,galna : Str) -> Bool -> A =
|
|
\x,y,z,b -> lin A {s = (mk3A x y z).s ; isComp = b} ;
|
|
|
|
mk7V : (supa,super,sup,söp,supit,supen,supande : Str) -> V ;
|
|
mk6V : (supa,super,sup,söp,supit,supen : Str) -> V ;
|
|
regV : (talar : Str) -> V ;
|
|
mk2V : (leka,lekte : Str) -> V ;
|
|
irregV : (dricka, drack, druckit : Str) -> V ;
|
|
|
|
partV : V -> Str -> V ;
|
|
|
|
mmkV2 : V -> Prep -> V2 ;
|
|
|
|
dirV2 : V -> V2 ;
|
|
|
|
|
|
} ;
|