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.
