diff options
20 files changed, 230 insertions, 194 deletions
diff --git a/compiler/GHC/Data/List/SetOps.hs b/compiler/GHC/Data/List/SetOps.hs index 2d916e9dd5..15b370582c 100644 --- a/compiler/GHC/Data/List/SetOps.hs +++ b/compiler/GHC/Data/List/SetOps.hs @@ -10,7 +10,7 @@ -- -- Avoid using them as much as possible module GHC.Data.List.SetOps ( - unionLists, minusList, deleteBys, + unionLists, minusList, -- Association lists Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, @@ -39,11 +39,6 @@ getNth :: Outputable a => [a] -> Int -> a getNth xs n = ASSERT2( xs `lengthExceeds` n, ppr n $$ ppr xs ) xs !! n -deleteBys :: (a -> a -> Bool) -> [a] -> [a] -> [a] --- (deleteBys eq xs ys) returns xs-ys, using the given equality function --- Just like 'Data.List.delete' but with an equality function -deleteBys eq xs ys = foldl' (flip (L.deleteBy eq)) xs ys - {- ************************************************************************ * * diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs index ef935cc59f..9d08a370c9 100644 --- a/compiler/GHC/Hs/Type.hs +++ b/compiler/GHC/Hs/Type.hs @@ -30,7 +30,7 @@ module GHC.Hs.Type ( HsTyLit(..), HsIPName(..), hsIPNameFS, HsArg(..), numVisibleArgs, - LHsTypeArg, + LHsTypeArg, lhsTypeArgSrcSpan, OutputableBndrFlag, LBangType, BangType, @@ -1289,6 +1289,13 @@ numVisibleArgs = count is_vis -- type level equivalent type LHsTypeArg p = HsArg (LHsType p) (LHsKind p) +-- | Compute the 'SrcSpan' associated with an 'LHsTypeArg'. +lhsTypeArgSrcSpan :: LHsTypeArg pass -> SrcSpan +lhsTypeArgSrcSpan arg = case arg of + HsValArg tm -> getLoc tm + HsTypeArg at ty -> at `combineSrcSpans` getLoc ty + HsArgPar sp -> sp + instance (Outputable tm, Outputable ty) => Outputable (HsArg tm ty) where ppr (HsValArg tm) = ppr tm ppr (HsTypeArg _ ty) = char '@' <> ppr ty diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs index 18f2c9071e..a13b15fe5d 100644 --- a/compiler/GHC/Rename/HsType.hs +++ b/compiler/GHC/Rename/HsType.hs @@ -24,11 +24,11 @@ module GHC.Rename.HsType ( -- Binding related stuff bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..), - rnImplicitBndrs, bindSigTyVarsFV, bindHsQTyVars, bindLRdrNames, + rnImplicitBndrs, bindSigTyVarsFV, bindHsQTyVars, + FreeKiTyVars, extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars, - extractHsTysRdrTyVarsDups, - extractRdrKindSigVars, extractDataDefnKindVars, - extractHsTvBndrs, extractHsTyArgRdrKiTyVarsDup, + extractHsTysRdrTyVars, extractRdrKindSigVars, extractDataDefnKindVars, + extractHsTvBndrs, extractHsTyArgRdrKiTyVars, forAllOrNothing, nubL ) where @@ -57,7 +57,6 @@ import GHC.Types.Name.Set import GHC.Types.FieldLabel import GHC.Utils.Misc -import GHC.Data.List.SetOps ( deleteBys ) import GHC.Types.Basic ( compareFixity, funTyFixity, negateFixity , Fixity(..), FixityDirection(..), LexicalFixity(..) , TypeOrKind(..) ) @@ -165,14 +164,14 @@ rn_hs_sig_wc_type :: HsSigWcTypeScoping -> HsDocContext -> Maybe SDoc -> RnM (a, FreeVars) rn_hs_sig_wc_type scoping ctxt inf_err hs_ty thing_inside = do { check_inferred_vars ctxt inf_err hs_ty - ; free_vars <- filterInScopeM (extractHsTyRdrTyVarsDups hs_ty) + ; free_vars <- filterInScopeM (extractHsTyRdrTyVars hs_ty) ; (nwc_rdrs', tv_rdrs) <- partition_nwcs free_vars ; let nwc_rdrs = nubL nwc_rdrs' ; implicit_bndrs <- case scoping of AlwaysBind -> pure tv_rdrs BindUnlessForall -> forAllOrNothing (isLHsForAllTy hs_ty) tv_rdrs NeverBind -> pure [] - ; rnImplicitBndrs implicit_bndrs $ \ vars -> + ; rnImplicitBndrs Nothing implicit_bndrs $ \ vars -> do { (wcs, hs_ty', fvs1) <- rnWcBody ctxt nwc_rdrs hs_ty ; (res, fvs2) <- thing_inside wcs vars hs_ty' ; return (res, fvs1 `plusFV` fvs2) } } @@ -180,7 +179,8 @@ rn_hs_sig_wc_type scoping ctxt inf_err hs_ty thing_inside rnHsWcType :: HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeVars) rnHsWcType ctxt (HsWC { hswc_body = hs_ty }) = do { free_vars <- filterInScopeM (extractHsTyRdrTyVars hs_ty) - ; (nwc_rdrs, _) <- partition_nwcs free_vars + ; (nwc_rdrs', _) <- partition_nwcs free_vars + ; let nwc_rdrs = nubL nwc_rdrs' ; (wcs, hs_ty', fvs) <- rnWcBody ctxt nwc_rdrs hs_ty ; let sig_ty' = HsWC { hswc_ext = wcs, hswc_body = hs_ty' } ; return (sig_ty', fvs) } @@ -330,8 +330,8 @@ rnHsSigType ctx level inf_err (HsIB { hsib_body = hs_ty }) ; check_inferred_vars ctx inf_err hs_ty ; vars0 <- forAllOrNothing (isLHsForAllTy hs_ty) $ filterInScope rdr_env - $ extractHsTyRdrTyVarsDups hs_ty - ; rnImplicitBndrs vars0 $ \ vars -> + $ extractHsTyRdrTyVars hs_ty + ; rnImplicitBndrs Nothing vars0 $ \ vars -> do { (body', fvs) <- rnLHsTyKi (mkTyKiEnv ctx level RnTypeBody) hs_ty ; return ( HsIB { hsib_ext = vars @@ -359,9 +359,9 @@ forAllOrNothing :: Bool -- we do not want to bring 'b' into scope, hence True -- But f :: a -> b -- we want to bring both 'a' and 'b' into scope, hence False - -> FreeKiTyVarsWithDups + -> FreeKiTyVars -- ^ Free vars of the type - -> RnM FreeKiTyVarsWithDups + -> RnM FreeKiTyVars forAllOrNothing has_outer_forall fvs = case has_outer_forall of True -> do traceRn "forAllOrNothing" $ text "has explicit outer forall" @@ -370,24 +370,50 @@ forAllOrNothing has_outer_forall fvs = case has_outer_forall of traceRn "forAllOrNothing" $ text "no explicit forall. implicit binders:" <+> ppr fvs pure fvs -rnImplicitBndrs :: FreeKiTyVarsWithDups +rnImplicitBndrs :: Maybe assoc + -- ^ @'Just' _@ => an associated type decl + -> FreeKiTyVars -- ^ Surface-syntax free vars that we will implicitly bind. - -- May have duplicates, which is checked here + -- May have duplicates, which are removed here. -> ([Name] -> RnM (a, FreeVars)) -> RnM (a, FreeVars) -rnImplicitBndrs implicit_vs_with_dups - thing_inside +rnImplicitBndrs mb_assoc implicit_vs_with_dups thing_inside = do { let implicit_vs = nubL implicit_vs_with_dups ; traceRn "rnImplicitBndrs" $ vcat [ ppr implicit_vs_with_dups, ppr implicit_vs ] + -- Use the currently set SrcSpan as the new source location for each Name. + -- See Note [Source locations for implicitly bound type variables]. ; loc <- getSrcSpanM - ; vars <- mapM (newLocalBndrRn . L loc . unLoc) implicit_vs + ; vars <- mapM (newTyVarNameRn mb_assoc . L loc . unLoc) implicit_vs ; bindLocalNamesFV vars $ thing_inside vars } +{- +Note [Source locations for implicitly bound type variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When bringing implicitly bound type variables into scope (in rnImplicitBndrs), +we do something peculiar: we drop the original SrcSpan attached to each +variable and replace it with the currently set SrcSpan. Moreover, this new +SrcSpan is usually /less/ precise than the original one, and that's OK. To see +why this is done, consider the following example: + + f :: a -> b -> a + +Suppose that a warning or error message needs to point to the SrcSpans of the +binding sites for `a` and `b`. But where /are/ they bound, anyway? Technically, +they're bound by an unwritten `forall` at the front of the type signature, but +there is no SrcSpan for that. We could point to the first occurrence of `a` as +the binding site for `a`, but that would make the first occurrence of `a` +special. Moreover, we don't want IDEs to confuse binding sites and occurrences. + +As a result, we make the `SrcSpan`s for `a` and `b` span the entirety of the +type signature, since the type signature implicitly carries their binding +sites. This is less precise, but more accurate. +-} + check_inferred_vars :: HsDocContext -> Maybe SDoc -- ^ The error msg if the signature is not allowed to contain @@ -833,22 +859,11 @@ bindSigTyVarsFV tvs thing_inside else bindLocalNamesFV tvs thing_inside } --- | Simply bring a bunch of RdrNames into scope. No checking for --- validity, at all. The binding location is taken from the location --- on each name. -bindLRdrNames :: [Located RdrName] - -> ([Name] -> RnM (a, FreeVars)) - -> RnM (a, FreeVars) -bindLRdrNames rdrs thing_inside - = do { var_names <- mapM (newTyVarNameRn Nothing) rdrs - ; bindLocalNamesFV var_names $ - thing_inside var_names } - --------------- bindHsQTyVars :: forall a b. HsDocContext -> Maybe a -- Just _ => an associated type decl - -> [Located RdrName] -- Kind variables from scope, no dups + -> FreeKiTyVars -- Kind variables from scope -> LHsQTyVars GhcPs -> (LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars)) -- The Bool is True <=> all kind variables used in the @@ -864,17 +879,16 @@ bindHsQTyVars :: forall a b. -- (b) Bring type variables into scope -- bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside - = do { let hs_tv_bndrs = hsQTvExplicit hsq_bndrs - bndr_kv_occs = extractHsTyVarBndrsKVs hs_tv_bndrs + = do { let bndr_kv_occs = extractHsTyVarBndrsKVs hs_tv_bndrs ; let -- See Note [bindHsQTyVars examples] for what -- all these various things are doing bndrs, implicit_kvs :: [Located RdrName] bndrs = map hsLTyVarLocName hs_tv_bndrs - implicit_kvs = nubL $ filterFreeVarsToBind bndrs $ + implicit_kvs = filterFreeVarsToBind bndrs $ bndr_kv_occs ++ body_kv_occs - del = deleteBys eqLocated - body_remaining = (body_kv_occs `del` bndrs) `del` bndr_kv_occs + body_remaining = filterFreeVarsToBind bndr_kv_occs $ + filterFreeVarsToBind bndrs body_kv_occs all_bound_on_lhs = null body_remaining ; traceRn "checkMixedVars3" $ @@ -885,17 +899,35 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside , text "body_remaining" <+> ppr body_remaining ] - ; implicit_kv_nms <- mapM (newTyVarNameRn mb_assoc) implicit_kvs - - ; bindLocalNamesFV implicit_kv_nms $ + ; rnImplicitBndrs mb_assoc implicit_kvs $ \ implicit_kv_nms' -> bindLHsTyVarBndrs doc NoWarnUnusedForalls mb_assoc hs_tv_bndrs $ \ rn_bndrs -> -- This is the only call site for bindLHsTyVarBndrs where we pass -- NoWarnUnusedForalls, which suppresses -Wunused-foralls warnings. -- See Note [Suppress -Wunused-foralls when binding LHsQTyVars]. - do { traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs) + do { let -- The SrcSpan that rnImplicitBndrs will attach to each Name will + -- span the entire declaration to which the LHsQTyVars belongs, + -- which will be reflected in warning and error messages. We can + -- be a little more precise than that by pointing to the location + -- of the LHsQTyVars instead, which is what bndrs_loc + -- corresponds to. + implicit_kv_nms = map (`setNameLoc` bndrs_loc) implicit_kv_nms' + + ; traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs) ; thing_inside (HsQTvs { hsq_ext = implicit_kv_nms , hsq_explicit = rn_bndrs }) all_bound_on_lhs } } + where + hs_tv_bndrs = hsQTvExplicit hsq_bndrs + + -- The SrcSpan of the LHsQTyVars. For example, bndrs_loc would be the + -- highlighted part in the class below: + -- + -- class C (a :: j) (b :: k) where + -- ^^^^^^^^^^^^^^^ + bndrs_loc = case map getLoc hs_tv_bndrs ++ map getLoc body_kv_occs of + [] -> panic "bindHsQTyVars.bndrs_loc" + [loc] -> loc + (loc:locs) -> loc `combineSrcSpans` last locs {- Note [bindHsQTyVars examples] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -912,12 +944,12 @@ Then: body_kv_occs = [k2,k1], kind variables free in the result kind signature - implicit_kvs = [k1,k2], kind variables free in kind signatures - of hs_tv_bndrs, and not bound by bndrs + implicit_kvs = [k1,k2,k1], kind variables free in kind signatures + of hs_tv_bndrs, and not bound by bndrs * We want to quantify add implicit bindings for implicit_kvs -* If implicit_body_kvs is non-empty, then there is a kind variable +* If body_kv_occs is non-empty, then there is a kind variable mentioned in the kind signature that is not bound "on the left". That's one of the rules for a CUSK, so we pass that info on as the second argument to thing_inside. @@ -925,6 +957,9 @@ Then: * Order is not important in these lists. All we are doing is bring Names into scope. +* bndr_kv_occs, body_kv_occs, and implicit_kvs can contain duplicates. All + duplicate occurrences are removed when we bind them with rnImplicitBndrs. + Finally, you may wonder why filterFreeVarsToBind removes in-scope variables from bndr/body_kv_occs. How can anything be in scope? Answer: HsQTyVars is /also/ used (slightly oddly) for Haskell-98 syntax @@ -1076,14 +1111,15 @@ bindLHsTyVarBndr doc mb_assoc (L loc (KindedTyVar x fl lrdr@(L lv _) kind)) $ thing_inside (L loc (KindedTyVar x fl (L lv tv_nm) kind')) ; return (b, fvs1 `plusFV` fvs2) } -newTyVarNameRn :: Maybe a -> Located RdrName -> RnM Name -newTyVarNameRn mb_assoc (L loc rdr) +newTyVarNameRn :: Maybe a -- associated class + -> Located RdrName -> RnM Name +newTyVarNameRn mb_assoc lrdr@(L _ rdr) = do { rdr_env <- getLocalRdrEnv ; case (mb_assoc, lookupLocalRdrEnv rdr_env rdr) of (Just _, Just n) -> return n -- Use the same Name as the parent class decl - _ -> newLocalBndrRn (L loc rdr) } + _ -> newLocalBndrRn lrdr } {- ********************************************************* * * @@ -1538,7 +1574,10 @@ To do that, we need to walk over a type and find its free type/kind variables. We preserve the left-to-right order of each variable occurrence. See Note [Ordering of implicit variables]. -Clients of this code can remove duplicates with nubL. +It is common for lists of free type variables to contain duplicates. For +example, in `f :: a -> a`, the free type variable list is [a, a]. When these +implicitly bound variables are brought into scope (with rnImplicitBndrs), +duplicates are removed with nubL. Note [Ordering of implicit variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1567,9 +1606,8 @@ the a in the code. Thus, GHC does ScopedSort on the variables. See Note [ScopedSort] in GHC.Core.Type. Implicitly bound variables are collected by any function which returns a -FreeKiTyVars, FreeKiTyVarsWithDups, or FreeKiTyVarsNoDups, which notably -includes the `extract-` family of functions (extractHsTysRdrTyVarsDups, -extractHsTyVarBndrsKVs, etc.). +FreeKiTyVars, which notably includes the `extract-` family of functions +(extractHsTysRdrTyVars, extractHsTyVarBndrsKVs, etc.). These functions thus promise to keep left-to-right ordering. Note [Implicit quantification in type synonyms] @@ -1655,18 +1693,13 @@ type checking. While viable, this would mean we'd end up accepting this: -} +-- A list of free type/kind variables, which can contain duplicates. -- See Note [Kind and type-variable binders] -- These lists are guaranteed to preserve left-to-right ordering of -- the types the variables were extracted from. See also -- Note [Ordering of implicit variables]. type FreeKiTyVars = [Located RdrName] --- | A 'FreeKiTyVars' list that is allowed to have duplicate variables. -type FreeKiTyVarsWithDups = FreeKiTyVars - --- | A 'FreeKiTyVars' list that contains no duplicate variables. -type FreeKiTyVarsNoDups = FreeKiTyVars - -- | Filter out any type and kind variables that are already in scope in the -- the supplied LocalRdrEnv. Note that this includes named wildcards, which -- look like perfectly ordinary type variables at this point. @@ -1684,46 +1717,32 @@ filterInScopeM vars inScope :: LocalRdrEnv -> RdrName -> Bool inScope rdr_env rdr = rdr `elemLocalRdrEnv` rdr_env -extract_tyarg :: LHsTypeArg GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups +extract_tyarg :: LHsTypeArg GhcPs -> FreeKiTyVars -> FreeKiTyVars extract_tyarg (HsValArg ty) acc = extract_lty ty acc extract_tyarg (HsTypeArg _ ki) acc = extract_lty ki acc extract_tyarg (HsArgPar _) acc = acc -extract_tyargs :: [LHsTypeArg GhcPs] -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups +extract_tyargs :: [LHsTypeArg GhcPs] -> FreeKiTyVars -> FreeKiTyVars extract_tyargs args acc = foldr extract_tyarg acc args -extractHsTyArgRdrKiTyVarsDup :: [LHsTypeArg GhcPs] -> FreeKiTyVarsWithDups -extractHsTyArgRdrKiTyVarsDup args +extractHsTyArgRdrKiTyVars :: [LHsTypeArg GhcPs] -> FreeKiTyVars +extractHsTyArgRdrKiTyVars args = extract_tyargs args [] -- | 'extractHsTyRdrTyVars' finds the type/kind variables -- of a HsType/HsKind. -- It's used when making the @forall@s explicit. --- When the same name occurs multiple times in the types, only the first --- occurrence is returned. -- See Note [Kind and type-variable binders] -extractHsTyRdrTyVars :: LHsType GhcPs -> FreeKiTyVarsNoDups -extractHsTyRdrTyVars ty - = nubL (extractHsTyRdrTyVarsDups ty) - --- | 'extractHsTyRdrTyVarsDups' finds the type/kind variables --- of a HsType/HsKind. --- It's used when making the @forall@s explicit. --- When the same name occurs multiple times in the types, all occurrences --- are returned. -extractHsTyRdrTyVarsDups :: LHsType GhcPs -> FreeKiTyVarsWithDups -extractHsTyRdrTyVarsDups ty - = extract_lty ty [] +extractHsTyRdrTyVars :: LHsType GhcPs -> FreeKiTyVars +extractHsTyRdrTyVars ty = extract_lty ty [] -- | Extracts the free type/kind variables from the kind signature of a HsType. -- This is used to implicitly quantify over @k@ in @type T = Nothing :: Maybe k@. --- When the same name occurs multiple times in the type, only the first --- occurrence is returned, and the left-to-right order of variables is --- preserved. +-- The left-to-right order of variables is preserved. -- See Note [Kind and type-variable binders] and -- Note [Ordering of implicit variables] and -- Note [Implicit quantification in type synonyms]. -extractHsTyRdrTyVarsKindVars :: LHsType GhcPs -> FreeKiTyVarsNoDups +extractHsTyRdrTyVarsKindVars :: LHsType GhcPs -> FreeKiTyVars extractHsTyRdrTyVarsKindVars (L _ ty) = case ty of HsParTy _ ty -> extractHsTyRdrTyVarsKindVars ty @@ -1733,51 +1752,45 @@ extractHsTyRdrTyVarsKindVars (L _ ty) = -- | Extracts free type and kind variables from types in a list. -- When the same name occurs multiple times in the types, all occurrences -- are returned. -extractHsTysRdrTyVarsDups :: [LHsType GhcPs] -> FreeKiTyVarsWithDups -extractHsTysRdrTyVarsDups tys - = extract_ltys tys [] +extractHsTysRdrTyVars :: [LHsType GhcPs] -> FreeKiTyVars +extractHsTysRdrTyVars tys = extract_ltys tys [] -- Returns the free kind variables of any explicitly-kinded binders, returning -- variable occurrences in left-to-right order. -- See Note [Ordering of implicit variables]. -- NB: Does /not/ delete the binders themselves. --- However duplicates are removed -- E.g. given [k1, a:k1, b:k2] -- the function returns [k1,k2], even though k1 is bound here -extractHsTyVarBndrsKVs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVarsNoDups -extractHsTyVarBndrsKVs tv_bndrs - = nubL (extract_hs_tv_bndrs_kvs tv_bndrs) +extractHsTyVarBndrsKVs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars +extractHsTyVarBndrsKVs tv_bndrs = extract_hs_tv_bndrs_kvs tv_bndrs -- Returns the free kind variables in a type family result signature, returning -- variable occurrences in left-to-right order. -- See Note [Ordering of implicit variables]. -extractRdrKindSigVars :: LFamilyResultSig GhcPs -> [Located RdrName] +extractRdrKindSigVars :: LFamilyResultSig GhcPs -> FreeKiTyVars extractRdrKindSigVars (L _ resultSig) = case resultSig of KindSig _ k -> extractHsTyRdrTyVars k TyVarSig _ (L _ (KindedTyVar _ _ _ k)) -> extractHsTyRdrTyVars k _ -> [] -- | Get type/kind variables mentioned in the kind signature, preserving --- left-to-right order and without duplicates: +-- left-to-right order: -- -- * data T a (b :: k1) :: k2 -> k1 -> k2 -> Type -- result: [k2,k1] -- * data T a (b :: k1) -- result: [] -- -- See Note [Ordering of implicit variables]. -extractDataDefnKindVars :: HsDataDefn GhcPs -> FreeKiTyVarsNoDups +extractDataDefnKindVars :: HsDataDefn GhcPs -> FreeKiTyVars extractDataDefnKindVars (HsDataDefn { dd_kindSig = ksig }) = maybe [] extractHsTyRdrTyVars ksig -extract_lctxt :: LHsContext GhcPs - -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups +extract_lctxt :: LHsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars extract_lctxt ctxt = extract_ltys (unLoc ctxt) -extract_ltys :: [LHsType GhcPs] - -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups +extract_ltys :: [LHsType GhcPs] -> FreeKiTyVars -> FreeKiTyVars extract_ltys tys acc = foldr extract_lty acc tys -extract_lty :: LHsType GhcPs - -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups +extract_lty :: LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars extract_lty (L _ ty) acc = case ty of HsTyVar _ _ ltv -> extract_tv ltv acc @@ -1818,15 +1831,15 @@ extract_lty (L _ ty) acc HsWildCardTy {} -> acc extractHsTvBndrs :: [LHsTyVarBndr flag GhcPs] - -> FreeKiTyVarsWithDups -- Free in body - -> FreeKiTyVarsWithDups -- Free in result + -> FreeKiTyVars -- Free in body + -> FreeKiTyVars -- Free in result extractHsTvBndrs tv_bndrs body_fvs = extract_hs_tv_bndrs tv_bndrs [] body_fvs extract_hs_tv_bndrs :: [LHsTyVarBndr flag GhcPs] - -> FreeKiTyVarsWithDups -- Accumulator - -> FreeKiTyVarsWithDups -- Free in body - -> FreeKiTyVarsWithDups + -> FreeKiTyVars -- Accumulator + -> FreeKiTyVars -- Free in body + -> FreeKiTyVars -- In (forall (a :: Maybe e). a -> b) we have -- 'a' is bound by the forall -- 'b' is a free type variable @@ -1841,24 +1854,28 @@ extract_hs_tv_bndrs tv_bndrs acc_vars body_vars = new_vars ++ acc_vars bndr_vars = extract_hs_tv_bndrs_kvs tv_bndrs tv_bndr_rdrs = map hsLTyVarLocName tv_bndrs -extract_hs_tv_bndrs_kvs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVarsWithDups +extract_hs_tv_bndrs_kvs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars -- Returns the free kind variables of any explicitly-kinded binders, returning -- variable occurrences in left-to-right order. -- See Note [Ordering of implicit variables]. -- NB: Does /not/ delete the binders themselves. --- Duplicates are /not/ removed -- E.g. given [k1, a:k1, b:k2] -- the function returns [k1,k2], even though k1 is bound here extract_hs_tv_bndrs_kvs tv_bndrs = foldr extract_lty [] [k | L _ (KindedTyVar _ _ _ k) <- tv_bndrs] -extract_tv :: Located RdrName - -> [Located RdrName] -> [Located RdrName] +extract_tv :: Located RdrName -> FreeKiTyVars -> FreeKiTyVars extract_tv tv acc = if isRdrTyVar (unLoc tv) then tv:acc else acc --- Deletes duplicates in a list of Located things. +-- Deletes duplicates in a list of Located things. This is used to: +-- +-- * Delete duplicate occurrences of implicitly bound type/kind variables when +-- bringing them into scope (in rnImplicitBndrs). +-- +-- * Delete duplicate occurrences of named wildcards (in rn_hs_sig_wc_type and +-- rnHsWcType). -- -- Importantly, this function is stable with respect to the original ordering -- of things in the list. This is important, as it is a property that GHC @@ -1872,9 +1889,9 @@ nubL = nubBy eqLocated -- already in scope, or are explicitly bound in the binder. filterFreeVarsToBind :: FreeKiTyVars -- ^ Explicitly bound here - -> FreeKiTyVarsWithDups + -> FreeKiTyVars -- ^ Potential implicit binders - -> FreeKiTyVarsWithDups + -> FreeKiTyVars -- ^ Final implicit binders filterFreeVarsToBind bndrs = filterOut is_in_scope -- Make sure to list the binder kvs before the body kvs, as mandated by diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs index 0a355b01ee..deee12a726 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 @@ -2116,11 +2133,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 diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs index f1233c55ed..3a4d0de24f 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs +++ b/compiler/GHC/Tc/Gen/Splice.hs @@ -1431,7 +1431,7 @@ reifyInstances th_nm th_tys -- must error before proceeding to typecheck the -- renamed type, as that will result in GHC -- internal errors (#13837). - bindLRdrNames tv_rdrs $ \ tv_names -> + rnImplicitBndrs Nothing tv_rdrs $ \ tv_names -> do { (rn_ty, fvs) <- rnLHsType doc rdr_ty ; return ((tv_names, rn_ty), fvs) } ; (_tvs, ty) diff --git a/testsuite/tests/indexed-types/should_compile/ExplicitForAllFams2.stderr b/testsuite/tests/indexed-types/should_compile/ExplicitForAllFams2.stderr index 0d2eaae027..a8aece69eb 100644 --- a/testsuite/tests/indexed-types/should_compile/ExplicitForAllFams2.stderr +++ b/testsuite/tests/indexed-types/should_compile/ExplicitForAllFams2.stderr @@ -5,7 +5,7 @@ ExplicitForAllFams2.hs:34:10: warning: [-Wunused-type-patterns] ExplicitForAllFams2.hs:35:10: warning: [-Wunused-type-patterns] Defined but not used on the right hand side: type variable ‘a’ -ExplicitForAllFams2.hs:38:7: warning: [-Wunused-type-patterns] +ExplicitForAllFams2.hs:38:6: warning: [-Wunused-type-patterns] Defined but not used on the right hand side: type variable ‘t’ ExplicitForAllFams2.hs:39:6: warning: [-Wunused-type-patterns] diff --git a/testsuite/tests/indexed-types/should_compile/T16356_Compile2.stderr b/testsuite/tests/indexed-types/should_compile/T16356_Compile2.stderr index 3aceb43604..bda837dd87 100644 --- a/testsuite/tests/indexed-types/should_compile/T16356_Compile2.stderr +++ b/testsuite/tests/indexed-types/should_compile/T16356_Compile2.stderr @@ -1,8 +1,8 @@ -T16356_Compile2.hs:10:12: warning: [-Wunused-type-patterns] +T16356_Compile2.hs:10:11: warning: [-Wunused-type-patterns] Defined but not used on the right hand side: type variable ‘j’ -T16356_Compile2.hs:10:17: warning: [-Wunused-type-patterns] +T16356_Compile2.hs:10:11: warning: [-Wunused-type-patterns] Defined but not used on the right hand side: type variable ‘a’ T16356_Compile2.hs:13:15: warning: [-Wunused-type-patterns] diff --git a/testsuite/tests/indexed-types/should_compile/T16632.stderr b/testsuite/tests/indexed-types/should_compile/T16632.stderr index d2eab5c6b5..1f0aea9a87 100644 --- a/testsuite/tests/indexed-types/should_compile/T16632.stderr +++ b/testsuite/tests/indexed-types/should_compile/T16632.stderr @@ -1,6 +1,6 @@ -T16632.hs:5:22: warning: [-Wunused-type-patterns] +T16632.hs:5:17: warning: [-Wunused-type-patterns] Defined but not used on the right hand side: type variable ‘b’ | 5 | type instance F Char b Int = () - | ^ + | ^^^^^^^^^^ diff --git a/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.stderr b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.stderr index 833315e6be..b3b97f03a5 100644 --- a/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.stderr +++ b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.stderr @@ -1,12 +1,12 @@ -UnusedTyVarWarnings.hs:8:7: warning: [-Wunused-type-patterns] +UnusedTyVarWarnings.hs:8:5: warning: [-Wunused-type-patterns] Defined but not used on the right hand side: type variable ‘b’ -UnusedTyVarWarnings.hs:11:20: warning: [-Wunused-type-patterns] +UnusedTyVarWarnings.hs:11:18: warning: [-Wunused-type-patterns] Defined but not used on the right hand side: type variable ‘b’ UnusedTyVarWarnings.hs:27:5: warning: [-Wunused-type-patterns] Defined but not used on the right hand side: type variable ‘a’ -UnusedTyVarWarnings.hs:33:19: warning: [-Wunused-type-patterns] +UnusedTyVarWarnings.hs:33:17: warning: [-Wunused-type-patterns] Defined but not used on the right hand side: type variable ‘b’ diff --git a/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarningsNamedWCs.stderr b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarningsNamedWCs.stderr index 9049ddf696..4801686ae3 100644 --- a/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarningsNamedWCs.stderr +++ b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarningsNamedWCs.stderr @@ -1,12 +1,12 @@ -UnusedTyVarWarningsNamedWCs.hs:8:7: warning: [-Wunused-type-patterns] +UnusedTyVarWarningsNamedWCs.hs:8:5: warning: [-Wunused-type-patterns] Defined but not used on the right hand side: type variable ‘b’ -UnusedTyVarWarningsNamedWCs.hs:11:20: warning: [-Wunused-type-patterns] +UnusedTyVarWarningsNamedWCs.hs:11:18: warning: [-Wunused-type-patterns] Defined but not used on the right hand side: type variable ‘b’ UnusedTyVarWarningsNamedWCs.hs:27:5: warning: [-Wunused-type-patterns] Defined but not used on the right hand side: type variable ‘a’ -UnusedTyVarWarningsNamedWCs.hs:33:19: warning: [-Wunused-type-patterns] +UnusedTyVarWarningsNamedWCs.hs:33:17: warning: [-Wunused-type-patterns] Defined but not used on the right hand side: type variable ‘b’ diff --git a/testsuite/tests/indexed-types/should_fail/T17008a.stderr b/testsuite/tests/indexed-types/should_fail/T17008a.stderr index 8428a279b4..795506e3b3 100644 --- a/testsuite/tests/indexed-types/should_fail/T17008a.stderr +++ b/testsuite/tests/indexed-types/should_fail/T17008a.stderr @@ -1,5 +1,5 @@ -T17008a.hs:11:21: error: +T17008a.hs:11:5: error: • Type variable ‘a1’ is mentioned in the RHS, but not bound on the LHS of the family instance The real LHS (expanding synonyms) is: F @a2 x diff --git a/testsuite/tests/indexed-types/should_fail/T7536.stderr b/testsuite/tests/indexed-types/should_fail/T7536.stderr index 22c565be62..9d38afdb9a 100644 --- a/testsuite/tests/indexed-types/should_fail/T7536.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7536.stderr @@ -1,5 +1,5 @@ -T7536.hs:8:21: error: +T7536.hs:8:18: error: • Type variable ‘a’ is mentioned in the RHS, but not bound on the LHS of the family instance The real LHS (expanding synonyms) is: TF Int diff --git a/testsuite/tests/polykinds/T11203.stderr b/testsuite/tests/polykinds/T11203.stderr index e6f30c0335..decefbd1fa 100644 --- a/testsuite/tests/polykinds/T11203.stderr +++ b/testsuite/tests/polykinds/T11203.stderr @@ -1,4 +1,4 @@ -T11203.hs:7:24: error: +T11203.hs:7:9: error: • Different names for the same type variable: ‘k1’ and ‘k2’ • In the data declaration for ‘Q’ diff --git a/testsuite/tests/polykinds/T11821a.stderr b/testsuite/tests/polykinds/T11821a.stderr index 50d58df8f5..cc18f2c0fd 100644 --- a/testsuite/tests/polykinds/T11821a.stderr +++ b/testsuite/tests/polykinds/T11821a.stderr @@ -1,4 +1,4 @@ -T11821a.hs:4:31: error: +T11821a.hs:4:16: error: • Different names for the same type variable: ‘k1’ and ‘k2’ • In the type declaration for ‘SameKind’ diff --git a/testsuite/tests/polykinds/T17841.stderr b/testsuite/tests/polykinds/T17841.stderr index 11243a4322..de33036dcf 100644 --- a/testsuite/tests/polykinds/T17841.stderr +++ b/testsuite/tests/polykinds/T17841.stderr @@ -3,7 +3,7 @@ T17841.hs:7:45: error: • Expected a type, but ‘t’ has kind ‘k2’ ‘k2’ is a rigid type variable bound by the class declaration for ‘Foo’ - at T17841.hs:7:17 + at T17841.hs:7:12-17 • In the kind ‘t’ In the first argument of ‘Proxy’, namely ‘(a :: t)’ In the type signature: foo :: Proxy (a :: t) diff --git a/testsuite/tests/polykinds/T7224.stderr b/testsuite/tests/polykinds/T7224.stderr index c9d2236206..ca1f32c1c2 100644 --- a/testsuite/tests/polykinds/T7224.stderr +++ b/testsuite/tests/polykinds/T7224.stderr @@ -3,7 +3,7 @@ T7224.hs:6:19: error: • Expected kind ‘i’, but ‘i’ has kind ‘*’ ‘i’ is a rigid type variable bound by the class declaration for ‘PMonad'’ - at T7224.hs:5:21 + at T7224.hs:5:16-36 • In the first argument of ‘m’, namely ‘i’ In the type signature: ret' :: a -> m i i a In the class declaration for ‘PMonad'’ @@ -12,7 +12,7 @@ T7224.hs:7:14: error: • Expected kind ‘i’, but ‘i’ has kind ‘*’ ‘i’ is a rigid type variable bound by the class declaration for ‘PMonad'’ - at T7224.hs:5:21 + at T7224.hs:5:16-36 • In the first argument of ‘m’, namely ‘i’ In the type signature: bind' :: m i j a -> (a -> m j k b) -> m i k b diff --git a/testsuite/tests/typecheck/should_fail/LevPolyBounded.stderr b/testsuite/tests/typecheck/should_fail/LevPolyBounded.stderr index 114d3e962d..c4c8d83a77 100644 --- a/testsuite/tests/typecheck/should_fail/LevPolyBounded.stderr +++ b/testsuite/tests/typecheck/should_fail/LevPolyBounded.stderr @@ -3,7 +3,7 @@ LevPolyBounded.hs:10:15: error: • Expected a type, but ‘a’ has kind ‘TYPE r’ ‘r’ is a rigid type variable bound by the class declaration for ‘XBounded’ - at LevPolyBounded.hs:9:27 + at LevPolyBounded.hs:9:17-27 • In the type signature: LevPolyBounded.minBound :: a In the class declaration for ‘XBounded’ @@ -11,6 +11,6 @@ LevPolyBounded.hs:11:15: error: • Expected a type, but ‘a’ has kind ‘TYPE r’ ‘r’ is a rigid type variable bound by the class declaration for ‘XBounded’ - at LevPolyBounded.hs:9:27 + at LevPolyBounded.hs:9:17-27 • In the type signature: LevPolyBounded.maxBound :: a In the class declaration for ‘XBounded’ diff --git a/testsuite/tests/typecheck/should_fail/T17566b.stderr b/testsuite/tests/typecheck/should_fail/T17566b.stderr index be3c0e19bd..50e788d723 100644 --- a/testsuite/tests/typecheck/should_fail/T17566b.stderr +++ b/testsuite/tests/typecheck/should_fail/T17566b.stderr @@ -1,4 +1,4 @@ -T17566b.hs:7:17: error: +T17566b.hs:7:12: error: • Different names for the same type variable: ‘k1’ and ‘k2’ • In the class declaration for ‘C’ diff --git a/testsuite/tests/typecheck/should_fail/T17566c.stderr b/testsuite/tests/typecheck/should_fail/T17566c.stderr index df5e5c0739..16d82cf26a 100644 --- a/testsuite/tests/typecheck/should_fail/T17566c.stderr +++ b/testsuite/tests/typecheck/should_fail/T17566c.stderr @@ -1,6 +1,6 @@ -T17566c.hs:11:23: error: +T17566c.hs:11:12: error: • Different names for the same type variable: - ‘k’ bound at T17566c.hs:10:17 - ‘k’ bound at T17566c.hs:11:23 + ‘k’ bound at T17566c.hs:10:12 + ‘k’ bound at T17566c.hs:11:12 • In the class declaration for ‘C2’ diff --git a/testsuite/tests/typecheck/should_fail/T9201.stderr b/testsuite/tests/typecheck/should_fail/T9201.stderr index 16a183bef0..ad873a0d0a 100644 --- a/testsuite/tests/typecheck/should_fail/T9201.stderr +++ b/testsuite/tests/typecheck/should_fail/T9201.stderr @@ -3,10 +3,10 @@ T9201.hs:6:17: error: • Expected kind ‘x’, but ‘a’ has kind ‘y’ ‘y’ is a rigid type variable bound by the class declaration for ‘MonoidalCCC’ - at T9201.hs:5:30 + at T9201.hs:5:20-49 ‘x’ is a rigid type variable bound by the class declaration for ‘MonoidalCCC’ - at T9201.hs:5:25 + at T9201.hs:5:20-49 • In the first argument of ‘f’, namely ‘a’ In the second argument of ‘d’, namely ‘(f a)’ In the type signature: ret :: d a (f a) |