scandinavian topological sentence model

lib/prelude/Prelude.gf

@@ -63,6 +63,11 @@ oper
 
   if_then_Str : Bool -> Str -> Str -> Str = if_then_else Str ;
 
+  onlyIf : Bool -> Str -> Str = \b,s -> case b of {
+    True => s ;
+    _ => nonExist
+    } ;
+
 -- zero, one, two, or more (elements in a list etc)
 
 param

lib/resource/abstract/Clause.gf

@@ -30,7 +30,7 @@ fun
   SPredSuperl  : NP -> ADeg -> Cl ;           -- "John is the oldest"
   SPredCN      : NP -> CN -> Cl ;             -- "John is a man"
   SPredNP      : NP -> NP -> Cl ;             -- "John is Bill"
-  SPredPP      : NP -> PP -> Cl ;             -- "John is in France"
+  SPredAdv     : NP -> Adv -> Cl ;            -- "John is in France"
   SPredAV      : NP -> AV  ->VPI ->Cl ;       -- "John is eager to leave"
   SPredObjA2V  : NP -> A2V -> NP ->VPI ->Cl ; -- "John is easy for us to convince"
 
@@ -55,7 +55,7 @@ fun
   QPredSuperl  : IP -> ADeg -> QCl ;           -- "who is the oldest"
   QPredCN      : IP -> CN -> QCl ;             -- "who is a man"
   QPredNP      : IP -> NP -> QCl ;             -- "who is Bill"
-  QPredPP      : IP -> PP -> QCl ;             -- "who is in France"
+  QPredAdv     : IP -> Adv -> QCl ;            -- "who is in France"
   QPredAV      : IP -> AV  ->VPI ->QCl ;       -- "who is eager to leave"
   QPredObjA2V  : IP -> A2V -> NP ->VPI ->QCl ; -- "who is easy for us to convince"
 

lib/resource/abstract/ClauseI.gf

@@ -25,7 +25,7 @@ incomplete concrete ClauseI of Clause = open Rules, Verbphrase in {
   SPredSuperl np a = PredVP np (PredSuperl a) ;
   SPredCN np v = PredVP np (PredCN v) ;
   SPredNP np v = PredVP np (PredNP v) ;
-  SPredPP np v = PredVP np (PredPP v) ;
+  SPredAdv np v = PredVP np (PredAdv v) ;
   SPredAV np v x = PredVP np (PredAV v x) ;
   SPredObjA2V np v x y = PredVP np (PredObjA2V v x y) ;
 
@@ -49,7 +49,7 @@ incomplete concrete ClauseI of Clause = open Rules, Verbphrase in {
   QPredSuperl np a = IntVP np (PredSuperl a) ;
   QPredCN np v = IntVP np (PredCN v) ;
   QPredNP np v = IntVP np (PredNP v) ;
-  QPredPP np v = IntVP np (PredPP v) ;
+  QPredAdv np v = IntVP np (PredAdv v) ;
   QPredAV np v x = IntVP np (PredAV v x) ;
   QPredObjA2V np v x y = IntVP np (PredObjA2V v x y) ;
 

lib/resource/abstract/Simple.gf

@@ -0,0 +1,41 @@
+abstract Simple = Categories ** {
+
+cat
+
+  Sentence ;
+
+fun
+
+  PAffirm    : Sentence -> Phr ;
+  PNegate    : Sentence -> Phr ;
+  PQuestion  : Sentence -> Phr ;
+  PCommand   : Imp      -> Phr ;
+
+  SVerb      : NP -> V         -> Sentence ;
+  STransVerb : NP -> V2 -> NP  -> Sentence ;
+  SAdjective : NP -> AP        -> Sentence ;
+  SAdverb    : NP -> Adv       -> Sentence ;
+
+  SModified  : Sentence -> Adv -> Sentence ;
+
+  PIntV      : IP -> V        -> Phr ;
+  PIntSubjV2 : IP -> V2 -> NP -> Phr ;
+  PIntObjV2  : IP -> NP -> V2 -> Phr ;
+  PIntAP     : IP -> AP ->       Phr ;
+  PIntAdv    : IP -> Adv ->      Phr ;
+
+  NPDef   : CN -> NP ;
+  NPIndef : CN -> NP ;
+  NPGroup : CN -> NP ;
+  NPMass  : CN -> NP ;
+  NPName  : PN -> NP ;
+
+  NSimple   : N -> CN ;
+  NModified : AP -> CN -> CN ;
+
+  ASimple : ADeg -> AP ;
+  AVery   : ADeg -> AP ;
+
+  AdvPrep : Prep -> NP -> Adv ;
+
+}

lib/resource/abstract/SimpleAux.gf

@@ -0,0 +1,6 @@
+resource SimpleAux = {
+
+param
+  SentenceForm = SAffirm | SNegate | SQuestion ;
+
+}

lib/resource/abstract/SimpleI.gf

@@ -0,0 +1,73 @@
+incomplete concrete SimpleI of Simple = 
+  open Predef, Prelude, SimpleAux, Categories, Rules, Structural, Verbphrase in {
+
+lincat
+
+  Sentence = {s : SentenceForm => Str} ;
+
+lin
+  PAffirm sent = ss (sent.s ! SAffirm) ** {lock_Phr = <>} ;
+  PNegate sent = ss (sent.s ! SNegate)  ** {lock_Phr = <>} ;
+  PQuestion sent =  ss (sent.s ! SQuestion)  ** {lock_Phr = <>} ;
+  PCommand = ImperOne ;
+
+  SVerb np v = {s = table {
+    SAffirm => toStr S (UseCl (PosTP TPresent ASimul) (PredVP np (UseV v))) ;
+    SNegate => toStr S (UseCl (NegTP TPresent ASimul) (PredVP np (UseV v))) ;
+    SQuestion => toStr QS (UseQCl (PosTP TPresent ASimul) (QuestCl (PredVP np
+    (UseV v))))
+    }
+  } ;
+
+  STransVerb np tv obj = {s = table {
+    SAffirm => toStr S (UseCl (PosTP TPresent ASimul) (PredVP np (ComplV2 tv obj))) ; 
+    SNegate => toStr S (UseCl (PosTP TPresent ASimul) (PredVP np (ComplV2 tv obj))) ; 
+    SQuestion => 
+      toStr QS (UseQCl (PosTP TPresent ASimul) (QuestCl (PredVP np (ComplV2 tv obj))))
+    }
+  } ;
+
+  SAdjective np ap = {s = table {
+    SAffirm => toStr S (UseCl (PosTP TPresent ASimul) (PredVP np (PredAP ap))) ;
+    SNegate => toStr S (UseCl (NegTP TPresent ASimul) (PredVP np (PredAP ap))) ;
+    SQuestion => toStr QS (UseQCl (PosTP TPresent ASimul) (QuestCl (PredVP np
+    (PredAP ap))))
+    }
+  } ;
+
+  SAdverb np ap = {s = table {
+    SAffirm => toStr S (UseCl (PosTP TPresent ASimul) (PredVP np (PredAdv ap))) ;
+    SNegate => toStr S (UseCl (NegTP TPresent ASimul) (PredVP np (PredAdv ap))) ;
+    SQuestion => toStr QS (UseQCl (PosTP TPresent ASimul) (QuestCl (PredVP np
+    (PredAdv ap))))
+    }
+  } ;
+
+  SModified s a = {s = \\f => s.s ! f ++ a.s ; lock_S = <>} ; ---
+
+  PIntV ip v = 
+    QuestPhrase (UseQCl (PosTP TPresent ASimul) (IntVP ip (UseV v))) ;
+  PIntSubjV2 ip v np = 
+    QuestPhrase (UseQCl (PosTP TPresent ASimul) (IntVP ip (ComplV2 v np))) ;
+  PIntObjV2 ip np v = 
+    QuestPhrase (UseQCl (PosTP TPresent ASimul) (IntSlash ip (SlashV2 np v))) ;
+  PIntAP ip v = 
+    QuestPhrase (UseQCl (PosTP TPresent ASimul) (IntVP ip (PredAP v))) ;
+  PIntAdv ip v = 
+    QuestPhrase (UseQCl (PosTP TPresent ASimul) (IntVP ip (PredAdv v))) ;
+
+  NPDef   = DefOneNP ;
+  NPIndef = IndefOneNP ;
+  NPGroup = IndefNumNP NoNum ;
+  NPMass  = MassNP ;
+  NPName  = UsePN ;
+
+  NSimple = UseN ;
+  NModified = ModAP ;
+
+  ASimple = PositADeg ;
+  AVery a = AdvAP very_Adv (PositADeg a) ;
+
+  AdvPrep p np = AdvPP (PrepNP p np) ;
+
+}

lib/resource/abstract/SimpleLang.gf

@@ -0,0 +1,26 @@
+--# -path=.:../../prelude
+
+abstract SimpleLang = 
+  Simple, 
+  Structural,
+  Basic, 
+  Time, 
+  Country 
+
+  ** {
+  fun
+
+-- Mount $Time$.
+
+  AdvDate : Date -> Adv ;
+  AdvTime : Time -> Adv ;
+  NWeekday : Weekday -> N ;
+  PNWeekday : Weekday -> PN ;
+
+-- Mount $Country$.
+
+  PNCountry : Country -> PN ;
+  ANationality : Nationality -> A ;
+  NLanguage : Language -> N ;
+
+}

lib/resource/abstract/Verbphrase.gf

@@ -37,7 +37,7 @@ abstract Verbphrase = Categories ** {
   PredSuperl   : ADeg -> VP ;             -- "is the oldest"
   PredCN       : CN -> VP ;               -- "is a man"
   PredNP       : NP -> VP ;               -- "is Bill"
-  PredPP       : PP -> VP ;               -- "is in France"
+  PredAdv      : Adv -> VP ;              -- "is in France", "is here"
   PredAV       : AV  -> VPI -> VP   ;     -- "is eager to leave"
   PredObjA2V   : A2V -> NP -> VPI -> VP ; -- "is easy for us to convince"
 

lib/resource/english/CategoriesEng.gf

@@ -75,6 +75,7 @@ lincat
   Tense  = {s : Str ; t : Tense} ;
   Ant    = {s : Str ; a : Anteriority} ;
 
+  PP     = {s : Str} ;
   Adv    = {s : Str} ;
   AdV    = {s : Str} ;
   AdA    = {s : Str} ;
@@ -90,7 +91,7 @@ lincat
 
   IP     = {s : NPForm => Str ; n : Number ; g : Gender} ;
   IDet   = {s : Str ; n : Number} ;
-  IAdv   = {s : Str } ;
+  IAdv   = {s : Str} ;
   QCl    = {s : Bool => SForm => QuestForm => Str} ;
   QS     = {s :                  QuestForm => Str} ;
   Imp    = {s : Number => Str} ;

lib/resource/english/ClauseEng.gf

@@ -25,7 +25,7 @@ concrete ClauseEng of Clause = CategoriesEng **
   SPredSuperl np a = predBeGroup np (complAdjective (superlAdjPhrase a)) ;
   SPredCN np v = predBeGroup np (complCommNoun v) ;
   SPredNP np v = predBeGroup np (complNounPhrase v) ;
-  SPredPP np v = predBeGroup np (complAdverb v) ;
+  SPredAdv np v = predBeGroup np (complAdverb v) ;
 
   SPredAV np v x = predBeGroup np (complVerbAdj v x) ;
   SPredObjA2V np v x y = predBeGroup np (complVerbAdj2 True v x y) ;
@@ -52,7 +52,7 @@ concrete ClauseEng of Clause = CategoriesEng **
   QPredSuperl np a = predBeGroupQ np (complAdjective (superlAdjPhrase a)) ;
   QPredCN np v = predBeGroupQ np (complCommNoun v) ;
   QPredNP np v = predBeGroupQ np (complNounPhrase v) ;
-  QPredPP np v = predBeGroupQ np (complAdverb v) ;
+  QPredAdv np v = predBeGroupQ np (complAdverb v) ;
   QPredAV np v x = predBeGroupQ np (complVerbAdj v x) ;
   QPredObjA2V np v x y = predBeGroupQ np (complVerbAdj2 True v x y) ;
 

lib/resource/english/SimpleEng.gf

@@ -0,0 +1,8 @@
+--# -path=.:../abstract:../../prelude
+
+concrete SimpleEng of Simple = CategoriesEng ** SimpleI with
+  (Categories = CategoriesEng),
+  (Rules = RulesEng),
+  (Structural = StructuralEng),
+  (Verbphrase = VerbphraseEng)
+  ;

lib/resource/english/SimpleLangEng.gf

@@ -0,0 +1,21 @@
+--# -path=.:../abstract:../../prelude
+
+concrete SimpleLangEng of SimpleLang = 
+  SimpleEng, 
+  StructuralEng,
+  BasicEng,
+  TimeEng,
+  CountryEng
+
+   ** open Prelude, ParadigmsEng in {
+
+lin
+  AdvDate d = prefixSS "on" d ;
+  AdvTime t = prefixSS "at" t ;
+  NWeekday w = w ;
+  PNWeekday w = nounPN w ;
+
+  PNCountry x = x ;
+  ANationality x = x ;
+  NLanguage x = x ;
+}

lib/resource/english/SyntaxEng.gf

@@ -668,7 +668,6 @@ oper
 
   param Order = Dir | Inv ;
 
-  ---- compiles to 4k lines gfr. also relSlash, relVerbPhrase are bad
   oper
   Verbal = VForm => Agr => Str ;
 
@@ -701,12 +700,12 @@ oper
        Inv => \\b,sf =>  
          let
            does = vp.s  ! b ! sf ! ag ;
-           walk = vp.s2 ! b ! sf ! ag
+           walk = vp.s2 ! False ! sf ! ag
          in
          case sf of {
            VFinite t Simul => case b of {
-             True => auxTense b t ag ++ it ++ walk ;
+             True => if_then_Str vp.isAux does (auxTense b t ag)++ it ++ walk ;
-             _    => does            ++ it ++ walk
+             _    => does ++ it ++ walk
             } ;
            _ => does ++ it ++ walk
            }

lib/resource/english/VerbphraseEng.gf

@@ -41,7 +41,7 @@ concrete VerbphraseEng of Verbphrase = CategoriesEng **
   PredSuperl a = predClauseBeGroup (complAdjective (superlAdjPhrase a)) ;
   PredCN v = predClauseBeGroup (complCommNoun v) ;
   PredNP v = predClauseBeGroup (complNounPhrase v) ;
-  PredPP v = predClauseBeGroup (complAdverb v) ;
+  PredAdv v = predClauseBeGroup (complAdverb v) ;
 
   PredAV v x = predClauseBeGroup (complVerbAdj v x) ;
   PredObjA2V v x y = predClauseBeGroup (complVerbAdj2 True v x y) ;

lib/resource/french/LangFre.gf

@@ -1,8 +1,8 @@
 --# -path=.:../romance:../abstract:../../prelude
 
-concrete LangFre of Lang = 
+concrete LangFre of LangVP = 
   RulesFre, 
-  ClauseFre, 
+  VerbphraseFre, 
   StructuralFre,  
   BasicFre,
   TimeFre,

lib/resource/french/ResourceFre.gf

@@ -1,4 +1,4 @@
 --# -path=.:../romance:../abstract:../../prelude
 
-concrete ResourceFre of Resource = RulesFre, StructuralFre, ClauseFre ** {} ;
+concrete ResourceFre of ResourceVP = RulesFre, StructuralFre, VerbphraseFre ** {} ;
 

lib/resource/french/SimpleFre.gf

@@ -0,0 +1,8 @@
+--# -path=.:../romancs:../abstract:../../prelude
+
+concrete SimpleFre of Simple = CategoriesFre ** SimpleI with
+  (Categories = CategoriesFre),
+  (Rules = RulesFre),
+  (Structural = StructuralFre),
+  (Verbphrase = VerbphraseFre)
+  ;

lib/resource/french/SimpleLangFre.gf

@@ -0,0 +1,21 @@
+--# -path=.:../romance:../abstract:../../prelude
+
+concrete SimpleLangFre of SimpleLang = 
+  SimpleFre, 
+  StructuralFre,  
+  BasicFre,
+  TimeFre,
+  CountryFre
+
+   ** open Prelude, ParadigmsFre in {
+
+lin
+  AdvDate d = prefixSS "le" d ;
+  AdvTime t = prefixSS "à" t ;
+  NWeekday w = w ;
+  PNWeekday w = mkPN (w.s ! singular) w.g ;
+
+  PNCountry x = x ;
+  ANationality x = x ;
+  NLanguage x = x ;
+}

lib/resource/romance/RulesRomance.gf

@@ -98,8 +98,8 @@ lin
 --
 
   SlashV2  = slashTransVerb ;
-  SlashVV2 = slashVerbVerb ;
+----  SlashVV2 = slashVerbVerb ;
-  SlashAdv = slashAdverb ;
+----  SlashAdv = slashAdverb ;
 
   IdRP = identRelPron ;
   FunRP = funRelPron ;

lib/resource/romance/SyntaxRomance.gf

@@ -928,7 +928,8 @@ oper
   ClauseSlashNounPhrase = Clause ** Complement ;
 
   slashTransVerb : NounPhrase -> TransVerb -> ClauseSlashNounPhrase = 
-    \jean,aimer ->
+    \jean,aimer -> variants {} ; ----
+{- ----
     predVerbGroupClause jean (predClauseGroup aimer (complVerb aimer)) **
     complementOfTransVerb aimer ;
 
@@ -941,7 +942,7 @@ oper
 
   slashAdverb : Clause -> {s : Str ; c : CaseA} -> ClauseSlashNounPhrase = 
     \ilhabite,dans -> ilhabite ** {s2 = dans.s ; c = dans.c} ;
-
+-}
 
 --2 Relative pronouns and relative clauses
 --

lib/resource/romance/VerbphraseRomance.gf

@@ -29,14 +29,14 @@ incomplete concrete VerbphraseRomance of Verbphrase = CategoriesRomance **
   UsePassV v = predClauseBeGroup (passVerb v) ;
   ComplV2 v x = predClauseGroup v (complTransVerb v x) ;
   ComplV3 v x y = predClauseGroup v (complDitransVerb v x y) ;
-  ComplReflV2 v = predClauseGroup v (reflTransVerb v) ;
+----  ComplReflV2 v = predClauseGroup v (reflTransVerb v) ;
   ComplVS v x = predClauseGroup v (complSentVerb v x) ;
   ComplVV v x = predClauseGroup v (complVerbVerb v x) ;
   ComplVQ v x = predClauseGroup v (complQuestVerb v x) ;
   ComplVA v x = predClauseGroup v (complAdjVerb v x) ;
   ComplV2A v x y = predClauseGroup v (complDitransAdjVerb v x y) ;
-  ComplSubjV2V v x y = predClauseGroup v (complDitransVerbVerb False v x y) ;
+----  ComplSubjV2V v x y = predClauseGroup v (complDitransVerbVerb False v x y) ;
-  ComplObjV2V v x y = predClauseGroup v (complDitransVerbVerb True v x y) ;
+----  ComplObjV2V v x y = predClauseGroup v (complDitransVerbVerb True v x y) ;
   ComplV2S v x y = predClauseGroup v (complDitransSentVerb v x y) ;
   ComplV2Q v x y = predClauseGroup v (complDitransQuestVerb v x y) ;
 
@@ -44,7 +44,7 @@ incomplete concrete VerbphraseRomance of Verbphrase = CategoriesRomance **
   PredSuperl a = predClauseBeGroup (complAdjective (superlAdjPhrase a)) ;
   PredCN v = predClauseBeGroup (complCommNoun v) ;
   PredNP v = predClauseBeGroup (complNounPhrase v) ;
-  PredPP v = predClauseBeGroup (complAdverb v) ;
+  PredAdv v = predClauseBeGroup (complAdverb v) ;
 
   PredAV v x = predClauseBeGroup (complVerbAdj v x) ;
   PredObjA2V v x y = predClauseBeGroup (complVerbAdj2 True v x y) ;

lib/resource/scandinavian/CategoriesScand.gf

@@ -68,7 +68,7 @@ lincat
   S      = Sentence ;
       -- = {s :                  Order => Str} ;
   Cl     = Clause ;
-      -- = {s : Bool => SForm => Order => Str} ;
+      -- = {s : Bool => ClForm => Str} ;
   Slash  = Clause ** {s2 : Preposition} ;
 
   RP     = {s : RelCase => GenNum => Str ; g : RelGender} ;

lib/resource/scandinavian/LangSats.gf

@@ -0,0 +1,27 @@
+--# -path=.:../../prelude
+
+abstract LangSats = 
+  Rules, 
+  Sats,
+  Structural, 
+  Basic, 
+  Time, 
+  Country 
+
+  ** {
+  fun
+
+-- Mount $Time$.
+
+  AdvDate : Date -> Adv ;
+  AdvTime : Time -> Adv ;
+  NWeekday : Weekday -> N ;
+  PNWeekday : Weekday -> PN ;
+
+-- Mount $Country$.
+
+  PNCountry : Country -> PN ;
+  ANationality : Nationality -> A ;
+  NLanguage : Language -> N ;
+
+}

lib/resource/scandinavian/RulesScand.gf

@@ -77,7 +77,7 @@ lin
   UseRCl tp cl = 
     {s = \\gn,p => tp.s ++ cl.s ! tp.b ! VFinite tp.t tp.a ! gn ! p} ;
   UseQCl tp cl = {s = \\q => tp.s ++ cl.s ! tp.b ! VFinite tp.t tp.a ! q} ;
- 
+
   PosTP t a = {s = t.s ++ a.s ; b = True  ; t = t.t ; a = a.a} ;
   NegTP t a = {s = t.s ++ a.s ; b = False ; t = t.t ; a = a.a} ;
 

lib/resource/scandinavian/SatsScand.gf

@@ -0,0 +1,162 @@
+--1 Topological structure of Scandinavian sentences.
+--
+-- This is an alternative, more 'native' analysis than $Clause$ and
+-- $Verbphrase$, due to Diderichsen.
+--
+-- Sources:
+--   N. Jörgensen & J. Svensson, "Nusvensk grammatik" (Gleerups, 2001);
+--   R. Zola Christensen, "Dansk grammatik for svenskere"
+--   (Studentlitteratur 1999).
+
+incomplete concrete SatsScand of Sats = CategoriesScand ** 
+  open Prelude, SyntaxScand in {
+
+  flags optimize=parametrize ;
+
+-- The analysis is based on the notions of fundament, nexus, and
+-- content ("innehåll") fields. Nexus and content are both divided into
+-- two subfields - a verb, a noun phrase, and an adverbial.
+-- In addition, there is a field for an extraposed sentence.
+-- Each of these subfields can in a main clause be 'moved' to the
+-- sentence-initial fundament position.
+
+  lincat 
+    Sats = {
+      s1 : SForm => Str ;   -- V1 har
+      s2 : Str ;            -- N1 jag
+      s3 : Bool => Str ;    -- A1 inte
+      s4 : SForm => Str ;   -- V2 sett
+      s5 : Str ;            -- N2 dig
+      s6 : Str ;            -- A2 idag
+      s7 : Str ;            -- S  att... (extraposed sentence)
+      e3,e4,e5,e6,e7 : Bool -- indicate if the field exists
+      } ;
+
+-- Thus the fundament is not a part of the $Sats$, but it is only
+-- created when the $Sats$ is used as a $Main$ clause.
+-- In an $Inv$erted clause, no fundament is created.
+-- In a $Sub$ordinate clause, the order is rigid as well.
+
+  lin
+    ClSats sats = {s = \\b,cf =>
+      let
+        osf  = cl2s cf ;
+        har  = sats.s1 ! osf.sf ;
+        jag  = sats.s2 ;
+        inte = sats.s3 ! b ;
+        sagt = sats.s4 ! osf.sf ;
+        dig  = sats.s5 ;
+        idag = sats.s6 ;
+        exts = sats.s7
+      in case osf.o of {
+      Main => variants {
+               jag  ++ har ++ inte ++ sagt ++ dig  ++ idag ++ exts ;
+        onlyIf (orB sats.e3 (notB b)) 
+               (inte ++ har ++ jag  ++ sagt ++ dig  ++ idag ++ exts) ;
+        onlyIf (orB sats.e4 (isCompoundClForm cf))
+               (sagt ++ har ++ jag  ++ inte ++ dig  ++ idag ++ exts) ;
+        onlyIf sats.e5 
+               (dig  ++ har ++ jag  ++ inte ++ sagt ++ idag ++ exts) ;
+        onlyIf sats.e6 
+               (idag ++ har ++ jag  ++ inte ++ sagt ++ dig  ++ exts) ;
+        onlyIf sats.e7 
+               (exts ++ har ++ jag  ++ inte ++ sagt ++ dig  ++ idag)
+        } ;
+      Inv => 
+        har ++ jag  ++ inte ++ sagt ++ dig ++ idag ++ exts ;
+      Sub => 
+        jag ++ inte ++ har  ++ sagt ++ dig ++ idag ++ exts
+      }
+    } ;
+
+-- The following rules show how the fields are filled in a
+-- predication, with different subcategorization patterns.
+
+    SatsV = mkSats ;
+
+    SatsV2 subj verb obj = 
+      mkSatsObject subj verb (verb.s2 ++ obj.s ! PAcc) ;
+
+    SatsV3 subj verb obj1 obj2 = 
+      mkSatsObject subj verb (verb.s2 ++ obj1.s ! PAcc ++ verb.s3 ++ obj2.s ! PAcc) ;
+
+    SatsReflV2 subj verb = 
+      mkSatsObject subj verb (verb.s2 ++ reflPron subj.n subj.p) ;
+
+    SatsVS subj verb sent = 
+      insertExtrapos (mkSats subj verb) (optStr infinAtt ++ sent.s ! Sub) ;
+
+    SatsVQ subj verb quest = 
+      insertExtrapos (mkSats subj verb) (quest.s ! IndirQ) ;
+
+    SatsV2S subj verb obj sent = 
+      insertExtrapos 
+        (mkSatsObject subj verb (verb.s2 ++ obj.s ! PAcc)) 
+        (optStr infinAtt ++ sent.s ! Sub) ;
+
+    SatsV2Q subj verb obj quest = 
+      insertExtrapos 
+        (mkSatsObject subj verb (verb.s2 ++ obj.s ! PAcc)) 
+        (quest.s ! IndirQ) ;
+
+    SatsAP subj adj = 
+      mkSatsCopula subj (adj.s ! predFormAdj subj.g subj.n ! Nom) ;
+
+    SatsCN subj cn = 
+      mkSatsCopula subj (indefNoun subj.n cn) ;
+
+    SatsNP subj np = 
+      mkSatsCopula subj (np.s ! PNom) ;
+
+    SatsAdv subj adv = 
+      mkSatsCopula subj adv.s ;
+
+-- No problem to insert a verb-complement verb:
+---- (another rule needed for complement in perfect: "jag vill ha gått")
+
+    VVSats sats vv = 
+     let 
+       harvelat = verbSForm vv Act 
+     in 
+     {s1 = \\sf => (harvelat sf).fin ;
+      s2 = sats.s2 ;
+      s3 = sats.s3 ;
+      s4 = \\sf => (harvelat sf).inf ++ sats.s4 ! VInfinit Simul ;
+      s5 = sats.s5 ;
+      s6 = sats.s6  ;
+      s7 = sats.s7  ;
+      e3 = sats.e3 ;
+      e4 = True ;
+      e5 = sats.e5 ;
+      e6 = sats.e6 ;
+      e7 = sats.e7
+      } ;
+
+-- This is where sentence adverbials are inserted.
+
+    AdVSats sats adv = {
+      s1 = sats.s1 ;
+      s2 = sats.s2 ;
+      s3 = \\b => sats.s3 ! b ++ adv.s ;
+      s4 = sats.s4 ;
+      s5 = sats.s5 ;
+      s6 = sats.s6 ;
+      s7 = sats.s7 ;
+      e3 = True ;
+      e4 = sats.e4 ;
+      e5 = sats.e5 ;
+      e6 = sats.e6 ;
+      e7 = sats.e7
+      } ;
+
+-- This is where other adverbials ('TSR') are inserted. There is an
+-- operation for this, since this place is used for many more things
+-- than the sentence adverbial place
+
+    AdvSats sats adv = insertAdverb sats adv.s ;
+
+-- with proper means in GF, this would become even nicer:
+
+---    AdVSats sats adv = sats ** {s3 = sats.s3 ++ adv.s ; e3 = True} ;
+
+}

lib/resource/scandinavian/SyntaxScand.gf

@@ -792,6 +792,11 @@ param
     ;
 
 oper 
+  isCompoundClForm : ClForm -> Bool = \cf -> case cf of {
+    ClFinite Present Simul _ | ClFinite Past Simul _ => False ;
+    _ => True
+    } ;
+
   cl2s : ClForm -> {o : Order ; sf : SForm} = \c -> case c of {
     ClFinite t a o   => {o = o ; sf = VFinite t a} ;
     ClInfinite a     => {o = Sub ; sf = VInfinit a} -- "jag såg John inte hälsa"
@@ -825,6 +830,82 @@ oper
        }
     } ;
 
+--3 For $Sats$, the native topological structure.
+
+    Sats = {
+      s1 : SForm => Str ;  -- V1 har
+      s2 : Str ;           -- N1 jag
+      s3 : Bool => Str ;   -- A1 inte
+      s4 : SForm => Str ;  -- V2 sagt
+      s5 : Str ;           -- N2 dig
+      s6 : Str ;           -- A2 idag
+      s7 : Str ;           -- S  extraposition
+      e3,e4,e5,e6,e7 : Bool   -- indicate if the field exists
+      } ;
+
+  mkSats : NounPhrase -> Verb -> Sats = \subj,verb ->
+     let 
+       harsovit = verbSForm verb Act 
+     in
+     {s1 = \\sf => (harsovit sf).fin ;
+      s2 = subj.s ! PNom ;
+      s3 = negation ;
+      s4 = \\sf => (harsovit sf).inf ++ verb.s1 ;
+      s5, s6, s7 = [] ;
+      e3,e4,e5,e6,e7 = False
+      } ;
+
+  insertObject : Sats -> Str -> Sats = \sats, obj -> 
+     {s1 = sats.s1 ;
+      s2 = sats.s2 ;
+      s3 = sats.s3 ;
+      s4 = sats.s4 ;
+      s5 = sats.s5 ++ obj ;
+      s6 = sats.s6 ;
+      s7 = sats.s7 ;
+      e3 = sats.e3 ;
+      e4 = sats.e4 ;
+      e5 = True ;
+      e6 = sats.e6 ;
+      e7 = sats.e7
+      } ;
+
+  insertAdverb : Sats -> Str -> Sats = \sats, adv -> 
+     {s1 = sats.s1 ;
+      s2 = sats.s2 ;
+      s3 = sats.s3 ;
+      s4 = sats.s4 ;
+      s6 = sats.s6 ++ adv ;
+      s5 = sats.s5 ;
+      s7 = sats.s7 ;
+      e3 = sats.e3 ;
+      e4 = sats.e4 ;
+      e6 = True ;
+      e5 = sats.e5 ;
+      e7 = sats.e7
+      } ;
+
+  insertExtrapos : Sats -> Str -> Sats = \sats, exts -> 
+     {s1 = sats.s1 ;
+      s2 = sats.s2 ;
+      s3 = sats.s3 ;
+      s4 = sats.s4 ;
+      s6 = sats.s6 ;
+      s5 = sats.s5 ;
+      s7 = sats.s7 ++ exts ;
+      e3 = sats.e3 ;
+      e4 = sats.e4 ;
+      e7 = True ;
+      e5 = sats.e5 ;
+      e6 = sats.e6
+      } ;
+
+  mkSatsObject : NounPhrase -> Verb -> Str -> Sats = \subj,verb,obj ->
+    insertObject (mkSats subj verb) obj ;
+
+  mkSatsCopula : NounPhrase -> Str -> Sats = \subj,obj ->
+    mkSatsObject subj (verbVara ** {s1 = []}) obj ;
+
 
 --3 Sentence-complement verbs
 --
@@ -833,7 +914,7 @@ oper
   SentenceVerb : Type = Verb ;
 
   complSentVerb : SentenceVerb -> Sentence -> VerbGroup = \se,duler ->
-    useVerb se (\\_,_,_ => se.s1 ++ optStr infinAtt ++ duler.s ! Main) ;
+    useVerb se (\\_,_,_ => se.s1 ++ optStr infinAtt ++ duler.s ! Sub) ;
 
   complQuestVerb : SentenceVerb -> QuestionSent -> VerbGroup = \se,omduler ->
     useVerb se (\\_,_,_ => se.s1 ++ omduler.s ! IndirQ) ;

lib/resource/scandinavian/VerbphraseScand.gf

@@ -41,7 +41,7 @@ incomplete concrete VerbphraseScand of Verbphrase = CategoriesScand **
   PredSuperl a = predAdjective (superlAdjPhrase a) ;
   PredCN = predCommNoun ;
   PredNP = predNounPhrase ;
-  PredPP = predAdverb ;
+  PredAdv = predAdverb ;
   PredAV = complVerbAdj ;
   PredObjA2V = complVerbAdj2 True ;
 

lib/resource/swedish/BasicSwe.gf

@@ -25,7 +25,7 @@ lin
   black_ADeg = mk2ADeg "svart" "svart" ;
   blue_ADeg = mk2ADeg "blå" "blått";
   boat_N = regN "båt" utrum ;
-  book_N = mk2N "bok" "böcker" ;
+  book_N = mkN "bok" "boken" "böcker" "böckerna" ;
   boot_N = mk2N "stövel" "stövlar" ;
   boss_N = mk2N "chef" "chefer" ;
   boy_N = regN "pojke" utrum ;
@@ -49,7 +49,7 @@ lin
   city_N = mk2N "stad" "städer" ;
   clean_ADeg = regADeg "ren" ;
   clever_ADeg = regADeg "klok" ;
-  close_V2 = dirV2 (regV "stänga") ;
+  close_V2 = dirV2 (mk2V "stänga" "stänger") ;
   coat_N = regN "rock" utrum ;
   cold_ADeg = regADeg "kall" ;
   come_V = (mkV "komma" "kommer" "kom" "kom" "kommit" "kommen") ;
@@ -105,7 +105,7 @@ lin
   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") ;
+  listen_V2 = mkV2 (regV "lyssna") "på" ;
   live_V = (irregV "leva" "levde" "levt") ; ---- ?
   long_ADeg = irregADeg "lång" "längre" "längst" ;
   lose_V2 = dirV2 (regV "förlora") ;

lib/resource/swedish/CountrySwe.gf

@@ -1,4 +1,4 @@
-concrete CountrySwe of Country = open ResourceSwe, ParadigmsSwe in {
+concrete CountrySwe of Country = open CategoriesSwe, ParadigmsSwe in {
 
   lincat
     Country = PN ;

lib/resource/swedish/LangSatsSwe.gf

@@ -0,0 +1,22 @@
+--# -path=.:../scandinavian:../abstract:../../prelude
+
+concrete LangSatsSwe of LangSats = 
+  RulesSwe, 
+  SatsSwe, 
+  StructuralSwe,  
+  BasicSwe,
+  TimeSwe,
+  CountrySwe
+
+   ** open Prelude, ParadigmsSwe in {
+
+lin
+  AdvDate d = prefixSS "på" d ;
+  AdvTime t = prefixSS "klockan" t ;
+  NWeekday w = w ;
+  PNWeekday w = nounPN w ;
+
+  PNCountry x = x ;
+  ANationality x = x ;
+  NLanguage x = x ;
+}

lib/resource/swedish/SatsSwe.gf

@@ -0,0 +1,4 @@
+--# -path=.:../scandinavian:../abstract:../../prelude
+
+concrete SatsSwe of Sats = CategoriesSwe **
+  SatsScand with (SyntaxScand=SyntaxSwe) ;

lib/resource/swedish/SimpleLangSwe.gf

@@ -0,0 +1,21 @@
+--# -path=.:../scandinavian:../abstract:../../prelude
+
+concrete SimpleLangSwe of SimpleLang = 
+  SimpleSwe, 
+  StructuralSwe,
+  BasicSwe,
+  TimeSwe,
+  CountrySwe
+
+   ** open Prelude, ParadigmsSwe in {
+
+lin
+  AdvDate d = prefixSS "på" d ;
+  AdvTime t = prefixSS "klockan" t ;
+  NWeekday w = w ;
+  PNWeekday w = nounPN w ;
+
+  PNCountry x = x ;
+  ANationality x = x ;
+  NLanguage x = x ;
+}

lib/resource/swedish/SimpleSwe.gf

@@ -0,0 +1,8 @@
+--# -path=.:../scandinavian:../abstract:../../prelude
+
+concrete SimpleSwe of Simple = CategoriesSwe ** SimpleI with
+  (Categories = CategoriesSwe),
+  (Rules = RulesSwe),
+  (Structural = StructuralSwe),
+  (Verbphrase = VerbphraseSwe)
+  ;

lib/resource/swedish/TimeSwe.gf

@@ -1,5 +1,5 @@
 concrete TimeSwe of Time = NumeralsSwe ** 
-  open Prelude, MorphoSwe, ResourceSwe, ParadigmsSwe in {
+  open Prelude, MorphoSwe, CategoriesSwe, ParadigmsSwe in {
 
 lincat
 Date = SS ;