From 95463f6dbae318b055e2cb7927ac7acb320c8382 Mon Sep 17 00:00:00 2001 From: aarne Date: Tue, 13 Sep 2005 21:05:32 +0000 Subject: fix in tc --- src/GF/Grammar/TypeCheck.hs | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) (limited to 'src/GF') diff --git a/src/GF/Grammar/TypeCheck.hs b/src/GF/Grammar/TypeCheck.hs index 66416f1d4..3158aae17 100644 --- a/src/GF/Grammar/TypeCheck.hs +++ b/src/GF/Grammar/TypeCheck.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/04/21 16:22:30 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.14 $ +-- > CVS $Date: 2005/09/13 22:05:32 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.15 $ -- -- (Description of the module) ----------------------------------------------------------------------------- @@ -243,7 +243,14 @@ cont2val = type2val . cont2exp justTypeCheckSrc :: Grammar -> Exp -> Val -> Err Constraints justTypeCheckSrc gr e v = do (_,constrs0) <- checkExp (grammar2theorySrc gr) (initTCEnv []) e v - return $ fst $ splitConstraintsSrc gr constrs0 + return $ filter notJustMeta constrs0 +---- return $ fst $ splitConstraintsSrc gr constrs0 +---- this change was to force proper tc of abstract modules. +---- May not be quite right. AR 13/9/2005 + where + notJustMeta (c,k) = case (c,k) of + (VClos g1 (Meta m1), VClos g2 (Meta m2)) -> False + _ -> True grammar2theorySrc :: Grammar -> Theory grammar2theorySrc gr (m,f) = case lookupFunTypeSrc gr m f of -- cgit v1.2.3