Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/71b5ca5a5e00e77c4fc2337db9900e0f98ed0a0f >--------------------------------------------------------------- commit 71b5ca5a5e00e77c4fc2337db9900e0f98ed0a0f Author: Ian Lynagh <i...@well-typed.com> Date: Wed Dec 5 20:35:16 2012 +0000 Refactor findAndReadIface; no functional changes >--------------------------------------------------------------- compiler/iface/LoadIface.lhs | 97 ++++++++++++++++++++--------------------- 1 files changed, 47 insertions(+), 50 deletions(-) diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 85c8a78..01a0d97 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -484,57 +484,54 @@ findAndReadIface :: SDoc -> Module -- sometimes it's ok to fail... see notes with loadInterface findAndReadIface doc_str mod hi_boot_file - = do { traceIf (sep [hsep [ptext (sLit "Reading"), - if hi_boot_file - then ptext (sLit "[boot]") - else empty, - ptext (sLit "interface for"), - ppr mod <> semi], - nest 4 (ptext (sLit "reason:") <+> doc_str)]) - - -- Check for GHC.Prim, and return its static interface - ; dflags <- getDynFlags - ; if mod == gHC_PRIM - then return (Succeeded (ghcPrimIface, + = do traceIf (sep [hsep [ptext (sLit "Reading"), + if hi_boot_file + then ptext (sLit "[boot]") + else empty, + ptext (sLit "interface for"), + ppr mod <> semi], + nest 4 (ptext (sLit "reason:") <+> doc_str)]) + + -- Check for GHC.Prim, and return its static interface + if mod == gHC_PRIM + then return (Succeeded (ghcPrimIface, "<built in interface for GHC.Prim>")) - else do - - -- Look for the file - ; hsc_env <- getTopEnv - ; mb_found <- liftIO (findExactModule hsc_env mod) - ; case mb_found of { - - Found loc mod -> do - - -- Found file, so read it - { let { file_path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc) } - - -- If the interface is in the current package then if we could - -- load it would already be in the HPT and we assume that our - -- callers checked that. - ; if thisPackage dflags == modulePackageId mod - && not (isOneShot (ghcMode dflags)) - then return (Failed (homeModError mod loc)) - else do { - - ; traceIf (ptext (sLit "readIFace") <+> text file_path) - ; read_result <- readIface mod file_path hi_boot_file - ; case read_result of - Failed err -> return (Failed (badIfaceFile file_path err)) - Succeeded iface - | mi_module iface /= mod -> - return (Failed (wrongIfaceModErr iface mod file_path)) - | otherwise -> - return (Succeeded (iface, file_path)) - -- Don't forget to fill in the package name... - }} - ; err -> do - { traceIf (ptext (sLit "...not found")) - ; dflags <- getDynFlags - ; return (Failed (cannotFindInterface dflags - (moduleName mod) err)) } - } - } + else do + dflags <- getDynFlags + -- Look for the file + hsc_env <- getTopEnv + mb_found <- liftIO (findExactModule hsc_env mod) + case mb_found of + Found loc mod -> do + + -- Found file, so read it + let file_path = addBootSuffix_maybe hi_boot_file + (ml_hi_file loc) + + -- If the interface is in the current package + -- then if we could load it would already be in + -- the HPT and we assume that our callers checked + -- that. + if thisPackage dflags == modulePackageId mod && + not (isOneShot (ghcMode dflags)) + then return (Failed (homeModError mod loc)) + else read_file file_path + err -> do + traceIf (ptext (sLit "...not found")) + dflags <- getDynFlags + return (Failed (cannotFindInterface dflags + (moduleName mod) err)) + where read_file file_path = do + traceIf (ptext (sLit "readIFace") <+> text file_path) + read_result <- readIface mod file_path hi_boot_file + case read_result of + Failed err -> return (Failed (badIfaceFile file_path err)) + Succeeded iface + | mi_module iface /= mod -> + return (Failed (wrongIfaceModErr iface mod file_path)) + | otherwise -> + return (Succeeded (iface, file_path)) + -- Don't forget to fill in the package name... \end{code} @readIface@ tries just the one file. _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
