Magnus pushed to branch wip/mangoiv/backport-unused-type at Glasgow Haskell Compiler / GHC Commits: b158f89b by mangoiv at 2026-06-18T13:35:00+02:00 backport unused type - - - - - 8 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -2007,8 +2007,8 @@ unsatisfiableClassNameKey = mkPreludeTyConUnique 170 anyTyConKey :: Unique anyTyConKey = mkPreludeTyConUnique 171 -zonkAnyTyConKey :: Unique -zonkAnyTyConKey = mkPreludeTyConUnique 172 +unusedTypeTyConKey :: Unique +unusedTypeTyConKey = mkPreludeTyConUnique 172 -- Custom user type-errors errorMessageTypeErrorFamKey :: Unique ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -92,7 +92,7 @@ module GHC.Builtin.Types ( cTupleSelId, cTupleSelIdName, -- * Any - anyTyCon, anyTy, anyTypeOfKind, zonkAnyTyCon, + anyTyCon, anyTy, anyTypeOfKind, unusedTypeTyCon, -- * Recovery TyCon makeRecoveryTyCon, @@ -310,7 +310,7 @@ wiredInTyCons = map (dataConTyCon . snd) boxingDataCons , soloTyCon , anyTyCon - , zonkAnyTyCon + , unusedTypeTyCon , boolTyCon , charTyCon , stringTyCon @@ -421,13 +421,13 @@ doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") {- Note [Any types] ~~~~~~~~~~~~~~~~ -The type constructors `Any` and `ZonkAny` are closed type families declared thus: +The type constructors `Any` and `UnusedType` are closed type families declared thus: - type family Any :: forall k. k where { } - type family ZonkAny :: forall k. Nat -> k where { } + type family Any :: forall k. k where { } + type family UnusedType :: forall k. Nat -> Symbol -> k where { } They are used when we want a type of a particular kind, but we don't really care -what that type is. The leading example is this: `ZonkAny` is used to instantiate +what that type is. The leading example is this: `UnusedType` is used to instantiate un-constrained type variables after type checking. For example, consider the term (length [] :: Int), where @@ -440,26 +440,26 @@ The typechecker will end up with length @alpha ([] @alpha) where `alpha` is an un-constrained unification variable. The "zonking" process zaps -that unconstrained `alpha` to an arbitrary type (ZonkAny @Type 3), where the `3` is -arbitrary (see wrinkle (Any5) below). This is done in `GHC.Tc.Zonk.Type.commitFlexi`. -So we end up with +that unconstrained `alpha` to an arbitrary type (UnusedType @Type 3 "a"), where the `3` is +arbitrary (see wrinkle (Any5) below). and `a` is the original name, if we have one. +This is done in `GHC.Tc.Zonk.Type.commitFlexi`. So we end up with - length @(ZonkAny @Type 3) ([] @(ZonkAny @Type 3)) + length @(UnusedType @Type 3 "a") ([] @(UnusedType @Type 3 "a")) -`Any` and `ZonkAny` differ only in the presence of the `Nat` argument; see -wrinkle (Any4). +`Any` and `UnusedType` differ only in the presence of the `Nat` and the `Symbol` arguments; +see wrinkle (Any4). Wrinkles: -(Any1) `Any` and `ZonkAny` are kind polymorphic since in some program we may - need to use `ZonkAny` to fill in a type variable of some kind other than * +(Any1) `Any` and `UnusedType` are kind polymorphic since in some program we may + need to use `UnusedType` to fill in a type variable of some kind other than * (see #959 for examples). (Any2) They are /closed/ type families, with no instances. For example, suppose that with alpha :: '(k1, k2) we add a given coercion g :: alpha ~ (Fst alpha, Snd alpha) - and we zonked alpha = ZonkAny @(k1,k2) n. Then, if `ZonkAny` was a /data/ type, - we'd get inconsistency because we'd have a Given equality with `ZonkAny` on one + and we zonked alpha = UnusedType @(k1,k2) n. Then, if `UnusedType` was a /data/ type, + we'd get inconsistency because we'd have a Given equality with `UnusedType` on one side and '(,) on the other. See also #9097 and #9636. See #25244 for a suggestion that we instead use an /open/ type family for which @@ -469,7 +469,7 @@ Wrinkles: the code generator, because the code gen may /enter/ a data value but never enters a function value. -(Any4) `ZonkAny` takes a `Nat` argument so that we can readily make up /distinct/ +(Any4) `UnusedType` takes a `Nat` argument so that we can readily make up /distinct/ types (#24817). Consider data SBool a where { STrue :: SBool True; SFalse :: SBool False } @@ -484,17 +484,29 @@ Wrinkles: Now, what are `alpha` and `beta`? If we zonk both of them to the same type `Any @Type`, the pattern-match checker will (wrongly) report that the first branch is inaccessible. So we zonk them to two /different/ types: - alpha := ZonkAny @Type 4 and beta := ZonkAny @Type k 5 + alpha := UnusedType @Type 4 "a" and beta := UnusedType @Type k 5 "b" (The actual numbers are arbitrary; they just need to differ.) The unique-name generation comes from field `tcg_zany_n` of `TcGblEnv`; and - `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newZonkAnyType` to + `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newUnusedTypeType` to make up a fresh type. If this example seems unconvincing (e.g. in this case foo must be bottom) see #24817 for larger but more compelling examples. -(Any5) `Any` and `ZonkAny` are wired-in so we can easily refer to it where we + `UnusedType` takes a `Symbol` argument so we can neatly display the type to the user. + While `UnusedType` ought to be an implementation detail, we sometimes leak it to the + user, especially in consumers of the GHC api like haskell-language-server. + The user does not know what an `UnusedType` is and just expects a meta variable. + However, since the process of zonking should remove all meta variables, we just try to + reconstruct it when pretty printing, e.g. + `UnusedType 3 "foo" :: Type` becomes `foo_3` + + Historical note: `UnusedType` was called `ZonkAny` in older versions of the compiler + but since this is a leaky abstractions (see above) we give it this improved name + and handle it specially in the pretty printer to avoid confusion of the user. + +(Any5) `Any` and `UnusedType` are wired-in so we can easily refer to it where we don't have a name environment (e.g. see Rules.matchRule for one example) (Any6) `Any` is defined in library module ghc-prim:GHC.Types, and exported so that @@ -502,7 +514,7 @@ Wrinkles: wired-in type: - has a fixed unique, anyTyConKey, - lives in the global name cache - Currently `ZonkAny` is not available to users; but it could easily be. + Currently `UnusedType` is not available to users; but it could easily be. (Any7) Properties of `Any`: * When `Any` is instantiated at a lifted type it is inhabited by at least one value, @@ -521,6 +533,17 @@ Wrinkles: See examples in ghc-prim:GHC.Types +(Any8) Warning about unused bindings of type `Any` and `UnusedType` are suppressed, + following the same rationale of supressing warning about the unit type. + + For example, consider (#25895): + + do { forever (return ()); blah } + + where forever :: forall a b. IO a -> IO b + Nothing constrains `b`, so it will be instantiates with `Any` or `UnusedType`. + But we certainly don't want to complain about a discarded do-binding. + The Any tycon used to be quite magic, but we have since been able to implement it merely with an empty kind polymorphic type family. See #10886 for a bit of history. @@ -547,23 +570,25 @@ anyTy = mkTyConTy anyTyCon anyTypeOfKind :: Kind -> Type anyTypeOfKind kind = mkTyConApp anyTyCon [kind] -zonkAnyTyConName :: Name -zonkAnyTyConName = - mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "ZonkAny") zonkAnyTyConKey zonkAnyTyCon +unusedTypeTyConName :: Name +unusedTypeTyConName = + mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "UnusedType") unusedTypeTyConKey unusedTypeTyCon -zonkAnyTyCon :: TyCon --- ZonkAnyTyCon :: forall k. Nat -> k +unusedTypeTyCon :: TyCon +-- unusedTypeTyCon :: forall k. Nat -> Symbol -> k -- See Note [Any types] -zonkAnyTyCon = mkFamilyTyCon zonkAnyTyConName - [ mkNamedTyConBinder Specified kv - , mkAnonTyConBinder nat_kv ] - (mkTyVarTy kv) +unusedTypeTyCon = mkFamilyTyCon unusedTypeTyConName bndrs res_kind Nothing (ClosedSynFamilyTyCon Nothing) Nothing NotInjective where - [kv,nat_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy] + [kv,nat_kv,sym_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy, typeSymbolKind] + bndrs = [ mkNamedTyConBinder Specified kv + , mkAnonTyConBinder nat_kv + , mkAnonTyConBinder sym_kv ] + res_kind = mkTyVarTy kv + kind = mkTyConKind bndrs res_kind -- | Make a fake, recovery 'TyCon' from an existing one. -- Used when recovering from errors in type declarations ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -985,9 +985,13 @@ warnDiscardedDoBindings rhs rhs_ty ; when (warn_unused || warn_wrong) $ do { fam_inst_envs <- dsGetFamInstEnvs ; let norm_elt_ty = topNormaliseType fam_inst_envs elt_ty - - -- Warn about discarding non-() things in 'monadic' binding - ; if warn_unused && not (isUnitTy norm_elt_ty) + supressible_ty = + isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isUnusedTypeTy norm_elt_ty + -- Warn about discarding things in 'monadic' binding, + -- however few types are excluded: + -- * Unit type `()` + -- * `UnusedType` or `Any` type see (Any8) of Note [Any types] + ; if warn_unused && not supressible_ty then diagnosticDs (DsUnusedDoBind rhs elt_ty) else ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -7,7 +7,7 @@ This module defines interface types and binders -} -{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE MultiWayIf, OverloadedRecordDot #-} {-# LANGUAGE LambdaCase #-} module GHC.Iface.Type ( IfExtName, @@ -1664,6 +1664,7 @@ pprTyTcApp ctxt_prec tc tys = sdocOption sdocPrintExplicitKinds $ \print_kinds -> sdocOption sdocPrintTypeAbbreviations $ \print_type_abbreviations -> getPprDebug $ \debug -> + getPprStyle $ \style -> if | ifaceTyConName tc `hasKey` ipClassKey , IA_Arg (IfaceLitTy (IfaceStrTyLit n)) @@ -1715,6 +1716,12 @@ pprTyTcApp ctxt_prec tc tys = | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys) -> doc + | ifaceTyConName tc `hasKey` unusedTypeTyConKey + , (arg_k : IfaceLitTy (IfaceNumTyLit arg_n) : IfaceLitTy (IfaceStrTyLit arg_nm) : _) <- appArgsIfaceTypes tys + -- if arg_k is a kind with more than 0 arguments, then _ might not be [] here + , userStyle style + -> ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_n arg_nm + | otherwise -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc $ appArgsIfaceTypesForAllTyFlags $ stripInvisArgs (PrintExplicitKinds print_kinds) tys @@ -1727,6 +1734,15 @@ ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case True -> maybeParen ctxt_prec starPrec $ unicodeSyntax (char '★') (char '*') +ppr_iface_unused_ty_tycon :: PprPrec -> IfaceType -> Integer -> LexicalFastString -> SDoc +ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_n arg_nm + = sdocOption sdocPrintExplicitKinds $ \print_kinds -> + sdocOption sdocPrintExplicitRuntimeReps $ \print_reps -> + if print_kinds || print_reps + then maybeParen ctxt_prec sigPrec $ prettyMeta <+> text "::" <+> pprIfaceType arg_k + else prettyMeta + where prettyMeta = ppr arg_nm <> ppr arg_n + -- | Pretty-print a type-level equality. -- Returns (Just doc) if the argument is a /saturated/ application -- of eqTyCon (~) @@ -2113,7 +2129,8 @@ instance Binary IfaceTyConSort where 0 -> return IfaceNormalTyCon 1 -> IfaceTupleTyCon <$> get bh <*> get bh 2 -> IfaceSumTyCon <$> get bh - _ -> return IfaceEqualityTyCon + 3 -> return IfaceEqualityTyCon + _ -> panic "get IfaceTyConSort" instance Binary IfaceTyConInfo where put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -569,7 +569,7 @@ data TcGblEnv -- ^ Allows us to choose unique DFun names. tcg_zany_n :: TcRef Integer, - -- ^ A source of unique identities for ZonkAny instances + -- ^ A source of unique identities for UnusedType instances -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) tcg_merged :: [(Module, Fingerprint)], ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -142,7 +142,7 @@ module GHC.Tc.Utils.Monad( getCCIndexM, getCCIndexTcM, -- * Zonking - liftZonkM, newZonkAnyType, + liftZonkM, newUnusedType, -- * Complete matches localAndImportedCompleteMatches, getCompleteMatchesTcM, @@ -156,7 +156,7 @@ import GHC.Prelude import GHC.Builtin.Names -import GHC.Builtin.Types( zonkAnyTyCon ) +import GHC.Builtin.Types( unusedTypeTyCon ) import GHC.Tc.Errors.Types import GHC.Tc.Types -- Re-export all @@ -180,7 +180,7 @@ import GHC.Core.UsageEnv import GHC.Core.Multiplicity import GHC.Core.InstEnv import GHC.Core.FamInstEnv -import GHC.Core.Type( mkNumLitTy ) +import GHC.Core.Type( mkNumLitTy, mkStrLitTy ) import GHC.Driver.Env import GHC.Driver.Session @@ -1792,17 +1792,17 @@ chooseUniqueOccTc fn = ; writeTcRef dfun_n_var (extendOccSet set occ) ; return occ } -newZonkAnyType :: Kind -> TcM Type --- Return a type (ZonkAny @k n), where n is fresh --- Recall ZonkAny :: forall k. Natural -> k +newUnusedType :: Name -> Kind -> TcM Type +-- Return a type (UnusedType @k n sym), where n is fresh +-- Recall UnusedType :: forall k. Natural -> Symbol -> k -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) -newZonkAnyType kind +newUnusedType name kind = do { env <- getGblEnv ; let zany_n_var = tcg_zany_n env ; i <- readTcRef zany_n_var ; let !i2 = i+1 ; writeTcRef zany_n_var i2 - ; return (mkTyConApp zonkAnyTyCon [kind, mkNumLitTy i]) } + ; return (mkTyConApp unusedTypeTyCon [kind, mkNumLitTy i, mkStrLitTy $ getOccFS name ]) } getConstraintVar :: TcM (TcRef WantedConstraints) getConstraintVar = do { env <- getLclEnv; return (tcl_lie env) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -88,7 +88,7 @@ module GHC.Tc.Utils.TcType ( isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy, isFloatingPrimTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, - isBoolTy, isUnitTy, isCharTy, + isBoolTy, isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy, isTauTy, isTauTyCon, tcIsTyVarTy, isPredTy, isTyVarClassPred, checkValidClsArgs, hasTyVarHead, @@ -2005,7 +2005,7 @@ isFloatTy, isDoubleTy, isFloatPrimTy, isDoublePrimTy, isIntegerTy, isNaturalTy, isIntTy, isWordTy, isBoolTy, - isUnitTy, isCharTy :: Type -> Bool + isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy :: Type -> Bool isFloatTy = is_tc floatTyConKey isDoubleTy = is_tc doubleTyConKey isFloatPrimTy = is_tc floatPrimTyConKey @@ -2016,6 +2016,8 @@ isIntTy = is_tc intTyConKey isWordTy = is_tc wordTyConKey isBoolTy = is_tc boolTyConKey isUnitTy = is_tc unitTyConKey +isAnyTy = is_tc anyTyConKey +isUnusedTypeTy = is_tc unusedTypeTyConKey isCharTy = is_tc charTyConKey -- | Check whether the type is of the form @Any :: k@, ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE GADTs #-} {- @@ -54,7 +55,7 @@ import GHC.Tc.Types.TcRef import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo ) import GHC.Tc.Utils.Env ( tcLookupGlobalOnly ) import GHC.Tc.Utils.TcType -import GHC.Tc.Utils.Monad ( newZonkAnyType, setSrcSpanA, liftZonkM, traceTc, addErr ) +import GHC.Tc.Utils.Monad ( newUnusedType, setSrcSpanA, liftZonkM, traceTc, addErr ) import GHC.Tc.Types.Constraint import GHC.Tc.Types.Evidence import GHC.Tc.Errors.Types @@ -471,7 +472,7 @@ commitFlexi tv zonked_kind | otherwise -> do { traceTc "Defaulting flexi tyvar to ZonkAny:" (pprTyVar tv) -- See Note [Any types] in GHC.Builtin.Types, esp wrinkle (Any4) - ; newZonkAnyType zonked_kind } + ; newUnusedType name zonked_kind } RuntimeUnkFlexi -> do { traceTc "Defaulting flexi tyvar to RuntimeUnk:" (pprTyVar tv) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b158f89b9c768379ce0346ef5ee37199... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b158f89b9c768379ce0346ef5ee37199... You're receiving this email because of your account on gitlab.haskell.org.
participants (1)
-
Magnus (@MangoIV)