Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
-
e0f3ff11
by Patrick at 2025-04-17T04:31:12-04:00
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:
| ... | ... | @@ -118,7 +118,7 @@ import GHC.Types.Var.Set |
| 118 | 118 | import GHC.Types.Name
|
| 119 | 119 | import GHC.Types.Name.Set
|
| 120 | 120 | import GHC.Types.Name.Env
|
| 121 | -import GHC.Types.DefaultEnv ( ClassDefaults(..), DefaultEnv, mkDefaultEnv )
|
|
| 121 | +import GHC.Types.DefaultEnv ( ClassDefaults(..), DefaultEnv, mkDefaultEnv, DefaultProvenance(..) )
|
|
| 122 | 122 | import GHC.Types.Id
|
| 123 | 123 | import GHC.Types.Id.Make
|
| 124 | 124 | import GHC.Types.Id.Info
|
| ... | ... | @@ -1333,7 +1333,7 @@ tcIfaceDefault this_mod IfaceDefault { ifDefaultCls = cls_name |
| 1333 | 1333 | ; let warn = fmap fromIfaceWarningTxt iface_warn
|
| 1334 | 1334 | ; return ClassDefaults { cd_class = cls
|
| 1335 | 1335 | , cd_types = tys'
|
| 1336 | - , cd_module = Just this_mod
|
|
| 1336 | + , cd_provenance = DP_Imported this_mod
|
|
| 1337 | 1337 | , cd_warn = warn } }
|
| 1338 | 1338 | where
|
| 1339 | 1339 | tyThingConClass :: TyThing -> Class
|
| ... | ... | @@ -85,7 +85,7 @@ import GHC.Tc.Types.Rank (Rank(..)) |
| 85 | 85 | import GHC.Tc.Types.TH
|
| 86 | 86 | import GHC.Tc.Utils.TcType
|
| 87 | 87 | |
| 88 | -import GHC.Types.DefaultEnv (ClassDefaults(ClassDefaults, cd_types, cd_module))
|
|
| 88 | +import GHC.Types.DefaultEnv (ClassDefaults(ClassDefaults, cd_types, cd_provenance), DefaultProvenance (..))
|
|
| 89 | 89 | import GHC.Types.Error
|
| 90 | 90 | import GHC.Types.Error.Codes
|
| 91 | 91 | import GHC.Types.Hint
|
| ... | ... | @@ -582,11 +582,19 @@ instance Diagnostic TcRnMessage where |
| 582 | 582 | TcRnMultipleDefaultDeclarations cls dup_things
|
| 583 | 583 | -> mkSimpleDecorated $
|
| 584 | 584 | hang (text "Multiple default declarations for class" <+> quotes (ppr cls))
|
| 585 | - 2 (vcat (map pp dup_things))
|
|
| 585 | + 2 (pp dup_things)
|
|
| 586 | 586 | where
|
| 587 | - pp :: LDefaultDecl GhcRn -> SDoc
|
|
| 588 | - pp (L locn DefaultDecl {})
|
|
| 589 | - = text "here was another default declaration" <+> ppr (locA locn)
|
|
| 587 | + pp :: ClassDefaults -> SDoc
|
|
| 588 | + pp (ClassDefaults { cd_provenance = prov })
|
|
| 589 | + = case prov of
|
|
| 590 | + DP_Local { defaultDeclLoc = loc, defaultDeclH98 = isH98 }
|
|
| 591 | + -> let
|
|
| 592 | + what =
|
|
| 593 | + if isH98
|
|
| 594 | + then text "default declaration"
|
|
| 595 | + else text "named default declaration"
|
|
| 596 | + in text "conflicting" <+> what <+> text "at:" <+> ppr loc
|
|
| 597 | + _ -> empty -- doesn't happen, as local defaults override imported and built-in defaults
|
|
| 590 | 598 | TcRnBadDefaultType ty deflt_clss
|
| 591 | 599 | -> mkSimpleDecorated $
|
| 592 | 600 | 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 = |
| 7139 | 7147 | --------------------------------------------------------------------------------
|
| 7140 | 7148 | |
| 7141 | 7149 | defaultTypesAndImport :: ClassDefaults -> SDoc
|
| 7142 | -defaultTypesAndImport ClassDefaults{cd_types, cd_module = Just cdm} =
|
|
| 7150 | +defaultTypesAndImport ClassDefaults{cd_types, cd_provenance = DP_Imported cdm} =
|
|
| 7143 | 7151 | hang (parens $ pprWithCommas ppr cd_types)
|
| 7144 | 7152 | 2 (text "imported from" <+> ppr cdm)
|
| 7145 | 7153 | defaultTypesAndImport ClassDefaults{cd_types} = parens (pprWithCommas ppr cd_types)
|
| ... | ... | @@ -1504,7 +1504,7 @@ data TcRnMessage where |
| 1504 | 1504 | |
| 1505 | 1505 | Text cases: module/mod58
|
| 1506 | 1506 | -}
|
| 1507 | - TcRnMultipleDefaultDeclarations :: Class -> [LDefaultDecl GhcRn] -> TcRnMessage
|
|
| 1507 | + TcRnMultipleDefaultDeclarations :: Class -> ClassDefaults -> TcRnMessage
|
|
| 1508 | 1508 | |
| 1509 | 1509 | {-| TcRnWarnClashingDefaultImports is a warning that occurs when a module imports
|
| 1510 | 1510 | more than one default declaration for the same class, and they are not all
|
| ... | ... | @@ -5,9 +5,10 @@ |
| 5 | 5 | -}
|
| 6 | 6 | {-# LANGUAGE MultiWayIf #-}
|
| 7 | 7 | {-# LANGUAGE TypeFamilies #-}
|
| 8 | +{-# LANGUAGE LambdaCase #-}
|
|
| 8 | 9 | |
| 9 | 10 | -- | Typechecking @default@ declarations
|
| 10 | -module GHC.Tc.Gen.Default ( tcDefaults ) where
|
|
| 11 | +module GHC.Tc.Gen.Default ( tcDefaultDecls, extendDefaultEnvWithLocalDefaults ) where
|
|
| 11 | 12 | |
| 12 | 13 | import GHC.Prelude
|
| 13 | 14 | import GHC.Hs
|
| ... | ... | @@ -16,7 +17,7 @@ import GHC.Builtin.Names |
| 16 | 17 | import GHC.Core.Class
|
| 17 | 18 | import GHC.Core.Predicate ( Pred (..), classifyPredType )
|
| 18 | 19 | |
| 19 | -import GHC.Data.Maybe ( firstJusts )
|
|
| 20 | +import GHC.Data.Maybe ( firstJusts, maybeToList )
|
|
| 20 | 21 | |
| 21 | 22 | import GHC.Tc.Errors.Types
|
| 22 | 23 | import GHC.Tc.Gen.HsType
|
| ... | ... | @@ -30,20 +31,17 @@ import GHC.Tc.Utils.TcMType ( newWanted ) |
| 30 | 31 | import GHC.Tc.Utils.TcType
|
| 31 | 32 | |
| 32 | 33 | import GHC.Types.Basic ( TypeOrKind(..) )
|
| 33 | -import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults (..), defaultEnv )
|
|
| 34 | +import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults (..), lookupDefaultEnv, insertDefaultEnv, DefaultProvenance (..) )
|
|
| 34 | 35 | import GHC.Types.SrcLoc
|
| 35 | 36 | |
| 36 | -import GHC.Unit.Types (Module, ghcInternalUnit, moduleUnit)
|
|
| 37 | +import GHC.Unit.Types (ghcInternalUnit, moduleUnit)
|
|
| 37 | 38 | |
| 38 | -import GHC.Utils.Misc (fstOf3, sndOf3)
|
|
| 39 | 39 | import GHC.Utils.Outputable
|
| 40 | 40 | |
| 41 | 41 | import qualified GHC.LanguageExtensions as LangExt
|
| 42 | 42 | |
| 43 | -import Data.Function (on)
|
|
| 44 | -import Data.List.NonEmpty ( NonEmpty (..), groupBy )
|
|
| 43 | +import Data.List.NonEmpty ( NonEmpty (..) )
|
|
| 45 | 44 | import qualified Data.List.NonEmpty as NE
|
| 46 | -import Data.Maybe (fromMaybe)
|
|
| 47 | 45 | import Data.Traversable ( for )
|
| 48 | 46 | |
| 49 | 47 | {- Note [Named default declarations]
|
| ... | ... | @@ -86,7 +84,7 @@ The moving parts are as follows: |
| 86 | 84 | * The `DefaultEnv` of all defaults in scope in a module is kept in the `tcg_default`
|
| 87 | 85 | field of `TcGblEnv`.
|
| 88 | 86 | |
| 89 | -* This field is populated by `GHC.Tc.Gen.Default.tcDefaults` which typechecks
|
|
| 87 | +* This field is populated by `GHC.Tc.Gen.Default.tcDefaultDecls` which typechecks
|
|
| 90 | 88 | any local or imported `default` declarations.
|
| 91 | 89 | |
| 92 | 90 | * Only a single default declaration can be in effect in any single module for
|
| ... | ... | @@ -103,7 +101,7 @@ The moving parts are as follows: |
| 103 | 101 | in effect be `default Num (Integer, Double)` as specified by Haskell Language
|
| 104 | 102 | Report.
|
| 105 | 103 | |
| 106 | - See Note [Default class defaults] in GHC.Tc.Utils.Env
|
|
| 104 | + See Note [Builtin class defaults] in GHC.Tc.Utils.Env
|
|
| 107 | 105 | |
| 108 | 106 | * Beside the defaults, the `ExtendedDefaultRules` and `OverloadedStrings`
|
| 109 | 107 | extensions also affect the traditional `default` declarations that don't name
|
| ... | ... | @@ -120,61 +118,54 @@ The moving parts are as follows: |
| 120 | 118 | tracked separately from `ImportAvails`, and returned separately from them by
|
| 121 | 119 | `GHC.Rename.Names.rnImports`.
|
| 122 | 120 | |
| 123 | -* Class defaults are exported explicitly, as the example above shows. A module's
|
|
| 124 | - exported defaults are tracked in `tcg_default_exports`, which are then
|
|
| 125 | - transferred to `mg_defaults`, `md_defaults`, and `mi_defaults_`.
|
|
| 121 | +* Class defaults are exported explicitly.
|
|
| 122 | + For example,
|
|
| 123 | + module M( ..., default C, ... )
|
|
| 124 | + exports the defaults for class C.
|
|
| 125 | + |
|
| 126 | + A module's exported defaults are computed by exports_from_avail,
|
|
| 127 | + tracked in tcg_default_exports, which are then transferred to mg_defaults,
|
|
| 128 | + md_defaults, and mi_defaults_.
|
|
| 129 | + |
|
| 130 | + Only defaults explicitly exported are actually exported.
|
|
| 131 | + (i.e. No defaults are exported in a module header like:
|
|
| 132 | + module M where ...)
|
|
| 133 | + |
|
| 126 | 134 | See Note [Default exports] in GHC.Tc.Gen.Export
|
| 127 | 135 | |
| 128 | 136 | * Since the class defaults merely help the solver infer the correct types, they
|
| 129 | 137 | leave no trace in Haskell Core.
|
| 130 | 138 | -}
|
| 131 | 139 | |
| 132 | --- See Note [Named default declarations]
|
|
| 133 | -tcDefaults :: [LDefaultDecl GhcRn]
|
|
| 134 | - -> TcM DefaultEnv -- Defaulting types to heave
|
|
| 135 | - -- into Tc monad for later use
|
|
| 136 | - -- in Disambig.
|
|
| 137 | - |
|
| 138 | -tcDefaults []
|
|
| 139 | - = getDeclaredDefaultTys -- No default declaration, so get the
|
|
| 140 | - -- default types from the envt;
|
|
| 141 | - -- i.e. use the current ones
|
|
| 142 | - -- (the caller will put them back there)
|
|
| 143 | - -- It's important not to return defaultDefaultTys here (which
|
|
| 144 | - -- we used to do) because in a TH program, tcDefaults [] is called
|
|
| 145 | - -- repeatedly, once for each group of declarations between top-level
|
|
| 146 | - -- splices. We don't want to carefully set the default types in
|
|
| 147 | - -- one group, only for the next group to ignore them and install
|
|
| 148 | - -- defaultDefaultTys
|
|
| 149 | - |
|
| 150 | -tcDefaults decls
|
|
| 151 | - = do { tcg_env <- getGblEnv
|
|
| 152 | - ; let
|
|
| 153 | - here = tcg_mod tcg_env
|
|
| 154 | - is_internal_unit = moduleUnit here == ghcInternalUnit
|
|
| 155 | - ; case (is_internal_unit, decls) of
|
|
| 156 | - -- Some internal GHC modules contain @default ()@ to declare that no defaults can take place
|
|
| 157 | - -- in the module.
|
|
| 158 | - -- We shortcut the treatment of such a default declaration with no class nor types: we won't
|
|
| 159 | - -- try to point 'cd_class' to 'Num' since it may not even exist yet.
|
|
| 160 | - { (True, [L _ (DefaultDecl _ Nothing [])])
|
|
| 161 | - -> return $ defaultEnv []
|
|
| 162 | - -- Otherwise we take apart the declaration into the class constructor and its default types.
|
|
| 163 | - ; _ ->
|
|
| 164 | - do { h2010_dflt_clss <- getH2010DefaultClasses
|
|
| 165 | - ; decls' <- mapMaybeM (declarationParts h2010_dflt_clss) decls
|
|
| 166 | - ; let
|
|
| 167 | - -- Find duplicate default declarations
|
|
| 168 | - decl_tag (mb_cls, _, _) =
|
|
| 169 | - case mb_cls of
|
|
| 170 | - Nothing -> Nothing
|
|
| 171 | - Just cls -> if cls `elem` h2010_dflt_clss
|
|
| 172 | - then Nothing
|
|
| 173 | - else Just cls
|
|
| 174 | - decl_groups = groupBy ((==) `on` decl_tag) decls'
|
|
| 175 | - ; decls_without_dups <- mapM (reportDuplicates here h2010_dflt_clss) decl_groups
|
|
| 176 | - ; return $ defaultEnv (concat decls_without_dups)
|
|
| 177 | - } } }
|
|
| 140 | +-- | Typecheck a collection of default declarations. These can be either:
|
|
| 141 | +--
|
|
| 142 | +-- - Haskell 98 default declarations, of the form @default (Float, Double)@
|
|
| 143 | +-- - Named default declarations, of the form @default Cls(Int, Char)@.
|
|
| 144 | +-- See Note [Named default declarations]
|
|
| 145 | +tcDefaultDecls :: [LDefaultDecl GhcRn] -> TcM [LocatedA ClassDefaults]
|
|
| 146 | +tcDefaultDecls decls =
|
|
| 147 | + do
|
|
| 148 | + tcg_env <- getGblEnv
|
|
| 149 | + let here = tcg_mod tcg_env
|
|
| 150 | + is_internal_unit = moduleUnit here == ghcInternalUnit
|
|
| 151 | + case (is_internal_unit, decls) of
|
|
| 152 | + -- No default declarations
|
|
| 153 | + (_, []) -> return []
|
|
| 154 | + -- As per Remark [default () in ghc-internal] in Note [Builtin class defaults],
|
|
| 155 | + -- some modules in ghc-internal include an empty `default ()` declaration, in order
|
|
| 156 | + -- to disable built-in defaults. This is no longer necessary (see `GHC.Tc.Utils.Env.tcGetDefaultTys`),
|
|
| 157 | + -- but we must still make sure not to error if we fail to look up e.g. the 'Num'
|
|
| 158 | + -- typeclass when typechecking such a default declaration. To do this, we wrap
|
|
| 159 | + -- calls of 'tcLookupClass' in 'tryTc'.
|
|
| 160 | + (True, [L _ (DefaultDecl _ Nothing [])]) -> do
|
|
| 161 | + h2010_dflt_clss <- foldMapM (fmap maybeToList . fmap fst . tryTc . tcLookupClass) =<< getH2010DefaultNames
|
|
| 162 | + case NE.nonEmpty h2010_dflt_clss of
|
|
| 163 | + Nothing -> return []
|
|
| 164 | + Just h2010_dflt_clss' -> toClassDefaults h2010_dflt_clss' decls
|
|
| 165 | + -- Otherwise we take apart the declaration into the class constructor and its default types.
|
|
| 166 | + _ -> do
|
|
| 167 | + h2010_dflt_clss <- getH2010DefaultClasses
|
|
| 168 | + toClassDefaults h2010_dflt_clss decls
|
|
| 178 | 169 | where
|
| 179 | 170 | getH2010DefaultClasses :: TcM (NonEmpty Class)
|
| 180 | 171 | -- All the classes subject to defaulting with a Haskell 2010 default
|
| ... | ... | @@ -186,18 +177,18 @@ tcDefaults decls |
| 186 | 177 | -- No extensions: Num
|
| 187 | 178 | -- OverloadedStrings: add IsString
|
| 188 | 179 | -- ExtendedDefaults: add Show, Eq, Ord, Foldable, Traversable
|
| 189 | - getH2010DefaultClasses
|
|
| 190 | - = do { num_cls <- tcLookupClass numClassName
|
|
| 191 | - ; ovl_str <- xoptM LangExt.OverloadedStrings
|
|
| 180 | + getH2010DefaultClasses = mapM tcLookupClass =<< getH2010DefaultNames
|
|
| 181 | + getH2010DefaultNames
|
|
| 182 | + = do { ovl_str <- xoptM LangExt.OverloadedStrings
|
|
| 192 | 183 | ; ext_deflt <- xoptM LangExt.ExtendedDefaultRules
|
| 193 | - ; deflt_str <- if ovl_str
|
|
| 194 | - then mapM tcLookupClass [isStringClassName]
|
|
| 195 | - else return []
|
|
| 196 | - ; deflt_interactive <- if ext_deflt
|
|
| 197 | - then mapM tcLookupClass interactiveClassNames
|
|
| 198 | - else return []
|
|
| 199 | - ; let extra_clss = deflt_str ++ deflt_interactive
|
|
| 200 | - ; return $ num_cls :| extra_clss
|
|
| 184 | + ; let deflt_str = if ovl_str
|
|
| 185 | + then [isStringClassName]
|
|
| 186 | + else []
|
|
| 187 | + ; let deflt_interactive = if ext_deflt
|
|
| 188 | + then interactiveClassNames
|
|
| 189 | + else []
|
|
| 190 | + ; let extra_clss_names = deflt_str ++ deflt_interactive
|
|
| 191 | + ; return $ numClassName :| extra_clss_names
|
|
| 201 | 192 | }
|
| 202 | 193 | declarationParts :: NonEmpty Class -> LDefaultDecl GhcRn -> TcM (Maybe (Maybe Class, LDefaultDecl GhcRn, [Type]))
|
| 203 | 194 | declarationParts h2010_dflt_clss decl@(L locn (DefaultDecl _ mb_cls_name dflt_hs_tys))
|
| ... | ... | @@ -220,20 +211,49 @@ tcDefaults decls |
| 220 | 211 | ; return (Just cls, decl, tau_tys)
|
| 221 | 212 | } }
|
| 222 | 213 | |
| 223 | - reportDuplicates :: Module -> NonEmpty Class -> NonEmpty (Maybe Class, LDefaultDecl GhcRn, [Type]) -> TcM [ClassDefaults]
|
|
| 224 | - reportDuplicates here h2010_dflt_clss ((mb_cls, _, tys) :| [])
|
|
| 225 | - = pure [ ClassDefaults{cd_class = c, cd_types = tys, cd_module = Just here, cd_warn = Nothing }
|
|
| 226 | - | c <- case mb_cls of
|
|
| 227 | - Nothing -> NE.toList h2010_dflt_clss
|
|
| 228 | - Just cls -> [cls]
|
|
| 229 | - ]
|
|
| 230 | - -- Report an error on multiple default declarations for the same class in the same module.
|
|
| 231 | - -- See Note [Disambiguation of multiple default declarations] in GHC.Tc.Module
|
|
| 232 | - reportDuplicates _ (num_cls :| _) decls@((_, L locn _, _) :| _)
|
|
| 233 | - = setSrcSpan (locA locn) (addErrTc $ dupDefaultDeclErr cls (sndOf3 <$> decls))
|
|
| 234 | - >> pure []
|
|
| 214 | + toClassDefaults :: NonEmpty Class -> [LDefaultDecl GhcRn] -> TcM [LocatedA ClassDefaults]
|
|
| 215 | + toClassDefaults h2010_dflt_clss dfs = do
|
|
| 216 | + dfs <- mapMaybeM (declarationParts h2010_dflt_clss) dfs
|
|
| 217 | + return $ concatMap (go False) dfs
|
|
| 235 | 218 | where
|
| 236 | - cls = fromMaybe num_cls $ firstJusts (fmap fstOf3 decls)
|
|
| 219 | + go h98 = \case
|
|
| 220 | + (Nothing, rn_decl, tys) -> concatMap (go True) [(Just cls, rn_decl, tys) | cls <- NE.toList h2010_dflt_clss]
|
|
| 221 | + (Just cls, (L locn _), tys) -> [(L locn $ ClassDefaults cls tys (DP_Local (locA locn) h98) Nothing)]
|
|
| 222 | + |
|
| 223 | +-- | Extend the default environment with the local default declarations
|
|
| 224 | +-- and do the action in the extended environment.
|
|
| 225 | +extendDefaultEnvWithLocalDefaults :: [LocatedA ClassDefaults] -> TcM a -> TcM a
|
|
| 226 | +extendDefaultEnvWithLocalDefaults decls action = do
|
|
| 227 | + tcg_env <- getGblEnv
|
|
| 228 | + let default_env = tcg_default tcg_env
|
|
| 229 | + new_default_env <- insertDefaultDecls default_env decls
|
|
| 230 | + updGblEnv (\gbl -> gbl { tcg_default = new_default_env } ) $ action
|
|
| 231 | + |
|
| 232 | +-- | Insert local default declarations into the default environment.
|
|
| 233 | +--
|
|
| 234 | +-- See 'insertDefaultDecl'.
|
|
| 235 | +insertDefaultDecls :: DefaultEnv -> [LocatedA ClassDefaults] -> TcM DefaultEnv
|
|
| 236 | +insertDefaultDecls = foldrM insertDefaultDecl
|
|
| 237 | +-- | Insert a local default declaration into the default environment.
|
|
| 238 | +--
|
|
| 239 | +-- If the class already has a local default declaration in the DefaultEnv,
|
|
| 240 | +-- report an error and return the original DefaultEnv. Otherwise, override
|
|
| 241 | +-- any existing default declarations (e.g. imported default declarations).
|
|
| 242 | +--
|
|
| 243 | +-- See Note [Disambiguation of multiple default declarations] in GHC.Tc.Module
|
|
| 244 | +insertDefaultDecl :: LocatedA ClassDefaults -> DefaultEnv -> TcM DefaultEnv
|
|
| 245 | +insertDefaultDecl (L decl_loc new_cls_defaults ) default_env =
|
|
| 246 | + case lookupDefaultEnv default_env (className cls) of
|
|
| 247 | + Just cls_defaults
|
|
| 248 | + | DP_Local {} <- cd_provenance cls_defaults
|
|
| 249 | + -> do { setSrcSpan (locA decl_loc) (addErrTc $ TcRnMultipleDefaultDeclarations cls cls_defaults)
|
|
| 250 | + ; return default_env }
|
|
| 251 | + _ -> return $ insertDefaultEnv new_cls_defaults default_env
|
|
| 252 | + -- NB: this overrides imported and built-in default declarations
|
|
| 253 | + -- for this class, if there were any.
|
|
| 254 | + where
|
|
| 255 | + cls = cd_class new_cls_defaults
|
|
| 256 | + |
|
| 237 | 257 | |
| 238 | 258 | -- | Check that the type is an instance of at least one of the default classes.
|
| 239 | 259 | --
|
| ... | ... | @@ -289,10 +309,6 @@ simplifyDefault cls dflt_ty@(L l _) |
| 289 | 309 | -> Nothing
|
| 290 | 310 | }
|
| 291 | 311 | |
| 292 | -dupDefaultDeclErr :: Class -> NonEmpty (LDefaultDecl GhcRn) -> TcRnMessage
|
|
| 293 | -dupDefaultDeclErr cls (L _ DefaultDecl {} :| dup_things)
|
|
| 294 | - = TcRnMultipleDefaultDeclarations cls dup_things
|
|
| 295 | - |
|
| 296 | 312 | {- Note [Instance check for default declarations]
|
| 297 | 313 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
| 298 | 314 | When we see a named default declaration, such as:
|
| ... | ... | @@ -327,4 +343,4 @@ whether each type is an instance of: |
| 327 | 343 | - ... or the IsString class, with -XOverloadedStrings
|
| 328 | 344 | - ... or any of the Show, Eq, Ord, Foldable, and Traversable classes,
|
| 329 | 345 | with -XExtendedDefaultRules
|
| 330 | --} |
|
| \ No newline at end of file | ||
| 346 | +-} |
| ... | ... | @@ -282,7 +282,7 @@ example, |
| 282 | 282 | would import the above `default IsString (Text, String)` declaration into the
|
| 283 | 283 | importing module.
|
| 284 | 284 | |
| 285 | -The `cd_module` field of `ClassDefaults` tracks the module whence the default was
|
|
| 285 | +The `cd_provenance` field of `ClassDefaults` tracks the module whence the default was
|
|
| 286 | 286 | imported from, for the purpose of warning reports. The said warning report may be
|
| 287 | 287 | triggered by `-Wtype-defaults` or by a user-defined `WARNING` pragma attached to
|
| 288 | 288 | the default export. In the latter case the warning text is stored in the
|
| ... | ... | @@ -383,6 +383,7 @@ the actual contents of the module are wired in to GHC. |
| 383 | 383 | -}
|
| 384 | 384 | |
| 385 | 385 | {- Note [Disambiguation of multiple default declarations]
|
| 386 | +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
| 386 | 387 | |
| 387 | 388 | See Note [Named default declarations] in GHC.Tc.Gen.Default
|
| 388 | 389 | |
| ... | ... | @@ -1811,9 +1812,8 @@ tcTyClsInstDecls tycl_decls deriv_decls default_decls binds |
| 1811 | 1812 | --
|
| 1812 | 1813 | -- But only after we've typechecked 'default' declarations.
|
| 1813 | 1814 | -- See Note [Typechecking default declarations]
|
| 1814 | - defaults <- tcDefaults default_decls ;
|
|
| 1815 | - updGblEnv (\gbl -> gbl { tcg_default = defaults }) $ do {
|
|
| 1816 | - |
|
| 1815 | + defaults <- tcDefaultDecls default_decls
|
|
| 1816 | + ; extendDefaultEnvWithLocalDefaults defaults $ do {
|
|
| 1817 | 1817 | |
| 1818 | 1818 | -- Careful to quit now in case there were instance errors, so that
|
| 1819 | 1819 | -- the deriving errors don't pile up as well.
|
| ... | ... | @@ -128,8 +128,7 @@ import GHC.Types.SourceFile |
| 128 | 128 | import GHC.Types.Name
|
| 129 | 129 | import GHC.Types.Name.Set
|
| 130 | 130 | import GHC.Types.Name.Env
|
| 131 | -import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults(..),
|
|
| 132 | - defaultEnv, emptyDefaultEnv, lookupDefaultEnv, unitDefaultEnv )
|
|
| 131 | +import GHC.Types.DefaultEnv
|
|
| 133 | 132 | import GHC.Types.Error
|
| 134 | 133 | import GHC.Types.Id
|
| 135 | 134 | import GHC.Types.Id.Info ( RecSelParent(..) )
|
| ... | ... | @@ -971,21 +970,28 @@ isBrackStage _other = False |
| 971 | 970 | ************************************************************************
|
| 972 | 971 | -}
|
| 973 | 972 | |
| 974 | -{- Note [Default class defaults]
|
|
| 973 | +{- Note [Builtin class defaults]
|
|
| 975 | 974 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
| 976 | -In absence of user-defined `default` declarations, the set of class defaults in
|
|
| 977 | -effect (i.e. `DefaultEnv`) is determined by the absence or
|
|
| 978 | -presence of the `ExtendedDefaultRules` and `OverloadedStrings` extensions. In their
|
|
| 979 | -absence, the only rule in effect is `default Num (Integer, Double)` as specified by
|
|
| 980 | -Haskell Language Report.
|
|
| 981 | - |
|
| 982 | -In GHC's internal packages `DefaultEnv` is empty to minimize cross-module dependencies:
|
|
| 983 | -the `Num` class or `Integer` type may not even be available in low-level modules. If
|
|
| 984 | -you don't do this, attempted defaulting in package ghc-prim causes an actual crash
|
|
| 985 | -(attempting to look up the `Integer` type).
|
|
| 986 | - |
|
| 987 | -A user-defined `default` declaration overrides the defaults for the specified class,
|
|
| 988 | -and only for that class.
|
|
| 975 | +In the absence of user-defined `default` declarations, the set of class defaults in
|
|
| 976 | +effect (i.e. the `DefaultEnv`) depends on whether the `ExtendedDefaultRules` and
|
|
| 977 | +`OverloadedStrings` extensions are enabled. In their absence, the only rule in effect
|
|
| 978 | +is `default Num (Integer, Double)`, as specified by the Haskell 2010 report.
|
|
| 979 | + |
|
| 980 | +Remark [No built-in defaults in ghc-internal]
|
|
| 981 | + |
|
| 982 | + When typechecking the ghc-internal package, we **do not** include any built-in
|
|
| 983 | + defaults. This is because, in ghc-internal, types such as 'Num' or 'Integer' may
|
|
| 984 | + not even be available (they haven't been typechecked yet).
|
|
| 985 | + |
|
| 986 | +Remark [default () in ghc-internal]
|
|
| 987 | + |
|
| 988 | + Historically, modules inside ghc-internal have used a single default declaration,
|
|
| 989 | + of the form `default ()`, to work around the problem described in
|
|
| 990 | + Remark [No built-in defaults in ghc-internal].
|
|
| 991 | + |
|
| 992 | + When we typecheck such a default declaration, we must also make sure not to fail
|
|
| 993 | + if e.g. 'Num' is not in scope. We thus have special treatment for this case,
|
|
| 994 | + in 'GHC.Tc.Gen.Default.tcDefaultDecls'.
|
|
| 989 | 995 | -}
|
| 990 | 996 | |
| 991 | 997 | tcGetDefaultTys :: TcM (DefaultEnv, -- Default classes and types
|
| ... | ... | @@ -997,7 +1003,7 @@ tcGetDefaultTys |
| 997 | 1003 | -- See also #1974
|
| 998 | 1004 | builtinDefaults cls tys = ClassDefaults{ cd_class = cls
|
| 999 | 1005 | , cd_types = tys
|
| 1000 | - , cd_module = Nothing
|
|
| 1006 | + , cd_provenance = DP_Builtin
|
|
| 1001 | 1007 | , cd_warn = Nothing }
|
| 1002 | 1008 | |
| 1003 | 1009 | -- see Note [Named default declarations] in GHC.Tc.Gen.Default
|
| ... | ... | @@ -1005,7 +1011,8 @@ tcGetDefaultTys |
| 1005 | 1011 | ; this_module <- tcg_mod <$> getGblEnv
|
| 1006 | 1012 | ; let this_unit = moduleUnit this_module
|
| 1007 | 1013 | ; if this_unit == ghcInternalUnit
|
| 1008 | - -- see Note [Default class defaults]
|
|
| 1014 | + -- see Remark [No built-in defaults in ghc-internal]
|
|
| 1015 | + -- in Note [Builtin class defaults] in GHC.Tc.Utils.Env
|
|
| 1009 | 1016 | then return (defaults, extended_defaults)
|
| 1010 | 1017 | else do
|
| 1011 | 1018 | -- not one of the built-in units
|
| ... | ... | @@ -1037,6 +1044,8 @@ tcGetDefaultTys |
| 1037 | 1044 | }
|
| 1038 | 1045 | -- The Num class is already user-defaulted, no need to construct the builtin default
|
| 1039 | 1046 | _ -> pure emptyDefaultEnv
|
| 1047 | + -- Supply the built-in defaults, but make the user-supplied defaults
|
|
| 1048 | + -- override them.
|
|
| 1040 | 1049 | ; let deflt_tys = mconcat [ extDef, numDef, ovlStr, defaults ]
|
| 1041 | 1050 | ; return (deflt_tys, extended_defaults) } }
|
| 1042 | 1051 |
| 1 | 1 | {-# LANGUAGE DeriveDataTypeable #-}
|
| 2 | +{-# LANGUAGE LambdaCase #-}
|
|
| 2 | 3 | |
| 3 | 4 | module GHC.Types.DefaultEnv
|
| 4 | 5 | ( ClassDefaults (..)
|
| 6 | + , DefaultProvenance (..)
|
|
| 5 | 7 | , DefaultEnv
|
| 6 | 8 | , emptyDefaultEnv
|
| 7 | 9 | , isEmptyDefaultEnv
|
| ... | ... | @@ -12,6 +14,8 @@ module GHC.Types.DefaultEnv |
| 12 | 14 | , defaultList
|
| 13 | 15 | , plusDefaultEnv
|
| 14 | 16 | , mkDefaultEnv
|
| 17 | + , insertDefaultEnv
|
|
| 18 | + , isHaskell2010Default
|
|
| 15 | 19 | )
|
| 16 | 20 | where
|
| 17 | 21 | |
| ... | ... | @@ -22,6 +26,7 @@ import GHC.Tc.Utils.TcType (Type) |
| 22 | 26 | import GHC.Types.Name (Name, nameUnique, stableNameCmp)
|
| 23 | 27 | import GHC.Types.Name.Env
|
| 24 | 28 | import GHC.Types.Unique.FM (lookupUFM_Directly)
|
| 29 | +import GHC.Types.SrcLoc (SrcSpan)
|
|
| 25 | 30 | import GHC.Unit.Module.Warnings (WarningTxt)
|
| 26 | 31 | import GHC.Unit.Types (Module)
|
| 27 | 32 | import GHC.Utils.Outputable
|
| ... | ... | @@ -37,13 +42,73 @@ import Data.Function (on) |
| 37 | 42 | -- NB: this includes Haskell98 default declarations, at the 'Num' key.
|
| 38 | 43 | type DefaultEnv = NameEnv ClassDefaults
|
| 39 | 44 | |
| 45 | +{- Note [DefaultProvenance]
|
|
| 46 | +~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
| 47 | +Each `ClassDefault` is annotated with its `DefaultProvenance`, which
|
|
| 48 | +says where the default came from. Specifically
|
|
| 49 | +* `DP_Local loc h98`: the default came from an explicit `default` declaration in the module
|
|
| 50 | + being compiled, at location `loc`, and the boolean `h98` indicates whether
|
|
| 51 | + it was from a Haskell 98 default declaration (e.g. `default (Int, Double)`).
|
|
| 52 | +* `DP_Imported M`: the default was imported, it is explicitly exported by module `M`.
|
|
| 53 | +* `DP_Builtin`: the default was automatically provided by GHC.
|
|
| 54 | + see Note [Builtin class defaults] in GHC.Tc.Utils.Env
|
|
| 55 | + |
|
| 56 | +These annotations are used to disambiguate multiple defaults for the same class.
|
|
| 57 | +For example, consider the following modules:
|
|
| 58 | + |
|
| 59 | + module M( default C ) where { default C( ... ) }
|
|
| 60 | + module M2( default C) where { import M }
|
|
| 61 | + module N( default C () where { default C(... ) }
|
|
| 62 | + |
|
| 63 | + module A where { import M2 }
|
|
| 64 | + module B where { import M2; import N }
|
|
| 65 | + module A1 where { import N; default C ( ... ) }
|
|
| 66 | + module B2 where { default C ( ... ); default C ( ... ) }
|
|
| 67 | + |
|
| 68 | +When compiling N, the default for C is annotated with DP_Local loc.
|
|
| 69 | +When compiling M2, the default for C is annotated with DP_Local M.
|
|
| 70 | +When compiling A, the default for C is annotated with DP_Imported M2.
|
|
| 71 | + |
|
| 72 | +Cases we needed to disambiguate:
|
|
| 73 | + * Compiling B, two defaults for C: DP_Imported M2, DP_Imported N.
|
|
| 74 | + * Compiling A1, two defaults for C: DP_Imported N, DP_Local loc.
|
|
| 75 | + * Compiling B2, two defaults for C: DP_Local loc1, DP_Local loc2.
|
|
| 76 | + |
|
| 77 | +For how we disambiguate these cases,
|
|
| 78 | +See Note [Disambiguation of multiple default declarations] in GHC.Tc.Module.
|
|
| 79 | +-}
|
|
| 80 | + |
|
| 81 | +-- | The provenance of a collection of default types for a class.
|
|
| 82 | +-- see Note [DefaultProvenance] for more details
|
|
| 83 | +data DefaultProvenance
|
|
| 84 | + -- | A locally defined default declaration.
|
|
| 85 | + = DP_Local
|
|
| 86 | + { defaultDeclLoc :: SrcSpan -- ^ The 'SrcSpan' of the default declaration
|
|
| 87 | + , defaultDeclH98 :: Bool -- ^ Is this a Haskell 98 default declaration?
|
|
| 88 | + }
|
|
| 89 | + -- | Built-in class defaults.
|
|
| 90 | + | DP_Builtin
|
|
| 91 | + -- | Imported class defaults.
|
|
| 92 | + | DP_Imported Module -- ^ The module from which the defaults were imported
|
|
| 93 | + deriving (Eq, Data)
|
|
| 94 | + |
|
| 95 | +instance Outputable DefaultProvenance where
|
|
| 96 | + ppr (DP_Local loc h98) = ppr loc <> (if h98 then text " (H98)" else empty)
|
|
| 97 | + ppr DP_Builtin = text "built-in"
|
|
| 98 | + ppr (DP_Imported mod) = ppr mod
|
|
| 99 | + |
|
| 100 | +isHaskell2010Default :: DefaultProvenance -> Bool
|
|
| 101 | +isHaskell2010Default = \case
|
|
| 102 | + DP_Local { defaultDeclH98 = isH98 } -> isH98
|
|
| 103 | + DP_Builtin -> True
|
|
| 104 | + DP_Imported {} -> False
|
|
| 105 | + |
|
| 40 | 106 | -- | Defaulting type assignments for the given class.
|
| 41 | 107 | data ClassDefaults
|
| 42 | 108 | = ClassDefaults { cd_class :: Class -- ^ The class whose defaults are being defined
|
| 43 | 109 | , cd_types :: [Type]
|
| 44 | - , cd_module :: Maybe Module
|
|
| 45 | - -- ^ @Nothing@ for built-in,
|
|
| 46 | - -- @Just@ the current module or the module whence the default was imported
|
|
| 110 | + , cd_provenance :: DefaultProvenance
|
|
| 111 | + -- ^ Where the defaults came from
|
|
| 47 | 112 | -- see Note [Default exports] in GHC.Tc.Gen.Export
|
| 48 | 113 | , cd_warn :: Maybe (WarningTxt GhcRn)
|
| 49 | 114 | -- ^ Warning emitted when the default is used
|
| ... | ... | @@ -70,6 +135,9 @@ defaultList :: DefaultEnv -> [ClassDefaults] |
| 70 | 135 | defaultList = sortBy (stableNameCmp `on` className . cd_class) . nonDetNameEnvElts
|
| 71 | 136 | -- sortBy recovers determinism
|
| 72 | 137 | |
| 138 | +insertDefaultEnv :: ClassDefaults -> DefaultEnv -> DefaultEnv
|
|
| 139 | +insertDefaultEnv d env = extendNameEnv env (className $ cd_class d) d
|
|
| 140 | + |
|
| 73 | 141 | lookupDefaultEnv :: DefaultEnv -> Name -> Maybe ClassDefaults
|
| 74 | 142 | lookupDefaultEnv env = lookupUFM_Directly env . nameUnique
|
| 75 | 143 |
| 1 | +{-# LANGUAGE NamedDefaults #-}
|
|
| 2 | + |
|
| 3 | +module Main where
|
|
| 4 | + |
|
| 5 | +import T25912_helper
|
|
| 6 | + |
|
| 7 | +-- now we declare the default instances
|
|
| 8 | +-- for the classes C again to check that
|
|
| 9 | +-- it won't hide the default instances for class B
|
|
| 10 | +default C (String)
|
|
| 11 | + |
|
| 12 | +main :: IO ()
|
|
| 13 | +main = do
|
|
| 14 | + print b |
| 1 | +"String" |
| 1 | +{-# LANGUAGE NamedDefaults #-}
|
|
| 2 | + |
|
| 3 | +module T25912_helper ( default C, C(c), default B, b ) where
|
|
| 4 | + |
|
| 5 | +class C a where
|
|
| 6 | + c :: a
|
|
| 7 | +instance C Int where
|
|
| 8 | + c = 1
|
|
| 9 | +instance C String where
|
|
| 10 | + c = "String"
|
|
| 11 | +default C (String)
|
|
| 12 | + |
|
| 13 | +class B a where
|
|
| 14 | + b :: a
|
|
| 15 | +instance B String where
|
|
| 16 | + b = "String"
|
|
| 17 | +default B (String) |
| 1 | +{-# LANGUAGE NamedDefaults, OverloadedStrings #-}
|
|
| 2 | +module NamedDefaultsNum where
|
|
| 3 | +import Data.String
|
|
| 4 | +default Num ()
|
|
| 5 | +foo = "abc" |
| 1 | +{-# LANGUAGE ExtendedDefaultRules #-}
|
|
| 2 | +{-# LANGUAGE NamedDefaults #-}
|
|
| 3 | +module T25934 where
|
|
| 4 | +default Num (Int)
|
|
| 5 | +default Show (Int) |
| ... | ... | @@ -39,3 +39,6 @@ test('T25858v2', [extra_files(['T25858v2_helper.hs'])], multimod_compile_and_run |
| 39 | 39 | test('T25858v3', [extra_files(['T25858v3_helper.hs'])], multimod_compile_and_run, ['T25858v3', ''])
|
| 40 | 40 | test('T25858v4', normal, compile_and_run, [''])
|
| 41 | 41 | test('T25882', normal, compile, [''])
|
| 42 | +test('T25912', [extra_files(['T25912_helper.hs'])], multimod_compile_and_run, ['T25912', ''])
|
|
| 43 | +test('T25914', normal, compile, [''])
|
|
| 44 | +test('T25934', normal, compile, ['']) |
| 1 | -default-fail03.hs:4:1: [GHC-99565]
|
|
| 1 | +default-fail03.hs:4:1: error: [GHC-99565]
|
|
| 2 | 2 | Multiple default declarations for class ‘Num’
|
| 3 | - here was another default declaration default-fail03.hs:3:1-29 |
|
| 3 | + conflicting named default declaration at: default-fail03.hs:3:1-29
|
|
| 4 | + |
| ... | ... | @@ -8,7 +8,7 @@ ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4345:8: Note [Lambda-boun |
| 8 | 8 | ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1387:37: Note [Gentle mode]
|
| 9 | 9 | ref compiler/GHC/Core/Opt/Specialise.hs:1761:29: Note [Arity decrease]
|
| 10 | 10 | ref compiler/GHC/Core/TyCo/Rep.hs:1783:31: Note [What prevents a constraint from floating]
|
| 11 | -ref compiler/GHC/Driver/DynFlags.hs:1216:52: Note [Eta-reduction in -O0]
|
|
| 11 | +ref compiler/GHC/Driver/DynFlags.hs:1218:52: Note [Eta-reduction in -O0]
|
|
| 12 | 12 | ref compiler/GHC/Driver/Main.hs:1901:34: Note [simpleTidyPgm - mkBootModDetailsTc]
|
| 13 | 13 | ref compiler/GHC/Hs/Expr.hs:189:63: Note [Pending Splices]
|
| 14 | 14 | 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] |
| 18 | 18 | ref compiler/GHC/HsToCore/Pmc/Solver.hs:860:20: Note [COMPLETE sets on data families]
|
| 19 | 19 | ref compiler/GHC/HsToCore/Quote.hs:1533:7: Note [How brackets and nested splices are handled]
|
| 20 | 20 | ref compiler/GHC/Stg/Unarise.hs:457:32: Note [Renaming during unarisation]
|
| 21 | -ref compiler/GHC/Tc/Gen/Default.hs:87:6: Note [Disambiguation of multiple default declarations]
|
|
| 22 | -ref compiler/GHC/Tc/Gen/Default.hs:193:11: Note [Disambiguation of multiple default declarations]
|
|
| 23 | 21 | ref compiler/GHC/Tc/Gen/HsType.hs:563:56: Note [Skolem escape prevention]
|
| 24 | -ref compiler/GHC/Tc/Gen/HsType.hs:2693:7: Note [Matching a kind signature with a declaration]
|
|
| 22 | +ref compiler/GHC/Tc/Gen/HsType.hs:2717:7: Note [Matching a kind signature with a declaration]
|
|
| 25 | 23 | ref compiler/GHC/Tc/Gen/Pat.hs:284:20: Note [Typing patterns in pattern bindings]
|
| 26 | 24 | ref compiler/GHC/Tc/Gen/Pat.hs:1378:7: Note [Matching polytyped patterns]
|
| 27 | 25 | 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] |
| 30 | 28 | ref compiler/GHC/Tc/Gen/Splice.hs:670:7: Note [How brackets and nested splices are handled]
|
| 31 | 29 | ref compiler/GHC/Tc/Gen/Splice.hs:909:11: Note [How brackets and nested splices are handled]
|
| 32 | 30 | ref compiler/GHC/Tc/Instance/Family.hs:458:35: Note [Constrained family instances]
|
| 33 | -ref compiler/GHC/Tc/Module.hs:385:3: Note [Disambiguation of multiple default declarations]
|
|
| 34 | -ref compiler/GHC/Tc/Module.hs:420:7: Note [Disambiguation of multiple default declarations]
|
|
| 35 | 31 | ref compiler/GHC/Tc/Solver/Rewrite.hs:1015:7: Note [Stability of rewriting]
|
| 36 | 32 | ref compiler/GHC/Tc/TyCl.hs:1322:6: Note [Unification variables need fresh Names]
|
| 37 | 33 | ref compiler/GHC/Tc/Types/Constraint.hs:209:9: Note [NonCanonical Semantics]
|
| 1 | - |
|
| 2 | 1 | mod58.hs:4:1: error: [GHC-99565]
|
| 3 | 2 | Multiple default declarations for class ‘Num’
|
| 4 | - here was another default declaration mod58.hs:3:1-21 |
|
| 3 | + conflicting default declaration at: mod58.hs:3:1-21
|
|
| 4 | + |