From ce1b0fe26ed7bb211e10129043655f38d4433bcd Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Tue, 30 May 2000 14:27:38 +0000
Subject: [PATCH] [project @ 2000-05-30 14:27:38 by simonmar] only add implicit
occs for bindIO & returnIO for foreign export, not for foreign import.
---
ghc/compiler/rename/RnSource.lhs | 18 +++++++++++-------
1 file changed, 11 insertions(+), 7 deletions(-)
diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index 367b7a553beb..026fbf6a81f5 100644
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -28,7 +28,8 @@ import RnEnv ( bindTyVarsRn, lookupBndrRn, lookupOccRn, getIPName,
checkDupOrQualNames, checkDupNames,
mkImportedGlobalName, mkImportedGlobalFromRdrName,
newDFunName, getDFunKey, newImplicitBinder,
- FreeVars, emptyFVs, plusFV, plusFVs, unitFV, addOneFV, mapFvRn
+ FreeVars, emptyFVs, plusFV, plusFVs, unitFV,
+ addOneFV, mapFvRn
)
import RnMonad
@@ -353,18 +354,21 @@ rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
lookupOccRn name `thenRn` \ name' ->
let
extra_fvs FoExport
- | isDyn = lookupImplicitOccsRn [makeStablePtr_RDR, deRefStablePtr_RDR]
- | otherwise = returnRn (unitFV name')
+ | isDyn =
+ lookupImplicitOccsRn [makeStablePtr_RDR, deRefStablePtr_RDR,
+ bindIO_RDR, returnIO_RDR]
+ | otherwise =
+ lookupImplicitOccsRn [bindIO_RDR, returnIO_RDR] `thenRn` \ fvs ->
+ returnRn (addOneFV fvs name')
extra_fvs other = returnRn emptyFVs
in
checkRn (ok_ext_nm ext_nm) (badExtName ext_nm) `thenRn_`
- lookupImplicitOccsRn [bindIO_RDR, returnIO_RDR] `thenRn` \ fvs1 ->
- extra_fvs imp_exp `thenRn` \ fvs2 ->
+ extra_fvs imp_exp `thenRn` \ fvs1 ->
- rnHsSigType fo_decl_msg ty `thenRn` \ (ty', fvs3) ->
+ rnHsSigType fo_decl_msg ty `thenRn` \ (ty', fvs2) ->
returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc),
- fvs1 `plusFV` fvs2 `plusFV` fvs3)
+ fvs1 `plusFV` fvs2)
where
fo_decl_msg = ptext SLIT("a foreign declaration")
isDyn = isDynamicExtName ext_nm
--
GitLab