[commit: ghc] master: LoadIFace: Show known names on inconsistent interface file (dad6a88)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/dad6a886802ec4e69104972428fabc75c79a634a/ghc

>---------------------------------------------------------------

commit dad6a886802ec4e69104972428fabc75c79a634a
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Wed Aug 31 16:04:11 2016 -0400

    LoadIFace: Show known names on inconsistent interface file
    
    Reviewers: austin
    
    Subscribers: simonpj, ezyang, thomie
    
    Differential Revision: https://phabricator.haskell.org/D2466


>---------------------------------------------------------------

dad6a886802ec4e69104972428fabc75c79a634a
 compiler/iface/LoadIface.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index ad5f7d3..c5c3538 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -138,7 +138,7 @@ importDecl name
         { eps <- getEps
         ; case lookupTypeEnv (eps_PTE eps) name of
             Just thing -> return (Succeeded thing)
-            Nothing    -> return (Failed not_found_msg)
+            Nothing    -> return $ Failed (ifPprDebug (found_things_msg eps) $$ not_found_msg)
     }}}
   where
     nd_doc = text "Need decl for" <+> ppr name
@@ -146,6 +146,11 @@ importDecl name
                                 pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name)
                        2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file",
                                 text "Use -ddump-if-trace to get an idea of which file caused the error"])
+    found_things_msg eps =
+        hang (text "Found the following declarations in" <+> ppr (nameModule name) <> colon)
+           2 (vcat (map ppr $ filter is_interesting $ nameEnvElts $ eps_PTE eps))
+      where
+        is_interesting thing = nameModule name == nameModule (getName thing)
 
 
 {-