X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FLoadIface.lhs;h=3faf00c1e26ff8ad4e8e28420aa016cc78b99ef1;hb=086f5cc85d2371e6f6d2ebafa68732b791772aff;hp=8bcf987c999cea089c051089c705b625529a37b3;hpb=61d2625ae2e6a4cdae2ffc92df828905e81c24cc;p=ghc-hetmet.git diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 8bcf987..3faf00c 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -42,13 +42,14 @@ import Name ( Name {-instance NamedThing-}, getOccName, import NameEnv import MkId ( seqId ) import Module -import OccName ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc, mkClassDataConOcc, - mkSuperDictSelOcc, mkDataConWrapperOcc, mkDataConWorkerOcc ) +import OccName ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc, + mkClassDataConOcc, mkSuperDictSelOcc, + mkDataConWrapperOcc, mkDataConWorkerOcc ) import SrcLoc ( importedSrcLoc ) import Maybes ( MaybeErr(..) ) import ErrUtils ( Message ) import Finder ( findImportedModule, findExactModule, - FindResult(..), cantFindError ) + FindResult(..), cannotFindInterface ) import UniqFM import Outputable import BinIface ( readBinIface ) @@ -81,14 +82,11 @@ loadSrcInterface doc mod want_boot = do Found _ mod -> do mb_iface <- initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot) case mb_iface of - Failed err -> failWithTc (elaborate err) + Failed err -> failWithTc err Succeeded iface -> return iface err -> let dflags = hsc_dflags hsc_env in - failWithTc (elaborate (cantFindError dflags mod err)) - where - elaborate err = hang (ptext SLIT("Failed to load interface for") <+> - quotes (ppr mod) <> colon) 4 err + failWithTc (cannotFindInterface dflags mod err) -- | Load interfaces for a collection of orphan modules. loadOrphanModules :: [Module] -> TcM () @@ -315,7 +313,8 @@ loadDecl ignore_prags mod (_version, decl) -- imported name, to fix the module correctly in the cache mk_new_bndr mod mb_parent occ = newGlobalBinder mod occ mb_parent - (importedSrcLoc (showSDoc (pprModule mod))) + (importedSrcLoc (showSDoc (ppr (moduleName mod)))) + -- ToDo: qualify with the package name if necessary doc = ptext SLIT("Declaration for") <+> ppr (ifName decl) @@ -336,8 +335,11 @@ ifaceDeclSubBndrs :: IfaceDecl -> [OccName] -- Deeply revolting, because it has to predict what gets bound, -- especially the question of whether there's a wrapper for a datacon -ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, ifSigs = sigs }) - = [tc_occ, dc_occ, dcww_occ] ++ +ifaceDeclSubBndrs IfaceClass { ifCtxt = sc_ctxt, + ifName = cls_occ, + ifSigs = sigs } + = co_occs ++ + [tc_occ, dc_occ, dcww_occ] ++ [op | IfaceClassOp op _ _ <- sigs] ++ [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] where @@ -345,16 +347,19 @@ ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, ifSigs = sigs n_sigs = length sigs tc_occ = mkClassTyConOcc cls_occ dc_occ = mkClassDataConOcc cls_occ + co_occs | is_newtype = [mkNewTyCoOcc tc_occ] + | otherwise = [] dcww_occ | is_newtype = mkDataConWrapperOcc dc_occ -- Newtypes have wrapper but no worker | otherwise = mkDataConWorkerOcc dc_occ -- Otherwise worker but no wrapper is_newtype = n_sigs + n_ctxt == 1 -- Sigh -ifaceDeclSubBndrs (IfaceData {ifCons = IfAbstractTyCon}) +ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = [] -- Newtype -ifaceDeclSubBndrs (IfaceData {ifCons = IfNewTyCon (IfVanillaCon { ifConOcc = con_occ, - ifConFields = fields})}) - = fields ++ [con_occ, mkDataConWrapperOcc con_occ] +ifaceDeclSubBndrs IfaceData {ifCons = IfNewTyCon (IfVanillaCon { + ifConOcc = con_occ, + ifConFields = fields})} + = fields ++ [con_occ, mkDataConWrapperOcc con_occ] -- Wrapper, no worker; see MkId.mkDataConIds ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon cons}) @@ -362,7 +367,7 @@ ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon cons}) ++ concatMap dc_occs cons where fld_occs (IfVanillaCon { ifConFields = fields }) = fields - fld_occs (IfGadtCon {}) = [] + fld_occs (IfGadtCon {}) = [] dc_occs con_decl | has_wrapper = [con_occ, work_occ, wrap_occ] | otherwise = [con_occ, work_occ] @@ -419,7 +424,8 @@ findAndReadIface doc_str mod hi_boot_file Failed err -> do { traceIf (ptext SLIT("...not found")) ; dflags <- getDOpts - ; returnM (Failed (cantFindError dflags (moduleName mod) err)) } ; + ; returnM (Failed (cannotFindInterface dflags + (moduleName mod) err)) } ; Succeeded file_path -> do