[project @ 2000-11-20 16:07:12 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 dc0e71d..4c3b864 100644 (file)
--- a/ghc/compiler/rename/RnHiFiles.lhs
+++ b/ghc/compiler/rename/RnHiFiles.lhs
@@ -27,9 +27,8 @@ import HscTypes               ( ModuleLocation(..),
                          AvailInfo, GenAvailInfo(..), Avails, Deprecations(..)
                         )
 import HsSyn           ( TyClDecl(..), InstDecl(..),
-                         HsType(..), ConDecl(..), 
-                         FixitySig(..), RuleDecl(..),
-                         tyClDeclNames
+                         HsType(..), FixitySig(..), RuleDecl(..),
+                         tyClDeclNames, tyClDeclSysNames
                        )
 import RdrHsSyn                ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl,
                          extractHsTyRdrNames 
@@ -60,6 +59,9 @@ import Lex
 import FiniteMap
 import Outputable
 import Bag
+import Config
+
+import Directory
 \end{code}
 
 
@@ -420,45 +422,31 @@ getIfaceDeclBinders, getTyClDeclBinders
        -> RdrNameTyClDecl
        -> RnM d AvailInfo
 
-getIfaceDeclBinders mod tycl_decl
-  = getTyClDeclBinders    mod tycl_decl        `thenRn` \ avail ->
-    getSysTyClDeclBinders mod tycl_decl        `thenRn` \ extras ->
-    returnRn (addSysAvails avail extras)
-               -- Add the sys-binders to avail.  When we import the decl,
-               -- it's full_avail that will get added to the 'already-slurped' set (iSlurp)
-               -- If we miss out sys-binders, we'll read the decl multiple times!
-
+-----------------
 getTyClDeclBinders mod (IfaceSig var ty prags src_loc)
   = newTopBinder mod var src_loc                       `thenRn` \ var_name ->
     returnRn (Avail var_name)
 
 getTyClDeclBinders mod tycl_decl
-  = mapRn do_one (tyClDeclNames tycl_decl)     `thenRn` \ (main_name:sub_names) ->
+  = new_top_bndrs mod (tyClDeclNames tycl_decl)                `thenRn` \ (main_name:sub_names) ->
     returnRn (AvailTC main_name (main_name : sub_names))
-  where
-    do_one (name,loc) = newTopBinder mod name loc
-\end{code}
-
-@getDeclSysBinders@ gets the implicit binders introduced by a decl.
-A the moment that's just the tycon and datacon that come with a class decl.
-They aren't returned by @getDeclBinders@ because they aren't in scope;
-but they {\em should} be put into the @DeclsMap@ of this module.
 
-Note that this excludes the default-method names of a class decl,
-and the dict fun of an instance decl, because both of these have 
-bindings of their own elsewhere.
-
-\begin{code}
-getSysTyClDeclBinders mod (ClassDecl _ cname _ _ sigs _ names src_loc)
-  = sequenceRn [newTopBinder mod n src_loc | n <- names]
+-----------------
+getIfaceDeclBinders mod (IfaceSig var ty prags src_loc)
+  = newTopBinder mod var src_loc                       `thenRn` \ var_name ->
+    returnRn (Avail var_name)
 
-getSysTyClDeclBinders mod (TyData _ _ _ _ cons _ _ _ _ _)
-  = sequenceRn [newTopBinder mod wkr_name src_loc | ConDecl _ wkr_name _ _ _ src_loc <- cons]
+getIfaceDeclBinders mod tycl_decl
+  = new_top_bndrs mod (tyClDeclNames tycl_decl)                `thenRn` \ (main_name:sub_names) ->
+    new_top_bndrs mod (tyClDeclSysNames tycl_decl)     `thenRn` \ sys_names ->
+    returnRn (AvailTC main_name (main_name : (sys_names ++ sub_names)))
 
-getSysTyClDeclBinders mod other_decl
-  = returnRn []
+-----------------
+new_top_bndrs mod names_w_locs
+  = sequenceRn [newTopBinder mod name loc | (name,loc) <- names_w_locs]
 \end{code}
 
+
 %*********************************************************
 %*                                                     *
 \subsection{Reading an interface file}
@@ -480,15 +468,16 @@ findAndReadIface doc_str mod_name hi_boot_file
     case maybe_found of
 
       Right (Just (wanted_mod,locn))
-        -> readIface (mkHiPath hi_boot_file (ml_hi_file locn)) `thenRn` \ read_result ->
+        -> mkHiPath hi_boot_file locn `thenRn` \ file -> 
+          readIface file `thenRn` \ read_result ->
           case read_result of
-              Left bad -> returnRn (Left bad)
-              Right iface 
-                 -> let read_mod = pi_mod iface
-                   in warnCheckRn (wanted_mod == read_mod)
-                                  (hiModuleNameMismatchWarn wanted_mod read_mod) 
-                                       `thenRn_`
-                      returnRn (Right (wanted_mod, iface))
+                Left bad -> returnRn (Left bad)
+                Right iface 
+                   -> let read_mod = pi_mod iface
+                     in warnCheckRn (wanted_mod == read_mod)
+                                    (hiModuleNameMismatchWarn wanted_mod 
+                                       read_mod) `thenRn_`
+                        returnRn (Right (wanted_mod, iface))
        -- Can't find it
       other   -> traceRn (ptext SLIT("...not found"))  `thenRn_`
                 returnRn (Left (noIfaceErr mod_name hi_boot_file))
@@ -500,9 +489,15 @@ findAndReadIface doc_str mod_name hi_boot_file
                           ppr mod_name <> semi],
                     nest 4 (ptext SLIT("reason:") <+> doc_str)]
 
-mkHiPath hi_boot_file (Just path)
-  | hi_boot_file = path ++ "-boot"
-  | otherwise    = path
+mkHiPath hi_boot_file locn
+  | hi_boot_file = 
+       ioToRnM_no_fail (doesFileExist hi_boot_ver_path) `thenRn` \ b ->
+       if b then returnRn hi_boot_ver_path
+            else returnRn hi_boot_path
+  | otherwise    = returnRn hi_path
+       where (Just hi_path)   = ml_hi_file locn
+             hi_boot_path     = hi_path ++ "-boot"
+             hi_boot_ver_path = hi_path ++ "-boot-" ++ cHscIfaceFileVersion
 \end{code}
 
 @readIface@ tries just the one file.