swedish completed

lib/resource-1.0/swedish/MorphoSwe.gf

@@ -0,0 +1,275 @@
+--# -path=.:../scandinavian:../common:../../prelude
+
+--1 A Simple Swedish Resource Morphology
+--
+-- Aarne Ranta 2002 -- 2005
+--
+-- This resource morphology contains definitions needed in the resource
+-- syntax. To build a lexicon, it is better to use $ParadigmsSwe$, which
+-- gives a higher-level access to this module.
+
+resource MorphoSwe = ResScand, DiffSwe ** open Prelude, (Predef=Predef) in {
+
+
+-- Nouns
+
+oper
+
+  mkNoun : (x1,_,_,x4 : Str) -> Noun =
+  \apa,apan,apor,aporna ->  {
+    s = nounForms apa apan apor aporna ;
+    g = case last apan of {
+      "n" => Utr ;
+      _ => Neutr
+      }
+    } ;
+
+  reg2Noun : Str -> Str -> Noun = \bil,bilar -> 
+   let 
+     l  = last bil ;
+     b  = Predef.tk 2 bil ; 
+     ar = Predef.dp 2 bilar ;
+     bile = Predef.tk 2 bilar
+   in 
+   case ar of {
+      "or" => case l of {
+         "a" => decl1Noun bil ;
+         "r" => decl5Noun bil ;
+         "o" => mkNoun bil (bil + "n")  bilar (bilar + "na") ;
+         _   => mkNoun bil (bil + "en") bilar (bilar + "na")
+         } ;
+      "ar" => ifTok Noun bil bilar 
+                (decl5Noun bil) 
+                (ifTok Noun bile bil 
+                 (decl2Noun bil)
+                 (case l of {
+                    "e" => decl2Noun bil ; -- pojke-pojkar
+                    _   => mkNoun bil (bile + "en") bilar (bilar + "na") -- mun-munnar
+                    }
+                 )
+                ) ;
+      "er" => case l of {
+        "e" => mkNoun bil (bil + "n") (bil +"r") (bil + "rna") ;
+        "y" | "å" | "é" => decl3Noun bil ;
+        _   => mkNoun bil (bil + "en") bilar (bilar + "na")
+      } ;
+      "en" => ifTok Noun bil bilar (decl5Noun bil) (decl4Noun bil) ; -- ben-ben
+      _ => ifTok Noun bil bilar (
+             case Predef.dp 3 bil of {
+                "are" => let kikar = init bil in
+                         mkNoun bil (kikar + "en") bil (kikar + "na") ; 
+                _ => decl5Noun bil
+                }
+             )
+             (decl5Noun bil) --- rest case with lots of garbage
+      } ; 
+         
+--- this is a very rough heuristic and misses "er".
+
+  regNoun : Str -> Gender -> Noun = \bil,g -> case g of {
+    Utr => case last bil of {
+      "a" => decl1Noun bil ;
+      _   => decl2Noun bil
+      } ;
+    Neutr => case last bil of {
+      "e" => decl4Noun bil ;
+      _   => decl5Noun bil
+      }
+    } ;
+
+
+-- School declensions.
+
+  decl1Noun : Str -> Noun = \apa -> 
+    let ap = init apa in
+    mkNoun apa (apa + "n") (ap + "or") (ap + "orna") ;
+
+  decl2Noun : Str -> Noun = \bil ->
+    case last bil of {
+      "e" => let pojk = init bil in 
+             mkNoun bil (bil + "n") (pojk + "ar") (pojk + "arna") ;
+      "o" | "u" | "y" => mkNoun bil (bil + "n") (bil + "ar") (bil + "arna") ;
+      _ => mkNoun bil (bil + "en") (bil + "ar") (bil + "arna")
+      } ;
+
+  decl3Noun : Str -> Noun = \sak ->
+    case last sak of {
+      "e" => mkNoun sak (sak + "n") (sak +"r") (sak + "rna") ;
+      "y" | "å" | "é" => mkNoun sak (sak + "n") (sak +"er") (sak + "erna") ;
+      _ => mkNoun sak (sak + "en") (sak + "er") (sak + "erna")
+      } ;
+
+  decl4Noun : Str -> Noun = \rike ->
+    mkNoun rike (rike + "t") (rike + "n") (rike + "na") ;
+
+  decl5Noun : Str -> Noun = \lik ->
+    mkNoun lik (lik + "et") lik (lik + "en") ;
+
+
+-- Adjectives
+
+adjIrreg : (x1,_,_,x4 : Str) -> Adjective ;
+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 : (x1,_,x3 : Str) -> Adjective ;
+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 : (x1,_,x3: Str) -> Adjective ;
+adjAlmostReg ljummen ljummet ljumma = 
+  mkAdjective ljummen ljummet ljumma ljumma 
+              (ljumma + "re") (ljumma + "st") (ljumma + "ste") ;
+
+adjReg : Str -> Adjective = \fin -> 
+  adjAlmostReg fin (fin + "t") (fin + "a") ;
+
+adj2Reg : Str -> Str -> Adjective = \vid,vitt -> 
+  adjAlmostReg vid vitt (vid + "a") ;
+
+
+-- Verbs
+
+-- A friendly form of $ResScand.mkVerb$, using the heuristic 
+-- $ptPretForms$ to infer two forms.
+
+  mkVerb6 : (x1,_,_,_,_,x6 : Str) -> Verb = 
+   \finna,finner,finn,fann,funnit,funnen ->
+    let 
+      funn = ptPretForms funnen ;
+      funnet = funn ! Strong SgNeutr ! Nom ;
+      funna  = funn ! Strong Plg ! Nom 
+    in
+    mkVerb finna finner finn fann funnit funnen funnet funna ;
+
+  ptPretForms : Str -> AFormPos => 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 (SgUtr)) => funn + "en" ;
+       (Strong (SgNeutr)) => funn + "et" ;
+       -- (Weak (AxSg Masc)) => funn + m + "e" ;
+       _ => funn + m + "a"
+       } ;
+     "dd" => case a of {
+       (Strong (SgUtr)) => funn + "dd" ;
+       (Strong (SgNeutr)) => funn + "tt" ;
+       -- (Weak (AxSg Masc)) => funn + "dde" ;
+       _ => funn + "dda"
+       } ;
+     "ad" => case a of {
+       (Strong (SgUtr)) => funn + "ad" ;
+       (Strong (SgNeutr)) => funn + "at" ;
+       _ => funn + "ade"
+       } ;
+     _ => case n of {
+       "d" => case a of {
+         (Strong (SgUtr)) => funne + "d" ;
+         (Strong (SgNeutr)) => funne + "t" ;
+         -- (Weak (AxSg Masc)) => funne + "de" ;
+         _ => funne + "da"
+         } ;
+       _ => case a of {
+         (Strong (SgUtr)) => funne + "t" ;
+         (Strong (SgNeutr)) => funne + "t" ;
+         -- (Weak (AxSg Masc)) => funne + "te" ;
+         _ => funne + "ta"
+         }
+      }
+  }
+  in 
+  mkCase c funna ;
+
+-- This is a general way to form irregular verbs.
+
+  irregVerb : (_,_,_ : 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" ;
+        "tt" => Predef.tk 2 sålt + "dd" ;
+        _ => init sålt + "d"
+        }
+    in 
+    mkVerb6 sälja (sälj + er) sälj sålde sålt såld ;
+
+  regVerb : (_,_ : Str) -> Verb = \tala,talade -> 
+    let 
+      ade   = Predef.dp 3 talade ;
+      de    = Predef.dp 2 ade ;
+      tal   = init tala ;
+      ta    = init tal ;
+      forms = case ade of {
+        "ade" => conj1 tala ;
+        "dde" => case last tala of {
+          "a" => mkVerb6 tala (tal + "er") tal (ta +"tte") (ta +"tt") (ta +"dd") ;
+          _ => conj3 tala
+          } ;
+        "tte" => mkVerb6 tala (tal + "er") tal (ta +"tte") (ta +"tt") (ta +"tt") ;
+        "nde" => mkVerb6 tala (tal + "er") tal (tal +"e") (ta +"t") tal ;
+        "rde" => mkVerb6 tala tal tal (tal +"de") (tal +"t") (tal +"d") ;
+        _ => case de of {
+          "te" => conj2 tala ;
+          _    => conj2d tala
+          }
+        }
+      in forms ** {s1 = []} ;
+
+
+-- school conjugations
+
+conj1 : Str -> Verb = \tala ->
+  mkVerb6 tala (tala + "r") tala (tala +"de") (tala +"t") (tala +"d") ;
+
+conj2 : Str -> Verb = \leka ->
+  let lek = init leka in
+  mkVerb6 leka (lek + "er") lek (lek +"te") (lek +"t") (lek +"t") ;
+
+conj2d : Str -> Verb = \gräva ->
+  let gräv = init gräva in
+  mkVerb6 gräva (gräv + "er") gräv (gräv +"de") (gräv +"t") (gräv +"d") ;
+
+conj3 : Str -> Verb = \bo ->
+  mkVerb6 bo (bo + "r") bo (bo +"dde") (bo +"tt") (bo +"dd") ;
+
+-- for $Structural$
+
+-- for Numerals
+
+param DForm = ental  | ton  | tiotal  ;
+
+oper 
+  LinDigit = {s : DForm => Str} ;
+
+  mkTal : Str -> Str -> Str -> LinDigit = \två, tolv, tjugo -> 
+    {s = table {ental => två ; ton => tolv ; tiotal => tjugo}} ;
+
+  regTal : Str -> LinDigit = \fem -> 
+    mkTal fem (fem + "ton") (fem + "tio") ;
+
+  numPl : Str -> {s : Gender => Str ; n : Number} = \n ->
+    {s = \\_ => n ; n = Pl} ;
+
+} ;
+

lib/resource-1.0/swedish/ParadigmsSwe.gf

@@ -0,0 +1,374 @@
+--# -path=.:../scandinavian:../common:../abstract:../../prelude
+
+--1 Swedish Lexical Paradigms
+--
+-- 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 $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 $IrregularEng$, which covers all irregularly inflected
+-- words.
+
+resource ParadigmsSwe = 
+  open 
+    (Predef=Predef), 
+    Prelude, 
+    ResScand, 
+    DiffSwe, 
+    MorphoSwe, 
+    CatSwe 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 ;
+
+
+--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"). 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 as follows
+
+  regPN : Str -> Gender -> PN ;          -- John, John's
+
+-- Sometimes you can reuse a common noun as a proper name, e.g. "Bank".
+
+  nounPN : N -> PN ;
+
+-- 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. 
+
+  ADeg : Type ;
+
+  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 if the
+-- infinitive ends with "a" ("tala" - "talar" - "talade" - "talat"),
+-- the third in other cases ("bo" - "bor" - "bodde" - "bott").
+
+  regV : (tala : Str) -> V ;
+
+-- The almost regular verb function needs the infinitive and the preteritum.
+-- It can deal with almost all cases in the first, second, and third
+-- conjugation: "tala" - "talade", "leka" - "lekte", 
+-- "gräva" - "grävde", "byta" - "bytte", "vända" - "vände",
+-- "tyda" - "tydde", "bo" - "bodde".
+
+  mk2V : (leka,lekte : 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 "passa på", 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 -> Preposition -> Preposition -> V3 ; -- tala med om
+  dirV3    : V -> Preposition -> V3 ;                -- ge _ till
+  dirdirV3 : V -> V3 ;                               -- ge _ _
+
+--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 ;
+
+-- Notice: categories $V2S, V2V, V2A, V2Q$ are in v 1.0 treated
+-- just as synonyms of $V2$, and the second argument is given
+-- as an adverb. Likewise $AS, A2S, AV, A2V$ are just $A$.
+-- $V0$ is just $V$.
+
+  V0, V2S, V2V, V2A, V2Q : Type ;
+  AS, A2S, AV, A2V : Type ;
+
+
+--2 Definitions of the paradigms
+--
+-- The definitions should not bother the user of the API. So they are
+-- hidden from the document.
+--.
+
+  Gender = DiffSwe.Gender ; 
+  Number = ResScand.Number ;
+  Case = ResScand.Case ;
+  utrum = Utr ; 
+  neutrum = Neutr ;
+  singular = Sg ;
+  plural = Pl ;
+  nominative = Nom ;
+  genitive = Gen ;
+
+  mkN x y z u = mkNoun x y z u ** {lock_N = <>} ;
+  regN x g = regNoun x g ** {lock_N = <>} ;
+  mk2N x g = reg2Noun x g ** {lock_N = <>} ;
+
+  mkN2 = \n,p -> n ** {lock_N2 = <> ; c2 = p} ;
+  regN2 n g = mkN2 (regN n g) (mkPreposition "av") ;
+  mkN3 = \n,p,q -> n ** {lock_N3 = <> ; c2 = p ; c3 = q} ;
+
+  regPN n g = {s = \\c => mkCase c n ; g = g} ** {lock_PN = <>} ;
+  nounPN n = {s = n.s ! singular ! Indef ; g = n.g ; lock_PN = <>} ;
+  mkNP x y n g = 
+    {s = table {NPPoss _ => y ; _ => x} ; a = agrP3 g n ; p = P3 ;
+     lock_NP = <>} ;
+
+  mkA a b c = (adjAlmostReg a b c) ** {lock_A = <>} ;
+  mk2A a b = (adj2Reg a b) ** {lock_A = <>} ;
+  regA a = (adjReg a) ** {lock_A = <>} ;
+
+  mkA2 a p = a ** {c2 = p ; lock_A2 = <>} ;
+
+  ADeg = A ;
+
+  mkADeg a b c d e f g = mkAdjective a b c d e f g ** {lock_A = <>} ;
+  regADeg a = adjReg a ** {lock_A = <>} ;
+  irregADeg a b c = adjIrreg3 a b c ** {lock_A = <>} ;
+  mk3ADeg a b c = adjAlmostReg a b c ** {lock_A = <>} ;
+  mk2ADeg a b = adj2Reg a b ** {lock_A = <>} ;
+
+  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 = mkVerb6 a b c d e f ** {lock_V = <>} ;
+
+  regV a = mk2V a (a + de) where {de = case last a of {"a" => "de" ; _ => "dde"}} ;
+  mk2V a b = regVerb a b ** {lock_V = <>} ;
+
+  irregV x y z = irregVerb x y z
+     ** {s1 = [] ; lock_V = <>} ;
+
+  partV v p = {s = \\f => v.s ! f ++ p ; lock_V = <>} ;
+----  depV v = deponentVerb v ** {lock_V = <>} ;
+
+  mkV2 v p = v ** {s = v.s ; c2 = p ; lock_V2 = <>} ;
+  dirV2 v = mkV2 v [] ;
+
+  mkV3 v p q = v ** {s = v.s ; c2 = p ; c3 = q ; lock_V3 = <>} ;
+  dirV3 v p = mkV3 v [] p ;
+  dirdirV3 v = dirV3 v [] ;
+
+
+  mkV0  v = v ** {lock_V0 = <>} ;
+  mkVS  v = v ** {lock_VS = <>} ;
+  mkVV  v = v ** {c2 = "att" ; lock_VV = <>} ;
+  mkVQ  v = v ** {lock_VQ = <>} ;
+
+  mkVA  v = v ** {lock_VA = <>} ;
+  mkV2A v p = mkV2 v p ** {lock_V2A = <>} ;
+
+  V0 : Type = V ;
+  V2S, V2V, V2Q, V2A : Type = V2 ;
+  AS, A2S, AV : Type = A ;
+  A2V : Type = A2 ;
+
+  mkV2S v p = mkV2 v p ** {lock_V2 = <>} ;
+  mkV2V v p t = mkV2 v p ** {s3 = t ; lock_V2 = <>} ;
+  mkV2Q v p = mkV2 v p ** {lock_V2 = <>} ;
+
+  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 = <>} ;
+
+} ;