updated dialogue to multimodal ; bug fixes in grammar compilation

8 files changed, 96 insertions, 54 deletions

diff --git a/examples/dialogue/AuxDialogue.gf b/examples/dialogue/AuxDialogue.gf
index 63b9c6979..ee1313d9b 100644
--- a/examples/dialogue/AuxDialogue.gf
+++ b/examples/dialogue/AuxDialogue.gf
@@ -1,6 +1,6 @@
-interface AuxDialogue = open Lang in {
+interface AuxDialogue = open Multi in {
   oper
-    defN : N -> NP = \n -> 
+    defN : N -> NP = \n ->
       DetCN (DetSg (SgQuant DefArt) NoOrd) (UseN n) ;
 
     mkMove : Str -> Phr = \s -> {s = variants {
diff --git a/examples/dialogue/AuxEng.gf b/examples/dialogue/AuxEng.gf
index 9c4ac8f37..89f2ec57e 100644
--- a/examples/dialogue/AuxEng.gf
+++ b/examples/dialogue/AuxEng.gf
@@ -1,2 +1,2 @@
-instance AuxEng of AuxDialogue = open LangEng in {
-}
\ No newline at end of file
+instance AuxEng of AuxDialogue = open MultiEng in {
+}
diff --git a/examples/dialogue/Dialogue.gf b/examples/dialogue/Dialogue.gf
index 31163cffe..41f805c93 100644
--- a/examples/dialogue/Dialogue.gf
+++ b/examples/dialogue/Dialogue.gf
@@ -14,14 +14,14 @@ abstract Dialogue = {
     Oper2 Kind Kind ;
 
   fun
-    MRequest : Action -> Move ;
-    MConfirm : Action -> Move ;
-    MAnswer  : Proposition -> Move ;
-    MIssue   : Question -> Move ;
+    IRequest : Action -> Input ;
+    IConfirm : Action -> Input ;
+    IAnswer  : Proposition -> Input ;
+    IIssue   : Question -> Input ;
 
-    MYes     : Move ;
-    MNo      : Move ;
-    MObject  : (k : Kind) -> Object k -> Move ;
+    IYes     : Input ;
+    INo      : Input ;
+    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 ;
 }
diff --git a/examples/dialogue/DialogueEng.gf b/examples/dialogue/DialogueEng.gf
index b30f30bcb..9f75525fe 100644
--- a/examples/dialogue/DialogueEng.gf
+++ b/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) ;
diff --git a/examples/dialogue/DialogueI.gf b/examples/dialogue/DialogueI.gf
index 20da618ac..9337638c9 100644
--- a/examples/dialogue/DialogueI.gf
+++ b/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} ;
-    Proposition = Phr ; ----
-    Question = Phr ;
+    Action = {s : ActType => Str ; point : Str} ;
+    Proposition = Utt ; ----
+    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) ;
-    MConfirm a = ss (a.s ! AConfirm) ;
-    MAnswer  a = a ;
-    MIssue   a = a ;
+    IRequest a = {s = a.s ! ARequest ; point = a.point} ;
+    IConfirm a = {s = a.s ! AConfirm ; point = a.point} ;
+    IAnswer  a = a ;
+    IIssue   a = a ;
 
-    MYes = yes_Phr ;
-    MNo  = no_Phr ;
-    MObject _ ob = PhrUtt NoPConj (UttNP ob) optPlease ;
+    IYes = yes_Phr ** noPoint ;
+    INo  = no_Phr ** noPoint ;
+    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 
-        (ExistIP (IDetCN whichPl_IDet NoNum NoOrd k)))) NoVoc ;
+      UttQS (UseQCl TPres ASimul PPos 
+        (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
-          } ;
-        AConfirm => variants {
+          }).s ;
+        AConfirm => (variants {
           aInf vp
-          }
-        }
+          }).s
+        } ;
+      point = vp.point
       } ;
 
-   optPlease : Voc = variants {NoVoc ; please_Voc} ;
+    optPlease : Voc = variants {NoVoc ; please_Voc} ;
+ 
+    aImp : VP -> Utt = \vp ->
+      UttImpSg PPos (ImpVP vp) ;
 
-   aImp : VP -> Str = \vp ->
-     (PhrUtt NoPConj (UttImpSg PPos (ImpVP vp)) optPlease).s ;
+    aWant : VP -> Utt = \vp ->
+      UttS (UseCl TPres ASimul PPos 
+        (PredVP (UsePron i_Pron) (ComplVV want_VV vp))) ;
 
-   aWant : VP -> Str = \vp ->
-     (PhrUtt NoPConj (UttS (UseCl TPres ASimul PPos (PredVP (UsePron i_Pron) 
-        (ComplVV want_VV vp)))) optPlease).s ;
+    aCanYou : VP -> Utt = \vp ->
+      UttQS (UseQCl TPres ASimul PPos (QuestCl 
+        (PredVP (UsePron youSg_Pron) (ComplVV can_VV vp)))) ;
 
-   aCanYou : VP -> Str = \vp ->
-     (PhrUtt NoPConj (UttQS (UseQCl TPres ASimul PPos (QuestCl (PredVP 
-        (UsePron youSg_Pron) (ComplVV can_VV vp))))) optPlease).s ;
+    aInf : VP -> Utt = \vp ->
+      UttVP vp ;
 
-   aInf : VP -> Str = \vp ->
-     (PhrUtt NoPConj (UttVP vp) NoVoc).s ;
+-- 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 = []} ;
 
 }
 
diff --git a/examples/dialogue/LightsEng.gf b/examples/dialogue/LightsEng.gf
index eceaa487d..77dcc0aed 100644
--- a/examples/dialogue/LightsEng.gf
+++ b/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") ;
diff --git a/src/GF/Canon/Look.hs b/src/GF/Canon/Look.hs
index 1fef9b586..1ac39c695 100644
--- a/src/GF/Canon/Look.hs
+++ b/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
diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs
index eaa44c1c9..630b9c204 100644
--- a/src/GF/Grammar/Lookup.hs
+++ 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
+        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 m ty 
+            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
-        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"
+
 
 lookupParams :: SourceGrammar -> Ident -> Ident -> Err [Param]
 lookupParams gr = look True where