[project @ 1999-06-01 16:40:41 by simonmar]

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

diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index ff21596..deff6b7 100644 (file)
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -64,6 +64,7 @@ import Outputable
 import Unique          ( Unique )
 import StringBuffer     ( StringBuffer, hGetStringBuffer )
 import FastString      ( mkFastString )
+import Lex
 import Outputable
 
 import IO      ( isDoesNotExistError )
@@ -241,7 +242,7 @@ loadDecl mod decls_map (version, decl)
     let
        main_name     = availName avail
        new_decls_map = foldl add_decl decls_map
-                                      [ (name, (version, avail, name==main_name, (mod, decl))) 
+                                      [ (name, (version, avail, name==main_name, (mod, decl'))) 
                                       | name <- sys_bndrs ++ availNames avail]
        add_decl decls_map (name, stuff)
          = WARN( name `elemNameEnv` decls_map, ppr name )
@@ -291,15 +292,25 @@ loadInstDecl mod insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
        --
        -- Here the gates are Baz and T, but *not* Foo.
     let 
-       munged_inst_ty = case inst_ty of
-                               HsForAllTy tvs cxt ty -> HsForAllTy tvs [] ty
-                               other                 -> inst_ty
-       free_names = extractHsTyRdrNames munged_inst_ty
+       munged_inst_ty = removeContext inst_ty
+       free_names     = extractHsTyRdrNames munged_inst_ty
     in
     setModuleRn (moduleName mod) $
     mapRn mkImportedGlobalFromRdrName free_names       `thenRn` \ gate_names ->
     returnRn ((mkNameSet gate_names, (mod, InstD decl)) `consBag` insts)
 
+
+-- In interface files, the instance decls now look like
+--     forall a. Foo a -> Baz (T a)
+-- so we have to strip off function argument types as well
+-- as the bit before the '=>' (which is always empty in interface files)
+removeContext (HsForAllTy tvs cxt ty) = HsForAllTy tvs [] (removeFuns ty)
+removeContext ty                     = removeFuns ty
+
+removeFuns (MonoFunTy _ ty) = removeFuns ty
+removeFuns ty              = ty
+
+
 loadRule :: Module -> Bag GatedDecl 
         -> RdrNameRuleDecl -> RnM d (Bag GatedDecl)
 -- "Gate" the rule simply by whether the rule variable is
@@ -858,12 +869,16 @@ readIface :: Module -> String -> RnM d (Maybe (Module, ParsedIface))
        -- Nothing <=> file not found, or unreadable, or illegible
        -- Just x  <=> successfully found and parsed 
 readIface the_mod file_path
-  = ioToRnM (hGetStringBuffer file_path)       `thenRn` \ read_result ->
+  = ioToRnM (hGetStringBuffer False file_path)       `thenRn` \ read_result ->
     case read_result of
        Right contents    -> 
-             case parseIface contents (mkSrcLoc (mkFastString file_path) 1) of
-                 Failed err                    -> failWithRn Nothing err 
-                 Succeeded (PIface mod_nm iface) ->
+             case parseIface contents
+                       PState{ bol = 0#, atbol = 1#,
+                               context = [],
+                               glasgow_exts = 1#,
+                               loc = mkSrcLoc (mkFastString file_path) 1 } of
+                 PFailed err                    -> failWithRn Nothing err 
+                 POk _  (PIface mod_nm iface) ->
                            warnCheckRn (mod_nm == moduleName the_mod)
                                        (hsep [ ptext SLIT("Something is amiss; requested module name")
                                                , pprModule the_mod