X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcoreSyn%2FCoreLint.lhs;fp=ghc%2Fcompiler%2FcoreSyn%2FCoreLint.lhs;h=059b3513d61b138be5b35cd48daaf0ded4085bbe;hb=f25b9225f77ca8aa097a9acb4b5be27daea94891;hp=ee5efb7ab5aa207aba5eb69c2b6b7ec7549dee3f;hpb=04612d54b51bebf809717d1cf0242efb6294ee59;p=ghc-hetmet.git

diff --git a/ghc/compiler/coreSyn/CoreLint.lhs b/ghc/compiler/coreSyn/CoreLint.lhs
index ee5efb7..059b351 100644
--- a/ghc/compiler/coreSyn/CoreLint.lhs
+++ b/ghc/compiler/coreSyn/CoreLint.lhs
@@ -18,7 +18,7 @@ import CoreUtils	( findDefault, exprOkForSpeculation, coreBindsSize, mkPiType )
 import Unify      	( coreRefineTys )
 import Bag
 import Literal		( literalType )
-import DataCon		( dataConRepType, isVanillaDataCon, dataConTyCon, dataConResTy, dataConWorkId )
+import DataCon		( dataConRepType, isVanillaDataCon, dataConTyCon, dataConWorkId )
 import TysWiredIn	( tupleCon )
 import Var		( Var, Id, TyVar, idType, tyVarKind, mustHaveLocalBinding )
 import VarSet
@@ -462,14 +462,12 @@ lintCoreAlt scrut_ty alt_ty alt@(DataAlt con, args, rhs)
 
     else 	-- GADT
     do	{ let (tvs,ids) = span isTyVar args
-	      pat_res_ty = dataConResTy con (mkTyVarTys tvs)	      
-
         ; subst <- getTvSubst 
 	; let in_scope  = getTvInScope subst
 	      subst_env = getTvSubstEnv subst
-        ; case coreRefineTys in_scope tvs pat_res_ty scrut_ty of {
-             Nothing     -> return () ;	-- Alternative is dead code
-             Just refine -> updateTvSubstEnv (composeTvSubst in_scope refine subst_env) $
+        ; case coreRefineTys in_scope con tvs scrut_ty of {
+             Nothing          -> return () ;	-- Alternative is dead code
+             Just (refine, _) -> updateTvSubstEnv (composeTvSubst in_scope refine subst_env) $
     do 	{ tvs'     <- mapM lintTy (mkTyVarTys tvs)
 	; con_type <- lintTyApps (dataConRepType con) tvs'
 	; mapM lintBinder ids	-- Lint Ids in the refined world