Use TyVars in PatSyns
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 25 Nov 2016 11:39:38 +0000 (11:39 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Fri, 25 Nov 2016 17:46:50 +0000 (17:46 +0000)
I found that some TcTyVars were lurking in a PatSyn, because
tc_patsyn_finish was using the TcType -> TcType zonker rather
than the TcType -> Type zonker.  Eeek.

I fixing this I also tided up function naming a bit (still not
terrific), and removed the unused TcTyBinder type entirely.

compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcHsType.hs
compiler/typecheck/TcMType.hs
compiler/typecheck/TcPatSyn.hs
compiler/typecheck/TcTyClsDecls.hs
compiler/typecheck/TcType.hs

index 2589576..5a455ea 100644 (file)
@@ -27,7 +27,7 @@ module TcHsSyn (
         -- in TcMType
         zonkTopDecls, zonkTopExpr, zonkTopLExpr,
         zonkTopBndrs, zonkTyBndrsX,
-        zonkTyConBinders,
+        zonkTyVarBindersX, zonkTyVarBinderX,
         emptyZonkEnv, mkEmptyZonkEnv,
         zonkTcTypeToType, zonkTcTypeToTypes, zonkTyVarOcc,
         zonkCoToCo, zonkSigType,
@@ -335,10 +335,10 @@ zonkEvVarOcc env v
   | otherwise
   = return (EvId $ zonkIdOcc env v)
 
-zonkTyBndrsX :: ZonkEnv -> [TyVar] -> TcM (ZonkEnv, [TyVar])
+zonkTyBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TyVar])
 zonkTyBndrsX = mapAccumLM zonkTyBndrX
 
-zonkTyBndrX :: ZonkEnv -> TyVar -> TcM (ZonkEnv, TyVar)
+zonkTyBndrX :: ZonkEnv -> TcTyVar -> TcM (ZonkEnv, TyVar)
 -- This guarantees to return a TyVar (not a TcTyVar)
 -- then we add it to the envt, so all occurrences are replaced
 zonkTyBndrX env tv
@@ -348,11 +348,14 @@ zonkTyBndrX env tv
        ; let tv' = mkTyVar (tyVarName tv) ki
        ; return (extendTyZonkEnv1 env tv', tv') }
 
-zonkTyConBinders :: ZonkEnv -> [TyConBinder] -> TcM (ZonkEnv, [TyConBinder])
-zonkTyConBinders = mapAccumLM zonkTyConBinderX
+zonkTyVarBindersX :: ZonkEnv -> [TyVarBndr TcTyVar vis]
+                             -> TcM (ZonkEnv, [TyVarBndr TyVar vis])
+zonkTyVarBindersX = mapAccumLM zonkTyVarBinderX
 
-zonkTyConBinderX :: ZonkEnv -> TyConBinder -> TcM (ZonkEnv, TyConBinder)
-zonkTyConBinderX env (TvBndr tv vis)
+zonkTyVarBinderX :: ZonkEnv -> TyVarBndr TcTyVar vis
+                            -> TcM (ZonkEnv, TyVarBndr TyVar vis)
+-- Takes a TcTyVar and guarantees to return a TyVar
+zonkTyVarBinderX env (TvBndr tv vis)
   = do { (env', tv') <- zonkTyBndrX env tv
        ; return (env', TvBndr tv' vis) }
 
index 8fb5d16..da1eeee 100644 (file)
@@ -1220,7 +1220,7 @@ Note [Dependent LHsQTyVars]
 We track (in the renamer) which explicitly bound variables in a
 LHsQTyVars are manifestly dependent; only precisely these variables
 may be used within the LHsQTyVars. We must do this so that kcHsTyVarBndrs
-can produce the right TcTyBinders, and tell Anon vs. Named. Earlier,
+can produce the right TyConBinders, and tell Anon vs. Named. Earlier,
 I thought it would work simply to do a free-variable check during
 kcHsTyVarBndrs, but this is bogus, because there may be unsolved
 equalities about. And we don't want to eagerly solve the equalities,
@@ -1283,7 +1283,7 @@ kcHsTyVarBndrs name unsat cusk open_fam all_kind_vars
 
            -- Now, because we're in a CUSK, quantify over the mentioned
            -- kind vars, in dependency order.
-       ; tc_binders  <- mapM zonkTyConBinder tc_binders
+       ; tc_binders  <- mapM zonkTcTyVarBinder tc_binders
        ; res_kind <- zonkTcType res_kind
        ; let tc_tvs = binderVars tc_binders
              qkvs   = tyCoVarsOfTypeWellScoped (mkTyConKind tc_binders res_kind)
index c200b4e..eae7305 100644 (file)
@@ -75,7 +75,7 @@ module TcMType (
   zonkTcTypeAndSplitDepVars, zonkTcTypesAndSplitDepVars,
   zonkQuantifiedTyVar,
   quantifyTyVars, quantifyZonkedTyVars,
-  zonkTcTyCoVarBndr, zonkTcTyBinder, zonkTyConBinder,
+  zonkTcTyCoVarBndr, zonkTcTyVarBinder,
   zonkTcType, zonkTcTypes, zonkCo,
   zonkTyCoVarKind, zonkTcTypeMapper,
 
@@ -90,7 +90,6 @@ module TcMType (
 import TyCoRep
 import TcType
 import Type
-import TyCon( TyConBinder )
 import Kind
 import Coercion
 import Class
@@ -1435,16 +1434,8 @@ zonkTcTyCoVarBndr tyvar
   = ASSERT2( isImmutableTyVar tyvar || (not $ isTyVar tyvar), pprTyVar tyvar )
     updateTyVarKindM zonkTcType tyvar
 
--- | Zonk a TyBinder
-zonkTcTyBinder :: TcTyBinder -> TcM TcTyBinder
-zonkTcTyBinder (Anon ty)   = Anon  <$> zonkTcType ty
-zonkTcTyBinder (Named tvb) = Named <$> zonkTyVarBinder tvb
-
-zonkTyConBinder :: TyConBinder -> TcM TyConBinder
-zonkTyConBinder = zonkTyVarBinder
-
-zonkTyVarBinder :: TyVarBndr TyVar vis -> TcM (TyVarBndr TyVar vis)
-zonkTyVarBinder (TvBndr tv vis)
+zonkTcTyVarBinder :: TyVarBndr TcTyVar vis -> TcM (TyVarBndr TcTyVar vis)
+zonkTcTyVarBinder (TvBndr tv vis)
   = do { tv' <- zonkTcTyCoVarBndr tv
        ; return (TvBndr tv' vis) }
 
index 5c62121..47a27b3 100644 (file)
@@ -20,6 +20,8 @@ import TcRnMonad
 import TcSigs( emptyPragEnv, completeSigFromId )
 import TcEnv
 import TcMType
+import TcHsSyn( zonkTyVarBindersX, zonkTcTypeToTypes
+              , zonkTcTypeToType, emptyZonkEnv )
 import TysPrim
 import TysWiredIn  ( runtimeRepTy )
 import Name
@@ -292,18 +294,19 @@ tc_patsyn_finish :: Located Name  -- ^ PatSyn Name
                  -- ^ Whether fields, empty if not record PatSyn
                  -> TcM (LHsBinds Id, TcGblEnv)
 tc_patsyn_finish lname dir is_infix lpat'
-                 (univ_bndrs, req_theta, req_ev_binds, req_dicts)
-                 (ex_bndrs, ex_tys, prov_theta, prov_dicts)
+                 (univ_tvs, req_theta, req_ev_binds, req_dicts)
+                 (ex_tvs,   ex_tys,    prov_theta,   prov_dicts)
                  (args, arg_tys)
                  pat_ty field_labels
   = do { -- Zonk everything.  We are about to build a final PatSyn
          -- so there had better be no unification variables in there
-         univ_tvs'    <- mapMaybeM zonk_qtv univ_bndrs
-       ; ex_tvs'      <- mapMaybeM zonk_qtv ex_bndrs
-       ; prov_theta'  <- zonkTcTypes prov_theta
-       ; req_theta'   <- zonkTcTypes req_theta
-       ; pat_ty'      <- zonkTcType pat_ty
-       ; arg_tys'     <- zonkTcTypes arg_tys
+
+         (ze, univ_tvs') <- zonkTyVarBindersX emptyZonkEnv univ_tvs
+       ; req_theta'      <- zonkTcTypeToTypes ze req_theta
+       ; (ze, ex_tvs')   <- zonkTyVarBindersX ze ex_tvs
+       ; prov_theta'       <- zonkTcTypeToTypes ze prov_theta
+       ; pat_ty'         <- zonkTcTypeToType ze pat_ty
+       ; arg_tys'        <- zonkTcTypeToTypes ze arg_tys
 
        ; let (env1, univ_tvs) = tidyTyVarBinders emptyTidyEnv univ_tvs'
              (env2, ex_tvs)   = tidyTyVarBinders env1 ex_tvs'
@@ -357,14 +360,6 @@ tc_patsyn_finish lname dir is_infix lpat'
 
        ; traceTc "tc_patsyn_finish }" empty
        ; return (matcher_bind, tcg_env) }
-  where
-    -- This is a bit of an odd functions; why does it not occur elsewhere
-    zonk_qtv :: TcTyVarBinder -> TcM (Maybe TcTyVarBinder)
-    zonk_qtv (TvBndr tv vis)
-      = do { mb_tv' <- zonkQuantifiedTyVar False tv
-                    -- ToDo: The False means that we behave here as if
-                    -- -XPolyKinds was always on, which isn't right.
-           ; return (fmap (\tv' -> TvBndr tv' vis) mb_tv') }
 
 {-
 ************************************************************************
index b711ef3..b9bc595 100644 (file)
@@ -368,7 +368,7 @@ kcTyClGroup decls
            ; kvs <- kindGeneralize (mkTyConKind kc_binders kc_res_kind)
            ; let all_binders = mkNamedTyConBinders Inferred kvs ++ kc_binders
 
-           ; (env, all_binders') <- zonkTyConBinders emptyZonkEnv all_binders
+           ; (env, all_binders') <- zonkTyVarBindersX emptyZonkEnv all_binders
            ; kc_res_kind'        <- zonkTcTypeToType env kc_res_kind
 
                       -- Make sure kc_kind' has the final, zonked kind variables
index bbf4712..099502d 100644 (file)
@@ -22,7 +22,7 @@ module TcType (
   -- Types
   TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType,
   TcTyVar, TcTyVarSet, TcDTyVarSet, TcTyCoVarSet, TcDTyCoVarSet,
-  TcKind, TcCoVar, TcTyCoVar, TcTyBinder, TcTyVarBinder, TcTyCon,
+  TcKind, TcCoVar, TcTyCoVar, TcTyVarBinder, TcTyCon,
 
   ExpType(..), InferResult(..), ExpSigmaType, ExpRhoType, mkCheckExpType,
 
@@ -309,7 +309,6 @@ type TcTyCoVar = Var    -- Either a TcTyVar or a CoVar
         -- T is "flattened" before quantifying over a
 
 type TcTyVarBinder = TyVarBinder
-type TcTyBinder    = TyBinder
 type TcTyCon       = TyCon   -- these can be the TcTyCon constructor
 
 -- These types do not have boxy type variables in them