From 7db1714bc461645af15c3a1bc2914149bdc20aa5 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Mon, 27 Oct 2003 14:05:17 +0000
Subject: [PATCH] [project @ 2003-10-27 14:05:17 by simonpj] Improve error
 message when iface decl not found

---
 ghc/compiler/iface/TcIface.lhs |   44 +++++++++++++++++++++++-----------------
 1 file changed, 25 insertions(+), 19 deletions(-)

diff --git a/ghc/compiler/iface/TcIface.lhs b/ghc/compiler/iface/TcIface.lhs
index 73f20cd..8f60c8a 100644
--- a/ghc/compiler/iface/TcIface.lhs
+++ b/ghc/compiler/iface/TcIface.lhs
@@ -182,29 +182,35 @@ getThing name
 
   | otherwise = do	-- The normal case, not wired in
   {	-- Get the decl from the pool
-    decl <- updateEps (\ eps ->
-	    let 
-	        (decls', decl) = selectDecl (eps_decls eps) name
-	    in
-	    (eps { eps_decls = decls' }, decl))
-
-    -- Typecheck it
-    -- Side-effects EPS by faulting in any needed decls
-    -- (via nested calls to tcImportDecl)
-  ; initIfaceLcl (nameModuleName name) (tcIfaceDecl decl) }
-
+    mb_decl <- updateEps (\ eps -> selectDecl eps name)
+
+    ; case mb_decl of
+	Just decl -> initIfaceLcl (nameModuleName name) (tcIfaceDecl decl)
+		-- Typecheck it
+		-- Side-effects EPS by faulting in any needed decls
+		-- (via nested calls to tcImportDecl)
+		     
+
+	Nothing -> do { ioToIOEnv (printErrs (msg defaultErrStyle)); failM }
+		-- Declaration not found
+		-- No errors-var to accumulate errors in, so just
+		-- print out the error right now
+		     
+    }
+  where
+     msg = hang (ptext SLIT("Can't find interface-file declaration for") <+> ppr (nameParent name))
+	      2 (vcat [ptext SLIT("Probable cause: bug in .hi-boot file, or inconsistent .hi file"),
+		       ptext SLIT("Use -ddump-if-trace to get an idea of which file caused the error")])
 
-selectDecl :: DeclPool -> Name -> (DeclPool, IfaceDecl)
+selectDecl :: ExternalPackageState -> Name -> (ExternalPackageState, Maybe IfaceDecl)
 -- Use nameParent to get the parent name of the thing
-selectDecl (Pool decls_map n_in n_out) name
-   = (Pool decls' n_in (n_out+1), decl)
+selectDecl eps@(EPS { eps_decls = Pool decls_map n_in n_out}) name
+   = case lookupNameEnv decls_map main_name of
+	Nothing   -> (eps, Nothing)
+	Just decl -> (eps {eps_decls = Pool decls' n_in (n_out+1)}, Just decl)
    where
      main_name = nameParent name
-     decl = case lookupNameEnv decls_map main_name of
-		Nothing   -> pprPanic "selectDecl" (ppr main_name <+> ppr name) ;
-		Just decl -> decl
-
-     decls' = delFromNameEnv decls_map main_name
+     decls'    = delFromNameEnv decls_map main_name
 \end{code}
 
 %************************************************************************
-- 
1.7.10.4