diff options
Diffstat (limited to 'compiler/GHC/Driver')
| -rw-r--r-- | compiler/GHC/Driver/Errors/Ppr.hs | 14 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Errors/Types.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Make.hs | 39 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Pipeline/Execute.hs | 2 |
4 files changed, 25 insertions, 32 deletions
diff --git a/compiler/GHC/Driver/Errors/Ppr.hs b/compiler/GHC/Driver/Errors/Ppr.hs index 1b604e1071..76a0ed15d3 100644 --- a/compiler/GHC/Driver/Errors/Ppr.hs +++ b/compiler/GHC/Driver/Errors/Ppr.hs @@ -19,6 +19,7 @@ import GHC.Unit.Module import GHC.Unit.State import GHC.Types.Hint import GHC.Types.SrcLoc +import Data.Version import Language.Haskell.Syntax.Decls (RuleDecl(..)) @@ -104,16 +105,23 @@ instance Diagnostic DriverMessage where -> let msg = vcat [ text "The following packages were specified" <+> text "via -package or -package-id flags," , text "but were not needed for compilation:" - , nest 2 (vcat (map (withDash . pprUnusedArg) unusedArgs)) + , nest 2 (vcat (map (withDash . displayOneUnused) unusedArgs)) ] in mkSimpleDecorated msg where withDash :: SDoc -> SDoc withDash = (<+>) (text "-") + displayOneUnused (_uid, pn , v, f) = + ppr pn <> text "-" <> text (showVersion v) + <+> parens (suffix f) + + suffix f = text "exposed by flag" <+> pprUnusedArg f + pprUnusedArg :: PackageArg -> SDoc - pprUnusedArg (PackageArg str) = text str - pprUnusedArg (UnitIdArg uid) = ppr uid + pprUnusedArg (PackageArg str) = text "-package" <+> text str + pprUnusedArg (UnitIdArg uid) = text "-package-id" <+> ppr uid + DriverUnnecessarySourceImports mod -> mkSimpleDecorated (text "{-# SOURCE #-} unnecessary in import of " <+> quotes (ppr mod)) DriverDuplicatedModuleDeclaration mod files diff --git a/compiler/GHC/Driver/Errors/Types.hs b/compiler/GHC/Driver/Errors/Types.hs index 7257b23903..015ae5e375 100644 --- a/compiler/GHC/Driver/Errors/Types.hs +++ b/compiler/GHC/Driver/Errors/Types.hs @@ -143,7 +143,7 @@ data DriverMessage where Test cases: warnings/should_compile/UnusedPackages -} - DriverUnusedPackages :: [PackageArg] -> DriverMessage + DriverUnusedPackages :: [(UnitId, PackageName, Version, PackageArg)] -> DriverMessage {-| DriverUnnecessarySourceImports (controlled with -Wunused-imports) occurs if there are {-# SOURCE #-} imports which are not necessary. See 'warnUnnecessarySourceImports' diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index 0c41dbbda6..cbf1e47cac 100644 --- a/compiler/GHC/Driver/Make.hs +++ b/compiler/GHC/Driver/Make.hs @@ -264,7 +264,7 @@ instantiationNodes uid unit_state = InstantiationNode uid <$> iuids_to_check where iuids_to_check :: [InstantiatedUnit] iuids_to_check = - nubSort $ concatMap goUnitId (explicitUnits unit_state) + nubSort $ concatMap (goUnitId . fst) (explicitUnits unit_state) where goUnitId uid = [ recur @@ -460,11 +460,18 @@ warnUnusedPackages us dflags mod_graph = $ concatMap ms_imps ( filter (\ms -> homeUnitId_ dflags == ms_unitid ms) (mgModSummaries mod_graph)) - requestedArgs = mapMaybe packageArg (packageFlags dflags) + used_args = Set.fromList $ map unitId loadedPackages - unusedArgs - = filter (\arg -> not $ any (matching us arg) loadedPackages) - requestedArgs + resolve (u,mflag) = do + -- The units which we depend on via the command line explicitly + flag <- mflag + -- Which we can find the UnitInfo for (should be all of them) + ui <- lookupUnit us u + -- Which are not explicitly used + guard (Set.notMember (unitId ui) used_args) + return (unitId ui, unitPackageName ui, unitPackageVersion ui, flag) + + unusedArgs = mapMaybe resolve (explicitUnits us) warn = singleMessage $ mkPlainMsgEnvelope diag_opts noSrcSpan (DriverUnusedPackages unusedArgs) @@ -472,28 +479,6 @@ warnUnusedPackages us dflags mod_graph = then emptyMessages else warn - where - packageArg (ExposePackage _ arg _) = Just arg - packageArg _ = Nothing - - matchingStr :: String -> UnitInfo -> Bool - matchingStr str p - = str == unitPackageIdString p - || str == unitPackageNameString p - - matching :: UnitState -> PackageArg -> UnitInfo -> Bool - matching _ (PackageArg str) p = matchingStr str p - matching state (UnitIdArg uid) p = uid == realUnit state p - - -- For wired-in packages, we have to unwire their id, - -- otherwise they won't match package flags - realUnit :: UnitState -> UnitInfo -> Unit - realUnit state - = unwireUnit state - . RealUnit - . Definite - . unitId - -- | A ModuleGraphNode which also has a hs-boot file, and the list of nodes on any -- path from module to its boot file. diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs index 97eeb58260..909102b573 100644 --- a/compiler/GHC/Driver/Pipeline/Execute.hs +++ b/compiler/GHC/Driver/Pipeline/Execute.hs @@ -996,7 +996,7 @@ doCpp logger tmpfs dflags unit_env raw input_fn output_fn = do -- MIN_VERSION macros let uids = explicitUnits unit_state - pkgs = catMaybes (map (lookupUnit unit_state) uids) + pkgs = mapMaybe (lookupUnit unit_state . fst) uids mb_macro_include <- if not (null pkgs) && gopt Opt_VersionMacros dflags then do macro_stub <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "h" |