diff options
| author | sheaf <sam.derbyshire@gmail.com> | 2023-05-15 15:23:49 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-05-15 18:03:00 -0400 |
| commit | 4d29ecdfcc79ad663e066d9f7d6d17b64c8c6c41 (patch) | |
| tree | 985890c63aee54a2e94e31aa85cbec44652987b9 | |
| parent | d69cbd78999071d2d6479be40ae90ddd83b9942a (diff) | |
| download | haskell-4d29ecdfcc79ad663e066d9f7d6d17b64c8c6c41.tar.gz | |
Migrate errors to diagnostics in GHC.Tc.Module
This commit migrates the errors in GHC.Tc.Module to use the new
diagnostic infrastructure.
It required a significant overhaul of the compatibility checks between
an hs-boot or signature module and its implementation; we now use
a Writer monad to accumulate errors; see the BootMismatch datatype
in GHC.Tc.Errors.Types, with its panoply of subtypes.
For the sake of readability, several local functions inside the
'checkBootTyCon' function were split off into top-level functions.
We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file"
datatype, as this mirrors the logic in several other places where we
want to treat hs-boot and hsig files in a similar fashion.
This commit also refactors the Backpack checks for type synonyms
implementing abstract data, to correctly reject implementations that
contain qualified or quantified types (this fixes #23342 and #23344).
110 files changed, 2223 insertions, 1378 deletions
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs index 01197061bb..cfba3ebab3 100644 --- a/compiler/GHC/Core/TyCon.hs +++ b/compiler/GHC/Core/TyCon.hs @@ -2131,13 +2131,13 @@ isOpenFamilyTyCon (TyCon { tyConDetails = details }) _ -> False | otherwise = False --- | Is this a synonym 'TyCon' that can have may have further instances appear? +-- | Is this a type family 'TyCon' (whether open or closed)? isTypeFamilyTyCon :: TyCon -> Bool isTypeFamilyTyCon (TyCon { tyConDetails = details }) | FamilyTyCon { famTcFlav = flav } <- details = not (isDataFamFlav flav) | otherwise = False --- | Is this a synonym 'TyCon' that can have may have further instances appear? +-- | Is this a data family 'TyCon'? isDataFamilyTyCon :: TyCon -> Bool isDataFamilyTyCon (TyCon { tyConDetails = details }) | FamilyTyCon { famTcFlav = flav } <- details = isDataFamFlav flav @@ -2158,14 +2158,14 @@ isClosedSynFamilyTyConWithAxiom_maybe (TyCon { tyConDetails = details }) isBuiltInSynFamTyCon_maybe :: TyCon -> Maybe BuiltInSynFamily isBuiltInSynFamTyCon_maybe (TyCon { tyConDetails = details }) - | FamilyTyCon {famTcFlav = BuiltInSynFamTyCon ops } <- details = Just ops - | otherwise = Nothing + | FamilyTyCon {famTcFlav = BuiltInSynFamTyCon ops} <- details = Just ops + | otherwise = Nothing -- | Extract type variable naming the result of injective type family tyConFamilyResVar_maybe :: TyCon -> Maybe Name tyConFamilyResVar_maybe (TyCon { tyConDetails = details }) | FamilyTyCon {famTcResVar = res} <- details = res - | otherwise = Nothing + | otherwise = Nothing -- | @'tyConInjectivityInfo' tc@ returns @'Injective' is@ if @tc@ is an -- injective tycon (where @is@ states for which 'tyConBinders' @tc@ is diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs index 042d0fe021..9ca39b68ae 100644 --- a/compiler/GHC/Driver/Backpack.hs +++ b/compiler/GHC/Driver/Backpack.hs @@ -139,9 +139,9 @@ computeUnitId (L _ unit) = (cid, [ (r, mkHoleModule r) | r <- reqs ]) where cid = hsComponentId (unLoc (hsunitName unit)) reqs = uniqDSetToList (unionManyUniqDSets (map (get_reqs . unLoc) (hsunitBody unit))) - get_reqs (DeclD HsigFile (L _ modname) _) = unitUniqDSet modname get_reqs (DeclD HsSrcFile _ _) = emptyUniqDSet get_reqs (DeclD HsBootFile _ _) = emptyUniqDSet + get_reqs (DeclD HsigFile (L _ modname) _) = unitUniqDSet modname get_reqs (IncludeD (IncludeDecl (L _ hsuid) _ _)) = unitFreeModuleHoles (convertHsComponentId hsuid) @@ -857,9 +857,9 @@ hsModuleToModSummary home_keys pn hsc_src modname (unpackFS unit_fs </> moduleNameSlashes modname) (case hsc_src of - HsigFile -> "hsig" + HsigFile -> "hsig" HsBootFile -> "hs-boot" - HsSrcFile -> "hs") + HsSrcFile -> "hs") -- DANGEROUS: bootifying can POISON the module finder cache let location = case hsc_src of HsBootFile -> addBootSuffixLocnOut location0 diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index b7bc05f74a..a8187074fe 100644 --- a/compiler/GHC/Driver/Make.hs +++ b/compiler/GHC/Driver/Make.hs @@ -1681,8 +1681,10 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots k = NodeKey_Module (msKey ms) hs_file_for_boot - | HsBootFile <- ms_hsc_src ms = Just $ ((ms_unitid ms), NoPkgQual, (GWIB (noLoc $ ms_mod_name ms) NotBoot)) - | otherwise = Nothing + | HsBootFile <- ms_hsc_src ms + = Just $ ((ms_unitid ms), NoPkgQual, (GWIB (noLoc $ ms_mod_name ms) NotBoot)) + | otherwise + = Nothing -- This loops over each import in each summary. It is mutually recursive with loopSummaries if we discover @@ -2207,9 +2209,9 @@ summariseModule hsc_env' home_unit old_summary_map is_boot (L _ wanted_mod) mb_p -- annotation, but we don't know if it's a signature or a regular -- module until we actually look it up on the filesystem. let hsc_src - | is_boot == IsBoot = HsBootFile + | is_boot == IsBoot = HsBootFile | isHaskellSigFilename src_fn = HsigFile - | otherwise = HsSrcFile + | otherwise = HsSrcFile when (pi_mod_name /= wanted_mod) $ throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc @@ -2534,7 +2536,7 @@ executeCompileNode k n !old_hmi hug mrehydrate_mods mod = do -- compiling a signature requires an knot_var for that unit. -- If you remove this then a lot of backpack tests fail. HsigFile -> Just [] - _ -> mrehydrate_mods + _ -> mrehydrate_mods {- Rehydration, see Note [Rehydrating Modules] -} diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs index f22a4a8655..cb4aa6d8a2 100644 --- a/compiler/GHC/Driver/Pipeline.hs +++ b/compiler/GHC/Driver/Pipeline.hs @@ -869,9 +869,8 @@ foreignJsPipeline pipe_env hsc_env location input_fn = do use (T_ForeignJs pipe_env hsc_env location input_fn) hscPostBackendPipeline :: P m => PipeEnv -> HscEnv -> HscSource -> Backend -> Maybe ModLocation -> FilePath -> m (Maybe FilePath) -hscPostBackendPipeline _ _ HsBootFile _ _ _ = return Nothing -hscPostBackendPipeline _ _ HsigFile _ _ _ = return Nothing -hscPostBackendPipeline pipe_env hsc_env _ bcknd ml input_fn = +hscPostBackendPipeline _ _ (HsBootOrSig _) _ _ _ = return Nothing +hscPostBackendPipeline pipe_env hsc_env HsSrcFile bcknd ml input_fn = applyPostHscPipeline (backendPostHscPipeline bcknd) pipe_env hsc_env ml input_fn applyPostHscPipeline diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs index 84113df8eb..fb3de7925a 100644 --- a/compiler/GHC/Driver/Pipeline/Execute.hs +++ b/compiler/GHC/Driver/Pipeline/Execute.hs @@ -1040,9 +1040,8 @@ llvmOptions llvm_config dflags = -- | What phase to run after one of the backend code generators has run hscPostBackendPhase :: HscSource -> Backend -> Phase -hscPostBackendPhase HsBootFile _ = StopLn -hscPostBackendPhase HsigFile _ = StopLn -hscPostBackendPhase _ bcknd = backendNormalSuccessorPhase bcknd +hscPostBackendPhase (HsBootOrSig _) _ = StopLn +hscPostBackendPhase HsSrcFile bcknd = backendNormalSuccessorPhase bcknd compileStub :: HscEnv -> FilePath -> IO FilePath diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs index 5305a97623..16f4b900b5 100644 --- a/compiler/GHC/Iface/Load.hs +++ b/compiler/GHC/Iface/Load.hs @@ -1142,8 +1142,8 @@ pprModIface unit_state iface@ModIface{ mi_final_exts = exts } ] where pp_hsc_src HsBootFile = text "[boot]" - pp_hsc_src HsigFile = text "[hsig]" - pp_hsc_src HsSrcFile = Outputable.empty + pp_hsc_src HsigFile = text "[hsig]" + pp_hsc_src HsSrcFile = Outputable.empty {- When printing export lists, we print like this: diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs index 71b87cb19c..84603e9399 100644 --- a/compiler/GHC/Iface/Syntax.hs +++ b/compiler/GHC/Iface/Syntax.hs @@ -748,27 +748,6 @@ filtering of method signatures. Instead we just check if anything at all is filtered and hide it in that case. -} -data ShowSub - = ShowSub - { ss_how_much :: ShowHowMuch - , ss_forall :: ShowForAllFlag } - --- See Note [Printing IfaceDecl binders] --- The alternative pretty printer referred to in the note. -newtype AltPpr = AltPpr (Maybe (OccName -> SDoc)) - -data ShowHowMuch - = ShowHeader AltPpr -- ^Header information only, not rhs - | ShowSome [OccName] AltPpr - -- ^ Show only some sub-components. Specifically, - -- - -- [@\[\]@] Print all sub-components. - -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@; - -- elide other sub-components to @...@ - -- May 14: the list is max 1 element long at the moment - | ShowIface - -- ^Everything including GHC-internal information (used in --show-iface) - {- Note [Printing IfaceDecl binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -782,11 +761,6 @@ When printing an interface file (--show-iface), we want to print everything unqualified, so we can just print the OccName directly. -} -instance Outputable ShowHowMuch where - ppr (ShowHeader _) = text "ShowHeader" - ppr ShowIface = text "ShowIface" - ppr (ShowSome occs _) = text "ShowSome" <+> ppr occs - showToHeader :: ShowSub showToHeader = ShowSub { ss_how_much = ShowHeader $ AltPpr Nothing , ss_forall = ShowForAllWhen } diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs index 2b45a712e6..1796539cd5 100644 --- a/compiler/GHC/Iface/Type.hs +++ b/compiler/GHC/Iface/Type.hs @@ -29,6 +29,7 @@ module GHC.Iface.Type ( IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder, IfaceForAllSpecBndr, IfaceForAllBndr, ForAllTyFlag(..), FunTyFlag(..), ShowForAllFlag(..), + ShowSub(..), ShowHowMuch(..), AltPpr(..), mkIfaceForAllTvBndr, mkIfaceTyConKind, ifaceForAllSpecToBndrs, ifaceForAllSpecToBndr, @@ -1317,6 +1318,32 @@ pprIfaceForAllCoBndr (tv, kind_co) -- or when compiling with -fprint-explicit-foralls. data ShowForAllFlag = ShowForAllMust | ShowForAllWhen +data ShowSub + = ShowSub + { ss_how_much :: ShowHowMuch + , ss_forall :: ShowForAllFlag } + +-- See Note [Printing IfaceDecl binders] +-- The alternative pretty printer referred to in the note. +newtype AltPpr = AltPpr (Maybe (OccName -> SDoc)) + +data ShowHowMuch + = ShowHeader AltPpr -- ^Header information only, not rhs + | ShowSome [OccName] AltPpr + -- ^ Show only some sub-components. Specifically, + -- + -- [@\[\]@] Print all sub-components. + -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@; + -- elide other sub-components to @...@ + -- May 14: the list is max 1 element long at the moment + | ShowIface + -- ^Everything including GHC-internal information (used in --show-iface) + +instance Outputable ShowHowMuch where + ppr (ShowHeader _) = text "ShowHeader" + ppr ShowIface = text "ShowIface" + ppr (ShowSome occs _) = text "ShowSome" <+> ppr occs + pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc pprIfaceSigmaType show_forall ty = hideNonStandardTypes (ppr_sigma show_forall topPrec) ty diff --git a/compiler/GHC/Iface/Type.hs-boot b/compiler/GHC/Iface/Type.hs-boot index 9c10f29ed5..e8cbd62158 100644 --- a/compiler/GHC/Iface/Type.hs-boot +++ b/compiler/GHC/Iface/Type.hs-boot @@ -1,6 +1,7 @@ module GHC.Iface.Type ( IfaceType, IfaceTyCon, IfaceBndr , IfaceCoercion, IfaceTyLit, IfaceAppArgs + , ShowSub ) where @@ -15,3 +16,4 @@ data IfaceTyCon data IfaceTyLit data IfaceCoercion data IfaceBndr +data ShowSub diff --git a/compiler/GHC/Linker/Loader.hs b/compiler/GHC/Linker/Loader.hs index f6caa18a9d..a3e7af02a8 100644 --- a/compiler/GHC/Linker/Loader.hs +++ b/compiler/GHC/Linker/Loader.hs @@ -764,7 +764,7 @@ getLinkDeps hsc_env pls replace_osuf span mods let iface = (hm_iface hmi) mmod = case mi_hsc_src iface of HsBootFile -> link_boot_mod_error (mi_module iface) - _ -> return $ Just (mi_module iface) + _ -> return $ Just (mi_module iface) in (mkUniqDSet $ Set.toList $ dep_direct_pkgs (mi_deps iface),) <$> mmod Nothing -> diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs index 503e56bd57..73af997a2e 100644 --- a/compiler/GHC/Rename/Bind.hs +++ b/compiler/GHC/Rename/Bind.hs @@ -26,7 +26,10 @@ module GHC.Rename.Bind ( rnMethodBinds, renameSigs, rnMatchGroup, rnGRHSs, rnGRHS, rnSrcFixityDecl, makeMiniFixityEnv, MiniFixityEnv, - HsSigCtxt(..) + HsSigCtxt(..), + + -- Utility for hs-boot files + rejectBootDecls ) where import GHC.Prelude @@ -56,6 +59,7 @@ import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set import GHC.Types.Name.Reader ( RdrName, rdrNameOcc ) +import GHC.Types.SourceFile import GHC.Types.SrcLoc as SrcLoc import GHC.Data.List.SetOps ( findDupsEq ) import GHC.Types.Basic ( RecFlag(..), TypeOrKind(..) ) @@ -199,10 +203,20 @@ rnTopBindsLHSBoot fix_env binds = do { topBinds <- rnTopBindsLHS fix_env binds ; case topBinds of ValBinds x mbinds sigs -> - do { mapM_ bindInHsBootFileErr mbinds + do { rejectBootDecls HsBoot BootBindsPs (bagToList $ mbinds) ; pure (ValBinds x emptyBag sigs) } _ -> pprPanic "rnTopBindsLHSBoot" (ppr topBinds) } +rejectBootDecls :: HsBootOrSig + -> (NonEmpty (LocatedA decl) -> BadBootDecls) + -> [LocatedA decl] + -> TcM () +rejectBootDecls _ _ [] = return () +rejectBootDecls hsc_src what (decl@(L loc _) : decls) + = addErrAt (locA loc) + $ TcRnIllegalHsBootOrSigDecl hsc_src + (what $ decl :| decls) + rnTopBindsBoot :: NameSet -> HsValBindsLR GhcRn GhcPs -> RnM (HsValBinds GhcRn, DefUses) -- A hs-boot file has no bindings. @@ -1384,9 +1398,6 @@ misplacedSigErr :: LSig GhcRn -> RnM () misplacedSigErr (L loc sig) = addErrAt (locA loc) $ TcRnMisplacedSigDecl sig -bindInHsBootFileErr :: LHsBindLR GhcRn GhcPs -> RnM () -bindInHsBootFileErr (L loc _) = addErrAt (locA loc) TcRnBindInBootFile - nonStdGuardErr :: (Outputable body, Anno (Stmt GhcRn body) ~ SrcSpanAnnA) => [LStmtLR GhcRn GhcRn body] -> TcRnMessage diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs index 5c23ee60cb..33c418fead 100644 --- a/compiler/GHC/Rename/Utils.hs +++ b/compiler/GHC/Rename/Utils.hs @@ -345,7 +345,7 @@ warnUnusedTopBinds :: [GlobalRdrElt] -> RnM () warnUnusedTopBinds gres = whenWOptM Opt_WarnUnusedTopBinds $ do env <- getGblEnv - let isBoot = tcg_src env == HsBootFile + let isBoot = isHsBootFile $ tcg_src env let noParent gre = case gre_par gre of NoParent -> True _ -> False diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 5a1485c1da..bf92125405 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -26,6 +26,8 @@ module GHC.Tc.Errors.Ppr import GHC.Prelude +import qualified Language.Haskell.TH as TH + import GHC.Builtin.Names import GHC.Builtin.Types ( boxedRepDataConTyCon, tYPETyCon, filterCTuple ) @@ -38,7 +40,7 @@ import GHC.Core.Unify ( tcMatchTys ) import GHC.Core.TyCon import GHC.Core.Class import GHC.Core.DataCon -import GHC.Core.Coercion.Axiom (coAxiomTyCon, coAxiomSingleBranch) +import GHC.Core.Coercion.Axiom (CoAxBranch, coAxiomTyCon, coAxiomSingleBranch) import GHC.Core.ConLike import GHC.Core.FamInstEnv ( FamInst(..), famInstAxiom, pprFamInst ) import GHC.Core.InstEnv @@ -56,7 +58,7 @@ import GHC.Hs import GHC.Tc.Errors.Types import GHC.Tc.Types.Constraint -import {-# SOURCE #-} GHC.Tc.Types( getLclEnvLoc, lclEnvInGeneratedCode, TcTyThing ) +import {-# SOURCE #-} GHC.Tc.Types( getLclEnvLoc, lclEnvInGeneratedCode, TcTyThing, pprTcTyThingCategory ) import GHC.Tc.Types.Origin import GHC.Tc.Types.Rank (Rank(..)) import GHC.Tc.Utils.TcType @@ -71,14 +73,20 @@ import GHC.Types.Id.Info ( RecSelParent(..) ) import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set +import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.TyThing +import {-# SOURCE #-} GHC.Types.TyThing.Ppr ( pprTyThingInContext ) import GHC.Types.Unique.Set ( nonDetEltsUniqSet ) import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Fixity (defaultFixity) +import GHC.Iface.Errors.Types +import GHC.Iface.Errors.Ppr +import GHC.Iface.Syntax ( ShowSub(..), ShowForAllFlag(..), showToHeader ) + import GHC.Unit.State import GHC.Unit.Module @@ -102,10 +110,7 @@ import Data.List ( groupBy, sortBy, tails , partition, unfoldr ) import Data.Ord ( comparing ) import Data.Bifunctor -import qualified Language.Haskell.TH as TH -import {-# SOURCE #-} GHC.Tc.Types (pprTcTyThingCategory) -import GHC.Iface.Errors.Types -import GHC.Iface.Errors.Ppr + data TcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext :: !Bool -- ^ Whether we show the error context or not , tcOptsIfaceOpts :: !IfaceMessageOpts @@ -302,9 +307,24 @@ instance Diagnostic TcRnMessage where TcRnArrowIfThenElsePredDependsOnResultTy -> mkSimpleDecorated $ text "Predicate type of `ifThenElse' depends on result type" - TcRnIllegalHsBootFileDecl + TcRnIllegalHsBootOrSigDecl boot_or_sig decls -> mkSimpleDecorated $ - text "Illegal declarations in an hs-boot file" + text "Illegal" <+> what <+> text "in" <+> whr <> dot + where + what = case decls of + BootBindsPs {} -> text "binding" + BootBindsRn {} -> text "binding" + BootInstanceSigs {} -> text "instance body" + BootFamInst {} -> text "family instance" + BootSpliceDecls {} -> text "splice" + BootForeignDecls {} -> text "foreign declaration" + BootDefaultDecls {} -> text "default declaration" + BootRuleDecls {} -> text "RULE pragma" + whr = case boot_or_sig of + HsBoot -> text "an hs-boot file" + Hsig -> text "a backpack signature file" + TcRnBootMismatch boot_or_sig err -> + mkSimpleDecorated $ pprBootMismatch boot_or_sig err TcRnRecursivePatternSynonym binds -> mkSimpleDecorated $ hang (text "Recursive pattern synonym definition with following bindings:") @@ -1265,9 +1285,6 @@ instance Diagnostic TcRnMessage where 2 (hang (pprPrefixName name) 2 (dcolon <+> ppr hs_ty)) ] - TcRnBadBootFamInstDecl {} - -> mkSimpleDecorated $ - text "Illegal family instance in hs-boot file" TcRnIllegalFamilyInstance tycon -> mkSimpleDecorated $ vcat [ text "Illegal family instance for" <+> quotes (ppr tycon) @@ -1392,8 +1409,6 @@ instance Diagnostic TcRnMessage where TcRnUnexpectedDefaultSig sig -> mkSimpleDecorated $ hang (text "Unexpected default signature:") 2 (ppr sig) - TcRnBindInBootFile -> mkSimpleDecorated $ - text "Bindings in hs-boot files are not allowed" TcRnDuplicateMinimalSig sig1 sig2 otherSigs -> mkSimpleDecorated $ vcat [ text "Multiple minimal complete definitions" , text "at" <+> vcat (map ppr $ sortBy leftmost_smallest $ map getLocA sigs) @@ -1864,6 +1879,37 @@ instance Diagnostic TcRnMessage where TcRnNonCanonicalDefinition reason inst_ty -> mkSimpleDecorated $ pprNonCanonicalDefinition inst_ty reason + TcRnUnexpectedDeclarationSplice {} + -> mkSimpleDecorated $ + text "Declaration splices are not permitted" <+> + text "inside top-level declarations added with" <+> + quotes (text "addTopDecls") <> dot + TcRnImplicitImportOfPrelude + -> mkSimpleDecorated $ + text "Module" <+> quotes (text "Prelude") <+> text "implicitly imported." + TcRnMissingMain explicit_export_list main_mod main_occ + -> mkSimpleDecorated $ + text "The" <+> ppMainFn main_occ + <+> text "is not" <+> defOrExp <+> text "module" + <+> quotes (ppr main_mod) + where + defOrExp :: SDoc + defOrExp | explicit_export_list = text "exported by" + | otherwise = text "defined in" + TcRnGhciUnliftedBind id + -> mkSimpleDecorated $ + sep [ text "GHCi can't bind a variable of unlifted type:" + , nest 2 (pprPrefixOcc id <+> dcolon <+> ppr (idType id)) ] + TcRnGhciMonadLookupFail ty lookups + -> mkSimpleDecorated $ + hang (text "Can't find type" <+> pp_ty <> dot $$ ambig_msg) + 2 (text "When checking that" <+> pp_ty <> + text "is a monad that can execute GHCi statements.") + where + pp_ty = quotes (text ty) + ambig_msg = case lookups of + Just (_:_:_) -> text "The type is ambiguous." + _ -> empty diagnosticReason = \case TcRnUnknownMessage m @@ -1943,7 +1989,9 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnArrowIfThenElsePredDependsOnResultTy -> ErrorWithoutFlag - TcRnIllegalHsBootFileDecl + TcRnIllegalHsBootOrSigDecl {} + -> ErrorWithoutFlag + TcRnBootMismatch {} -> ErrorWithoutFlag TcRnRecursivePatternSynonym{} -> ErrorWithoutFlag @@ -2240,8 +2288,6 @@ instance Diagnostic TcRnMessage where -> WarningWithFlag (Opt_WarnMissingMethods) TcRnMisplacedInstSig{} -> ErrorWithoutFlag - TcRnBadBootFamInstDecl{} - -> ErrorWithoutFlag TcRnIllegalFamilyInstance{} -> ErrorWithoutFlag TcRnMissingClassAssoc{} @@ -2292,8 +2338,6 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnUnexpectedDefaultSig{} -> ErrorWithoutFlag - TcRnBindInBootFile{} - -> ErrorWithoutFlag TcRnDuplicateMinimalSig{} -> ErrorWithoutFlag TcRnLoopySuperclassSolve{} @@ -2493,7 +2537,16 @@ instance Diagnostic TcRnMessage where -> WarningWithFlag Opt_WarnNonCanonicalMonoidInstances TcRnNonCanonicalDefinition (NonCanonicalMonad _) _ -> WarningWithFlag Opt_WarnNonCanonicalMonadInstances - + TcRnUnexpectedDeclarationSplice {} + -> ErrorWithoutFlag + TcRnImplicitImportOfPrelude {} + -> WarningWithFlag Opt_WarnImplicitPrelude + TcRnMissingMain {} + -> ErrorWithoutFlag + TcRnGhciUnliftedBind {} + -> ErrorWithoutFlag + TcRnGhciMonadLookupFail {} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2573,8 +2626,18 @@ instance Diagnostic TcRnMessage where -> noHints TcRnArrowIfThenElsePredDependsOnResultTy -> noHints - TcRnIllegalHsBootFileDecl + TcRnIllegalHsBootOrSigDecl {} + -> noHints + TcRnBootMismatch boot_or_sig err + | Hsig <- boot_or_sig + , BootMismatch _ _ (BootMismatchedTyCons _boot_tc real_tc tc_errs) <- err + , any is_synAbsData_etaReduce (NE.toList tc_errs) + -> [SuggestEtaReduceAbsDataTySyn real_tc] + | otherwise -> noHints + where + is_synAbsData_etaReduce (SynAbstractData SynAbsDataTySynNotNullary) = True + is_synAbsData_etaReduce _ = False TcRnRecursivePatternSynonym{} -> noHints TcRnPartialTypeSigTyVarMismatch{} @@ -2881,8 +2944,6 @@ instance Diagnostic TcRnMessage where -> noHints TcRnMisplacedInstSig{} -> [suggestExtension LangExt.InstanceSigs] - TcRnBadBootFamInstDecl{} - -> noHints TcRnIllegalFamilyInstance{} -> noHints TcRnMissingClassAssoc{} @@ -2938,8 +2999,6 @@ instance Diagnostic TcRnMessage where -> noHints TcRnUnexpectedDefaultSig{} -> [suggestExtension LangExt.DefaultSignatures] - TcRnBindInBootFile{} - -> noHints TcRnDuplicateMinimalSig{} -> noHints TcRnLoopySuperclassSolve wtd_loc wtd_pty @@ -3157,6 +3216,16 @@ instance Diagnostic TcRnMessage where -> noHints TcRnNonCanonicalDefinition reason _ -> suggestNonCanonicalDefinition reason + TcRnUnexpectedDeclarationSplice {} + -> noHints + TcRnImplicitImportOfPrelude {} + -> noHints + TcRnMissingMain {} + -> noHints + TcRnGhciUnliftedBind {} + -> noHints + TcRnGhciMonadLookupFail {} + -> noHints diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode @@ -3318,6 +3387,7 @@ ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity) pprBindings :: [Name] -> SDoc pprBindings = pprWithCommas (quotes . ppr) + injectivityErrorHerald :: SDoc injectivityErrorHerald = text "Type family equation violates the family's injectivity annotation." @@ -5565,3 +5635,250 @@ suggestNonCanonicalDefinition reason = "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid" doc_monad = "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return" + +-------------------------------------------------------------------------------- +-- hs-boot mismatch errors + +pprBootMismatch :: HsBootOrSig -> BootMismatch -> SDoc +pprBootMismatch boot_or_sig = \case + MissingBootThing nm err -> + let def_or_exp = case err of + MissingBootDefinition -> text "defined in" + MissingBootExport -> text "exported by" + in quotes (ppr nm) <+> text "is exported by the" + <+> ppr_boot_or_sig <> comma + <+> text "but not" + <+> def_or_exp <+> text "the implementing module." + MissingBootInstance boot_dfun -> + hang (text "instance" <+> ppr (idType boot_dfun)) + 2 (text "is defined in the" <+> ppr ppr_boot_or_sig <> comma <+> + text "but not in the implementing module.") + BadReexportedBootThing name name' -> + withUserStyle alwaysQualify AllTheWay $ vcat + [ text "The" <+> ppr_boot_or_sig + <+> text "(re)exports" <+> quotes (ppr name) + , text "but the implementing module exports a different identifier" <+> quotes (ppr name') + ] + BootMismatch boot_thing real_thing err -> + vcat + [ ppr real_thing <+> + text "has conflicting definitions in the module" + , text "and its" <+> ppr_boot_or_sig <> dot, + text "Main module:" <+> real_doc + , (case boot_or_sig of + HsBoot -> text " Boot file:" + Hsig -> text " Hsig file:") <+> boot_doc + , pprBootMismatchWhat boot_or_sig err + ] + where + to_doc + = pprTyThingInContext $ + showToHeader + { ss_forall = + case boot_or_sig of + HsBoot -> ShowForAllMust + Hsig -> ShowForAllWhen } + + real_doc = to_doc real_thing + boot_doc = to_doc boot_thing + + where + ppr_boot_or_sig = case boot_or_sig of + HsBoot -> text "hs-boot file" + Hsig -> text "hsig file" + + +pprBootMismatchWhat :: HsBootOrSig -> BootMismatchWhat -> SDoc +pprBootMismatchWhat boot_or_sig = \case + BootMismatchedIdTypes {} -> + text "The two types are different." + BootMismatchedTyCons tc1 tc2 errs -> + vcat $ map (pprBootTyConMismatch boot_or_sig tc1 tc2) (NE.toList errs) + +pprBootTyConMismatch :: HsBootOrSig -> TyCon -> TyCon + -> BootTyConMismatch -> SDoc +pprBootTyConMismatch boot_or_sig tc1 tc2 = \case + TyConKindMismatch -> + text "The types have different kinds." + TyConRoleMismatch sub_type -> + if sub_type + then + text "The roles are not compatible:" $$ + text "Main module:" <+> ppr (tyConRoles tc1) $$ + text " Hsig file:" <+> ppr (tyConRoles tc2) + else + text "The roles do not match." $$ + if boot_or_sig == HsBoot + then text "NB: roles on abstract types default to" <+> + quotes (text "representational") <+> text "in hs-boot files." + else empty + TyConSynonymMismatch {} -> empty -- nothing interesting to say + TyConFlavourMismatch fam_flav1 fam_flav2 -> + whenPprDebug $ + text "Family flavours" <+> ppr fam_flav1 <+> text "and" <+> ppr fam_flav2 <+> + text "do not match" + TyConAxiomMismatch ax_errs -> + pprBootListMismatches (text "Type family equations do not match:") + pprTyConAxiomMismatch ax_errs + TyConInjectivityMismatch {} -> + text "Injectivity annotations do not match" + TyConMismatchedClasses _ _ err -> + pprBootClassMismatch boot_or_sig err + TyConMismatchedData _rhs1 _rhs2 err -> + pprBootDataMismatch err + SynAbstractData err -> + pprSynAbstractDataError err + TyConsVeryDifferent -> + empty -- should be obvious to the user what the problem is + +pprSynAbstractDataError :: SynAbstractDataError -> SDoc +pprSynAbstractDataError = \case + SynAbsDataTySynNotNullary -> + text "Illegal parameterized type synonym in implementation of abstract data." + SynAbstractDataInvalidRHS bad_sub_tys -> + let msgs = mapMaybe pprInvalidAbstractSubTy (NE.toList bad_sub_tys) + in case msgs of + [] -> herald <> dot + msg:[] -> hang (herald <> colon) + 2 msg + _ -> hang (herald <> colon) + 2 (vcat $ map (<+> bullet) msgs) + + where + herald = text "Illegal implementation of abstract data" + pprInvalidAbstractSubTy = \case + TyConApp tc _ + -> assertPpr (isTypeFamilyTyCon tc) (ppr tc) $ + Just $ text "Invalid type family" <+> quotes (ppr tc) <> dot + ty@(ForAllTy {}) + -> Just $ text "Invalid polymorphic type" <> colon <+> ppr ty <> dot + ty@(FunTy af _ _ _) + | not (af == FTF_T_T) + -> Just $ text "Invalid qualified type" <> colon <+> ppr ty <> dot + _ -> Nothing + +pprTyConAxiomMismatch :: BootListMismatch CoAxBranch BootAxiomBranchMismatch -> SDoc +pprTyConAxiomMismatch = \case + MismatchedLength -> + text "The number of equations differs." + MismatchedThing i br1 br2 err -> + hang (text "The" <+> speakNth (i+1) <+> text "equations do not match.") + 2 (pprCoAxBranchMismatch br1 br2 err) + +pprCoAxBranchMismatch :: CoAxBranch -> CoAxBranch -> BootAxiomBranchMismatch -> SDoc +pprCoAxBranchMismatch _br1 _br2 err = + text "The" <+> what <+> text "don't match." + where + what = case err of + MismatchedAxiomBinders -> text "variables bound in the equation" + MismatchedAxiomLHS -> text "equation left-hand sides" + MismatchedAxiomRHS -> text "equation right-hand sides" + +pprBootListMismatches :: SDoc -- ^ herald + -> (BootListMismatch item err -> SDoc) + -> BootListMismatches item err -> SDoc +pprBootListMismatches herald ppr_one errs = + hang herald 2 msgs + where + msgs = case errs of + err :| [] -> ppr_one err + _ -> vcat $ map ((bullet <+>) . ppr_one) $ NE.toList errs + +pprBootClassMismatch :: HsBootOrSig -> BootClassMismatch -> SDoc +pprBootClassMismatch boot_or_sig = \case + MismatchedMethods errs -> + pprBootListMismatches (text "The class methods do not match:") + pprBootClassMethodListMismatch errs + MismatchedATs at_errs -> + pprBootListMismatches (text "The associated types do not match:") + (pprATMismatch boot_or_sig) at_errs + MismatchedFunDeps -> + text "The functional dependencies do not match." + MismatchedSuperclasses -> + text "The superclass constraints do not match." + MismatchedMinimalPragmas -> + text "The MINIMAL pragmas are not compatible." + +pprATMismatch :: HsBootOrSig -> BootListMismatch ClassATItem BootATMismatch -> SDoc +pprATMismatch boot_or_sig = \case + MismatchedLength -> + text "The number of associated type defaults differs." + MismatchedThing i at1 at2 err -> + pprATMismatchErr boot_or_sig i at1 at2 err + +pprATMismatchErr :: HsBootOrSig -> Int -> ClassATItem -> ClassATItem -> BootATMismatch -> SDoc +pprATMismatchErr boot_or_sig i (ATI tc1 _) (ATI tc2 _) = \case + MismatchedTyConAT err -> + hang (text "The associated types differ:") + 2 $ pprBootTyConMismatch boot_or_sig tc1 tc2 err + MismatchedATDefaultType -> + text "The types of the" <+> speakNth (i+1) <+> + text "associated type default differ." + +pprBootClassMethodListMismatch :: BootListMismatch ClassOpItem BootMethodMismatch -> SDoc +pprBootClassMethodListMismatch = \case + MismatchedLength -> + text "The number of class methods differs." + MismatchedThing _ op1 op2 err -> + pprBootClassMethodMismatch op1 op2 err + +pprBootClassMethodMismatch :: ClassOpItem -> ClassOpItem -> BootMethodMismatch -> SDoc +pprBootClassMethodMismatch (op1, _) (op2, _) = \case + MismatchedMethodNames -> + text "The method names" <+> quotes pname1 <+> text "and" + <+> quotes pname2 <+> text "differ." + MismatchedMethodTypes {} -> + text "The types of" <+> pname1 <+> text "are different." + MismatchedDefaultMethods subtype_check -> + if subtype_check + then + text "The default methods associated with" <+> pname1 <+> + text "are not compatible." + else + text "The default methods associated with" <+> pname1 <+> + text "are different." + where + nm1 = idName op1 + nm2 = idName op2 + pname1 = quotes (ppr nm1) + pname2 = quotes (ppr nm2) + +pprBootDataMismatch :: BootDataMismatch -> SDoc +pprBootDataMismatch = \case + MismatchedNewtypeVsData -> + text "Cannot match a" <+> quotes (text "data") <+> + text "definition with a" <+> quotes (text "newtype") <+> + text "definition." + MismatchedConstructors dc_errs -> + pprBootListMismatches (text "The constructors do not match:") + pprBootDataConMismatch dc_errs + MismatchedDatatypeContexts {} -> + text "The datatype contexts do not match." + +pprBootDataConMismatch :: BootListMismatch DataCon BootDataConMismatch + -> SDoc +pprBootDataConMismatch = \case + MismatchedLength -> + text "The number of constructors differs." + MismatchedThing _ dc1 dc2 err -> + pprBootDataConMismatchErr dc1 dc2 err + +pprBootDataConMismatchErr :: DataCon -> DataCon -> BootDataConMismatch -> SDoc +pprBootDataConMismatchErr dc1 dc2 = \case + MismatchedDataConNames -> + text "The names" <+> pname1 <+> text "and" <+> pname2 <+> text "differ." + MismatchedDataConFixities -> + text "The fixities of" <+> pname1 <+> text "differ." + MismatchedDataConBangs -> + text "The strictness annotations for" <+> pname1 <+> text "differ." + MismatchedDataConFieldLabels -> + text "The record label lists for" <+> pname1 <+> text "differ." + MismatchedDataConTypes -> + text "The types for" <+> pname1 <+> text "differ." + where + name1 = dataConName dc1 + name2 = dataConName dc2 + pname1 = quotes (ppr name1) + pname2 = quotes (ppr name2) + +-------------------------------------------------------------------------------- diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index cd80a3dbc9..4f0d961a3d 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -119,6 +119,21 @@ module GHC.Tc.Errors.Types ( , NonCanonicalDefinition(..) , NonCanonical_Monoid(..) , NonCanonical_Monad(..) + + -- * Errors for hs-boot and signature files + , BadBootDecls(..) + , MissingBootThing(..), missingBootThing + , BootMismatch(..) + , BootMismatchWhat(..) + , BootTyConMismatch(..) + , BootAxiomBranchMismatch(..) + , BootClassMismatch(..) + , BootMethodMismatch(..) + , BootATMismatch(..) + , BootDataMismatch(..) + , BootDataConMismatch(..) + , SynAbstractDataError(..) + , BootListMismatch(..), BootListMismatches ) where import GHC.Prelude @@ -142,6 +157,7 @@ import GHC.Types.Id.Info ( RecSelParent(..) ) import GHC.Types.Name (Name, OccName, getSrcLoc, getSrcSpan) import qualified GHC.Types.Name.Occurrence as OccName import GHC.Types.Name.Reader +import GHC.Types.SourceFile (HsBootOrSig(..)) import GHC.Types.SrcLoc import GHC.Types.TyThing (TyThing) import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar, CoVar, Specificity) @@ -149,16 +165,16 @@ import GHC.Types.Var.Env (TidyEnv) import GHC.Types.Var.Set (TyVarSet, VarSet) import GHC.Unit.Types (Module) import GHC.Utils.Outputable -import GHC.Core.Class (Class, ClassMinimalDef) +import GHC.Core.Class (Class, ClassMinimalDef, ClassOpItem, ClassATItem) import GHC.Core.Coercion (Coercion) import GHC.Core.Coercion.Axiom (CoAxBranch) import GHC.Core.ConLike (ConLike) import GHC.Core.DataCon (DataCon, FieldLabel) import GHC.Core.FamInstEnv (FamInst) -import GHC.Core.InstEnv (LookupInstanceErrReason, ClsInst) +import GHC.Core.InstEnv (LookupInstanceErrReason, ClsInst, DFunId) import GHC.Core.PatSyn (PatSyn) import GHC.Core.Predicate (EqRel, predTypeEqRel) -import GHC.Core.TyCon (TyCon, Role) +import GHC.Core.TyCon (TyCon, Role, FamTyConFlav, AlgTyConRhs) import GHC.Core.Type (Kind, Type, ThetaType, PredType, ErrorMsgType) import GHC.Driver.Backend (Backend) import GHC.Unit.State (UnitState) @@ -775,14 +791,62 @@ data TcRnMessage where -} TcRnArrowIfThenElsePredDependsOnResultTy :: TcRnMessage - {-| TcRnIllegalHsBootFileDecl is an error that occurs when an hs-boot file + {-| TcRnIllegalHsBootOrSigDecl is an error that occurs when an hs-boot file contains declarations that are not allowed, such as bindings. - Example(s): None + Examples: - Test cases: None + -- A.hs-boot + f :: Int -> Int + f x = 2 * x -- binding not allowed + + -- B.hs-boot + type family F a where { F Int = Bool } + -- type family equations not allowed + + -- C.hsig + bar :: Int -> Int + {-# RULES forall x. bar x = x #-} -- RULES not allowed + + + Test cases: + + - bindings: T19781 + - class instance body: none + - type family instance: HsBootFam + - splice: none + - foreign declaration: none + - default declaration: none + - RULEs: none -} - TcRnIllegalHsBootFileDecl :: TcRnMessage + TcRnIllegalHsBootOrSigDecl :: !HsBootOrSig -> !BadBootDecls -> TcRnMessage + + {-| TcRnBootMismatch is a family of errors that occur when there is a + mismatch between the hs-boot and hs files. + + Examples: + + -- A.hs-boot + foo :: Int -> Bool + data D = MkD + + -- A.hs + foo :: Int -> Char + foo = chr + + data D = MkD Int + + Test cases: + + - missing export: bkpcabal06, bkpfail{01,05,09,16,35}, rnfail{047,055} + - missing definition: none + - missing instance: T14075 + - mismatch in exports: bkpfail{03,19} + - conflicting definitions: bkpcabal02, + bkpfail{04,06,07,10,12,133,14,15,17,22,23,25,26,27,41,42,45,47,50,52,53,54}, + T19244{a,b}, T23344, ClosedFam3, rnfail055 + -} + TcRnBootMismatch :: !HsBootOrSig -> !BootMismatch -> TcRnMessage {-| TcRnRecursivePatternSynonym is an error that occurs when a pattern synonym is defined in terms of itself, either directly or indirectly. @@ -1524,7 +1588,7 @@ data TcRnMessage where -} TcRnFieldUpdateInvalidType :: [(FieldLabelString,TcType)] -> TcRnMessage - {- TcRnMissingStrictFields is an error occurring when a record field marked + {-| TcRnMissingStrictFields is an error occurring when a record field marked as strict is omitted when constructing said record. Example(s): @@ -1586,7 +1650,7 @@ data TcRnMessage where -- ^ the reason this record update was rejected -> TcRnMessage - {- TcRnStaticFormNotClosed is an error pertaining to terms that are marked static + {-| TcRnStaticFormNotClosed is an error pertaining to terms that are marked static using the -XStaticPointers extension but which are not closed terms. Example(s): @@ -1921,7 +1985,7 @@ data TcRnMessage where -- (so we should give a Template Haskell hint) -> TcRnMessage - {- TcRnForeignImportPrimExtNotSet is an error occurring when a foreign import + {-| TcRnForeignImportPrimExtNotSet is an error occurring when a foreign import is declared using the @prim@ calling convention without having turned on the -XGHCForeignImportPrim extension. @@ -1932,7 +1996,7 @@ data TcRnMessage where -} TcRnForeignImportPrimExtNotSet :: ForeignImport GhcRn -> TcRnMessage - {- TcRnForeignImportPrimSafeAnn is an error declaring that the safe/unsafe + {-| TcRnForeignImportPrimSafeAnn is an error declaring that the safe/unsafe annotation should not be used with @prim@ foreign imports. Example(s): @@ -1942,7 +2006,7 @@ data TcRnMessage where -} TcRnForeignImportPrimSafeAnn :: ForeignImport GhcRn -> TcRnMessage - {- TcRnForeignFunctionImportAsValue is an error explaining that foreign @value@ + {-| TcRnForeignFunctionImportAsValue is an error explaining that foreign @value@ imports cannot have function types. Example(s): @@ -1952,7 +2016,7 @@ data TcRnMessage where -} TcRnForeignFunctionImportAsValue :: ForeignImport GhcRn -> TcRnMessage - {- TcRnFunPtrImportWithoutAmpersand is a warning controlled by @-Wdodgy-foreign-imports@ + {-| TcRnFunPtrImportWithoutAmpersand is a warning controlled by @-Wdodgy-foreign-imports@ that informs the user of a possible missing @&@ in the declaration of a foreign import with a 'FunPtr' return type. @@ -1963,7 +2027,7 @@ data TcRnMessage where -} TcRnFunPtrImportWithoutAmpersand :: ForeignImport GhcRn -> TcRnMessage - {- TcRnIllegalForeignDeclBackend is an error occurring when a foreign import declaration + {-| TcRnIllegalForeignDeclBackend is an error occurring when a foreign import declaration is not compatible with the code generation backend being used. Example(s): None @@ -1976,7 +2040,7 @@ data TcRnMessage where -> ExpectedBackends -> TcRnMessage - {- TcRnUnsupportedCallConv informs the user that the calling convention specified + {-| TcRnUnsupportedCallConv informs the user that the calling convention specified for a foreign export declaration is not compatible with the target platform. It is a warning controlled by @-Wunsupported-calling-conventions@ in the case of @stdcall@ but is otherwise considered an error. @@ -1989,7 +2053,7 @@ data TcRnMessage where -> UnsupportedCallConvention -> TcRnMessage - {- TcRnIllegalForeignType is an error for when a type appears in a foreign + {-| TcRnIllegalForeignType is an error for when a type appears in a foreign function signature that is not compatible with the FFI. Example(s): None @@ -2007,7 +2071,7 @@ data TcRnMessage where -} TcRnIllegalForeignType :: !(Maybe ArgOrResult) -> !IllegalForeignTypeReason -> TcRnMessage - {- TcRnInvalidCIdentifier indicates a C identifier that is not valid. + {-| TcRnInvalidCIdentifier indicates a C identifier that is not valid. Example(s): foreign import prim safe "not valid" cmm_test2 :: Int# -> Int# @@ -2016,7 +2080,7 @@ data TcRnMessage where -} TcRnInvalidCIdentifier :: !CLabelString -> TcRnMessage - {- TcRnExpectedValueId is an error occurring when something that is not a + {-| TcRnExpectedValueId is an error occurring when something that is not a value identifier is used where one is expected. Example(s): none @@ -2025,7 +2089,7 @@ data TcRnMessage where -} TcRnExpectedValueId :: !TcTyThing -> TcRnMessage - {- TcRnRecSelectorEscapedTyVar is an error indicating that a record field selector + {-| TcRnRecSelectorEscapedTyVar is an error indicating that a record field selector containing an existential type variable is used as a function rather than in a pattern match. @@ -2038,7 +2102,7 @@ data TcRnMessage where -} TcRnRecSelectorEscapedTyVar :: !OccName -> TcRnMessage - {- TcRnPatSynNotBidirectional is an error for when a non-bidirectional pattern + {-| TcRnPatSynNotBidirectional is an error for when a non-bidirectional pattern synonym is used as a constructor. Example(s): @@ -2051,7 +2115,7 @@ data TcRnMessage where -} TcRnPatSynNotBidirectional :: !Name -> TcRnMessage - {- TcRnSplicePolymorphicLocalVar is the error that occurs when the expression + {-| TcRnSplicePolymorphicLocalVar is the error that occurs when the expression inside typed template haskell brackets is a polymorphic local variable. Example(s): @@ -2061,7 +2125,7 @@ data TcRnMessage where -} TcRnSplicePolymorphicLocalVar :: !Id -> TcRnMessage - {- TcRnIllegalDerivingItem is an error for when something other than a type class + {-| TcRnIllegalDerivingItem is an error for when something other than a type class appears in a deriving statement. Example(s): @@ -2071,7 +2135,7 @@ data TcRnMessage where -} TcRnIllegalDerivingItem :: !(LHsSigType GhcRn) -> TcRnMessage - {- TcRnUnexpectedAnnotation indicates the erroroneous use of an annotation such + {-| TcRnUnexpectedAnnotation indicates the erroroneous use of an annotation such as strictness, laziness, or unpacking. Example(s): @@ -2083,7 +2147,7 @@ data TcRnMessage where -} TcRnUnexpectedAnnotation :: !(HsType GhcRn) -> !HsSrcBang -> TcRnMessage - {- TcRnIllegalRecordSyntax is an error indicating an illegal use of record syntax. + {-| TcRnIllegalRecordSyntax is an error indicating an illegal use of record syntax. Example(s): data T = T Int { field :: Int } @@ -2093,7 +2157,7 @@ data TcRnMessage where -} TcRnIllegalRecordSyntax :: Either (HsType GhcPs) (HsType GhcRn) -> TcRnMessage - {- TcRnUnexpectedTypeSplice is an error for a typed template haskell splice + {-| TcRnUnexpectedTypeSplice is an error for a typed Template Haskell splice appearing unexpectedly. Example(s): none @@ -2102,7 +2166,16 @@ data TcRnMessage where -} TcRnUnexpectedTypeSplice :: !(HsType GhcRn) -> TcRnMessage - {- TcRnInvalidVisibleKindArgument is an error for a kind application on a + {-| TcRnUnexpectedDeclarationSplice is an error that occurs when a Template Haskell + splice appears inside top-level declarations added with 'addTopDecls'. + + Example(s): none + + Test cases: none + -} + TcRnUnexpectedDeclarationSplice :: TcRnMessage + + {-| TcRnInvalidVisibleKindArgument is an error for a kind application on a target type that cannot accept it. Example(s): @@ -2124,7 +2197,7 @@ data TcRnMessage where -> !Type -- ^ Target of the kind application -> TcRnMessage - {- TcRnTooManyBinders is an error for a type constructor that is declared with + {-| TcRnTooManyBinders is an error for a type constructor that is declared with more arguments then its kind specifies. Example(s): @@ -2135,7 +2208,7 @@ data TcRnMessage where -} TcRnTooManyBinders :: !Kind -> ![LHsTyVarBndr () GhcRn] -> TcRnMessage - {- TcRnDifferentNamesForTyVar is an error that indicates different names being + {-| TcRnDifferentNamesForTyVar is an error that indicates different names being used for the same type variable. Example(s): @@ -2150,7 +2223,7 @@ data TcRnMessage where -} TcRnDifferentNamesForTyVar :: !Name -> !Name -> TcRnMessage - {- TcRnInvalidReturnKind is an error for a data declaration that has a kind signature + {-| TcRnInvalidReturnKind is an error for a data declaration that has a kind signature with an invalid result kind. Example(s): @@ -2197,7 +2270,7 @@ data TcRnMessage where -> Bool -- ^ Whether enabling -XPolyKinds should be suggested -> TcRnMessage - {- TcRnClassKindNotConstraint is an error for a type class that has a kind that + {-| TcRnClassKindNotConstraint is an error for a type class that has a kind that is not equivalent to Constraint. Example(s): @@ -2208,7 +2281,7 @@ data TcRnMessage where -} TcRnClassKindNotConstraint :: !Kind -> TcRnMessage - {- TcRnUnpromotableThing is an error that occurs when the user attempts to + {-| TcRnUnpromotableThing is an error that occurs when the user attempts to use the promoted version of something which is not promotable. Example(s): @@ -2243,7 +2316,7 @@ data TcRnMessage where -} TcRnUnpromotableThing :: !Name -> !PromotionErr -> TcRnMessage - {- TcRnMatchesHaveDiffNumArgs is an error occurring when something has matches + {-| TcRnMatchesHaveDiffNumArgs is an error occurring when something has matches that have different numbers of arguments Example(s): @@ -2295,7 +2368,7 @@ data TcRnMessage where -} TcRnDataKindsError :: TypeOrKind -> HsType GhcPs -> TcRnMessage - {- TcRnCannotBindScopedTyVarInPatSig is an error stating that scoped type + {-| TcRnCannotBindScopedTyVarInPatSig is an error stating that scoped type variables cannot be used in pattern bindings. Example(s): @@ -2305,7 +2378,7 @@ data TcRnMessage where -} TcRnCannotBindScopedTyVarInPatSig :: !(NE.NonEmpty (Name, TcTyVar)) -> TcRnMessage - {- TcRnCannotBindTyVarsInPatBind is an error for when type + {-| TcRnCannotBindTyVarsInPatBind is an error for when type variables are introduced in a pattern binding Example(s): @@ -2316,7 +2389,7 @@ data TcRnMessage where -} TcRnCannotBindTyVarsInPatBind :: !(NE.NonEmpty (Name, TcTyVar)) -> TcRnMessage - {- TcRnTooManyTyArgsInConPattern is an error occurring when a constructor pattern + {-| TcRnTooManyTyArgsInConPattern is an error occurring when a constructor pattern has more than the expected number of type arguments Example(s): @@ -2331,7 +2404,7 @@ data TcRnMessage where -> !Int -- ^ Actual number of args -> TcRnMessage - {- TcRnMultipleInlinePragmas is a warning signifying that multiple inline pragmas + {-| TcRnMultipleInlinePragmas is a warning signifying that multiple inline pragmas reference the same definition. Example(s): @@ -2348,7 +2421,7 @@ data TcRnMessage where -> !(NE.NonEmpty (LocatedA InlinePragma)) -- ^ Other pragmas -> TcRnMessage - {- TcRnUnexpectedPragmas is a warning that occurs when unexpected pragmas appear + {-| TcRnUnexpectedPragmas is a warning that occurs when unexpected pragmas appear in the source. Example(s): @@ -2357,7 +2430,7 @@ data TcRnMessage where -} TcRnUnexpectedPragmas :: !Id -> !(NE.NonEmpty (LSig GhcRn)) -> TcRnMessage - {- TcRnNonOverloadedSpecialisePragma is a warning for a specialise pragma being + {-| TcRnNonOverloadedSpecialisePragma is a warning for a specialise pragma being placed on a definition that is not overloaded. Example(s): @@ -2370,7 +2443,7 @@ data TcRnMessage where -} TcRnNonOverloadedSpecialisePragma :: !(LIdP GhcRn) -> TcRnMessage - {- TcRnSpecialiseNotVisible is a warning that occurs when the subject of a + {-| TcRnSpecialiseNotVisible is a warning that occurs when the subject of a SPECIALISE pragma has a definition that is not visible from the current module. Example(s): none @@ -2379,7 +2452,7 @@ data TcRnMessage where -} TcRnSpecialiseNotVisible :: !Name -> TcRnMessage - {- TcRnPragmaWarning is a warning that can happen when usage of something + {-| TcRnPragmaWarning is a warning that can happen when usage of something is warned or deprecated by pragma. Test cases: @@ -2695,7 +2768,7 @@ data TcRnMessage where -} TcRnCannotRepresentType :: !UnrepresentableTypeDescr -> !Type -> TcRnMessage - {-| TcRnRunSpliceFailure is an error indicating that a template haskell splice + {-| TcRnRunSpliceFailure is an error indicating that a Template Haskell splice failed to be converted into a valid expression. Example(s): @@ -2738,7 +2811,7 @@ data TcRnMessage where -> !String -- Error body -> TcRnMessage - {- | TcRnUnsatisfiedMinimalDef is a warning that occurs when a class instance + {-| TcRnUnsatisfiedMinimalDef is a warning that occurs when a class instance is missing methods that are required by the minimal definition. Example: @@ -2779,7 +2852,7 @@ data TcRnMessage where -} TcRnUnsatisfiedMinimalDef :: ClassMinimalDef -> TcRnMessage - {- | 'TcRnMisplacedInstSig' is an error that happens when a method in + {-| 'TcRnMisplacedInstSig' is an error that happens when a method in a class instance is given a type signature, but the user has not enabled the @InstanceSigs@ extension. @@ -2787,21 +2860,14 @@ data TcRnMessage where testsuite/tests/module/mod45 -} TcRnMisplacedInstSig :: Name -> (LHsSigType GhcRn) -> TcRnMessage - {- | 'TcRnBadBootFamInstDecl' is an error that is triggered by a - type family instance being declared in an hs-boot file. - - Test case: - testsuite/tests/indexed-types/should_fail/HsBootFam - -} - TcRnBadBootFamInstDecl :: {} -> TcRnMessage - {- | 'TcRnIllegalFamilyInstance' is an error that occurs when an associated + {-| 'TcRnIllegalFamilyInstance' is an error that occurs when an associated type or data family is given a top-level instance. Test case: testsuite/tests/indexed-types/should_fail/T3092 -} TcRnIllegalFamilyInstance :: TyCon -> TcRnMessage - {- | 'TcRnMissingClassAssoc' is an error that occurs when a class instance + {-| 'TcRnMissingClassAssoc' is an error that occurs when a class instance for a class with an associated type or data family is missing a corresponding family instance declaration. @@ -2809,7 +2875,7 @@ data TcRnMessage where testsuite/tests/indexed-types/should_fail/SimpleFail7 -} TcRnMissingClassAssoc :: TyCon -> TcRnMessage - {- | 'TcRnNotOpenFamily' is an error that is triggered by attempting to give + {-| 'TcRnNotOpenFamily' is an error that is triggered by attempting to give a top-level (open) type family instance for a closed type family. Test cases: @@ -2945,7 +3011,7 @@ data TcRnMessage where -} TcRnSectionWithoutParentheses :: HsExpr GhcPs -> TcRnMessage - {- TcRnBindingOfExistingName is an error triggered by an attempt to rebind + {-| TcRnBindingOfExistingName is an error triggered by an attempt to rebind built-in syntax, punned list or tuple syntax, or a name quoted via Template Haskell. Examples: @@ -3095,17 +3161,6 @@ data TcRnMessage where -} TcRnUnexpectedDefaultSig :: Sig GhcPs -> TcRnMessage - {-| TcRnBindInBootFile is an error triggered by a binding in hs-boot file. - - Example: - - -- in an .hs-boot file: - x = 3 - - Test cases: rename/should_fail/T19781 - -} - TcRnBindInBootFile :: TcRnMessage - {-| TcRnDuplicateMinimalSig is an error triggered by two or more minimal signatures for one type class. @@ -4053,6 +4108,65 @@ data TcRnMessage where TcRnNonCanonicalDefinition :: !NonCanonicalDefinition -- ^ Specifics -> !(LHsSigType GhcRn) -- ^ The instance type -> TcRnMessage + {-| TcRnImplicitImportOfPrelude is a warning, controlled by @Wimplicit-prelude@, + that is triggered upon an implicit import of the @Prelude@ module. + + Example: + + {-# OPTIONS_GHC -fwarn-implicit-prelude #-} + module M where {} + + Test case: rn055 + + -} + TcRnImplicitImportOfPrelude :: TcRnMessage + + {-| TcRnMissingMain is an error that occurs when a Main module does + not define a main function (named @main@ by default, but overridable + with the @main-is@ command line flag). + + Example: + + module Main where {} + + Test cases: + T414, T7765, readFail021, rnfail007, T13839b, T17171a, T16453E1, tcfail030, + T19397E3, T19397E4 + + -} + TcRnMissingMain + :: !Bool -- ^ whether the module has an explicit export list + -> !Module + -> !OccName -- ^ the expected name of the main function + -> TcRnMessage + + {-| TcRnGhciUnliftedBind is an error that occurs when a user attempts to + bind an unlifted value in GHCi. + + Example (in GHCi): + + let a = (# 1#, 3# #) + + Test cases: T9140, T19035b + -} + TcRnGhciUnliftedBind :: !Id -> TcRnMessage + + {-| TcRnGhciMonadLookupFail is an error that occurs when the user sets + the GHCi monad, using the GHC API 'setGHCiMonad' function, but GHC + can't find which monad the user is referring to. + + Example: + + import GHC ( setGHCiMonad ) + + ... setGHCiMonad "NoSuchThing" + + Test cases: none + -} + TcRnGhciMonadLookupFail + :: String -- ^ the textual name of the monad requested by the user + -> Maybe [GlobalRdrElt] -- ^ lookup result + -> TcRnMessage deriving Generic @@ -4492,6 +4606,185 @@ instance Outputable Exported where ppr IsNotExported = text "IsNotExported" ppr IsExported = text "IsExported" +-- | What declarations were not allowed in an hs-boot or hsig file? +data BadBootDecls + = BootBindsPs !(NE.NonEmpty (LHsBindLR GhcRn GhcPs)) + | BootBindsRn !(NE.NonEmpty (LHsBindLR GhcRn GhcRn)) + | BootInstanceSigs !(NE.NonEmpty (LSig GhcRn)) + | BootFamInst !TyCon + | BootSpliceDecls !(NE.NonEmpty (LocatedA (HsUntypedSplice GhcPs))) + | BootForeignDecls !(NE.NonEmpty (LForeignDecl GhcRn)) + | BootDefaultDecls !(NE.NonEmpty (LDefaultDecl GhcRn)) + | BootRuleDecls !(NE.NonEmpty (LRuleDecls GhcRn)) + +-- | A mismatch between an hs-boot or signature file and its implementing module. +data BootMismatch + -- | Something defined or exported by an hs-boot or signature file + -- is missing from the implementing module. + = MissingBootThing !Name !MissingBootThing + + -- | A typeclass instance is declared in the hs-boot file but + -- it is not present in the implementing module. + | MissingBootInstance !DFunId -- ^ the boot instance 'DFunId' + -- NB: we never trigger this for hsig files, as in that case we do + -- a full round of constraint solving, and a missing instance gets reported + -- as an unsolved Wanted constraint with a 'InstProvidedOrigin' 'CtOrigin'. + -- See GHC.Tc.Utils.Backpack.check_inst. + + -- | A mismatch between an hsig file and its implementing module + -- in the 'Name' that a particular re-export refers to. + | BadReexportedBootThing !Name !Name + + -- | A mismatch between the declaration of something in the hs-boot or + -- signature file and its implementation, e.g. a type mismatch or + -- a type family implemented as a class. + | BootMismatch + !TyThing -- ^ boot thing + !TyThing -- ^ real thing + !BootMismatchWhat + deriving Generic + +-- | Something from the hs-boot or signature file is missing from the +-- implementing module. +data MissingBootThing + -- | Something defined in the hs-boot or signature file is not defined in the + -- implementing module. + = MissingBootDefinition + -- | Something exported by the hs-boot or signature file is not exported by the + -- implementing module. + | MissingBootExport + deriving Generic + +missingBootThing :: HsBootOrSig -> Name -> MissingBootThing -> TcRnMessage +missingBootThing src nm thing = + TcRnBootMismatch src (MissingBootThing nm thing) + +-- | A mismatch of two 'TyThing's between an hs-boot or signature file +-- and its implementing module. +data BootMismatchWhat + -- | The 'Id's have different types. + = BootMismatchedIdTypes !Id -- ^ boot 'Id' + !Id -- ^ real 'Id' + -- | Two 'TyCon's aren't compatible. + | BootMismatchedTyCons !TyCon -- ^ boot 'TyCon' + !TyCon -- ^ real 'TyCon' + !(NE.NonEmpty BootTyConMismatch) + deriving Generic + +-- | An error in the implementation of an abstract datatype using +-- a type synonym. +data SynAbstractDataError + -- | The type synony was not nullary. + = SynAbsDataTySynNotNullary + -- | The type synonym RHS contained invalid types, e.g. + -- a type family or a forall. + | SynAbstractDataInvalidRHS !(NE.NonEmpty Type) + +-- | Mismatched implementation of a 'TyCon' in an hs-boot or signature file. +data BootTyConMismatch + -- | The 'TyCon' kinds differ. + = TyConKindMismatch + -- | The 'TyCon' 'Role's aren't compatible. + | TyConRoleMismatch !Bool -- ^ True <=> role subtype check + -- | Two type synonyms have different RHSs. + | TyConSynonymMismatch !Kind !Kind + -- | The two 'TyCon's are of a different flavour, e.g. one is + -- a data family and the other is a type family. + | TyConFlavourMismatch !FamTyConFlav !FamTyConFlav + -- | The equations of a type family don't match. + | TyConAxiomMismatch !(BootListMismatches CoAxBranch BootAxiomBranchMismatch) + -- | The type family injectivity annotations don't match. + | TyConInjectivityMismatch + -- | The 'TyCon's are both datatype 'TyCon's, but they have diferent 'DataCon's. + | TyConMismatchedData !AlgTyConRhs !AlgTyConRhs !BootDataMismatch + -- | The 'TyCon's are both 'Class' 'TyCon's, but the classes don't match. + | TyConMismatchedClasses !Class !Class !BootClassMismatch + -- | The 'TyCon's are something completely different. + | TyConsVeryDifferent + -- | An abstract 'TyCon' is implemented using a type synonym in an invalid + -- manner. See 'SynAbstractDataError'. + | SynAbstractData !SynAbstractDataError + + +-- | Utility datatype to record errors when checking compatibity +-- between two lists of things, e.g. class methods, associated types, +-- type family equations, etc. +data BootListMismatch item err + -- | Different number of items. + = MismatchedLength + -- | The item at the given position in the list differs. + | MismatchedThing !Int !item !item !err + +type BootListMismatches item err = + NE.NonEmpty (BootListMismatch item err) + +data BootAxiomBranchMismatch + -- | The quantified variables in an equation don't match. + -- + -- Example: the quantification of @a@ in + -- + -- @type family F a where { forall a. F a = Maybe a }@ + = MismatchedAxiomBinders + -- | The LHSs of an equation don't match. + | MismatchedAxiomLHS + -- | The RHSs of an equation don't match. + | MismatchedAxiomRHS + +-- | A mismatch in a class, between its declaration in an hs-boot or signature +-- file, and its implementation in a source Haskell file. +data BootClassMismatch + -- | The class methods don't match. + = MismatchedMethods !(BootListMismatches ClassOpItem BootMethodMismatch) + -- | The associated types don't match. + | MismatchedATs !(BootListMismatches ClassATItem BootATMismatch) + -- | The functional dependencies don't match. + | MismatchedFunDeps + -- | The superclasses don't match. + | MismatchedSuperclasses + -- | The @MINIMAL@ pragmas are not compatible. + | MismatchedMinimalPragmas + +-- | A mismatch in a class method, between its declaration in an hs-boot or signature +-- file, and its implementation in a source Haskell file. +data BootMethodMismatch + -- | The class method names are different. + = MismatchedMethodNames + -- | The types of a class method are different. + | MismatchedMethodTypes !Type !Type + -- | The default method types are not compatible. + | MismatchedDefaultMethods !Bool -- ^ True <=> subtype check + +-- | A mismatch in an associated type of a class, between its declaration +-- in an hs-boot or signature file, and its implementation in a source Haskell file. +data BootATMismatch + -- | Two associated types don't match. + = MismatchedTyConAT !BootTyConMismatch + -- | Two associated type defaults don't match. + | MismatchedATDefaultType + +-- | A mismatch in a datatype declaration, between an hs-boot file or signature +-- file and its implementing module. +data BootDataMismatch + -- | A datatype is implemented as a newtype or vice-versa. + = MismatchedNewtypeVsData + -- | The constructors don't match. + | MismatchedConstructors !(BootListMismatches DataCon BootDataConMismatch) + -- | The datatype contexts differ. + | MismatchedDatatypeContexts + +-- | A mismatch in a data constrcutor, between its declaration in an hs-boot +-- file or signature file, and its implementation in a source Haskell module. +data BootDataConMismatch + -- | The 'Name's of the 'DataCon's differ. + = MismatchedDataConNames + -- | The fixities of the 'DataCon's differ. + | MismatchedDataConFixities + -- | The strictness annotations of the 'DataCon's differ. + | MismatchedDataConBangs + -- | The 'DataCon's have different field labels. + | MismatchedDataConFieldLabels + -- | The 'DataCon's have incompatible types. + | MismatchedDataConTypes -------------------------------------------------------------------------------- -- diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs index cee24aa395..74f05a7b2c 100644 --- a/compiler/GHC/Tc/Gen/Bind.hs +++ b/compiler/GHC/Tc/Gen/Bind.hs @@ -33,6 +33,8 @@ import GHC.Driver.Session import GHC.Data.FastString import GHC.Hs +import GHC.Rename.Bind ( rejectBootDecls ) + import GHC.Tc.Errors.Types import GHC.Tc.Gen.Sig import GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep_syntactic ) @@ -72,6 +74,7 @@ import GHC.Types.Var.Env( TidyEnv, TyVarEnv, mkVarEnv, lookupVarEnv ) import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Env +import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Utils.Error @@ -231,9 +234,10 @@ tcCompleteSigs sigs = tcHsBootSigs :: [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn] -> TcM [Id] -- A hs-boot file has only one BindGroup, and it only has type --- signatures in it. The renamer checked all this +-- signatures in it. The renamer checked all this. tcHsBootSigs binds sigs - = do { checkTc (null binds) TcRnIllegalHsBootFileDecl + = do { unless (null binds) $ + rejectBootDecls HsBoot BootBindsRn (concatMap (bagToList . snd) binds) ; concatMapM (addLocMA tc_boot_sig) (filter isTypeLSig sigs) } where tc_boot_sig (TypeSig _ lnames hs_ty) = mapM f lnames diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs index 5c381f9e70..0783608bd5 100644 --- a/compiler/GHC/Tc/Module.hs +++ b/compiler/GHC/Tc/Module.hs @@ -44,9 +44,7 @@ module GHC.Tc.Module ( tcRnInstantiateSignature, loadUnqualIfaces, -- More private... - badReexportedBootThing, checkBootDeclM, - missingBootThing, getRenamedStuff, RenamedStuff ) where @@ -82,12 +80,12 @@ import GHC.Tc.Gen.Foreign import GHC.Tc.TyCl.Instance import GHC.Tc.Utils.TcMType import GHC.Tc.Utils.TcType -import GHC.Tc.Utils.Instantiate (tcGetInsts) import GHC.Tc.Solver import GHC.Tc.TyCl import GHC.Tc.Instance.Typeable ( mkTypeableBinds ) import GHC.Tc.Utils.Backpack +import GHC.Rename.Bind ( rejectBootDecls ) import GHC.Rename.Splice ( rnTopSpliceDecls, traceSplice, SpliceInfo(..) ) import GHC.Rename.HsType import GHC.Rename.Expr @@ -99,8 +97,6 @@ import GHC.Rename.Doc import GHC.Rename.Utils ( mkNameClashErr ) import GHC.Iface.Decl ( coAxiomToIfaceDecl ) -import GHC.Iface.Syntax ( ShowSub(..), showToHeader ) -import GHC.Iface.Type ( ShowForAllFlag(..) ) import GHC.Iface.Env ( externaliseName ) import GHC.Iface.Load @@ -108,20 +104,19 @@ import GHC.Builtin.Types ( mkListTy, anyTypeOfKind ) import GHC.Builtin.Names import GHC.Builtin.Utils -import GHC.Hs +import GHC.Hs hiding ( FunDep(..) ) import GHC.Hs.Dump import GHC.Core.PatSyn import GHC.Core.Predicate ( classMethodTy ) import GHC.Core.InstEnv import GHC.Core.TyCon -import GHC.Core.ConLike import GHC.Core.DataCon +import GHC.Core.TyCo.Rep import GHC.Core.Type import GHC.Core.Class import GHC.Core.Coercion.Axiom import GHC.Core.Reduction ( Reduction(..) ) -import GHC.Core.RoughMap( RoughMatchTc(..) ) import GHC.Core.TyCo.Ppr( debugPprType ) import GHC.Core.FamInstEnv ( FamInst, pprFamInst, famInstsRepTyCons, orphNamesOfFamInst @@ -156,7 +151,6 @@ import GHC.Types.Basic hiding( SuccessFlag(..) ) import GHC.Types.Annotations import GHC.Types.SrcLoc import GHC.Types.SourceFile -import GHC.Types.TyThing.Ppr ( pprTyThingInContext ) import GHC.Types.PkgQual import qualified GHC.LanguageExtensions as LangExt @@ -177,8 +171,10 @@ import GHC.Data.List.SetOps import GHC.Data.Bag import qualified GHC.Data.BooleanFormula as BF +import Control.Arrow ( second ) import Control.DeepSeq import Control.Monad +import Control.Monad.Trans.Writer.CPS import Data.Data ( Data ) import Data.Functor.Classes ( liftEq ) import Data.List ( sortBy, sort ) @@ -186,6 +182,7 @@ import Data.List.NonEmpty ( NonEmpty (..) ) import qualified Data.List.NonEmpty as NE import Data.Ord import qualified Data.Set as S +import Data.Foldable ( for_ ) import Data.Traversable ( for ) @@ -271,9 +268,7 @@ tcRnModuleTcRnM hsc_env mod_sum implicit_prelude import_decls } ; when (notNull prel_imports) $ do - let msg = mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag Opt_WarnImplicitPrelude) noHints (implicitPreludeWarn) - addDiagnostic msg + addDiagnostic TcRnImplicitImportOfPrelude ; -- TODO This is a little skeevy; maybe handle a bit more directly let { simplifyImport (L _ idecl) = @@ -319,17 +314,19 @@ tcRnModuleTcRnM hsc_env mod_sum ; setGblEnv tcg_env1 $ do { -- Rename and type check the declarations traceRn "rn1a" empty - ; tcg_env <- if isHsBootOrSig hsc_src - then do { - ; tcg_env <- tcRnHsBootDecls hsc_src local_decls - ; traceRn "rn4a: before exports" empty - ; tcg_env <- setGblEnv tcg_env $ - rnExports explicit_mod_hdr export_ies - ; traceRn "rn4b: after exports" empty - ; return tcg_env - } - else {-# SCC "tcRnSrcDecls" #-} - tcRnSrcDecls explicit_mod_hdr export_ies local_decls + ; tcg_env <- + case hsc_src of + HsBootOrSig boot_or_sig -> + do { tcg_env <- tcRnHsBootDecls boot_or_sig local_decls + ; traceRn "rn4a: before exports" empty + ; tcg_env <- setGblEnv tcg_env $ + rnExports explicit_mod_hdr export_ies + ; traceRn "rn4b: after exports" empty + ; return tcg_env + } + HsSrcFile -> + {-# SCC "tcRnSrcDecls" #-} + tcRnSrcDecls explicit_mod_hdr export_ies local_decls ; whenM (goptM Opt_DoCoreLinting) $ lintGblEnv (hsc_logger hsc_env) (hsc_dflags hsc_env) tcg_env @@ -370,10 +367,6 @@ tcRnModuleTcRnM hsc_env mod_sum } } -implicitPreludeWarn :: SDoc -implicitPreludeWarn - = text "Module `Prelude' implicitly imported" - {- ************************************************************************ * * @@ -633,18 +626,15 @@ tc_rn_src_decls ds ; case th_group_tail of { Nothing -> return () ; Just (SpliceDecl _ (L loc _) _, _) -> - setSrcSpanA loc - $ addErr (mkTcRnUnknownMessage $ mkPlainError noHints $ text - ("Declaration splices are not " - ++ "permitted inside top-level " - ++ "declarations added with addTopDecls")) + setSrcSpanA loc $ addErr $ + TcRnUnexpectedDeclarationSplice } -- Rename TH-generated top-level declarations ; (tcg_env, th_rn_decls) <- setGblEnv tcg_env $ rnTopSrcDecls th_group -- Dump generated top-level declarations - ; let msg = "top-level declarations added with addTopDecls" + ; let msg = "top-level declarations added with 'addTopDecls'" ; traceSplice $ SpliceInfo { spliceDescription = msg , spliceIsDecl = True @@ -693,8 +683,8 @@ tc_rn_src_decls ds ************************************************************************ -} -tcRnHsBootDecls :: HscSource -> [LHsDecl GhcPs] -> TcM TcGblEnv -tcRnHsBootDecls hsc_src decls +tcRnHsBootDecls :: HsBootOrSig -> [LHsDecl GhcPs] -> TcM TcGblEnv +tcRnHsBootDecls boot_or_sig decls = do { (first_group, group_tail) <- findSplice decls -- Rename the declarations @@ -716,11 +706,11 @@ tcRnHsBootDecls hsc_src decls -- Check for illegal declarations ; case group_tail of - Just (SpliceDecl _ d _, _) -> badBootDecl hsc_src "splice" d + Just (SpliceDecl _ d _, _) -> rejectBootDecls boot_or_sig BootSpliceDecls [d] Nothing -> return () - ; mapM_ (badBootDecl hsc_src "foreign") for_decls - ; mapM_ (badBootDecl hsc_src "default") def_decls - ; mapM_ (badBootDecl hsc_src "rule") rule_decls + ; rejectBootDecls boot_or_sig BootForeignDecls for_decls + ; rejectBootDecls boot_or_sig BootDefaultDecls def_decls + ; rejectBootDecls boot_or_sig BootRuleDecls rule_decls -- Typecheck type/class/instance decls ; traceTc "Tc2 (boot)" empty @@ -754,17 +744,6 @@ tcRnHsBootDecls hsc_src decls }}} ; traceTc "boot" (ppr lie); return gbl_env } -badBootDecl :: HscSource -> String -> LocatedA decl -> TcM () -badBootDecl hsc_src what (L loc _) - = addErrAt (locA loc) $ mkTcRnUnknownMessage $ mkPlainError noHints $ - (char 'A' <+> text what - <+> text "declaration is not (currently) allowed in a" - <+> (case hsc_src of - HsBootFile -> text "hs-boot" - HsigFile -> text "hsig" - _ -> panic "badBootDecl: should be an hsig or hs-boot file") - <+> text "file") - {- Once we've typechecked the body of the module, we want to compare what we've found (gathered in a TypeEnv) with the hi-boot details (if any). @@ -1005,7 +984,7 @@ checkHiBootIface' -- that the hs-boot file exports. [] -> do addErrAt (nameSrcSpan missing_name) - (missingBootThing True missing_name "exported by") + (missingBootThing HsBoot missing_name MissingBootExport) return Nothing -- If the boot module does not *define* the thing, we are done @@ -1017,11 +996,11 @@ checkHiBootIface' -- then compare the definitions | Just real_thing <- lookupTypeEnv local_type_env name, Just boot_thing <- mb_boot_thing - = do checkBootDeclM True boot_thing real_thing + = do checkBootDeclM HsBoot boot_thing real_thing return Nothing | otherwise - = do addErrTc (missingBootThing True name "defined in") + = do addErrTc (missingBootThing HsBoot name MissingBootDefinition) return Nothing where name = availName boot_avail @@ -1069,7 +1048,8 @@ checkHiBootIface' vcat (map (ppr . idType . instanceDFunId) local_insts) , text "boot_dfun_ty" <+> ppr (idType boot_dfun) ] - ; addErrTc (instMisMatch boot_dfun) + ; addErrTc $ TcRnBootMismatch HsBoot + $ MissingBootInstance boot_dfun ; return Nothing } find_real_dfun :: DFunId -> [DFunId] @@ -1091,13 +1071,18 @@ checkHiBootIface' -- | Compares two things for equivalence between boot-file and normal code, -- reporting an error if they don't match up. -checkBootDeclM :: Bool -- ^ True <=> an hs-boot file (could also be a sig) - -> TyThing -> TyThing -> TcM () -checkBootDeclM is_boot boot_thing real_thing - = whenIsJust (checkBootDecl is_boot boot_thing real_thing) $ \ err -> - addErrAt span - (bootMisMatch is_boot err real_thing boot_thing) +checkBootDeclM :: HsBootOrSig + -> TyThing -- ^ boot thing + -> TyThing -- ^ real thing + -> TcM () +checkBootDeclM boot_or_sig boot_thing real_thing + = for_ boot_errs $ \ boot_err -> + addErrAt span $ + TcRnBootMismatch boot_or_sig $ + BootMismatch boot_thing real_thing boot_err where + boot_errs = execWriter $ checkBootDecl boot_or_sig boot_thing real_thing + -- Here we use the span of the boot thing or, if it doesn't have a sensible -- span, that of the real thing, span @@ -1107,69 +1092,77 @@ checkBootDeclM is_boot boot_thing real_thing | otherwise = nameSrcSpan (getName real_thing) +-- | Writer monad for accumulating errors when comparing an hs-boot or +-- signature file with its implementing module. +type BootErrsM err = Writer [err] () + +-- | If the test in the first parameter is True, succeed. +-- Otherwise, record the given error. +check :: Bool -> err -> BootErrsM err +check True _ = checkSuccess +check False err = bootErr err + +-- | Record an error. +bootErr :: err -> BootErrsM err +bootErr err = tell [err] + +-- | A convenience synonym for a lack of errors, for @checkBootDecl@ and friends. +checkSuccess :: BootErrsM err +checkSuccess = return () + +-- | Map over the error types in an error-accumulating computation. +embedErrs :: (err1 -> err2) -> BootErrsM err1 -> BootErrsM err2 +embedErrs f = mapWriter (second (fmap f)) + +-- | Wrap up a list of errors into a single message. +wrapErrs :: (NE.NonEmpty err1 -> err2) -> BootErrsM err1 -> BootErrsM err2 +wrapErrs f w = + case execWriter w of + [] -> checkSuccess + err : errs -> bootErr (f $ err :| errs) + -- | Compares the two things for equivalence between boot-file and normal -- code. Returns @Nothing@ on success or @Just "some helpful info for user"@ -- failure. If the difference will be apparent to the user, @Just empty@ is -- perfectly suitable. -checkBootDecl :: Bool -> TyThing -> TyThing -> Maybe SDoc +checkBootDecl :: HsBootOrSig -> TyThing -> TyThing -> BootErrsM BootMismatchWhat checkBootDecl _ (AnId id1) (AnId id2) = assert (id1 == id2) $ check (idType id1 `eqType` idType id2) - (text "The two types are different") - -checkBootDecl is_boot (ATyCon tc1) (ATyCon tc2) - = checkBootTyCon is_boot tc1 tc2 - -checkBootDecl _ (AConLike (RealDataCon dc1)) (AConLike (RealDataCon _)) - = pprPanic "checkBootDecl" (ppr dc1) - -checkBootDecl _ _ _ = Just empty -- probably shouldn't happen + (BootMismatchedIdTypes id1 id2) --- | Combines two potential error messages -andThenCheck :: Maybe SDoc -> Maybe SDoc -> Maybe SDoc -Nothing `andThenCheck` msg = msg -msg `andThenCheck` Nothing = msg -Just d1 `andThenCheck` Just d2 = Just (d1 $$ d2) -infixr 0 `andThenCheck` +checkBootDecl boot_or_sig (ATyCon tc1) (ATyCon tc2) + = wrapErrs (BootMismatchedTyCons tc1 tc2) $ + checkBootTyCon boot_or_sig tc1 tc2 --- | If the test in the first parameter is True, succeed with @Nothing@; --- otherwise, return the provided check -checkUnless :: Bool -> Maybe SDoc -> Maybe SDoc -checkUnless True _ = Nothing -checkUnless False k = k +checkBootDecl _ t1 t2 + = pprPanic "checkBootDecl" (ppr t1 $$ ppr t2) -- | Run the check provided for every pair of elements in the lists. --- The provided SDoc should name the element type, in the plural. -checkListBy :: (a -> a -> Maybe SDoc) -> [a] -> [a] -> SDoc - -> Maybe SDoc -checkListBy check_fun as bs whats = go [] as bs +-- +-- Records an error: +-- +-- - when any two items at the same position in the two lists don't match +-- according to the given function, +-- - when the lists are of different lengths. +checkListBy :: (a -> a -> BootErrsM err) -> [a] -> [a] + -> (BootListMismatches a err -> err2) + -> BootErrsM err2 +checkListBy check_fun as bs mk_err = wrapErrs mk_err $ go 1 as bs where - herald = text "The" <+> whats <+> text "do not match" - - go [] [] [] = Nothing - go docs [] [] = Just (hang (herald <> colon) 2 (vcat $ reverse docs)) - go docs (x:xs) (y:ys) = case check_fun x y of - Just doc -> go (doc:docs) xs ys - Nothing -> go docs xs ys - go _ _ _ = Just (hang (herald <> colon) - 2 (text "There are different numbers of" <+> whats)) - --- | If the test in the first parameter is True, succeed with @Nothing@; --- otherwise, fail with the given SDoc. -check :: Bool -> SDoc -> Maybe SDoc -check True _ = Nothing -check False doc = Just doc - --- | A more perspicuous name for @Nothing@, for @checkBootDecl@ and friends. -checkSuccess :: Maybe SDoc -checkSuccess = Nothing + go _ [] [] = checkSuccess + go !i (x:xs) (y:ys) = + do { embedErrs (MismatchedThing i x y) $ check_fun x y + ; go (i+1) xs ys } + go _ _ _ = bootErr MismatchedLength ---------------- -checkBootTyCon :: Bool -> TyCon -> TyCon -> Maybe SDoc -checkBootTyCon is_boot tc1 tc2 +checkBootTyCon :: HsBootOrSig -> TyCon -> TyCon -> BootErrsM BootTyConMismatch +checkBootTyCon boot_or_sig tc1 tc2 | not (eqType (tyConKind tc1) (tyConKind tc2)) - = Just $ text "The types have different kinds" -- First off, check the kind + -- First off, check the kind + = bootErr TyConKindMismatch | Just c1 <- tyConClass_maybe tc1 , Just c2 <- tyConClass_maybe tc2 @@ -1178,383 +1171,407 @@ checkBootTyCon is_boot tc1 tc2 (clas_tvs2, clas_fds2, sc_theta2, _, ats2, op_stuff2) = classExtraBigSig c2 , Just env <- eqVarBndrs emptyRnEnv2 clas_tvs1 clas_tvs2 - = let - eqSig (id1, def_meth1) (id2, def_meth2) - = check (name1 == name2) - (text "The names" <+> pname1 <+> text "and" <+> pname2 <+> - text "are different") `andThenCheck` - check (eqTypeX env op_ty1 op_ty2) - (text "The types of" <+> pname1 <+> - text "are different") `andThenCheck` - if is_boot - then check (liftEq eqDM def_meth1 def_meth2) - (text "The default methods associated with" <+> pname1 <+> - text "are different") - else check (subDM op_ty1 def_meth1 def_meth2) - (text "The default methods associated with" <+> pname1 <+> - text "are not compatible") - where - name1 = idName id1 - name2 = idName id2 - pname1 = quotes (ppr name1) - pname2 = quotes (ppr name2) - op_ty1 = classMethodTy id1 - op_ty2 = classMethodTy id2 - - eqAT (ATI tc1 def_ats1) (ATI tc2 def_ats2) - = checkBootTyCon is_boot tc1 tc2 `andThenCheck` - check (eqATDef def_ats1 def_ats2) - (text "The associated type defaults differ") - - eqDM (_, VanillaDM) (_, VanillaDM) = True - eqDM (_, GenericDM t1) (_, GenericDM t2) = eqTypeX env t1 t2 - eqDM _ _ = False - - -- NB: first argument is from hsig, second is from real impl. - -- Order of pattern matching matters. - subDM _ Nothing _ = True - subDM _ _ Nothing = False - - -- If the hsig wrote: - -- - -- f :: a -> a - -- default f :: a -> a - -- - -- this should be validly implementable using an old-fashioned - -- vanilla default method. - subDM t1 (Just (_, GenericDM gdm_t1)) (Just (_, VanillaDM)) - = eqType t1 gdm_t1 -- Take care (#22476). Both t1 and gdm_t1 come - -- from tc1, so use eqType, and /not/ eqTypeX - - -- This case can occur when merging signatures - subDM t1 (Just (_, VanillaDM)) (Just (_, GenericDM t2)) - = eqTypeX env t1 t2 - - subDM _ (Just (_, VanillaDM)) (Just (_, VanillaDM)) = True - subDM _ (Just (_, GenericDM t1)) (Just (_, GenericDM t2)) - = eqTypeX env t1 t2 - - -- Ignore the location of the defaults - eqATDef Nothing Nothing = True - eqATDef (Just (ty1, _loc1)) (Just (ty2, _loc2)) = eqTypeX env ty1 ty2 - eqATDef _ _ = False - - eqFD (as1,bs1) (as2,bs2) = - liftEq (eqTypeX env) (mkTyVarTys as1) (mkTyVarTys as2) && - liftEq (eqTypeX env) (mkTyVarTys bs1) (mkTyVarTys bs2) - in - checkRoles roles1 roles2 `andThenCheck` - -- Checks kind of class - check (liftEq eqFD clas_fds1 clas_fds2) - (text "The functional dependencies do not match") `andThenCheck` - checkUnless (isAbstractTyCon tc1) $ - check (liftEq (eqTypeX env) sc_theta1 sc_theta2) - (text "The class constraints do not match") `andThenCheck` - checkListBy eqSig op_stuff1 op_stuff2 (text "methods") `andThenCheck` - checkListBy eqAT ats1 ats2 (text "associated types") `andThenCheck` - check (classMinimalDef c1 `BF.implies` classMinimalDef c2) - (text "The MINIMAL pragmas are not compatible") + = do { check_roles + ; embedErrs (TyConMismatchedClasses c1 c2) $ + do { -- Checks kind of class + ; check (liftEq (eqFD env) clas_fds1 clas_fds2) + MismatchedFunDeps + ; unless (isAbstractTyCon tc1) $ + do { check (liftEq (eqTypeX env) sc_theta1 sc_theta2) + MismatchedSuperclasses + ; checkListBy (compatClassOp env boot_or_sig) op_stuff1 op_stuff2 + MismatchedMethods + ; checkListBy (compatAT env boot_or_sig) ats1 ats2 + MismatchedATs + ; check (classMinimalDef c1 `BF.implies` classMinimalDef c2) + MismatchedMinimalPragmas + } } } | Just syn_rhs1 <- synTyConRhs_maybe tc1 , Just syn_rhs2 <- synTyConRhs_maybe tc2 , Just env <- eqVarBndrs emptyRnEnv2 (tyConTyVars tc1) (tyConTyVars tc2) = assert (tc1 == tc2) $ - checkRoles roles1 roles2 `andThenCheck` - check (eqTypeX env syn_rhs1 syn_rhs2) empty -- nothing interesting to say + do { check_roles + ; check (eqTypeX env syn_rhs1 syn_rhs2) $ + TyConSynonymMismatch syn_rhs1 syn_rhs2 } + -- This allows abstract 'data T a' to be implemented using 'type T = ...' -- and abstract 'class K a' to be implement using 'type K = ...' -- See Note [Synonyms implement abstract data] - | not is_boot -- don't support for hs-boot yet + | Hsig <- boot_or_sig -- don't support for hs-boot yet , isAbstractTyCon tc1 , Just (tvs, ty) <- synTyConDefn_maybe tc2 - , Just (tc2', args) <- tcSplitTyConApp_maybe ty - = checkSynAbsData tvs ty tc2' args - -- TODO: When it's a synonym implementing a class, we really - -- should check if the fundeps are satisfied, but - -- there is not an obvious way to do this for a constraint synonym. - -- So for now, let it all through (it won't cause segfaults, anyway). - -- Tracked at #12704. - - -- This allows abstract 'data T :: Nat' to be implemented using - -- 'type T = 42' Since the kinds already match (we have checked this - -- upfront) all we need to check is that the implementation 'type T - -- = ...' defined an actual literal. See #15138 for the case this - -- handles. - | not is_boot - , isAbstractTyCon tc1 - , Just (_,ty2) <- synTyConDefn_maybe tc2 - , isJust (isLitTy ty2) - = Nothing + = checkSynAbsData tc1 tc2 tvs ty | Just fam_flav1 <- famTyConFlav_maybe tc1 , Just fam_flav2 <- famTyConFlav_maybe tc2 = assert (tc1 == tc2) $ - let eqFamFlav OpenSynFamilyTyCon OpenSynFamilyTyCon = True - eqFamFlav (DataFamilyTyCon {}) (DataFamilyTyCon {}) = True - -- This case only happens for hsig merging: - eqFamFlav AbstractClosedSynFamilyTyCon AbstractClosedSynFamilyTyCon = True - eqFamFlav AbstractClosedSynFamilyTyCon (ClosedSynFamilyTyCon {}) = True - eqFamFlav (ClosedSynFamilyTyCon {}) AbstractClosedSynFamilyTyCon = True - eqFamFlav (ClosedSynFamilyTyCon ax1) (ClosedSynFamilyTyCon ax2) - = eqClosedFamilyAx ax1 ax2 - eqFamFlav (BuiltInSynFamTyCon {}) (BuiltInSynFamTyCon {}) = tc1 == tc2 - eqFamFlav _ _ = False - injInfo1 = tyConInjectivityInfo tc1 - injInfo2 = tyConInjectivityInfo tc2 - in - -- check equality of roles, family flavours and injectivity annotations - -- (NB: Type family roles are always nominal. But the check is - -- harmless enough.) - checkRoles roles1 roles2 `andThenCheck` - check (eqFamFlav fam_flav1 fam_flav2) - (whenPprDebug $ - text "Family flavours" <+> ppr fam_flav1 <+> text "and" <+> ppr fam_flav2 <+> - text "do not match") `andThenCheck` - check (injInfo1 == injInfo2) (text "Injectivities do not match") + do { let injInfo1 = tyConInjectivityInfo tc1 + injInfo2 = tyConInjectivityInfo tc2 + ; -- check equality of roles, family flavours and injectivity annotations + -- (NB: Type family roles are always nominal. But the check is + -- harmless enough.) + ; check_roles + ; compatFamFlav fam_flav1 fam_flav2 + ; check (injInfo1 == injInfo2) TyConInjectivityMismatch } | isAlgTyCon tc1 && isAlgTyCon tc2 , Just env <- eqVarBndrs emptyRnEnv2 (tyConTyVars tc1) (tyConTyVars tc2) = assert (tc1 == tc2) $ - checkRoles roles1 roles2 `andThenCheck` - check (liftEq (eqTypeX env) + do { check_roles + ; let rhs1 = algTyConRhs tc1 + rhs2 = algTyConRhs tc2 + ; embedErrs (TyConMismatchedData rhs1 rhs2) $ + do { check (liftEq (eqTypeX env) (tyConStupidTheta tc1) (tyConStupidTheta tc2)) - (text "The datatype contexts do not match") `andThenCheck` - eqAlgRhs tc1 (algTyConRhs tc1) (algTyConRhs tc2) + MismatchedDatatypeContexts + ; compatAlgRhs rhs1 rhs2 } } - | otherwise = Just empty -- two very different types -- should be obvious + | otherwise = bootErr TyConsVeryDifferent + -- two very different types; + -- should be obvious to the user what the problem is where - roles1 = tyConRoles tc1 -- the abstract one - roles2 = tyConRoles tc2 - roles_msg = text "The roles do not match." $$ - (text "Roles on abstract types default to" <+> - quotes (text "representational") <+> text "in boot files.") - - roles_subtype_msg = text "The roles are not compatible:" $$ - text "Main module:" <+> ppr roles2 $$ - text "Hsig file:" <+> ppr roles1 - - checkRoles r1 r2 - | is_boot || isInjectiveTyCon tc1 Representational -- See Note [Role subtyping] - = check (r1 == r2) roles_msg - | otherwise = check (r2 `rolesSubtypeOf` r1) roles_subtype_msg - - -- Note [Role subtyping] - -- ~~~~~~~~~~~~~~~~~~~~~ - -- In the current formulation of roles, role subtyping is only OK if the - -- "abstract" TyCon was not representationally injective. Among the most - -- notable examples of non representationally injective TyCons are abstract - -- data, which can be implemented via newtypes (which are not - -- representationally injective). The key example is - -- in this example from #13140: - -- - -- -- In an hsig file - -- data T a -- abstract! - -- type role T nominal - -- - -- -- Elsewhere - -- foo :: Coercible (T a) (T b) => a -> b - -- foo x = x - -- - -- We must NOT allow foo to typecheck, because if we instantiate - -- T with a concrete data type with a phantom role would cause - -- Coercible (T a) (T b) to be provable. Fortunately, if T is not - -- representationally injective, we cannot make the inference that a ~N b if - -- T a ~R T b. - -- - -- Unconditional role subtyping would be possible if we setup - -- an extra set of roles saying when we can project out coercions - -- (we call these proj-roles); then it would NOT be valid to instantiate T - -- with a data type at phantom since the proj-role subtyping check - -- would fail. See #13140 for more details. - -- - -- One consequence of this is we get no role subtyping for non-abstract - -- data types in signatures. Suppose you have: - -- - -- signature A where - -- type role T nominal - -- data T a = MkT - -- - -- If you write this, we'll treat T as injective, and make inferences - -- like T a ~R T b ==> a ~N b (mkSelCo). But if we can - -- subsequently replace T with one at phantom role, we would then be able to - -- infer things like T Int ~R T Bool which is bad news. + check_roles = checkRoles boot_or_sig tc1 (tyConRoles tc2) + + +emptyRnEnv2 :: RnEnv2 +emptyRnEnv2 = mkRnEnv2 emptyInScopeSet + +-- | Check that two class methods have compatible type signatures. +compatClassOp :: RnEnv2 -> HsBootOrSig -> ClassOpItem -> ClassOpItem -> BootErrsM BootMethodMismatch +compatClassOp env boot_or_sig (id1, def_meth1) (id2, def_meth2) + = do { check (name1 == name2) $ + MismatchedMethodNames + ; check (eqTypeX env op_ty1 op_ty2) $ + MismatchedMethodTypes op_ty1 op_ty2 + ; case boot_or_sig of + HsBoot -> + check (liftEq eqDM def_meth1 def_meth2) $ + MismatchedDefaultMethods False + Hsig -> + check (subDM op_ty1 def_meth1 def_meth2) $ + MismatchedDefaultMethods True } + where + name1 = idName id1 + name2 = idName id2 + op_ty1 = classMethodTy id1 + op_ty2 = classMethodTy id2 + + eqDM (_, VanillaDM) (_, VanillaDM) = True + eqDM (_, GenericDM t1) (_, GenericDM t2) = eqTypeX env t1 t2 + eqDM _ _ = False + + -- NB: first argument is from hsig, second is from real impl. + -- Order of pattern matching matters. + subDM _ Nothing _ = True + subDM _ _ Nothing = False + + -- If the hsig wrote: -- - -- We could allow role subtyping here if we didn't treat *any* data types - -- defined in signatures as injective. But this would be a bit surprising, - -- replacing a data type in a module with one in a signature could cause - -- your code to stop typechecking (whereas if you made the type abstract, - -- it is more understandable that the type checker knows less). + -- f :: a -> a + -- default f :: a -> a -- - -- It would have been best if this was purely a question of defaults - -- (i.e., a user could explicitly ask for one behavior or another) but - -- the current role system isn't expressive enough to do this. - -- Having explicit proj-roles would solve this problem. + -- this should be validly implementable using an old-fashioned + -- vanilla default method. + subDM t1 (Just (_, GenericDM gdm_t1)) (Just (_, VanillaDM)) + = eqType t1 gdm_t1 -- Take care (#22476). Both t1 and gdm_t1 come + -- from tc1, so use eqType, and /not/ eqTypeX + + -- This case can occur when merging signatures + subDM t1 (Just (_, VanillaDM)) (Just (_, GenericDM t2)) + = eqTypeX env t1 t2 + + subDM _ (Just (_, VanillaDM)) (Just (_, VanillaDM)) = True + subDM _ (Just (_, GenericDM t1)) (Just (_, GenericDM t2)) + = eqTypeX env t1 t2 + +-- | Check that two associated types are compatible. +compatAT :: RnEnv2 -> HsBootOrSig -> ClassATItem -> ClassATItem + -> BootErrsM BootATMismatch +compatAT env boot_or_sig (ATI tc1 def_ats1) (ATI tc2 def_ats2) + = do { embedErrs MismatchedTyConAT $ + checkBootTyCon boot_or_sig tc1 tc2 + ; check (compatATDef def_ats1 def_ats2) + MismatchedATDefaultType } + + where + -- Ignore the location of the defaults + compatATDef Nothing Nothing = True + compatATDef (Just (ty1, _loc1)) (Just (ty2, _loc2)) = eqTypeX env ty1 ty2 + compatATDef _ _ = False + +-- | Check that two functional dependencies are the same. +eqFD :: RnEnv2 -> FunDep TyVar -> FunDep TyVar -> Bool +eqFD env (as1,bs1) (as2,bs2) = + liftEq (eqTypeX env) (mkTyVarTys as1) (mkTyVarTys as2) && + liftEq (eqTypeX env) (mkTyVarTys bs1) (mkTyVarTys bs2) + +-- | Check compatibility of two type family flavours. +compatFamFlav :: FamTyConFlav -> FamTyConFlav -> BootErrsM BootTyConMismatch +compatFamFlav OpenSynFamilyTyCon OpenSynFamilyTyCon + = checkSuccess +compatFamFlav (DataFamilyTyCon {}) (DataFamilyTyCon {}) + = checkSuccess +compatFamFlav AbstractClosedSynFamilyTyCon AbstractClosedSynFamilyTyCon + = checkSuccess -- This case only happens for hsig merging. +compatFamFlav AbstractClosedSynFamilyTyCon (ClosedSynFamilyTyCon {}) + = checkSuccess +compatFamFlav (ClosedSynFamilyTyCon {}) AbstractClosedSynFamilyTyCon + = checkSuccess +compatFamFlav (ClosedSynFamilyTyCon ax1) (ClosedSynFamilyTyCon ax2) + = eqClosedFamilyAx ax1 ax2 +compatFamFlav (BuiltInSynFamTyCon {}) (BuiltInSynFamTyCon {}) + = checkSuccess +compatFamFlav flav1 flav2 + = bootErr $ TyConFlavourMismatch flav1 flav2 + +-- | Check that two 'AlgTyConRhs's are compatible. +compatAlgRhs :: AlgTyConRhs -> AlgTyConRhs -> BootErrsM BootDataMismatch +compatAlgRhs (AbstractTyCon {}) _rhs2 = + checkSuccess -- rhs2 is guaranteed to be injective, since it's an AlgTyCon +compatAlgRhs tc1@DataTyCon{} tc2@DataTyCon{} = + checkListBy compatCon (data_cons tc1) (data_cons tc2) MismatchedConstructors +compatAlgRhs tc1@NewTyCon{ data_con = dc1 } tc2@NewTyCon{ data_con = dc2 } = + embedErrs (MismatchedConstructors . NE.singleton . MismatchedThing 1 dc1 dc2) $ + compatCon (data_con tc1) (data_con tc2) +compatAlgRhs _ _ = bootErr MismatchedNewtypeVsData + +-- | Check that two 'DataCon's are compatible. +compatCon :: DataCon -> DataCon -> BootErrsM BootDataConMismatch +compatCon c1 c2 + = do { check (dataConName c1 == dataConName c2) + MismatchedDataConNames + ; check (dataConIsInfix c1 == dataConIsInfix c2) + MismatchedDataConFixities + ; check (liftEq eqHsBang (dataConImplBangs c1) (dataConImplBangs c2)) + MismatchedDataConBangs + ; check (map flSelector (dataConFieldLabels c1) == map flSelector (dataConFieldLabels c2)) + MismatchedDataConFieldLabels + ; check (eqType (dataConWrapperType c1) (dataConWrapperType c2)) + MismatchedDataConTypes } + +eqClosedFamilyAx :: Maybe (CoAxiom br) -> Maybe (CoAxiom br1) + -> BootErrsM BootTyConMismatch +eqClosedFamilyAx Nothing Nothing = checkSuccess +eqClosedFamilyAx Nothing (Just _) = bootErr $ TyConAxiomMismatch $ NE.singleton MismatchedLength +eqClosedFamilyAx (Just _) Nothing = bootErr $ TyConAxiomMismatch $ NE.singleton MismatchedLength +eqClosedFamilyAx (Just (CoAxiom { co_ax_branches = branches1 })) + (Just (CoAxiom { co_ax_branches = branches2 })) + = checkListBy eqClosedFamilyBranch branch_list1 branch_list2 + TyConAxiomMismatch + where + branch_list1 = fromBranches branches1 + branch_list2 = fromBranches branches2 + +eqClosedFamilyBranch :: CoAxBranch -> CoAxBranch -> BootErrsM BootAxiomBranchMismatch +eqClosedFamilyBranch (CoAxBranch { cab_tvs = tvs1, cab_cvs = cvs1 + , cab_lhs = lhs1, cab_rhs = rhs1 }) + (CoAxBranch { cab_tvs = tvs2, cab_cvs = cvs2 + , cab_lhs = lhs2, cab_rhs = rhs2 }) + | Just env1 <- eqVarBndrs emptyRnEnv2 tvs1 tvs2 + , Just env <- eqVarBndrs env1 cvs1 cvs2 + = do { check (liftEq (eqTypeX env) lhs1 lhs2) MismatchedAxiomLHS + ; check (eqTypeX env rhs1 rhs2) MismatchedAxiomRHS } + | otherwise + = bootErr MismatchedAxiomBinders + +{- Note [Role subtyping] +~~~~~~~~~~~~~~~~~~~~~~~~ +In the current formulation of roles, role subtyping is only OK if the +"abstract" TyCon was not representationally injective. Among the most +notable examples of non representationally injective TyCons are abstract +data, which can be implemented via newtypes (which are not +representationally injective). The key example is +in this example from #13140: + + -- In an hsig file + data T a -- abstract! + type role T nominal + + -- Elsewhere + foo :: Coercible (T a) (T b) => a -> b + foo x = x + +We must NOT allow foo to typecheck, because if we instantiate +T with a concrete data type with a phantom role would cause +Coercible (T a) (T b) to be provable. Fortunately, if T is not +representationally injective, we cannot make the inference that a ~N b if +T a ~R T b. + +Unconditional role subtyping would be possible if we setup +an extra set of roles saying when we can project out coercions +(we call these proj-roles); then it would NOT be valid to instantiate T +with a data type at phantom since the proj-role subtyping check +would fail. See #13140 for more details. + +One consequence of this is we get no role subtyping for non-abstract +data types in signatures. Suppose you have: + + signature A where + type role T nominal + data T a = MkT + +If you write this, we'll treat T as injective, and make inferences +like T a ~R T b ==> a ~N b (mkSelCo). But if we can +subsequently replace T with one at phantom role, we would then be able to +infer things like T Int ~R T Bool which is bad news. + +We could allow role subtyping here if we didn't treat *any* data types +defined in signatures as injective. But this would be a bit surprising, +replacing a data type in a module with one in a signature could cause +your code to stop typechecking (whereas if you made the type abstract, +it is more understandable that the type checker knows less). + +It would have been best if this was purely a question of defaults +(i.e., a user could explicitly ask for one behavior or another) but +the current role system isn't expressive enough to do this. +Having explicit proj-roles would solve this problem. +-} + +checkRoles :: HsBootOrSig -> TyCon -> [Role] -> BootErrsM BootTyConMismatch +checkRoles boot_or_sig tc1 r2 + | boot_or_sig == HsBoot + || isInjectiveTyCon tc1 Representational -- See Note [Role subtyping] + = check (r1 == r2) (TyConRoleMismatch False) + | otherwise + = check (r2 `rolesSubtypeOf` r1) (TyConRoleMismatch True) + where + + r1 = tyConRoles tc1 rolesSubtypeOf [] [] = True -- NB: this relation is the OPPOSITE of the subroling relation rolesSubtypeOf (x:xs) (y:ys) = x >= y && rolesSubtypeOf xs ys rolesSubtypeOf _ _ = False - -- Note [Synonyms implement abstract data] - -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -- An abstract data type or class can be implemented using a type synonym, - -- but ONLY if the type synonym is nullary and has no type family - -- applications. This arises from two properties of skolem abstract data: - -- - -- For any T (with some number of parameters), - -- - -- 1. T is a valid type (it is "curryable"), and - -- - -- 2. T is valid in an instance head (no type families). - -- - -- See also 'HowAbstract' and Note [Skolem abstract data]. - - -- Given @type T tvs = ty@, where @ty@ decomposes into @tc2' args@, - -- check that this synonym is an acceptable implementation of @tc1@. - -- See Note [Synonyms implement abstract data] - checkSynAbsData :: [TyVar] -> Type -> TyCon -> [Type] -> Maybe SDoc - checkSynAbsData tvs ty tc2' args = - check (null (tcTyFamInsts ty)) - (text "Illegal type family application in implementation of abstract data.") - `andThenCheck` - check (null tvs) - (text "Illegal parameterized type synonym in implementation of abstract data." $$ - text "(Try eta reducing your type synonym so that it is nullary.)") - `andThenCheck` - -- Don't report roles errors unless the type synonym is nullary - checkUnless (not (null tvs)) $ - assert (null roles2) $ - -- If we have something like: - -- - -- signature H where - -- data T a - -- module H where - -- data K a b = ... - -- type T = K Int - -- - -- we need to drop the first role of K when comparing! - checkRoles roles1 (drop (length args) (tyConRoles tc2')) -{- - -- Hypothetically, if we were allow to non-nullary type synonyms, here - -- is how you would check the roles - if length tvs == length roles1 - then checkRoles roles1 roles2 - else case tcSplitTyConApp_maybe ty of - Just (tc2', args) -> - checkRoles roles1 (drop (length args) (tyConRoles tc2') ++ roles2) - Nothing -> Just roles_msg --} +{- Note [Synonyms implement abstract data] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +An abstract data type or class can be implemented using a type synonym, +but ONLY if: - eqAlgRhs _ (AbstractTyCon {}) _rhs2 - = checkSuccess -- rhs2 is guaranteed to be injective, since it's an AlgTyCon - eqAlgRhs _ tc1@DataTyCon{} tc2@DataTyCon{} = - checkListBy eqCon (data_cons tc1) (data_cons tc2) (text "constructors") - eqAlgRhs _ tc1@NewTyCon{} tc2@NewTyCon{} = - eqCon (data_con tc1) (data_con tc2) - eqAlgRhs _ _ _ = Just (text "Cannot match a" <+> quotes (text "data") <+> - text "definition with a" <+> quotes (text "newtype") <+> - text "definition") - - eqCon c1 c2 - = check (name1 == name2) - (text "The names" <+> pname1 <+> text "and" <+> pname2 <+> - text "differ") `andThenCheck` - check (dataConIsInfix c1 == dataConIsInfix c2) - (text "The fixities of" <+> pname1 <+> - text "differ") `andThenCheck` - check (liftEq eqHsBang (dataConImplBangs c1) (dataConImplBangs c2)) - (text "The strictness annotations for" <+> pname1 <+> - text "differ") `andThenCheck` - check (map flSelector (dataConFieldLabels c1) == map flSelector (dataConFieldLabels c2)) - (text "The record label lists for" <+> pname1 <+> - text "differ") `andThenCheck` - check (eqType (dataConWrapperType c1) (dataConWrapperType c2)) - (text "The types for" <+> pname1 <+> text "differ") - where - name1 = dataConName c1 - name2 = dataConName c2 - pname1 = quotes (ppr name1) - pname2 = quotes (ppr name2) - - eqClosedFamilyAx Nothing Nothing = True - eqClosedFamilyAx Nothing (Just _) = False - eqClosedFamilyAx (Just _) Nothing = False - eqClosedFamilyAx (Just (CoAxiom { co_ax_branches = branches1 })) - (Just (CoAxiom { co_ax_branches = branches2 })) - = numBranches branches1 == numBranches branches2 - && (and $ zipWith eqClosedFamilyBranch branch_list1 branch_list2) - where - branch_list1 = fromBranches branches1 - branch_list2 = fromBranches branches2 + 1. T, as a standalone occurrence, is a valid type + (T is "curryable"), and - eqClosedFamilyBranch (CoAxBranch { cab_tvs = tvs1, cab_cvs = cvs1 - , cab_lhs = lhs1, cab_rhs = rhs1 }) - (CoAxBranch { cab_tvs = tvs2, cab_cvs = cvs2 - , cab_lhs = lhs2, cab_rhs = rhs2 }) - | Just env1 <- eqVarBndrs emptyRnEnv2 tvs1 tvs2 - , Just env <- eqVarBndrs env1 cvs1 cvs2 - = liftEq (eqTypeX env) lhs1 lhs2 && - eqTypeX env rhs1 rhs2 + 2. T is valid in an instance head. - | otherwise = False +This gives rise to the following conditions under which we can implement +an abstract data declaration @data T@ using a type synonym @type T tvs = rhs@: -emptyRnEnv2 :: RnEnv2 -emptyRnEnv2 = mkRnEnv2 emptyInScopeSet + 1. The type synonym T is nullary (tvs is null). ----------------- -missingBootThing :: Bool -> Name -> String -> TcRnMessage -missingBootThing is_boot name what - = mkTcRnUnknownMessage $ mkPlainError noHints $ - quotes (ppr name) <+> text "is exported by the" - <+> (if is_boot then text "hs-boot" else text "hsig") - <+> text "file, but not" - <+> text what <+> text "the module" - -badReexportedBootThing :: Bool -> Name -> Name -> TcRnMessage -badReexportedBootThing is_boot name name' - = mkTcRnUnknownMessage $ mkPlainError noHints $ - withUserStyle alwaysQualify AllTheWay $ vcat - [ text "The" <+> (if is_boot then text "hs-boot" else text "hsig") - <+> text "file (re)exports" <+> quotes (ppr name) - , text "but the implementing module exports a different identifier" <+> quotes (ppr name') - ] - -bootMisMatch :: Bool -> SDoc -> TyThing -> TyThing -> TcRnMessage -bootMisMatch is_boot extra_info real_thing boot_thing - = mkTcRnUnknownMessage $ mkPlainError noHints $ - pprBootMisMatch is_boot extra_info real_thing real_doc boot_doc + 2. The rhs must not contain any foralls, quantified types, or type family + applications. + See 'invalidAbsDataSubTypes' which computes a collection of + invalid subtypes. + +See also 'HowAbstract' and Note [Skolem abstract data]. +-} + +-- | We are implementing an abstract data declaration of the form @data T@ +-- in a signature file, with a type synonym @type T tvs = rhs@ in the +-- implementing module. +-- +-- This function checks that the implementation is valid: +-- +-- 1. the type synonym T is nullary, i.e. tvs is null, +-- 2. rhs doesn't contain any type families, foralls, or qualified types. +-- +-- See Note [Synonyms implement abstract data] +checkSynAbsData :: TyCon -- ^ @tc1@, the abstract data 'TyCon' we are implementing + -> TyCon -- ^ @tc2@, a type synonym @type T tvs = ty@ + -- we are using to implement @tc1@ + -> [TyVar] -- ^ @tvs@ + -> Type -- ^ @ty@ + -> BootErrsM BootTyConMismatch +checkSynAbsData tc1 tc2 syn_tvs syn_rhs + -- We are implementing @data T@ with @type T tvs = rhs@. + -- Check the conditions of Note [Synonyms implement abstract data]. + = do { -- (1): T is nullary. + ; check (null syn_tvs) $ + SynAbstractData SynAbsDataTySynNotNullary + -- (2): the RHS of the type synonym is valid. + ; case invalidAbsDataSubTypes syn_rhs of + [] -> checkSuccess + err:errs -> bootErr $ SynAbstractData $ + SynAbstractDataInvalidRHS (err :| errs) + -- NB: this allows implementing e.g. @data T :: Nat@ with @type T = 3@. + -- See #15138. + + -- TODO: When it's a synonym implementing a class, we really + -- should check that the fundeps are satisfied, but + -- there is not an obvious way to do this for a constraint synonym. + -- So for now, let it all through (it won't cause segfaults, anyway). + -- Tracked at #12704. + + -- ... we also need to check roles. + ; if | Just (tc2', args) <- tcSplitTyConApp_maybe syn_rhs + , null syn_tvs -- Don't report role errors unless the type synonym is nullary + -> assert (null (tyConRoles tc2)) $ + -- If we have something like: + -- + -- signature H where + -- data T a + -- module H where + -- data K a b = ... + -- type T = K Int + -- + -- we need to drop the first role of K when comparing! + checkRoles Hsig tc1 (drop (length args) (tyConRoles tc2')) + | otherwise + -> checkSuccess + } + +{- + -- Hypothetically, if we were allow to non-nullary type synonyms, here + -- is how you would check the roles + if length tvs == length roles1 + then checkRoles roles1 roles2 + else case tcSplitTyConApp_maybe ty of + Just (tc2', args) -> + checkRoles Hsig tc1 (drop (length args) (tyConRoles tc2') ++ roles2) + Nothing -> Just roles_msg +-} + +-- | Is this type a valid implementation of abstract data? +-- +-- Returns a list of invalid sub-types encountered. +invalidAbsDataSubTypes :: Type -> [Type] +invalidAbsDataSubTypes = execWriter . go where - to_doc - = pprTyThingInContext $ showToHeader { ss_forall = - if is_boot - then ShowForAllMust - else ShowForAllWhen } - - real_doc = to_doc real_thing - boot_doc = to_doc boot_thing - - pprBootMisMatch :: Bool -> SDoc -> TyThing -> SDoc -> SDoc -> SDoc - pprBootMisMatch is_boot extra_info real_thing real_doc boot_doc - = vcat - [ ppr real_thing <+> - text "has conflicting definitions in the module", - text "and its" <+> - (if is_boot - then text "hs-boot file" - else text "hsig file"), - text "Main module:" <+> real_doc, - (if is_boot - then text "Boot file: " - else text "Hsig file: ") - <+> boot_doc, - extra_info - ] - -instMisMatch :: DFunId -> TcRnMessage -instMisMatch dfun - = mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "instance" <+> ppr (idType dfun)) - 2 (text "is defined in the hs-boot file, but not in the module itself") + go :: Type -> Writer [Type] () + go ty + | Just ty' <- coreView ty + = go ty' + go TyVarTy{} + = ok -- We report an error at the binding site of type variables, + -- e.g. in the TySyn LHS or in the forall. + -- It's not useful to report a second error for their occurrences + go (AppTy t1 t2) + = do { go t1; go t2 } + go ty@(TyConApp tc tys) + | isTypeFamilyTyCon tc + = invalid ty + | otherwise + = mapM_ go tys + go ty@(ForAllTy{}) + = invalid ty + go ty@(FunTy af w t1 t2) + | af == FTF_T_T + = do { go w + ; go (typeKind t1) ; go t1 + ; go (typeKind t2) ; go t2 + } + | otherwise + = invalid ty + go LitTy{} + = ok + go ty@(CastTy{}) + = invalid ty + go ty@(CoercionTy{}) + = invalid ty + + ok = pure () + invalid ty = tell [ty] {- ************************************************************************ @@ -1609,13 +1626,6 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls, updLclEnv (\tcl_env -> tcl_env { tcl_th_bndrs = th_bndrs `plusNameEnv` tcl_th_bndrs tcl_env }) $ setGblEnv tcg_env $ do { - -- Generate Applicative/Monad proposal (AMP) warnings - traceTc "Tc3b" empty ; - - -- Generate Semigroup/Monoid warnings - traceTc "Tc3c" empty ; - tcSemigroupWarnings ; - -- Foreign import declarations next. traceTc "Tc4" empty ; (fi_ids, fi_decls, fi_gres) <- tcForeignImports foreign_decls ; @@ -1689,196 +1699,6 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls, tcTopSrcDecls _ = panic "tcTopSrcDecls: ValBindsIn" - -tcSemigroupWarnings :: TcM () -tcSemigroupWarnings = do - mod <- getModule - -- ghc-prim doesn't depend on base - unless (moduleUnit mod == primUnit) $ do - traceTc "tcSemigroupWarnings" empty - let warnFlag = Opt_WarnSemigroup - tcPreludeClashWarn warnFlag sappendName - tcMissingParentClassWarn warnFlag monoidClassName semigroupClassName - - --- | Warn on local definitions of names that would clash with future Prelude --- elements. --- --- A name clashes if the following criteria are met: --- 1. It would is imported (unqualified) from Prelude --- 2. It is locally defined in the current module --- 3. It has the same literal name as the reference function --- 4. It is not identical to the reference function -tcPreludeClashWarn :: WarningFlag - -> Name - -> TcM () -tcPreludeClashWarn warnFlag name = do - { warn <- woptM warnFlag - ; when warn $ do - { traceTc "tcPreludeClashWarn/wouldBeImported" empty - -- Is the name imported (unqualified) from Prelude? (Point 4 above) - ; rnImports <- fmap (map unLoc . tcg_rn_imports) getGblEnv - -- (Note that this automatically handles -XNoImplicitPrelude, as Prelude - -- will not appear in rnImports automatically if it is set.) - - -- Continue only the name is imported from Prelude - ; when (importedViaPrelude name rnImports) $ do - -- Handle 2.-4. - { rdrElts <- fmap (concat . nonDetOccEnvElts . tcg_rdr_env) getGblEnv - - ; let clashes :: GlobalRdrElt -> Bool - clashes x = isLocalDef && nameClashes && isNotInProperModule - where - isLocalDef = gre_lcl x == True - -- Names are identical ... - nameClashes = nameOccName (greName x) == nameOccName name - -- ... but not the actual definitions, because we don't want to - -- warn about a bad definition of e.g. <> in Data.Semigroup, which - -- is the (only) proper place where this should be defined - isNotInProperModule = greName x /= name - - -- List of all offending definitions - clashingElts :: [GlobalRdrElt] - clashingElts = filter clashes rdrElts - - ; traceTc "tcPreludeClashWarn/prelude_functions" - (hang (ppr name) 4 (sep [ppr clashingElts])) - - ; let warn_msg x = addDiagnosticAt (nameSrcSpan (greName x)) $ - mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag warnFlag) noHints $ (hsep - [ text "Local definition of" - , (quotes . ppr . nameOccName . greName) x - , text "clashes with a future Prelude name." ] - $$ - text "This will become an error in a future release." ) - ; mapM_ warn_msg clashingElts - }}} - - where - - -- Is the given name imported via Prelude? - -- - -- Possible scenarios: - -- a) Prelude is imported implicitly, issue warnings. - -- b) Prelude is imported explicitly, but without mentioning the name in - -- question. Issue no warnings. - -- c) Prelude is imported hiding the name in question. Issue no warnings. - -- d) Qualified import of Prelude, no warnings. - importedViaPrelude :: Name - -> [ImportDecl GhcRn] - -> Bool - importedViaPrelude name = any importViaPrelude - where - isPrelude :: ImportDecl GhcRn -> Bool - isPrelude imp = unLoc (ideclName imp) == pRELUDE_NAME - - -- Implicit (Prelude) import? - isImplicit :: ImportDecl GhcRn -> Bool - isImplicit = ideclImplicit . ideclExt - - -- Unqualified import? - isUnqualified :: ImportDecl GhcRn -> Bool - isUnqualified = not . isImportDeclQualified . ideclQualified - - -- List of explicitly imported (or hidden) Names from a single import. - -- Nothing -> No explicit imports - -- Just (False, <names>) -> Explicit import list of <names> - -- Just (True , <names>) -> Explicit hiding of <names> - importListOf :: ImportDecl GhcRn -> Maybe (ImportListInterpretation, [Name]) - importListOf = fmap toImportList . ideclImportList - where - toImportList (h, loc) = (h, map (ieName . unLoc) (unLoc loc)) - - isExplicit :: ImportDecl GhcRn -> Bool - isExplicit x = case importListOf x of - Nothing -> False - Just (Exactly, explicit) - -> nameOccName name `elem` map nameOccName explicit - Just (EverythingBut, hidden) - -> nameOccName name `notElem` map nameOccName hidden - - -- Check whether the given name would be imported (unqualified) from - -- an import declaration. - importViaPrelude :: ImportDecl GhcRn -> Bool - importViaPrelude x = isPrelude x - && isUnqualified x - && (isImplicit x || isExplicit x) - - --- Notation: is* is for classes the type is an instance of, should* for those --- that it should also be an instance of based on the corresponding --- is*. -tcMissingParentClassWarn :: WarningFlag - -> Name -- ^ Instances of this ... - -> Name -- ^ should also be instances of this - -> TcM () -tcMissingParentClassWarn warnFlag isName shouldName - = do { warn <- woptM warnFlag - ; when warn $ do - { traceTc "tcMissingParentClassWarn" empty - ; isClass' <- tcLookupClass_maybe isName - ; shouldClass' <- tcLookupClass_maybe shouldName - ; case (isClass', shouldClass') of - (Just isClass, Just shouldClass) -> do - { localInstances <- tcGetInsts - ; let isInstance m = is_cls m == isClass - isInsts = filter isInstance localInstances - ; traceTc "tcMissingParentClassWarn/isInsts" (ppr isInsts) - ; forM_ isInsts (checkShouldInst isClass shouldClass) - } - (is',should') -> - traceTc "tcMissingParentClassWarn/notIsShould" - (hang (ppr isName <> text "/" <> ppr shouldName) 2 ( - (hsep [ quotes (text "Is"), text "lookup for" - , ppr isName - , text "resulted in", ppr is' ]) - $$ - (hsep [ quotes (text "Should"), text "lookup for" - , ppr shouldName - , text "resulted in", ppr should' ]))) - }} - where - -- Check whether the desired superclass exists in a given environment. - checkShouldInst :: Class -- Class of existing instance - -> Class -- Class there should be an instance of - -> ClsInst -- Existing instance - -> TcM () - checkShouldInst isClass shouldClass isInst - = do { instEnv <- tcGetInstEnvs - ; let (instanceMatches, shouldInsts, _) - = lookupInstEnv False instEnv shouldClass (is_tys isInst) - - ; traceTc "tcMissingParentClassWarn/checkShouldInst" - (hang (ppr isInst) 4 - (sep [ppr instanceMatches, ppr shouldInsts])) - - -- "<location>: Warning: <type> is an instance of <is> but not - -- <should>" e.g. "Foo is an instance of Monad but not Applicative" - ; let instLoc = srcLocSpan . nameSrcLoc $ getName isInst - warnMsg (RM_KnownTc name:_) = - addDiagnosticAt instLoc $ - mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag warnFlag) noHints $ - hsep [ (quotes . ppr . nameOccName) name - , text "is an instance of" - , (ppr . nameOccName . className) isClass - , text "but not" - , (ppr . nameOccName . className) shouldClass ] - <> text "." - $$ - hsep [ text "This will become an error in" - , text "a future release." ] - warnMsg _ = pure () - ; when (nullUnifiers shouldInsts && null instanceMatches) $ - warnMsg (is_tcs isInst) - } - - tcLookupClass_maybe :: Name -> TcM (Maybe Class) - tcLookupClass_maybe name = tcLookupImported_maybe name >>= \case - Succeeded (ATyCon tc) | cls@(Just _) <- tyConClass_maybe tc -> pure cls - _else -> pure Nothing - - --------------------------- tcTyClsInstDecls :: [TyClGroup GhcRn] -> [LDerivDecl GhcRn] @@ -1996,13 +1816,7 @@ checkMain explicit_mod_hdr export_ies -- in other modes, add error message and go on with typechecking. noMainMsg main_mod main_occ - = mkTcRnUnknownMessage $ mkPlainError noHints $ - text "The" <+> ppMainFn main_occ - <+> text "is not" <+> text defOrExp <+> text "module" - <+> quotes (ppr main_mod) - - defOrExp | explicit_export_list = "exported by" - | otherwise = "defined in" + = TcRnMissingMain explicit_export_list main_mod main_occ explicit_export_list = explicit_mod_hdr && isJust export_ies -- | Get the unqualified name of the function to use as the \"main\" for the main module. @@ -2010,17 +1824,7 @@ checkMain explicit_mod_hdr export_ies getMainOcc :: DynFlags -> OccName getMainOcc dflags = case mainFunIs dflags of Just fn -> mkVarOccFS (mkFastString fn) - Nothing -> mainOcc - -ppMainFn :: OccName -> SDoc -ppMainFn main_occ - | main_occ == mainOcc - = text "IO action" <+> quotes (ppr main_occ) - | otherwise - = text "main IO action" <+> quotes (ppr main_occ) - -mainOcc :: OccName -mainOcc = mkVarOccFS (fsLit "main") + Nothing -> mkVarOccFS (fsLit "main") generateMainBinding :: TcGblEnv -> Name -> TcM TcGblEnv -- There is a single exported 'main' function, called 'foo' (say), @@ -2302,7 +2106,8 @@ tcRnStmt hsc_env rdr_stmt -- None of the Ids should be of unboxed type, because we -- cast them all to HValues in the end! - mapM_ bad_unboxed (filter (mightBeUnliftedType . idType) zonked_ids) ; + mapM_ (addErr . TcRnGhciUnliftedBind) $ + filter (mightBeUnliftedType . idType) zonked_ids ; traceTc "tcs 1" empty ; this_mod <- getModule ; @@ -2315,10 +2120,6 @@ tcRnStmt hsc_env rdr_stmt return (global_ids, zonked_expr, fix_env) } - where - bad_unboxed id = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - (sep [text "GHCi can't bind a variable of unlifted type:", - nest 2 (pprPrefixOcc id <+> dcolon <+> ppr (idType id))]) {- -------------------------------------------------------------------------- @@ -2675,9 +2476,7 @@ isGHCiMonad hsc_env ty let userTy = mkTyConApp userTyCon [] _ <- tcLookupInstance ghciClass [userTy] return name - - Just _ -> failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ text "Ambiguous type!" - Nothing -> failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ text ("Can't find type:" ++ ty) + _ -> failWithTc $ TcRnGhciMonadLookupFail ty occIO -- | How should we infer a type? See Note [TcRnExprMode] data TcRnExprMode = TM_Inst -- ^ Instantiate inferred quantifiers only (:type) @@ -2981,8 +2780,7 @@ tcRnLookupRdrName hsc_env (L loc rdr_name) let rdr_names = dataTcOccs rdr_name ; names_s <- mapM lookupInfoOccRn rdr_names ; let names = concat names_s - ; when (null names) (addErrTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ - (text "Not in scope:" <+> quotes (ppr rdr_name))) + ; when (null names) (addErrTc $ mkTcRnNotInScope rdr_name NotInScope) ; return names } tcRnLookupName :: HscEnv -> Name -> IO (Messages TcRnMessage, Maybe TyThing) diff --git a/compiler/GHC/Tc/Module.hs-boot b/compiler/GHC/Tc/Module.hs-boot index 40d89fe727..12a88ba72d 100644 --- a/compiler/GHC/Tc/Module.hs-boot +++ b/compiler/GHC/Tc/Module.hs-boot @@ -1,12 +1,7 @@ module GHC.Tc.Module where -import GHC.Prelude +import GHC.Types.SourceFile(HsBootOrSig) import GHC.Types.TyThing(TyThing) -import GHC.Tc.Errors.Types (TcRnMessage) import GHC.Tc.Types (TcM) -import GHC.Types.Name (Name) -checkBootDeclM :: Bool -- ^ True <=> an hs-boot file (could also be a sig) - -> TyThing -> TyThing -> TcM () -missingBootThing :: Bool -> Name -> String -> TcRnMessage -badReexportedBootThing :: Bool -> Name -> Name -> TcRnMessage +checkBootDeclM :: HsBootOrSig -> TyThing -> TyThing -> TcM () diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs index f0bfb8b4da..a2d8a30c9c 100644 --- a/compiler/GHC/Tc/TyCl/Instance.hs +++ b/compiler/GHC/Tc/TyCl/Instance.hs @@ -23,6 +23,7 @@ where import GHC.Prelude import GHC.Hs +import GHC.Rename.Bind ( rejectBootDecls ) import GHC.Tc.Errors.Types import GHC.Tc.Gen.Bind import GHC.Tc.TyCl @@ -75,6 +76,7 @@ import GHC.Driver.Ppr import GHC.Utils.Logger import GHC.Data.FastString import GHC.Types.Id +import GHC.Types.SourceFile import GHC.Types.SourceText import GHC.Data.List.SetOps import GHC.Types.Name @@ -488,7 +490,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty, cid_binds = binds , cid_sigs = uprags, cid_tyfam_insts = ats , cid_overlap_mode = overlap_mode , cid_datafam_insts = adts })) - = setSrcSpanA loc $ + = setSrcSpanA loc $ addErrCtxt (instDeclCtxt1 hs_ty) $ do { dfun_ty <- tcHsClsInstType (InstDeclCtxt False) hs_ty ; let (tyvars, theta, clas, inst_tys) = tcSplitDFunTy dfun_ty @@ -555,11 +557,13 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty, cid_binds = binds all_insts = tyfam_insts ++ datafam_insts -- In hs-boot files there should be no bindings - ; let no_binds = isEmptyLHsBinds binds && null uprags - ; is_boot <- tcIsHsBootOrSig - ; failIfTc (is_boot && not no_binds) TcRnIllegalHsBootFileDecl - - ; return ( [inst_info], all_insts, deriv_infos ) } + ; gbl_env <- getGblEnv; + ; case tcg_src gbl_env of + { HsSrcFile -> return () + ; HsBootOrSig boot_or_sig -> + do { rejectBootDecls boot_or_sig BootBindsRn (bagToList binds) + ; rejectBootDecls boot_or_sig BootInstanceSigs uprags } } + ; return ([inst_info], all_insts, deriv_infos) } where defined_ats = mkNameSet (map (tyFamInstDeclName . unLoc) ats) `unionNameSet` @@ -619,9 +623,13 @@ tcFamInstDeclChecks mb_clsinfo fam_tc -- and can't (currently) be in an hs-boot file ; traceTc "tcFamInstDecl" (ppr fam_tc) ; type_families <- xoptM LangExt.TypeFamilies - ; is_boot <- tcIsHsBootOrSig -- Are we compiling an hs-boot file? + ; hs_src <- tcHscSource -- Are we compiling an hs-boot file? ; checkTc type_families (TcRnTyFamsDisabled (TyFamsDisabledInstance fam_tc)) - ; checkTc (not is_boot) TcRnBadBootFamInstDecl + ; case hs_src of + HsBootOrSig boot_or_sig -> + addErrTc $ TcRnIllegalHsBootOrSigDecl boot_or_sig (BootFamInst fam_tc) + HsSrcFile -> + return () -- Check that it is a family TyCon, and that -- oplevel type instances are not for associated types. diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs index 5f76ba7e0c..4d93bf1aec 100644 --- a/compiler/GHC/Tc/Utils/Backpack.hs +++ b/compiler/GHC/Tc/Utils/Backpack.hs @@ -94,7 +94,7 @@ checkHsigDeclM sig_iface sig_thing real_thing = do let name = getName real_thing -- TODO: Distinguish between signature merging and signature -- implementation cases. - checkBootDeclM False sig_thing real_thing + checkBootDeclM Hsig sig_thing real_thing real_fixity <- lookupFixityRn name let sig_fixity = case mi_fix_fn (mi_final_exts sig_iface) (occName name) of Nothing -> defaultFixity @@ -159,7 +159,7 @@ checkHsigIface tcg_env gre_env sig_iface -- The hsig did NOT define this function; that means it must -- be a reexport. In this case, make sure the 'Name' of the - -- reexport matches the 'Name exported here. + -- reexport matches the 'Name' exported here. | [gre] <- lookupGRE_OccName (AllNameSpaces WantNormal) gre_env (nameOccName name) = do let name' = greName gre when (name /= name') $ do @@ -174,11 +174,11 @@ checkHsigIface tcg_env gre_env sig_iface -> getLocA e _ -> nameSrcSpan name addErrAt loc - (badReexportedBootThing False name name') + (TcRnBootMismatch Hsig $ BadReexportedBootThing name name') -- This should actually never happen, but whatever... | otherwise = addErrAt (nameSrcSpan name) - (missingBootThing False name "exported by") + (missingBootThing Hsig name MissingBootExport) -- Note [Fail before checking instances in checkHsigIface] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -917,9 +917,9 @@ exportOccs = concatMap (map nameOccName . availNames) impl_msg :: UnitState -> Module -> InstantiatedModule -> SDoc impl_msg unit_state impl_mod (Module req_uid req_mod_name) = pprWithUnitState unit_state $ - text "while checking that" <+> ppr impl_mod <+> - text "implements signature" <+> ppr req_mod_name <+> - text "in" <+> ppr req_uid + text "While checking that" <+> quotes (ppr impl_mod) <+> + text "implements signature" <+> quotes (ppr req_mod_name) <+> + text "in" <+> quotes (ppr req_uid) <> dot -- | Check if module implements a signature. (The signature is -- always un-hashed, which is why its components are specified diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index 75b74cbb35..534e966b94 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -54,7 +54,7 @@ module GHC.Tc.Utils.Monad( -- * Typechecker global environment getIsGHCi, getGHCiMonad, getInteractivePrintName, - tcIsHsBootOrSig, tcIsHsig, tcSelfBootInfo, getGlobalRdrEnv, + tcHscSource, tcIsHsBootOrSig, tcIsHsig, tcSelfBootInfo, getGlobalRdrEnv, getRdrEnvs, getImports, getFixityEnv, extendFixityEnv, getDeclaredDefaultTys, @@ -929,7 +929,10 @@ getInteractivePrintName :: TcRn Name getInteractivePrintName = do { hsc <- getTopEnv; return (ic_int_print $ hsc_IC hsc) } tcIsHsBootOrSig :: TcRn Bool -tcIsHsBootOrSig = do { env <- getGblEnv; return (isHsBootOrSig (tcg_src env)) } +tcIsHsBootOrSig = isHsBootOrSig <$> tcHscSource + +tcHscSource :: TcRn HscSource +tcHscSource = do { env <- getGblEnv; return (tcg_src env)} tcIsHsig :: TcRn Bool tcIsHsig = do { env <- getGblEnv; return (isHsigFile (tcg_src env)) } @@ -1324,7 +1327,7 @@ capture_constraints thing_inside capture_messages :: TcM r -> TcM (r, Messages TcRnMessage) -- capture_messages simply captures and returns the --- errors arnd warnings generated by thing_inside +-- errors and warnings generated by thing_inside -- Precondition: thing_inside must not throw an exception! -- Reason for precondition: an exception would blow past the place -- where we read the msg_var, and we'd lose the constraints altogether diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs index 481fa15570..00f6a73532 100644 --- a/compiler/GHC/Tc/Utils/TcType.hs +++ b/compiler/GHC/Tc/Utils/TcType.hs @@ -250,7 +250,7 @@ import GHC.Utils.Panic.Plain import GHC.Utils.Error( Validity'(..) ) import qualified GHC.LanguageExtensions as LangExt -import Data.IORef +import Data.IORef ( IORef ) import Data.List.NonEmpty( NonEmpty(..) ) import Data.List ( partition, nub, (\\) ) diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs index da51f7245f..59f18e5d74 100644 --- a/compiler/GHC/Tc/Validity.hs +++ b/compiler/GHC/Tc/Validity.hs @@ -66,6 +66,7 @@ import GHC.Types.Name import GHC.Types.Var.Env import GHC.Types.Var.Set import GHC.Types.Var ( VarBndr(..), isInvisibleFunArg, mkTyVar ) +import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.Unique.Set( isEmptyUniqSet ) @@ -1436,9 +1437,8 @@ We can also have instances for functions: @instance Foo (a -> b) ...@. checkValidInstHead :: UserTypeCtxt -> Class -> [Type] -> TcM () checkValidInstHead ctxt clas cls_args = do { dflags <- getDynFlags - ; is_boot <- tcIsHsBootOrSig - ; is_sig <- tcIsHsig - ; check_special_inst_head dflags is_boot is_sig ctxt clas cls_args + ; hsc_src <- tcHscSource + ; check_special_inst_head dflags hsc_src ctxt clas cls_args ; checkValidTypePats (classTyCon clas) cls_args } @@ -1468,15 +1468,15 @@ in hsig files, where `is_sig` is True. -} -check_special_inst_head :: DynFlags -> Bool -> Bool - -> UserTypeCtxt -> Class -> [Type] -> TcM () +check_special_inst_head :: DynFlags -> HscSource -> UserTypeCtxt + -> Class -> [Type] -> TcM () -- Wow! There are a surprising number of ad-hoc special cases here. -- TODO: common up the logic for special typeclasses (see GHC ticket #20441). -check_special_inst_head dflags is_boot is_sig ctxt clas cls_args +check_special_inst_head dflags hs_src ctxt clas cls_args - -- If not in an hs-boot file, abstract classes cannot have instances + -- Abstract classes cannot have instances, except in hs-boot or signature files. | isAbstractClass clas - , not is_boot + , hs_src == HsSrcFile = failWithTc (TcRnAbstractClassInst clas) -- Complain about hand-written instances of built-in classes @@ -1486,7 +1486,7 @@ check_special_inst_head dflags is_boot is_sig ctxt clas cls_args -- allow a standalone deriving declaration: they are no-ops, -- and we warn about them in GHC.Tc.Deriv.deriveStandalone. | clas_nm == typeableClassName - , not is_sig + , not (hs_src == HsigFile) -- Note [Instances of built-in classes in signature files] , hand_written_bindings = failWithTc $ TcRnSpecialClassInst clas False @@ -1495,7 +1495,7 @@ check_special_inst_head dflags is_boot is_sig ctxt clas cls_args -- are forbidden outside of signature files (#12837). -- Derived instances are forbidden completely (#21087). | clas_nm `elem` [ knownNatClassName, knownSymbolClassName, knownCharClassName ] - , (not is_sig && hand_written_bindings) || derived_instance + , (not (hs_src == HsigFile) && hand_written_bindings) || derived_instance -- Note [Instances of built-in classes in signature files] = failWithTc $ TcRnSpecialClassInst clas False diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs index 5025ff022f..7bcafbe32e 100644 --- a/compiler/GHC/Types/Error/Codes.hs +++ b/compiler/GHC/Types/Error/Codes.hs @@ -24,6 +24,8 @@ import GHC.Types.Error ( DiagnosticCode(..), UnknownDiagnostic (..), diagnostic import GHC.Hs.Extension ( GhcRn ) +import GHC.Core.InstEnv (LookupInstanceErrReason) +import GHC.Iface.Errors.Types import GHC.Driver.Errors.Types ( DriverMessage ) import GHC.Parser.Errors.Types ( PsMessage, PsHeaderMessage ) import GHC.HsToCore.Errors.Types ( DsMessage ) @@ -37,8 +39,7 @@ import GHC.Exts ( proxy# ) import GHC.Generics import GHC.TypeLits ( Symbol, TypeError, ErrorMessage(..) ) import GHC.TypeNats ( Nat, KnownNat, natVal' ) -import GHC.Core.InstEnv (LookupInstanceErrReason) -import GHC.Iface.Errors.Types + {- Note [Diagnostic codes] ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -359,7 +360,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnTagToEnumResTyNotAnEnum" = 49356 GhcDiagnosticCode "TcRnTagToEnumResTyTypeData" = 96189 GhcDiagnosticCode "TcRnArrowIfThenElsePredDependsOnResultTy" = 55868 - GhcDiagnosticCode "TcRnIllegalHsBootFileDecl" = 58195 + GhcDiagnosticCode "TcRnIllegalHsBootOrSigDecl" = 58195 GhcDiagnosticCode "TcRnRecursivePatternSynonym" = 72489 GhcDiagnosticCode "TcRnPartialTypeSigTyVarMismatch" = 88793 GhcDiagnosticCode "TcRnPartialTypeSigBadQuantifier" = 94185 @@ -507,7 +508,6 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnInterfaceLookupError" = 52243 GhcDiagnosticCode "TcRnUnsatisfiedMinimalDef" = 06201 GhcDiagnosticCode "TcRnMisplacedInstSig" = 06202 - GhcDiagnosticCode "TcRnBadBootFamInstDecl" = 06203 GhcDiagnosticCode "TcRnIllegalFamilyInstance" = 06204 GhcDiagnosticCode "TcRnMissingClassAssoc" = 06205 GhcDiagnosticCode "TcRnNotOpenFamily" = 06207 @@ -522,7 +522,6 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnDuplicateSigDecl" = 31744 GhcDiagnosticCode "TcRnMisplacedSigDecl" = 87866 GhcDiagnosticCode "TcRnUnexpectedDefaultSig" = 40700 - GhcDiagnosticCode "TcRnBindInBootFile" = 11247 GhcDiagnosticCode "TcRnDuplicateMinimalSig" = 85346 GhcDiagnosticCode "TcRnLoopySuperclassSolve" = 36038 GhcDiagnosticCode "TcRnIllegalInstanceHeadDecl" = 12222 @@ -600,6 +599,11 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnBindingNameConflict" = 10498 GhcDiagnosticCode "NonCanonicalMonoid" = 50928 GhcDiagnosticCode "NonCanonicalMonad" = 22705 + GhcDiagnosticCode "TcRnUnexpectedDeclarationSplice" = 17599 + GhcDiagnosticCode "TcRnImplicitImportOfPrelude" = 20540 + GhcDiagnosticCode "TcRnMissingMain" = 67120 + GhcDiagnosticCode "TcRnGhciUnliftedBind" = 17999 + GhcDiagnosticCode "TcRnGhciMonadLookupFail" = 44990 -- PatSynInvalidRhsReason GhcDiagnosticCode "PatSynNotInvertible" = 69317 @@ -773,6 +777,14 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "EmptyStmtsGroupInDoNotation" = 82311 GhcDiagnosticCode "EmptyStmtsGroupInArrowNotation" = 19442 + -- HsBoot and Hsig errors + GhcDiagnosticCode "MissingBootDefinition" = 63610 + GhcDiagnosticCode "MissingBootExport" = 91999 + GhcDiagnosticCode "MissingBootInstance" = 79857 + GhcDiagnosticCode "BadReexportedBootThing" = 12424 + GhcDiagnosticCode "BootMismatchedIdTypes" = 11890 + GhcDiagnosticCode "BootMismatchedTyCons" = 15843 + -- To generate new random numbers: -- https://www.random.org/integers/?num=10&min=1&max=99999&col=1&base=10&format=plain -- @@ -784,6 +796,8 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnNameByTemplateHaskellQuote" = 40027 GhcDiagnosticCode "TcRnIllegalBindingOfBuiltIn" = 69639 GhcDiagnosticCode "TcRnMixedSelectors" = 40887 + GhcDiagnosticCode "TcRnBadBootFamInstDecl" = 06203 + GhcDiagnosticCode "TcRnBindInBootFile" = 11247 {- ********************************************************************* * * @@ -872,6 +886,11 @@ type family ConRecursInto con where ConRecursInto "TcRnInterfaceError" = 'Just IfaceMessage ConRecursInto "Can'tFindInterface" = 'Just MissingInterfaceError + -- HsBoot and Hsig errors + ConRecursInto "TcRnBootMismatch" = 'Just BootMismatch + ConRecursInto "MissingBootThing" = 'Just MissingBootThing + ConRecursInto "BootMismatch" = 'Just BootMismatchWhat + ------------------ -- FFI errors diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs index 7057925dea..69f98ba1da 100644 --- a/compiler/GHC/Types/Hint.hs +++ b/compiler/GHC/Types/Hint.hs @@ -27,11 +27,12 @@ import qualified Data.List.NonEmpty as NE import GHC.Utils.Outputable import qualified GHC.LanguageExtensions as LangExt -import Data.Typeable +import Data.Typeable (Typeable) import GHC.Unit.Module (ModuleName, Module) import GHC.Hs.Extension (GhcTc, GhcRn) import GHC.Core.Coercion import GHC.Core.FamInstEnv (FamFlavor) +import GHC.Core.TyCon (TyCon) import GHC.Core.Type (PredType) import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name (Name, NameSpace, OccName (occNameFS), isSymOcc, nameOccName) @@ -453,6 +454,9 @@ data GhcHint Name -- ^ method with non-canonical implementation Name -- ^ possible other method to use as the RHS instead String -- ^ Documentation URL + {-| Suggest eta-reducing a type synonym used in the implementation + of abstract data. -} + | SuggestEtaReduceAbsDataTySyn TyCon -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs index 4454d872cd..f6b995babc 100644 --- a/compiler/GHC/Types/Hint/Ppr.hs +++ b/compiler/GHC/Types/Hint/Ppr.hs @@ -13,6 +13,7 @@ import GHC.Parser.Errors.Basic import GHC.Types.Hint import GHC.Core.FamInstEnv (FamFlavor(..)) +import GHC.Core.TyCon import GHC.Hs.Expr () -- instance Outputable import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Types.Id @@ -245,6 +246,9 @@ instance Outputable GhcHint where text "or define as" <+> quotes (pprPrefixUnqual lhs <+> text "=" <+> pprPrefixUnqual rhs) $$ text "See also:" <+> text refURL + SuggestEtaReduceAbsDataTySyn tc + -> text "If possible, eta-reduce the type synonym" <+> ppr_tc <+> text "so that it is nullary." + where ppr_tc = quotes (ppr $ tyConName tc) perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs index 964c313abd..316b3e911f 100644 --- a/compiler/GHC/Types/Name/Occurrence.hs +++ b/compiler/GHC/Types/Name/Occurrence.hs @@ -104,6 +104,9 @@ module GHC.Types.Name.Occurrence ( unionOccSets, unionManyOccSets, elemOccSet, isEmptyOccSet, + -- * Dealing with main + mainOcc, ppMainFn, + -- * Tidying up TidyOccEnv, emptyTidyOccEnv, initTidyOccEnv, tidyOccName, avoidClashesOccEnv, delTidyOccEnvList, @@ -1253,6 +1256,24 @@ tidyOccName env occ@(OccName occ_sp fs) {- ************************************************************************ * * + Utilies for "main" +* * +************************************************************************ +-} + +mainOcc :: OccName +mainOcc = mkVarOccFS (fsLit "main") + +ppMainFn :: OccName -> SDoc +ppMainFn main_occ + | main_occ == mainOcc + = text "IO action" <+> quotes (ppr main_occ) + | otherwise + = text "main IO action" <+> quotes (ppr main_occ) + +{- +************************************************************************ +* * Binary instance Here rather than in GHC.Iface.Binary because OccName is abstract * * diff --git a/compiler/GHC/Types/SourceFile.hs b/compiler/GHC/Types/SourceFile.hs index 7a1898a51e..0d04a194de 100644 --- a/compiler/GHC/Types/SourceFile.hs +++ b/compiler/GHC/Types/SourceFile.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE PatternSynonyms #-} + module GHC.Types.SourceFile - ( HscSource(..) + ( HscSource(HsBootFile, HsigFile, ..) + , HsBootOrSig(..) , hscSourceToIsBoot , isHsBootOrSig - , isHsigFile + , isHsBootFile, isHsigFile , hscSourceString ) where @@ -11,45 +14,57 @@ import GHC.Prelude import GHC.Utils.Binary import GHC.Unit.Types --- Note [HscSource types] --- ~~~~~~~~~~~~~~~~~~~~~~ --- There are three types of source file for Haskell code: --- --- * HsSrcFile is an ordinary hs file which contains code, --- --- * HsBootFile is an hs-boot file, which is used to break --- recursive module imports (there will always be an --- HsSrcFile associated with it), and --- --- * HsigFile is an hsig file, which contains only type --- signatures and is used to specify signatures for --- modules. --- --- Syntactically, hs-boot files and hsig files are quite similar: they --- only include type signatures and must be associated with an --- actual HsSrcFile. isHsBootOrSig allows us to abstract over code --- which is indifferent to which. However, there are some important --- differences, mostly owing to the fact that hsigs are proper --- modules (you `import Sig` directly) whereas HsBootFiles are --- temporary placeholders (you `import {-# SOURCE #-} Mod). --- When we finish compiling the true implementation of an hs-boot, --- we replace the HomeModInfo with the real HsSrcFile. An HsigFile, on the --- other hand, is never replaced (in particular, we *cannot* use the --- HomeModInfo of the original HsSrcFile backing the signature, since it --- will export too many symbols.) --- --- Additionally, while HsSrcFile is the only Haskell file --- which has *code*, we do generate .o files for HsigFile, because --- this is how the recompilation checker figures out if a file --- needs to be recompiled. These are fake object files which --- should NOT be linked against. +{- Note [HscSource types] +~~~~~~~~~~~~~~~~~~~~~~~~~ +There are three types of source file for Haskell code: + + * HsSrcFile is an ordinary hs file which contains code, + + * HsBootFile is an hs-boot file, which is used to break + recursive module imports (there will always be an + HsSrcFile associated with it), and + + * HsigFile is an hsig file, which contains only type + signatures and is used to specify signatures for + modules. + +Syntactically, hs-boot files and hsig files are quite similar: they +only include type signatures and must be associated with an +actual HsSrcFile. isHsBootOrSig allows us to abstract over code +which is indifferent to which. However, there are some important +differences, mostly owing to the fact that hsigs are proper +modules (you `import Sig` directly) whereas HsBootFiles are +temporary placeholders (you `import {-# SOURCE #-} Mod). +When we finish compiling the true implementation of an hs-boot, +we replace the HomeModInfo with the real HsSrcFile. An HsigFile, on the +other hand, is never replaced (in particular, we *cannot* use the +HomeModInfo of the original HsSrcFile backing the signature, since it +will export too many symbols.) + +Additionally, while HsSrcFile is the only Haskell file +which has *code*, we do generate .o files for HsigFile, because +this is how the recompilation checker figures out if a file +needs to be recompiled. These are fake object files which +should NOT be linked against. +-} + +data HsBootOrSig + = HsBoot -- ^ .hs-boot file + | Hsig -- ^ .hsig file + deriving (Eq, Ord, Show) data HscSource - = HsSrcFile -- ^ .hs file - | HsBootFile -- ^ .hs-boot file - | HsigFile -- ^ .hsig file + -- | .hs file + = HsSrcFile + -- | .hs-boot or .hsig file + | HsBootOrSig !HsBootOrSig deriving (Eq, Ord, Show) +{-# COMPLETE HsSrcFile, HsBootFile, HsigFile #-} +pattern HsBootFile, HsigFile :: HscSource +pattern HsBootFile = HsBootOrSig HsBoot +pattern HsigFile = HsBootOrSig Hsig + -- | Tests if an 'HscSource' is a boot file, primarily for constructing elements -- of 'BuildModule'. We conflate signatures and modules because they are bound -- in the same namespace; only boot interfaces can be disambiguated with @@ -70,15 +85,18 @@ instance Binary HscSource where _ -> return HsigFile hscSourceString :: HscSource -> String -hscSourceString HsSrcFile = "" -hscSourceString HsBootFile = "[boot]" -hscSourceString HsigFile = "[sig]" +hscSourceString HsSrcFile = "" +hscSourceString HsBootFile = "[boot]" +hscSourceString HsigFile = "[sig]" -- See Note [HscSource types] isHsBootOrSig :: HscSource -> Bool -isHsBootOrSig HsBootFile = True -isHsBootOrSig HsigFile = True -isHsBootOrSig _ = False +isHsBootOrSig (HsBootOrSig _) = True +isHsBootOrSig HsSrcFile = False + +isHsBootFile :: HscSource -> Bool +isHsBootFile HsBootFile = True +isHsBootFile _ = False isHsigFile :: HscSource -> Bool isHsigFile HsigFile = True diff --git a/compiler/GHC/Types/TyThing/Ppr.hs b/compiler/GHC/Types/TyThing/Ppr.hs index 2982635815..3f0505e492 100644 --- a/compiler/GHC/Types/TyThing/Ppr.hs +++ b/compiler/GHC/Types/TyThing/Ppr.hs @@ -28,7 +28,7 @@ import GHC.Core.TyCo.Ppr ( pprUserForAll, pprTypeApp ) import GHC.Iface.Decl ( tyThingToIfaceDecl ) import GHC.Iface.Syntax ( ShowSub(..), ShowHowMuch(..), AltPpr(..) - , showToHeader, pprIfaceDecl ) + , showToHeader, pprIfaceDecl ) import GHC.Utils.Outputable diff --git a/compiler/GHC/Types/TyThing/Ppr.hs-boot b/compiler/GHC/Types/TyThing/Ppr.hs-boot new file mode 100644 index 0000000000..388a21305c --- /dev/null +++ b/compiler/GHC/Types/TyThing/Ppr.hs-boot @@ -0,0 +1,11 @@ +module GHC.Types.TyThing.Ppr ( + pprTyThing, + pprTyThingInContext + ) where + +import {-# SOURCE #-} GHC.Iface.Type ( ShowSub ) +import GHC.Types.TyThing ( TyThing ) +import GHC.Utils.Outputable ( SDoc ) + +pprTyThing :: ShowSub -> TyThing -> SDoc +pprTyThingInContext :: ShowSub -> TyThing -> SDoc diff --git a/testsuite/tests/backpack/cabal/bkpcabal02/bkpcabal02.stderr b/testsuite/tests/backpack/cabal/bkpcabal02/bkpcabal02.stderr index e6a1f31a82..4d56d26651 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal02/bkpcabal02.stderr +++ b/testsuite/tests/backpack/cabal/bkpcabal02/bkpcabal02.stderr @@ -1,10 +1,10 @@ -q/H.hsig:2:1: error: +q\H.hsig:2:1: error: [GHC-11890] • Identifier ‘x’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: x :: Int - Hsig file: x :: Bool - The two types are different + Hsig file: x :: Bool + The two types are different. • while merging the signatures from: • bkpcabal01-0.1.0.0:p[H=<H>]:H • ...and the local signature for H diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr b/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr index 24defef3c5..6a68787319 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr +++ b/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr @@ -1,4 +1,4 @@ sig/P.hsig:1:1: error: [GHC-93011] • ‘p’ is exported by the hsig file, but not exported by the implementing module ‘bkpcabal06-0.1.0.0:impl:P’ - • while checking that bkpcabal06-0.1.0.0:impl:P implements signature P in bkpcabal06-0.1.0.0:sig[P=bkpcabal06-0.1.0.0:impl:P] + • While checking that ‘bkpcabal06-0.1.0.0:impl:P’ implements signature ‘P’ in ‘bkpcabal06-0.1.0.0:sig[P=bkpcabal06-0.1.0.0:impl:P]’. diff --git a/testsuite/tests/backpack/should_compile/all.T b/testsuite/tests/backpack/should_compile/all.T index 07c1ed27ec..9a2edebd8e 100644 --- a/testsuite/tests/backpack/should_compile/all.T +++ b/testsuite/tests/backpack/should_compile/all.T @@ -52,6 +52,7 @@ test('bkp57', normal, backpack_compile, ['']) test('bkp58', normal, backpack_compile, ['']) test('bkp59', normal, backpack_compile, ['']) test('bkp60', normal, backpack_compile, ['']) +test('bkp61', normal, backpack_compile, ['']) test('T13140', normal, backpack_compile, ['']) test('T13149', expect_broken(13149), backpack_compile, ['']) diff --git a/testsuite/tests/backpack/should_compile/bkp09.bkp b/testsuite/tests/backpack/should_compile/bkp09.bkp index 64cf447715..68b9677d56 100644 --- a/testsuite/tests/backpack/should_compile/bkp09.bkp +++ b/testsuite/tests/backpack/should_compile/bkp09.bkp @@ -7,7 +7,7 @@ unit p where data T a = MkT (S a) data S a = MkS a --- keept his synced up! +-- keep this synced up! unit q where signature H where data T a = MkT (S a) diff --git a/testsuite/tests/backpack/should_compile/bkp15.bkp b/testsuite/tests/backpack/should_compile/bkp15.bkp index c661eafe6f..48058417a9 100644 --- a/testsuite/tests/backpack/should_compile/bkp15.bkp +++ b/testsuite/tests/backpack/should_compile/bkp15.bkp @@ -22,7 +22,7 @@ unit p where -- type instance Elem Int = Bool -- pattern Blub n = ("foo", n) --- keept his synced up! +-- keep this synced up! unit q where signature H where x :: (forall a. a -> a) -> (Int, Bool) diff --git a/testsuite/tests/backpack/should_compile/bkp61.bkp b/testsuite/tests/backpack/should_compile/bkp61.bkp new file mode 100644 index 0000000000..3ad7d721bb --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp61.bkp @@ -0,0 +1,36 @@ +-- Check that we can implement abstract data using a data family. + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} + +unit p where + signature H where + import Data.Kind + type T :: Bool -> Type + data T b + turnOff :: T True -> T False + turnOn :: T False -> T True + module A where + import H + foo :: T True -> T True + foo = turnOn . turnOff + +unit q where + module H where + import Data.Kind + type D :: Bool -> Type + data family D a + data instance D True = DT + data instance D False = DF + turnOff DT = DF + turnOn DF = DT + + type S = D + type T = S + +unit r where + dependency q + dependency p[H=q:H] + module N where + import A + bar = foo . foo diff --git a/testsuite/tests/backpack/should_compile/bkp61.stderr b/testsuite/tests/backpack/should_compile/bkp61.stderr new file mode 100644 index 0000000000..808295964d --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp61.stderr @@ -0,0 +1,15 @@ +[1 of 3] Processing p + [1 of 2] Compiling H[sig] ( p\H.hsig, nothing ) + [2 of 2] Compiling A ( p\A.hs, nothing ) +[2 of 3] Processing q + Instantiating q + [1 of 1] Compiling H ( q\H.hs, bkp61.out\q\H.o ) +[3 of 3] Processing r + Instantiating r + [1 of 2] Including q + [2 of 2] Including p[H=q:H] + Instantiating p[H=q:H] + [1 of 2] Compiling H[sig] ( p\H.hsig, bkp61.out\p\p-D5Mg3foBSCrDbQDKH4WGSG\H.o ) + [2 of 2] Compiling A ( p\A.hs, bkp61.out\p\p-D5Mg3foBSCrDbQDKH4WGSG\A.o ) + [1 of 2] Compiling N ( r\N.hs, bkp61.out\r\N.o ) + [2 of 2] Instantiating p diff --git a/testsuite/tests/backpack/should_fail/T19244a.stderr b/testsuite/tests/backpack/should_fail/T19244a.stderr index 5dceaad5f3..3c9e217a87 100644 --- a/testsuite/tests/backpack/should_fail/T19244a.stderr +++ b/testsuite/tests/backpack/should_fail/T19244a.stderr @@ -1,31 +1,31 @@ [1 of 4] Processing user - [1 of 2] Compiling Map[sig] ( user/Map.hsig, nothing ) - [2 of 2] Compiling User ( user/User.hs, nothing ) + [1 of 2] Compiling Map[sig] ( user\Map.hsig, nothing ) + [2 of 2] Compiling User ( user\User.hs, nothing ) [2 of 4] Processing ordmap Instantiating ordmap - [1 of 1] Compiling Map ( ordmap/Map.hs, T19244a.out/ordmap/Map.o ) + [1 of 1] Compiling Map ( ordmap\Map.hs, T19244a.out\ordmap\Map.o ) [3 of 4] Processing eqmap Instantiating eqmap - [1 of 1] Compiling Map ( eqmap/Map.hs, T19244a.out/eqmap/Map.o ) + [1 of 1] Compiling Map ( eqmap\Map.hs, T19244a.out\eqmap\Map.o ) [4 of 4] Processing main Instantiating main [1 of 2] Including user[Map=ordmap:Map] Instantiating user[Map=ordmap:Map] - [1 of 2] Compiling Map[sig] ( user/Map.hsig, T19244a.out/user/user-GzloW2NeDdA2M0V8qzN4g2/Map.o ) + [1 of 2] Compiling Map[sig] ( user\Map.hsig, T19244a.out\user\user-GzloW2NeDdA2M0V8qzN4g2\Map.o ) -T19244a.bkp:22:9: error: +T19244a.bkp:22:9: error: [GHC-15843] • Type constructor ‘Key’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type Key :: * -> Constraint type Key = GHC.Classes.Ord :: * -> Constraint - Hsig file: type Key :: forall {k}. k -> Constraint - class Key k1 - The types have different kinds - • while checking that ordmap:Map implements signature Map in user[Map=ordmap:Map] + Hsig file: type Key :: forall {k}. k -> Constraint + class Key k1 + The types have different kinds. + • While checking that ‘ordmap:Map’ implements signature ‘Map’ in ‘user[Map=ordmap:Map]’. -<no location info>: error: +<no location info>: error: [GHC-15843] • Type constructor ‘Map’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type role Map nominal representational type Map :: * -> * -> * data Map k a @@ -35,37 +35,37 @@ T19244a.bkp:22:9: error: !(Map k a) !(Map k a) | Data.Map.Internal.Tip - Hsig file: type role Map nominal representational - type Map :: forall {k} {k1}. k -> k1 -> * - data Map k2 a - The types have different kinds - • while checking that ordmap:Map implements signature Map in user[Map=ordmap:Map] + Hsig file: type role Map nominal representational + type Map :: forall {k} {k1}. k -> k1 -> * + data Map k2 a + The types have different kinds. + • While checking that ‘ordmap:Map’ implements signature ‘Map’ in ‘user[Map=ordmap:Map]’. -<no location info>: error: +<no location info>: error: [GHC-11890] • Identifier ‘lookup’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: lookup :: GHC.Classes.Ord k => k -> Map k a -> GHC.Maybe.Maybe a - Hsig file: lookup :: - Key (*) k => k -> Map (*) (*) k a -> GHC.Maybe.Maybe a - The two types are different - • while checking that ordmap:Map implements signature Map in user[Map=ordmap:Map] + Hsig file: lookup :: + Key (*) k => k -> Map (*) (*) k a -> GHC.Maybe.Maybe a + The two types are different. + • While checking that ‘ordmap:Map’ implements signature ‘Map’ in ‘user[Map=ordmap:Map]’. -<no location info>: error: +<no location info>: error: [GHC-11890] • Identifier ‘insert’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: insert :: GHC.Classes.Ord k => k -> a -> Map k a -> Map k a - Hsig file: insert :: - Key (*) k => k -> a -> Map (*) (*) k a -> Map (*) (*) k a - The two types are different - • while checking that ordmap:Map implements signature Map in user[Map=ordmap:Map] + Hsig file: insert :: + Key (*) k => k -> a -> Map (*) (*) k a -> Map (*) (*) k a + The two types are different. + • While checking that ‘ordmap:Map’ implements signature ‘Map’ in ‘user[Map=ordmap:Map]’. -<no location info>: error: +<no location info>: error: [GHC-11890] • Identifier ‘empty’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: empty :: Map k a - Hsig file: empty :: - forall {k1} {k2} (k3 :: k1) (a :: k2). Map k1 k2 k3 a - The two types are different - • while checking that ordmap:Map implements signature Map in user[Map=ordmap:Map] + Hsig file: empty :: + forall {k1} {k2} (k3 :: k1) (a :: k2). Map k1 k2 k3 a + The two types are different. + • While checking that ‘ordmap:Map’ implements signature ‘Map’ in ‘user[Map=ordmap:Map]’. diff --git a/testsuite/tests/backpack/should_fail/T19244b.stderr b/testsuite/tests/backpack/should_fail/T19244b.stderr index 3a50d11079..6c883c2601 100644 --- a/testsuite/tests/backpack/should_fail/T19244b.stderr +++ b/testsuite/tests/backpack/should_fail/T19244b.stderr @@ -1,21 +1,21 @@ [1 of 3] Processing user - [1 of 2] Compiling Map[sig] ( user/Map.hsig, nothing ) - [2 of 2] Compiling User ( user/User.hs, nothing ) + [1 of 2] Compiling Map[sig] ( user\Map.hsig, nothing ) + [2 of 2] Compiling User ( user\User.hs, nothing ) [2 of 3] Processing ordmap Instantiating ordmap - [1 of 1] Compiling Map ( ordmap/Map.hs, T19244b.out/ordmap/Map.o ) + [1 of 1] Compiling Map ( ordmap\Map.hs, T19244b.out\ordmap\Map.o ) [3 of 3] Processing main Instantiating main [1 of 1] Including user[Map=ordmap:Map] Instantiating user[Map=ordmap:Map] - [1 of 2] Compiling Map[sig] ( user/Map.hsig, T19244b.out/user/user-GzloW2NeDdA2M0V8qzN4g2/Map.o ) + [1 of 2] Compiling Map[sig] ( user\Map.hsig, T19244b.out\user\user-GzloW2NeDdA2M0V8qzN4g2\Map.o ) -T19244b.bkp:11:27: error: +T19244b.bkp:11:27: error: [GHC-15843] • Type constructor ‘Key’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type Key :: * -> Constraint type Key = GHC.Classes.Ord :: * -> Constraint - Hsig file: type Key :: forall {k}. k -> Constraint - class Key k1 - The types have different kinds - • while checking that ordmap:Map implements signature Map in user[Map=ordmap:Map] + Hsig file: type Key :: forall {k}. k -> Constraint + class Key k1 + The types have different kinds. + • While checking that ‘ordmap:Map’ implements signature ‘Map’ in ‘user[Map=ordmap:Map]’. diff --git a/testsuite/tests/backpack/should_fail/T23342.bkp b/testsuite/tests/backpack/should_fail/T23342.bkp new file mode 100644 index 0000000000..62f9b5f1c5 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/T23342.bkp @@ -0,0 +1,21 @@ +unit p where + signature H where + import Data.Kind + data T1 + data T2 + data T3 + +unit q where + module H where + import Data.Kind + class C a where {} + data S + + type T1 = forall (a :: Type). a -> a + type T2 = forall (a :: Type). C a => a + type T3 = C S => S -> S + +unit r where + dependency q + dependency p[H=q:H] + diff --git a/testsuite/tests/backpack/should_fail/T23342.stderr b/testsuite/tests/backpack/should_fail/T23342.stderr new file mode 100644 index 0000000000..39641082d6 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/T23342.stderr @@ -0,0 +1,44 @@ +[1 of 3] Processing p + [1 of 1] Compiling H[sig] ( p\H.hsig, nothing ) +[2 of 3] Processing q + Instantiating q + [1 of 1] Compiling H ( q\H.hs, T23342.out\q\H.o ) +[3 of 3] Processing r + Instantiating r + [1 of 2] Including q + [2 of 2] Including p[H=q:H] + Instantiating p[H=q:H] + [1 of 1] Compiling H[sig] ( p\H.hsig, T23342.out\p\p-D5Mg3foBSCrDbQDKH4WGSG\H.o ) + +T23342.bkp:14:5: error: [GHC-15843] + • Type constructor ‘T1’ has conflicting definitions in the module + and its hsig file. + Main module: type T1 :: * + type T1 = forall a. a -> a + Hsig file: type T1 :: * + data T1 + Illegal implementation of abstract data: + Invalid polymorphic type: forall a. a -> a. + • While checking that ‘q:H’ implements signature ‘H’ in ‘p[H=q:H]’. + +T23342.bkp:15:5: error: [GHC-15843] + • Type constructor ‘T2’ has conflicting definitions in the module + and its hsig file. + Main module: type T2 :: * + type T2 = forall a. C a => a + Hsig file: type T2 :: * + data T2 + Illegal implementation of abstract data: + Invalid polymorphic type: forall a. C a => a. + • While checking that ‘q:H’ implements signature ‘H’ in ‘p[H=q:H]’. + +T23342.bkp:16:5: error: [GHC-15843] + • Type constructor ‘T3’ has conflicting definitions in the module + and its hsig file. + Main module: type T3 :: * + type T3 = C S => S -> S + Hsig file: type T3 :: * + data T3 + Illegal implementation of abstract data: + Invalid qualified type: C S => S -> S. + • While checking that ‘q:H’ implements signature ‘H’ in ‘p[H=q:H]’. diff --git a/testsuite/tests/backpack/should_fail/T23344.bkp b/testsuite/tests/backpack/should_fail/T23344.bkp new file mode 100644 index 0000000000..3d60ff7b51 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/T23344.bkp @@ -0,0 +1,54 @@ +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ImpredicativeTypes #-} + +unit p where + module M where + import Data.Kind + + type C :: Type -> Constraint + class C a where + type family F a :: Type + +unit q where + dependency p + signature H where + data T1 + data T2 + data T3 + module N where + import M ( C(F) ) + import H ( T1, T2, T3 ) + + instance C T1 where + type F T1 = T2 + instance C T2 where + type F T2 = T3 + instance C T3 where + type F T3 = T1 + +unit r where + dependency p + module H where + import Data.Kind + + type S1 :: Type -> Type + data S1 a = MkS1 + + type S2 :: Type + data S2 = MkS2 + + type G :: Type -> Constraint + class G a where {} + + type T1 = S1 (forall (a :: Type). a -> a) + type T2 = S1 (G S2 => S2) + + type Y = forall a. a -> a + type Z = Y + type T3 = S1 Y + +unit s where + dependency p + dependency r + dependency q[H=r:H] diff --git a/testsuite/tests/backpack/should_fail/T23344.stderr b/testsuite/tests/backpack/should_fail/T23344.stderr new file mode 100644 index 0000000000..6687faba5f --- /dev/null +++ b/testsuite/tests/backpack/should_fail/T23344.stderr @@ -0,0 +1,51 @@ +[1 of 4] Processing p + Instantiating p + [1 of 1] Compiling M ( p\M.hs, T23344.out\p\M.o ) +[2 of 4] Processing q + [1 of 2] Compiling H[sig] ( q\H.hsig, nothing ) + [2 of 2] Compiling N ( q\N.hs, nothing ) +[3 of 4] Processing r + Instantiating r + [1 of 1] Including p + [1 of 1] Compiling H ( r\H.hs, T23344.out\r\H.o ) +[4 of 4] Processing s + Instantiating s + [1 of 3] Including p + [2 of 3] Including r + [3 of 3] Including q[H=r:H] + Instantiating q[H=r:H] + [1 of 1] Including p + [1 of 2] Compiling H[sig] ( q\H.hsig, T23344.out\q\q-EsMFZGC3QiBIz4krwt67aW\H.o ) + +T23344.bkp:44:5: error: [GHC-15843] + • Type constructor ‘T1’ has conflicting definitions in the module + and its hsig file. + Main module: type T1 :: * + type T1 = S1 (forall a. a -> a) + Hsig file: type T1 :: * + data T1 + Illegal implementation of abstract data: + Invalid polymorphic type: forall a. a -> a. + • While checking that ‘r:H’ implements signature ‘H’ in ‘q[H=r:H]’. + +T23344.bkp:45:5: error: [GHC-15843] + • Type constructor ‘T2’ has conflicting definitions in the module + and its hsig file. + Main module: type T2 :: * + type T2 = S1 (G S2 => S2) + Hsig file: type T2 :: * + data T2 + Illegal implementation of abstract data: + Invalid qualified type: G S2 => S2. + • While checking that ‘r:H’ implements signature ‘H’ in ‘q[H=r:H]’. + +T23344.bkp:49:5: error: [GHC-15843] + • Type constructor ‘T3’ has conflicting definitions in the module + and its hsig file. + Main module: type T3 :: * + type T3 = S1 Y + Hsig file: type T3 :: * + data T3 + Illegal implementation of abstract data: + Invalid polymorphic type: forall a. a -> a. + • While checking that ‘r:H’ implements signature ‘H’ in ‘q[H=r:H]’. diff --git a/testsuite/tests/backpack/should_fail/all.T b/testsuite/tests/backpack/should_fail/all.T index e01a4281a5..91733d9040 100644 --- a/testsuite/tests/backpack/should_fail/all.T +++ b/testsuite/tests/backpack/should_fail/all.T @@ -49,5 +49,8 @@ test('bkpfail50', normal, backpack_compile_fail, ['']) test('bkpfail51', normal, backpack_compile_fail, ['']) test('bkpfail52', normal, backpack_compile_fail, ['']) test('bkpfail53', normal, backpack_compile_fail, ['']) +test('bkpfail54', normal, backpack_compile_fail, ['']) test('T19244a', normal, backpack_compile_fail, ['']) test('T19244b', normal, backpack_compile_fail, ['']) +test('T23342', normal, backpack_compile_fail, ['']) +test('T23344', normal, backpack_compile_fail, ['']) diff --git a/testsuite/tests/backpack/should_fail/bkpfail01.stderr b/testsuite/tests/backpack/should_fail/bkpfail01.stderr index 7197fa3eb2..6b13993058 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail01.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail01.stderr @@ -1,19 +1,19 @@ [1 of 3] Processing p - [1 of 2] Compiling H[sig] ( p/H.hsig, nothing ) - [2 of 2] Compiling A ( p/A.hs, nothing ) + [1 of 2] Compiling H[sig] ( p\H.hsig, nothing ) + [2 of 2] Compiling A ( p\A.hs, nothing ) [2 of 3] Processing q Instantiating q - [1 of 1] Compiling H ( q/H.hs, nothing ) + [1 of 1] Compiling H ( q\H.hs, nothing ) [3 of 3] Processing r Instantiating r [1 of 1] Including p[H=q:H] Instantiating p[H=q:H] - [1 of 2] Compiling H[sig] ( p/H.hsig, nothing ) + [1 of 2] Compiling H[sig] ( p\H.hsig, nothing ) -bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error: [GHC-93011] +bkpfail01.out\p\p-D5Mg3foBSCrDbQDKH4WGSG\..\H.hi:1:1: error: [GHC-93011] • ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’ - • while checking that q:H implements signature H in p[H=q:H] + • While checking that ‘q:H’ implements signature ‘H’ in ‘p[H=q:H]’. -bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error: [GHC-93011] +bkpfail01.out\p\p-D5Mg3foBSCrDbQDKH4WGSG\..\H.hi:1:1: error: [GHC-93011] • ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’ - • while checking that q:H implements signature H in p[H=q:H] + • While checking that ‘q:H’ implements signature ‘H’ in ‘p[H=q:H]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail03.stderr b/testsuite/tests/backpack/should_fail/bkpfail03.stderr index 9383a2aca1..3d38234f45 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail03.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail03.stderr @@ -1,17 +1,17 @@ [1 of 3] Processing q - [1 of 2] Compiling M1 ( q/M1.hs, nothing ) - [2 of 2] Compiling M2[sig] ( q/M2.hsig, nothing ) + [1 of 2] Compiling M1 ( q\M1.hs, nothing ) + [2 of 2] Compiling M2[sig] ( q\M2.hsig, nothing ) [2 of 3] Processing m2 Instantiating m2 - [1 of 1] Compiling M2 ( m2/M2.hs, nothing ) + [1 of 1] Compiling M2 ( m2\M2.hs, nothing ) [3 of 3] Processing p Instantiating p [1 of 1] Including q[M2=m2:M2] Instantiating q[M2=m2:M2] - [1 of 2] Compiling M1 ( q/M1.hs, nothing ) - [2 of 2] Compiling M2[sig] ( q/M2.hsig, nothing ) + [1 of 2] Compiling M1 ( q\M1.hs, nothing ) + [2 of 2] Compiling M2[sig] ( q\M2.hsig, nothing ) -bkpfail03.bkp:3:9: error: +bkpfail03.bkp:3:9: error: [GHC-12424] • The hsig file (re)exports ‘M1.M’ but the implementing module exports a different identifier ‘M2.M’ - • while checking that m2:M2 implements signature M2 in q[M2=m2:M2] + • While checking that ‘m2:M2’ implements signature ‘M2’ in ‘q[M2=m2:M2]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail04.stderr b/testsuite/tests/backpack/should_fail/bkpfail04.stderr index 397cd24851..450da78636 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail04.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail04.stderr @@ -1,20 +1,20 @@ [1 of 3] Processing p - [1 of 1] Compiling A[sig] ( p/A.hsig, nothing ) + [1 of 1] Compiling A[sig] ( p\A.hsig, nothing ) [2 of 3] Processing q - [1 of 1] Compiling A[sig] ( q/A.hsig, nothing ) + [1 of 1] Compiling A[sig] ( q\A.hsig, nothing ) [3 of 3] Processing r - [1 of 4] Compiling A[sig] ( r/A.hsig, nothing ) + [1 of 4] Compiling A[sig] ( r\A.hsig, nothing ) -bkpfail04.bkp:7:9: error: +bkpfail04.bkp:7:9: error: [GHC-15843] • Type constructor ‘A’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type A :: * data A = A {foo :: Int} - Hsig file: type A :: * - data A = A {bar :: Bool} + Hsig file: type A :: * + data A = A {bar :: Bool} The constructors do not match: - The record label lists for ‘A’ differ - The types for ‘A’ differ + • The record label lists for ‘A’ differ. + • The types for ‘A’ differ. • while merging the signatures from: • p[A=<A>]:A • q[A=<A>]:A diff --git a/testsuite/tests/backpack/should_fail/bkpfail05.stderr b/testsuite/tests/backpack/should_fail/bkpfail05.stderr index c07426fc6b..1827c7ff1a 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail05.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail05.stderr @@ -1,23 +1,23 @@ [1 of 5] Processing h - [1 of 1] Compiling H[sig] ( h/H.hsig, nothing ) + [1 of 1] Compiling H[sig] ( h\H.hsig, nothing ) [2 of 5] Processing t-impl Instantiating t-impl - [1 of 1] Compiling T ( t-impl/T.hs, bkpfail05.out/t-impl/T.o ) + [1 of 1] Compiling T ( t-impl\T.hs, bkpfail05.out\t-impl\T.o ) [3 of 5] Processing p - [1 of 2] Compiling H[sig] ( p/H.hsig, nothing ) + [1 of 2] Compiling H[sig] ( p\H.hsig, nothing ) [2 of 2] Instantiating h [4 of 5] Processing h-impl Instantiating h-impl [1 of 1] Including t-impl - [1 of 1] Compiling H ( h-impl/H.hs, bkpfail05.out/h-impl/H.o ) + [1 of 1] Compiling H ( h-impl\H.hs, bkpfail05.out\h-impl\H.o ) [5 of 5] Processing q Instantiating q [1 of 1] Including p[H=h-impl:H] Instantiating p[H=h-impl:H] [1 of 2] Including h[H=h-impl:H] Instantiating h[H=h-impl:H] - [1 of 1] Compiling H[sig] ( h/H.hsig, bkpfail05.out/h/h-5FYQgnNkfSvBT5yogOxPpf/H.o ) + [1 of 1] Compiling H[sig] ( h\H.hsig, bkpfail05.out\h\h-5FYQgnNkfSvBT5yogOxPpf\H.o ) -bkpfail05.out/h/h-5FYQgnNkfSvBT5yogOxPpf/../H.hi:1:1: error: [GHC-93011] +bkpfail05.out\h\h-5FYQgnNkfSvBT5yogOxPpf\..\H.hi:1:1: error: [GHC-93011] • ‘T1’ is exported by the hsig file, but not exported by the implementing module ‘h-impl:H’ - • while checking that h-impl:H implements signature H in h[H=h-impl:H] + • While checking that ‘h-impl:H’ implements signature ‘H’ in ‘h[H=h-impl:H]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail06.stderr b/testsuite/tests/backpack/should_fail/bkpfail06.stderr index a707bf06b6..ef40417b48 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail06.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail06.stderr @@ -1,22 +1,22 @@ [1 of 3] Processing p - [1 of 2] Compiling H[sig] ( p/H.hsig, nothing ) - [2 of 2] Compiling A ( p/A.hs, nothing ) + [1 of 2] Compiling H[sig] ( p\H.hsig, nothing ) + [2 of 2] Compiling A ( p\A.hs, nothing ) [2 of 3] Processing qimpl Instantiating qimpl - [1 of 2] Compiling T ( qimpl/T.hs, bkpfail06.out/qimpl/T.o ) - [2 of 2] Compiling H ( qimpl/H.hs, bkpfail06.out/qimpl/H.o ) + [1 of 2] Compiling T ( qimpl\T.hs, bkpfail06.out\qimpl\T.o ) + [2 of 2] Compiling H ( qimpl\H.hs, bkpfail06.out\qimpl\H.o ) [3 of 3] Processing q Instantiating q [1 of 1] Including p[H=qimpl:H] Instantiating p[H=qimpl:H] - [1 of 2] Compiling H[sig] ( p/H.hsig, bkpfail06.out/p/p-IueY0RdHDM2I4k0mLZuqM0/H.o ) + [1 of 2] Compiling H[sig] ( p\H.hsig, bkpfail06.out\p\p-IueY0RdHDM2I4k0mLZuqM0\H.o ) -bkpfail06.bkp:10:9: error: +bkpfail06.bkp:10:9: error: [GHC-15843] • Type constructor ‘T’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type T :: * data T = T GHC.Types.Bool - Hsig file: type T :: * - data T = T GHC.Types.Int - The constructors do not match: The types for ‘T’ differ - • while checking that qimpl:H implements signature H in p[H=qimpl:H] + Hsig file: type T :: * + data T = T GHC.Types.Int + The constructors do not match: The types for ‘T’ differ. + • While checking that ‘qimpl:H’ implements signature ‘H’ in ‘p[H=qimpl:H]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail07.stderr b/testsuite/tests/backpack/should_fail/bkpfail07.stderr index 251fd67f0b..7829f1e0cd 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail07.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail07.stderr @@ -1,20 +1,20 @@ [1 of 3] Processing p - [1 of 1] Compiling H[sig] ( p/H.hsig, nothing ) + [1 of 1] Compiling H[sig] ( p\H.hsig, nothing ) [2 of 3] Processing h - [1 of 3] Compiling T ( h/T.hs, nothing ) - [2 of 3] Compiling H ( h/H.hs, nothing ) - [3 of 3] Compiling A[sig] ( h/A.hsig, nothing ) + [1 of 3] Compiling T ( h\T.hs, nothing ) + [2 of 3] Compiling H ( h\H.hs, nothing ) + [3 of 3] Compiling A[sig] ( h\A.hsig, nothing ) [3 of 3] Processing q - [1 of 3] Compiling A[sig] ( q/A.hsig, nothing ) + [1 of 3] Compiling A[sig] ( q\A.hsig, nothing ) [2 of 3] Instantiating h [3 of 3] Instantiating p -bkpfail07.bkp:6:9: error: +bkpfail07.bkp:6:9: error: [GHC-15843] • Type constructor ‘T’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type T :: * data T = T GHC.Types.Bool - Hsig file: type T :: * - data T = T GHC.Types.Int - The constructors do not match: The types for ‘T’ differ - • while checking that h[A=<A>]:H implements signature H in p[H=h[A=<A>]:H] + Hsig file: type T :: * + data T = T GHC.Types.Int + The constructors do not match: The types for ‘T’ differ. + • While checking that ‘h[A=<A>]:H’ implements signature ‘H’ in ‘p[H=h[A=<A>]:H]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail09.stderr b/testsuite/tests/backpack/should_fail/bkpfail09.stderr index 858f292001..48be5a4274 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail09.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail09.stderr @@ -1,17 +1,17 @@ [1 of 3] Processing p - [1 of 2] Compiling H[sig] ( p/H.hsig, nothing ) - [2 of 2] Compiling A ( p/A.hs, nothing ) + [1 of 2] Compiling H[sig] ( p\H.hsig, nothing ) + [2 of 2] Compiling A ( p\A.hs, nothing ) [2 of 3] Processing q Instantiating q - [1 of 1] Compiling H ( q/H.hs, bkpfail09.out/q/H.o ) + [1 of 1] Compiling H ( q\H.hs, bkpfail09.out\q\H.o ) [3 of 3] Processing r - [1 of 3] Compiling H2[sig] ( r/H2.hsig, nothing ) + [1 of 3] Compiling H2[sig] ( r\H2.hsig, nothing ) [2 of 3] Instantiating p Command line argument: -unit-id p[H=H]:0:0: error: [GHC-93011] • ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’ - • while checking that q:H implements signature H in p[H=q:H] + • While checking that ‘q:H’ implements signature ‘H’ in ‘p[H=q:H]’. Command line argument: -unit-id p[H=H]:0:0: error: [GHC-93011] • ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’ - • while checking that q:H implements signature H in p[H=q:H] + • While checking that ‘q:H’ implements signature ‘H’ in ‘p[H=q:H]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail10.stderr b/testsuite/tests/backpack/should_fail/bkpfail10.stderr index 78ceaffb30..abd3a1b6ba 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail10.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail10.stderr @@ -1,28 +1,28 @@ [1 of 3] Processing p - [1 of 1] Compiling H[sig] ( p/H.hsig, nothing ) + [1 of 1] Compiling H[sig] ( p\H.hsig, nothing ) [2 of 3] Processing q Instantiating q - [1 of 1] Compiling H ( q/H.hs, bkpfail10.out/q/H.o ) + [1 of 1] Compiling H ( q\H.hs, bkpfail10.out\q\H.o ) [3 of 3] Processing r Instantiating r [1 of 2] Including p[H=q:H] Instantiating p[H=q:H] - [1 of 1] Compiling H[sig] ( p/H.hsig, bkpfail10.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/H.o ) + [1 of 1] Compiling H[sig] ( p\H.hsig, bkpfail10.out\p\p-D5Mg3foBSCrDbQDKH4WGSG\H.o ) -bkpfail10.bkp:8:9: error: +bkpfail10.bkp:8:9: error: [GHC-15843] • Type constructor ‘H’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type H :: * -> * data H a = H a - Hsig file: type H :: * - data H - The types have different kinds - • while checking that q:H implements signature H in p[H=q:H] + Hsig file: type H :: * + data H + The types have different kinds. + • While checking that ‘q:H’ implements signature ‘H’ in ‘p[H=q:H]’. -bkpfail10.bkp:10:9: error: +bkpfail10.bkp:10:9: error: [GHC-11890] • Identifier ‘f’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: f :: H a -> H a - Hsig file: f :: H -> H - The two types are different - • while checking that q:H implements signature H in p[H=q:H] + Hsig file: f :: H -> H + The two types are different. + • While checking that ‘q:H’ implements signature ‘H’ in ‘p[H=q:H]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail11.stderr b/testsuite/tests/backpack/should_fail/bkpfail11.stderr index cfcfdcb0e4..2686cd1fbc 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail11.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail11.stderr @@ -15,4 +15,4 @@ bkpfail11.out\sig\sig-HyoWTHt34SDIRGEX0vZ8iN\..\A.hi:1:1: error: [GHC-39999] arising when attempting to show that instance [safe] GHC.Show.Show T -- Defined at bkpfail11.bkp:5:18 is provided by ‘mod:A’ - • while checking that mod:A implements signature A in sig[A=mod:A] + • While checking that ‘mod:A’ implements signature ‘A’ in ‘sig[A=mod:A]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail12.stderr b/testsuite/tests/backpack/should_fail/bkpfail12.stderr index f240d2f058..a7205970fb 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail12.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail12.stderr @@ -1,17 +1,17 @@ [1 of 3] Processing p - [1 of 2] Compiling Q[sig] ( p/Q.hsig, nothing ) - [2 of 2] Compiling P ( p/P.hs, nothing ) + [1 of 2] Compiling Q[sig] ( p\Q.hsig, nothing ) + [2 of 2] Compiling P ( p\P.hs, nothing ) [2 of 3] Processing q Instantiating q - [1 of 1] Compiling Q ( q/Q.hs, bkpfail12.out/q/Q.o ) + [1 of 1] Compiling Q ( q\Q.hs, bkpfail12.out\q\Q.o ) [3 of 3] Processing r - [1 of 3] Compiling H[sig] ( r/H.hsig, nothing ) + [1 of 3] Compiling H[sig] ( r\H.hsig, nothing ) [2 of 3] Instantiating p -bkpfail12.bkp:8:9: error: +bkpfail12.bkp:8:9: error: [GHC-11890] • Identifier ‘f’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: f :: GHC.Types.Bool - Hsig file: f :: GHC.Types.Int - The two types are different - • while checking that Q implements signature Q in p[Q=Q] + Hsig file: f :: GHC.Types.Int + The two types are different. + • While checking that ‘Q’ implements signature ‘Q’ in ‘p[Q=Q]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail13.stderr b/testsuite/tests/backpack/should_fail/bkpfail13.stderr index 13d227a617..fa46c6a61a 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail13.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail13.stderr @@ -1,17 +1,17 @@ [1 of 3] Processing p - [1 of 2] Compiling Q[sig] ( p/Q.hsig, nothing ) - [2 of 2] Compiling P ( p/P.hs, nothing ) + [1 of 2] Compiling Q[sig] ( p\Q.hsig, nothing ) + [2 of 2] Compiling P ( p\P.hs, nothing ) [2 of 3] Processing q Instantiating q - [1 of 1] Compiling QMe ( q/QMe.hs, bkpfail13.out/q/QMe.o ) + [1 of 1] Compiling QMe ( q\QMe.hs, bkpfail13.out\q\QMe.o ) [3 of 3] Processing r - [1 of 3] Compiling H[sig] ( r/H.hsig, nothing ) + [1 of 3] Compiling H[sig] ( r\H.hsig, nothing ) [2 of 3] Instantiating p -bkpfail13.bkp:8:9: error: +bkpfail13.bkp:8:9: error: [GHC-11890] • Identifier ‘f’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: f :: GHC.Types.Bool - Hsig file: f :: GHC.Types.Int - The two types are different - • while checking that q:QMe implements signature Q in p[Q=q:QMe] + Hsig file: f :: GHC.Types.Int + The two types are different. + • While checking that ‘q:QMe’ implements signature ‘Q’ in ‘p[Q=q:QMe]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail14.stderr b/testsuite/tests/backpack/should_fail/bkpfail14.stderr index 401cab2286..3c1de27b10 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail14.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail14.stderr @@ -1,20 +1,20 @@ [1 of 3] Processing p - [1 of 3] Compiling Q[sig] ( p/Q.hsig, nothing ) - [2 of 3] Compiling Q2[sig] ( p/Q2.hsig, nothing ) - [3 of 3] Compiling P ( p/P.hs, nothing ) + [1 of 3] Compiling Q[sig] ( p\Q.hsig, nothing ) + [2 of 3] Compiling Q2[sig] ( p\Q2.hsig, nothing ) + [3 of 3] Compiling P ( p\P.hs, nothing ) [2 of 3] Processing q Instantiating q - [1 of 3] Compiling QMe ( q/QMe.hs, bkpfail14.out/q/QMe.o ) - [2 of 3] Compiling Q ( q/Q.hs, bkpfail14.out/q/Q.o ) - [3 of 3] Compiling Q2 ( q/Q2.hs, bkpfail14.out/q/Q2.o ) + [1 of 3] Compiling QMe ( q\QMe.hs, bkpfail14.out\q\QMe.o ) + [2 of 3] Compiling Q ( q\Q.hs, bkpfail14.out\q\Q.o ) + [3 of 3] Compiling Q2 ( q\Q2.hs, bkpfail14.out\q\Q2.o ) [3 of 3] Processing r - [1 of 3] Compiling H[sig] ( r/H.hsig, nothing ) + [1 of 3] Compiling H[sig] ( r\H.hsig, nothing ) [2 of 3] Instantiating p -bkpfail14.bkp:9:9: error: +bkpfail14.bkp:9:9: error: [GHC-11890] • Identifier ‘f’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: f :: GHC.Types.Bool - Hsig file: f :: GHC.Types.Int - The two types are different - • while checking that QMe implements signature Q in p[Q=QMe,Q2=Q2] + Hsig file: f :: GHC.Types.Int + The two types are different. + • While checking that ‘QMe’ implements signature ‘Q’ in ‘p[Q=QMe,Q2=Q2]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail15.stderr b/testsuite/tests/backpack/should_fail/bkpfail15.stderr index cf30efe6f8..18c86e4b44 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail15.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail15.stderr @@ -1,18 +1,18 @@ [1 of 3] Processing p - [1 of 3] Compiling A[sig] ( p/A.hsig, nothing ) - [2 of 3] Compiling Q[sig] ( p/Q.hsig, nothing ) - [3 of 3] Compiling P ( p/P.hs, nothing ) + [1 of 3] Compiling A[sig] ( p\A.hsig, nothing ) + [2 of 3] Compiling Q[sig] ( p\Q.hsig, nothing ) + [3 of 3] Compiling P ( p\P.hs, nothing ) [2 of 3] Processing q Instantiating q - [1 of 1] Compiling Q ( q/Q.hs, bkpfail15.out/q/Q.o ) + [1 of 1] Compiling Q ( q\Q.hs, bkpfail15.out\q\Q.o ) [3 of 3] Processing r - [1 of 2] Compiling A[sig] ( r/A.hsig, nothing ) + [1 of 2] Compiling A[sig] ( r\A.hsig, nothing ) [2 of 2] Instantiating p -bkpfail15.bkp:8:9: error: +bkpfail15.bkp:8:9: error: [GHC-11890] • Identifier ‘f’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: f :: GHC.Types.Bool - Hsig file: f :: GHC.Types.Int - The two types are different - • while checking that q:Q implements signature Q in p[A=<A>,Q=q:Q] + Hsig file: f :: GHC.Types.Int + The two types are different. + • While checking that ‘q:Q’ implements signature ‘Q’ in ‘p[A=<A>,Q=q:Q]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail16.stderr b/testsuite/tests/backpack/should_fail/bkpfail16.stderr index af4d241106..6196ab958a 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail16.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail16.stderr @@ -1,11 +1,11 @@ [1 of 2] Processing p - [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, nothing ) + [1 of 1] Compiling ShouldFail[sig] ( p\ShouldFail.hsig, nothing ) [2 of 2] Processing q Instantiating q - [1 of 1] Including p[ShouldFail=base-4.13.0.0:Data.Bool] - Instantiating p[ShouldFail=base-4.13.0.0:Data.Bool] - [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/ShouldFail.o ) + [1 of 1] Including p[ShouldFail=base-4.18.0.0:Data.Bool] + Instantiating p[ShouldFail=base-4.18.0.0:Data.Bool] + [1 of 1] Compiling ShouldFail[sig] ( p\ShouldFail.hsig, bkpfail16.out\p\p-1OqLaT7dAn947wScQQKCw5\ShouldFail.o ) -bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/../ShouldFail.hi:1:1: error: [GHC-93011] +bkpfail16.out\p\p-1OqLaT7dAn947wScQQKCw5\..\ShouldFail.hi:1:1: error: [GHC-93011] • ‘Booly’ is exported by the hsig file, but not exported by the implementing module ‘Data.Bool’ - • while checking that Data.Bool implements signature ShouldFail in p[ShouldFail=Data.Bool] + • While checking that ‘Data.Bool’ implements signature ‘ShouldFail’ in ‘p[ShouldFail=Data.Bool]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail17.stderr b/testsuite/tests/backpack/should_fail/bkpfail17.stderr index 2777b503ed..699de6374c 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail17.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail17.stderr @@ -1,18 +1,18 @@ [1 of 2] Processing p - [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, nothing ) + [1 of 1] Compiling ShouldFail[sig] ( p\ShouldFail.hsig, nothing ) [2 of 2] Processing q Instantiating q - [1 of 1] Including p[ShouldFail=base-4.16.0.0:Prelude] - Instantiating p[ShouldFail=base-4.16.0.0:Prelude] - [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, bkpfail17.out/p/p-2W6J7O3LvroH97zGxbPEGF/ShouldFail.o ) + [1 of 1] Including p[ShouldFail=base-4.18.0.0:Prelude] + Instantiating p[ShouldFail=base-4.18.0.0:Prelude] + [1 of 1] Compiling ShouldFail[sig] ( p\ShouldFail.hsig, bkpfail17.out\p\p-2W6J7O3LvroH97zGxbPEGF\ShouldFail.o ) -<no location info>: error: +<no location info>: error: [GHC-15843] • Type constructor ‘Either’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type Either :: * -> * -> * data Either a b = Left a | Right b - Hsig file: type role Either representational phantom phantom - type Either :: * -> * -> * -> * - data Either a b c = Left a - The types have different kinds - • while checking that Prelude implements signature ShouldFail in p[ShouldFail=Prelude] + Hsig file: type role Either representational phantom phantom + type Either :: * -> * -> * -> * + data Either a b c = Left a + The types have different kinds. + • While checking that ‘Prelude’ implements signature ‘ShouldFail’ in ‘p[ShouldFail=Prelude]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail19.stderr b/testsuite/tests/backpack/should_fail/bkpfail19.stderr index a66eca5e60..6540bfd0e9 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail19.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail19.stderr @@ -1,12 +1,12 @@ [1 of 2] Processing p - [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, nothing ) + [1 of 1] Compiling ShouldFail[sig] ( p\ShouldFail.hsig, nothing ) [2 of 2] Processing q Instantiating q - [1 of 1] Including p[ShouldFail=base-4.13.0.0:Data.STRef] - Instantiating p[ShouldFail=base-4.13.0.0:Data.STRef] - [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, bkpfail19.out/p/p-CfyUIAu1JTRCDuXEyGszXN/ShouldFail.o ) + [1 of 1] Including p[ShouldFail=base-4.18.0.0:Data.STRef] + Instantiating p[ShouldFail=base-4.18.0.0:Data.STRef] + [1 of 1] Compiling ShouldFail[sig] ( p\ShouldFail.hsig, bkpfail19.out\p\p-CfyUIAu1JTRCDuXEyGszXN\ShouldFail.o ) -<no location info>: error: +<no location info>: error: [GHC-12424] • The hsig file (re)exports ‘Data.STRef.Lazy.newSTRef’ but the implementing module exports a different identifier ‘GHC.STRef.newSTRef’ - • while checking that Data.STRef implements signature ShouldFail in p[ShouldFail=Data.STRef] + • While checking that ‘Data.STRef’ implements signature ‘ShouldFail’ in ‘p[ShouldFail=Data.STRef]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail22.stderr b/testsuite/tests/backpack/should_fail/bkpfail22.stderr index cb0a0e23fa..c03360435f 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail22.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail22.stderr @@ -1,23 +1,23 @@ [1 of 4] Processing p - [1 of 2] Compiling H[sig] ( p/H.hsig, nothing ) - [2 of 2] Compiling M ( p/M.hs, nothing ) + [1 of 2] Compiling H[sig] ( p\H.hsig, nothing ) + [2 of 2] Compiling M ( p\M.hs, nothing ) [2 of 4] Processing q - [1 of 2] Compiling H2[sig] ( q/H2.hsig, nothing ) - [2 of 2] Compiling N ( q/N.hs, nothing ) + [1 of 2] Compiling H2[sig] ( q\H2.hsig, nothing ) + [2 of 2] Compiling N ( q\N.hs, nothing ) [3 of 4] Processing badimpl Instantiating badimpl - [1 of 1] Compiling H2 ( badimpl/H2.hs, bkpfail22.out/badimpl/H2.o ) + [1 of 1] Compiling H2 ( badimpl\H2.hs, bkpfail22.out\badimpl\H2.o ) [4 of 4] Processing check Instantiating check [1 of 2] Including q[H2=badimpl:H2] Instantiating q[H2=badimpl:H2] - [1 of 2] Compiling H2[sig] ( q/H2.hsig, bkpfail22.out/q/q-FjwGsuDQ5qiKUCvnEATUA9/H2.o ) + [1 of 2] Compiling H2[sig] ( q\H2.hsig, bkpfail22.out\q\q-FjwGsuDQ5qiKUCvnEATUA9\H2.o ) -bkpfail22.bkp:16:9: error: +bkpfail22.bkp:16:9: error: [GHC-15843] • Type constructor ‘S’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type S :: * type S = () - Hsig file: type S :: * - type S = GHC.Types.Bool - • while checking that badimpl:H2 implements signature H2 in q[H2=badimpl:H2] + Hsig file: type S :: * + type S = GHC.Types.Bool + • While checking that ‘badimpl:H2’ implements signature ‘H2’ in ‘q[H2=badimpl:H2]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail23.stderr b/testsuite/tests/backpack/should_fail/bkpfail23.stderr index a8144dbde5..d8e492cf55 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail23.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail23.stderr @@ -1,23 +1,24 @@ [1 of 3] Processing p - [1 of 2] Compiling H[sig] ( p/H.hsig, nothing ) - [2 of 2] Compiling M ( p/M.hs, nothing ) + [1 of 2] Compiling H[sig] ( p\H.hsig, nothing ) + [2 of 2] Compiling M ( p\M.hs, nothing ) [2 of 3] Processing h Instantiating h - [1 of 1] Compiling H ( h/H.hs, bkpfail23.out/h/H.o ) + [1 of 1] Compiling H ( h\H.hs, bkpfail23.out\h\H.o ) [3 of 3] Processing r Instantiating r [1 of 1] Including p[H=h:H] Instantiating p[H=h:H] - [1 of 2] Compiling H[sig] ( p/H.hsig, bkpfail23.out/p/p-6KeuBvYi0jvLWqVbkSAZMq/H.o ) + [1 of 2] Compiling H[sig] ( p\H.hsig, bkpfail23.out\p\p-6KeuBvYi0jvLWqVbkSAZMq\H.o ) -bkpfail23.bkp:15:9: error: +bkpfail23.bkp:15:9: error: [GHC-15843] • Type constructor ‘F’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type F :: * -> * type F a = () - Hsig file: type role F phantom - type F :: * -> * - data F a + Hsig file: type role F phantom + type F :: * -> * + data F a Illegal parameterized type synonym in implementation of abstract data. - (Try eta reducing your type synonym so that it is nullary.) - • while checking that h:H implements signature H in p[H=h:H] + • While checking that ‘h:H’ implements signature ‘H’ in ‘p[H=h:H]’. + Suggested fix: + If possible, eta-reduce the type synonym ‘F’ so that it is nullary. diff --git a/testsuite/tests/backpack/should_fail/bkpfail25.stderr b/testsuite/tests/backpack/should_fail/bkpfail25.stderr index 9433904ee5..9c483e3593 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail25.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail25.stderr @@ -1,6 +1,6 @@ [1 of 3] Processing p - [1 of 2] Compiling H[sig] ( p/H.hsig, nothing ) - [2 of 2] Compiling M ( p/M.hs, nothing ) + [1 of 2] Compiling H[sig] ( p\H.hsig, nothing ) + [2 of 2] Compiling M ( p\M.hs, nothing ) bkpfail25.bkp:8:18: warning: [GHC-06201] [-Wmissing-methods (in -Wdefault)] • No explicit implementation for @@ -8,19 +8,22 @@ bkpfail25.bkp:8:18: warning: [GHC-06201] [-Wmissing-methods (in -Wdefault)] • In the instance declaration for ‘Functor T’ [2 of 3] Processing q Instantiating q - [1 of 1] Compiling H ( q/H.hs, bkpfail25.out/q/H.o ) + [1 of 1] Compiling H ( q\H.hs, bkpfail25.out\q\H.o ) [3 of 3] Processing r Instantiating r [1 of 1] Including p[H=q:H] Instantiating p[H=q:H] - [1 of 2] Compiling H[sig] ( p/H.hsig, bkpfail25.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/H.o ) + [1 of 2] Compiling H[sig] ( p\H.hsig, bkpfail25.out\p\p-D5Mg3foBSCrDbQDKH4WGSG\H.o ) -bkpfail25.bkp:13:9: error: +bkpfail25.bkp:13:9: error: [GHC-15843] • Type constructor ‘T’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type T :: * -> * type T a = a - Hsig file: type role T nominal - type T :: * -> * - data T a - • while checking that q:H implements signature H in p[H=q:H] + Hsig file: type role T nominal + type T :: * -> * + data T a + Illegal parameterized type synonym in implementation of abstract data. + • While checking that ‘q:H’ implements signature ‘H’ in ‘p[H=q:H]’. + Suggested fix: + If possible, eta-reduce the type synonym ‘T’ so that it is nullary. diff --git a/testsuite/tests/backpack/should_fail/bkpfail26.stderr b/testsuite/tests/backpack/should_fail/bkpfail26.stderr index f697f47212..18de9f92b4 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail26.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail26.stderr @@ -1,23 +1,24 @@ [1 of 3] Processing p - [1 of 2] Compiling H[sig] ( p/H.hsig, nothing ) - [2 of 2] Compiling M ( p/M.hs, nothing ) + [1 of 2] Compiling H[sig] ( p\H.hsig, nothing ) + [2 of 2] Compiling M ( p\M.hs, nothing ) [2 of 3] Processing q Instantiating q - [1 of 1] Compiling H ( q/H.hs, bkpfail26.out/q/H.o ) + [1 of 1] Compiling H ( q\H.hs, bkpfail26.out\q\H.o ) [3 of 3] Processing r Instantiating r [1 of 1] Including p[H=q:H] Instantiating p[H=q:H] - [1 of 2] Compiling H[sig] ( p/H.hsig, bkpfail26.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/H.o ) + [1 of 2] Compiling H[sig] ( p\H.hsig, bkpfail26.out\p\p-D5Mg3foBSCrDbQDKH4WGSG\H.o ) -bkpfail26.bkp:16:9: error: +bkpfail26.bkp:16:9: error: [GHC-15843] • Type constructor ‘T’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type T :: * -> * type T a = [a] - Hsig file: type role T nominal - type T :: * -> * - data T a + Hsig file: type role T nominal + type T :: * -> * + data T a Illegal parameterized type synonym in implementation of abstract data. - (Try eta reducing your type synonym so that it is nullary.) - • while checking that q:H implements signature H in p[H=q:H] + • While checking that ‘q:H’ implements signature ‘H’ in ‘p[H=q:H]’. + Suggested fix: + If possible, eta-reduce the type synonym ‘T’ so that it is nullary. diff --git a/testsuite/tests/backpack/should_fail/bkpfail27.stderr b/testsuite/tests/backpack/should_fail/bkpfail27.stderr index bc5a8c6bd5..d4ae895626 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail27.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail27.stderr @@ -1,21 +1,21 @@ [1 of 3] Processing p - [1 of 2] Compiling H[sig] ( p/H.hsig, nothing ) - [2 of 2] Compiling M ( p/M.hs, nothing ) + [1 of 2] Compiling H[sig] ( p\H.hsig, nothing ) + [2 of 2] Compiling M ( p\M.hs, nothing ) [2 of 3] Processing q Instantiating q - [1 of 1] Compiling H ( q/H.hs, bkpfail27.out/q/H.o ) + [1 of 1] Compiling H ( q\H.hs, bkpfail27.out\q\H.o ) [3 of 3] Processing r Instantiating r [1 of 1] Including p[H=q:H] Instantiating p[H=q:H] - [1 of 2] Compiling H[sig] ( p/H.hsig, bkpfail27.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/H.o ) + [1 of 2] Compiling H[sig] ( p\H.hsig, bkpfail27.out\p\p-D5Mg3foBSCrDbQDKH4WGSG\H.o ) -bkpfail27.bkp:15:9: error: +bkpfail27.bkp:15:9: error: [GHC-15843] • Type constructor ‘T’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type T :: * type T = F - Hsig file: type T :: * - data T - Illegal type family application in implementation of abstract data. - • while checking that q:H implements signature H in p[H=q:H] + Hsig file: type T :: * + data T + Illegal implementation of abstract data: Invalid type family ‘F’. + • While checking that ‘q:H’ implements signature ‘H’ in ‘p[H=q:H]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail35.stderr b/testsuite/tests/backpack/should_fail/bkpfail35.stderr index f72bd23184..fc8cabbe4a 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail35.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail35.stderr @@ -1,18 +1,18 @@ [1 of 4] Processing p - [1 of 2] Compiling A[sig] ( p/A.hsig, nothing ) - [2 of 2] Compiling B ( p/B.hs, nothing ) + [1 of 2] Compiling A[sig] ( p\A.hsig, nothing ) + [2 of 2] Compiling B ( p\B.hs, nothing ) [2 of 4] Processing q - [1 of 2] Compiling A[sig] ( q/A.hsig, nothing ) + [1 of 2] Compiling A[sig] ( q\A.hsig, nothing ) [2 of 2] Instantiating p [3 of 4] Processing aimpl Instantiating aimpl - [1 of 1] Compiling A ( aimpl/A.hs, bkpfail35.out/aimpl/A.o ) + [1 of 1] Compiling A ( aimpl\A.hs, bkpfail35.out\aimpl\A.o ) [4 of 4] Processing r Instantiating r [1 of 1] Including q[A=aimpl:A] Instantiating q[A=aimpl:A] - [1 of 1] Compiling A[sig] ( q/A.hsig, bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/A.o ) + [1 of 1] Compiling A[sig] ( q\A.hsig, bkpfail35.out\q\q-E72T6bb4XRkIeTPWK2mCKa\A.o ) -bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/../A.hi:1:1: error: [GHC-93011] +bkpfail35.out\q\q-E72T6bb4XRkIeTPWK2mCKa\..\A.hi:1:1: error: [GHC-93011] • ‘y’ is exported by the hsig file, but not exported by the implementing module ‘aimpl:A’ - • while checking that aimpl:A implements signature A in q[A=aimpl:A] + • While checking that ‘aimpl:A’ implements signature ‘A’ in ‘q[A=aimpl:A]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail37.stderr b/testsuite/tests/backpack/should_fail/bkpfail37.stderr index 4158517b28..320e107bf2 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail37.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail37.stderr @@ -1,17 +1,17 @@ [1 of 3] Processing p - [1 of 1] Compiling A[sig] ( p/A.hsig, nothing ) + [1 of 1] Compiling A[sig] ( p\A.hsig, nothing ) [2 of 3] Processing q Instantiating q - [1 of 1] Compiling A ( q/A.hs, bkpfail37.out/q/A.o ) + [1 of 1] Compiling A ( q\A.hs, bkpfail37.out\q\A.o ) [3 of 3] Processing r Instantiating r [1 of 1] Including p[A=q:A] Instantiating p[A=q:A] - [1 of 1] Compiling A[sig] ( p/A.hsig, bkpfail37.out/p/p-HVmFlcYSefiK5n1aDP1v7x/A.o ) + [1 of 1] Compiling A[sig] ( p\A.hsig, bkpfail37.out\p\p-HVmFlcYSefiK5n1aDP1v7x\A.o ) bkpfail37.bkp:9:9: error: [GHC-93007] • Identifier ‘op’ has conflicting fixities in the module and its hsig file Main module: infixr 4 Hsig file: infixr 6 - • while checking that q:A implements signature A in p[A=q:A] + • While checking that ‘q:A’ implements signature ‘A’ in ‘p[A=q:A]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail41.stderr b/testsuite/tests/backpack/should_fail/bkpfail41.stderr index 6f58345fe7..6732d71574 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail41.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail41.stderr @@ -1,25 +1,25 @@ [1 of 3] Processing p - [1 of 2] Compiling A[sig] ( p/A.hsig, nothing ) - [2 of 2] Compiling B[sig] ( p/B.hsig, nothing ) + [1 of 2] Compiling A[sig] ( p\A.hsig, nothing ) + [2 of 2] Compiling B[sig] ( p\B.hsig, nothing ) [2 of 3] Processing i Instantiating i - [1 of 1] Compiling A ( i/A.hs, bkpfail41.out/i/A.o ) + [1 of 1] Compiling A ( i\A.hs, bkpfail41.out\i\A.o ) [3 of 3] Processing r - [1 of 2] Compiling B[sig] ( r/B.hsig, nothing ) + [1 of 2] Compiling B[sig] ( r\B.hsig, nothing ) [2 of 2] Instantiating p -bkpfail41.bkp:10:9: error: +bkpfail41.bkp:10:9: error: [GHC-15843] • Class ‘C’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type C :: * -> Constraint class C a where f :: a -> a {-# MINIMAL f #-} - Hsig file: type C :: * -> Constraint - class C a where - f :: a -> a - default f :: a -> a - The methods do not match: - The default methods associated with ‘f’ are not compatible - The MINIMAL pragmas are not compatible - • while checking that i:A implements signature A in p[A=i:A,B=<B>] + Hsig file: type C :: * -> Constraint + class C a where + f :: a -> a + default f :: a -> a + The class methods do not match: + The default methods associated with ‘f’ are not compatible. + The MINIMAL pragmas are not compatible. + • While checking that ‘i:A’ implements signature ‘A’ in ‘p[A=i:A,B=<B>]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail42.stderr b/testsuite/tests/backpack/should_fail/bkpfail42.stderr index 0dfef9355f..b8c6fb4c34 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail42.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail42.stderr @@ -1,17 +1,20 @@ [1 of 2] Processing p - [1 of 1] Compiling A[sig] ( p/A.hsig, nothing ) + [1 of 1] Compiling A[sig] ( p\A.hsig, nothing ) [2 of 2] Processing q - [1 of 2] Compiling A[sig] ( q/A.hsig, nothing ) + [1 of 2] Compiling A[sig] ( q\A.hsig, nothing ) -bkpfail42.bkp:10:9: error: +bkpfail42.bkp:10:9: error: [GHC-15843] • Type constructor ‘F’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type F :: * -> * type family F a where F a = Int - Hsig file: type F :: * -> * - type family F a where - F a = Bool + Hsig file: type F :: * -> * + type family F a where + F a = Bool + Type family equations do not match: + The second equations do not match. + The equation right-hand sides don't match. • while merging the signatures from: • p[A=<A>]:A • ...and the local signature for A diff --git a/testsuite/tests/backpack/should_fail/bkpfail43.stderr b/testsuite/tests/backpack/should_fail/bkpfail43.stderr index 1231788023..72e48315a0 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail43.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail43.stderr @@ -17,4 +17,4 @@ bkpfail43.out\p\p-HVmFlcYSefiK5n1aDP1v7x\..\A.hi:1:1: error: [GHC-39999] -- Defined at bkpfail43.bkp:3:18 is provided by ‘q:A’ (maybe you haven't applied a function to enough arguments?) - • while checking that q:A implements signature A in p[A=q:A] + • While checking that ‘q:A’ implements signature ‘A’ in ‘p[A=q:A]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail45.stderr b/testsuite/tests/backpack/should_fail/bkpfail45.stderr index e2b4236aab..5049f5f4b3 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail45.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail45.stderr @@ -1,24 +1,23 @@ [1 of 3] Processing p - [1 of 2] Compiling A[sig] ( p/A.hsig, nothing ) - [2 of 2] Compiling B ( p/B.hs, nothing ) + [1 of 2] Compiling A[sig] ( p\A.hsig, nothing ) + [2 of 2] Compiling B ( p\B.hs, nothing ) [2 of 3] Processing a Instantiating a - [1 of 1] Compiling A ( a/A.hs, bkpfail45.out/a/A.o ) + [1 of 1] Compiling A ( a\A.hs, bkpfail45.out\a\A.o ) [3 of 3] Processing q Instantiating q [1 of 1] Including p[A=a:A] Instantiating p[A=a:A] - [1 of 2] Compiling A[sig] ( p/A.hsig, bkpfail45.out/p/p-KvF5Y9pEVY39j64PHPNj9i/A.o ) + [1 of 2] Compiling A[sig] ( p\A.hsig, bkpfail45.out\p\p-KvF5Y9pEVY39j64PHPNj9i\A.o ) -bkpfail45.bkp:14:9: error: +bkpfail45.bkp:14:9: error: [GHC-15843] • Type constructor ‘T’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type role T phantom type T :: * -> * data T a = T - Hsig file: type role T nominal - type T :: * -> * - data T a = T + Hsig file: type role T nominal + type T :: * -> * + data T a = T The roles do not match. - Roles on abstract types default to ‘representational’ in boot files. - • while checking that a:A implements signature A in p[A=a:A] + • While checking that ‘a:A’ implements signature ‘A’ in ‘p[A=a:A]’. diff --git a/testsuite/tests/backpack/should_fail/bkpfail46.stderr b/testsuite/tests/backpack/should_fail/bkpfail46.stderr index 5ab1a5fddb..9b387a39d7 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail46.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail46.stderr @@ -1,22 +1,23 @@ [1 of 3] Processing p - [1 of 2] Compiling A[sig] ( p/A.hsig, nothing ) - [2 of 2] Compiling M ( p/M.hs, nothing ) + [1 of 2] Compiling A[sig] ( p\A.hsig, nothing ) + [2 of 2] Compiling M ( p\M.hs, nothing ) [2 of 3] Processing q Instantiating q - [1 of 1] Compiling A ( q/A.hs, bkpfail46.out/q/A.o ) + [1 of 1] Compiling A ( q\A.hs, bkpfail46.out\q\A.o ) [3 of 3] Processing r Instantiating r [1 of 1] Including p[A=q:A] Instantiating p[A=q:A] - [1 of 2] Compiling A[sig] ( p/A.hsig, bkpfail46.out/p/p-HVmFlcYSefiK5n1aDP1v7x/A.o ) + [1 of 2] Compiling A[sig] ( p\A.hsig, bkpfail46.out\p\p-HVmFlcYSefiK5n1aDP1v7x\A.o ) -bkpfail46.bkp:16:9: error: +bkpfail46.bkp:16:9: error: [GHC-15843] • Type constructor ‘K’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type K :: * -> Constraint type K a = GHC.Classes.Eq a :: Constraint - Hsig file: type K :: * -> Constraint - class K a + Hsig file: type K :: * -> Constraint + class K a Illegal parameterized type synonym in implementation of abstract data. - (Try eta reducing your type synonym so that it is nullary.) - • while checking that q:A implements signature A in p[A=q:A] + • While checking that ‘q:A’ implements signature ‘A’ in ‘p[A=q:A]’. + Suggested fix: + If possible, eta-reduce the type synonym ‘K’ so that it is nullary. diff --git a/testsuite/tests/backpack/should_fail/bkpfail47.stderr b/testsuite/tests/backpack/should_fail/bkpfail47.stderr index 86453f28ea..adb764be16 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail47.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail47.stderr @@ -1,22 +1,22 @@ [1 of 3] Processing p - [1 of 1] Compiling A[sig] ( p/A.hsig, nothing ) + [1 of 1] Compiling A[sig] ( p\A.hsig, nothing ) [2 of 3] Processing q - [1 of 1] Compiling A[sig] ( q/A.hsig, nothing ) + [1 of 1] Compiling A[sig] ( q\A.hsig, nothing ) [3 of 3] Processing r - [1 of 3] Compiling A[sig] ( r/A.hsig, nothing ) + [1 of 3] Compiling A[sig] ( r\A.hsig, nothing ) -bkpfail47.bkp:10:9: error: +bkpfail47.bkp:10:9: error: [GHC-15843] • Type constructor ‘T’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type role T representational nominal type T :: * -> * -> * data T a b = MkT - Hsig file: type role T nominal representational - type T :: * -> * -> * - data T a b + Hsig file: type role T nominal representational + type T :: * -> * -> * + data T a b The roles are not compatible: - Main module: [representational, nominal] - Hsig file: [nominal, representational] + Main module: [nominal, representational] + Hsig file: [representational, nominal] • while merging the signatures from: • p[A=<A>]:A • q[A=<A>]:A diff --git a/testsuite/tests/backpack/should_fail/bkpfail50.stderr b/testsuite/tests/backpack/should_fail/bkpfail50.stderr index 2d4d171ea7..0ca6328193 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail50.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail50.stderr @@ -1,16 +1,16 @@ [1 of 2] Processing p - [1 of 1] Compiling H[sig] ( p/H.hsig, nothing ) + [1 of 1] Compiling H[sig] ( p\H.hsig, nothing ) [2 of 2] Processing q - [1 of 2] Compiling A[sig] ( q/A.hsig, nothing ) + [1 of 2] Compiling A[sig] ( q\A.hsig, nothing ) -bkpfail50.bkp:7:9: error: +bkpfail50.bkp:7:9: error: [GHC-15843] • Type constructor ‘T’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type T :: * data T = T Bool - Hsig file: type T :: * - data T = T Int - The constructors do not match: The types for ‘T’ differ + Hsig file: type T :: * + data T = T Int + The constructors do not match: The types for ‘T’ differ. • while merging the signatures from: • p[H=<A>]:H • ...and the local signature for A diff --git a/testsuite/tests/backpack/should_fail/bkpfail52.stderr b/testsuite/tests/backpack/should_fail/bkpfail52.stderr index 888434e33c..4a920bf65c 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail52.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail52.stderr @@ -1,16 +1,16 @@ [1 of 2] Processing p - [1 of 1] Compiling H[sig] ( p/H.hsig, nothing ) + [1 of 1] Compiling H[sig] ( p\H.hsig, nothing ) [2 of 2] Processing q - [1 of 3] Compiling B ( q/B.hs, nothing ) - [2 of 3] Compiling A[sig] ( q/A.hsig, nothing ) + [1 of 3] Compiling B ( q\B.hs, nothing ) + [2 of 3] Compiling A[sig] ( q\A.hsig, nothing ) -bkpfail52.bkp:10:9: error: +bkpfail52.bkp:10:9: error: [GHC-15843] • Type constructor ‘T’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type T :: * type T = B.T - Hsig file: type T :: * - data T = T Int + Hsig file: type T :: * + data T = T Int • while merging the signatures from: • p[H=<A>]:H • ...and the local signature for A diff --git a/testsuite/tests/backpack/should_fail/bkpfail53.stderr b/testsuite/tests/backpack/should_fail/bkpfail53.stderr index b694bc57ff..a5939ff072 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail53.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail53.stderr @@ -1,17 +1,17 @@ [1 of 2] Processing p - [1 of 2] Compiling H[sig] ( p/H.hsig, nothing ) - [2 of 2] Compiling I ( p/I.hs, nothing ) + [1 of 2] Compiling H[sig] ( p\H.hsig, nothing ) + [2 of 2] Compiling I ( p\I.hs, nothing ) [2 of 2] Processing q - [1 of 4] Compiling B ( q/B.hs, nothing ) - [2 of 4] Compiling A[sig] ( q/A.hsig, nothing ) + [1 of 4] Compiling B ( q\B.hs, nothing ) + [2 of 4] Compiling A[sig] ( q\A.hsig, nothing ) -bkpfail53.bkp:15:9: error: +bkpfail53.bkp:15:9: error: [GHC-15843] • Type constructor ‘T’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type T :: * type T = B.T - Hsig file: type T :: * - data T = T Int + Hsig file: type T :: * + data T = T Int • while merging the signatures from: • p[H=<A>]:H • ...and the local signature for A diff --git a/testsuite/tests/backpack/should_fail/bkpfail54.bkp b/testsuite/tests/backpack/should_fail/bkpfail54.bkp new file mode 100644 index 0000000000..4248390c91 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail54.bkp @@ -0,0 +1,47 @@ + +-- Check that we do something sensible when we implement +-- abstract data with a quantified type. + +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE TypeFamilies #-} + +unit p where + module M where + import Data.Kind ( Type, Constraint ) + + type C :: Type -> Constraint + class C a where + type family F a :: Type + +unit q where + dependency p + signature H where + data T1 + data T2 + data T3 + module N where + import M ( C(F) ) + import H ( T1, T2, T3 ) + + instance C T1 where + type F T1 = T2 + instance C T2 where + type F T2 = T3 + instance C T3 where + type F T3 = T1 + +unit r where + dependency p + module H where + + class C2 a where {} + data S = MkS + + type T1 = forall a. a -> a + type T2 = forall a. C2 a => a + type T3 = C2 S => S -> S + +unit s where + dependency p + dependency r + dependency q[H=r:H] diff --git a/testsuite/tests/backpack/should_fail/bkpfail54.stderr b/testsuite/tests/backpack/should_fail/bkpfail54.stderr new file mode 100644 index 0000000000..8fd391624e --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail54.stderr @@ -0,0 +1,51 @@ +[1 of 4] Processing p + Instantiating p + [1 of 1] Compiling M ( p\M.hs, bkpfail54.out\p\M.o ) +[2 of 4] Processing q + [1 of 2] Compiling H[sig] ( q\H.hsig, nothing ) + [2 of 2] Compiling N ( q\N.hs, nothing ) +[3 of 4] Processing r + Instantiating r + [1 of 1] Including p + [1 of 1] Compiling H ( r\H.hs, bkpfail54.out\r\H.o ) +[4 of 4] Processing s + Instantiating s + [1 of 3] Including p + [2 of 3] Including r + [3 of 3] Including q[H=r:H] + Instantiating q[H=r:H] + [1 of 1] Including p + [1 of 2] Compiling H[sig] ( q\H.hsig, bkpfail54.out\q\q-EsMFZGC3QiBIz4krwt67aW\H.o ) + +bkpfail54.bkp:40:5: error: [GHC-15843] + • Type constructor ‘T1’ has conflicting definitions in the module + and its hsig file. + Main module: type T1 :: * + type T1 = forall a. a -> a + Hsig file: type T1 :: * + data T1 + Illegal implementation of abstract data: + Invalid polymorphic type: forall a. a -> a. + • While checking that ‘r:H’ implements signature ‘H’ in ‘q[H=r:H]’. + +bkpfail54.bkp:41:5: error: [GHC-15843] + • Type constructor ‘T2’ has conflicting definitions in the module + and its hsig file. + Main module: type T2 :: * + type T2 = forall a. C2 a => a + Hsig file: type T2 :: * + data T2 + Illegal implementation of abstract data: + Invalid polymorphic type: forall a. C2 a => a. + • While checking that ‘r:H’ implements signature ‘H’ in ‘q[H=r:H]’. + +bkpfail54.bkp:42:5: error: [GHC-15843] + • Type constructor ‘T3’ has conflicting definitions in the module + and its hsig file. + Main module: type T3 :: * + type T3 = C2 S => S -> S + Hsig file: type T3 :: * + data T3 + Illegal implementation of abstract data: + Invalid qualified type: C2 S => S -> S. + • While checking that ‘r:H’ implements signature ‘H’ in ‘q[H=r:H]’. diff --git a/testsuite/tests/count-deps/CountDepsAst.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout index 549f9bd371..ac861f6135 100644 --- a/testsuite/tests/count-deps/CountDepsAst.stdout +++ b/testsuite/tests/count-deps/CountDepsAst.stdout @@ -244,6 +244,7 @@ GHC.Types.SrcLoc GHC.Types.Target GHC.Types.Tickish GHC.Types.TyThing +GHC.Types.TyThing.Ppr GHC.Types.TypeEnv GHC.Types.Unique GHC.Types.Unique.DFM diff --git a/testsuite/tests/count-deps/CountDepsParser.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout index 639d765427..828f5c6cae 100644 --- a/testsuite/tests/count-deps/CountDepsParser.stdout +++ b/testsuite/tests/count-deps/CountDepsParser.stdout @@ -251,6 +251,7 @@ GHC.Types.SrcLoc GHC.Types.Target GHC.Types.Tickish GHC.Types.TyThing +GHC.Types.TyThing.Ppr GHC.Types.TypeEnv GHC.Types.Unique GHC.Types.Unique.DFM diff --git a/testsuite/tests/driver/T14075/T14075.stderr b/testsuite/tests/driver/T14075/T14075.stderr index 9c7bb7e359..c09cf120e3 100644 --- a/testsuite/tests/driver/T14075/T14075.stderr +++ b/testsuite/tests/driver/T14075/T14075.stderr @@ -1,7 +1,7 @@ -F.hs-boot:5:1: error: - ‘F.F’ is exported by the hs-boot file, but not exported by the module +F.hs-boot:5:1: error: [GHC-91999] + ‘F.F’ is exported by the hs-boot file, but not exported by the implementing module. -F.hs-boot:6:10: error: +F.hs-boot:6:10: error: [GHC-79857] instance O.O F.F - is defined in the hs-boot file, but not in the module itself + is defined in the hs-boot file, but not in the implementing module. diff --git a/testsuite/tests/ghci/scripts/T7894.stderr b/testsuite/tests/ghci/scripts/T7894.stderr index 17f7171bad..4addbb5657 100644 --- a/testsuite/tests/ghci/scripts/T7894.stderr +++ b/testsuite/tests/ghci/scripts/T7894.stderr @@ -1,2 +1,2 @@ -<interactive>:1:1: error: Not in scope: ‘Data.Maybe.->’ +<interactive>:1:1: error: [GHC-76037] Not in scope: ‘Data.Maybe.->’ diff --git a/testsuite/tests/ghci/scripts/T9140.stdout b/testsuite/tests/ghci/scripts/T9140.stdout index dbaa905b6f..29219a2312 100644 --- a/testsuite/tests/ghci/scripts/T9140.stdout +++ b/testsuite/tests/ghci/scripts/T9140.stdout @@ -7,6 +7,6 @@ You can't mix polymorphic and unlifted bindings: a = (# 1, 3 #) Suggested fix: Add a type signature. -<interactive>:1:1: error: +<interactive>:1:1: error: [GHC-17999] GHCi can't bind a variable of unlifted type: a :: (# Integer, Integer #) diff --git a/testsuite/tests/ghci/scripts/ghci034.stderr b/testsuite/tests/ghci/scripts/ghci034.stderr index 3d4b95c96c..fdb9f039d6 100644 --- a/testsuite/tests/ghci/scripts/ghci034.stderr +++ b/testsuite/tests/ghci/scripts/ghci034.stderr @@ -1,2 +1,3 @@ -<interactive>:1:1: error: Not in scope: ‘thisIsNotDefined’ +<interactive>:1:1: error: [GHC-76037] + Not in scope: ‘thisIsNotDefined’ diff --git a/testsuite/tests/ghci/should_fail/T18052b.stderr b/testsuite/tests/ghci/should_fail/T18052b.stderr index 30d2a389ab..6298f62533 100644 --- a/testsuite/tests/ghci/should_fail/T18052b.stderr +++ b/testsuite/tests/ghci/should_fail/T18052b.stderr @@ -1,3 +1,3 @@ -<interactive>:1:1: error: +<interactive>:1:1: error: [GHC-17999] GHCi can't bind a variable of unlifted type: (%%%) :: GHC.Prim.Int# diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr index 28190937a4..f02c4d94bc 100644 --- a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr +++ b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr @@ -1,34 +1,39 @@ -ClosedFam3.hs-boot:8:1: error: +ClosedFam3.hs-boot:8:1: error: [GHC-15843] Type constructor ‘Foo’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type Foo :: * -> * type family Foo a where Foo Int = Bool Foo Double = Char - Boot file: type Foo :: * -> * + Boot file: type Foo :: * -> * type family Foo a where Foo Int = Bool + Type family equations do not match: + The number of equations differs. -ClosedFam3.hs-boot:11:1: error: +ClosedFam3.hs-boot:11:1: error: [GHC-15843] Type constructor ‘Bar’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type Bar :: * -> * type family Bar a where Bar Int = Bool Bar Double = Double - Boot file: type Bar :: * -> * + Boot file: type Bar :: * -> * type family Bar a where Bar Int = Bool Bar Double = Char + Type family equations do not match: + The third equations do not match. + The equation right-hand sides don't match. -ClosedFam3.hs-boot:15:1: error: +ClosedFam3.hs-boot:15:1: error: [GHC-15843] Type constructor ‘Baz’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type Baz :: * -> * type family Baz a where Baz Int = Bool - Boot file: type Baz :: forall k. k -> * + Boot file: type Baz :: forall k. k -> * type family Baz a where Baz Int = Bool - The types have different kinds + The types have different kinds. diff --git a/testsuite/tests/indexed-types/should_fail/HsBootFam.stderr b/testsuite/tests/indexed-types/should_fail/HsBootFam.stderr index a6950a3ade..2a75d81bdb 100644 --- a/testsuite/tests/indexed-types/should_fail/HsBootFam.stderr +++ b/testsuite/tests/indexed-types/should_fail/HsBootFam.stderr @@ -1,5 +1,5 @@ [1 of 3] Compiling HsBootFam_aux[boot] ( HsBootFam_aux.hs-boot, HsBootFam_aux.o-boot ) -HsBootFam_aux.hs-boot:6:1: [GHC-06203] - Illegal family instance in hs-boot file - In the type instance declaration for ‘F’ +HsBootFam_aux.hs-boot:6:1: error: [GHC-58195] + • Illegal family instance in an hs-boot file. + • In the type instance declaration for ‘F’ diff --git a/testsuite/tests/module/T414.stderr b/testsuite/tests/module/T414.stderr index 70c0cdecf7..55fc76508b 100644 --- a/testsuite/tests/module/T414.stderr +++ b/testsuite/tests/module/T414.stderr @@ -1,2 +1,3 @@ -T414.hs:1:1: The IO action ‘main’ is not exported by module ‘Main’ +T414.hs:1:1: error: [GHC-67120] + The IO action ‘main’ is not exported by module ‘Main’ diff --git a/testsuite/tests/module/T7765.stderr b/testsuite/tests/module/T7765.stderr index bc8377d20d..ba69bb0634 100644 --- a/testsuite/tests/module/T7765.stderr +++ b/testsuite/tests/module/T7765.stderr @@ -1,2 +1,3 @@ -T7765.hs:1:1: The IO action ‘main’ is not defined in module ‘Main’ +T7765.hs:1:1: error: [GHC-67120] + The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/parser/should_fail/readFail021.stderr b/testsuite/tests/parser/should_fail/readFail021.stderr index fe9c64b7e7..40b6d9e370 100644 --- a/testsuite/tests/parser/should_fail/readFail021.stderr +++ b/testsuite/tests/parser/should_fail/readFail021.stderr @@ -1,3 +1,3 @@ -readFail021.hs:1:1: +readFail021.hs:1:1: error: [GHC-67120] The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/rename/should_compile/rn055.stderr b/testsuite/tests/rename/should_compile/rn055.stderr index 93c74ff6a8..8ac45051d0 100644 --- a/testsuite/tests/rename/should_compile/rn055.stderr +++ b/testsuite/tests/rename/should_compile/rn055.stderr @@ -1,3 +1,3 @@ -rn055.hs:1:1: warning: [-Wimplicit-prelude] - Module `Prelude' implicitly imported +rn055.hs:1:1: warning: [GHC-20540] [-Wimplicit-prelude] + Module ‘Prelude’ implicitly imported. diff --git a/testsuite/tests/rename/should_fail/T13839b.stderr b/testsuite/tests/rename/should_fail/T13839b.stderr index 93846bd410..8d969ee454 100644 --- a/testsuite/tests/rename/should_fail/T13839b.stderr +++ b/testsuite/tests/rename/should_fail/T13839b.stderr @@ -1,3 +1,3 @@ -T13839b.hs:1:1: error: +T13839b.hs:1:1: error: [GHC-67120] The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/rename/should_fail/T19781.stderr b/testsuite/tests/rename/should_fail/T19781.stderr index ffe4a4d329..04e16481ac 100644 --- a/testsuite/tests/rename/should_fail/T19781.stderr +++ b/testsuite/tests/rename/should_fail/T19781.stderr @@ -1,6 +1,3 @@ -T19781_A.hs-boot:4:1: error: [GHC-11247] - Bindings in hs-boot files are not allowed - -T19781_A.hs-boot:7:1: error: [GHC-11247] - Bindings in hs-boot files are not allowed +T19781_A.hs-boot:4:1: error: [GHC-58195] + Illegal binding in an hs-boot file. diff --git a/testsuite/tests/rename/should_fail/rnfail007.stderr b/testsuite/tests/rename/should_fail/rnfail007.stderr index 98f96f1e02..90ae9e7659 100644 --- a/testsuite/tests/rename/should_fail/rnfail007.stderr +++ b/testsuite/tests/rename/should_fail/rnfail007.stderr @@ -1,3 +1,3 @@ -rnfail007.hs:1:1: +rnfail007.hs:1:1: error: [GHC-67120] The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/rename/should_fail/rnfail047.stderr b/testsuite/tests/rename/should_fail/rnfail047.stderr index 8f7304aa59..8e68027e29 100644 --- a/testsuite/tests/rename/should_fail/rnfail047.stderr +++ b/testsuite/tests/rename/should_fail/rnfail047.stderr @@ -1,3 +1,3 @@ -RnFail047_A.hs-boot:5:1: error: - ‘RnFail047_A.y’ is exported by the hs-boot file, but not exported by the module +RnFail047_A.hs-boot:5:1: error: [GHC-91999] + ‘RnFail047_A.y’ is exported by the hs-boot file, but not exported by the implementing module. diff --git a/testsuite/tests/rename/should_fail/rnfail055.stderr b/testsuite/tests/rename/should_fail/rnfail055.stderr index 787009a4c6..1077a6eb10 100644 --- a/testsuite/tests/rename/should_fail/rnfail055.stderr +++ b/testsuite/tests/rename/should_fail/rnfail055.stderr @@ -5,116 +5,117 @@ RnFail055.hs:2:73: warning: [-Wdeprecated-flags (in -Wdefault)] RnFail055.hs-boot:2:73: warning: [-Wdeprecated-flags (in -Wdefault)] -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. -RnFail055.hs-boot:5:1: error: +RnFail055.hs-boot:5:1: error: [GHC-11890] Identifier ‘f1’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: f1 :: Int -> Float - Boot file: f1 :: Float -> Int - The two types are different + Boot file: f1 :: Float -> Int + The two types are different. -RnFail055.hs-boot:7:1: error: +RnFail055.hs-boot:7:1: error: [GHC-15843] Type constructor ‘S1’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type S1 :: * -> * -> * type S1 a b = (a, b) - Boot file: type S1 :: * -> * -> * -> * + Boot file: type S1 :: * -> * -> * -> * type S1 a b c = (a, b) - The types have different kinds + The types have different kinds. -RnFail055.hs-boot:9:1: error: +RnFail055.hs-boot:9:1: error: [GHC-15843] Type constructor ‘S2’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type S2 :: * -> * -> * type S2 a b = forall a1. (a1, b) - Boot file: type S2 :: * -> * -> * + Boot file: type S2 :: * -> * -> * type S2 a b = forall b1. (a, b1) The roles do not match. - Roles on abstract types default to ‘representational’ in boot files. + NB: roles on abstract types default to ‘representational’ in hs-boot files. -RnFail055.hs-boot:13:1: error: +RnFail055.hs-boot:13:1: error: [GHC-15843] Type constructor ‘T1’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type T1 :: * -> * -> * data T1 a b = T1 [b] [a] - Boot file: type T1 :: * -> * -> * + Boot file: type T1 :: * -> * -> * data T1 a b = T1 [a] [b] - The constructors do not match: The types for ‘T1’ differ + The constructors do not match: The types for ‘T1’ differ. -RnFail055.hs-boot:15:1: error: +RnFail055.hs-boot:15:1: error: [GHC-15843] Type constructor ‘T2’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type role T2 representational nominal type T2 :: * -> * -> * data Eq b => T2 a b = T2 a - Boot file: type role T2 nominal phantom + Boot file: type role T2 nominal phantom type T2 :: * -> * -> * data Eq a => T2 a b = T2 a The roles do not match. - Roles on abstract types default to ‘representational’ in boot files. - The datatype contexts do not match - The constructors do not match: The types for ‘T2’ differ + NB: roles on abstract types default to ‘representational’ in hs-boot files. + The datatype contexts do not match. + The constructors do not match: The types for ‘T2’ differ. -RnFail055.hs-boot:17:11: error: - ‘T3’ is exported by the hs-boot file, but not exported by the module +RnFail055.hs-boot:17:11: error: [GHC-91999] + ‘T3’ is exported by the hs-boot file, but not exported by the implementing module. -RnFail055.hs-boot:18:12: error: - ‘T3'’ is exported by the hs-boot file, but not exported by the module +RnFail055.hs-boot:18:12: error: [GHC-91999] + ‘T3'’ is exported by the hs-boot file, but not exported by the implementing module. -RnFail055.hs-boot:22:1: error: +RnFail055.hs-boot:22:1: error: [GHC-15843] Type constructor ‘T5’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type T5 :: * -> * data T5 a = T5 {field5 :: a} - Boot file: type T5 :: * -> * + Boot file: type T5 :: * -> * data T5 a = T5 a The constructors do not match: - The record label lists for ‘T5’ differ + The record label lists for ‘T5’ differ. -RnFail055.hs-boot:24:1: error: +RnFail055.hs-boot:24:1: error: [GHC-15843] Type constructor ‘T6’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type T6 :: * data T6 = T6 Int - Boot file: type T6 :: * + Boot file: type T6 :: * data T6 = T6 !Int The constructors do not match: - The strictness annotations for ‘T6’ differ + The strictness annotations for ‘T6’ differ. -RnFail055.hs-boot:26:1: error: +RnFail055.hs-boot:26:1: error: [GHC-15843] Type constructor ‘T7’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type role T7 phantom type T7 :: * -> * data T7 a = forall a1. T7 a1 - Boot file: type T7 :: * -> * + Boot file: type T7 :: * -> * data T7 a = forall b. T7 a The roles do not match. - Roles on abstract types default to ‘representational’ in boot files. - The constructors do not match: The types for ‘T7’ differ + NB: roles on abstract types default to ‘representational’ in hs-boot files. + The constructors do not match: The types for ‘T7’ differ. -RnFail055.hs-boot:28:22: error: - ‘RnFail055.m1’ is exported by the hs-boot file, but not exported by the module +RnFail055.hs-boot:28:22: error: [GHC-91999] + ‘RnFail055.m1’ is exported by the hs-boot file, but not exported by the implementing module. -RnFail055.hs-boot:29:1: error: +RnFail055.hs-boot:29:1: error: [GHC-15843] Class ‘C2’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type C2 :: * -> * -> Constraint class C2 a b where m2 :: a -> b m2' :: a -> b {-# MINIMAL m2, m2' #-} - Boot file: type C2 :: * -> * -> Constraint + Boot file: type C2 :: * -> * -> Constraint class C2 a b where m2 :: a -> b {-# MINIMAL m2 #-} - The methods do not match: There are different numbers of methods - The MINIMAL pragmas are not compatible + The class methods do not match: + The number of class methods differs. + The MINIMAL pragmas are not compatible. -RnFail055.hs-boot:30:1: error: +RnFail055.hs-boot:30:1: error: [GHC-15843] Class ‘C3’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type C3 :: * -> Constraint class (Eq a, Ord a) => C3 a - Boot file: type C3 :: * -> Constraint + Boot file: type C3 :: * -> Constraint class (Ord a, Eq a) => C3 a - The class constraints do not match + The superclass constraints do not match. diff --git a/testsuite/tests/rep-poly/RepPolyBackpack3.stderr b/testsuite/tests/rep-poly/RepPolyBackpack3.stderr index 5b187eb186..a32c868f28 100644 --- a/testsuite/tests/rep-poly/RepPolyBackpack3.stderr +++ b/testsuite/tests/rep-poly/RepPolyBackpack3.stderr @@ -9,12 +9,12 @@ Instantiating sig[Sig=impl:Impl] [1 of 1] Compiling Sig[sig] ( sig\Sig.hsig, RepPolyBackpack3.out\sig\sig-Absk5cIXTXe6UYhGMYGber\Sig.o ) -RepPolyBackpack3.bkp:17:5: error: +RepPolyBackpack3.bkp:17:5: error: [GHC-15843] • Type constructor ‘Rep’ has conflicting definitions in the module - and its hsig file + and its hsig file. Main module: type Rep :: GHC.Types.RuntimeRep type Rep = T :: GHC.Types.RuntimeRep - Hsig file: type Rep :: GHC.Types.RuntimeRep - data Rep - Illegal type family application in implementation of abstract data. - • while checking that impl:Impl implements signature Sig in sig[Sig=impl:Impl] + Hsig file: type Rep :: GHC.Types.RuntimeRep + data Rep + Illegal implementation of abstract data: Invalid type family ‘T’. + • While checking that ‘impl:Impl’ implements signature ‘Sig’ in ‘sig[Sig=impl:Impl]’. diff --git a/testsuite/tests/roles/should_fail/Roles12.stderr b/testsuite/tests/roles/should_fail/Roles12.stderr index b4d7499fe9..99eb45fd96 100644 --- a/testsuite/tests/roles/should_fail/Roles12.stderr +++ b/testsuite/tests/roles/should_fail/Roles12.stderr @@ -1,11 +1,11 @@ -Roles12.hs:6:1: error: +Roles12.hs:6:1: error: [GHC-15843] Type constructor ‘T’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type role T phantom type T :: * -> * data T a - Boot file: type T :: * -> * + Boot file: type T :: * -> * data T a The roles do not match. - Roles on abstract types default to ‘representational’ in boot files. + NB: roles on abstract types default to ‘representational’ in hs-boot files. diff --git a/testsuite/tests/roles/should_fail/T9204.stderr b/testsuite/tests/roles/should_fail/T9204.stderr index c54df4870c..33f638578e 100644 --- a/testsuite/tests/roles/should_fail/T9204.stderr +++ b/testsuite/tests/roles/should_fail/T9204.stderr @@ -1,11 +1,11 @@ -T9204.hs:7:1: error: +T9204.hs:7:1: error: [GHC-15843] Type constructor ‘D’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type role D phantom type D :: * -> * data D a - Boot file: type D :: * -> * + Boot file: type D :: * -> * data D a The roles do not match. - Roles on abstract types default to ‘representational’ in boot files. + NB: roles on abstract types default to ‘representational’ in hs-boot files. diff --git a/testsuite/tests/typecheck/T12441/T12441.stderr b/testsuite/tests/typecheck/T12441/T12441.stderr index fe6b471d52..a585a6babb 100644 --- a/testsuite/tests/typecheck/T12441/T12441.stderr +++ b/testsuite/tests/typecheck/T12441/T12441.stderr @@ -1,10 +1,10 @@ -[1 of 3] Compiling T12441[boot] ( T12441.hs-boot, T12441.o-boot )
-[2 of 3] Compiling T12441A ( T12441A.hs, T12441A.o )
-[3 of 3] Compiling T12441 ( T12441.hs, T12441.o )
-
-T12441.hs-boot:3:1:
- Identifier ‘f’ has conflicting definitions in the module
- and its hs-boot file
- Main module: f :: forall b a. (a, b)
- Boot file: f :: forall a b. (a, b)
- The two types are different
+[1 of 3] Compiling T12441[boot] ( T12441.hs-boot, T12441.o-boot ) +[2 of 3] Compiling T12441A ( T12441A.hs, T12441A.o ) +[3 of 3] Compiling T12441 ( T12441.hs, T12441.o ) + +T12441.hs-boot:3:1: error: [GHC-11890] + Identifier ‘f’ has conflicting definitions in the module + and its hs-boot file. + Main module: f :: forall b a. (a, b) + Boot file: f :: forall a b. (a, b) + The two types are different. diff --git a/testsuite/tests/typecheck/should_fail/T12035.stderr b/testsuite/tests/typecheck/should_fail/T12035.stderr index 375b94c95a..b1bce2d3d0 100644 --- a/testsuite/tests/typecheck/should_fail/T12035.stderr +++ b/testsuite/tests/typecheck/should_fail/T12035.stderr @@ -1,8 +1,8 @@ -T12035.hs-boot:2:1: error: +T12035.hs-boot:2:1: error: [GHC-15843] Type constructor ‘T’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type T :: * type T = Bool - Boot file: type T :: * + Boot file: type T :: * data T diff --git a/testsuite/tests/typecheck/should_fail/T12035j.stderr b/testsuite/tests/typecheck/should_fail/T12035j.stderr index 375b94c95a..b1bce2d3d0 100644 --- a/testsuite/tests/typecheck/should_fail/T12035j.stderr +++ b/testsuite/tests/typecheck/should_fail/T12035j.stderr @@ -1,8 +1,8 @@ -T12035.hs-boot:2:1: error: +T12035.hs-boot:2:1: error: [GHC-15843] Type constructor ‘T’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type T :: * type T = Bool - Boot file: type T :: * + Boot file: type T :: * data T diff --git a/testsuite/tests/typecheck/should_fail/T12042.stderr b/testsuite/tests/typecheck/should_fail/T12042.stderr index ae3cf33ea7..323c5e3693 100644 --- a/testsuite/tests/typecheck/should_fail/T12042.stderr +++ b/testsuite/tests/typecheck/should_fail/T12042.stderr @@ -2,10 +2,10 @@ [2 of 3] Compiling T12042a ( T12042a.hs, T12042a.o ) [3 of 3] Compiling T12042 ( T12042.hs, T12042.o ) -T12042.hs-boot:2:1: error: +T12042.hs-boot:2:1: error: [GHC-15843] Type constructor ‘S’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type S :: * type S = R - Boot file: type S :: * + Boot file: type S :: * data S diff --git a/testsuite/tests/typecheck/should_fail/T16453E1.stderr b/testsuite/tests/typecheck/should_fail/T16453E1.stderr index d435ab8e1e..082a1cbc4d 100644 --- a/testsuite/tests/typecheck/should_fail/T16453E1.stderr +++ b/testsuite/tests/typecheck/should_fail/T16453E1.stderr @@ -1,2 +1,3 @@ -T16453E1.hs:1:1: error: + +T16453E1.hs:1:1: error: [GHC-67120] The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/typecheck/should_fail/T19397E3.stderr b/testsuite/tests/typecheck/should_fail/T19397E3.stderr index 2359ec171a..b6f692f84d 100644 --- a/testsuite/tests/typecheck/should_fail/T19397E3.stderr +++ b/testsuite/tests/typecheck/should_fail/T19397E3.stderr @@ -1,3 +1,3 @@ -T19397E3.hs:1:1: error: +T19397E3.hs:1:1: error: [GHC-67120] The main IO action ‘foo’ is not defined in module ‘Main’ diff --git a/testsuite/tests/typecheck/should_fail/T19397E4.stderr b/testsuite/tests/typecheck/should_fail/T19397E4.stderr index 3f9eec7bf0..a80a14dd3d 100644 --- a/testsuite/tests/typecheck/should_fail/T19397E4.stderr +++ b/testsuite/tests/typecheck/should_fail/T19397E4.stderr @@ -1,3 +1,3 @@ -T19397E4.hs:1:1: error: +T19397E4.hs:1:1: error: [GHC-67120] The main IO action ‘foo’ is not exported by module ‘Main’ diff --git a/testsuite/tests/typecheck/should_fail/T20588.stderr b/testsuite/tests/typecheck/should_fail/T20588.stderr index b9b7ed3f38..50e7bbec77 100644 --- a/testsuite/tests/typecheck/should_fail/T20588.stderr +++ b/testsuite/tests/typecheck/should_fail/T20588.stderr @@ -1,29 +1,29 @@ -T20588.hs-boot:8:1: error: +T20588.hs-boot:8:1: error: [GHC-15843] Class ‘C’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type C :: * -> Constraint class C a where meth :: a -> a {-# MINIMAL meth #-} - Boot file: type C :: * -> Constraint + Boot file: type C :: * -> Constraint class C a where meth :: a -> a {-# MINIMAL meth #-} - The methods do not match: - The default methods associated with ‘meth’ are different + The class methods do not match: + The default methods associated with ‘meth’ are different. -T20588.hs-boot:11:1: error: +T20588.hs-boot:11:1: error: [GHC-15843] Class ‘D’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type D :: * -> Constraint class D a where type T :: * -> * type family T a Default: Int - Boot file: type D :: * -> Constraint + Boot file: type D :: * -> Constraint class D a where type T :: * -> * type family T a The associated types do not match: - The associated type defaults differ + The types of the second associated type default differ. diff --git a/testsuite/tests/typecheck/should_fail/T20588c.stderr b/testsuite/tests/typecheck/should_fail/T20588c.stderr index d15573a30f..5b008ecc48 100644 --- a/testsuite/tests/typecheck/should_fail/T20588c.stderr +++ b/testsuite/tests/typecheck/should_fail/T20588c.stderr @@ -1,14 +1,14 @@ -T20588c.hs-boot:7:1: error: +T20588c.hs-boot:7:1: error: [GHC-15843] Class ‘C’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type C :: * -> Constraint class C a where meth :: a default meth :: Monoid a => a - Boot file: type C :: * -> Constraint + Boot file: type C :: * -> Constraint class C a where meth :: a {-# MINIMAL meth #-} - The methods do not match: - The default methods associated with ‘meth’ are different + The class methods do not match: + The default methods associated with ‘meth’ are different. diff --git a/testsuite/tests/typecheck/should_fail/T3468.stderr b/testsuite/tests/typecheck/should_fail/T3468.stderr index c8aa7622f8..77a55c34d7 100644 --- a/testsuite/tests/typecheck/should_fail/T3468.stderr +++ b/testsuite/tests/typecheck/should_fail/T3468.stderr @@ -1,10 +1,10 @@ -T3468.hs-boot:3:1: error: +T3468.hs-boot:3:1: error: [GHC-15843] Type constructor ‘Tool’ has conflicting definitions in the module - and its hs-boot file + and its hs-boot file. Main module: type role Tool phantom type Tool :: * -> * data Tool d = forall a r. F a - Boot file: type Tool :: * + Boot file: type Tool :: * data Tool - The types have different kinds + The types have different kinds. diff --git a/testsuite/tests/typecheck/should_fail/tcfail030.stderr b/testsuite/tests/typecheck/should_fail/tcfail030.stderr index 66b129076b..d11a91f896 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail030.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail030.stderr @@ -1,3 +1,3 @@ -tcfail030.hs:1:1: +tcfail030.hs:1:1: error: [GHC-67120] The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr index 75df49fd36..4ef1b425b1 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr @@ -1,8 +1,4 @@ -Template.hs:5:1: warning: [-Wsemigroup (in -Wcompat)] - Local definition of ‘<>’ clashes with a future Prelude name. - This will become an error in a future release. - Template.hs:11:3: warning: [GHC-50928] [-Wnoncanonical-monoid-instances (in -Wdefault, -Wcompat)] Noncanonical ‘(<>) = mappend’ definition detected in the instance declaration for ‘Semigroup S’. |