A class in an interface file defines the CoTyCon of its class tyocn

[ghc-hetmet.git] / compiler / iface / LoadIface.lhs

diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index 8bcf987..3faf00c 100644 (file)
--- 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