focal constructions in Scandinavian

lib/src/abstract/Extra.gf

@@ -47,4 +47,21 @@ abstract Extra = Cat ** {
 
     PrepCN : Prep -> CN -> Adv ;   -- by accident [Prep + CN without article]
 
+  -- fronted/focal constructions, only for main clauses
+
+  cat
+    Foc ;
+
+  fun
+    FocObj : NP  -> ClSlash -> Foc ;   -- her I love
+    FocAdv : Adv -> Cl      -> Foc ;   -- today I will sleep
+    FocAdV : AdV -> Cl      -> Foc ;   -- never will I sleep
+    FocAP  : AP  -> NP      -> Foc ;   -- green was the tree
+    FocNeg : Cl             -> Foc ;   -- not is he here
+    FocVP  : VP  -> NP      -> Foc ;   -- love her I do
+    FocVV  : VV -> VP -> NP -> Foc ;   -- to love her I want
+    
+    UseFoc : Temp -> Pol -> Foc -> Utt ;
+
+    
 }

lib/src/scandinavian/ExtraScand.gf

@@ -1,5 +1,5 @@
 incomplete concrete ExtraScand of ExtraScandAbs = CatScand ** 
-   open CommonScand,Coordination,ResScand in {
+   open CommonScand,Coordination,ResScand, ParamX in {
   lin
     GenNP np = {
       s,sp = \\n,_,_,g => np.s ! NPPoss (gennum (ngen2gen g) n) Nom ; 
@@ -84,4 +84,24 @@ incomplete concrete ExtraScand of ExtraScandAbs = CatScand **
     ICompAP ap = {s = \\a => hur_IAdv.s ++ ap.s ! a} ;
 
     IAdvAdv adv = {s = hur_IAdv.s ++ adv.s} ;
+
+  lincat
+    Foc = {s : ParamX.Tense => Anteriority => Polarity => Str} ;
+
+  lin
+    FocObj np cls = {
+      s = \\t,a,p => cls.c2.s ++ np.s ! accusative ++ cls.s ! t ! a ! p ! Inv
+      } ;
+    FocAdv adv cls = {
+      s = \\t,a,p => adv.s ++ cls.s ! t ! a ! p ! Inv
+      } ; 
+    FocAdV adv cls = {
+      s = \\t,a,p => adv.s ++ cls.s ! t ! a ! p ! Inv
+      } ; 
+    FocNeg cl = {
+      s = \\t,a,p => (negation ! Neg) ++ cl.s ! t ! a ! p ! Inv
+      } ;
+    
+    UseFoc t p foc = {s = t.s ++ p.s ++ foc.s ! t.t ! t.a ! p.p} ;
+
 } 

lib/src/swedish/ExtraSwe.gf

@@ -1,3 +1,25 @@
-concrete ExtraSwe of ExtraSweAbs = ExtraScandSwe ** {
+concrete ExtraSwe of ExtraSweAbs = ExtraScandSwe ** open CommonScand, ResSwe, ParamX in {
+
+lin
+    FocVP vp np = {
+      s = \\t,a,p =>
+        let
+          subj = np.s ! nominative ;
+          agr  = np.a ;
+          vps  = vp.s ! VPFinite t a ;
+          verb = case <<t,a> : ParamX.Tense * Anteriority> of {
+            <Pres,Simul> => {fin = "gör"    ; inf = vps.inf} 
+            ; --# notpresent
+            <Past,Simul> => {fin = "gjorde" ; inf = vps.inf} ; --# notpresent
+            _ => vps --# notpresent
+            } ;
+          vfin = verb.fin ;
+          vinf = verb.inf ;
+          neg  = vp.a1 ! p ;
+          comp = vp.n2 ! agr ++ vp.a2 ++ vp.ext
+        in
+        vinf ++ comp ++ vfin ++ subj ++ neg
+      } ;
+
 
 }