diff options
Diffstat (limited to 'compiler/GHC/Rename/Module.hs')
| -rw-r--r-- | compiler/GHC/Rename/Module.hs | 129 |
1 files changed, 73 insertions, 56 deletions
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs index 5e9d4dec64..7274525f39 100644 --- a/compiler/GHC/Rename/Module.hs +++ b/compiler/GHC/Rename/Module.hs @@ -664,7 +664,7 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds rnFamInstEqn :: HsDocContext -> AssocTyFamInfo - -> [Located RdrName] + -> FreeKiTyVars -- ^ Kind variables from the equation's RHS to be implicitly bound -- if no explicit forall. -> FamInstEqn GhcPs rhs @@ -676,16 +676,7 @@ rnFamInstEqn doc atfi rhs_kvars , feqn_pats = pats , feqn_fixity = fixity , feqn_rhs = payload }}) rn_payload - = do { let mb_cls = case atfi of - NonAssocTyFamEqn -> Nothing - AssocTyFamDeflt cls -> Just cls - AssocTyFamInst cls _ -> Just cls - ; tycon' <- lookupFamInstName mb_cls tycon - ; let pat_kity_vars_with_dups = extractHsTyArgRdrKiTyVarsDup pats - -- Use the "...Dups" form because it's needed - -- below to report unused binder on the LHS - - ; let bndrs = fromMaybe [] mb_bndrs + = do { tycon' <- lookupFamInstName mb_cls tycon -- all_imp_vars represent the implicitly bound type variables. This is -- empty if we have an explicit `forall` (see @@ -713,48 +704,45 @@ rnFamInstEqn doc atfi rhs_kvars -- No need to filter out explicit binders (the 'mb_bndrs = Just -- explicit_bndrs' case) because there must be none if we're going -- to implicitly bind anything, per the previous comment. - nubL $ pat_kity_vars_with_dups ++ rhs_kvars - ; all_imp_var_names <- mapM (newTyVarNameRn mb_cls) all_imp_vars - - -- All the free vars of the family patterns - -- with a sensible binding location - ; ((bndrs', pats', payload'), fvs) - <- bindLocalNamesFV all_imp_var_names $ - bindLHsTyVarBndrs doc WarnUnusedForalls - Nothing bndrs $ \bndrs' -> - -- Note: If we pass mb_cls instead of Nothing here, - -- bindLHsTyVarBndrs will use class variables for any names - -- the user meant to bring in scope here. This is an explicit - -- forall, so we want fresh names, not class variables. - -- Thus: always pass Nothing - do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats - ; (payload', rhs_fvs) <- rn_payload doc payload - - -- Report unused binders on the LHS - -- See Note [Unused type variables in family instances] - ; let groups :: [NonEmpty (Located RdrName)] - groups = equivClasses cmpLocated $ - pat_kity_vars_with_dups - ; nms_dups <- mapM (lookupOccRn . unLoc) $ - [ tv | (tv :| (_:_)) <- groups ] - -- Add to the used variables - -- a) any variables that appear *more than once* on the LHS - -- e.g. F a Int a = Bool - -- b) for associated instances, the variables - -- of the instance decl. See - -- Note [Unused type variables in family instances] - ; let nms_used = extendNameSetList rhs_fvs $ - inst_tvs ++ nms_dups - inst_tvs = case atfi of - NonAssocTyFamEqn -> [] - AssocTyFamDeflt _ -> [] - AssocTyFamInst _ inst_tvs -> inst_tvs - all_nms = all_imp_var_names ++ hsLTyVarNames bndrs' - ; warnUnusedTypePatterns all_nms nms_used - - ; return ((bndrs', pats', payload'), rhs_fvs `plusFV` pat_fvs) } - - ; let all_fvs = fvs `addOneFV` unLoc tycon' + pat_kity_vars_with_dups ++ rhs_kvars + + ; rnImplicitBndrs mb_cls all_imp_vars $ \all_imp_var_names' -> + bindLHsTyVarBndrs doc WarnUnusedForalls + Nothing (fromMaybe [] mb_bndrs) $ \bndrs' -> + -- Note: If we pass mb_cls instead of Nothing here, + -- bindLHsTyVarBndrs will use class variables for any names + -- the user meant to bring in scope here. This is an explicit + -- forall, so we want fresh names, not class variables. + -- Thus: always pass Nothing + do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats + ; (payload', rhs_fvs) <- rn_payload doc payload + + -- Report unused binders on the LHS + -- See Note [Unused type variables in family instances] + ; let -- The SrcSpan that rnImplicitBndrs will attach to each Name will + -- span the entire type family instance, which will be reflected in + -- -Wunused-type-patterns warnings. We can be a little more precise + -- than that by pointing to the LHS of the instance instead, which + -- is what lhs_loc corresponds to. + all_imp_var_names = map (`setNameLoc` lhs_loc) all_imp_var_names' + + groups :: [NonEmpty (Located RdrName)] + groups = equivClasses cmpLocated $ + pat_kity_vars_with_dups + ; nms_dups <- mapM (lookupOccRn . unLoc) $ + [ tv | (tv :| (_:_)) <- groups ] + -- Add to the used variables + -- a) any variables that appear *more than once* on the LHS + -- e.g. F a Int a = Bool + -- b) for associated instances, the variables + -- of the instance decl. See + -- Note [Unused type variables in family instances] + ; let nms_used = extendNameSetList rhs_fvs $ + inst_tvs ++ nms_dups + all_nms = all_imp_var_names ++ hsLTyVarNames bndrs' + ; warnUnusedTypePatterns all_nms nms_used + + ; let all_fvs = (rhs_fvs `plusFV` pat_fvs) `addOneFV` unLoc tycon' -- type instance => use, hence addOneFV ; return (HsIB { hsib_ext = all_imp_var_names -- Note [Wildcards in family instances] @@ -765,7 +753,36 @@ rnFamInstEqn doc atfi rhs_kvars , feqn_pats = pats' , feqn_fixity = fixity , feqn_rhs = payload' } }, - all_fvs) } + all_fvs) } } + where + -- The parent class, if we are dealing with an associated type family + -- instance. + mb_cls = case atfi of + NonAssocTyFamEqn -> Nothing + AssocTyFamDeflt cls -> Just cls + AssocTyFamInst cls _ -> Just cls + + -- The type variables from the instance head, if we are dealing with an + -- associated type family instance. + inst_tvs = case atfi of + NonAssocTyFamEqn -> [] + AssocTyFamDeflt _ -> [] + AssocTyFamInst _ inst_tvs -> inst_tvs + + pat_kity_vars_with_dups = extractHsTyArgRdrKiTyVars pats + -- It is crucial that extractHsTyArgRdrKiTyVars return + -- duplicate occurrences, since they're needed to help + -- determine unused binders on the LHS. + + -- The SrcSpan of the LHS of the instance. For example, lhs_loc would be + -- the highlighted part in the example below: + -- + -- type instance F a b c = Either a b + -- ^^^^^ + lhs_loc = case map lhsTypeArgSrcSpan pats ++ map getLoc rhs_kvars of + [] -> panic "rnFamInstEqn.lhs_loc" + [loc] -> loc + (loc:locs) -> loc `combineSrcSpans` last locs rnTyFamInstDecl :: AssocTyFamInfo -> TyFamInstDecl GhcPs @@ -2115,11 +2132,11 @@ rnConDecl decl@(ConDeclGADT { con_names = names -- See #14808. ; implicit_bndrs <- forAllOrNothing explicit_forall $ extractHsTvBndrs explicit_tkvs - $ extractHsTysRdrTyVarsDups (theta ++ arg_tys ++ [res_ty]) + $ extractHsTysRdrTyVars (theta ++ arg_tys ++ [res_ty]) ; let ctxt = ConDeclCtx new_names - ; rnImplicitBndrs implicit_bndrs $ \ implicit_tkvs -> + ; rnImplicitBndrs Nothing implicit_bndrs $ \ implicit_tkvs -> bindLHsTyVarBndrs ctxt WarnUnusedForalls Nothing explicit_tkvs $ \ explicit_tkvs -> do { (new_cxt, fvs1) <- rnMbContext ctxt mcxt |