Commit 2ef5da49 authored by sof's avatar sof
Browse files

[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.
parent 19739664
......@@ -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 ->
......
......@@ -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
......
......@@ -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) ->
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment