X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcGadt.lhs;h=b556e89e3273ed15e45c2ad32e4d8479f7979933;hb=3f1b316d7035c55cd712cd39a9981339bcef2e8c;hp=987a4c66e785ebaf8fb9d776019419bc4c6fcb9d;hpb=f4510d27c5883fe7e8570f4dd49d45a8b0122f2c;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcGadt.lhs b/compiler/typecheck/TcGadt.lhs index 987a4c6..b556e89 100644 --- a/compiler/typecheck/TcGadt.lhs +++ b/compiler/typecheck/TcGadt.lhs @@ -10,11 +10,17 @@ %************************************************************************ \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module TcGadt ( Refinement, emptyRefinement, isEmptyRefinement, gadtRefine, refineType, refinePred, refineResType, - dataConCanMatch, tcUnifyTys, BindFlag(..) ) where @@ -25,7 +31,6 @@ import Coercion import Type import TypeRep -import DataCon import Var import VarEnv import VarSet @@ -34,11 +39,8 @@ import Maybes import Control.Monad import Outputable import TcType - -#ifdef DEBUG import Unique import UniqFM -#endif \end{code} @@ -184,7 +186,7 @@ gadtRefine (Reft in_scope env1) do_one reft co_var = unify reft (TyVarTy co_var) ty1 ty2 where (ty1,ty2) = splitCoercionKind (tyVarKind co_var) -\end{code} +\end{code} %************************************************************************ %* * @@ -242,29 +244,10 @@ fixTvSubstEnv in_scope env fixpt = mapVarEnv (substTy (mkTvSubst in_scope fixpt)) env ---------------------------- -dataConCanMatch :: [Type] -> DataCon -> Bool --- Returns True iff the data con can match a scrutinee of type (T tys) --- where T is the type constructor for the data con --- --- Instantiate the equations and try to unify them -dataConCanMatch tys con - | null eq_spec = True -- Common - | all isTyVarTy tys = True -- Also common - | otherwise - = isJust (tcUnifyTys (\tv -> BindMe) - (map (substTyVar subst . fst) eq_spec) - (map snd eq_spec)) - where - dc_tvs = dataConUnivTyVars con - eq_spec = dataConEqSpec con - subst = zipTopTvSubst dc_tvs tys - ----------------------------- tryToBind :: TyVarSet -> TyVar -> BindFlag tryToBind tv_set tv | tv `elemVarSet` tv_set = BindMe | otherwise = AvoidMe - \end{code} @@ -275,7 +258,6 @@ tryToBind tv_set tv | tv `elemVarSet` tv_set = BindMe %************************************************************************ \begin{code} -#ifdef DEBUG badReftElts :: InternalReft -> [(Unique, (Coercion,Type))] -- Return the BAD elements of the refinement -- Should be empty; used in asserions only @@ -288,7 +270,6 @@ badReftElts env | otherwise = False where (ty1,ty2) = coercionKind co -#endif emptyInternalReft :: InternalReft emptyInternalReft = emptyVarEnv