diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs index eef7a3fbe3d2c2a4973ed04bf1300562f47433a1..de84f395592c897779701c959b35ea9d1d997bcb 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 b70f54122b81ec0beb80d2e563a50cd7e563c0e4..2fc9ea8e0d430c070799f0b15cbbfd41299a9803 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 1d52c5f71bd7a2fe2b0675a029f71f1865d634aa..2496ee8cd5c83ded5a89c7f3619e499f1d9a9944 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 1b7b47178b05c188eb2cfd427ef99e2031db122d..b13b29f5ce6d983ec48e8cd433207f36b9c022b8 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 549137ac77198b2c34c4c729b91f9d60c71673c6..3c1b0e89722d8e07d0c2adcd7d19f27182d67b83 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 4d774dd9f440da854489946712812ce6dae99ab5..89e484d98e072a559439aa8f7345ba5045444d44 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, @@ -298,6 +299,28 @@ rnDecl (DefD (DefaultDecl tys src_loc)) returnRn (DefD (DefaultDecl tys' src_loc)) \end{code} +%********************************************************* +%* * +\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}