diff --git a/lib/resource-1.0/common/ParamX.gf b/lib/resource-1.0/common/ParamX.gf index a87c68a19..f8ecb373b 100644 --- a/lib/resource-1.0/common/ParamX.gf +++ b/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 + } + } ; + } diff --git a/lib/resource-1.0/doc/Resource-HOWTO.html b/lib/resource-1.0/doc/Resource-HOWTO.html index 20a099074..ce75e4f59 100644 --- a/lib/resource-1.0/doc/Resource-HOWTO.html +++ b/lib/resource-1.0/doc/Resource-HOWTO.html @@ -73,6 +73,7 @@ one of a small number of different types). Thus we have +

Infrastructure modules

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:
  1. Select a phrase category module, e.g. NounDut, and uncomment one - linearization rule (for instance, DefSg, which is + linearization rule (for instance, IndefSg, which is not too complicated).
  2. 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.
  3. Think about the categories involved (CN, NP, N) and the variations they have. Encode this in the lincats of CatDut. @@ -240,13 +241,14 @@ only one. So you will find yourself iterating the following steps:
  4. To be able to test the construction, define some words you need to instantiate it in LexDut. Again, it can be helpful to define some simple-minded - morphological paradigms in ResDut, e.g. corresponding to - ResEng.regN. + morphological paradigms in ResDut, in particular worst-case + constructors corresponding to e.g. + ResEng.mkNoun.
  5. Doing this, you may want to test the resource independently. Do this by 
            i -retain ResDut
-       cc regN "huis"
+       cc mkNoun "ei" "eieren" Neutr
  6. Uncomment NounDut and LexDut in TestDut, diff --git a/lib/resource-1.0/english/ParadigmsEng.gf b/lib/resource-1.0/english/ParadigmsEng.gf index 21854206c..fff368a0c 100644 --- a/lib/resource-1.0/english/ParadigmsEng.gf +++ b/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 = <>} ; diff --git a/lib/resource-1.0/multimodal/DemRes.gf b/lib/resource-1.0/multimodal/DemRes.gf new file mode 100644 index 000000000..abdccd41d --- /dev/null +++ b/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 ; + +-} + +} diff --git a/lib/resource-1.0/multimodal/Demonstrative.gf b/lib/resource-1.0/multimodal/Demonstrative.gf new file mode 100644 index 000000000..7f14ff061 --- /dev/null +++ b/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 ; + +} diff --git a/lib/resource-1.0/multimodal/DemonstrativeEng.gf b/lib/resource-1.0/multimodal/DemonstrativeEng.gf new file mode 100644 index 000000000..b4b9d5508 --- /dev/null +++ b/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) ; + diff --git a/lib/resource-1.0/multimodal/DemonstrativeI.gf b/lib/resource-1.0/multimodal/DemonstrativeI.gf new file mode 100644 index 000000000..8a5fd7e51 --- /dev/null +++ b/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" ; + +} + diff --git a/lib/resource-1.0/multimodal/Multimodal.gf b/lib/resource-1.0/multimodal/Multimodal.gf new file mode 100644 index 000000000..7d3df68d5 --- /dev/null +++ b/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 + ** {} ; diff --git a/lib/resource-1.0/multimodal/MultimodalEng.gf b/lib/resource-1.0/multimodal/MultimodalEng.gf new file mode 100644 index 000000000..81daed3f8 --- /dev/null +++ b/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 + ** {} ; + diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index 14d4f9b93..fc77bb6fa 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/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