[commit: ghc] master: Comments and white space; plus structurally avoiding the previously "egregious bug" (b45309f)
git at git.haskell.org
git at git.haskell.org
Thu Feb 12 14:11:08 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/b45309fb660955558a10cbde058cf5db2e37ef2b/ghc
>---------------------------------------------------------------
commit b45309fb660955558a10cbde058cf5db2e37ef2b
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Thu Feb 12 14:12:43 2015 +0000
Comments and white space; plus structurally avoiding the previously "egregious bug"
>---------------------------------------------------------------
b45309fb660955558a10cbde058cf5db2e37ef2b
compiler/typecheck/TcUnify.hs | 26 ++++++++++++++++----------
1 file changed, 16 insertions(+), 10 deletions(-)
diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs
index 689e6f4..32a04de 100644
--- a/compiler/typecheck/TcUnify.hs
+++ b/compiler/typecheck/TcUnify.hs
@@ -980,21 +980,27 @@ checkTauTvUpdate dflags tv ty
= ASSERT( not (isTyVarTy ty) )
return Nothing
| otherwise
- = do { ty1 <- zonkTcType ty
- ; sub_k <- unifyKindX (tyVarKind tv) (typeKind ty1)
+ = do { ty <- zonkTcType ty
+ ; sub_k <- unifyKindX (tyVarKind tv) (typeKind ty)
; case sub_k of
- Nothing -> return Nothing
- Just LT -> return Nothing
- _ | is_return_tv -> if tv `elemVarSet` tyVarsOfType ty1
- then return Nothing
- else return (Just ty1)
- _ | defer_me ty1 -- Quick test
+ Nothing -> return Nothing -- Kinds don't unify
+ Just LT -> return Nothing -- (tv :: *) ~ (ty :: ?)
+ -- Don't unify because that would widen tv's kind
+
+ _ | is_return_tv -- ReturnTv: a simple occurs-check is all that we need
+ -- See Note [ReturnTv] in TcType
+ -> if tv `elemVarSet` tyVarsOfType ty
+ then return Nothing
+ else return (Just ty)
+
+ _ | defer_me ty -- Quick test
-> -- Failed quick test so try harder
- case occurCheckExpand dflags tv ty1 of
+ case occurCheckExpand dflags tv ty of
OC_OK ty2 | defer_me ty2 -> return Nothing
| otherwise -> return (Just ty2)
_ -> return Nothing
- | otherwise -> return (Just ty1) }
+
+ _ | otherwise -> return (Just ty) }
where
details = ASSERT2( isMetaTyVar tv, ppr tv ) tcTyVarDetails tv
info = mtv_info details
More information about the ghc-commits
mailing list