[project @ 1999-07-08 13:46:25 by sof]

A 'foreign export' (static) declaration doesn't bind a name but
simply adds an occurrence of a name.

diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index c5018a4..9683ef2 100644 (file)
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -22,6 +22,7 @@ module RnIfaces (
 import CmdLineOpts     ( opt_NoPruneDecls, opt_IgnoreIfacePragmas )
 import HsSyn           ( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..), 
                          HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
+                         ForeignDecl(..), ForKind(..), isDynamic,
                          FixitySig(..), RuleDecl(..),
                          isClassOpSig
                        )
@@ -30,7 +31,7 @@ import RdrHsSyn               ( RdrNameHsDecl, RdrNameInstDecl, RdrNameTyClDecl, RdrNameRuleD
                          extractHsTyRdrNames
                        )
 import RnEnv           ( mkImportedGlobalName, newImportedBinder, mkImportedGlobalFromRdrName,
-                         lookupOccRn,
+                         lookupOccRn, lookupImplicitOccRn,
                          pprAvail,
                          availName, availNames, addAvailToNameSet,
                          FreeVars, emptyFVs
@@ -787,11 +788,25 @@ getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
     returnRn (Just (Avail var_name))
 
 getDeclBinders new_name (FixD _)  = returnRn Nothing
-getDeclBinders new_name (ForD _)  = returnRn Nothing
+
+    -- foreign declarations
+getDeclBinders new_name (ForD (ForeignDecl nm kind _ dyn _ loc))
+  | binds_haskell_name kind dyn
+  = new_name nm loc                `thenRn` \ name ->
+    returnRn (Just (Avail name))
+
+  | otherwise -- a foreign export
+  = lookupImplicitOccRn nm `thenRn_` 
+    returnRn Nothing
+
 getDeclBinders new_name (DefD _)  = returnRn Nothing
 getDeclBinders new_name (InstD _) = returnRn Nothing
 getDeclBinders new_name (RuleD _) = returnRn Nothing
 
+binds_haskell_name (FoImport _) _   = True
+binds_haskell_name FoLabel      _   = True
+binds_haskell_name FoExport  ext_nm = isDynamic ext_nm
+
 ----------------
 getConFieldNames new_name (ConDecl con _ _ (RecCon fielddecls) src_loc : rest)
   = mapRn (\n -> new_name n src_loc) (con:fields)      `thenRn` \ cfs ->

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 9f46d36..f549234 100644 (file)
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -306,15 +306,6 @@ getLocalDeclBinders new_name (ValD binds)
     do_one (rdr_name, loc) = new_name rdr_name loc     `thenRn` \ name ->
                             returnRn (Avail name)
 
-    -- foreign declarations
-getLocalDeclBinders new_name (ForD (ForeignDecl nm kind _ dyn _ loc))
-  | binds_haskell_name kind dyn
-  = new_name nm loc                `thenRn` \ name ->
-    returnRn [Avail name]
-
-  | otherwise
-  = returnRn []
-
 getLocalDeclBinders new_name decl
   = getDeclBinders new_name decl       `thenRn` \ maybe_avail ->
     case maybe_avail of
@@ -326,10 +317,6 @@ getLocalDeclBinders new_name decl
        -- etc, into the cache
     new_sys_name rdr_name loc = newImplicitBinder (rdrNameOcc rdr_name) loc
 
-binds_haskell_name (FoImport _) _   = True
-binds_haskell_name FoLabel      _   = True
-binds_haskell_name FoExport  ext_nm = isDynamic ext_nm
-
 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG FixityEnv
 fixitiesFromLocalDecls gbl_env decls
   = foldlRn getFixities emptyNameEnv decls

diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index 9508d78..753ab7b 100644 (file)
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -362,7 +362,7 @@ rnDecl (DefD (DefaultDecl tys src_loc))
 \begin{code}
 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
   = pushSrcLocRn src_loc $
-    lookupBndrRn name                  `thenRn` \ name' ->
+    lookupOccRn name                   `thenRn` \ name' ->
     let 
        fvs1 = case imp_exp of
                FoImport _ | not isDyn  -> emptyFVs
@@ -370,6 +370,7 @@ rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
                FoExport   | isDyn      -> mkNameSet [makeStablePtr_NAME,
                                                      deRefStablePtr_NAME,
                                                      bindIO_NAME]
+                          | otherwise  -> mkNameSet [name']
                _ -> emptyFVs
     in
     rnHsSigType fo_decl_msg ty                 `thenRn` \ (ty', fvs2) ->