[project @ 1999-04-27 17:33:49 by sof]

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

diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index f507e6a..eebe37e 100644 (file)
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -25,7 +25,7 @@ import CmdLineOpts    ( opt_PruneTyDecls,  opt_PruneInstDecls,
 import HsSyn           ( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..), 
                          HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
                          FixitySig(..),
-                         hsDeclName, countTyClDecls, isDataDecl, nonFixitySigs
+                         hsDeclName, countTyClDecls, isDataDecl, isClassOpSig
                        )
 import BasicTypes      ( Version, NewOrData(..) )
 import RdrHsSyn                ( RdrNameHsDecl, RdrNameInstDecl, RdrNameTyClDecl,
@@ -172,14 +172,15 @@ loadInterface :: SDoc -> Module -> RnMG (Module, Ifaces)
 loadInterface doc_str load_mod
  = getIfacesRn                 `thenRn` \ ifaces ->
    let
-       new_hif              = moduleIfaceFlavour load_mod
+       hi_boot_wanted       = bootFlavour (moduleIfaceFlavour load_mod)
        mod_map              = iModMap ifaces
        (insts, tycls_names) = iDefInsts ifaces
+       
    in
        -- CHECK WHETHER WE HAVE IT ALREADY
    case lookupFM mod_map load_mod of {
        Just (existing_hif, _, _) 
-               | bootFlavour new_hif || not (bootFlavour existing_hif)
+               | hi_boot_wanted || not (bootFlavour existing_hif)
                ->      -- Already in the cache, and new version is no better than old,
                        -- so don't re-read it
                    returnRn (setModuleFlavour existing_hif load_mod, ifaces) ;
@@ -188,8 +189,20 @@ loadInterface doc_str load_mod
        -- READ THE MODULE IN
    findAndReadIface doc_str load_mod           `thenRn` \ read_result ->
    case read_result of {
-       -- Check for not found
-       Nothing ->      -- Not found, so add an empty export env to the Ifaces map
+       Nothing | not hi_boot_wanted && load_mod `elem` thinAirModules
+               -> -- Hack alert!  When compiling PrelBase we have to load the
+                  -- decls for packCString# and friends; they are 'thin-air' Ids
+                  -- (see PrelInfo.lhs).  So if we don't find the HiFile we quietly
+                  -- look for a .hi-boot file instead, and use that
+                  --
+                  -- NB this causes multiple "failed" attempts to read PrelPack,
+                  --    which makes curious reading with -dshow-rn-trace, but
+                  --    there's no harm done
+                  loadInterface doc_str (mkBootModule load_mod)
+
+              
+               | otherwise
+               ->      -- Not found, so add an empty export env to the Ifaces map
                        -- so that we don't look again
                   let
                        new_mod_map = addToFM mod_map load_mod (hiFile, 0, [])
@@ -678,13 +691,20 @@ getNonWiredDataDecl needed_name
                    version
                    avail@(AvailTC tycon_name _) 
                    ty_decl@(TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
-  |  needed_name == tycon_name
-  && opt_PruneTyDecls
+  |  null condecls ||
+       -- HACK ALERT!  If the data type is abstract then it must from a 
+       -- hand-written hi-boot file.  We put it in the deferred pile unconditionally,
+       -- because we don't want to read it in, and then later find a decl for a constructor
+       -- from that type, read the real interface file, and read in the full data type
+       -- decl again!!!  
+
+     (needed_name == tycon_name
+     && opt_PruneTyDecls
         -- don't prune newtypes, as the code generator may
        -- want to peer inside a newtype type constructor
        -- (ClosureInfo.fun_result_ty is the culprit.)
-  && not (new_or_data == NewType)
-  && not (nameUnique needed_name `elem` cCallishTyKeys)                
+     && not (new_or_data == NewType)
+     && not (nameUnique needed_name `elem` cCallishTyKeys))
        -- Hack!  Don't prune these tycons whose constructors
        -- the desugarer must be able to see when desugaring
        -- a CCall.  Ugh!
@@ -745,7 +765,7 @@ getImportedInstDecls :: RnMG [(Module,RdrNameInstDecl)]
 getImportedInstDecls
   =    -- First load any special-instance modules that aren't aready loaded
     getSpecialInstModules                      `thenRn` \ inst_mods ->
-    mapRn load_it inst_mods                    `thenRn_`
+    mapRn_ load_it inst_mods                   `thenRn_`
 
        -- Now we're ready to grab the instance declarations
        -- Find the un-gated ones and return them, 
@@ -800,7 +820,7 @@ getImportedFixities gbl_env
                                           not (isLocallyDefined name)
                       ]
     in
-    mapRn load (nub home_modules)      `thenRn_`
+    mapRn_ load (nub home_modules)     `thenRn_`
 
        -- Now we can snaffle the fixity env
     getIfacesRn                                                `thenRn` \ ifaces ->
@@ -976,10 +996,10 @@ getDeclBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ tname dname src_loc
 
        -- Record the names for the class ops
     let
-       -- ignoring fixity declarations
-       nonfix_sigs = nonFixitySigs sigs
+       -- just want class-op sigs
+       op_sigs = filter isClassOpSig sigs
     in
-    mapRn (getClassOpNames new_name) nonfix_sigs       `thenRn` \ sub_names ->
+    mapRn (getClassOpNames new_name) op_sigs   `thenRn` \ sub_names ->
 
     returnRn (Just (AvailTC class_name (class_name : sub_names)))
 
@@ -1050,15 +1070,8 @@ findAndReadIface doc_str mod_name
     case (lookupFM himap (moduleUserString mod_name)) of
          -- Found the file
        Just fpath -> readIface mod_name fpath
-        -- Hack alert!  When compiling PrelBase we have to load the
-        -- decls for packCString# and friends; they are 'thin-air' Ids
-        -- (see PrelInfo.lhs).  So if we don't find the HiFile we quietly
-        -- look for a .hi-boot file instead, and use that
-       Nothing |  not from_hi_boot && mod_name `elem` thinAirModules
-              -> findAndReadIface doc_str (mkBootModule mod_name)
-               | otherwise              
-              -> traceRn (ptext SLIT("...failed"))     `thenRn_`
-                 returnRn Nothing
+       Nothing    -> traceRn (ptext SLIT("...failed")) `thenRn_`
+                    returnRn Nothing
   where
     hif                 = moduleIfaceFlavour mod_name
     from_hi_boot = bootFlavour hif