example/Discourse for English too

3 files changed, 61 insertions, 86 deletions

diff --git a/examples/discourse/Discourse.gf b/examples/discourse/Discourse.gf
index 0b942dbdf..f70d46b4b 100644
--- a/examples/discourse/Discourse.gf
+++ b/examples/discourse/Discourse.gf
@@ -18,37 +18,11 @@ fun
   PreObjS   : Marker -> Temp -> Pol -> Clause -> S ;              -- maitoahan Jussi juo nyt
   PreAdvS   : Marker -> Temp -> Pol -> Clause -> S ;              -- nythän Jussi juo maitoa
 
-  NoFocClause    : NP -> VP -> Clause ;                           -- Jussi juo maitoa nyt
-  FocSubjClause  : NP -> VP -> Clause ;                           -- Jussikin juo maitoa nyt
-  FocVerbClause  : NP -> VP -> Clause ;                           -- Jussi juokin maitoa nyt
-  FocObjClause   : NP -> VPSlash -> NP -> Clause ;                -- Jussi juo maitoakin nyt
-  FocAdvClause   : NP -> VP -> Adv -> Clause ;                    -- Jussi juo maitoa nytkin
-
-
-{-
-  ClauseS        : Marker -> Temp -> Pol -> NP -> VP -> S ;              -- Jussihan juo maitoa nyt
-
-  FocSubjS       : Marker -> Temp -> Pol -> NP -> VP -> S ;              -- Jussikinhan juo maitoa nyt
-  FocVerbS       : Marker -> Temp -> Pol -> NP -> VP -> S ;              -- Jussihan juokin maitoa nyt
-  FocObjS        : Marker -> Temp -> Pol -> NP -> VPSlash -> NP -> S ;   -- Jussihan juo maitoakin nyt
-  FocAdvS        : Marker -> Temp -> Pol -> NP -> VP -> Adv -> S ;       -- Jussihan juo maitoa nytkin
--}
-{-
-  PreAdvS        : Part -> Temp -> Pol -> Adv -> Clause -> S ;   -- nythän Jussi juo maitoa
-  PreAdvKinS     : Part -> Temp -> Pol -> Adv -> Clause -> S ;   -- nytkinhän Jussi juo maitoa
-  PreAdvSubjKinS : Part -> Temp -> Pol -> Adv -> Clause -> S ;   -- nythän Jussikin juo maitoa
-  PreAdvVerbKinS : Part -> Temp -> Pol -> Adv -> Clause -> S ;   -- nythän Jussi juokin maitoa
-
-  PreObjS        : Part -> Temp -> Pol        -> Clause -> S ;   -- maitoahan Jussi juo nyt
-  PreObjKinS     : Part -> Temp -> Pol        -> Clause -> S ;   -- maitoakinhan Jussi juo nyt
-  PreObjSubjKinS : Part -> Temp -> Pol        -> Clause -> S ;   -- maitoahan Jussikin juo nyt
-  PreObjVerbKinS : Part -> Temp -> Pol        -> Clause -> S ;   -- maitoahan Jussi juokin nyt
-
-  PreVerbS       : Part -> Temp -> Pol        -> Clause -> S ;   -- juohan Jussi maitoa nyt
-  PreVerbSubKinS : Part -> Temp -> Pol        -> Clause -> S ;   -- juohan Jussikin maitoa nyt
-  PreVerbAdvKinS : Part -> Temp -> Pol -> Adv -> Clause -> S ;   -- juohan Jussi nytkin maitoa
-  PreVerbObjKinS : Part -> Temp -> Pol -> NP  -> Clause -> S ;   -- juohan Jussi maitoa nytkin
--}
+  NoFocClause    : NP -> VPSlash -> NP -> Adv -> Clause ;         -- Jussi juo maitoa nyt
+  FocSubjClause  : NP -> VPSlash -> NP -> Adv -> Clause ;         -- Jussikin juo maitoa nyt
+  FocVerbClause  : NP -> VPSlash -> NP -> Adv -> Clause ;         -- Jussi juokin maitoa nyt
+  FocObjClause   : NP -> VPSlash -> NP -> Adv -> Clause ;         -- Jussi juo maitoakin nyt
+  FocAdvClause   : NP -> VPSlash -> NP -> Adv -> Clause ;         -- Jussi juo maitoa nytkin
 
   neutralMarker, remindMarker, contrastMarker : Marker ; 
 
diff --git a/examples/discourse/DiscourseEng.gf b/examples/discourse/DiscourseEng.gf
index 09dfd871d..9ee3b070a 100644
--- a/examples/discourse/DiscourseEng.gf
+++ b/examples/discourse/DiscourseEng.gf
@@ -1,43 +1,56 @@
---# -path=.:alltenses
+--# -path=.:present
 
 concrete DiscourseEng of Discourse = 
   LexiconEng,
-  NounEng, VerbEng,
-  AdjectiveEng, AdverbEng,
-  StructuralEng - [nobody_NP, nothing_NP],
+  NounEng, VerbEng - [SlashV2VNP,SlashVV, Slash2V3, Slash3V3],
+  AdjectiveEng, AdverbEng,  
+  StructuralEng - [nobody_NP,nothing_NP],
   TenseX
-** open SyntaxEng, (P = ParadigmsEng), (R = ParamX), Prelude in {
+** open SyntaxEng, (P = ParadigmsEng), (R = ParamX), (E = ExtraEng), (L = LangEng), Prelude in {
 
 lincat
-  Clause  = {subj : NP ; vp : VP} ;
-  Part    = {a : Adv ; isPre : Bool} ;
+  Clause = {s : R.Polarity => {subj : NP ; vps : VPSlash ; obj : NP ; adv : Adv}} ;
+  Marker = Adv ;
 
 lin
-  ClauseS part temp pol cl = 
-    mkS temp pol (mkCl (mkNP cl.subj part) cl.vp) ;
-  SubjKinS part temp pol cl = 
-    mkS temp pol (mkCl (mkNP (mkNP cl.subj (kin.s ! pol.p)) part) cl.vp) ;
-  VerbKinS part temp pol cl = 
-    mkS temp pol (mkCl (mkNP cl.subj part) (mkVP cl.vp (kin.s ! pol.p))) ;
-  AdvKinS  part temp pol adv cl = 
-    mkS temp pol (mkCl (mkNP cl.subj part) (mkVP (mkVP cl.vp adv) (kin.s ! pol.p))) ;
-  PreAdvS part temp pol adv cl = 
-    mkS adv (mkS part (mkS temp pol (mkCl cl.subj cl.vp))) ;
-  PreAdvKinS part temp pol adv cl = 
-    mkS adv (mkS part (mkS (kin.s ! pol.p) (mkS temp pol (mkCl cl.subj cl.vp)))) ;
-  PreAdvSubjKinS  part temp pol adv cl = 
-    mkS adv (mkS part (mkS temp pol (mkCl (mkNP cl.subj (kin.s ! pol.p)) cl.vp))) ;
-  PreAdvVerbKinS  part temp pol adv cl = 
-    mkS adv (mkS part (mkS temp pol (mkCl cl.subj (mkVP cl.vp (kin.s ! pol.p))))) ;
-
-  PredClause subj v = {subj = subj ; vp = v} ;
-
-  noPart     = {a = P.mkAdv [] ; isPre = False} ;
-  han_Part   = {a = P.mkAdv "as you know" ; isPre = True} ;
-  pas_Part   = {a = P.mkAdv "no" ; isPre = True} ;
-
-oper 
-  kin : {s : R.Polarity => Adv}  = 
-    {s = table {R.Pos => P.mkAdv "too" ; R.Neg => P.mkAdv "either"}} ;
+  PreSubjS marker temp pol cla = 
+    let cl = cla.s ! pol.p in
+    mkS marker (mkS temp pol 
+      (mkCl cl.subj (mkVP (mkVP cl.vps cl.obj) cl.adv))) ;
+
+  PreVerbS marker temp pol cla = 
+    let cl = cla.s ! pol.p in
+    mkS marker (mkS temp pol 
+      (mkCl cl.subj (mkVP actually_AdV (mkVP (mkVP E.do_VV (mkVP cl.vps cl.obj)) cl.adv)))) ;
+
+  PreObjS marker temp pol cla = 
+    let cl = cla.s ! pol.p in
+    mkS marker (mkS (mkCl cl.obj
+      (mkRS temp pol (mkRCl E.that_RP (mkClSlash cl.subj (L.AdvVPSlash cl.vps cl.adv)))))) ;
+
+  PreAdvS marker temp pol cla = 
+    let cl = cla.s ! pol.p in
+    mkS marker (mkS cl.adv
+      (mkS temp pol (mkCl cl.subj (mkVP cl.vps cl.obj)))) ;
+
+  NoFocClause np vps obj adv = 
+    {s = \\p => {subj = np ; vps = vps ; obj = obj ; adv = adv}} ;
+  FocSubjClause np vps obj adv = 
+    {s = \\p => {subj = mkNP np (too p) ; vps = vps ; obj = obj ; adv = adv}} ;
+  FocVerbClause np vps obj adv = 
+    {s = \\p => {subj = np ; vps = L.AdVVPSlash even_AdV vps ; obj = obj ; adv = adv}} ;
+  FocObjClause np vps obj adv = 
+    {s = \\p => {subj = np ; vps = vps ; obj = mkNP obj (too p) ; adv = adv}} ;
+  FocAdvClause np vps obj adv = 
+    {s = \\p => {subj = np ; vps = vps ; obj = obj ; adv = lin Adv (ss (adv.s ++ (too p).s))}} ;
+
+  neutralMarker  = P.mkAdv [] ;
+  remindMarker   = P.mkAdv "as we know" ;
+  contrastMarker = P.mkAdv "no but" ;
+
+oper
+  too : R.Polarity -> Adv = \p -> case p of {R.Pos => P.mkAdv "too" ; R.Neg => P.mkAdv "either"} ;
+  even_AdV = P.mkAdV "even" ;
+  actually_AdV = P.mkAdV "actually" ;
 
 }
diff --git a/examples/discourse/DiscourseFin.gf b/examples/discourse/DiscourseFin.gf
index 5e708207c..59e730f22 100644
--- a/examples/discourse/DiscourseFin.gf
+++ b/examples/discourse/DiscourseFin.gf
@@ -22,29 +22,17 @@ lin
   PreAdvS marker temp pol cl = 
     E.S_ASV marker temp pol cl ;
 
-  NoFocClause np vp = 
-    E.PredClPlus np vp ;
-  FocSubjClause np vp = 
-    E.PredClPlusFocSubj np vp ;
-  FocVerbClause np vp = 
-    E.PredClPlusFocVerb np vp ;
-  FocObjClause np vp obj = 
-    lin ClPlus (E.PredClPlusFocObj np vp obj) ;
-  FocAdvS np vp adv = 
-    lin ClPlus (E.PredClPlusFocAdv np vp adv) ;
+  NoFocClause np vps obj adv = 
+    E.PredClPlus np (mkVP (mkVP vps obj) adv) ;
+  FocSubjClause np vps obj adv = 
+    E.PredClPlusFocSubj np (mkVP (mkVP vps obj) adv) ;
+  FocVerbClause np vps obj adv = 
+    E.PredClPlusFocVerb np (mkVP (mkVP vps obj) adv) ;
+--  FocObjClause np vps obj adv = 
+--    lin ClPlus (E.PredClPlusFocObj np (mkVP vps adv) obj) ;
+  FocAdvClause np vps obj adv = 
+    lin ClPlus (E.PredClPlusFocAdv np (mkVP vps obj) adv) ;
 
-{-
-  ClauseS marker temp pol np vp = 
-    E.S_SVO marker temp pol (E.PredClPlus np vp) ;
-  FocSubjS marker temp pol np vp = 
-    E.S_SVO marker temp pol (E.PredClPlusFocSubj np vp) ;
-  FocVerbS marker temp pol np vp = 
-    E.S_SVO marker temp pol (E.PredClPlusFocVerb np vp) ;
-  FocObjS marker temp pol np vp obj = 
-    E.S_SVO marker temp pol (E.PredClPlusFocObj np vp obj) ;
-  FocAdvS marker temp pol np vp adv = 
-    E.S_SVO marker temp pol (E.PredClPlusFocAdv np vp adv) ;
--}
   neutralMarker  = E.noPart ;
   remindMarker   = E.han_Part ;
   contrastMarker = E.pas_Part ;