diff options
| -rw-r--r-- | src/GF/Compile/CheckGrammar.hs | 1 | ||||
| -rw-r--r-- | src/GF/Compile/TypeCheck.hs | 47 | ||||
| -rw-r--r-- | 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 |