From 4869272036841043e5fef350007b6a943e8c4690 Mon Sep 17 00:00:00 2001
From: "Edward Z. Yang" <ezyang@cs.stanford.edu>
Date: Tue, 7 Apr 2015 09:08:54 -0500
Subject: [PATCH] Don't repeat package key with -dppr-debug when package info
is missing.
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Reviewed By: austin
Differential Revision: https://phabricator.haskell.org/D802
---
compiler/basicTypes/Module.hs | 12 +++++++-----
compiler/main/Packages.hs | 8 +++-----
compiler/main/Packages.hs-boot | 2 +-
3 files changed, 11 insertions(+), 11 deletions(-)
diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs
index ac5efd4a2cf4..85e852fa5d7e 100644
--- a/compiler/basicTypes/Module.hs
+++ b/compiler/basicTypes/Module.hs
@@ -326,11 +326,13 @@ stablePackageKeyCmp p1 p2 = packageKeyFS p1 `compare` packageKeyFS p2
instance Outputable PackageKey where
ppr pk = getPprStyle $ \sty -> sdocWithDynFlags $ \dflags ->
- text (packageKeyPackageIdString dflags pk)
- -- Don't bother qualifying if it's wired in!
- <> (if qualPackage sty pk && not (pk `elem` wiredInPackageKeys)
- then char '@' <> ftext (packageKeyFS pk)
- else empty)
+ case packageKeyPackageIdString dflags pk of
+ Nothing -> ftext (packageKeyFS pk)
+ Just pkg -> text pkg
+ -- Don't bother qualifying if it's wired in!
+ <> (if qualPackage sty pk && not (pk `elem` wiredInPackageKeys)
+ then char '@' <> ftext (packageKeyFS pk)
+ else empty)
instance Binary PackageKey where
put_ bh pid = put_ bh (packageKeyFS pid)
diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index 28f2f2d2c316..aa97280a290d 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -1325,12 +1325,10 @@ missingDependencyMsg (Just parent)
-- -----------------------------------------------------------------------------
-packageKeyPackageIdString :: DynFlags -> PackageKey -> String
+packageKeyPackageIdString :: DynFlags -> PackageKey -> Maybe String
packageKeyPackageIdString dflags pkg_key
- | pkg_key == mainPackageKey = "main"
- | otherwise = maybe "(unknown)"
- sourcePackageIdString
- (lookupPackage dflags pkg_key)
+ | pkg_key == mainPackageKey = Just "main"
+ | otherwise = fmap sourcePackageIdString (lookupPackage dflags pkg_key)
-- | Will the 'Name' come from a dynamically linked library?
isDllName :: DynFlags -> PackageKey -> Module -> Name -> Bool
diff --git a/compiler/main/Packages.hs-boot b/compiler/main/Packages.hs-boot
index 2f898f19d3e7..f2343b66c9d7 100644
--- a/compiler/main/Packages.hs-boot
+++ b/compiler/main/Packages.hs-boot
@@ -3,4 +3,4 @@ module Packages where
import {-# SOURCE #-} Module (PackageKey)
import {-# SOURCE #-} DynFlags (DynFlags)
data PackageState
-packageKeyPackageIdString :: DynFlags -> PackageKey -> String
+packageKeyPackageIdString :: DynFlags -> PackageKey -> Maybe String
--
GitLab