From 6a562dd51c1d264ce74a9f6fdf020e21ce34d143 Mon Sep 17 00:00:00 2001 From: simonpj Date: Fri, 14 Jul 2000 13:38:39 +0000 Subject: [PATCH] [project @ 2000-07-14 13:38:39 by simonpj] Arrange that type signatures work right. Consider: module A import M( f ) f :: Int -> Int f x = x Here, the 'f' in the signature isn't ambiguous; it refers to the locally defined f. (This isn't clear in the Haskell 98 report, but it will be.) --- ghc/compiler/rename/RnBinds.lhs | 4 +-- ghc/compiler/rename/RnEnv.lhs | 57 ++++++++++++-------------------------- ghc/compiler/rename/RnSource.lhs | 11 ++++++-- 3 files changed, 27 insertions(+), 45 deletions(-) diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs index 33d99ff..ef5596b 100644 --- a/ghc/compiler/rename/RnBinds.lhs +++ b/ghc/compiler/rename/RnBinds.lhs @@ -224,8 +224,8 @@ rnMonoBinds mbinds sigs thing_inside -- Non-empty monobinds = -- Extract all the binders in this group, -- and extend current scope, inventing new names for the new binders -- This also checks that the names form a set - bindLocatedLocalsRn (text "a binding group") mbinders_w_srclocs - $ \ new_mbinders -> + bindLocatedLocalsRn (text "a binding group") + mbinders_w_srclocs $ \ new_mbinders -> let binder_set = mkNameSet new_mbinders in diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index 823a122..15a46bf 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -24,7 +24,7 @@ import Name ( Name, Provenance(..), ExportFlag(..), NamedThing(..), mkLocalName, mkImportedLocalName, mkGlobalName, mkUnboundName, mkIPName, isWiredInName, hasBetterProv, nameOccName, setNameModule, nameModule, - pprOccName, isLocallyDefined, nameUnique, nameOccName, + pprOccName, isLocallyDefined, nameUnique, setNameProvenance, getNameProvenance, pprNameProvenance, extendNameEnv_C, plusNameEnv_C, nameEnvElts ) @@ -322,6 +322,13 @@ bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b $ \ name' -> bindCoreLocalsFVRn bs $ \ names' -> thing_inside (name':names') +bindLocalNames names enclosed_scope + = getLocalNameEnv `thenRn` \ name_env -> + setLocalNameEnv (addListToRdrEnv name_env pairs) + enclosed_scope + where + pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names] + ------------------------------------- bindLocalRn doc rdr_name enclosed_scope = getSrcLocRn `thenRn` \ loc -> @@ -350,15 +357,10 @@ bindUVarRn = bindLocalRn extendTyVarEnvFVRn :: [HsTyVarBndr Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars) -- This tiresome function is used only in rnDecl on InstDecl extendTyVarEnvFVRn tyvars enclosed_scope - = getLocalNameEnv `thenRn` \ env -> - let - tyvar_names = hsTyVarNames tyvars - new_env = addListToRdrEnv env [ (mkRdrUnqual (getOccName name), name) - | name <- tyvar_names - ] - in - setLocalNameEnv new_env enclosed_scope `thenRn` \ (thing, fvs) -> + = bindLocalNames tyvar_names enclosed_scope `thenRn` \ (thing, fvs) -> returnRn (thing, delListFromNameSet fvs tyvar_names) + where + tyvar_names = hsTyVarNames tyvars bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName] -> ([HsTyVarBndr Name] -> RnMS a) @@ -474,38 +476,13 @@ lookupGlobalOccRn rdr_name -- import M( f ) -- f :: Int -> Int -- f x = x --- In a sense, it's clear that the 'f' in the signature must refer --- to A.f, but the Haskell98 report does not stipulate this, so --- I treat the 'f' in the signature as a reference to an unqualified --- 'f' and hence fail with an ambiguous reference. +-- It's clear that the 'f' in the signature must refer to A.f +-- The Haskell98 report does not stipulate this, but it will! +-- So we must treat the 'f' in the signature in the same way +-- as the binding occurrence of 'f', using lookupBndrRn lookupSigOccRn :: RdrName -> RnMS Name -lookupSigOccRn = lookupOccRn - -{- OLD VERSION --- This code tries to be cleverer than the above. --- The variable in a signature must refer to a locally-defined thing, --- even if there's an imported thing of the same name. --- --- But this doesn't work for instance decls: --- instance Enum Int where --- {-# INLINE enumFrom #-} --- ... --- Here the enumFrom is an imported reference! -lookupSigOccRn rdr_name - = getNameEnvs `thenRn` \ (global_env, local_env) -> - case (lookupRdrEnv local_env rdr_name, lookupRdrEnv global_env rdr_name) of - (Just name, _) -> returnRn name - - (Nothing, Just names) -> case filter isLocallyDefined names of - [n] -> returnRn n - ns -> pprPanic "lookupSigOccRn" (ppr rdr_name <+> ppr names <+> ppr ns) - -- There can't be a local top-level name-clash - -- (That's dealt with elsewhere.) - - (Nothing, Nothing) -> failWithRn (mkUnboundName rdr_name) - (unknownNameErr rdr_name) --} - +lookupSigOccRn = lookupBndrRn + -- Look in both local and global env lookup_occ global_env local_env rdr_name diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs index 1b19d4b..260b9c6 100644 --- a/ghc/compiler/rename/RnSource.lhs +++ b/ghc/compiler/rename/RnSource.lhs @@ -25,7 +25,7 @@ import RnEnv ( bindTyVarsRn, lookupBndrRn, lookupOccRn, getIPName, lookupImplicitOccRn, lookupImplicitOccsRn, bindLocalsRn, bindLocalRn, bindLocalsFVRn, bindUVarRn, bindTyVarsFVRn, bindTyVarsFV2Rn, extendTyVarEnvFVRn, - bindCoreLocalFVRn, bindCoreLocalsFVRn, + bindCoreLocalFVRn, bindCoreLocalsFVRn, bindLocalNames, checkDupOrQualNames, checkDupNames, mkImportedGlobalName, mkImportedGlobalFromRdrName, newDFunName, getDFunKey, newImplicitBinder, @@ -299,14 +299,19 @@ rnDecl (InstD (InstDecl inst_ty mbinds uprags dfun_rdr_name src_loc)) rnMethodBinds mbinds ) `thenRn` \ (mbinds', meth_fvs) -> let - binders = mkNameSet (map fst (bagToList (collectMonoBinders mbinds'))) + binders = map fst (bagToList (collectMonoBinders mbinds')) + binder_set = mkNameSet binders in -- Rename the prags and signatures. -- Note that the type variables are not in scope here, -- so that instance Eq a => Eq (T a) where -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-} -- works OK. - renameSigs (okInstDclSig binders) uprags `thenRn` \ (new_uprags, prag_fvs) -> + -- + -- But the (unqualified) method names are in scope + bindLocalNames binders ( + renameSigs (okInstDclSig binder_set) uprags + ) `thenRn` \ (new_uprags, prag_fvs) -> getModeRn `thenRn` \ mode -> (case mode of -- 1.7.10.4