Remove dead quantifyTyVars
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 12 Apr 2017 15:20:13 +0000 (16:20 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Thu, 13 Apr 2017 08:26:42 +0000 (09:26 +0100)
This patch

* removes a function TcMType.quantifyTyVars
  that was never called

* renames quantifyZonkedTyVars to quantifyTyVars

Plus a few comments.  No functional change at all

compiler/typecheck/TcHsType.hs
compiler/typecheck/TcMType.hs
compiler/typecheck/TcRules.hs
compiler/typecheck/TcSimplify.hs
compiler/typecheck/TcTyClsDecls.hs

index 0e3a43c..9b313f0 100644 (file)
@@ -1596,7 +1596,7 @@ kindGeneralize kind_or_type
   = do { kvs <- zonkTcTypeAndFV kind_or_type
        ; let dvs = DV { dv_kvs = kvs, dv_tvs = emptyDVarSet }
        ; gbl_tvs <- tcGetGlobalTyCoVars -- Already zonked
-       ; quantifyZonkedTyVars gbl_tvs dvs }
+       ; quantifyTyVars gbl_tvs dvs }
 
 {-
 Note [Kind generalisation]
index 1a67875..6b517eb 100644 (file)
@@ -74,7 +74,7 @@ module TcMType (
   zonkTyCoVarsAndFVList,
   zonkTcTypeAndSplitDepVars, zonkTcTypesAndSplitDepVars,
   zonkQuantifiedTyVar, defaultTyVar,
-  quantifyTyVars, quantifyZonkedTyVars,
+  quantifyTyVars,
   zonkTcTyCoVarBndr, zonkTcTyVarBinder,
   zonkTcType, zonkTcTypes, zonkCo,
   zonkTyCoVarKind, zonkTcTypeMapper,
@@ -907,24 +907,17 @@ For more information about deterministic sets see
 Note [Deterministic UniqFM] in UniqDFM.
 -}
 
-quantifyTyVars, quantifyZonkedTyVars
-  :: TcTyCoVarSet     -- global tvs
+quantifyTyVars
+  :: TcTyCoVarSet     -- Global tvs; already zonked
   -> CandidatesQTvs   -- See Note [Dependent type variables] in TcType
+                      -- Already zonked
   -> TcM [TcTyVar]
 -- See Note [quantifyTyVars]
 -- Can be given a mixture of TcTyVars and TyVars, in the case of
 --   associated type declarations. Also accepts covars, but *never* returns any.
 
--- The zonked variant assumes everything is already zonked.
-
-quantifyTyVars gbl_tvs (DV { dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs })
-  = do { dep_tkvs    <- zonkTyCoVarsAndFVDSet dep_tkvs
-       ; nondep_tkvs <- zonkTyCoVarsAndFVDSet nondep_tkvs
-       ; gbl_tvs     <- zonkTyCoVarsAndFV gbl_tvs
-       ; quantifyZonkedTyVars gbl_tvs (DV { dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs }) }
-
-quantifyZonkedTyVars gbl_tvs dvs@(DV{ dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs })
-  = do { traceTc "quantifyZonkedTyVars" (vcat [ppr dvs, ppr gbl_tvs])
+quantifyTyVars gbl_tvs dvs@(DV{ dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs })
+  = do { traceTc "quantifyTyVars" (vcat [ppr dvs, ppr gbl_tvs])
        ; let all_cvs = filterVarSet isCoVar $ dVarSetToVarSet dep_tkvs
              dep_kvs = dVarSetElemsWellScoped $
                        dep_tkvs `dVarSetMinusVarSet` gbl_tvs
@@ -960,7 +953,7 @@ quantifyZonkedTyVars gbl_tvs dvs@(DV{ dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs })
            -- mentioned in the kinds of the nondep_tvs'
            -- now refer to the dep_kvs'
 
-       ; traceTc "quantifyZonkedTyVars"
+       ; traceTc "quantifyTyVars"
            (vcat [ text "globals:" <+> ppr gbl_tvs
                  , text "nondep:"  <+> pprTyVars nondep_tvs
                  , text "dep:"     <+> pprTyVars dep_kvs
@@ -969,19 +962,24 @@ quantifyZonkedTyVars gbl_tvs dvs@(DV{ dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs })
 
        ; return (dep_kvs' ++ nondep_tvs') }
   where
+    -- zonk_quant returns a tyvar if it should be quantified over;
+    -- otherwise, it returns Nothing. The latter case happens for
+    --    * Kind variables, with -XNoPolyKinds: don't quantify over these
+    --    * RuntimeRep variables: we never quantify over these
     zonk_quant default_kind tkv
-      | isTcTyVar tkv = zonkQuantifiedTyVar default_kind tkv
-      | otherwise     = return $ Just tkv
-      -- For associated types, we have the class variables
-      -- in scope, and they are TyVars not TcTyVars
-
-zonkQuantifiedTyVar :: Bool     -- True  <=> this is a kind var and -XNoPolyKinds
-                                -- False <=> not a kind var or -XPolyKinds
-                    -> TcTyVar
-                    -> TcM (Maybe TcTyVar)
+      | not (isTcTyVar tkv)
+      = return (Just tkv)  -- For associated types, we have the class variables
+                           -- in scope, and they are TyVars not TcTyVars
+      | otherwise
+      = do { deflt_done <- defaultTyVar default_kind tkv
+           ; case deflt_done of
+               True  -> return Nothing
+               False -> do { tv <- zonkQuantifiedTyVar tkv
+                           ; return (Just tv) } }
+
+zonkQuantifiedTyVar :: TcTyVar -> TcM TcTyVar
 -- The quantified type variables often include meta type variables
--- we want to freeze them into ordinary type variables, and
--- default their kind (e.g. from TYPE v to TYPE Lifted)
+-- we want to freeze them into ordinary type variables
 -- The meta tyvar is updated to point to the new skolem TyVar.  Now any
 -- bound occurrences of the original type variable will get zonked to
 -- the immutable version.
@@ -990,33 +988,26 @@ zonkQuantifiedTyVar :: Bool     -- True  <=> this is a kind var and -XNoPolyKind
 --
 -- This function is called on both kind and type variables,
 -- but kind variables *only* if PolyKinds is on.
---
--- This returns a tyvar if it should be quantified over;
--- otherwise, it returns Nothing. The latter case happens for
---    * Kind variables, with -XNoPolyKinds: don't quantify over these
---    * RuntimeRep variables: we never quantify over these
 
-zonkQuantifiedTyVar default_kind tv
+zonkQuantifiedTyVar tv
   = case tcTyVarDetails tv of
       SkolemTv {} -> do { kind <- zonkTcType (tyVarKind tv)
-                        ; return $ Just (setTyVarKind tv kind) }
+                        ; return (setTyVarKind tv kind) }
         -- It might be a skolem type variable,
         -- for example from a user type signature
 
-      MetaTv {}
-        -> do { mb_tv <- defaultTyVar default_kind tv
-              ; case mb_tv of
-                  True  -> return Nothing
-                  False -> do { tv' <- skolemiseUnboundMetaTyVar tv
-                              ; return (Just tv') } }
+      MetaTv {} -> skolemiseUnboundMetaTyVar tv
 
       _other -> pprPanic "zonkQuantifiedTyVar" (ppr tv) -- FlatSkol, RuntimeUnk
 
 defaultTyVar :: Bool      -- True <=> please default this kind variable to *
-             -> TcTyVar   -- Always an unbound meta tyvar
+             -> TcTyVar   -- If it's a MetaTyVar then it is unbound
              -> TcM Bool  -- True <=> defaulted away altogether
 
 defaultTyVar default_kind tv
+  | not (isMetaTyVar tv)
+  = return False
+
   | isRuntimeRepVar tv && not_sig_tv  -- We never quantify over a RuntimeRep var
   = do { traceTc "Defaulting a RuntimeRep var to LiftedRep" (ppr tv)
        ; writeMetaTyVar tv liftedRepTy
@@ -1301,13 +1292,6 @@ zonkTyCoVarsAndFVList :: [TyCoVar] -> TcM [TyCoVar]
 zonkTyCoVarsAndFVList tycovars =
   tyCoVarsOfTypesList <$> mapM zonkTyCoVar tycovars
 
--- Takes a deterministic set of TyCoVars, zonks them and returns a
--- deterministic set of their free variables.
--- See Note [quantifyTyVars determinism].
-zonkTyCoVarsAndFVDSet :: DTyCoVarSet -> TcM DTyCoVarSet
-zonkTyCoVarsAndFVDSet tycovars =
-  tyCoVarsOfTypesDSet <$> mapM zonkTyCoVar (dVarSetElems tycovars)
-
 zonkTcTyVars :: [TcTyVar] -> TcM [TcType]
 zonkTcTyVars tyvars = mapM zonkTcTyVar tyvars
 
index dd773cf..d80321c 100644 (file)
@@ -106,7 +106,7 @@ tcRule (HsRule name act hs_bndrs lhs fv_lhs rhs fv_rhs)
                         rule_ty : map idType tpl_ids
        ; gbls  <- tcGetGlobalTyCoVars -- Even though top level, there might be top-level
                                       -- monomorphic bindings from the MR; test tc111
-       ; qtkvs <- quantifyZonkedTyVars gbls forall_tkvs
+       ; qtkvs <- quantifyTyVars gbls forall_tkvs
        ; traceTc "tcRule" (vcat [ pprFullRuleName name
                                 , ppr forall_tkvs
                                 , ppr qtkvs
index 934e246..e5f3fe9 100644 (file)
@@ -581,7 +581,7 @@ simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds
   | isEmptyWC wanteds
   = do { gbl_tvs <- tcGetGlobalTyCoVars
        ; dep_vars <- zonkTcTypesAndSplitDepVars (map snd name_taus)
-       ; qtkvs <- quantifyZonkedTyVars gbl_tvs dep_vars
+       ; qtkvs <- quantifyTyVars gbl_tvs dep_vars
        ; traceTc "simplifyInfer: empty WC" (ppr name_taus $$ ppr qtkvs)
        ; return (qtkvs, [], emptyTcEvBinds) }
 
@@ -948,7 +948,7 @@ decideQuantifiedTyVars mono_tvs name_taus psigs candidates
              grown_tvs = growThetaTyVars candidates (tyCoVarsOfTypes seed_tys)
 
        -- Now we have to classify them into kind variables and type variables
-       -- (sigh) just for the benefit of -XNoPolyKinds; see quantifyZonkedTyVars
+       -- (sigh) just for the benefit of -XNoPolyKinds; see quantifyTyVars
        --
        -- Keep the psig_tys first, so that candidateQTyVarsOfTypes produces
        -- them in that order, so that the final qtvs quantifies in the same
@@ -960,7 +960,7 @@ decideQuantifiedTyVars mono_tvs name_taus psigs candidates
              dvs_plus = DV { dv_kvs = pick cand_kvs, dv_tvs = pick cand_tvs }
 
        ; mono_tvs <- TcM.zonkTyCoVarsAndFV mono_tvs
-       ; quantifyZonkedTyVars mono_tvs dvs_plus }
+       ; quantifyTyVars mono_tvs dvs_plus }
 
 ------------------
 growThetaTyVars :: ThetaType -> TyCoVarSet -> TyVarSet
index e0929f4..0010492 100644 (file)
@@ -608,9 +608,15 @@ kcConDecl (ConDeclGADT { con_names = names
                        , con_type = ty })
   = addErrCtxt (dataConCtxtName names) $
       do { _ <- tcGadtSigType (ppr names) (unLoc $ head names) ty
+                -- Even though the data constructor's type is closed, we
+                -- must still call tcGadtSigType, because that influences
+                -- the inferred kind of the /type/ constructor.  Example:
+                --    data T f a where
+                --      MkT :: f a -> T f a
+                -- If we don't look at MkT we won't get the correct kind
+                -- for the type constructor T
          ; return () }
 
-
 {-
 Note [Recursion and promoting data constructors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1296,7 +1302,7 @@ tcFamTyPats fam_shape@(name,_,_,_) mb_clsinfo pats kind_checker thing_inside
             -- replace a meta kind var with (Any *)
             -- Very like kindGeneralize
        ; vars  <- zonkTcTypesAndSplitDepVars typats
-       ; qtkvs <- quantifyZonkedTyVars emptyVarSet vars
+       ; qtkvs <- quantifyTyVars emptyVarSet vars
 
        ; MASSERT( isEmptyVarSet $ coVarsOfTypes typats )
            -- This should be the case, because otherwise the solveEqualities
@@ -1462,10 +1468,17 @@ tcConDecl rep_tycon tmpl_bndrs res_tmpl
                       , con_details = hs_details })
   = addErrCtxt (dataConCtxtName [name]) $
     do { traceTc "tcConDecl 1" (ppr name)
+
+       -- Get hold of the existential type variables
+       -- e.g. data T a = forall (b::k) f. MkT a (f b)
+       -- Here tmpl_bndrs = {a}
+       --          hs_kvs = {k}
+       --          hs_tvs = {f,b}
        ; let (hs_kvs, hs_tvs) = case hs_qvars of
                Nothing -> ([], [])
                Just (HsQTvs { hsq_implicit = kvs, hsq_explicit = tvs })
                        -> (kvs, tvs)
+
        ; (imp_tvs, (exp_tvs, ctxt, arg_tys, field_lbls, stricts))
            <- solveEqualities $
               tcImplicitTKBndrs hs_kvs $
@@ -1479,8 +1492,9 @@ tcConDecl rep_tycon tmpl_bndrs res_tmpl
                                      allBoundVariabless arg_tys
                  ; return ((exp_tvs, ctxt, arg_tys, field_lbls, stricts), bound_vars)
                  }
+
+         -- exp_tvs have explicit, user-written binding sites
          -- imp_tvs are user-written kind variables, without an explicit binding site
-         -- exp_tvs have binding sites
          -- the kvs below are those kind variables entirely unmentioned by the user
          --   and discovered only by generalization
 
@@ -1497,7 +1511,7 @@ tcConDecl rep_tycon tmpl_bndrs res_tmpl
                  -- we're doing this to get the right behavior around removing
                  -- any vars bound in exp_binders.
 
-       ; kvs <- quantifyZonkedTyVars (mkVarSet (binderVars tmpl_bndrs)) vars
+       ; kvs <- quantifyTyVars (mkVarSet (binderVars tmpl_bndrs)) vars
 
              -- Zonk to Types
        ; (ze, qkvs)      <- zonkTyBndrsX emptyZonkEnv kvs
@@ -1541,7 +1555,7 @@ tcConDecl rep_tycon tmpl_bndrs res_tmpl
                                             mkFunTys ctxt $
                                             mkFunTys arg_tys $
                                             res_ty)
-       ; tkvs <- quantifyZonkedTyVars emptyVarSet vars
+       ; tkvs <- quantifyTyVars emptyVarSet vars
 
              -- Zonk to Types
        ; (ze, qtkvs) <- zonkTyBndrsX emptyZonkEnv (tkvs ++ user_tvs)