updated dialogue to multimodal ; bug fixes in grammar compilation

examples/dialogue/AuxDialogue.gf

@@ -1,4 +1,4 @@
-interface AuxDialogue = open Lang in {
+interface AuxDialogue = open Multi in {
   oper
     defN : N -> NP = \n ->
       DetCN (DetSg (SgQuant DefArt) NoOrd) (UseN n) ;

examples/dialogue/AuxEng.gf

@@ -1,2 +1,2 @@
-instance AuxEng of AuxDialogue = open LangEng in {
+instance AuxEng of AuxDialogue = open MultiEng in {
 }

examples/dialogue/Dialogue.gf

@@ -14,14 +14,14 @@ abstract Dialogue = {
     Oper2 Kind Kind ;
 
   fun
-    MRequest : Action -> Move ;
+    IRequest : Action -> Input ;
-    MConfirm : Action -> Move ;
+    IConfirm : Action -> Input ;
-    MAnswer  : Proposition -> Move ;
+    IAnswer  : Proposition -> Input ;
-    MIssue   : Question -> Move ;
+    IIssue   : Question -> Input ;
 
-    MYes     : Move ;
+    IYes     : Input ;
-    MNo      : Move ;
+    INo      : Input ;
-    MObject  : (k : Kind) -> Object k -> Move ;
+    IObject  : (k : Kind) -> Object k -> Input ;
 
     PAction  : Action -> Proposition ;
 
@@ -35,5 +35,18 @@ abstract Dialogue = {
     OIndef : (k : Kind) -> Object k ;
     ODef   : (k : Kind) -> Object k ;
 
+-- multimodality
 
+  cat
+    Click ;
+    Input ;  -- multimodal asynchronous input
+    Speech ; -- speech only
+  fun
+    OThis     : (k : Kind) -> Click -> Object k ;
+    OThisKind : (k : Kind) -> Click -> Object k ;
+
+    MInput : Input -> Move ;
+    SInput : Input -> Speech ;
+
+    MkClick : String -> Click ;
 }

examples/dialogue/DialogueEng.gf

@@ -1,4 +1,4 @@
---# -path=.:present:prelude
+--# -path=.:multimodal:alltenses:prelude
 
 concrete DialogueEng of Dialogue = DialogueI with 
-  (Lang = LangEng) ;
+  (Multi = MultiEng) ;

examples/dialogue/DialogueI.gf

@@ -1,10 +1,10 @@
-incomplete concrete DialogueI of Dialogue = open Lang, Prelude in {
+incomplete concrete DialogueI of Dialogue = open Multi, Prelude in {
 
   lincat
     Move   = Phr ;
-    Action = {s : ActType => Str} ;
+    Action = {s : ActType => Str ; point : Str} ;
-    Proposition = Phr ; ----
+    Proposition = Utt ; ----
-    Question = Phr ;
+    Question = Utt ;
     Kind   = CN ;
     Object = NP ;
     Oper0  = V ;
@@ -12,26 +12,26 @@ incomplete concrete DialogueI of Dialogue = open Lang, Prelude in {
     Oper2  = V3 ;
 
   lin
-    MRequest a = ss (a.s ! ARequest) ;
+    IRequest a = {s = a.s ! ARequest ; point = a.point} ;
-    MConfirm a = ss (a.s ! AConfirm) ;
+    IConfirm a = {s = a.s ! AConfirm ; point = a.point} ;
-    MAnswer  a = a ;
+    IAnswer  a = a ;
-    MIssue   a = a ;
+    IIssue   a = a ;
 
-    MYes = yes_Phr ;
+    IYes = yes_Phr ** noPoint ;
-    MNo  = no_Phr ;
+    INo  = no_Phr ** noPoint ;
-    MObject _ ob = PhrUtt NoPConj (UttNP ob) optPlease ;
+    IObject _ ob = UttNP ob ;
 
-    PAction a  = ss (a.s ! AConfirm) ;
+    PAction a  = {s = a.s ! AConfirm ; point = a.point} ;
 
     QKind k = 
-      PhrUtt NoPConj (UttQS (UseQCl TPres ASimul PPos 
+      UttQS (UseQCl TPres ASimul PPos 
-        (ExistIP (IDetCN whichPl_IDet NoNum NoOrd k)))) NoVoc ;
+        (ExistIP (IDetCN whichPl_IDet NoNum NoOrd k))) ;
 
     AOper0 op         = mkAction (UseV op) ;
     AOper1 _   op x   = mkAction (ComplV2 op x) ;
     AOper2 _ _ op x y = mkAction (ComplV3 op x y) ;
 
-    OAll k   = PredetNP all_Predet (DetCN (DetPl (PlQuant IndefArt) NoNum NoOrd) k) ;
+    OAll k = PredetNP all_Predet (DetCN (DetPl (PlQuant IndefArt) NoNum NoOrd) k) ;
     OIndef k = DetCN (DetSg (SgQuant IndefArt) NoOrd) k ;
     ODef k   = DetCN (DetSg (SgQuant DefArt) NoOrd) k ;
 
@@ -43,34 +43,54 @@ incomplete concrete DialogueI of Dialogue = open Lang, Prelude in {
   -- this should perhaps be language dependent - but at least these
   -- variants seem to make sense in all languages
 
-    mkAction : VP -> {s : ActType => Str} = \vp -> {
+    mkAction : VP -> {s : ActType => Str ; point : Str} = \vp -> {
       s = table {
-        ARequest => variants {
+        ARequest => (variants {
           aImp vp ;
           aWant vp ;
           aCanYou vp
-          } ;
+          }).s ;
-        AConfirm => variants {
+        AConfirm => (variants {
           aInf vp
-          }
+          }).s
-        }
+        } ;
+      point = vp.point
       } ;
 
-   optPlease : Voc = variants {NoVoc ; please_Voc} ;
+    optPlease : Voc = variants {NoVoc ; please_Voc} ;
  
-   aImp : VP -> Str = \vp ->
+    aImp : VP -> Utt = \vp ->
-     (PhrUtt NoPConj (UttImpSg PPos (ImpVP vp)) optPlease).s ;
+      UttImpSg PPos (ImpVP vp) ;
 
-   aWant : VP -> Str = \vp ->
+    aWant : VP -> Utt = \vp ->
-     (PhrUtt NoPConj (UttS (UseCl TPres ASimul PPos (PredVP (UsePron i_Pron) 
+      UttS (UseCl TPres ASimul PPos 
-        (ComplVV want_VV vp)))) optPlease).s ;
+        (PredVP (UsePron i_Pron) (ComplVV want_VV vp))) ;
 
-   aCanYou : VP -> Str = \vp ->
+    aCanYou : VP -> Utt = \vp ->
-     (PhrUtt NoPConj (UttQS (UseQCl TPres ASimul PPos (QuestCl (PredVP 
+      UttQS (UseQCl TPres ASimul PPos (QuestCl 
-        (UsePron youSg_Pron) (ComplVV can_VV vp))))) optPlease).s ;
+        (PredVP (UsePron youSg_Pron) (ComplVV can_VV vp)))) ;
 
-   aInf : VP -> Str = \vp ->
+    aInf : VP -> Utt = \vp ->
-     (PhrUtt NoPConj (UttVP vp) NoVoc).s ;
+      UttVP vp ;
+
+-- multimodality
+
+  lincat
+    Click  = Point ;
+    Input  = Utt ;
+    Speech = Multi.Speech ;
+
+  lin
+    OThis     k c = this8point_NP c ;
+    OThisKind k c = DetCN (DetSg (SgQuant (this8point_Quant c)) NoOrd) k ;
+
+    MInput i = PhrUtt NoPConj i optPlease ;
+    SInput i = SpeechUtt NoPConj i optPlease ;
+
+    MkClick = MkPoint ;
+
+  oper
+    noPoint = {point = []} ;
 
 }
 

examples/dialogue/LightsEng.gf

@@ -1,7 +1,7 @@
---# -path=.:present:prelude
+--# -path=.:multimodal:alltenses:prelude
 
 concrete LightsEng of Lights = 
-  DialogueEng ** open LangEng, ParadigmsEng, AuxEng, Prelude in {
+  DialogueEng ** open MultiEng, ParadigmsEng, AuxEng, Prelude in {
 
   lin
     Light       = UseN (regN "light") ;

lib/resource-1.0/common/CommonX.gf

@@ -1,18 +1,19 @@
 concrete CommonX of Common = open (R = ParamX) in {
 
   lincat
-    Text, Phr = {s : Str} ;
+    Text = {s : Str ; lock_Text : {}} ;
-    Utt = {s : Str} ;
+    Phr = {s : Str ; lock_Phr : {}} ;
-    Voc = {s : Str} ;
+    Utt = {s : Str ; lock_Utt : {}} ;
-    SC  = {s : Str} ;
+    Voc = {s : Str ; lock_Voc : {}} ;
-    Adv = {s : Str} ; 
+    SC  = {s : Str ; lock_SC : {}} ;
-    AdV = {s : Str} ; 
+    Adv = {s : Str ; lock_Adv : {}} ;
-    AdA = {s : Str} ; 
+    AdV = {s : Str ; lock_AdV : {}} ;
-    AdS = {s : Str} ; 
+    AdA = {s : Str ; lock_AdA : {}} ;
-    AdN = {s : Str} ;
+    AdS = {s : Str ; lock_AdS : {}} ;
-    IAdv = {s : Str} ;
+    AdN = {s : Str ; lock_AdN : {}} ;
-    CAdv = {s : Str} ;
+    IAdv = {s : Str ; lock_IAdv : {}} ;
-    PConj = {s : Str} ;
+    CAdv = {s : Str ; lock_CAdv : {}} ;
+    PConj = {s : Str ; lock_PConj : {}} ;
 
     Tense = {s : Str ; t : R.Tense} ;
     Ant   = {s : Str ; a : R.Anteriority} ;

lib/resource-1.0/common/ConstructX.gf

@@ -3,16 +3,16 @@ resource ConstructX = open CommonX in {
   oper
     mkText : Str -> Text = \s -> {s = s ; lock_Text = <>} ; 
     mkPhr  : Str -> Phr  = \s -> {s = s ; lock_Phr = <>} ; 
-    Utt = {s : Str} ;
+    mkUtt : Str -> Utt  = \s -> {s = s ; lock_Utt = <>} ;
-    Voc = {s : Str} ;
+    mkVoc : Str -> Voc  = \s -> {s = s ; lock_Voc = <>} ;
-    SC  = {s : Str} ;
+    mkSC : Str -> SC  = \s -> {s = s ; lock_SC = <>} ;
-    Adv = {s : Str} ; 
+    mkAdv : Str -> Adv  = \s -> {s = s ; lock_Adv = <>} ;
-    AdV = {s : Str} ; 
+    mkAdV : Str -> AdV  = \s -> {s = s ; lock_AdV = <>} ;
-    AdA = {s : Str} ; 
+    mkAdA : Str -> AdA  = \s -> {s = s ; lock_AdA = <>} ;
-    AdS = {s : Str} ; 
+    mkAdS : Str -> AdS  = \s -> {s = s ; lock_AdS = <>} ;
-    AdN = {s : Str} ;
+    mkAdN : Str -> AdN  = \s -> {s = s ; lock_AdN = <>} ;
-    IAdv = {s : Str} ;
+    mkIAdv : Str -> IAdv  = \s -> {s = s ; lock_IAdv = <>} ;
-    CAdv = {s : Str} ;
+    mkCAdv : Str -> CAdv  = \s -> {s = s ; lock_CAdv = <>} ;
-    PConj = {s : Str} ;
+    mkPConj : Str -> PConj  = \s -> {s = s ; lock_PConj = <>} ;
 
 }

lib/resource-1.0/multimodal/MultiEng.gf

@@ -1,6 +1,4 @@
---# -path=.:../english:../abstract:../common:prelude
+--# -path=.:alltenses:prelude
-
--- --# -path=.:present:prelude
 
 concrete MultiEng of Multi =
   LangEng - [

src/GF/Canon/Look.hs

@@ -158,6 +158,9 @@ ccompute cnc = comp []
         R rs -> maybe (Bad ("unknown label" +++ prt l +++ "in" +++ prt u'))
                       return $ 
                         lookup l [ (x,y) | Ass x y <- rs]
+        FV rrs -> do
+          mapM (\r -> compt (P r l)) rrs >>= return . FV
+
         _    -> return $ P u' l
     FV ts    -> liftM FV (mapM compt ts)
     C E b    -> compt b

src/GF/Grammar/Lookup.hs

@@ -72,19 +72,25 @@ lookupResType gr m c = do
         CncFun (Just (cat,(cont,val))) _ _ -> do
           val' <- return val ---- lockRecType cat val 
           return $ mkProd (cont, val', [])
-        CncFun _ _ _ -> do
+        CncFun _ _ _      -> lookFunType m m c
-          a  <- abstractOfConcrete gr m
-          mu <- lookupModMod gr a
-          info <- lookupIdentInfo mu c
-          case info of
-            AbsFun (Yes ty) _ -> return $ redirectTerm m ty 
-            AbsCat _ _ -> return typeType
-            _ -> prtBad "cannot find type of reused function" c
         AnyInd _ n        -> lookupResType gr n c
         ResParam _        -> return $ typePType
         ResValue (Yes t)  -> return $ qualifAnnotPar m t
         _   -> Bad $ prt c +++ "has no type defined in resource" +++ prt m
     _ -> Bad $ prt m +++ "is not a resource"
+  where
+    lookFunType e m c = do
+          a  <- abstractOfConcrete gr m
+          lookFun e m c a
+    lookFun e m c a = do
+          mu <- lookupModMod gr a
+          info <- lookupIdentInfo mu c
+          case info of
+            AbsFun (Yes ty) _ -> return $ redirectTerm e ty 
+            AbsCat _ _ -> return typeType
+            AnyInd _ n -> lookFun e m c n
+            _ -> prtBad "cannot find type of reused function" c
+
 
 lookupParams :: SourceGrammar -> Ident -> Ident -> Err [Param]
 lookupParams gr = look True where