[project @ 2003-06-24 07:58:18 by simonpj]

[ghc-hetmet.git] / ghc / compiler / rename / RnHiFiles.lhs

diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs
index f14fb61..82512dc 100644 (file)
--- a/ghc/compiler/rename/RnHiFiles.lhs
+++ b/ghc/compiler/rename/RnHiFiles.lhs
@@ -52,8 +52,9 @@ import Module         ( Module, ModuleName, ModLocation(ml_hi_file),
                          extendModuleEnv, lookupModuleEnvByName
                        )
 import RdrName         ( RdrName, mkRdrUnqual, rdrNameOcc, nameRdrName )
-import OccName         ( OccName, mkWorkerOcc, mkClassTyConOcc, mkClassDataConOcc,
-                         mkSuperDictSelOcc, mkGenOcc1, mkGenOcc2 )
+import OccName         ( OccName, mkClassTyConOcc, mkClassDataConOcc,
+                         mkSuperDictSelOcc, mkGenOcc1, mkGenOcc2, 
+                         mkDataConWrapperOcc, mkDataConWorkerOcc )
 import TyCon           ( DataConDetails(..) )
 import SrcLoc          ( noSrcLoc, mkSrcLoc )
 import Maybes          ( maybeToBool )
@@ -326,13 +327,14 @@ getSysBinders :: Module -> TyClDecl RdrName -> TcRn m [Name]
 -- on RdrNames, returning OccNames
 
 getSysBinders mod (ClassDecl {tcdName = cname, tcdCtxt = cxt, tcdLoc = loc})
-  = sequenceM [new_sys_bndr mod n loc | n <- sys_occs]
+  = mapM (new_sys_bndr mod loc) sys_occs
   where
        -- C.f. TcClassDcl.tcClassDecl1
-    sys_occs   = tc_occ : data_occ : dw_occ : sc_sel_occs
+    sys_occs   = tc_occ : data_occ : dwrap_occ : dwork_occ : sc_sel_occs
     cls_occ    = rdrNameOcc cname
     data_occ   = mkClassDataConOcc cls_occ
-    dw_occ     = mkWorkerOcc data_occ
+    dwrap_occ          = mkDataConWrapperOcc data_occ
+    dwork_occ          = mkDataConWorkerOcc data_occ
     tc_occ     = mkClassTyConOcc   cls_occ
     sc_sel_occs = [mkSuperDictSelOcc n cls_occ | n <- [1..length cxt]]
 
@@ -340,19 +342,21 @@ getSysBinders mod (TyData {tcdName = tc_name, tcdCons = DataCons cons,
                           tcdGeneric = Just want_generic, tcdLoc = loc})
        -- The 'Just' is because this is an interface-file decl
        -- so it will say whether to derive generic stuff for it or not
-  = sequenceM ([new_sys_bndr mod n loc | n <- gen_occs] ++ 
-              map con_sys_occ cons)
+  = mapM (new_sys_bndr mod loc) (gen_occs ++ concatMap mk_con_occs cons)
   where
+    new = new_sys_bndr
        -- c.f. TcTyDecls.tcTyDecl
     tc_occ = rdrNameOcc tc_name
     gen_occs | want_generic = [mkGenOcc1 tc_occ, mkGenOcc2 tc_occ]
             | otherwise    = []
-    con_sys_occ (ConDecl name _ _ _ loc) 
-       = new_sys_bndr mod (mkWorkerOcc (rdrNameOcc name)) loc
+    mk_con_occs (ConDecl name _ _ _ _) 
+       = [mkDataConWrapperOcc con_occ, mkDataConWorkerOcc con_occ]
+       where
+         con_occ = rdrNameOcc name     -- The "source name"
     
 getSysBinders mod decl = returnM []
 
-new_sys_bndr mod occ loc = newTopBinder mod (mkRdrUnqual occ) loc
+new_sys_bndr mod loc occ = newTopBinder mod (mkRdrUnqual occ) loc
 
 
 -----------------------------------------------------
@@ -568,11 +572,12 @@ findAndReadIface doc_str mod_name hi_boot_file
     ioToTcRn (findHiFile mod_name hi_boot_file)        `thenM` \ maybe_found ->
 
     case maybe_found of
-      Nothing -> 
+      Left files -> 
        traceRn (ptext SLIT("...not found"))    `thenM_`
-       returnM (Left (noIfaceErr mod_name hi_boot_file))
+       getDOpts                                `thenM` \ dflags ->
+       returnM (Left (noIfaceErr dflags mod_name hi_boot_file files))
 
-      Just (wanted_mod, file_path) -> 
+      Right (wanted_mod, file_path) -> 
        traceRn (ptext SLIT("readIFace") <+> text file_path)    `thenM_` 
 
        readIface wanted_mod file_path hi_boot_file     `thenM` \ read_result ->
@@ -591,7 +596,8 @@ findAndReadIface doc_str mod_name hi_boot_file
                           ppr mod_name <> semi],
                     nest 4 (ptext SLIT("reason:") <+> doc_str)]
 
-findHiFile :: ModuleName -> IsBootInterface -> IO (Maybe (Module, FilePath))
+findHiFile :: ModuleName -> IsBootInterface
+          -> IO (Either [FilePath] (Module, FilePath))
 findHiFile mod_name hi_boot_file
  = do { 
        -- In interactive or --make mode, we are *not allowed* to demand-load
@@ -607,9 +613,9 @@ findHiFile mod_name hi_boot_file
                        else findPackageModule mod_name ;
 
        case maybe_found of {
-         Nothing -> return Nothing ;
+         Left files -> return (Left files) ;
 
-         Just (mod,loc) -> do {
+         Right (mod,loc) -> do {
 
        -- Return the path to M.hi, M.hi-boot, or M.hi-boot-n as appropriate
        let { hi_path            = ml_hi_file loc ;
@@ -618,11 +624,11 @@ findHiFile mod_name hi_boot_file
            };
 
        if not hi_boot_file then
-          return (Just (mod, hi_path))
+          return (Right (mod, hi_path))
        else do {
                hi_ver_exists <- doesFileExist hi_boot_ver_path ;
-               if hi_ver_exists then return (Just (mod, hi_boot_ver_path))
-                                else return (Just (mod, hi_boot_path))
+               if hi_ver_exists then return (Right (mod, hi_boot_ver_path))
+                                else return (Right (mod, hi_boot_path))
        }}}}
 \end{code}
 
@@ -659,6 +665,7 @@ read_iface mod file_path is_hi_boot_file
  where
     exts = ExtFlags {glasgowExtsEF = True,
                     ffiEF         = True,
+                    arrowsEF      = True,
                     withEF        = True,
                     parrEF        = True}
     loc  = mkSrcLoc (mkFastString file_path) 1
@@ -699,12 +706,6 @@ ghcPrimIface = ParsedIface {
 %*********************************************************
 
 \begin{code}
-noIfaceErr mod_name boot_file
-  = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name)
-       -- We used to print the search path, but we can't do that
-       -- now, because it's hidden inside the finder.
-       -- Maybe the finder should expose more functions.
-
 badIfaceFile file err
   = vcat [ptext SLIT("Bad interface file:") <+> text file, 
          nest 4 err]