diff --git a/lib/resource/abstract/DemRes.gf b/lib/resource/abstract/DemRes.gf new file mode 100644 index 000000000..725d84770 --- /dev/null +++ b/lib/resource/abstract/DemRes.gf @@ -0,0 +1,41 @@ +interface DemRes = open Prelude, Resource in { + + oper + Pointing = {s5 : Str} ; + + noPointing : Pointing = {s5 = []} ; + + mkDemS : Cl -> DemAdverb -> Pointing -> MultiSentence = \cl,adv,p -> + {s = table { + MInd => msS (UseCl (PosTP TPresent ASimul) (AdvCl cl adv)) ; + MQuest => msQS (UseQCl (PosTP TPresent ASimul) (QuestCl (AdvCl cl adv))) + } ; + s5 = p.s5 ++ adv.s5 + } ; + mkDemQ : QCl -> DemAdverb -> Pointing -> MultiQuestion = \cl,adv,p -> + {s = msQS (UseQCl (PosTP TPresent ASimul) cl) ++ adv.s ; --- (AdvQCl cl adv)) ; + 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 + } ; + + mkDemType : Type -> Type = \t -> t ** Pointing ; + + Demonstrative : Type = mkDemType NP ; + MultiSentence : Type = mkDemType {s : MSForm => Str} ; + MultiQuestion : Type = mkDemType SS ; + DemAdverb : Type = mkDemType Adv ; + + addDAdv : Adv -> Pointing -> DemAdverb -> DemAdverb = \a,p,d -> + {s = a.s ++ d.s ; s5 = p.s5 ++ d.s5 ; lock_Adv = a.lock_Adv} ; + + param + MSForm = MInd | MQuest ; + +} diff --git a/lib/resource/abstract/Demonstrative.gf b/lib/resource/abstract/Demonstrative.gf new file mode 100644 index 000000000..ce9703d11 --- /dev/null +++ b/lib/resource/abstract/Demonstrative.gf @@ -0,0 +1,31 @@ +abstract Demonstrative = Categories ** { + + cat + MS ; + MQ ; + Dem ; + DAdv ; + Point ; + + fun + MkPoint : String -> Point ; + + DemV : V -> Dem -> DAdv -> MS ; + DemV2 : V2 -> Dem -> Dem -> DAdv -> MS ; + ModDemV : VV -> V -> Dem -> DAdv -> MS ; + ModDemV2 : VV -> V2 -> Dem -> Dem -> DAdv -> MS ; + + QDemV : V -> IP -> DAdv -> MQ ; + QDemV2 : V2 -> IP -> Dem -> DAdv -> MQ ; + + this_Dem : Point -> Dem ; + that_Dem : Point -> Dem ; + thisDet_Dem : Point -> CN -> Dem ; + thatDet_Dem : Point -> CN -> Dem ; + + here_DAdv : Point -> DAdv -> DAdv ; + here7from_DAdv : Point -> DAdv -> DAdv ; + here7to_DAdv : Point -> DAdv -> DAdv ; + NoDAdv : DAdv ; + +} diff --git a/lib/resource/abstract/DemonstrativeI.gf b/lib/resource/abstract/DemonstrativeI.gf new file mode 100644 index 000000000..9a6134288 --- /dev/null +++ b/lib/resource/abstract/DemonstrativeI.gf @@ -0,0 +1,42 @@ +--# -path=.:../abstract:../../prelude + +incomplete concrete DemonstrativeI of Demonstrative = + open Prelude, Resource, Basic, DemRes in { + + lincat + MS = MultiSentence ; + MQ = MultiQuestion ; + Dem = Demonstrative ; + DAdv = DemAdverb ; + Point = Pointing ; + + lin + MkPoint s = {s5 = s.s} ; + + DemV verb dem adv = + mkDemS (SPredV dem verb) adv dem ; + DemV2 verb su ob adv = + mkDemS (SPredV2 su verb ob) adv (concatDem su ob) ; + ModDemV vv verb dem adv = + mkDemS (SPredVV dem vv (UseVCl PPos ASimul (IPredV verb))) adv dem ; + ModDemV2 vv verb su ob adv = + mkDemS (SPredVV su vv (UseVCl PPos ASimul (IPredV2 verb ob))) adv (concatDem su ob) ; + + QDemV verb ip adv = + mkDemQ (QPredV ip verb) adv noPointing ; + QDemV2 verb ip ob adv = + mkDemQ (QPredV2 ip verb ob) adv ob ; + + + this_Dem p = this_NP ** p ; + that_Dem p = this_NP ** p ; + thisDet_Dem p cn = DetNP this_Det cn ** p ; + thatDet_Dem p cn = DetNP that_Det cn ** p ; + + here_DAdv p = addDAdv here_Adv p ; + here7from_DAdv p = addDAdv here7from_Adv p ; + here7to_DAdv p = addDAdv here7to_Adv p ; + + NoDAdv = {s,s5 = [] ; lock_Adv = <>} ; + +} diff --git a/lib/resource/abstract/Multimodal.gf b/lib/resource/abstract/Multimodal.gf new file mode 100644 index 000000000..fccc9487b --- /dev/null +++ b/lib/resource/abstract/Multimodal.gf @@ -0,0 +1,39 @@ +--# -path=.:../../prelude + +abstract Multimodal = + Rules, + Structural, + Basic, + Time, + Demonstrative + + ** { + + flags startcat=Phr ; + + fun + +-- Interface to $Demonstrative$. + + DemNP : NP -> Dem ; + DemAdv : Adv -> DAdv -> DAdv ; + SentMS : MS -> Phr ; + QuestMS : MS -> Phr ; + QuestMQ : MQ -> Phr ; + +-- Mount $Time$. + + AdvDate : Date -> Adv ; + AdvTime : Time -> Adv ; + +} + +{- +> p -cat=Phr "I go from here to here ; foo bar" +SentMS (DemV go_V (DemNP i_NP) + (here7from_DAdv (MkPoint "foo") (here7to_DAdv (MkPoint "bar") NoDAdv))) + +> p -cat=Phr "which cars go from here to here ; foo bar" +QuestMQ (QDemV go_V (IDetCN which8many_IDet (UseN car_N)) + (here7from_DAdv (MkPoint "foo") (here7to_DAdv (MkPoint "bar") NoDAdv))) +-} diff --git a/lib/resource/abstract/MultimodalI.gf b/lib/resource/abstract/MultimodalI.gf new file mode 100644 index 000000000..19ea7979d --- /dev/null +++ b/lib/resource/abstract/MultimodalI.gf @@ -0,0 +1,15 @@ +incomplete concrete MultimodalI of Multimodal = + open Prelude, Resource, Basic, Lang, DemRes in { + + lin + DemNP np = np ** {s5 = [] ; lock_NP = <>} ; + DemAdv adv = addDAdv (adv ** {lock_Adv = <>}) {s5 = []} ; + SentMS ms = {s = ms.s ! MInd ++ ";" ++ ms.s5} ; + QuestMS ms = {s = ms.s ! MQuest ++ ";" ++ ms.s5} ; + QuestMQ ms = {s = ms.s ++ ";" ++ ms.s5} ; + + AdvDate = AdvDate ; + AdvTime = AdvTime ; + +} + diff --git a/lib/resource/english/BasicEng.gf b/lib/resource/english/BasicEng.gf index 0bd8ce415..6f81c7cd3 100644 --- a/lib/resource/english/BasicEng.gf +++ b/lib/resource/english/BasicEng.gf @@ -223,7 +223,7 @@ lin stop_V = regDuplV "stop" ; jump_V = regV "jump" ; here_Adv = mkAdv "here" ; - here7to_Adv = mkAdv "here" ; + here7to_Adv = mkAdv ["to here"] ; here7from_Adv = mkAdv ["from here"] ; there_Adv = mkAdv "there" ; there7to_Adv = mkAdv "there" ; diff --git a/lib/resource/english/DemResEng.gf b/lib/resource/english/DemResEng.gf new file mode 100644 index 000000000..d6ffc3ea3 --- /dev/null +++ b/lib/resource/english/DemResEng.gf @@ -0,0 +1,9 @@ +instance DemResEng of DemRes = open Prelude, ResourceEng, SyntaxEng in { + + oper + msS : S -> Str = \x -> x.s ; + msQS : QS -> Str = \x -> x.s ! DirQ ; + msImp : Imp -> Str = \x -> x.s ! Sg ; + + +} ; diff --git a/lib/resource/english/DemonstrativeEng.gf b/lib/resource/english/DemonstrativeEng.gf new file mode 100644 index 000000000..567833b0b --- /dev/null +++ b/lib/resource/english/DemonstrativeEng.gf @@ -0,0 +1,7 @@ +--# -path=.:../abstract:../../prelude + +concrete DemonstrativeEng of Demonstrative = + CategoriesEng ** DemonstrativeI with + (Resource = ResourceEng), + (Basic = BasicEng), + (DemRes = DemResEng) ; diff --git a/lib/resource/english/MultimodalEng.gf b/lib/resource/english/MultimodalEng.gf new file mode 100644 index 000000000..74ebe6bbf --- /dev/null +++ b/lib/resource/english/MultimodalEng.gf @@ -0,0 +1,8 @@ +--# -path=.:../abstract:../../prelude + +concrete MultimodalEng of Multimodal = + RulesEng, StructuralEng, BasicEng, TimeEng, DemonstrativeEng ** MultimodalI with + (Resource = ResourceEng), + (Basic = BasicEng), + (Lang = LangEng), + (DemRes = DemResEng) ; diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index fb42bd17e..a1b042f00 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/10/02 20:50:19 $ +-- > CVS $Date: 2005/11/06 22:00:37 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.29 $ +-- > CVS $Revision: 1.30 $ -- -- AR 4\/12\/1999 -- 1\/4\/2000 -- 8\/9\/2001 -- 15\/5\/2002 -- 27\/11\/2002 -- 18\/6\/2003 -- @@ -564,6 +564,7 @@ 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 ** ... _ -> prtFail "invalid record type extension" trm RecType rr -> do (r',ty,s') <- checks [ diff --git a/src/GF/Infra/Modules.hs b/src/GF/Infra/Modules.hs index 561e4ff0a..435a1fca9 100644 --- a/src/GF/Infra/Modules.hs +++ b/src/GF/Infra/Modules.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/05/30 21:08:14 $ +-- > CVS $Date: 2005/11/06 22:00:37 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.24 $ +-- > CVS $Revision: 1.25 $ -- -- Datastructures and functions for modules, common to GF and GFC. -- @@ -349,6 +349,8 @@ sameMType m n = case (m,n) of (MTInstance _, MTInterface) -> True (MTResource, MTInstance _) -> True (MTResource, MTInterface) -> True + (MTAbstract, MTInterface) -> True -- for reuse + (MTConcrete _, MTResource) -> True -- for reuse (MTInterface,MTResource) -> True _ -> m == n