resources and new instantiation syntax

lib/resource/abstract/Basic.gf

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

lib/resource/abstract/Clause.gf

@@ -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. 
 

lib/resource/abstract/Rules.gf

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

lib/resource/danish/MorphoDan.gf

@@ -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 Act)    => spiser ;
-       VF (Pres m Pass) => spises ;
+       VF (Pres Pass)   => spises ;
-       VF (Pret m v)    => mkVoice v spiste ;
+       VF (Pret v)      => mkVoice v spiste ;
        VI (Supin v)     => mkVoice v spist ;
-       VI (PtPret c)    => mkCase spist ! c ;
+       VI (PtPret _ c)  => mkCase spist ! c ; ---- GenNum
-       VF Imper         => spis
+       VF (Imper v)     => mkVoice v spis
        }
      } ;
 

lib/resource/danish/RulesDan.gf

@@ -1,4 +1,4 @@
 --# -path=.:../scandinavian:../abstract:../../prelude
 
-concrete RulesDan of Rules =
+concrete RulesDan of Rules = CategoriesDan **
   RulesScand with (SyntaxScand=SyntaxDan) ;

lib/resource/danish/SyntaxDan.gf

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

lib/resource/danish/TestResourceDan.gf

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

lib/resource/danish/TypesDan.gf

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

lib/resource/english/BasicEng.gf

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

lib/resource/english/ClauseEng.gf

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

lib/resource/english/RulesEng.gf

@@ -142,8 +142,8 @@ lin
   IntSlash = intSlash ;
   QuestAdv = questAdverbial ;
 
-  PosImperVP = imperVerbPhrase True ;
+  PosImpVP = imperVerbPhrase True ;
-  NegImperVP = imperVerbPhrase False ;
+  NegImpVP = imperVerbPhrase False ;
 
   IndicPhrase = indicUtt ;
   QuestPhrase = interrogUtt ;

lib/resource/english/SyntaxEng.gf

@@ -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
+       let 
-       walk.s ! b ! VInfinit Simul ! a ++ walk.s2 ! b ! VInfinit Simul ! a
+         a = toAgr n P2 human ;
+         dont = if_then_Str b [] "don't" 
+       in
+       dont ++ walk.s ! a
     } ;
 
   imperUtterance : Number -> Imperative -> Utterance = \n,I ->

lib/resource/french/RulesFre.gf

@@ -1,4 +1,4 @@
 --# -path=.:../romance:../abstract:../../prelude
 
-concrete RulesFre of Rules =
+concrete RulesFre of Rules = CategoriesFre **
   RulesRomance with (SyntaxRomance=SyntaxFre) ;

lib/resource/french/TestResourceFre.gf

@@ -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 {

lib/resource/italian/RulesIta.gf

@@ -1,4 +1,4 @@
 --# -path=.:../romance:../abstract:../../prelude
 
-concrete RulesIta of Rules =
+concrete RulesIta of Rules = CategoriesIta **
   RulesRomance with (SyntaxRomance=SyntaxIta) ;

lib/resource/italian/TestResourceIta.gf

@@ -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 {

lib/resource/norwegian/MorphoNor.gf

@@ -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 Act)    => spiser ;
-       VF (Pres m Pass) => spises ;
+       VF (Pres Pass)   => spises ;
-       VF (Pret m v)    => mkVoice v spiste ;
+       VF (Pret v)      => mkVoice v spiste ;
        VI (Supin v)     => mkVoice v spist ;
-       VI (PtPret c)    => mkCase spist ! c ;
+       VI (PtPret _ c)  => mkCase spist ! c ; ---- GenNum
-       VF Imper         => spis
+       VF (Imper v)     => mkVoice v spis
        }
      } ;
 

lib/resource/norwegian/SyntaxNor.gf

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

lib/resource/norwegian/TypesNor.gf

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

lib/resource/scandinavian/CategoriesScand.gf

@@ -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 ; 
+  VPI    = {s  : VIForm => Gender => Number => Person => Str} ;
-            s3 : Gender => Number => Person => Str} ;
   V2     = TransVerb ; 
       -- = Verb ** {s2 : Preposition} ;
   V3     = TransVerb ** {s3 : Preposition} ;

lib/resource/scandinavian/ClauseScand.gf

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

lib/resource/scandinavian/RulesScand.gf

@@ -126,8 +126,8 @@ lin
   IntSlash = intSlash ;
   QuestAdv = questAdverbial ;
 
-  PosImperVP = imperVerbPhrase True ;
+  PosImpVP = imperVerbPhrase True ;
-  NegImperVP = imperVerbPhrase False ;
+  NegImpVP = imperVerbPhrase False ;
 
   IndicPhrase = indicUtt ;
   QuestPhrase = interrogUtt ;

lib/resource/scandinavian/SyntaxScand.gf

@@ -283,7 +283,9 @@ 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 ; 
+    s : VIForm => Gender => Number => Person => Str
-    s2 : Str ; 
-    s3 : 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 ;
+   {s = table {
-    s2 = vg.s2 ! b ;
+          VIInfinit => \\g,n,p => 
-    s3 = vg.s3 ! VInfinit a ;
+            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.s ! VIInfinit ! g ! n ! p) ;
-              simma.s3 ! 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.s ! VIInfinit ! g ! n ! p) ;
-              simma.s3 ! 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 ++ 
+        (\\g,n,p => be.s1 ++ {-strPrep-} be.s2 ++ dig.s ! PAcc ++ be.s3 ++ 
-              simma.s ++ simma.s2 ++
               if_then_Str obj 
-                 (simma.s3 ! dig.g ! dig.n ! dig.p)
+                 (simma.s ! VIInfinit ! dig.g ! dig.n ! dig.p)
-                 (simma.s3 ! g     ! n     ! 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.s ! VIInfinit ! dig.g ! dig.n ! dig.p)
-                 (simma.s3 ! g ! n ! 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 ;

lib/resource/scandinavian/TypesScand.gf

@@ -96,9 +96,16 @@ oper
 oper Verbum : Type = {s : VerbForm => Str} ;
 
 param
-  VFin ;
+  VFin =
+   Pres Voice
+ | Pret Voice
+ | Imper Voice ;
 
-  VInf ;
+  VInf = 
+   Inf Voice
+ | Supin Voice
+ | PtPret AdjFormPos Case
+ ;
 
   VerbForm = 
      VF VFin

lib/resource/spanish/RulesSpa.gf

@@ -1,4 +1,4 @@
 --# -path=.:../romance:../abstract:../../prelude
 
-concrete RulesSpa of Rules =
+concrete RulesSpa of Rules = CategoriesSpa **
   RulesRomance with (SyntaxRomance=SyntaxSpa) ;

lib/resource/spanish/TestResourceSpa.gf

@@ -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 {

lib/resource/swedish/BasicSwe.gf

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

lib/resource/swedish/ClauseSwe.gf

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

lib/resource/swedish/MorphoSwe.gf

@@ -10,69 +10,268 @@
 
 resource MorphoSwe = TypesSwe ** open Prelude in {
 
+-- Nouns
+
 oper
-  mkVerbPart : (supa,super,sup,söp,supit,supen,upp : Str) -> Verb = 
+  mkNoun : (apa,apan,apor,aporna : Str) -> Subst =
-   \finna,finner,finn,fann,funnit,funnen,upp ->
+  \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 Act) => finner ;
-    VF (Pres Ind Pass) => finn + "s" ;
+    VF (Pres Pass) => mkVoice Pass finn ;
-    VF (Pres Cnj Act) => finn + "e" ;
+    VF (Pret v) => mkVoice v fann ;
-    VF (Pres Cnj Pass) => finn + "es" ;
+    VF (Imper v) => mkVoice v finn ;
-    VF (Pret Ind Act) => fann ;
+    VI (Inf v) => mkVoice v finna ;
-    VF (Pret Ind Pass) => fann + "s" ;
+    VI (Supin v) => mkVoice v funnit ;
-    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" ;
     VI (PtPret a c) => funn ! a ! c
     } ;
-     s1 = upp
+     s1 = []
-    } ;
+   } ;
 
-ptPretForms : Str -> AdjFormPos => Case => Str = \funnen -> \\a,c =>  
+  vFinna : (_,_,_ : Str) -> Verb = \finn, fann, funn -> 
-  mkCase c (
+    mkVerb (finn + "a") (finn + "er") finn fann (funn + "it") (funn + "en") ;
- {- ----
-    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"
-    } ;
 
-  _ => 
+-- Now this is more general and subsumes $vFinna$.
--}
+
-  funnen ---- to be completed
+  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 : (_,_,_,_,_,_,_ : Str) -> Verb = \supa,super,sup,söp,supit,supen,upp ->
-    mkVerbPart supa super sup söp supit supen [] ; 
+    {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 Act) => tal + "ar" ;
-    VF (Pres Ind Pass) => tal + "as" ;
+    VF (Pres Pass) => tal + "as" ;
-    VF (Pres Cnj Act) => tal + "e" ;
+    VF (Pret Act) => tal + "ade" ;
-    VF (Pres Cnj Pass) => tal + "es" ;
+    VF (Pret Pass) => tal + "ades" ;
-    VF (Pret Ind Act) => tal + "ade" ;
+    VF (Imper Act) => tal + "a" ;
-    VF (Pret Ind Pass) => tal + "ades" ;
+    VF (Imper Pass) => tal + "as" ;
-    VF (Pret Cnj Act) => tal + "ade" ;
-    VF (Pret Cnj Pass) => tal + "ades" ;
-    VF Imper => tal + "a" ;
     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 Act) => lek + "er" ;
-    VF (Pres Ind Pass) => variants {lek + "s" ; lek + "es"} ;
+    VF (Pres Pass) => mkVoice Pass lek ;
-    VF (Pres Cnj Act) => lek + "e" ;
+    VF (Pret Act) => lek + "te" ;
-    VF (Pres Cnj Pass) => lek + "es" ;
+    VF (Pret Pass) => lek + "tes" ;
-    VF (Pret Ind Act) => lek + "te" ;
+    VF (Imper v) => mkVoice v lek ;
-    VF (Pret Ind Pass) => lek + "tes" ;
-    VF (Pret Cnj Act) => lek + "te" ;
-    VF (Pret Cnj Pass) => lek + "tes" ;
-    VF Imper => 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 Act) => ty + "der" ;
-    VF (Pres Ind Pass) => variants {ty + "ds" ; ty + "des"} ;
+    VF (Pres Pass) => variants {ty + "ds" ; ty + "des"} ;
-    VF (Pres Cnj Act) => ty + "de" ;
+    VF (Pret Act) => ty + "dde" ;
-    VF (Pres Cnj Pass) => ty + "des" ;
+    VF (Pret Pass) => ty + "ddes" ;
-    VF (Pret Ind Act) => ty + "dde" ;
+    VF (Imper Act) => ty + "d" ;
-    VF (Pret Ind Pass) => ty + "ddes" ;
+    VF (Imper Pass) => ty + "ds" ;
-    VF (Pret Cnj Act) => ty + "dde" ;
-    VF (Pret Cnj Pass) => ty + "ddes" ;
-    VF Imper => ty + "d" ;
     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 Act) => vän + "der" ;
-    VF (Pres Ind Pass) => variants {vän + "ds" ; vän + "des"} ;
+    VF (Pres Pass) => variants {vän + "ds" ; vän + "des"} ;
-    VF (Pres Cnj Act) => vän + "de" ;
+    VF (Pret Act) => vän + "de" ;
-    VF (Pres Cnj Pass) => vän + "des" ;
+    VF (Pret Pass) => vän + "des" ;
-    VF (Pret Ind Act) => vän + "de" ;
+    VF (Imper Act) => vän + "d" ;
-    VF (Pret Ind Pass) => vän + "des" ;
+    VF (Imper Pass) => vän + "ds" ;
-    VF (Pret Cnj Act) => vän + "de" ;
-    VF (Pret Cnj Pass) => vän + "des" ;
-    VF Imper => vän + "d" ;
     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 Act) => by + "ter" ;
-    VF (Pres Ind Pass) => variants {by + "ts" ; by + "tes"} ;
+    VF (Pres Pass) => variants {by + "ts" ; by + "tes"} ;
-    VF (Pres Cnj Act) => by + "te" ;
+    VF (Pret Act) => by + "tte" ;
-    VF (Pres Cnj Pass) => by + "tes" ;
+    VF (Pret Pass) => by + "ttes" ;
-    VF (Pret Ind Act) => by + "tte" ;
+    VF (Imper Act) => by + "t" ;
-    VF (Pret Ind Pass) => by + "ttes" ;
+    VF (Imper Pass) => by + "ts" ;
-    VF (Pret Cnj Act) => by + "tte" ;
-    VF (Pret Cnj Pass) => by + "ttes" ;
-    VF Imper => by + "t" ;
     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 Act) => hyr ;
-    VF (Pres Ind Pass) => variants {hyr + "s" ; hyr + "es"} ;
+    VF (Pres Pass) => variants {hyr + "s" ; hyr + "es"} ;
-    VF (Pres Cnj Act) => hyr + "e" ;
+    VF (Pret Act) => hyr + "de" ;
-    VF (Pres Cnj Pass) => hyr + "es" ;
+    VF (Pret Pass) => hyr + "des" ;
-    VF (Pret Ind Act) => hyr + "de" ;
+    VF (Imper Act) => hyr ;
-    VF (Pret Ind Pass) => hyr + "des" ;
+    VF (Imper Pass) => hyr + "s" ;
-    VF (Pret Cnj Act) => hyr + "de" ;
-    VF (Pret Cnj Pass) => hyr + "des" ;
-    VF Imper => hyr ;
     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 Act) => "har" ;
-    VF (Pres Ind Pass) => variants {"havs" ; "has"} ;
+    VF (Pres Pass) => "has" ;
-    VF (Pres Conj Act) => "have" ;
+    VF (Pret Act) => "hade" ;
-    VF (Pres Conj Pass) => "haves" ;
+    VF (Pret Pass) => "hades" ;
-    VF (Pret Ind Act) => "hade" ;
+    VF (Imper Act) => "ha" ;
-    VF (Pret Ind Pass) => "hades" ;
+    VF (Imper Pass) => "has" ;
-    VF (Pret Conj Act) => "hade" ;
+    VI (Inf Act) => "ha" ;
-    VF (Pret Conj Pass) => "hades" ;
+    VI (Inf Pass) => "has" ;
-    VF Imper => variants {"hav" ; "ha"} ;
-    VI (Inf Act) => variants {"hava" ; "ha"} ;
-    VI (Inf Pass) => variants {"havas" ; "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 Act) => "är" ;
-    VF (Pres Ind Pass) => variants {} ;
+    VF (Pres Pass) => variants {} ;
-    VF (Pres Conj Act) => "vare" ;
+    VF (Pret Act) => "var" ;
-    VF (Pres Conj Pass) => variants {} ;
+    VF (Pret Pass) => variants {} ;
-    VF (Pret Ind Act) => "var" ;
+    VF (Imper _) => "var" ;
-    VF (Pret Ind Pass) => variants {} ;
-    VF (Pret Conj Act) => "vore" ;
-    VF (Pret Conj 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") ;
 
-
-
 }

lib/resource/swedish/NewParadigmsSwe.gf

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

lib/resource/swedish/RulesSwe.gf

@@ -1,4 +1,4 @@
 --# -path=.:../scandinavian:../abstract:../../prelude
 
-concrete RulesSwe of Rules =
+concrete RulesSwe of Rules = CategoriesSwe **
   RulesScand with (SyntaxScand=SyntaxSwe) ;

lib/resource/swedish/SyntaxSwe.gf

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

lib/resource/swedish/TestResourceSwe.gf

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

lib/resource/swedish/TypesSwe.gf

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

src/GF/Compile/Compile.hs

@@ -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
+       sm0 <- putp ("| parsing" +++ file) $ getSourceModule file
-       let mos = case env of ((_,gr,_),_) -> modules gr
        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
+       cm  <- putp ("+ reading" +++ gfc) $ getCanonModule gfc
-       ft <- getReadTimes file
+       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

src/GF/Compile/Extend.hs

@@ -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 :: Bool -> Ident -> Ident -> Info -> Info -> Err Info
-extendAnyInfo isc n i j = errIn ("building extension for" +++ prt n) $ case (i,j) of
+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)
 
 
 

src/GF/Compile/Rebuild.hs

@@ -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] ----

src/GF/Data/Operations.hs

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

src/GF/Infra/Modules.hs

@@ -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 {

src/GF/Infra/ReadFiles.hs

@@ -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 -> 
+    ---- m:n:"with":ms -> 
-      ((MTyOther,name),(m,MUInstance):(n,MUOther):[(n,MUComplete) | n <- 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])
 

src/GF/Source/AbsGF.hs

@@ -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)

src/GF/Source/GF.cf

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

src/GF/Source/GrammarToSource.hs

@@ -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']]
 

src/GF/Source/LexGF.hs

@@ -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
+eitherResIdent tv s = treeFind resWords
-  isResWord s = isInTree s $
+  where
-    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))))
+  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)
+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)
-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
 
 unescapeInitTail :: String -> String
 unescapeInitTail = unesc . tail where

src/GF/Source/LexGF.x

@@ -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
+eitherResIdent tv s = treeFind resWords
-  isResWord s = isInTree s $
+  where
-    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))))
+  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)
+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)
-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
 
 unescapeInitTail :: String -> String
 unescapeInitTail = unesc . tail where

src/GF/Source/PrintGF.hs

@@ -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])
 

src/GF/Source/SourceToGrammar.hs

@@ -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
+        m'       <- transIdent m
-        opens' <- mapM transOpen opens 
+        opens'   <- mapM transOpen opens 
-        return (id', GM.ModWith mtyp' mstat' m' 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))
+   mkAbs a = MModule q (MTAbstract absName) (MBody ne (OpenIn [])  (topDefs a))
-   mkRes ps r = MModule q (MTResource resName) (MBody ne (Opens ops) (topDefs r))
+   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))
+                               (MBody ne (OpenIn (map OName (resName:ps))) (topDefs r))
-   mkPack (m, ds) = MModule q (MTResource m) (MBody ne  (Opens []) (topDefs ds))
+   mkPack (m, ds) = MModule q (MTResource m) (MBody ne  (OpenIn []) (topDefs ds))
    topDefs t = t
    ne = NoExt
    q = CMCompl