%************************************************************************
\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
import Type
import TypeRep
-import DataCon
import Var
import VarEnv
import VarSet
import Control.Monad
import Outputable
import TcType
-
-#ifdef DEBUG
import Unique
import UniqFM
-#endif
\end{code}
do_one reft co_var = unify reft (TyVarTy co_var) ty1 ty2
where
(ty1,ty2) = splitCoercionKind (tyVarKind co_var)
-\end{code}
+\end{code}
%************************************************************************
%* *
-- then use transitivity with the original coercion
-----------------------------
+-- XXX Can we do this more nicely, by exploiting laziness?
+-- Or avoid needing it in the first place?
fixTvSubstEnv :: InScopeSet -> TvSubstEnv -> TvSubstEnv
-fixTvSubstEnv in_scope env
- = fixpt
+fixTvSubstEnv in_scope env = f env
where
- 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
+ f e = let e' = mapUFM (substTy (mkTvSubst in_scope e)) e
+ in if and $ eltsUFM $ intersectUFM_C tcEqType e e'
+ then e
+ else f e'
----------------------------
tryToBind :: TyVarSet -> TyVar -> BindFlag
tryToBind tv_set tv | tv `elemVarSet` tv_set = BindMe
| otherwise = AvoidMe
-
\end{code}
%************************************************************************
\begin{code}
-#ifdef DEBUG
badReftElts :: InternalReft -> [(Unique, (Coercion,Type))]
-- Return the BAD elements of the refinement
-- Should be empty; used in asserions only
| otherwise = False
where
(ty1,ty2) = coercionKind co
-#endif
emptyInternalReft :: InternalReft
emptyInternalReft = emptyVarEnv