[project @ 2001-12-06 10:45:42 by simonpj]

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

diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index f98124d..e18fd9c 100644 (file)
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -11,7 +11,7 @@ module RnSource ( rnTyClDecl, rnIfaceRuleDecl, rnInstDecl, rnSourceDecls,
 
 import RnExpr
 import HsSyn
-import HscTypes                ( GlobalRdrEnv )
+import HscTypes                ( GlobalRdrEnv, AvailEnv )
 import RdrName         ( RdrName, isRdrDataCon, elemRdrEnv )
 import RdrHsSyn                ( RdrNameConDecl, RdrNameTyClDecl,
                          extractGenericPatTyVars
@@ -37,8 +37,8 @@ import DataCon                ( dataConId )
 import Name            ( Name, NamedThing(..) )
 import NameSet
 import PrelInfo                ( derivableClassKeys )
-import PrelNames       ( deRefStablePtr_RDR, newStablePtr_RDR,
-                         bindIO_RDR, returnIO_RDR
+import PrelNames       ( deRefStablePtrName, newStablePtrName,
+                         bindIOName, returnIOName
                        )
 import TysWiredIn      ( tupleCon )
 import List            ( partition )
@@ -73,13 +73,13 @@ Checks the @(..)@ etc constraints in the export list.
 %*********************************************************
 
 \begin{code}
-rnSourceDecls :: GlobalRdrEnv -> LocalFixityEnv
+rnSourceDecls :: GlobalRdrEnv -> AvailEnv -> LocalFixityEnv
              -> [RdrNameHsDecl] 
              -> RnMG ([RenamedHsDecl], FreeVars)
        -- The decls get reversed, but that's ok
 
-rnSourceDecls gbl_env local_fixity_env decls
-  = initRnMS gbl_env emptyRdrEnv local_fixity_env SourceMode (go emptyFVs [] decls)
+rnSourceDecls gbl_env avails local_fixity_env decls
+  = initRnMS gbl_env avails emptyRdrEnv local_fixity_env SourceMode (go emptyFVs [] decls)
   where
        -- Fixity and deprecations have been dealt with already; ignore them
     go fvs ds' []             = returnRn (ds', fvs)
@@ -130,20 +130,19 @@ rnSourceDecl (DefD (DefaultDecl tys src_loc))
 \begin{code}
 rnHsForeignDecl (ForeignImport name ty spec src_loc)
   = pushSrcLocRn src_loc               $
-    lookupOccRn name                   `thenRn` \ name' ->
-    rnHsTypeFVs (fo_decl_msg name) ty  `thenRn` \ (ty', fvs1) ->
-    lookupOrigNames (extras spec)      `thenRn` \ fvs2 ->
-    returnRn (ForeignImport name' ty' spec src_loc, fvs1 `plusFV` fvs2)
+    lookupTopBndrRn name               `thenRn` \ name' ->
+    rnHsTypeFVs (fo_decl_msg name) ty  `thenRn` \ (ty', fvs) ->
+    returnRn (ForeignImport name' ty' spec src_loc, fvs `plusFV` extras spec)
   where
-    extras (CDynImport _) = [newStablePtr_RDR, deRefStablePtr_RDR, bindIO_RDR, returnIO_RDR]
-    extras other         = []
+    extras (CDynImport _) = mkFVs [newStablePtrName, deRefStablePtrName, bindIOName, returnIOName]
+    extras other         = emptyFVs
 
 rnHsForeignDecl (ForeignExport name ty spec src_loc)
   = pushSrcLocRn src_loc                       $
     lookupOccRn name                           `thenRn` \ name' ->
-    rnHsTypeFVs (fo_decl_msg name) ty                  `thenRn` \ (ty', fvs1) ->
-    lookupOrigNames [bindIO_RDR, returnIO_RDR] `thenRn` \ fvs2 ->
-    returnRn (ForeignExport name' ty' spec src_loc, fvs1 `plusFV` fvs2)
+    rnHsTypeFVs (fo_decl_msg name) ty                  `thenRn` \ (ty', fvs) ->
+    returnRn (ForeignExport name' ty' spec src_loc, 
+             mkFVs [bindIOName, returnIOName] `plusFV` fvs)
 
 fo_decl_msg name = ptext SLIT("The foreign declaration for") <+> ppr name
 \end{code}
@@ -178,9 +177,7 @@ finishSourceInstDecl (InstDecl _       mbinds uprags _               _      )
     let
        meth_doc    = text "In the bindings in an instance declaration"
        meth_names  = collectLocatedMonoBinders mbinds
-       inst_tyvars = case inst_ty of
-                       HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
-                       other                             -> []
+       (inst_tyvars, (cls,_)) = getHsInstHead inst_ty
        -- (Slightly strangely) the forall-d tyvars scope over
        -- the method bindings too
     in
@@ -189,7 +186,7 @@ finishSourceInstDecl (InstDecl _       mbinds uprags _               _      )
        -- NB meth_names can be qualified!
     checkDupNames meth_doc meth_names          `thenRn_`
     extendTyVarEnvFVRn (map hsTyVarName inst_tyvars) (         
-       rnMethodBinds [] mbinds
+       rnMethodBinds cls [] mbinds
     )                                          `thenRn` \ (mbinds', meth_fvs) ->
     let 
        binders    = collectMonoBinders mbinds'
@@ -412,7 +409,7 @@ finishSourceTyClDecl (TyData {tcdDerivs = Just derivs, tcdLoc = src_loc})   -- Der
     returnRn (rn_ty_decl {tcdDerivs = Just derivs'}, mkNameSet derivs')
 
 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc})    -- Get mbinds from here
-        rn_cls_decl@(ClassDecl {tcdTyVars = tyvars})                           -- Everything else is here
+        rn_cls_decl@(ClassDecl {tcdName = cls, tcdTyVars = tyvars})            -- Everything else is here
   -- There are some default-method bindings (abeit possibly empty) so 
   -- this is a source-code class declaration
   =    -- The newLocals call is tiresome: given a generic class decl
@@ -434,7 +431,7 @@ finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc}) -- G
     in
     checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
     newLocalsRn gen_rdr_tyvars_w_locs                  `thenRn` \ gen_tyvars ->
-    rnMethodBinds gen_tyvars mbinds                    `thenRn` \ (mbinds', meth_fvs) ->
+    rnMethodBinds cls gen_tyvars mbinds                        `thenRn` \ (mbinds', meth_fvs) ->
     returnRn (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
   where
     meth_doc = text "In the default-methods for class" <+> ppr (tcdName rn_cls_decl)