Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e0f3ff11 by Patrick at 2025-04-17T04:31:12-04:00 Refactor Handling of Multiple Default Declarations Fixes: #25912, #25914, #25934 Previously, GHC discarded all loaded defaults (tcg_default) when local defaults were encountered during typechecking. According to the exportable-named-default proposal (sections 2.4.2 and 2.4.3), local defaults should be merged into tcg_default, retaining any defaults already present while overriding where necessary. Key Changes: * Introduce DefaultProvenance to track the origin of default declarations (local, imported, or built-in), replacing the original cd_module in ClassDefaults with cd_provenance :: DefaultProvenance. * Rename tcDefaults to tcDefaultDecls, limiting its responsibility to only converting renamed class defaults into ClassDefaults. * Add extendDefaultEnvWithLocalDefaults to merge local defaults into the environment, with proper duplication checks: - Duplicate local defaults for a class trigger an error. - Local defaults override imported or built-in defaults. * Update and add related notes: Note [Builtin class defaults], Note [DefaultProvenance]. * Add regression tests: T25912, T25914, T25934. Thanks sam and simon for the help on this patch. Co-authored-by: sheaf - - - - - 17 changed files: - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Default.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Types/DefaultEnv.hs - + testsuite/tests/default/T25912.hs - + testsuite/tests/default/T25912.stdout - + testsuite/tests/default/T25912_helper.hs - + testsuite/tests/default/T25914.hs - + testsuite/tests/default/T25934.hs - testsuite/tests/default/all.T - testsuite/tests/default/default-fail03.stderr - testsuite/tests/linters/notes.stdout - testsuite/tests/module/mod58.stderr Changes: ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -118,7 +118,7 @@ import GHC.Types.Var.Set import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Env -import GHC.Types.DefaultEnv ( ClassDefaults(..), DefaultEnv, mkDefaultEnv ) +import GHC.Types.DefaultEnv ( ClassDefaults(..), DefaultEnv, mkDefaultEnv, DefaultProvenance(..) ) import GHC.Types.Id import GHC.Types.Id.Make import GHC.Types.Id.Info @@ -1333,7 +1333,7 @@ tcIfaceDefault this_mod IfaceDefault { ifDefaultCls = cls_name ; let warn = fmap fromIfaceWarningTxt iface_warn ; return ClassDefaults { cd_class = cls , cd_types = tys' - , cd_module = Just this_mod + , cd_provenance = DP_Imported this_mod , cd_warn = warn } } where tyThingConClass :: TyThing -> Class ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -85,7 +85,7 @@ import GHC.Tc.Types.Rank (Rank(..)) import GHC.Tc.Types.TH import GHC.Tc.Utils.TcType -import GHC.Types.DefaultEnv (ClassDefaults(ClassDefaults, cd_types, cd_module)) +import GHC.Types.DefaultEnv (ClassDefaults(ClassDefaults, cd_types, cd_provenance), DefaultProvenance (..)) import GHC.Types.Error import GHC.Types.Error.Codes import GHC.Types.Hint @@ -582,11 +582,19 @@ instance Diagnostic TcRnMessage where TcRnMultipleDefaultDeclarations cls dup_things -> mkSimpleDecorated $ hang (text "Multiple default declarations for class" <+> quotes (ppr cls)) - 2 (vcat (map pp dup_things)) + 2 (pp dup_things) where - pp :: LDefaultDecl GhcRn -> SDoc - pp (L locn DefaultDecl {}) - = text "here was another default declaration" <+> ppr (locA locn) + pp :: ClassDefaults -> SDoc + pp (ClassDefaults { cd_provenance = prov }) + = case prov of + DP_Local { defaultDeclLoc = loc, defaultDeclH98 = isH98 } + -> let + what = + if isH98 + then text "default declaration" + else text "named default declaration" + in text "conflicting" <+> what <+> text "at:" <+> ppr loc + _ -> empty -- doesn't happen, as local defaults override imported and built-in defaults TcRnBadDefaultType ty deflt_clss -> mkSimpleDecorated $ hang (text "The default type" <+> quotes (ppr ty) <+> text "is not an instance of") @@ -7139,7 +7147,7 @@ pprPatersonCondFailure (PCF_TyFam tc) InTyFamEquation _lhs rhs = -------------------------------------------------------------------------------- defaultTypesAndImport :: ClassDefaults -> SDoc -defaultTypesAndImport ClassDefaults{cd_types, cd_module = Just cdm} = +defaultTypesAndImport ClassDefaults{cd_types, cd_provenance = DP_Imported cdm} = hang (parens $ pprWithCommas ppr cd_types) 2 (text "imported from" <+> ppr cdm) defaultTypesAndImport ClassDefaults{cd_types} = parens (pprWithCommas ppr cd_types) ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -1504,7 +1504,7 @@ data TcRnMessage where Text cases: module/mod58 -} - TcRnMultipleDefaultDeclarations :: Class -> [LDefaultDecl GhcRn] -> TcRnMessage + TcRnMultipleDefaultDeclarations :: Class -> ClassDefaults -> TcRnMessage {-| TcRnWarnClashingDefaultImports is a warning that occurs when a module imports more than one default declaration for the same class, and they are not all ===================================== compiler/GHC/Tc/Gen/Default.hs ===================================== @@ -5,9 +5,10 @@ -} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE LambdaCase #-} -- | Typechecking @default@ declarations -module GHC.Tc.Gen.Default ( tcDefaults ) where +module GHC.Tc.Gen.Default ( tcDefaultDecls, extendDefaultEnvWithLocalDefaults ) where import GHC.Prelude import GHC.Hs @@ -16,7 +17,7 @@ import GHC.Builtin.Names import GHC.Core.Class import GHC.Core.Predicate ( Pred (..), classifyPredType ) -import GHC.Data.Maybe ( firstJusts ) +import GHC.Data.Maybe ( firstJusts, maybeToList ) import GHC.Tc.Errors.Types import GHC.Tc.Gen.HsType @@ -30,20 +31,17 @@ import GHC.Tc.Utils.TcMType ( newWanted ) import GHC.Tc.Utils.TcType import GHC.Types.Basic ( TypeOrKind(..) ) -import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults (..), defaultEnv ) +import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults (..), lookupDefaultEnv, insertDefaultEnv, DefaultProvenance (..) ) import GHC.Types.SrcLoc -import GHC.Unit.Types (Module, ghcInternalUnit, moduleUnit) +import GHC.Unit.Types (ghcInternalUnit, moduleUnit) -import GHC.Utils.Misc (fstOf3, sndOf3) import GHC.Utils.Outputable import qualified GHC.LanguageExtensions as LangExt -import Data.Function (on) -import Data.List.NonEmpty ( NonEmpty (..), groupBy ) +import Data.List.NonEmpty ( NonEmpty (..) ) import qualified Data.List.NonEmpty as NE -import Data.Maybe (fromMaybe) import Data.Traversable ( for ) {- Note [Named default declarations] @@ -86,7 +84,7 @@ The moving parts are as follows: * The `DefaultEnv` of all defaults in scope in a module is kept in the `tcg_default` field of `TcGblEnv`. -* This field is populated by `GHC.Tc.Gen.Default.tcDefaults` which typechecks +* This field is populated by `GHC.Tc.Gen.Default.tcDefaultDecls` which typechecks any local or imported `default` declarations. * Only a single default declaration can be in effect in any single module for @@ -103,7 +101,7 @@ The moving parts are as follows: in effect be `default Num (Integer, Double)` as specified by Haskell Language Report. - See Note [Default class defaults] in GHC.Tc.Utils.Env + See Note [Builtin class defaults] in GHC.Tc.Utils.Env * Beside the defaults, the `ExtendedDefaultRules` and `OverloadedStrings` extensions also affect the traditional `default` declarations that don't name @@ -120,61 +118,54 @@ The moving parts are as follows: tracked separately from `ImportAvails`, and returned separately from them by `GHC.Rename.Names.rnImports`. -* Class defaults are exported explicitly, as the example above shows. A module's - exported defaults are tracked in `tcg_default_exports`, which are then - transferred to `mg_defaults`, `md_defaults`, and `mi_defaults_`. +* Class defaults are exported explicitly. + For example, + module M( ..., default C, ... ) + exports the defaults for class C. + + A module's exported defaults are computed by exports_from_avail, + tracked in tcg_default_exports, which are then transferred to mg_defaults, + md_defaults, and mi_defaults_. + + Only defaults explicitly exported are actually exported. + (i.e. No defaults are exported in a module header like: + module M where ...) + See Note [Default exports] in GHC.Tc.Gen.Export * Since the class defaults merely help the solver infer the correct types, they leave no trace in Haskell Core. -} --- See Note [Named default declarations] -tcDefaults :: [LDefaultDecl GhcRn] - -> TcM DefaultEnv -- Defaulting types to heave - -- into Tc monad for later use - -- in Disambig. - -tcDefaults [] - = getDeclaredDefaultTys -- No default declaration, so get the - -- default types from the envt; - -- i.e. use the current ones - -- (the caller will put them back there) - -- It's important not to return defaultDefaultTys here (which - -- we used to do) because in a TH program, tcDefaults [] is called - -- repeatedly, once for each group of declarations between top-level - -- splices. We don't want to carefully set the default types in - -- one group, only for the next group to ignore them and install - -- defaultDefaultTys - -tcDefaults decls - = do { tcg_env <- getGblEnv - ; let - here = tcg_mod tcg_env - is_internal_unit = moduleUnit here == ghcInternalUnit - ; case (is_internal_unit, decls) of - -- Some internal GHC modules contain @default ()@ to declare that no defaults can take place - -- in the module. - -- We shortcut the treatment of such a default declaration with no class nor types: we won't - -- try to point 'cd_class' to 'Num' since it may not even exist yet. - { (True, [L _ (DefaultDecl _ Nothing [])]) - -> return $ defaultEnv [] - -- Otherwise we take apart the declaration into the class constructor and its default types. - ; _ -> - do { h2010_dflt_clss <- getH2010DefaultClasses - ; decls' <- mapMaybeM (declarationParts h2010_dflt_clss) decls - ; let - -- Find duplicate default declarations - decl_tag (mb_cls, _, _) = - case mb_cls of - Nothing -> Nothing - Just cls -> if cls `elem` h2010_dflt_clss - then Nothing - else Just cls - decl_groups = groupBy ((==) `on` decl_tag) decls' - ; decls_without_dups <- mapM (reportDuplicates here h2010_dflt_clss) decl_groups - ; return $ defaultEnv (concat decls_without_dups) - } } } +-- | Typecheck a collection of default declarations. These can be either: +-- +-- - Haskell 98 default declarations, of the form @default (Float, Double)@ +-- - Named default declarations, of the form @default Cls(Int, Char)@. +-- See Note [Named default declarations] +tcDefaultDecls :: [LDefaultDecl GhcRn] -> TcM [LocatedA ClassDefaults] +tcDefaultDecls decls = + do + tcg_env <- getGblEnv + let here = tcg_mod tcg_env + is_internal_unit = moduleUnit here == ghcInternalUnit + case (is_internal_unit, decls) of + -- No default declarations + (_, []) -> return [] + -- As per Remark [default () in ghc-internal] in Note [Builtin class defaults], + -- some modules in ghc-internal include an empty `default ()` declaration, in order + -- to disable built-in defaults. This is no longer necessary (see `GHC.Tc.Utils.Env.tcGetDefaultTys`), + -- but we must still make sure not to error if we fail to look up e.g. the 'Num' + -- typeclass when typechecking such a default declaration. To do this, we wrap + -- calls of 'tcLookupClass' in 'tryTc'. + (True, [L _ (DefaultDecl _ Nothing [])]) -> do + h2010_dflt_clss <- foldMapM (fmap maybeToList . fmap fst . tryTc . tcLookupClass) =<< getH2010DefaultNames + case NE.nonEmpty h2010_dflt_clss of + Nothing -> return [] + Just h2010_dflt_clss' -> toClassDefaults h2010_dflt_clss' decls + -- Otherwise we take apart the declaration into the class constructor and its default types. + _ -> do + h2010_dflt_clss <- getH2010DefaultClasses + toClassDefaults h2010_dflt_clss decls where getH2010DefaultClasses :: TcM (NonEmpty Class) -- All the classes subject to defaulting with a Haskell 2010 default @@ -186,18 +177,18 @@ tcDefaults decls -- No extensions: Num -- OverloadedStrings: add IsString -- ExtendedDefaults: add Show, Eq, Ord, Foldable, Traversable - getH2010DefaultClasses - = do { num_cls <- tcLookupClass numClassName - ; ovl_str <- xoptM LangExt.OverloadedStrings + getH2010DefaultClasses = mapM tcLookupClass =<< getH2010DefaultNames + getH2010DefaultNames + = do { ovl_str <- xoptM LangExt.OverloadedStrings ; ext_deflt <- xoptM LangExt.ExtendedDefaultRules - ; deflt_str <- if ovl_str - then mapM tcLookupClass [isStringClassName] - else return [] - ; deflt_interactive <- if ext_deflt - then mapM tcLookupClass interactiveClassNames - else return [] - ; let extra_clss = deflt_str ++ deflt_interactive - ; return $ num_cls :| extra_clss + ; let deflt_str = if ovl_str + then [isStringClassName] + else [] + ; let deflt_interactive = if ext_deflt + then interactiveClassNames + else [] + ; let extra_clss_names = deflt_str ++ deflt_interactive + ; return $ numClassName :| extra_clss_names } declarationParts :: NonEmpty Class -> LDefaultDecl GhcRn -> TcM (Maybe (Maybe Class, LDefaultDecl GhcRn, [Type])) declarationParts h2010_dflt_clss decl@(L locn (DefaultDecl _ mb_cls_name dflt_hs_tys)) @@ -220,20 +211,49 @@ tcDefaults decls ; return (Just cls, decl, tau_tys) } } - reportDuplicates :: Module -> NonEmpty Class -> NonEmpty (Maybe Class, LDefaultDecl GhcRn, [Type]) -> TcM [ClassDefaults] - reportDuplicates here h2010_dflt_clss ((mb_cls, _, tys) :| []) - = pure [ ClassDefaults{cd_class = c, cd_types = tys, cd_module = Just here, cd_warn = Nothing } - | c <- case mb_cls of - Nothing -> NE.toList h2010_dflt_clss - Just cls -> [cls] - ] - -- Report an error on multiple default declarations for the same class in the same module. - -- See Note [Disambiguation of multiple default declarations] in GHC.Tc.Module - reportDuplicates _ (num_cls :| _) decls@((_, L locn _, _) :| _) - = setSrcSpan (locA locn) (addErrTc $ dupDefaultDeclErr cls (sndOf3 <$> decls)) - >> pure [] + toClassDefaults :: NonEmpty Class -> [LDefaultDecl GhcRn] -> TcM [LocatedA ClassDefaults] + toClassDefaults h2010_dflt_clss dfs = do + dfs <- mapMaybeM (declarationParts h2010_dflt_clss) dfs + return $ concatMap (go False) dfs where - cls = fromMaybe num_cls $ firstJusts (fmap fstOf3 decls) + go h98 = \case + (Nothing, rn_decl, tys) -> concatMap (go True) [(Just cls, rn_decl, tys) | cls <- NE.toList h2010_dflt_clss] + (Just cls, (L locn _), tys) -> [(L locn $ ClassDefaults cls tys (DP_Local (locA locn) h98) Nothing)] + +-- | Extend the default environment with the local default declarations +-- and do the action in the extended environment. +extendDefaultEnvWithLocalDefaults :: [LocatedA ClassDefaults] -> TcM a -> TcM a +extendDefaultEnvWithLocalDefaults decls action = do + tcg_env <- getGblEnv + let default_env = tcg_default tcg_env + new_default_env <- insertDefaultDecls default_env decls + updGblEnv (\gbl -> gbl { tcg_default = new_default_env } ) $ action + +-- | Insert local default declarations into the default environment. +-- +-- See 'insertDefaultDecl'. +insertDefaultDecls :: DefaultEnv -> [LocatedA ClassDefaults] -> TcM DefaultEnv +insertDefaultDecls = foldrM insertDefaultDecl +-- | Insert a local default declaration into the default environment. +-- +-- If the class already has a local default declaration in the DefaultEnv, +-- report an error and return the original DefaultEnv. Otherwise, override +-- any existing default declarations (e.g. imported default declarations). +-- +-- See Note [Disambiguation of multiple default declarations] in GHC.Tc.Module +insertDefaultDecl :: LocatedA ClassDefaults -> DefaultEnv -> TcM DefaultEnv +insertDefaultDecl (L decl_loc new_cls_defaults ) default_env = + case lookupDefaultEnv default_env (className cls) of + Just cls_defaults + | DP_Local {} <- cd_provenance cls_defaults + -> do { setSrcSpan (locA decl_loc) (addErrTc $ TcRnMultipleDefaultDeclarations cls cls_defaults) + ; return default_env } + _ -> return $ insertDefaultEnv new_cls_defaults default_env + -- NB: this overrides imported and built-in default declarations + -- for this class, if there were any. + where + cls = cd_class new_cls_defaults + -- | Check that the type is an instance of at least one of the default classes. -- @@ -289,10 +309,6 @@ simplifyDefault cls dflt_ty@(L l _) -> Nothing } -dupDefaultDeclErr :: Class -> NonEmpty (LDefaultDecl GhcRn) -> TcRnMessage -dupDefaultDeclErr cls (L _ DefaultDecl {} :| dup_things) - = TcRnMultipleDefaultDeclarations cls dup_things - {- Note [Instance check for default declarations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we see a named default declaration, such as: @@ -327,4 +343,4 @@ whether each type is an instance of: - ... or the IsString class, with -XOverloadedStrings - ... or any of the Show, Eq, Ord, Foldable, and Traversable classes, with -XExtendedDefaultRules --} \ No newline at end of file +-} ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -282,7 +282,7 @@ example, would import the above `default IsString (Text, String)` declaration into the importing module. -The `cd_module` field of `ClassDefaults` tracks the module whence the default was +The `cd_provenance` field of `ClassDefaults` tracks the module whence the default was imported from, for the purpose of warning reports. The said warning report may be triggered by `-Wtype-defaults` or by a user-defined `WARNING` pragma attached to the default export. In the latter case the warning text is stored in the ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -383,6 +383,7 @@ the actual contents of the module are wired in to GHC. -} {- Note [Disambiguation of multiple default declarations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ See Note [Named default declarations] in GHC.Tc.Gen.Default @@ -1811,9 +1812,8 @@ tcTyClsInstDecls tycl_decls deriv_decls default_decls binds -- -- But only after we've typechecked 'default' declarations. -- See Note [Typechecking default declarations] - defaults <- tcDefaults default_decls ; - updGblEnv (\gbl -> gbl { tcg_default = defaults }) $ do { - + defaults <- tcDefaultDecls default_decls + ; extendDefaultEnvWithLocalDefaults defaults $ do { -- Careful to quit now in case there were instance errors, so that -- the deriving errors don't pile up as well. ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -128,8 +128,7 @@ import GHC.Types.SourceFile import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Env -import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults(..), - defaultEnv, emptyDefaultEnv, lookupDefaultEnv, unitDefaultEnv ) +import GHC.Types.DefaultEnv import GHC.Types.Error import GHC.Types.Id import GHC.Types.Id.Info ( RecSelParent(..) ) @@ -971,21 +970,28 @@ isBrackStage _other = False ************************************************************************ -} -{- Note [Default class defaults] +{- Note [Builtin class defaults] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In absence of user-defined `default` declarations, the set of class defaults in -effect (i.e. `DefaultEnv`) is determined by the absence or -presence of the `ExtendedDefaultRules` and `OverloadedStrings` extensions. In their -absence, the only rule in effect is `default Num (Integer, Double)` as specified by -Haskell Language Report. - -In GHC's internal packages `DefaultEnv` is empty to minimize cross-module dependencies: -the `Num` class or `Integer` type may not even be available in low-level modules. If -you don't do this, attempted defaulting in package ghc-prim causes an actual crash -(attempting to look up the `Integer` type). - -A user-defined `default` declaration overrides the defaults for the specified class, -and only for that class. +In the absence of user-defined `default` declarations, the set of class defaults in +effect (i.e. the `DefaultEnv`) depends on whether the `ExtendedDefaultRules` and +`OverloadedStrings` extensions are enabled. In their absence, the only rule in effect +is `default Num (Integer, Double)`, as specified by the Haskell 2010 report. + +Remark [No built-in defaults in ghc-internal] + + When typechecking the ghc-internal package, we **do not** include any built-in + defaults. This is because, in ghc-internal, types such as 'Num' or 'Integer' may + not even be available (they haven't been typechecked yet). + +Remark [default () in ghc-internal] + + Historically, modules inside ghc-internal have used a single default declaration, + of the form `default ()`, to work around the problem described in + Remark [No built-in defaults in ghc-internal]. + + When we typecheck such a default declaration, we must also make sure not to fail + if e.g. 'Num' is not in scope. We thus have special treatment for this case, + in 'GHC.Tc.Gen.Default.tcDefaultDecls'. -} tcGetDefaultTys :: TcM (DefaultEnv, -- Default classes and types @@ -997,7 +1003,7 @@ tcGetDefaultTys -- See also #1974 builtinDefaults cls tys = ClassDefaults{ cd_class = cls , cd_types = tys - , cd_module = Nothing + , cd_provenance = DP_Builtin , cd_warn = Nothing } -- see Note [Named default declarations] in GHC.Tc.Gen.Default @@ -1005,7 +1011,8 @@ tcGetDefaultTys ; this_module <- tcg_mod <$> getGblEnv ; let this_unit = moduleUnit this_module ; if this_unit == ghcInternalUnit - -- see Note [Default class defaults] + -- see Remark [No built-in defaults in ghc-internal] + -- in Note [Builtin class defaults] in GHC.Tc.Utils.Env then return (defaults, extended_defaults) else do -- not one of the built-in units @@ -1037,6 +1044,8 @@ tcGetDefaultTys } -- The Num class is already user-defaulted, no need to construct the builtin default _ -> pure emptyDefaultEnv + -- Supply the built-in defaults, but make the user-supplied defaults + -- override them. ; let deflt_tys = mconcat [ extDef, numDef, ovlStr, defaults ] ; return (deflt_tys, extended_defaults) } } ===================================== compiler/GHC/Types/DefaultEnv.hs ===================================== @@ -1,7 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE LambdaCase #-} module GHC.Types.DefaultEnv ( ClassDefaults (..) + , DefaultProvenance (..) , DefaultEnv , emptyDefaultEnv , isEmptyDefaultEnv @@ -12,6 +14,8 @@ module GHC.Types.DefaultEnv , defaultList , plusDefaultEnv , mkDefaultEnv + , insertDefaultEnv + , isHaskell2010Default ) where @@ -22,6 +26,7 @@ import GHC.Tc.Utils.TcType (Type) import GHC.Types.Name (Name, nameUnique, stableNameCmp) import GHC.Types.Name.Env import GHC.Types.Unique.FM (lookupUFM_Directly) +import GHC.Types.SrcLoc (SrcSpan) import GHC.Unit.Module.Warnings (WarningTxt) import GHC.Unit.Types (Module) import GHC.Utils.Outputable @@ -37,13 +42,73 @@ import Data.Function (on) -- NB: this includes Haskell98 default declarations, at the 'Num' key. type DefaultEnv = NameEnv ClassDefaults +{- Note [DefaultProvenance] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Each `ClassDefault` is annotated with its `DefaultProvenance`, which +says where the default came from. Specifically +* `DP_Local loc h98`: the default came from an explicit `default` declaration in the module + being compiled, at location `loc`, and the boolean `h98` indicates whether + it was from a Haskell 98 default declaration (e.g. `default (Int, Double)`). +* `DP_Imported M`: the default was imported, it is explicitly exported by module `M`. +* `DP_Builtin`: the default was automatically provided by GHC. + see Note [Builtin class defaults] in GHC.Tc.Utils.Env + +These annotations are used to disambiguate multiple defaults for the same class. +For example, consider the following modules: + + module M( default C ) where { default C( ... ) } + module M2( default C) where { import M } + module N( default C () where { default C(... ) } + + module A where { import M2 } + module B where { import M2; import N } + module A1 where { import N; default C ( ... ) } + module B2 where { default C ( ... ); default C ( ... ) } + +When compiling N, the default for C is annotated with DP_Local loc. +When compiling M2, the default for C is annotated with DP_Local M. +When compiling A, the default for C is annotated with DP_Imported M2. + +Cases we needed to disambiguate: + * Compiling B, two defaults for C: DP_Imported M2, DP_Imported N. + * Compiling A1, two defaults for C: DP_Imported N, DP_Local loc. + * Compiling B2, two defaults for C: DP_Local loc1, DP_Local loc2. + +For how we disambiguate these cases, +See Note [Disambiguation of multiple default declarations] in GHC.Tc.Module. +-} + +-- | The provenance of a collection of default types for a class. +-- see Note [DefaultProvenance] for more details +data DefaultProvenance + -- | A locally defined default declaration. + = DP_Local + { defaultDeclLoc :: SrcSpan -- ^ The 'SrcSpan' of the default declaration + , defaultDeclH98 :: Bool -- ^ Is this a Haskell 98 default declaration? + } + -- | Built-in class defaults. + | DP_Builtin + -- | Imported class defaults. + | DP_Imported Module -- ^ The module from which the defaults were imported + deriving (Eq, Data) + +instance Outputable DefaultProvenance where + ppr (DP_Local loc h98) = ppr loc <> (if h98 then text " (H98)" else empty) + ppr DP_Builtin = text "built-in" + ppr (DP_Imported mod) = ppr mod + +isHaskell2010Default :: DefaultProvenance -> Bool +isHaskell2010Default = \case + DP_Local { defaultDeclH98 = isH98 } -> isH98 + DP_Builtin -> True + DP_Imported {} -> False + -- | Defaulting type assignments for the given class. data ClassDefaults = ClassDefaults { cd_class :: Class -- ^ The class whose defaults are being defined , cd_types :: [Type] - , cd_module :: Maybe Module - -- ^ @Nothing@ for built-in, - -- @Just@ the current module or the module whence the default was imported + , cd_provenance :: DefaultProvenance + -- ^ Where the defaults came from -- see Note [Default exports] in GHC.Tc.Gen.Export , cd_warn :: Maybe (WarningTxt GhcRn) -- ^ Warning emitted when the default is used @@ -70,6 +135,9 @@ defaultList :: DefaultEnv -> [ClassDefaults] defaultList = sortBy (stableNameCmp `on` className . cd_class) . nonDetNameEnvElts -- sortBy recovers determinism +insertDefaultEnv :: ClassDefaults -> DefaultEnv -> DefaultEnv +insertDefaultEnv d env = extendNameEnv env (className $ cd_class d) d + lookupDefaultEnv :: DefaultEnv -> Name -> Maybe ClassDefaults lookupDefaultEnv env = lookupUFM_Directly env . nameUnique ===================================== testsuite/tests/default/T25912.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE NamedDefaults #-} + +module Main where + +import T25912_helper + +-- now we declare the default instances +-- for the classes C again to check that +-- it won't hide the default instances for class B +default C (String) + +main :: IO () +main = do + print b ===================================== testsuite/tests/default/T25912.stdout ===================================== @@ -0,0 +1 @@ +"String" ===================================== testsuite/tests/default/T25912_helper.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE NamedDefaults #-} + +module T25912_helper ( default C, C(c), default B, b ) where + +class C a where + c :: a +instance C Int where + c = 1 +instance C String where + c = "String" +default C (String) + +class B a where + b :: a +instance B String where + b = "String" +default B (String) ===================================== testsuite/tests/default/T25914.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE NamedDefaults, OverloadedStrings #-} +module NamedDefaultsNum where +import Data.String +default Num () +foo = "abc" ===================================== testsuite/tests/default/T25934.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE NamedDefaults #-} +module T25934 where +default Num (Int) +default Show (Int) ===================================== testsuite/tests/default/all.T ===================================== @@ -39,3 +39,6 @@ test('T25858v2', [extra_files(['T25858v2_helper.hs'])], multimod_compile_and_run test('T25858v3', [extra_files(['T25858v3_helper.hs'])], multimod_compile_and_run, ['T25858v3', '']) test('T25858v4', normal, compile_and_run, ['']) test('T25882', normal, compile, ['']) +test('T25912', [extra_files(['T25912_helper.hs'])], multimod_compile_and_run, ['T25912', '']) +test('T25914', normal, compile, ['']) +test('T25934', normal, compile, ['']) ===================================== testsuite/tests/default/default-fail03.stderr ===================================== @@ -1,3 +1,4 @@ -default-fail03.hs:4:1: [GHC-99565] +default-fail03.hs:4:1: error: [GHC-99565] Multiple default declarations for class ‘Num’ - here was another default declaration default-fail03.hs:3:1-29 + conflicting named default declaration at: default-fail03.hs:3:1-29 + ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -8,7 +8,7 @@ ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4345:8: Note [Lambda-boun ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1387:37: Note [Gentle mode] ref compiler/GHC/Core/Opt/Specialise.hs:1761:29: Note [Arity decrease] ref compiler/GHC/Core/TyCo/Rep.hs:1783:31: Note [What prevents a constraint from floating] -ref compiler/GHC/Driver/DynFlags.hs:1216:52: Note [Eta-reduction in -O0] +ref compiler/GHC/Driver/DynFlags.hs:1218:52: Note [Eta-reduction in -O0] ref compiler/GHC/Driver/Main.hs:1901:34: Note [simpleTidyPgm - mkBootModDetailsTc] ref compiler/GHC/Hs/Expr.hs:189:63: Note [Pending Splices] ref compiler/GHC/Hs/Expr.hs:2194:87: Note [Lifecycle of a splice] @@ -18,10 +18,8 @@ ref compiler/GHC/Hs/Pat.hs:151:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Pmc/Solver.hs:860:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1533:7: Note [How brackets and nested splices are handled] ref compiler/GHC/Stg/Unarise.hs:457:32: Note [Renaming during unarisation] -ref compiler/GHC/Tc/Gen/Default.hs:87:6: Note [Disambiguation of multiple default declarations] -ref compiler/GHC/Tc/Gen/Default.hs:193:11: Note [Disambiguation of multiple default declarations] ref compiler/GHC/Tc/Gen/HsType.hs:563:56: Note [Skolem escape prevention] -ref compiler/GHC/Tc/Gen/HsType.hs:2693:7: Note [Matching a kind signature with a declaration] +ref compiler/GHC/Tc/Gen/HsType.hs:2717:7: Note [Matching a kind signature with a declaration] ref compiler/GHC/Tc/Gen/Pat.hs:284:20: Note [Typing patterns in pattern bindings] ref compiler/GHC/Tc/Gen/Pat.hs:1378:7: Note [Matching polytyped patterns] ref compiler/GHC/Tc/Gen/Sig.hs:91:10: Note [Overview of type signatures] @@ -30,8 +28,6 @@ ref compiler/GHC/Tc/Gen/Splice.hs:543:35: Note [PendingRnSplice] ref compiler/GHC/Tc/Gen/Splice.hs:670:7: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Gen/Splice.hs:909:11: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Instance/Family.hs:458:35: Note [Constrained family instances] -ref compiler/GHC/Tc/Module.hs:385:3: Note [Disambiguation of multiple default declarations] -ref compiler/GHC/Tc/Module.hs:420:7: Note [Disambiguation of multiple default declarations] ref compiler/GHC/Tc/Solver/Rewrite.hs:1015:7: Note [Stability of rewriting] ref compiler/GHC/Tc/TyCl.hs:1322:6: Note [Unification variables need fresh Names] ref compiler/GHC/Tc/Types/Constraint.hs:209:9: Note [NonCanonical Semantics] ===================================== testsuite/tests/module/mod58.stderr ===================================== @@ -1,4 +1,4 @@ - mod58.hs:4:1: error: [GHC-99565] Multiple default declarations for class ‘Num’ - here was another default declaration mod58.hs:3:1-21 + conflicting default declaration at: mod58.hs:3:1-21 + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0f3ff11719f1ee343d1b5d1fd3193d9... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0f3ff11719f1ee343d1b5d1fd3193d9... You're receiving this email because of your account on gitlab.haskell.org.