From fc0ec0c0cd02b0ce4366b2383313276031132b32 Mon Sep 17 00:00:00 2001 From: aarne Date: Tue, 6 Dec 2005 12:39:36 +0000 Subject: [PATCH] opers in cnc --- lib/resource-1.0/multimodal/DemRes.gf | 49 ------------------ lib/resource-1.0/multimodal/Demonstrative.gf | 11 ++-- lib/resource-1.0/multimodal/DemonstrativeI.gf | 11 ++-- src/GF/Compile/CheckGrammar.hs | 8 ++- src/GF/Compile/Optimize.hs | 2 +- src/GF/Source/SourceToGrammar.hs | 2 +- transfer/examples/aggregation/English.gf | 51 ++++++++++++++----- 7 files changed, 61 insertions(+), 73 deletions(-) diff --git a/lib/resource-1.0/multimodal/DemRes.gf b/lib/resource-1.0/multimodal/DemRes.gf index abdccd41d..fe3fc2c5c 100644 --- a/lib/resource-1.0/multimodal/DemRes.gf +++ b/lib/resource-1.0/multimodal/DemRes.gf @@ -28,53 +28,4 @@ resource DemRes = open Prelude in { 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 index e2d6f6183..ed2d8b9dd 100644 --- a/lib/resource-1.0/multimodal/Demonstrative.gf +++ b/lib/resource-1.0/multimodal/Demonstrative.gf @@ -6,6 +6,9 @@ abstract Demonstrative = Cat, Tense ** { MQS ; -- multimodal wh question MImp ; -- multimodal imperative MVP ; -- multimodal verb phrase + MComp ; -- multimodal complement to copula (MAP, DNP, DAdv) + MAP ; -- multimodal adjectival phrase + DNP ; -- demonstrative noun phrase DAdv ; -- demonstrative adverbial Point ; -- pointing gesture @@ -31,11 +34,11 @@ abstract Demonstrative = Cat, Tense ** { DemV2 : V2 -> DNP -> MVP ; -- takes this (here) DemVV : VV -> MVP -> MVP ; -- wants to fly (here) - DemComp : DComp -> MVP ; -- is here ; is bigger than this + DemComp : MComp -> MVP ; -- is here ; is bigger than this - DCompAP : DAP -> DComp ; -- bigger than this - DCompNP : DNP -> DComp ; -- the price of this - DCompAdv : DAdv -> DComp ; -- here + DCompAP : MAP -> MComp ; -- bigger than this + DCompNP : DNP -> MComp ; -- the price of this + DCompAdv : DAdv -> MComp ; -- here -- Adverbial modification of a verb phrase. diff --git a/lib/resource-1.0/multimodal/DemonstrativeI.gf b/lib/resource-1.0/multimodal/DemonstrativeI.gf index b929f9165..3287c9813 100644 --- a/lib/resource-1.0/multimodal/DemonstrativeI.gf +++ b/lib/resource-1.0/multimodal/DemonstrativeI.gf @@ -7,6 +7,8 @@ incomplete concrete DemonstrativeI of Demonstrative = Cat, TenseX ** MQS = Dem {s : Polarity => Str} ; MImp = Dem {s : Polarity => Str} ; MVP = Dem VP ; + MComp = Dem Comp ; + MAP = Dem AP ; DNP = Dem NP ; DAdv = Dem Adv ; Point = DemRes.Point ; @@ -26,8 +28,11 @@ incomplete concrete DemonstrativeI of Demonstrative = Cat, TenseX ** DemV2 verb obj = mkDem VP (ComplV2 verb obj) obj ; DemVV vv vp = mkDem VP (ComplVV vv vp) vp ; - DemComp comp = mkDem Comp (UseComp comp) ; - DCompAP + DemComp comp = mkDem VP (UseComp comp) comp ; +--- DemComp = keepDem VP UseComp ; + + DCompAP ap = mkDem Comp (CompAP ap) ap ; + DCompAdv adv = mkDem Comp (CompAdv adv) adv ; AdvMVP vp adv = @@ -38,7 +43,7 @@ incomplete concrete DemonstrativeI of Demonstrative = Cat, TenseX ** thisDet_DNP cn = mkDem NP (DetCN (MkDet NoPredet this_Quant NoNum NoOrd) cn) ; - thatDet_DNP p cn = mkDem (DetNP that_Det cn) ; + thatDet_DNP cn = mkDem NP (DetCN (MkDet NoPredet that_Quant NoNum NoOrd) cn) ; here_DAdv = mkDem Adv here_Adv ; diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index fc77bb6fa..08b14e3fb 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -218,7 +218,7 @@ checkCncInfo gr m (a,abs) (c,info) = do checkPrintname gr mpr return (c,CncCat (Yes typ') mdef' mpr) - _ -> return (c,info) + _ -> checkResInfo gr (c,info) where env = gr @@ -740,6 +740,12 @@ checkEqLType env t u trm = do all (\ (l,a) -> any (\ (k,b) -> alpha g a b && l == k) ts) rs + (ExtR r s, ExtR r' s') -> alpha g r r' && alpha g s s' + + (ExtR r s, t) -> alpha g r t || alpha g s t + + + -- the following say that Ints n is a subset of Int and of Ints m (App (Q (IC "Predef") (IC "Ints")) (EInt n), App (Q (IC "Predef") (IC "Ints")) (EInt m)) -> m >= n diff --git a/src/GF/Compile/Optimize.hs b/src/GF/Compile/Optimize.hs index 65ccc056f..40514b75c 100644 --- a/src/GF/Compile/Optimize.hs +++ b/src/GF/Compile/Optimize.hs @@ -63,7 +63,7 @@ evalModule oopts ms mo@(name,mod) = case mod of MGrammar (mod' : _) <- foldM evalOp gr ids return $ mod' MTConcrete a -> do - js' <- mapMTree (evalCncInfo oopts gr0 name a) js + js' <- mapMTree (evalCncInfo oopts gr name a) js ---- <- gr0 6/12/2005 return $ (name, ModMod (Module mt st fs me ops js')) _ -> return $ (name,mod) diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs index 2e63e68d4..00e7c0c56 100644 --- a/src/GF/Source/SourceToGrammar.hs +++ b/src/GF/Source/SourceToGrammar.hs @@ -339,7 +339,7 @@ transCncDef x = case x of let defs2 = [(f, termInPattern t) | (f,(_,Yes t)) <- defs'] returnl [(f, G.CncFun Nothing (yes t) nope) | (f,t) <- defs2] - _ -> Bad $ "illegal definition in concrete syntax:" ++++ printTree x + _ -> errIn ("illegal definition in concrete syntax:") $ transResDef x transPrintDef :: PrintDef -> Err [(Ident,G.Term)] transPrintDef x = case x of diff --git a/transfer/examples/aggregation/English.gf b/transfer/examples/aggregation/English.gf index 21da16b23..53199787b 100644 --- a/transfer/examples/aggregation/English.gf +++ b/transfer/examples/aggregation/English.gf @@ -1,18 +1,41 @@ concrete English of Abstract = { -pattern - Pred np vp = np ++ vp ; - ConjS c A B = A ++ c ++ B ; - ConjVP c A B = A ++ c ++ B ; - ConjNP c A B = A ++ c ++ B ; - - John = "John" ; - Mary = "Mary" ; - Bill = "Bill" ; - Walk = "walks" ; - Run = "runs" ; - Swim = "swims" ; +lincat + VP = {s : Num => Str} ; + NP, Conj = {s : Str ; n : Num} ; + +lin + Pred np vp = ss (np.s ++ vp.s ! np.n) ; + ConjS c A B = ss (A.s ++ c.s ++ B.s) ; + ConjVP c A B = {s = \\n => A.s ! n ++ c.s ++ B.s ! n} ; + ConjNP c A B = {s = A.s ++ c.s ++ B.s ; n = c.n} ; + + John = pn "John" ; + Mary = pn "Mary" ; + Bill = pn "Bill" ; + Walk = vp "walk" ; + Run = vp "run" ; + Swim = vp "swim" ; + + And = {s = "and" ; n = Pl} ; + Or = pn "or" ; + +param + Num = Sg | Pl ; + +oper + vp : Str -> {s : Num => Str} = \run -> { + s = table { + Sg => run + "s" ; + Pl => run + } + } ; + + pn : Str -> {s : Str ; n : Num} = \bob -> { + s = bob ; + n = Sg + } ; + + ss : Str -> {s : Str} = \s -> {s = s} ; - And = "and" ; - Or = "or" ; }