[commit: ghc] ghc-8.0: Kill off redundant SigTv check in occurCheckExpand (11f9bff)

git at git.haskell.org git at git.haskell.org
Sun Oct 2 18:53:52 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/11f9bffb11462f0bed3881e160968bf024466bdc/ghc

>---------------------------------------------------------------

commit 11f9bffb11462f0bed3881e160968bf024466bdc
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon May 16 22:08:08 2016 +0100

    Kill off redundant SigTv check in occurCheckExpand
    
    This patch simply deletes code, the SigTv check in
    occurCheckExpand.  As the new comment says
    
    In the past we also rejected a SigTv matched with a non-tyvar
    But it is wrong to reject that for Givens;
    and SigTv is in any case handled separately by
       - TcUnify.checkTauTvUpdate (on-the-fly unifier)
       - TcInteract.canSolveByUnification (main constraint solver)
    
    (cherry picked from commit d25cb61a1c2a135a2564143a332f8b2962f134bc)


>---------------------------------------------------------------

11f9bffb11462f0bed3881e160968bf024466bdc
 compiler/typecheck/TcType.hs | 20 ++++++--------------
 1 file changed, 6 insertions(+), 14 deletions(-)

diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index a949938..b5cafac 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -1536,7 +1536,6 @@ See also Note [occurCheckExpand] in TcCanonical
 data OccCheckResult a
   = OC_OK a
   | OC_Forall
-  | OC_NonTyVar
   | OC_Occurs
 
 instance Functor OccCheckResult where
@@ -1550,7 +1549,6 @@ instance Monad OccCheckResult where
   return            = pure
   OC_OK x     >>= k = k x
   OC_Forall   >>= _ = OC_Forall
-  OC_NonTyVar >>= _ = OC_NonTyVar
   OC_Occurs   >>= _ = OC_Occurs
 
 occurCheckExpand :: DynFlags -> TcTyVar -> Type -> OccCheckResult Type
@@ -1558,17 +1556,19 @@ occurCheckExpand :: DynFlags -> TcTyVar -> Type -> OccCheckResult Type
 -- Check whether
 --   a) the given variable occurs in the given type.
 --   b) there is a forall in the type (unless we have -XImpredicativeTypes)
---   c) if it's a SigTv, ty should be a tyvar
 --
 -- We may have needed to do some type synonym unfolding in order to
 -- get rid of the variable (or forall), so we also return the unfolded
 -- version of the type, which is guaranteed to be syntactically free
 -- of the given type variable.  If the type is already syntactically
 -- free of the variable, then the same type is returned.
-
+--
+-- NB: in the past we also rejected a SigTv matched with a non-tyvar
+--     But it is wrong to reject that for Givens;
+--     and SigTv is in any case handled separately by
+--        - TcUnify.checkTauTvUpdate (on-the-fly unifier)
+--        - TcInteract.canSolveByUnification (main constraint solver)
 occurCheckExpand dflags tv ty
-  | MetaTv { mtv_info = SigTv } <- details
-                  = go_sig_tv ty
   | fast_check ty = return ty
   | otherwise     = go emptyVarEnv ty
   where
@@ -1576,14 +1576,6 @@ occurCheckExpand dflags tv ty
 
     impredicative = canUnifyWithPolyType dflags details
 
-    -- Check 'ty' is a tyvar, or can be expanded into one
-    go_sig_tv ty@(TyVarTy tv')
-      | fast_check (tyVarKind tv') = return ty
-      | otherwise                  = do { k' <- go emptyVarEnv (tyVarKind tv')
-                                        ; return (mkTyVarTy (setTyVarKind tv' k')) }
-    go_sig_tv ty | Just ty' <- coreView ty = go_sig_tv ty'
-    go_sig_tv _                            = OC_NonTyVar
-
     -- True => fine
     fast_check (LitTy {})          = True
     fast_check (TyVarTy tv')       = tv /= tv' && fast_check (tyVarKind tv')



More information about the ghc-commits mailing list