From 21aa3cfa17baf0cd6c0dd49aaa45cab8e2a4ad2c Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Sun, 5 Oct 2008 15:21:08 +0000
Subject: [PATCH] forced checking def definitions; accept pgf with no concretes

---
 src/GF/Compile/CheckGrammar.hs  |  3 ++-
 src/GF/Compile/GrammarToGFCC.hs |  2 +-
 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