diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs index c5018a4c81771e261e1d958417fb817ba6809e95..9683ef2c886364e931d679b018047f0ffb5fc430 100644 --- 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 9f46d363c1a6dc6bcfaa26a9e0e67371eb11363c..f549234e04919bf3d3e736ba1d8ef1913b948bfa 100644 --- 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 9508d78ffd258b81ac81eeac54c613af89271265..753ab7b5be17a319539e651e89dc442ab19cdd74 100644 --- 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) ->