[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.

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 ->

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

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) ->