diff options
| author | aarne <aarne@cs.chalmers.se> | 2008-10-05 15:21:08 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2008-10-05 15:21:08 +0000 |
| commit | 21aa3cfa17baf0cd6c0dd49aaa45cab8e2a4ad2c (patch) | |
| tree | 4c9e1ed7d44a07389eead4797742fdefe1879bd5 | |
| parent | 24207d40e9cb56173de22d9a424975f0da0bc416 (diff) | |
forced checking def definitions; accept pgf with no concretes
| -rw-r--r-- | src/GF/Compile/CheckGrammar.hs | 3 | ||||
| -rw-r--r-- | src/GF/Compile/GrammarToGFCC.hs | 2 | ||||
| -rw-r--r-- | src/GF/Compile/TypeCheck.hs | 10 |
3 files changed, 7 insertions, 8 deletions
diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index d63ce7258..c93788cd2 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -139,7 +139,8 @@ checkAbsInfo st m mo (c,info) = do md' <- case md of Yes d -> do let d' = elimTables d - mkCheckWarn "definition of function" $ checkEquation st (m,c) d' +---- mkCheckWarn "definition of function" $ checkEquation st (m,c) d' + mkCheck "definition of function" $ checkEquation st (m,c) d' return $ Yes d' _ -> return md return $ (c,AbsFun (Yes typ) md') diff --git a/src/GF/Compile/GrammarToGFCC.hs b/src/GF/Compile/GrammarToGFCC.hs index 5d2b1b408..4a59f970a 100644 --- a/src/GF/Compile/GrammarToGFCC.hs +++ b/src/GF/Compile/GrammarToGFCC.hs @@ -47,7 +47,7 @@ mkCanon2gfcc :: Options -> String -> SourceGrammar -> (String,D.PGF) mkCanon2gfcc opts cnc gr = (prIdent abs, (canon2gfcc opts pars . reorder abs . canon2canon abs) gr) where - abs = err error id $ M.abstractOfConcrete gr (identC (BS.pack cnc)) + abs = err (const c) id $ M.abstractOfConcrete gr c where c = identC (BS.pack cnc) pars = mkParamLincat gr -- Adds parsers for all concretes diff --git a/src/GF/Compile/TypeCheck.hs b/src/GF/Compile/TypeCheck.hs index 2d58a33ee..568eb3846 100644 --- a/src/GF/Compile/TypeCheck.hs +++ b/src/GF/Compile/TypeCheck.hs @@ -85,14 +85,12 @@ cont2val = type2val . cont2exp justTypeCheck :: Grammar -> Exp -> Val -> Err Constraints justTypeCheck gr e v = do (_,constrs0) <- checkExp (grammar2theory gr) (initTCEnv []) e v - 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 + (constrs1,_) <- unifyVal constrs0 + return $ filter notJustMeta constrs1 notJustMeta (c,k) = case (c,k) of - (VClos g1 (Meta m1), VClos g2 (Meta m2)) -> False - _ -> True + (VClos g1 (Meta m1), VClos g2 (Meta m2)) -> False + _ -> True grammar2theory :: Grammar -> Theory grammar2theory gr (m,f) = case lookupFunType gr m f of |