Commit ffe3daa2 authored by sof's avatar sof
Browse files

[project @ 1998-08-14 11:47:29 by sof]

Renaming foreign decls
parent 83f1f583
......@@ -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(..) )
......
......@@ -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")]
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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}
......
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