[project @ 2000-10-11 16:45:53 by sewardj]

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

diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index a9e9d3e..08e7fb9 100644 (file)
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -41,19 +41,18 @@ import ParseIface   ( parseIface, IfaceStuff(..) )
 
 import Name            ( Name {-instance NamedThing-}, nameOccName,
                          nameModule, isLocallyDefined, 
-                         isWiredInName, nameUnique, NamedThing(..),
+                         isWiredInName, NamedThing(..),
                          elemNameEnv, extendNameEnv
                         )
-import Module          ( Module, moduleString, pprModule,
-                         mkVanillaModule, pprModuleName,
-                         moduleUserString, moduleName, isLocalModule,
+import Module          ( Module, mkVanillaModule, pprModuleName,
+                         moduleName, isLocalModule,
                          ModuleName, WhereFrom(..),
                        )
 import RdrName         ( RdrName, rdrNameOcc )
 import NameSet
 import SrcLoc          ( mkSrcLoc, SrcLoc )
 import PrelInfo                ( cCallishTyKeys )
-import Maybes          ( MaybeErr(..), maybeToBool, orElse )
+import Maybes          ( maybeToBool )
 import Unique          ( Uniquable(..) )
 import StringBuffer     ( hGetStringBuffer )
 import FastString      ( mkFastString )
@@ -602,7 +601,7 @@ getNonWiredInDecl needed_name
     loadHomeInterface doc_str needed_name      `thenRn` \ ifaces ->
     case lookupNameEnv (iDecls ifaces) needed_name of
 
-      Just (version, avail, is_tycon_name, decl@(_, TyClD (TyData DataType _ _ _ _ ncons _ _ _)))
+      Just (version, avail, is_tycon_name, decl@(_, TyClD (TyData DataType _ _ _ _ ncons _ _ _ _ _)))
        -- This case deals with deferred import of algebraic data types
 
        |  not opt_NoPruneTyDecls
@@ -953,6 +952,7 @@ mkImportExportInfo this_mod export_avails exports
 
        export_info = [(m, sortExport as) | (m,as) <- fmToList export_fm]
     in
+    traceRn (text "Modules in Ifaces: " <+> fsep (map ppr (keysFM mod_map)))   `thenRn_`
     returnRn (export_info, import_info)
 
 
@@ -1013,7 +1013,7 @@ getDeclBinders :: (RdrName -> SrcLoc -> RnM d Name)       -- New-name function
                -> RdrNameHsDecl
                -> RnM d (Maybe AvailInfo)
 
-getDeclBinders new_name (TyClD (TyData _ _ tycon _ condecls _ _ _ src_loc))
+getDeclBinders new_name (TyClD (TyData _ _ tycon _ condecls _ _ _ src_loc _ _))
   = new_name tycon src_loc                     `thenRn` \ tycon_name ->
     getConFieldNames new_name condecls         `thenRn` \ sub_names ->
     returnRn (Just (AvailTC tycon_name (tycon_name : nub sub_names)))
@@ -1024,7 +1024,7 @@ getDeclBinders new_name (TyClD (TySynonym tycon _ _ src_loc))
   = new_name tycon src_loc             `thenRn` \ tycon_name ->
     returnRn (Just (AvailTC tycon_name [tycon_name]))
 
-getDeclBinders new_name (TyClD (ClassDecl _ cname _ _ sigs _ _ _ _ _ _ src_loc))
+getDeclBinders new_name (TyClD (ClassDecl _ cname _ _ sigs _ _ _ src_loc))
   = new_name cname src_loc                     `thenRn` \ class_name ->
 
        -- Record the names for the class ops
@@ -1071,13 +1071,8 @@ getConFieldNames new_name (ConDecl con _ _ _ (RecCon fielddecls) src_loc : rest)
 
 getConFieldNames new_name (ConDecl con _ _ _ condecl src_loc : rest)
   = new_name con src_loc               `thenRn` \ n ->
-    (case condecl of
-      NewCon _ (Just f) -> 
-        new_name f src_loc `thenRn` \ new_f ->
-       returnRn [n,new_f]
-      _ -> returnRn [n])               `thenRn` \ nn ->
     getConFieldNames new_name rest     `thenRn` \ ns -> 
-    returnRn (nn ++ ns)
+    returnRn (n : ns)
 
 getConFieldNames new_name [] = returnRn []
 
@@ -1094,10 +1089,11 @@ and the dict fun of an instance decl, because both of these have
 bindings of their own elsewhere.
 
 \begin{code}
-getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ _ sigs _ _ tname dname dwname snames src_loc))
-  = sequenceRn [new_name n src_loc | n <- (tname : dname : dwname : snames)]
+getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ _ sigs _ _ names 
+                                  src_loc))
+  = sequenceRn [new_name n src_loc | n <- names]
 
-getDeclSysBinders new_name (TyClD (TyData _ _ _ _ cons _ _ _ _))
+getDeclSysBinders new_name (TyClD (TyData _ _ _ _ cons _ _ _ _ _ _))
   = sequenceRn [new_name wkr_name src_loc | ConDecl _ wkr_name _ _ _ src_loc <- cons]
 
 getDeclSysBinders new_name other_decl
@@ -1124,10 +1120,12 @@ findAndReadIface doc_str mod_name hi_boot_file
       -- one for 'normal' ones, the other for .hi-boot files,
       -- hence the need to signal which kind we're interested.
 
-    getHiMaps                  `thenRn` \ (search_path, hi_map, hiboot_map) ->
+    --getHiMaps                        `thenRn` \ (search_path, hi_map, hiboot_map) ->
     let
-       relevant_map | hi_boot_file = hiboot_map
-                    | otherwise    = hi_map
+        bomb = panic "findAndReadInterface: hi_maps: FIXME"
+        search_path = panic "findAndReadInterface: search_path: FIXME"
+       relevant_map | hi_boot_file = bomb --hiboot_map
+                    | otherwise    = bomb --hi_map
     in 
     case lookupFM relevant_map mod_name of
        -- Found the file
@@ -1208,10 +1206,6 @@ getDeclErr name
          ptext SLIT("from module") <+> quotes (ppr (nameModule name))
         ]
 
-getDeclWarn name loc
-  = sep [ptext SLIT("Failed to find (optional) interface decl for") <+> quotes (ppr name),
-        ptext SLIT("desired at") <+> ppr loc]
-
 importDeclWarn name
   = sep [ptext SLIT(
     "Compiler tried to import decl from interface file with same name as module."),