multimodal resource recreated for new API

lib/resource-1.0/common/ParamX.gf

@@ -24,4 +24,13 @@ resource ParamX = {
     conjPerson : Person -> Person -> Person = \_,p -> 
       p ;
 
+-- To construct a record with a polarity-dependent table.
+
+    polCases : Str -> Str -> {s : Polarity => Str} = \true,false -> {
+      s = table {
+        Pos => true ;
+        Neg => false
+        }
+      } ;
+
 }

lib/resource-1.0/doc/Resource-HOWTO.html

@@ -73,6 +73,7 @@ one of a small number of different types). Thus we have
 </ul>
 
 
+
 <h3>Infrastructure modules</h3>
 
 Expressions of each phrase category are constructed in the corresponding
@@ -227,11 +228,11 @@ only one. So you will find yourself iterating the following steps:
 
 <ol>
 <li> Select a phrase category module, e.g. <tt>NounDut</tt>, and uncomment one
-     linearization rule (for instance, <tt>DefSg</tt>, which is
+     linearization rule (for instance, <tt>IndefSg</tt>, which is
      not too complicated).
 
 <li> Write down some Dutch examples of this rule, in this case translations
-     of "the dog", "the house", "the big house", etc.
+     of "a dog", "a house", "a big house", etc.
 
 <li> Think about the categories involved (<tt>CN, NP, N</tt>) and the
      variations they have. Encode this in the lincats of <tt>CatDut</tt>.
@@ -240,13 +241,14 @@ only one. So you will find yourself iterating the following steps:
 <li> To be able to test the construction, 
      define some words you need to instantiate it
      in <tt>LexDut</tt>. Again, it can be helpful to define some simple-minded
-     morphological paradigms in <tt>ResDut</tt>, e.g. corresponding to
+     morphological paradigms in <tt>ResDut</tt>, in particular worst-case
-     <tt>ResEng.regN</tt>.
+     constructors corresponding to e.g.
+     <tt>ResEng.mkNoun</tt>.
 
 <li> Doing this, you may want to test the resource independently. Do this by
      <pre>
        i -retain ResDut
-       cc regN "huis"
+       cc mkNoun "ei" "eieren" Neutr
      </pre>
 
 <li> Uncomment <tt>NounDut</tt> and <tt>LexDut</tt> in <tt>TestDut</tt>,

lib/resource-1.0/english/ParadigmsEng.gf

@@ -332,7 +332,7 @@ oper
     mkN man men (man + "'s") mens ;
 
   mkN = \man,men,man's,men's -> 
-    mkNoun man men man's men's ** {g = Neutr ; lock_N = <>} ;
+    mkNoun man man's men men's ** {g = Neutr ; lock_N = <>} ;
 
   genderN g man = {s = man.s ; g = g ; lock_N = <>} ;
 

lib/resource-1.0/multimodal/DemRes.gf

@@ -0,0 +1,80 @@
+resource DemRes = open Prelude in {
+
+  oper
+
+    Point : Type = 
+      {point : Str} ;
+
+    point : Point -> Str = \p ->
+      p.point ;
+ 
+    mkPoint : Str -> Point = \s -> 
+      {point = s} ;
+
+    noPoint : Point = 
+      mkPoint [] ;
+
+    concatPoint : (x,y : Point) -> Point = \x,y -> 
+      mkPoint (point x ++ point y) ;
+
+-- A type is made demonstrative by adding $Point$.
+
+    Dem : Type -> Type = \t -> t ** Point ;
+
+    mkDem : (t : Type) -> t -> Point -> Dem t = \_,x,s ->
+      x ** s ;
+
+    nonDem : (t : Type) -> t -> Dem t = \t,x ->
+      mkDem t x noPoint ;
+
+
+{-
+    mkDemS  : Cl -> DemAdverb -> Pointing -> MultiSentence = \cl,adv,p ->
+    {s = table {
+       MInd   b => msS  (UseCl  (polar b) (AdvCl cl adv)) ;
+       MQuest b => msQS (UseQCl (polar b) (QuestCl (AdvCl cl adv)))
+       } ;
+     point = p.point ++ adv.point
+    } ;
+
+    polar : Bool -> TP = \b -> case b of {
+      True  => PosTP TPresent ASimul ;
+      False => NegTP TPresent ASimul
+      } ;
+
+    mkDemQ  : QCl -> DemAdverb -> Pointing -> MultiQuestion = \cl,adv,p ->
+    {s = \\b => msQS (UseQCl (polar b) cl) ++ adv.s ; --- (AdvQCl cl adv)) ;
+     point = p.s5 ++ adv.s5
+    } ;
+    mkDemImp : VCl -> DemAdverb -> Pointing -> MultiImperative = \cl,adv,p ->
+    {s = table { 
+           True  => msImp (PosImpVP cl) ++ adv.s ;
+           False => msImp (NegImpVP cl) ++ adv.s
+           } ;
+     s5 = p.s5 ++ adv.s5
+    } ;
+
+    msS   : S  -> Str ;
+    msQS  : QS -> Str ;
+    msImp : Imp -> Str ;
+
+    concatDem : (x,y : Pointing) -> Pointing = \x,y -> {
+      s5 = x.s5 ++ y.s5
+      } ;
+
+    MultiSentence   : Type = mkDemType {s : MSForm => Str} ;
+    MultiQuestion   : Type = mkDemType {s : Bool   => Str} ;
+    MultiImperative : Type = mkDemType {s : Bool   => Str} ;
+
+    Demonstrative   : Type = mkDemType NP ;
+    DemAdverb       : Type = mkDemType Adv ;
+
+    mkDAdv : Adv -> Pointing -> DemAdverb = \a,p ->
+      a ** p ** {lock_Adv = a.lock_Adv} ;
+
+  param
+    MSForm = MInd Bool | MQuest Bool ;
+
+-}
+
+}

lib/resource-1.0/multimodal/Demonstrative.gf

@@ -0,0 +1,70 @@
+abstract Demonstrative = Cat, Tense ** {
+
+  cat
+
+    MS ;     -- multimodal sentence or question
+    MQS ;    -- multimodal wh question
+    MImp ;   -- multimodal imperative
+    MVP ;    -- multimodal verb phrase
+    DNP ;    -- demonstrative noun phrase
+    DAdv ;   -- demonstrative adverbial
+    Point ;  -- pointing gesture
+
+  fun
+
+-- A pointing gesture is constructed from a string.
+
+    MkPoint : String -> Point ;
+
+-- Construction of sentences, questions, and imperatives.
+
+    PredMVP   : DNP -> MVP -> MS ;  -- he flies here
+    QuestMVP  : DNP -> MVP -> MQS ; -- does he fly here
+
+    QQuestMVP : IP  -> MVP -> MQS ; -- who flies here
+
+    ImpMVP    : MVP -> MImp ;       -- fly here!
+
+-- Construction of verb phrases from verb + complements.
+
+    DemV   : V  -> MVP ;              -- flies (here)
+    DemV2  : V2 -> DNP -> MVP ;       -- takes this (here)
+    DemVV  : VV -> MVP -> MVP ;       -- wants to fly (here)
+
+-- Adverbial modification of a verb phrase.
+
+    AdvMVP : MVP -> DAdv -> MVP ;      
+
+-- Demonstrative pronouns as NPs and determiners.
+
+    this_DNP    : Point -> DNP ;        -- this
+    that_DNP    : Point -> DNP ;        -- that
+    thisDet_DNP : Point -> CN -> DNP ;  -- this car
+    thatDet_DNP : Point -> CN -> DNP ;  -- that car
+
+-- Demonstrative adverbs.
+
+    here_DAdv      : Point -> DAdv ;    -- here
+    here7from_DAdv : Point -> DAdv ;    -- from here
+    here7to_DAdv   : Point -> DAdv ;    -- to here
+
+-- Building an adverb as prepositional phrase.
+
+    PrepDNP : Prep -> DNP -> DAdv ;
+
+-- Using ordinary categories.
+
+-- Interface to $Demonstrative$.
+
+    DemNP   : NP  -> DNP ;
+    DemAdv  : Adv -> DAdv ;
+    PhrMS   : Pol -> MS   -> Phr ;
+    PhrMS   : Pol -> MS   -> Phr ;
+    PhrMQS  : Pol -> MQS  -> Phr ;
+    PhrMImp : Pol -> MImp -> Phr ;
+
+-- For testing and example-based grammar writing.
+
+    point1, point2 : Point ;
+
+}

lib/resource-1.0/multimodal/DemonstrativeEng.gf

@@ -0,0 +1,6 @@
+--# -path=.:../english/:../abstract:../common:prelude
+
+concrete DemonstrativeEng of Demonstrative = CatEng, TenseX ** DemonstrativeI with
+  (Test = TestEng),
+  (Structural = StructuralEng) ;
+

lib/resource-1.0/multimodal/DemonstrativeI.gf

@@ -0,0 +1,53 @@
+incomplete concrete DemonstrativeI of Demonstrative = Cat, TenseX **
+  open Prelude, Test, Structural, ParamX, DemRes in {
+
+  lincat
+
+    MS     = Dem {s : Polarity => Str} ;
+    MQS    = Dem {s : Polarity => Str} ;
+    MImp   = Dem {s : Polarity => Str} ;
+    MVP    = Dem VP ;
+    DNP    = Dem NP ;
+    DAdv   = Dem Adv ;
+    Point  = DemRes.Point ;
+
+  lin
+
+    MkPoint s = mkPoint s.s ;
+
+    PredMVP np vp = 
+      let cl = PredVP np vp
+      in 
+      mkDem 
+        {s : Polarity => Str} 
+        (polCases (PosCl cl).s (NegCl cl).s) (concatPoint np vp) ;
+
+    DemV verb      = mkDem VP (UseV verb) noPoint ;
+    DemV2 verb obj = mkDem VP (ComplV2 verb obj) obj ;
+    DemVV vv vp    = mkDem VP (ComplVV vv vp) vp ;
+
+    AdvMVP vp adv =
+      mkDem VP (AdvVP vp adv) (concatPoint vp adv) ;
+
+    this_DNP = mkDem NP this_NP ;
+    that_DNP = mkDem NP that_NP ;
+
+--    thisDet_DNP p cn = mkDem (DetNP this_Det cn) p ;
+--    thatDet_DNP p cn = mkDem (DetNP that_Det cn) p ;
+
+    here_DAdv      = mkDem Adv here_Adv ;
+--    here7from_DAdv = mkDem here7from_Adv ;
+--    here7to_DAdv   = mkDem here7to_Adv ;
+
+    PrepDNP p np   = mkDem Adv (PrepNP p np) np ;
+
+    DemNP np = nonDem NP (np ** {lock_NP = <>}) ;
+--    DemAdv = nonDem Adv ;
+    PhrMS pol ms = {s = pol.s ++ ms.s ! pol.p ++ ";" ++ ms.point} ;
+
+
+    point1 = mkPoint "p1" ;
+    point2 = mkPoint "p2" ;
+
+}
+

lib/resource-1.0/multimodal/Multimodal.gf

@@ -0,0 +1,16 @@
+abstract Multimodal =
+  Noun,
+--  Verb, 
+  Adjective,
+  Adverb,
+  Numeral,
+--  Sentence, 
+--  Question,
+--  Relative,
+--  Conjunction,
+--  Phrase,
+--  Tensed,
+  Structural,
+  Demonstrative,
+  Basic
+  ** {} ;

lib/resource-1.0/multimodal/MultimodalEng.gf

@@ -0,0 +1,19 @@
+--# -path=.:../english/:../abstract:../common:prelude
+
+concrete MultimodalEng of Multimodal =
+  NounEng,
+--  Verb, 
+  AdjectiveEng,
+  AdverbEng,
+  NumeralEng,
+--  Sentence, 
+--  Question,
+--  Relative,
+--  Conjunction,
+--  Phrase,
+--  Tensed,
+  StructuralEng,
+  DemonstrativeEng,
+  BasicEng
+  ** {} ;
+

src/GF/Compile/CheckGrammar.hs

@@ -569,7 +569,8 @@ checkLType env trm typ0 = do
          trm' <- comp trm
          case trm' of
            RecType _ -> termWith trm $ return typeType
-           ExtR (Vr _) (RecType _) -> termWith trm $ return typeType -- ext t = t ** ...
+           ExtR (Vr _) (RecType _) -> termWith trm $ return typeType 
+                                      -- ext t = t ** ...
            _ -> prtFail "invalid record type extension" trm
        RecType rr -> do
          (r',ty,s') <- checks [
@@ -585,7 +586,14 @@ checkLType env trm typ0 = do
                 r2 <- justCheck r' rr0
                 s2 <- justCheck s' rr2
                 return $ (ExtR r2 s2, typ) 
-           _ -> raise ("record type expected in extension of" +++ prt r +++ "but found" +++ prt ty)
+           _ -> raise ("record type expected in extension of" +++ prt r +++ 
+                       "but found" +++ prt ty)
+
+       ExtR ty ex -> do
+         r' <- justCheck r ty
+         s' <- justCheck s ex
+         return $ (ExtR r' s', typ) --- is this all?
+
        _ -> prtFail "record extension not meaningful for" typ
 
     FV vs -> do