From 26e86f13dca20efa7797b52dab4ab6195bec91e2 Mon Sep 17 00:00:00 2001
From: krasimir <krasimir@chalmers.se>
Date: Sun, 15 Mar 2009 17:33:14 +0000
Subject: [PATCH] code cleanup in the typechecker

---
 src/GF/Compile/CheckGrammar.hs |  1 -
 src/GF/Compile/TypeCheck.hs    | 47 +++++-----------------------------
 src/GF/Grammar/PrGrammar.hs    |  5 +---
 3 files changed, 7 insertions(+), 46 deletions(-)

diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs
index 552bd4177..e128c3477 100644
--- a/src/GF/Compile/CheckGrammar.hs
+++ b/src/GF/Compile/CheckGrammar.hs
@@ -138,7 +138,6 @@ checkAbsInfo st m mo (c,info) = do
  where
    mkCheck cat ss = case ss of
      [] -> return (c,info)
-     ["[]"] -> return (c,info) ----
      _  -> checkErr $ Bad (unlines ss ++++ "in" +++ cat +++ prt c +++ pos c)
    ---- temporary solution when tc of defs is incomplete
    mkCheckWarn cat ss = case ss of
diff --git a/src/GF/Compile/TypeCheck.hs b/src/GF/Compile/TypeCheck.hs
index 1e124f60e..e824a0cfe 100644
--- a/src/GF/Compile/TypeCheck.hs
+++ b/src/GF/Compile/TypeCheck.hs
@@ -20,15 +20,13 @@ module GF.Compile.TypeCheck (-- * top-level type checking functions; TC should n
 		 ) where
 
 import GF.Data.Operations
---import GF.Data.Zipper
 
 import GF.Grammar.Abstract
+import GF.Grammar.Lookup
+import GF.Grammar.Unify
+import GF.Grammar.Printer
 import GF.Compile.Refresh
 import GF.Compile.AbsCompute
-import GF.Grammar.Lookup
-import qualified GF.Grammar.Lookup as Lookup ---
-import GF.Grammar.Unify ---
-
 import GF.Compile.TC
 
 import Control.Monad (foldM, liftM, liftM2)
@@ -41,39 +39,7 @@ initTCEnv gamma =
 
 type2val :: Type -> Val
 type2val = VClos []
-{-
-aexp2tree :: (AExp,[(Val,Val)]) -> Err Tree
-aexp2tree (aexp,cs) = do
-  (bi,at,vt,ts) <- treeForm aexp
-  ts' <- mapM aexp2tree [(t,[]) | t <- ts]
-  return $ Tr (N (bi,at,vt,(cs,[]),False),ts')
- where
-  treeForm a = case a of
-     AAbs x v b  -> do
-       (bi, at, vt, args) <- treeForm b
-       v' <- whnf v ---- should not be needed...
-       return ((x,v') : bi, at, vt, args)
-     AApp c a v -> do
-       (_,at,_,args) <- treeForm c
-       v' <- whnf v ---- 
-       return ([],at,v',args ++ [a]) 
-     AVr x v -> do
-       v' <- whnf v ---- 
-       return ([],AtV x,v',[])
-     ACn c v -> do
-       v' <- whnf v ---- 
-       return ([],AtC c,v',[])
-     AInt i -> do
-       return ([],AtI i,valAbsInt,[])
-     AFloat i -> do
-       return ([],AtF i,valAbsFloat,[])
-     AStr s -> do
-       return ([],AtL s,valAbsString,[])
-     AMeta m v -> do
-       v' <- whnf v ---- 
-       return ([],AtM m,v',[])
-     _ -> Bad "illegal tree" -- AProd
--}
+
 cont2exp :: Context -> Exp
 cont2exp c = mkProd (c, eType, []) -- to check a context
 
@@ -106,11 +72,10 @@ checkTyp :: Grammar -> Type -> [String]
 checkTyp gr typ = err singleton prConstrs $ justTypeCheck gr typ vType
 
 checkEquation :: Grammar -> Fun -> Term -> [String]
-checkEquation gr (m,fun) def = err singleton id $ do
+checkEquation gr (m,fun) def = err singleton prConstrs $ do
   typ  <- lookupFunType gr m fun
   cs   <- justTypeCheck gr def (vClos typ)
-  let cs1 = filter notJustMeta cs
-  return $ ifNull [] (singleton . prConstraints) cs1
+  return $ filter notJustMeta cs
 
 checkConstrs :: Grammar -> Cat -> [Ident] -> [String]
 checkConstrs gr cat _ = [] ---- check constructors!
diff --git a/src/GF/Grammar/PrGrammar.hs b/src/GF/Grammar/PrGrammar.hs
index 1b26d1d48..bad356bef 100644
--- a/src/GF/Grammar/PrGrammar.hs
+++ b/src/GF/Grammar/PrGrammar.hs
@@ -22,7 +22,7 @@
 module GF.Grammar.PrGrammar (Print(..),
 		  prtBad,
 		  prGrammar,
-		  prConstrs, prConstraints, 
+		  prConstrs, 
                   prTermTabular
 		 ) where
 
@@ -152,9 +152,6 @@ prprTree = prf False where
 
 -- auxiliaries
 
-prConstraints :: Constraints -> String
-prConstraints = concat . prConstrs
-
 prMetaSubst :: MetaSubst -> String
 prMetaSubst = concat . prMSubst