From a6dc94435648dfeeb10a691a1fd6d3ad2f6dd154 Mon Sep 17 00:00:00 2001 From: aarne Date: Tue, 6 Dec 2005 12:39:36 +0000 Subject: [PATCH] opers in cnc --- src/GF/Compile/CheckGrammar.hs | 8 +++- src/GF/Compile/Optimize.hs | 2 +- src/GF/Source/SourceToGrammar.hs | 2 +- transfer/examples/aggregation/English.gf | 51 +++++++++++++++++------- 4 files changed, 46 insertions(+), 17 deletions(-) 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" ; }