From ffe3daa2cebacc56878467a8ee09602712ff5dee Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Fri, 14 Aug 1998 11:47:36 +0000
Subject: [PATCH] [project @ 1998-08-14 11:47:29 by sof] Renaming foreign
 decls

---
 ghc/compiler/rename/RnBinds.lhs  |    2 +-
 ghc/compiler/rename/RnEnv.lhs    |    2 +-
 ghc/compiler/rename/RnHsSyn.lhs  |    1 +
 ghc/compiler/rename/RnIfaces.lhs |    1 +
 ghc/compiler/rename/RnNames.lhs  |   13 ++++++++++++-
 ghc/compiler/rename/RnSource.lhs |   27 +++++++++++++++++++++++++--
 6 files changed, 41 insertions(+), 5 deletions(-)

diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs
index eef7a3f..de84f39 100644
--- a/ghc/compiler/rename/RnBinds.lhs
+++ b/ghc/compiler/rename/RnBinds.lhs
@@ -26,7 +26,7 @@ import RnHsSyn
 import RnMonad
 import RnExpr		( rnMatch, rnGRHSsAndBinds, rnPat, checkPrecMatch )
 import RnEnv		( bindLocatedLocalsRn, lookupBndrRn, lookupOccRn, lookupGlobalOccRn,
-			  newLocalNames, isUnboundName, warnUnusedBinds
+			  isUnboundName, warnUnusedBinds
 			)
 import CmdLineOpts	( opt_SigsRequired )
 import Digraph		( stronglyConnComp, SCC(..) )
diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index b70f541..2fc9ea8 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -709,7 +709,7 @@ fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
 		 ppr how_in_scope2])
 
 shadowedNameWarn shadow
-  = hcat [ptext SLIT("This binding for"), 
+  = hsep [ptext SLIT("This binding for"), 
 	       quotes (ppr shadow),
 	       ptext SLIT("shadows an existing binding")]
 
diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 1d52c5f..2496ee8 100644
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -31,6 +31,7 @@ type RenamedContext		= Context 		Name
 type RenamedHsDecl		= HsDecl		Unused Name RenamedPat
 type RenamedSpecDataSig		= SpecDataSig		Name
 type RenamedDefaultDecl		= DefaultDecl		Name
+type RenamedForeignDecl		= ForeignDecl		Name
 type RenamedFixityDecl		= FixityDecl		Name
 type RenamedGRHS		= GRHS			Unused Name RenamedPat
 type RenamedGRHSsAndBinds	= GRHSsAndBinds		Unused Name RenamedPat
diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index 1b7b471..b13b29f 100644
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -917,6 +917,7 @@ getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
   = new_name var src_loc			`thenRn` \ var_name ->
     returnRn (Avail var_name)
 
+getDeclBinders new_name (ForD _)  = returnRn NotAvailable
 getDeclBinders new_name (DefD _)  = returnRn NotAvailable
 getDeclBinders new_name (InstD _) = returnRn NotAvailable
 
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 549137a..3c1b0e8 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -15,7 +15,8 @@ import CmdLineOpts    ( opt_NoImplicitPrelude, opt_WarnDuplicateExports,
 		      )
 
 import HsSyn	( HsModule(..), ImportDecl(..), HsDecl(..), 
-		  IE(..), ieName,
+		  IE(..), ieName, 
+		  ForeignDecl(..), ExtName(..),
 		  FixityDecl(..),
 		  collectTopBinders
 		)
@@ -224,6 +225,16 @@ importsFromLocalDecls rec_exp_fn (HsModule mod _ _ _ fix_decls decls _)
       = mapRn do_one (bagToList (collectTopBinders binds))	`thenRn` \ val_avails ->
 	returnRn (val_avails ++ avails)
 
+    -- foreign import declaration
+    getLocalDeclBinders avails (ForD (ForeignDecl nm (Just _) _ _ _ loc))
+      = do_one (nm,loc)			    `thenRn` \ for_avail ->
+	returnRn (for_avail : avails)
+
+    -- foreign export dynamic declaration
+    getLocalDeclBinders avails (ForD (ForeignDecl nm Nothing _ Dynamic _ loc))
+      = do_one (nm,loc)			    `thenRn` \ for_avail ->
+	returnRn (for_avail : avails)
+
     getLocalDeclBinders avails decl
       = getDeclBinders newLocalName decl	`thenRn` \ avail ->
 	case avail of
diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index 4d774dd..89e484d 100644
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -20,9 +20,10 @@ import CmdLineOpts	( opt_IgnoreIfacePragmas )
 
 import RnBinds		( rnTopBinds, rnMethodBinds, renameSigs )
 import RnEnv		( bindTyVarsRn, lookupBndrRn, lookupOccRn, lookupImplicitOccRn, bindLocalsRn,
-			  newDfunName, checkDupOrQualNames, checkDupNames,
+			  newDfunName, checkDupOrQualNames, checkDupNames, lookupGlobalOccRn,
 			  newLocallyDefinedGlobalName, newImportedGlobalName, ifaceFlavour,
-			  listType_RDR, tupleType_RDR )
+			  listType_RDR, tupleType_RDR, addImplicitOccRn
+			)
 import RnMonad
 
 import Name		( Name, OccName(..), occNameString, prefixOccName,
@@ -300,6 +301,28 @@ rnDecl (DefD (DefaultDecl tys src_loc))
 
 %*********************************************************
 %*							*
+\subsection{Foreign declarations}
+%*							*
+%*********************************************************
+
+\begin{code}
+rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
+  = pushSrcLocRn src_loc $
+    lookupBndrRn name		        `thenRn` \ name' ->
+    (if is_export then
+        addImplicitOccRn name'
+     else
+	returnRn name')			`thenRn_`
+    rnHsSigType fo_decl_msg ty		`thenRn` \ ty' ->
+    returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc))
+ where
+  fo_decl_msg = ptext SLIT("a foreign declaration")
+  is_export   = not (maybeToBool imp_exp) && not (isDynamic ext_nm)
+
+\end{code}
+
+%*********************************************************
+%*							*
 \subsection{Support code for type/data declarations}
 %*							*
 %*********************************************************
-- 
1.7.10.4