diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2015-06-02 00:02:03 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2015-06-02 00:50:45 +0100 |
| commit | 9b73cb16485f331d9dc1f37826c6d503e24a5b0b (patch) | |
| tree | f5f5772dc844ed925af757c1b5cd08b8fa6bd88d | |
| parent | 11d8f84fd3237c3821c8f826716fc4c9adfccb8c (diff) | |
| download | haskell-9b73cb16485f331d9dc1f37826c6d503e24a5b0b.tar.gz | |
Refactor the GlobalRdrEnv, fixing #7672
This patch started innocently enough, by deleting a single
call from rnImportDecl, namely
let gbl_env = mkGlobalRdrEnv (filterOut from_this_mod gres)
The 'filterOut' makes no sense, and was the cause of #7672.
But that little loose end led to into a twisty maze of little
passages, all alike, which has taken me an unreasonably long
time to straighten out. Happily, I think the result is really
much better.
In particular:
* INVARIANT 1 of the GlobalRdrEnv type was simply not true:
we had multiple GlobalRdrElts in a list with the same
gre_name field. This kludgily implmented one form of
shadowing.
* Meanwhile, extendGlobalRdrEnvRn implemented a second form of
shadowing, by deleting stuff from the GlobalRdrEnv.
* In turn, much of this shadowing stuff depended on the Names of
the Ids bound in the GHCi InteractiveContext being Internal
names, even though the TyCons and suchlike all had External
Names. Very confusing.
So I have made the following changes
* I re-established INVARIANT 1 of GlobalRdrEnv. As a result
some strange code in RdrName.pickGREs goes away.
* RnNames.extendGlobalRdrEnvRn now makes one call to deal with
shadowing, where necessary, and another to extend the
environment. It deals separately with duplicate bindings.
The very complicated RdrName.extendGlobalRdrEnv becomes much
simpler; we need to export the shadowing function, now called
RdrName.shadowNames; and we can nuke
RdrName.findLocalDupsRdrEnv altogether.
RdrName Note [GlobalRdrEnv shadowing] summarises the shadowing
story
* The Names of the Ids bound in the GHCi interactive context are
now all External. See Note [Interactively-bound Ids in GHCi]
in HscTypes.
* Names for Ids created by the debugger are now made by
IfaceEnv.newInteractiveBinder. This fixes a lurking bug which
was that the debugger was using mkNewUniqueSupply 'I' to make
uniques, which does NOT guarantee a fresh supply of uniques on
successive calls.
* Note [Template Haskell ambiguity] in RnEnv shows that one TH-related
error is reported lazily (on occurrences) when it might be better
reported when extending the environment. In some (but not all) cases
this was done before; but now it's uniformly at occurrences. In
some ways it'd be better to report when extending the environment,
but it's a tiresome test and the error is rare, so I'm leaving it
at the lookup site for now, with the above Note.
* A small thing: RnNames.greAvail becomes RdrName.availFromGRE, where
it joins the dual RdrName.gresFromAvail.
24 files changed, 581 insertions, 569 deletions
diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs index 4ebeecaacc..7764303d2e 100644 --- a/compiler/basicTypes/RdrName.hs +++ b/compiler/basicTypes/RdrName.hs @@ -44,13 +44,13 @@ module RdrName ( -- * Global mapping of 'RdrName' to 'GlobalRdrElt's GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv, - lookupGlobalRdrEnv, extendGlobalRdrEnv, + lookupGlobalRdrEnv, extendGlobalRdrEnv, shadowNames, pprGlobalRdrEnv, globalRdrEnvElts, lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes, - transformGREs, findLocalDupsRdrEnv, pickGREs, + transformGREs, pickGREs, -- * GlobalRdrElts - gresFromAvails, gresFromAvail, + gresFromAvails, gresFromAvail, localGREsFromAvail, availFromGRE, -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec' GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK, @@ -400,14 +400,14 @@ type GlobalRdrEnv = OccEnv [GlobalRdrElt] -- The list in the codomain is required because there may be name clashes -- These only get reported on lookup, not on construction -- --- INVARIANT: All the members of the list have distinct --- 'gre_name' fields; that is, no duplicate Names +-- INVARIANT 1: All the members of the list have distinct +-- 'gre_name' fields; that is, no duplicate Names -- --- INVARIANT: Imported provenance => Name is an ExternalName --- However LocalDefs can have an InternalName. This --- happens only when type-checking a [d| ... |] Template --- Haskell quotation; see this note in RnNames --- Note [Top-level Names in Template Haskell decl quotes] +-- INVARIANT 2: Imported provenance => Name is an ExternalName +-- However LocalDefs can have an InternalName. This +-- happens only when type-checking a [d| ... |] Template +-- Haskell quotation; see this note in RnNames +-- Note [Top-level Names in Template Haskell decl quotes] -- | An element of the 'GlobalRdrEnv' data GlobalRdrElt @@ -473,7 +473,7 @@ So: in an export list Module M exports everything, so its exports will be AvailTC C [C,T,op] AvailTC T [T,TInt,TBool] -On import we convert to GlobalRdrElt and the combine +On import we convert to GlobalRdrElt and then combine those. For T that will mean we have one GRE with Parent C one GRE with NoParent @@ -493,13 +493,25 @@ gresFromAvail prov_fn avail gre_par = mkParent n avail, gre_prov = prov_fn n} | n <- availNames avail ] - where + +localGREsFromAvail :: AvailInfo -> [GlobalRdrElt] +-- Turn an Avail into a list of LocalDef GlobalRdrElts +localGREsFromAvail = gresFromAvail (const LocalDef) mkParent :: Name -> AvailInfo -> Parent mkParent _ (Avail _) = NoParent mkParent n (AvailTC m _) | n == m = NoParent | otherwise = ParentIs m +availFromGRE :: GlobalRdrElt -> AvailInfo +availFromGRE gre + = case gre_par gre of + ParentIs p -> AvailTC p [me] + NoParent | isTyConName me -> AvailTC me [me] + | otherwise -> Avail me + where + me = gre_name gre + emptyGlobalRdrEnv :: GlobalRdrEnv emptyGlobalRdrEnv = emptyOccEnv @@ -583,20 +595,9 @@ pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt] -- the locally-defined @f@, and a GRE for the imported @f@, with a /single/ -- provenance, namely the one for @Baz(f)@. pickGREs rdr_name gres - | (_ : _ : _) <- candidates -- This is usually false, so we don't have to - -- even look at internal_candidates - , (gre : _) <- internal_candidates - = [gre] -- For this internal_candidate stuff, - -- see Note [Template Haskell binders in the GlobalRdrEnv] - -- If there are multiple Internal candidates, pick the - -- first one (ie with the (innermost binding) - | otherwise = ASSERT2( isSrcRdrName rdr_name, ppr rdr_name ) - candidates + mapMaybe pick gres where - candidates = mapMaybe pick gres - internal_candidates = filter (isInternalName . gre_name) candidates - rdr_is_unqual = isUnqual rdr_name rdr_is_qual = isQual_maybe rdr_name @@ -664,45 +665,62 @@ transformGREs trans_gre occs rdr_env Just gres -> extendOccEnv env occ (map trans_gre gres) Nothing -> env -extendGlobalRdrEnv :: Bool -> GlobalRdrEnv -> [AvailInfo] -> GlobalRdrEnv --- Extend with new LocalDef GREs from the AvailInfos. --- --- If do_shadowing is True, first remove name clashes between the new --- AvailInfos and the existing GlobalRdrEnv. --- This is used by the GHCi top-level --- --- E.g. Adding a LocalDef "x" when there is an existing GRE for Q.x --- should remove any unqualified import of Q.x, --- leaving only the qualified one --- --- However do *not* remove name clashes between the AvailInfos themselves, --- so that (say) data T = A | A --- will still give a duplicate-binding error. --- Same thing if there are multiple AvailInfos (don't remove clashes), --- though I'm not sure this ever happens with do_shadowing=True - -extendGlobalRdrEnv do_shadowing env avails - = foldl add_avail env1 avails - where - names = concatMap availNames avails - env1 | do_shadowing = foldl shadow_name env names - | otherwise = env - -- By doing the removal first, we ensure that the new AvailInfos - -- don't shadow each other; that would conceal genuine errors - -- E.g. in GHCi data T = A | A - - add_avail env avail = foldl (add_name avail) env (availNames avail) - - add_name avail env name - = extendOccEnv_Acc (:) singleton env occ gre - where - occ = nameOccName name - gre = GRE { gre_name = name - , gre_par = mkParent name avail - , gre_prov = LocalDef } +extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv +extendGlobalRdrEnv env gre + = extendOccEnv_Acc insertGRE singleton env + (nameOccName (gre_name gre)) gre + +shadowNames :: GlobalRdrEnv -> [Name] -> GlobalRdrEnv +shadowNames = foldl shadowName + +{- Note [GlobalRdrEnv shadowing] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Before adding new names to the GlobalRdrEnv we nuke some existing entries; +this is "shadowing". The actual work is done by RdrEnv.shadowNames. +There are two reasons for shadowing: + +* The GHCi REPL + + - Ids bought into scope on the command line (eg let x = True) have + External Names, like Ghci4.x. We want a new binding for 'x' (say) + to override the existing binding for 'x'. + See Note [Interactively-bound Ids in GHCi] in HscTypes + + - Data types also have Extenal Names, like Ghci4.T; but we still want + 'T' to mean the newly-declared 'T', not an old one. + +* Nested Template Haskell declaration brackets + See Note [Top-level Names in Template Haskell decl quotes] in RnNames + + Consider a TH decl quote: + module M where + f x = h [d| f = 3 |] + We must shadow the outer declaration of 'f', else we'll get a + complaint when extending the GlobalRdrEnv, saying that there are two + bindings for 'f'. There are several tricky points: + + - This shadowing applies even if the binding for 'f' is in a + where-clause, and hence is in the *local* RdrEnv not the *global* + RdrEnv. This is done in lcl_env_TH in extendGlobalRdrEnvRn. + + - The External Name M.f from the enclosing module must certainly + still be available. So we don't nuke it entirely; we just make + it seem like qualified import. + + - We only shadow *External* names (which come from the main module), + or from earlier GHCi commands. Do not shadow *Internal* names + because in the bracket + [d| class C a where f :: a + f = 4 |] + rnSrcDecls will first call extendGlobalRdrEnvRn with C[f] from the + class decl, and *separately* extend the envt with the value binding. + At that stage, the class op 'f' will have an Internal name. +-} -shadow_name :: GlobalRdrEnv -> Name -> GlobalRdrEnv -shadow_name env name +shadowName :: GlobalRdrEnv -> Name -> GlobalRdrEnv +-- Remove certain old LocalDef GREs that share the same OccName as this new Name. +-- See Note [GlobalRdrEnv shadowing] for details +shadowName env name = alterOccEnv (fmap alter_fn) env (nameOccName name) where alter_fn :: [GlobalRdrElt] -> [GlobalRdrElt] @@ -710,23 +728,30 @@ shadow_name env name shadow_with :: Name -> GlobalRdrElt -> Maybe GlobalRdrElt shadow_with new_name old_gre@(GRE { gre_name = old_name, gre_prov = LocalDef }) - = case (nameModule_maybe old_name, nameModule_maybe new_name) of - (Nothing, _) -> Nothing - (Just old_mod, Just new_mod) | new_mod == old_mod -> Nothing - (Just old_mod, _) -> Just (old_gre { gre_prov = Imported [fake_imp_spec] }) - where - fake_imp_spec = ImpSpec id_spec ImpAll -- Urgh! - old_mod_name = moduleName old_mod - id_spec = ImpDeclSpec { is_mod = old_mod_name - , is_as = old_mod_name - , is_qual = True - , is_dloc = nameSrcSpan old_name } + = case nameModule_maybe old_name of + Nothing -> Just old_gre + Just old_mod + | Just new_mod <- nameModule_maybe new_name + , new_mod == old_mod + -> Nothing + | otherwise + -> Just (old_gre { gre_prov = Imported [mk_fake_imp_spec old_name old_mod] }) + shadow_with new_name old_gre@(GRE { gre_prov = Imported imp_specs }) | null imp_specs' = Nothing | otherwise = Just (old_gre { gre_prov = Imported imp_specs' }) where imp_specs' = mapMaybe (shadow_is new_name) imp_specs + mk_fake_imp_spec old_name old_mod -- Urgh! + = ImpSpec id_spec ImpAll + where + old_mod_name = moduleName old_mod + id_spec = ImpDeclSpec { is_mod = old_mod_name + , is_as = old_mod_name + , is_qual = True + , is_dloc = nameSrcSpan old_name } + shadow_is :: Name -> ImportSpec -> Maybe ImportSpec shadow_is new_name is@(ImpSpec { is_decl = id_spec }) | Just new_mod <- nameModule_maybe new_name @@ -735,41 +760,6 @@ shadow_name env name | otherwise -- Shadow unqualified only = Just (is { is_decl = id_spec { is_qual = True } }) -{- -Note [Template Haskell binders in the GlobalRdrEnv] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For reasons described in Note [Top-level Names in Template Haskell decl quotes] -in RnNames, a GRE with an Internal gre_name (i.e. one generated by a TH decl -quote) should *shadow* a GRE with an External gre_name. Hence some faffing -around in pickGREs and findLocalDupsRdrEnv --} - -findLocalDupsRdrEnv :: GlobalRdrEnv -> [Name] -> [[GlobalRdrElt]] --- ^ For each 'OccName', see if there are multiple local definitions --- for it; return a list of all such --- and return a list of the duplicate bindings -findLocalDupsRdrEnv rdr_env occs - = go rdr_env [] occs - where - go _ dups [] = dups - go rdr_env dups (name:names) - = case filter (pick name) gres of - [] -> go rdr_env dups names - [_] -> go rdr_env dups names -- The common case - dup_gres -> go rdr_env' (dup_gres : dups) names - where - occ = nameOccName name - gres = lookupOccEnv rdr_env occ `orElse` [] - rdr_env' = delFromOccEnv rdr_env occ - -- The delFromOccEnv avoids repeating the same - -- complaint twice, when names itself has a duplicate - -- which is a common case - - -- See Note [Template Haskell binders in the GlobalRdrEnv] - pick name (GRE { gre_name = n, gre_prov = LocalDef }) - | isInternalName name = isInternalName n - | otherwise = True - pick _ _ = False {- ************************************************************************ diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs index 5b1b33795a..6e891ba798 100644 --- a/compiler/ghci/Debugger.hs +++ b/compiler/ghci/Debugger.hs @@ -2,14 +2,14 @@ ----------------------------------------------------------------------------- -- --- GHCi Interactive debugging commands +-- GHCi Interactive debugging commands -- -- Pepe Iborra (supported by Google SoC) 2006 -- -- ToDo: lots of violation of layering here. This module should -- decide whether it is above the GHC API (import GHC and nothing -- else) or below it. --- +-- ----------------------------------------------------------------------------- module Debugger (pprintClosureCommand, showTerm, pprTypeAndContents) where @@ -20,6 +20,7 @@ import RtClosureInspect import GhcMonad import HscTypes import Id +import IfaceEnv( newInteractiveBinder ) import Name import Var hiding ( varName ) import VarSet @@ -71,7 +72,7 @@ pprintClosureCommand bindThings force str = do -- Do the obtainTerm--bindSuspensions-computeSubstitution dance go :: GhcMonad m => TvSubst -> Id -> m (TvSubst, Term) go subst id = do - let id' = id `setIdType` substTy subst (idType id) + let id' = id `setIdType` substTy subst (idType id) term_ <- GHC.obtainTermFromId maxBound force id' term <- tidyTermTyVars term_ term' <- if bindThings && @@ -112,9 +113,9 @@ bindSuspensions t = do alreadyUsedNames = map (occNameString . nameOccName . getName) inScope availNames = map ((prefix++) . show) [(1::Int)..] \\ alreadyUsedNames availNames_var <- liftIO $ newIORef availNames - (t', stuff) <- liftIO $ foldTerm (nameSuspensionsAndGetInfos availNames_var) t + (t', stuff) <- liftIO $ foldTerm (nameSuspensionsAndGetInfos hsc_env availNames_var) t let (names, tys, hvals) = unzip3 stuff - let ids = [ mkVanillaGlobal name ty + let ids = [ mkVanillaGlobal name ty | (name,ty) <- zip names tys] new_ic = extendInteractiveContextWithIds ictxt ids liftIO $ extendLinkEnv (zip names hvals) @@ -123,27 +124,27 @@ bindSuspensions t = do where -- Processing suspensions. Give names and recopilate info - nameSuspensionsAndGetInfos :: IORef [String] -> - TermFold (IO (Term, [(Name,Type,HValue)])) - nameSuspensionsAndGetInfos freeNames = TermFold + nameSuspensionsAndGetInfos :: HscEnv -> IORef [String] + -> TermFold (IO (Term, [(Name,Type,HValue)])) + nameSuspensionsAndGetInfos hsc_env freeNames = TermFold { - fSuspension = doSuspension freeNames + fSuspension = doSuspension hsc_env freeNames , fTerm = \ty dc v tt -> do tt' <- sequence tt let (terms,names) = unzip tt' return (Term ty dc v terms, concat names) , fPrim = \ty n ->return (Prim ty n,[]) - , fNewtypeWrap = - \ty dc t -> do + , fNewtypeWrap = + \ty dc t -> do (term, names) <- t return (NewtypeWrap ty dc term, names) , fRefWrap = \ty t -> do - (term, names) <- t + (term, names) <- t return (RefWrap ty term, names) } - doSuspension freeNames ct ty hval _name = do + doSuspension hsc_env freeNames ct ty hval _name = do name <- atomicModifyIORef' freeNames (\x->(tail x, head x)) - n <- newGrimName name + n <- newGrimName hsc_env name return (Suspension ct ty hval (Just n), [(n,ty,hval)]) @@ -181,7 +182,7 @@ showTerm term = do `gfinally` do setSession hsc_env GHC.setSessionDynFlags dflags - cPprShowable prec NewtypeWrap{ty=new_ty,wrapped_term=t} = + cPprShowable prec NewtypeWrap{ty=new_ty,wrapped_term=t} = cPprShowable prec t{ty=new_ty} cPprShowable _ _ = return Nothing @@ -192,26 +193,24 @@ showTerm term = do bindToFreshName hsc_env ty userName = do - name <- newGrimName userName - let id = mkVanillaGlobal name ty + name <- newGrimName hsc_env userName + let id = mkVanillaGlobal name ty new_ic = extendInteractiveContextWithIds (hsc_IC hsc_env) [id] return (hsc_env {hsc_IC = new_ic }, name) -- Create new uniques and give them sequentially numbered names -newGrimName :: MonadIO m => String -> m Name -newGrimName userName = do - us <- liftIO $ mkSplitUniqSupply 'b' - let unique = uniqFromSupply us - occname = mkOccName varName userName - name = mkInternalName unique occname noSrcSpan - return name +newGrimName :: MonadIO m => HscEnv -> String -> m Name +newGrimName hsc_env userName + = liftIO (newInteractiveBinder hsc_env occ noSrcSpan) + where + occ = mkOccName varName userName pprTypeAndContents :: GhcMonad m => Id -> m SDoc pprTypeAndContents id = do dflags <- GHC.getSessionDynFlags let pcontents = gopt Opt_PrintBindContents dflags pprdId = (PprTyThing.pprTyThing . AnId) id - if pcontents + if pcontents then do let depthBound = 100 -- If the value is an exception, make sure we catch it and @@ -225,7 +224,7 @@ pprTypeAndContents id = do else return pprdId -------------------------------------------------------------- --- Utils +-- Utils traceOptIf :: GhcMonad m => DumpFlag -> SDoc -> m () traceOptIf flag doc = do diff --git a/compiler/iface/IfaceEnv.hs b/compiler/iface/IfaceEnv.hs index f647e35707..0a13fc468c 100644 --- a/compiler/iface/IfaceEnv.hs +++ b/compiler/iface/IfaceEnv.hs @@ -3,7 +3,8 @@ {-# LANGUAGE CPP, RankNTypes #-} module IfaceEnv ( - newGlobalBinder, newImplicitBinder, + newGlobalBinder, newImplicitBinder, newInteractiveBinder, + externaliseName, lookupIfaceTop, lookupOrig, lookupOrigNameCache, extendNameCache, newIfaceName, newIfaceNames, @@ -13,8 +14,9 @@ module IfaceEnv ( ifaceExportNames, -- Name-cache stuff - allocateGlobalBinder, initNameCache, updNameCache, - getNameCache, mkNameCacheUpdater, NameCacheUpdater(..) + allocateGlobalBinder, + initNameCache, updNameCache, + mkNameCacheUpdater, NameCacheUpdater(..) ) where #include "HsVersions.h" @@ -70,10 +72,18 @@ newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name -- moment when we know its Module and SrcLoc in their full glory newGlobalBinder mod occ loc - = do mod `seq` occ `seq` return () -- See notes with lookupOrig --- traceIf (text "newGlobalBinder" <+> ppr mod <+> ppr occ <+> ppr loc) - updNameCache $ \name_cache -> - allocateGlobalBinder name_cache mod occ loc + = do { mod `seq` occ `seq` return () -- See notes with lookupOrig +-- ; traceIf (text "newGlobalBinder" <+> ppr mod <+> ppr occ <+> ppr loc) + ; updNameCacheTcRn $ \name_cache -> + allocateGlobalBinder name_cache mod occ loc } + +newInteractiveBinder :: HscEnv -> OccName -> SrcSpan -> IO Name +-- Works in the IO monad, and gets the Module +-- from the interactive context +newInteractiveBinder hsc_env occ loc + = do { let mod = icInteractiveModule (hsc_IC hsc_env) + ; updNameCache hsc_env $ \name_cache -> + allocateGlobalBinder name_cache mod occ loc } allocateGlobalBinder :: NameCache @@ -150,8 +160,8 @@ lookupOrig mod occ mod `seq` occ `seq` return () -- ; traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ) - ; updNameCache $ \name_cache -> - case lookupOrigNameCache (nsNames name_cache) mod occ of { + ; updNameCacheTcRn $ \name_cache -> + case lookupOrigNameCache (nsNames name_cache) mod occ of { Just name -> (name_cache, name); Nothing -> case takeUniqFromSupply (nsUniqs name_cache) of { @@ -162,6 +172,19 @@ lookupOrig mod occ in (name_cache{ nsUniqs = us, nsNames = new_cache }, name) }}} +externaliseName :: Module -> Name -> TcRnIf m n Name +-- Take an Internal Name and make it an External one, +-- with the same unique +externaliseName mod name + = do { let occ = nameOccName name + loc = nameSrcSpan name + uniq = nameUnique name + ; occ `seq` return () -- c.f. seq in newGlobalBinder + ; updNameCacheTcRn $ \ ns -> + let name' = mkExternalName uniq mod occ loc + ns' = ns { nsNames = extendNameCache (nsNames ns) mod occ name' } + in (ns', name') } + {- ************************************************************************ * * @@ -214,26 +237,23 @@ extendNameCache nc mod occ name where combine _ occ_env = extendOccEnv occ_env occ name -getNameCache :: TcRnIf a b NameCache -getNameCache = do { HscEnv { hsc_NC = nc_var } <- getTopEnv; - readMutVar nc_var } +updNameCacheTcRn :: (NameCache -> (NameCache, c)) -> TcRnIf a b c +updNameCacheTcRn upd_fn = do { hsc_env <- getTopEnv + ; liftIO (updNameCache hsc_env upd_fn) } -updNameCache :: (NameCache -> (NameCache, c)) -> TcRnIf a b c -updNameCache upd_fn = do - HscEnv { hsc_NC = nc_var } <- getTopEnv - atomicUpdMutVar' nc_var upd_fn +updNameCache :: HscEnv -> (NameCache -> (NameCache, c)) -> IO c +updNameCache hsc_env upd_fn = atomicModifyIORef' (hsc_NC hsc_env) upd_fn -- | A function that atomically updates the name cache given a modifier -- function. The second result of the modifier function will be the result -- of the IO action. -newtype NameCacheUpdater = NCU { updateNameCache :: forall c. (NameCache -> (NameCache, c)) -> IO c } +newtype NameCacheUpdater + = NCU { updateNameCache :: forall c. (NameCache -> (NameCache, c)) -> IO c } -- | Return a function to atomically update the name cache. mkNameCacheUpdater :: TcRnIf a b NameCacheUpdater -mkNameCacheUpdater = do - nc_var <- hsc_NC `fmap` getTopEnv - let update_nc f = atomicModifyIORef' nc_var f - return (NCU update_nc) +mkNameCacheUpdater = do { hsc_env <- getTopEnv + ; return (NCU (updNameCache hsc_env)) } initNameCache :: UniqSupply -> [Name] -> NameCache initNameCache us names diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 961c3a34cc..1d33c4fb9c 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -1159,7 +1159,7 @@ appendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code) {- ************************************************************************ * * -\subsection{The interactive context} + The interactive context * * ************************************************************************ @@ -1235,28 +1235,40 @@ The details are a bit tricky though: Note [Interactively-bound Ids in GHCi] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Ids bound by previous Stmts in GHCi are currently - a) GlobalIds - b) with an Internal Name (not External) - c) and a tidied type + a) GlobalIds, with + b) An External Name, like Ghci4.foo + See Note [The interactive package] above + c) A tidied type (a) They must be GlobalIds (not LocalIds) otherwise when we come to compile an expression using these ids later, the byte code generator will consider the occurrences to be free rather than global. - (b) They start with an Internal Name because a Stmt is a local - construct, so the renamer naturally builds an Internal name for - each of its binders. It would be possible subsequently to give - them an External Name (in a GhciN module) but then we'd have - to substitute it out. So for now they stay Internal. + (b) Having an External Name is important because of Note + [GlobalRdrEnv shadowing] in RdrName (c) Their types are tidied. This is important, because :info may ask to look at them, and :info expects the things it looks up to have tidy types -However note that TyCons, Classes, and even Ids bound by other top-level -declarations in GHCi (eg foreign import, record selectors) currently get -External Names, with Ghci9 (or 8, or 7, etc) as the module name. +Where do interactively-bound Ids come from? + + - GHCi REPL Stmts e.g. + ghci> let foo x = x+1 + These start with an Internal Name because a Stmt is a local + construct, so the renamer naturally builds an Internal name for + each of its binders. Then in tcRnStmt they are externalised via + TcRnDriver.externaliseAndTidyId, so they get Names like Ghic4.foo. + + - Ids bound by the debugger etc have Names constructed by + IfaceEnv.newInteractiveBinder; at the call sites it is followed by + mkVanillaGlobal or mkVanillaGlobalWithInfo. So again, they are + all Global, External. + + - TyCons, Classes, and Ids bound by other top-level declarations in + GHCi (eg foreign import, record selectors) also get External + Names, with Ghci9 (or 8, or 7, etc) as the module name. Note [ic_tythings] @@ -1462,9 +1474,11 @@ icExtendGblRdrEnv env tythings = foldr add env tythings -- Foldr makes things in the front of -- the list shadow things at the back where - add thing env = extendGlobalRdrEnv True {- Shadowing please -} env - [tyThingAvailInfo thing] - -- One at a time, to ensure each shadows the previous ones + -- One at a time, to ensure each shadows the previous ones + add thing env = foldl extendGlobalRdrEnv env1 (localGREsFromAvail avail) + where + env1 = shadowNames env (availNames avail) + avail = tyThingAvailInfo thing substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 59224e8195..f96f4b9af1 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -52,6 +52,7 @@ import HsSyn import HscTypes import BasicTypes ( HValue ) import InstEnv +import IfaceEnv ( newInteractiveBinder ) import FamInstEnv ( FamInst, orphNamesOfFamInst ) import TyCon import Type hiding( typeKind ) @@ -69,6 +70,7 @@ import Linker import DynFlags import Unique import UniqSupply +import MonadUtils import Module import Panic import UniqFM @@ -187,7 +189,7 @@ execStmt stmt ExecOptions{..} = do -- empty statement / comment Nothing -> return (ExecComplete (Right []) 0) - Just (tyThings, hval, fix_env) -> do + Just (ids, hval, fix_env) -> do updateFixityEnv fix_env status <- @@ -201,7 +203,7 @@ execStmt stmt ExecOptions{..} = do size = ghciHistSize idflags' - handleRunStatus execSingleStep stmt bindings tyThings + handleRunStatus execSingleStep stmt bindings ids breakMVar statusMVar status (emptyHistory size) -- | The type returned by the deprecated 'runStmt' and @@ -626,17 +628,18 @@ bindLocalsAtBreakpoint -- bind, all we can do is bind a local variable to the exception -- value. bindLocalsAtBreakpoint hsc_env apStack Nothing = do - let exn_fs = fsLit "_exception" - exn_name = mkInternalName (getUnique exn_fs) (mkVarOccFS exn_fs) span - e_fs = fsLit "e" - e_name = mkInternalName (getUnique e_fs) (mkTyVarOccFS e_fs) span - e_tyvar = mkRuntimeUnkTyVar e_name liftedTypeKind - exn_id = Id.mkVanillaGlobal exn_name (mkTyVarTy e_tyvar) + let exn_occ = mkVarOccFS (fsLit "_exception") + span = mkGeneralSrcSpan (fsLit "<exception thrown>") + exn_name <- newInteractiveBinder hsc_env exn_occ span + + let e_fs = fsLit "e" + e_name = mkInternalName (getUnique e_fs) (mkTyVarOccFS e_fs) span + e_tyvar = mkRuntimeUnkTyVar e_name liftedTypeKind + exn_id = Id.mkVanillaGlobal exn_name (mkTyVarTy e_tyvar) ictxt0 = hsc_IC hsc_env ictxt1 = extendInteractiveContextWithIds ictxt0 [exn_id] - span = mkGeneralSrcSpan (fsLit "<exception thrown>") -- Linker.extendLinkEnv [(exn_name, unsafeCoerce# apStack)] return (hsc_env{ hsc_IC = ictxt1 }, [exn_name], span) @@ -673,37 +676,28 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do -- So that we don't fall over in a heap when this happens, just don't -- bind any free variables instead, and we emit a warning. mb_hValues <- mapM (getIdValFromApStack apStack) (map fromIntegral offsets) - let filtered_ids = [ id | (id, Just _hv) <- zip ids mb_hValues ] when (any isNothing mb_hValues) $ debugTraceMsg (hsc_dflags hsc_env) 1 $ text "Warning: _result has been evaluated, some bindings have been lost" - us <- mkSplitUniqSupply 'I' - let (us1, us2) = splitUniqSupply us - tv_subst = newTyVars us1 free_tvs - new_ids = zipWith3 (mkNewId tv_subst) occs filtered_ids (uniqsFromSupply us2) - names = map idName new_ids - - -- make an Id for _result. We use the Unique of the FastString "_result"; - -- we don't care about uniqueness here, because there will only be one - -- _result in scope at any time. - let result_name = mkInternalName (getUnique result_fs) - (mkVarOccFS result_fs) span - result_id = Id.mkVanillaGlobal result_name (substTy tv_subst result_ty) - - -- for each Id we're about to bind in the local envt: - -- - tidy the type variables - -- - globalise the Id (Ids are supposed to be Global, apparently). - -- - let result_ok = isPointer result_id - all_ids | result_ok = result_id : new_ids - | otherwise = new_ids - id_tys = map idType all_ids - (_,tidy_tys) = tidyOpenTypes emptyTidyEnv id_tys - final_ids = zipWith setIdType all_ids tidy_tys + us <- mkSplitUniqSupply 'I' -- Dodgy; will give the same uniques every time + let tv_subst = newTyVars us free_tvs + filtered_ids = [ id | (id, Just _hv) <- zip ids mb_hValues ] + (_,tidy_tys) = tidyOpenTypes emptyTidyEnv $ + map (substTy tv_subst . idType) filtered_ids + + new_ids <- zipWith3M mkNewId occs tidy_tys filtered_ids + result_name <- newInteractiveBinder hsc_env (mkVarOccFS result_fs) span + + let result_id = Id.mkVanillaGlobal result_name (substTy tv_subst result_ty) + result_ok = isPointer result_id + + final_ids | result_ok = result_id : new_ids + | otherwise = new_ids ictxt0 = hsc_IC hsc_env ictxt1 = extendInteractiveContextWithIds ictxt0 final_ids + names = map idName new_ids Linker.extendLinkEnv [ (name,hval) | (name, Just hval) <- zip names mb_hValues ] when result_ok $ Linker.extendLinkEnv [(result_name, unsafeCoerce# apStack)] @@ -714,13 +708,10 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do -- state is single-threaded and otherwise we'd spam old bindings -- whenever we stop at a breakpoint. The InteractveContext is properly -- saved/restored, but not the linker state. See #1743, test break026. - mkNewId :: TvSubst -> OccName -> Id -> Unique -> Id - mkNewId tv_subst occ id uniq - = Id.mkVanillaGlobalWithInfo name ty (idInfo id) - where - loc = nameSrcSpan (idName id) - name = mkInternalName uniq occ loc - ty = substTy tv_subst (idType id) + mkNewId :: OccName -> Type -> Id -> IO Id + mkNewId occ ty old_id + = do { name <- newInteractiveBinder hsc_env occ (getSrcSpan old_id) + ; return (Id.mkVanillaGlobalWithInfo name ty (idInfo old_id)) } newTyVars :: UniqSupply -> TcTyVarSet -> TvSubst -- Similarly, clone the type variables mentioned in the types diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index 0b877959e3..d80e970f94 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -24,8 +24,7 @@ module RnEnv ( greRdrName, lookupSubBndrGREs, lookupConstructorFields, lookupSyntaxName, lookupSyntaxNames, lookupIfThenElse, - lookupGreRn, lookupGreRn_maybe, - lookupGreLocalRn_maybe, + lookupGreAvailRn, getLookupOccRn, addUsedRdrNames, newLocalBndrRn, newLocalBndrsRn, @@ -164,13 +163,8 @@ newTopSrcBinder (L loc rdr_name) (addErrAt loc (badOrigBinding rdr_name)) ; return name } else -- See Note [Binders in Template Haskell] in Convert.hs - do { let occ = nameOccName name - ; occ `seq` return () -- c.f. seq in newGlobalBinder - ; this_mod <- getModule - ; updNameCache $ \ ns -> - let name' = mkExternalName (nameUnique name) this_mod occ loc - ns' = ns { nsNames = extendNameCache (nsNames ns) this_mod occ name' } - in (ns', name') } + do { this_mod <- getModule + ; externaliseName this_mod name } | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name = do { this_mod <- getModule @@ -305,11 +299,11 @@ lookupTopBndrRn_maybe rdr_name (do { op_ok <- xoptM Opt_TypeOperators ; unless op_ok (addErr (opDeclErr rdr_name)) }) - ; mb_gre <- lookupGreLocalRn_maybe rdr_name - ; case mb_gre of - Nothing -> return Nothing - Just gre -> return (Just $ gre_name gre) } - + ; env <- getGlobalRdrEnv + ; case filter isLocalGRE (lookupGRE_RdrName rdr_name env) of + [gre] -> return (Just (gre_name gre)) + _ -> return Nothing -- Ambiguous (can't happen) or unbound + } ----------------------------------------------- -- | Lookup an @Exact@ @RdrName@. See Note [Looking up Exact RdrNames]. @@ -350,6 +344,8 @@ lookupExactOcc_either name , gre <- lookupGlobalRdrEnv env occ , gre_name gre == name ] ; case gres of + [gre] -> return (Right (gre_name gre)) + [] -> -- See Note [Splicing Exact names] do { lcl_env <- getLocalRdrEnv ; if name `inLocalRdrEnvScope` lcl_env @@ -366,28 +362,30 @@ lookupExactOcc_either name return (Left exact_nm_err) #endif /* !GHCI */ } - - [gre] -> return (Right (gre_name gre)) - _ -> return (Left dup_nm_err) - -- We can get more than one GRE here, if there are multiple - -- bindings for the same name. Sometimes they are caught later - -- by findLocalDupsRdrEnv, like in this example (Trac #8932): - -- $( [d| foo :: a->a; foo x = x |]) - -- foo = True - -- But when the names are totally identical, we panic (Trac #7241): - -- $(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] [''Show]]) - -- So, let's emit an error here, even if it will lead to duplication in some cases. + gres -> return (Left (sameNameErr gres)) -- Ugh! See Note [Template Haskell ambiguity] } - where exact_nm_err = hang (ptext (sLit "The exact Name") <+> quotes (ppr name) <+> ptext (sLit "is not in scope")) 2 (vcat [ ptext (sLit "Probable cause: you used a unique Template Haskell name (NameU), ") , ptext (sLit "perhaps via newName, but did not bind it") , ptext (sLit "If that's it, then -ddump-splices might be useful") ]) - dup_nm_err = hang (ptext (sLit "Duplicate exact Name") <+> quotes (ppr $ nameOccName name)) - 2 (vcat [ ptext (sLit "Probable cause: you used a unique Template Haskell name (NameU), ") - , ptext (sLit "perhaps via newName, but bound it multiple times") - , ptext (sLit "If that's it, then -ddump-splices might be useful") ]) + +sameNameErr :: [GlobalRdrElt] -> MsgDoc +sameNameErr [] = panic "addSameNameErr: empty list" +sameNameErr gres@(_ : _) + = hang (ptext (sLit "Same exact name in multiple name-spaces:")) + 2 (vcat (map pp_one sorted_names) $$ th_hint) + where + sorted_names = sortWith nameSrcLoc (map gre_name gres) + pp_one name + = hang (pprNameSpace (occNameSpace (getOccName name)) + <+> quotes (ppr name) <> comma) + 2 (ptext (sLit "declared at:") <+> ppr (nameSrcLoc name)) + + th_hint = vcat [ ptext (sLit "Probable cause: you bound a unique Template Haskell name (NameU),") + , ptext (sLit "perhaps via newName, in different name-spaces.") + , ptext (sLit "If that's it, then -ddump-splices might be useful") ] + ----------------------------------------------- lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name @@ -582,7 +580,7 @@ These System names are generated by Convert.thRdrName But, constructors and the like need External Names, not System Names! So we do the following - * In RnEnv.newGlobalBinder we spot Exact RdrNames that wrap a + * In RnEnv.newTopSrcBinder we spot Exact RdrNames that wrap a non-External Name, and make an External name for it. This is the name that goes in the GlobalRdrEnv @@ -623,6 +621,25 @@ in scope in the GlobalRdrEnv, we need to look up the DataName namespace too. (An alternative would be to make the GlobalRdrEnv also have a Name -> GRE mapping.) +Note [Template Haskell ambiguity] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The GlobalRdrEnv invariant says that if + occ -> [gre1, ..., gren] +then the gres have distinct Names (INVARIANT 1 of GlobalRdrEnv). +This is guaranteed by extendGlobalRdrEnvRn (the dups check in add_gre). + +So how can we get multiple gres in lookupExactOcc_maybe? Because in +TH we might use the same TH NameU in two different name spaces. +eg (Trac #7241): + $(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] [''Show]]) +Here we generate a type constructor and data constructor with the same +unique, but differnt name spaces. + +It'd be nicer to rule this out in extendGlobalRdrEnvRn, but that would +mean looking up the OccName in every name-space, just in case, and that +seems a bit brutal. So it's just done here on lookup. But we might +need to revisit that choice. + Note [Usage for sub-bndrs] ~~~~~~~~~~~~~~~~~~~~~~~~~~ If you have this @@ -825,43 +842,50 @@ lookupGlobalOccRn_maybe rdr_name -------------------------------------------------- lookupGreRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt) --- Just look up the RdrName in the GlobalRdrEnv +-- Look up the RdrName in the GlobalRdrEnv +-- Exactly one binding: records it as "used", return (Just gre) +-- No bindings: return Nothing +-- Many bindings: report "ambiguous", return an arbitrary (Just gre) +-- (This API is a bit strange; lookupGRERn2_maybe is simpler. +-- But it works and I don't want to fiddle too much.) lookupGreRn_maybe rdr_name - = lookupGreRn_help rdr_name (lookupGRE_RdrName rdr_name) - -lookupGreRn :: RdrName -> RnM GlobalRdrElt --- If not found, add error message, and return a fake GRE -lookupGreRn rdr_name - = do { mb_gre <- lookupGreRn_maybe rdr_name - ; case mb_gre of { - Just gre -> return gre ; - Nothing -> do - { traceRn (text "lookupGreRn" <+> ppr rdr_name) - ; name <- unboundName WL_Global rdr_name - ; return (GRE { gre_name = name, gre_par = NoParent, - gre_prov = LocalDef }) }}} - -lookupGreLocalRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt) --- Similar, but restricted to locally-defined things -lookupGreLocalRn_maybe rdr_name - = lookupGreRn_help rdr_name lookup_fn - where - lookup_fn env = filter isLocalGRE (lookupGRE_RdrName rdr_name env) - -lookupGreRn_help :: RdrName -- Only used in error message - -> (GlobalRdrEnv -> [GlobalRdrElt]) -- Lookup function - -> RnM (Maybe GlobalRdrElt) --- Checks for exactly one match; reports deprecations --- Returns Nothing, without error, if too few -lookupGreRn_help rdr_name lookup = do { env <- getGlobalRdrEnv - ; case lookup env of + ; case lookupGRE_RdrName rdr_name env of [] -> return Nothing [gre] -> do { addUsedRdrName True gre rdr_name ; return (Just gre) } gres -> do { addNameClashErrRn rdr_name gres + ; traceRn (text "name clash" <+> (ppr rdr_name $$ ppr gres $$ ppr env)) ; return (Just (head gres)) } } +lookupGreRn2_maybe :: RdrName -> RnM (Maybe GlobalRdrElt) +-- Look up the RdrName in the GlobalRdrEnv +-- Exactly one binding: record it as "used", return (Just gre) +-- No bindings: report "not in scope", return Nothing +-- Many bindings: report "ambiguous", return Nothing +lookupGreRn2_maybe rdr_name + = do { env <- getGlobalRdrEnv + ; case lookupGRE_RdrName rdr_name env of + [] -> do { _ <- unboundName WL_Global rdr_name + ; return Nothing } + [gre] -> do { addUsedRdrName True gre rdr_name + ; return (Just gre) } + gres -> do { addNameClashErrRn rdr_name gres + ; traceRn (text "name clash" <+> (ppr rdr_name $$ ppr gres $$ ppr env)) + ; return Nothing } } + +lookupGreAvailRn :: RdrName -> RnM (Name, AvailInfo) +-- Used in export lists +-- If not found or ambiguous, add error message, and fake with UnboundName +lookupGreAvailRn rdr_name + = do { mb_gre <- lookupGreRn2_maybe rdr_name + ; case mb_gre of { + Just gre -> return (gre_name gre, availFromGRE gre) ; + Nothing -> + do { traceRn (text "lookupGreRn" <+> ppr rdr_name) + ; let name = mkUnboundName rdr_name + ; return (name, Avail name) } } } + {- ********************************************************* * * diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index b692f47cd7..11f8e61063 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -263,8 +263,7 @@ rnImportDecl this_mod -- filter the imports according to the import declaration (new_imp_details, gres) <- filterImports ifaces imp_spec imp_details - let gbl_env = mkGlobalRdrEnv (filterOut from_this_mod gres) - from_this_mod gre = nameModule (gre_name gre) == this_mod + let gbl_env = mkGlobalRdrEnv gres -- True <=> import M () import_all = case imp_details of @@ -410,6 +409,7 @@ created by its bindings. Note [Top-level Names in Template Haskell decl quotes] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ See also: Note [Interactively-bound Ids in GHCi] in HscTypes + Note [Looking up Exact RdrNames] in RnEnv Consider a Template Haskell declaration quotation like this: module M where @@ -417,31 +417,11 @@ Consider a Template Haskell declaration quotation like this: When renaming the declarations inside [d| ...|], we treat the top level binders specially in two ways -1. We give them an Internal name, not (as usual) an External one. - Otherwise the NameCache gets confused by a second allocation of - M.f. (We used to invent a fake module ThFake to avoid this, but - that had other problems, notably in getting the correct answer for - nameIsLocalOrFrom in lookupFixity. So we now leave tcg_module - unaffected.) +1. We give them an Internal Name, not (as usual) an External one. + This is done by RnEnv.newTopSrcBinder. -2. We make them *shadow* the outer bindings. If we don't do that, - we'll get a complaint when extending the GlobalRdrEnv, saying that - there are two bindings for 'f'. There are several tricky points: - - * This shadowing applies even if the binding for 'f' is in a - where-clause, and hence is in the *local* RdrEnv not the *global* - RdrEnv. - - * The *qualified* name M.f from the enclosing module must certainly - still be available. So we don't nuke it entirely; we just make - it seem like qualified import. - - * We only shadow *External* names (which come from the main module) - Do not shadow *Inernal* names because in the bracket - [d| class C a where f :: a - f = 4 |] - rnSrcDecls will first call extendGlobalRdrEnvRn with C[f] from the - class decl, and *separately* extend the envt with the value binding. +2. We make them *shadow* the outer bindings. + See Note [GlobalRdrEnv shadowing] 3. We find out whether we are inside a [d| ... |] by testing the TH stage. This is a slight hack, because the stage field was really @@ -469,31 +449,28 @@ extendGlobalRdrEnvRn avails new_fixities -- Delete new_occs from global and local envs -- If we are in a TemplateHaskell decl bracket, -- we are going to shadow them - -- See Note [Top-level Names in Template Haskell decl quotes] + -- See Note [GlobalRdrEnv shadowing] inBracket = isBrackStage stage + lcl_env_TH = lcl_env { tcl_rdr = delLocalRdrEnvList (tcl_rdr lcl_env) new_occs } + -- See Note [GlobalRdrEnv shadowing] lcl_env2 | inBracket = lcl_env_TH | otherwise = lcl_env - rdr_env2 = extendGlobalRdrEnv (isGHCi && not inBracket) rdr_env avails - -- Shadowing only applies for GHCi decls outside brackets - -- e.g. (Trac #4127a) - -- ghci> runQ [d| class C a where f :: a - -- f = True - -- instance C Int where f = 2 |] - -- We don't want the f=True to shadow the f class-op + -- Deal with shadowing: see Note [GlobalRdrEnv shadowing] + want_shadowing = isGHCi || inBracket + rdr_env1 | want_shadowing = shadowNames rdr_env new_names + | otherwise = rdr_env lcl_env3 = lcl_env2 { tcl_th_bndrs = extendNameEnvList th_bndrs [ (n, (TopLevel, th_lvl)) | n <- new_names ] } - fix_env' = foldl extend_fix_env fix_env new_names - dups = findLocalDupsRdrEnv rdr_env2 new_names - gbl_env' = gbl_env { tcg_rdr_env = rdr_env2, tcg_fix_env = fix_env' } + ; rdr_env2 <- foldlM add_gre rdr_env1 new_gres - ; traceRn (text "extendGlobalRdrEnvRn 1" <+> (ppr avails $$ (ppr dups))) - ; mapM_ (addDupDeclErr . map gre_name) dups + ; let fix_env' = foldl extend_fix_env fix_env new_names + gbl_env' = gbl_env { tcg_rdr_env = rdr_env2, tcg_fix_env = fix_env' } ; traceRn (text "extendGlobalRdrEnvRn 2" <+> (pprGlobalRdrEnv True rdr_env2)) ; return (gbl_env', lcl_env3) } @@ -510,12 +487,34 @@ extendGlobalRdrEnvRn avails new_fixities where occ = nameOccName name -{- -@getLocalDeclBinders@ returns the names for an @HsDecl@. It's -used for source code. + new_gres :: [GlobalRdrElt] -- New LocalDef GREs, derived from avails + new_gres = concatMap localGREsFromAvail avails + + add_gre :: GlobalRdrEnv -> GlobalRdrElt -> RnM GlobalRdrEnv + -- Extend the GlobalRdrEnv with a LocalDef GRE + -- If there is already a LocalDef GRE with the same OccName, + -- report an error and discard the new GRE + -- This establishes INVARIANT 1 of GlobalRdrEnvs + add_gre env gre + | not (null dups) -- Same OccName defined twice + = do { addDupDeclErr (gre : dups); return env } + + | otherwise + = return (extendGlobalRdrEnv env gre) + where + name = gre_name gre + occ = nameOccName name + dups = filter isLocalGRE (lookupGlobalRdrEnv env occ) + + +{- ********************************************************************* +* * + getLocalDeclBindersd@ returns the names for an HsDecl + It's used for source code. *** See "THE NAMING STORY" in HsDecls **** --} +* * +********************************************************************* -} getLocalNonValBinders :: MiniFixityEnv -> HsGroup RdrName -> RnM ((TcGblEnv, TcLclEnv), NameSet) @@ -877,15 +876,6 @@ catIELookupM ms = [ a | Succeeded a <- ms ] ************************************************************************ -} -greExportAvail :: GlobalRdrElt -> AvailInfo -greExportAvail gre - = case gre_par gre of - ParentIs p -> AvailTC p [me] - NoParent | isTyConName me -> AvailTC me [me] - | otherwise -> Avail me - where - me = gre_name gre - plusAvail :: AvailInfo -> AvailInfo -> AvailInfo plusAvail a1 a2 | debugIsOn && availName a1 /= availName a2 @@ -1088,7 +1078,7 @@ exports_from_avail Nothing rdr_env _imports _this_mod = -- The same as (module M) where M is the current module name, -- so that's how we handle it. let - avails = [ greExportAvail gre + avails = [ availFromGRE gre | gre <- globalRdrEnvElts rdr_env , isLocalGRE gre ] in @@ -1125,7 +1115,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod || (moduleName this_mod == mod) ; gres = filter (isModuleExported implicit_prelude mod) (globalRdrEnvElts rdr_env) - ; new_exports = map greExportAvail gres + ; new_exports = map availFromGRE gres ; names = map gre_name gres } ; checkErr exportValid (moduleNotImported mod) @@ -1167,13 +1157,11 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod ------------- lookup_ie :: IE RdrName -> RnM (IE Name, AvailInfo) lookup_ie (IEVar (L l rdr)) - = do gre <- lookupGreRn rdr - return (IEVar (L l (gre_name gre)), greExportAvail gre) + = do (name, avail) <- lookupGreAvailRn rdr + return (IEVar (L l name), avail) lookup_ie (IEThingAbs (L l rdr)) - = do gre <- lookupGreRn rdr - let name = gre_name gre - avail = greExportAvail gre + = do (name, avail) <- lookupGreAvailRn rdr return (IEThingAbs (L l name), avail) lookup_ie ie@(IEThingAll (L l rdr)) @@ -1495,7 +1483,7 @@ extendImportMap rdr_env rdr imp_map add _ avails = avail : avails -- add is really just a specialised (++) decl_loc = srcSpanEnd (is_dloc imp_decl_spec) -- For srcSpanEnd see Note [The ImportMap] - avail = greExportAvail gre + avail = availFromGRE gre bestImport :: [ImportSpec] -> ImportSpec bestImport iss @@ -1762,10 +1750,9 @@ greSrcSpan gre where name_span = nameSrcSpan (gre_name gre) -addDupDeclErr :: [Name] -> TcRn () -addDupDeclErr [] - = panic "addDupDeclErr: empty list" -addDupDeclErr names@(name : _) +addDupDeclErr :: [GlobalRdrElt] -> TcRn () +addDupDeclErr [] = panic "addDupDeclErr: empty list" +addDupDeclErr gres@(gre : _) = addErrAt (getSrcSpan (last sorted_names)) $ -- Report the error at the later location vcat [ptext (sLit "Multiple declarations of") <+> @@ -1776,7 +1763,8 @@ addDupDeclErr names@(name : _) ptext (sLit "Declared at:") <+> vcat (map (ppr . nameSrcLoc) sorted_names)] where - sorted_names = sortWith nameSrcLoc names + name = gre_name gre + sorted_names = sortWith nameSrcLoc (map gre_name gres) dupExportWarn :: OccName -> IE RdrName -> IE RdrName -> SDoc dupExportWarn occ_name ie1 ie2 diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs index e31ce86503..c34241018a 100644 --- a/compiler/typecheck/TcEnv.hs +++ b/compiler/typecheck/TcEnv.hs @@ -25,7 +25,8 @@ module TcEnv( tcExtendTyVarEnv, tcExtendTyVarEnv2, tcExtendLetEnv, tcExtendLetEnvIds, tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2, - tcExtendIdBndrs, tcExtendGhciIdEnv, + tcExtendIdBndrs, tcExtendLocalTypeEnv, + isClosedLetBndr, tcLookup, tcLookupLocated, tcLookupLocalIds, tcLookupId, tcLookupTyVar, @@ -394,46 +395,6 @@ getScopedTyVarBinds = do { lcl_env <- getLclEnv ; return [(name, tv) | ATyVar name tv <- nameEnvElts (tcl_env lcl_env)] } -{- -Note [Initialising the type environment for GHCi] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -tcExtendGhciIdEnv extends the local type environemnt with GHCi -identifiers (from ic_tythings), bound earlier in the interaction. -They may have free type variables (RuntimeUnk things), and if we don't -register these free TyVars as global TyVars then the typechecker will -try to quantify over them and fall over in zonkQuantifiedTyVar. -So we must add any free TyVars to the typechecker's global -TyVar set. That is most conveniently done here, using the local function -tcExtendLocalTypeEnv. - -Note especially that - - * tcExtendGhciIdEnv extends the local type env, tcl_env - That's important because some are not closed (ie have free tyvars) - and the compiler assumes that the global type env (tcg_type_env) has - no free tyvars. Actually, only ones with Internal names can be non-closed - so we just add those - - * The tct_closed flag depends on whether the thing has free (RuntimeUnk) - type variables - - * It will also does tcExtendGlobalTyVars; this is important - because of those RuntimeUnk variables - - * It does not extend the local RdrEnv (tcl_rdr), because the things are - already in the GlobalRdrEnv. Extending the local RdrEnv isn't terrible, - but it means there is an entry for the same Name in both global and local - RdrEnvs, and that lead to duplicate "perhaps you meant..." suggestions - (e.g. T5564). - - We don't bother with the tcl_th_bndrs environment either. - - * NB: all these TcTyThings will be in the global type envt (tcg_type_env) as - well. We are just shadowing them here to deal with the global tyvar - stuff. That's why we can simply drop the External-Name ones; they - will be found in the global envt --} - isClosedLetBndr :: Id -> TopLevelFlag -- See Note [Bindings with closed types] in TcRnTypes -- Note that we decided if a let-bound variable is closed by @@ -443,19 +404,6 @@ isClosedLetBndr id | isEmptyVarSet (tyVarsOfType (idType id)) = TopLevel | otherwise = NotTopLevel -tcExtendGhciIdEnv :: [TyThing] -> TcM a -> TcM a --- Used to bind Ids for GHCi identifiers bound earlier in the user interaction --- See Note [Initialising the type environment for GHCi] -tcExtendGhciIdEnv ids thing_inside - = do { lcl_env <- tcExtendLocalTypeEnv tc_ty_things - ; setLclEnv lcl_env thing_inside } - where - tc_ty_things = [ (name, ATcId { tct_id = id - , tct_closed = isClosedLetBndr id }) - | AnId id <- ids - , let name = idName id - , isInternalName name ] - tcExtendLetEnv :: TopLevelFlag -> [TcId] -> TcM a -> TcM a -- Used for both top-level value bindings and and nested let/where-bindings -- Adds to the TcIdBinderStack too @@ -510,7 +458,8 @@ tc_extend_local_env top_lvl extra_env thing_inside -- that are bound together with extra_env and should not be regarded -- as free in the types of extra_env. = do { traceTc "env2" (ppr extra_env) - ; env1 <- tcExtendLocalTypeEnv extra_env + ; env0 <- getLclEnv + ; env1 <- tcExtendLocalTypeEnv env0 extra_env ; stage <- getStage ; let env2 = extend_local_env (top_lvl, thLevel stage) extra_env env1 ; setLclEnv env2 thing_inside } @@ -528,14 +477,12 @@ tc_extend_local_env top_lvl extra_env thing_inside , tcl_th_bndrs = extendNameEnvList th_bndrs -- We only track Ids in tcl_th_bndrs [(n, thlvl) | (n, ATcId {}) <- pairs] } -tcExtendLocalTypeEnv :: [(Name, TcTyThing)] -> TcM TcLclEnv -tcExtendLocalTypeEnv tc_ty_things +tcExtendLocalTypeEnv :: TcLclEnv -> [(Name, TcTyThing)] -> TcM TcLclEnv +tcExtendLocalTypeEnv lcl_env@(TcLclEnv { tcl_env = lcl_type_env }) tc_ty_things | isEmptyVarSet extra_tvs - = do { lcl_env@(TcLclEnv { tcl_env = lcl_type_env }) <- getLclEnv - ; return (lcl_env { tcl_env = extendNameEnvList lcl_type_env tc_ty_things } ) } + = return (lcl_env { tcl_env = extendNameEnvList lcl_type_env tc_ty_things }) | otherwise - = do { lcl_env@(TcLclEnv { tcl_env = lcl_type_env }) <- getLclEnv - ; global_tvs <- readMutVar (tcl_tyvars lcl_env) + = do { global_tvs <- readMutVar (tcl_tyvars lcl_env) ; new_g_var <- newMutVar (global_tvs `unionVarSet` extra_tvs) ; return (lcl_env { tcl_tyvars = new_g_var , tcl_env = extendNameEnvList lcl_type_env tc_ty_things } ) } diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 1df1ca3b8a..b0d02f0da2 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -28,6 +28,17 @@ module TcRnDriver ( #ifdef GHCI import {-# SOURCE #-} TcSplice ( runQuasi ) import RnSplice ( rnTopSpliceDecls, traceSplice, SpliceInfo(..) ) +import IfaceEnv( externaliseName ) +import TcType ( isUnitTy, isTauTy ) +import TcHsType +import TcMatches +import RnTypes +import RnExpr +import MkId +import TidyPgm ( globaliseAndTidyId ) +import TysWiredIn ( unitTy, mkListTy ) +import DynamicLoading ( loadPlugins ) +import Plugins ( tcPlugin ) #endif import DynFlags @@ -58,6 +69,7 @@ import MkIface import TcSimplify import TcTyClsDecls import LoadIface +import TidyPgm ( mkBootModDetailsTc ) import RnNames import RnEnv import RnSource @@ -80,25 +92,11 @@ import ConLike import DataCon import Type import Class +import BasicTypes hiding( SuccessFlag(..) ) import CoAxiom import Annotations import Data.List ( sortBy ) import Data.Ord -#ifdef GHCI -import BasicTypes hiding( SuccessFlag(..) ) -import TcType ( isUnitTy, isTauTy ) -import TcHsType -import TcMatches -import RnTypes -import RnExpr -import MkId -import TidyPgm ( globaliseAndTidyId ) -import TysWiredIn ( unitTy, mkListTy ) -import DynamicLoading ( loadPlugins ) -import Plugins ( tcPlugin ) -#endif -import TidyPgm ( mkBootModDetailsTc ) - import FastString import Maybes import Util @@ -1420,7 +1418,7 @@ runTcInteractive hsc_env thing_inside case i of IIModule n -> getOrphans n IIDecl i -> getOrphans (unLoc (ideclName i)) - ; gbl_env <- getGblEnv + ; (gbl_env, lcl_env) <- getEnvs ; let gbl_env' = gbl_env { tcg_rdr_env = ic_rn_gbl_env icxt , tcg_type_env = type_env @@ -1444,26 +1442,65 @@ runTcInteractive hsc_env thing_inside -- TODO: Cache this } - ; setGblEnv gbl_env' $ - tcExtendGhciIdEnv ty_things $ -- See Note [Initialising the type environment for GHCi] - thing_inside } -- in TcEnv + ; lcl_env' <- tcExtendLocalTypeEnv lcl_env lcl_ids + ; setEnvs (gbl_env', lcl_env') thing_inside } where (home_insts, home_fam_insts) = hptInstances hsc_env (\_ -> True) - icxt = hsc_IC hsc_env - (ic_insts, ic_finsts) = ic_instances icxt - ty_things = ic_tythings icxt + icxt = hsc_IC hsc_env + (ic_insts, ic_finsts) = ic_instances icxt + (lcl_ids, top_ty_things) = partitionWith is_closed (ic_tythings icxt) + + is_closed :: TyThing -> Either (Name, TcTyThing) TyThing + -- Put Ids with free type variables (always RuntimeUnks) + -- in the *local* type environment + -- See Note [Initialising the type environment for GHCi] + is_closed thing + | AnId id <- thing + , NotTopLevel <- isClosedLetBndr id + = Left (idName id, ATcId { tct_id = id, tct_closed = NotTopLevel }) + | otherwise + = Right thing - type_env1 = mkTypeEnvWithImplicits ty_things + type_env1 = mkTypeEnvWithImplicits top_ty_things type_env = extendTypeEnvWithIds type_env1 (map instanceDFunId ic_insts) -- Putting the dfuns in the type_env -- is just to keep Core Lint happy con_fields = [ (dataConName c, dataConFieldLabels c) - | ATyCon t <- ty_things + | ATyCon t <- top_ty_things , c <- tyConDataCons t ] +{- Note [Initialising the type environment for GHCi] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Most of the the Ids in ic_things, defined by the user in 'let' stmts, +have closed types. E.g. + ghci> let foo x y = x && not y + +However the GHCi debugger creates top-level bindings for Ids whose +types have free RuntimeUnk skolem variables, standing for unknown +types. If we don't register these free TyVars as global TyVars then +the typechecker will try to quantify over them and fall over in +zonkQuantifiedTyVar. so we must add any free TyVars to the +typechecker's global TyVar set. That is most conveniently by using +tcExtendLocalTypeEnv, which automatically extends the global TyVar +set. + +We do this by splitting out the Ids with open types, using 'is_closed' +to do the partition. The top-level things go in the global TypeEnv; +the open, NotTopLevel, Ids, with free RuntimeUnk tyvars, go in the +local TypeEnv. + +Note that we don't extend the local RdrEnv (tcl_rdr); all the in-scope +things are already in the interactive context's GlobalRdrEnv. +Extending the local RdrEnv isn't terrible, but it means there is an +entry for the same Name in both global and local RdrEnvs, and that +lead to duplicate "perhaps you meant..." suggestions (e.g. T5564). + +We don't bother with the tcl_th_bndrs environment either. +-} + #ifdef GHCI -- | The returned [Id] is the list of new Ids bound by this statement. It can -- be used to extend the InteractiveContext via extendInteractiveContext. @@ -1485,7 +1522,8 @@ tcRnStmt hsc_env rdr_stmt mapM_ bad_unboxed (filter (isUnLiftedType . idType) zonked_ids) ; traceTc "tcs 1" empty ; - let { global_ids = map globaliseAndTidyId zonked_ids } ; + this_mod <- getModule ; + global_ids <- mapM (externaliseAndTidyId this_mod) zonked_ids ; -- Note [Interactively-bound Ids in GHCi] in HscTypes {- --------------------------------------------- @@ -1715,7 +1753,8 @@ getGhciStepIO :: TcM (LHsExpr Name) getGhciStepIO = do ghciTy <- getGHCiMonad fresh_a <- newUnique - let a_tv = mkTcTyVarName fresh_a (fsLit "a") + loc <- getSrcSpanM + let a_tv = mkInternalName fresh_a (mkTyVarOccFS (fsLit "a")) loc ghciM = nlHsAppTy (nlHsTyVar ghciTy) (nlHsTyVar a_tv) ioM = nlHsAppTy (nlHsTyVar ioTyConName) (nlHsTyVar a_tv) @@ -1901,8 +1940,7 @@ tcRnDeclsi hsc_env local_decls = <- zonkTopDecls all_ev_binds binds Nothing sig_ns rules vects imp_specs fords - let --global_ids = map globaliseAndTidyId bind_ids - final_type_env = extendTypeEnvWithIds type_env bind_ids --global_ids + let final_type_env = extendTypeEnvWithIds type_env bind_ids tcg_env' = tcg_env { tcg_binds = binds', tcg_ev_binds = ev_binds', tcg_imp_specs = imp_specs', @@ -1912,6 +1950,12 @@ tcRnDeclsi hsc_env local_decls = setGlobalTypeEnv tcg_env' final_type_env + +externaliseAndTidyId :: Module -> Id -> TcM Id +externaliseAndTidyId this_mod id + = do { name' <- externaliseName this_mod (idName id) + ; return (globaliseAndTidyId (setIdName id name')) } + #endif /* GHCi */ {- diff --git a/testsuite/tests/ghci.debugger/scripts/break027.stdout b/testsuite/tests/ghci.debugger/scripts/break027.stdout index bac674b946..903b7b772a 100644 --- a/testsuite/tests/ghci.debugger/scripts/break027.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break027.stdout @@ -1,9 +1,9 @@ -Breakpoint 0 activated at ../QSort.hs:(4,1)-(6,55) -Stopped at ../QSort.hs:(4,1)-(6,55) -_result :: [t] = _ -Stopped at ../QSort.hs:5:16-51 -_result :: [Integer] = _ -a :: Integer = 3 -left :: [Integer] = _ -right :: [Integer] = _ -a :: Integer -- Defined at <no location info> +Breakpoint 0 activated at ..\QSort.hs:(4,1)-(6,55)
+Stopped at ..\QSort.hs:(4,1)-(6,55)
+_result :: [t] = _
+Stopped at ..\QSort.hs:5:16-51
+_result :: [Integer] = _
+a :: Integer = 3
+left :: [Integer] = _
+right :: [Integer] = _
+a :: Integer -- Defined in ‘interactive:Ghci2’
diff --git a/testsuite/tests/ghci/scripts/T10248.stderr b/testsuite/tests/ghci/scripts/T10248.stderr index 1245b994fd..8133ee585a 100644 --- a/testsuite/tests/ghci/scripts/T10248.stderr +++ b/testsuite/tests/ghci/scripts/T10248.stderr @@ -1,18 +1,16 @@ - -<interactive>:3:10: warning: - Found hole ‘_’ with type: IO () - In the second argument of ‘(<$>)’, namely ‘_’ - In the first argument of ‘ghciStepIO :: - IO a_alT -> IO a_alT’, namely - ‘Just <$> _’ - In a stmt of an interactive GHCi command: - it <- ghciStepIO :: IO a_alT -> IO a_alT (Just <$> _) -*** Exception: <interactive>:3:10: error: - Found hole ‘_’ with type: IO () - In the second argument of ‘(<$>)’, namely ‘_’ - In the first argument of ‘ghciStepIO :: - IO a_alT -> IO a_alT’, namely - ‘Just <$> _’ - In a stmt of an interactive GHCi command: - it <- ghciStepIO :: IO a_alT -> IO a_alT (Just <$> _) -(deferred type error) +
+<interactive>:3:10: warning:
+ Found hole ‘_’ with type: IO ()
+ In the second argument of ‘(<$>)’, namely ‘_’
+ In the first argument of ‘ghciStepIO :: IO a -> IO a’, namely
+ ‘Just <$> _’
+ In a stmt of an interactive GHCi command:
+ it <- ghciStepIO :: IO a -> IO a (Just <$> _)
+*** Exception: <interactive>:3:10: error:
+ Found hole ‘_’ with type: IO ()
+ In the second argument of ‘(<$>)’, namely ‘_’
+ In the first argument of ‘ghciStepIO :: IO a -> IO a’, namely
+ ‘Just <$> _’
+ In a stmt of an interactive GHCi command:
+ it <- ghciStepIO :: IO a -> IO a (Just <$> _)
+(deferred type error)
diff --git a/testsuite/tests/ghci/scripts/T5564.stderr b/testsuite/tests/ghci/scripts/T5564.stderr index c358dab319..deba7e2b78 100644 --- a/testsuite/tests/ghci/scripts/T5564.stderr +++ b/testsuite/tests/ghci/scripts/T5564.stderr @@ -1,9 +1,10 @@ - -<interactive>:3:1: - Not in scope: ‘git’ - Perhaps you meant ‘it’ (line 2) - -<interactive>:5:1: - Not in scope: ‘fit’ - Perhaps you meant one of these: - ‘fst’ (imported from Prelude), ‘it’ (line 4) +
+<interactive>:3:1: error:
+ Not in scope: ‘git’
+ Perhaps you meant ‘it’ (line 2)
+
+<interactive>:5:1: error:
+ Not in scope: ‘fit’
+ Perhaps you meant one of these:
+ ‘fst’ (imported from Prelude), ‘Ghci1.it’ (imported from Ghci1),
+ ‘it’ (line 4)
diff --git a/testsuite/tests/module/mod110.stderr b/testsuite/tests/module/mod110.stderr index 1018f69f0d..815da10602 100644 --- a/testsuite/tests/module/mod110.stderr +++ b/testsuite/tests/module/mod110.stderr @@ -1,7 +1,7 @@ - -mod110.hs:11:10: - Ambiguous occurrence ‘Eq’ - It could refer to either ‘M.Eq’, defined at mod110.hs:7:1 - or ‘Prelude.Eq’, - imported from ‘Prelude’ at mod110.hs:4:1-14 - (and originally defined in ‘GHC.Classes’) +
+mod110.hs:11:10: error:
+ Ambiguous occurrence ‘Eq’
+ It could refer to either ‘Prelude.Eq’,
+ imported from ‘Prelude’ at mod110.hs:4:1-14
+ (and originally defined in ‘GHC.Classes’)
+ or ‘M.Eq’, defined at mod110.hs:7:1
diff --git a/testsuite/tests/module/mod151.stderr b/testsuite/tests/module/mod151.stderr index 9f750584f0..3feab8e7ba 100644 --- a/testsuite/tests/module/mod151.stderr +++ b/testsuite/tests/module/mod151.stderr @@ -1,7 +1,7 @@ - -mod151.hs:2:20: - Ambiguous occurrence ‘id’ - It could refer to either ‘M.id’, defined at mod151.hs:2:30 - or ‘Prelude.id’, - imported from ‘Prelude’ at mod151.hs:2:8 - (and originally defined in ‘GHC.Base’) +
+mod151.hs:2:20: error:
+ Ambiguous occurrence ‘id’
+ It could refer to either ‘Prelude.id’,
+ imported from ‘Prelude’ at mod151.hs:2:8
+ (and originally defined in ‘GHC.Base’)
+ or ‘M.id’, defined at mod151.hs:2:30
diff --git a/testsuite/tests/module/mod152.stderr b/testsuite/tests/module/mod152.stderr index 3c96bc1270..d0106d44a6 100644 --- a/testsuite/tests/module/mod152.stderr +++ b/testsuite/tests/module/mod152.stderr @@ -1,14 +1,7 @@ - -mod152.hs:2:26: - Ambiguous occurrence ‘id’ - It could refer to either ‘M.id’, defined at mod152.hs:2:36 - or ‘Prelude.id’, - imported from ‘Prelude’ at mod152.hs:2:8 - (and originally defined in ‘GHC.Base’) - -mod152.hs:2:26: - Conflicting exports for ‘id’: - ‘module Prelude’ exports ‘Prelude.id’ - imported from ‘Prelude’ at mod152.hs:2:8 - (and originally defined in ‘GHC.Base’) - ‘id’ exports ‘M.id’ defined at mod152.hs:2:36 +
+mod152.hs:2:26: error:
+ Ambiguous occurrence ‘id’
+ It could refer to either ‘Prelude.id’,
+ imported from ‘Prelude’ at mod152.hs:2:8
+ (and originally defined in ‘GHC.Base’)
+ or ‘M.id’, defined at mod152.hs:2:36
diff --git a/testsuite/tests/module/mod153.stderr b/testsuite/tests/module/mod153.stderr index fa5283b9ef..8f45a03063 100644 --- a/testsuite/tests/module/mod153.stderr +++ b/testsuite/tests/module/mod153.stderr @@ -1,7 +1,7 @@ - -mod153.hs:2:11: - Ambiguous occurrence ‘id’ - It could refer to either ‘M.id’, defined at mod153.hs:2:21 - or ‘Prelude.id’, - imported from ‘Prelude’ at mod153.hs:2:8 - (and originally defined in ‘GHC.Base’) +
+mod153.hs:2:11: error:
+ Ambiguous occurrence ‘id’
+ It could refer to either ‘Prelude.id’,
+ imported from ‘Prelude’ at mod153.hs:2:8
+ (and originally defined in ‘GHC.Base’)
+ or ‘M.id’, defined at mod153.hs:2:21
diff --git a/testsuite/tests/rename/should_compile/T1972.stderr b/testsuite/tests/rename/should_compile/T1972.stderr index 0f450fc023..e19b08eece 100644 --- a/testsuite/tests/rename/should_compile/T1972.stderr +++ b/testsuite/tests/rename/should_compile/T1972.stderr @@ -1,12 +1,12 @@ - -T1972.hs:12:3: Warning: - This binding for ‘name’ shadows the existing binding - defined at T1972.hs:9:19 - -T1972.hs:14:3: Warning: - This binding for ‘mapAccumL’ shadows the existing bindings - defined at T1972.hs:16:1 - imported from ‘Data.List’ at T1972.hs:7:1-16 - (and originally defined in ‘Data.Traversable’) - -T1972.hs:20:10: Warning: Defined but not used: ‘c’ +
+T1972.hs:12:3: warning:
+ This binding for ‘name’ shadows the existing binding
+ defined at T1972.hs:9:19
+
+T1972.hs:14:3: warning:
+ This binding for ‘mapAccumL’ shadows the existing bindings
+ imported from ‘Data.List’ at T1972.hs:7:1-16
+ (and originally defined in ‘Data.Traversable’)
+ defined at T1972.hs:16:1
+
+T1972.hs:20:10: warning: Defined but not used: ‘c’
diff --git a/testsuite/tests/rename/should_fail/T5533.stderr b/testsuite/tests/rename/should_fail/T5533.stderr index 5d514685d4..2c8d761667 100644 --- a/testsuite/tests/rename/should_fail/T5533.stderr +++ b/testsuite/tests/rename/should_fail/T5533.stderr @@ -1,4 +1,4 @@ - -T5533.hs:4:1: - The type signature for ‘f2’ lacks an accompanying binding - (You cannot give a type signature for a record selector or class method) +
+T5533.hs:4:1: error:
+ The type signature for ‘f2’ lacks an accompanying binding
+ (The type signature must be given where ‘f2’ is declared)
diff --git a/testsuite/tests/rename/should_fail/T7906.stderr b/testsuite/tests/rename/should_fail/T7906.stderr index 3f06d8b2fb..e2b3e13008 100644 --- a/testsuite/tests/rename/should_fail/T7906.stderr +++ b/testsuite/tests/rename/should_fail/T7906.stderr @@ -1,4 +1,4 @@ - -T7906.hs:5:16: - The INLINABLE pragma for ‘foo’ lacks an accompanying binding - (You cannot give a INLINABLE pragma for a record selector or class method) +
+T7906.hs:5:16: error:
+ The INLINABLE pragma for ‘foo’ lacks an accompanying binding
+ (The INLINABLE pragma must be given where ‘foo’ is declared)
diff --git a/testsuite/tests/rename/should_fail/rn_dup.stderr b/testsuite/tests/rename/should_fail/rn_dup.stderr index 961e420ac7..db6767a635 100644 --- a/testsuite/tests/rename/should_fail/rn_dup.stderr +++ b/testsuite/tests/rename/should_fail/rn_dup.stderr @@ -1,22 +1,30 @@ - -rn_dup.hs:9:10: - Multiple declarations of ‘MkT’ - Declared at: rn_dup.hs:7:10 - rn_dup.hs:7:16 - rn_dup.hs:9:10 - -rn_dup.hs:12:16: - Multiple declarations of ‘rf’ - Declared at: rn_dup.hs:11:16 - rn_dup.hs:11:27 - rn_dup.hs:12:16 - -rn_dup.hs:17:3: - Multiple declarations of ‘CT’ - Declared at: rn_dup.hs:15:3 - rn_dup.hs:17:3 - -rn_dup.hs:18:3: - Multiple declarations of ‘f’ - Declared at: rn_dup.hs:16:3 - rn_dup.hs:18:3 +
+rn_dup.hs:9:10: error:
+ Multiple declarations of ‘MkT’
+ Declared at: rn_dup.hs:7:10
+ rn_dup.hs:9:10
+
+rn_dup.hs:9:10: error:
+ Multiple declarations of ‘MkT’
+ Declared at: rn_dup.hs:7:16
+ rn_dup.hs:9:10
+
+rn_dup.hs:12:16: error:
+ Multiple declarations of ‘rf’
+ Declared at: rn_dup.hs:11:16
+ rn_dup.hs:12:16
+
+rn_dup.hs:12:16: error:
+ Multiple declarations of ‘rf’
+ Declared at: rn_dup.hs:11:27
+ rn_dup.hs:12:16
+
+rn_dup.hs:17:3: error:
+ Multiple declarations of ‘CT’
+ Declared at: rn_dup.hs:15:3
+ rn_dup.hs:17:3
+
+rn_dup.hs:18:3: error:
+ Multiple declarations of ‘f’
+ Declared at: rn_dup.hs:16:3
+ rn_dup.hs:18:3
diff --git a/testsuite/tests/rename/should_fail/rnfail044.stderr b/testsuite/tests/rename/should_fail/rnfail044.stderr index eef15b2209..4cfb3e4d23 100644 --- a/testsuite/tests/rename/should_fail/rnfail044.stderr +++ b/testsuite/tests/rename/should_fail/rnfail044.stderr @@ -1,7 +1,7 @@ - -rnfail044.hs:5:12: - Ambiguous occurrence ‘splitAt’ - It could refer to either ‘A.splitAt’, defined at rnfail044.hs:8:3 - or ‘Data.List.splitAt’, - imported from ‘Prelude’ at rnfail044.hs:5:8 - (and originally defined in ‘GHC.List’) +
+rnfail044.hs:5:12: error:
+ Ambiguous occurrence ‘splitAt’
+ It could refer to either ‘Data.List.splitAt’,
+ imported from ‘Prelude’ at rnfail044.hs:5:8
+ (and originally defined in ‘GHC.List’)
+ or ‘A.splitAt’, defined at rnfail044.hs:8:3
diff --git a/testsuite/tests/th/T7241.stderr b/testsuite/tests/th/T7241.stderr index 343cdc827d..15c554175c 100644 --- a/testsuite/tests/th/T7241.stderr +++ b/testsuite/tests/th/T7241.stderr @@ -1,6 +1,8 @@ - -T7241.hs:7:3: - Duplicate exact Name ‘Foo’ - Probable cause: you used a unique Template Haskell name (NameU), - perhaps via newName, but bound it multiple times - If that's it, then -ddump-splices might be useful +
+T7241.hs:7:3: error:
+ Same exact name in multiple name-spaces:
+ type constructor or class ‘Foo’, declared at: T7241.hs:7:3
+ data constructor ‘Foo’, declared at: T7241.hs:7:3
+ Probable cause: you bound a unique Template Haskell name (NameU),
+ perhaps via newName, in different name-spaces.
+ If that's it, then -ddump-splices might be useful
diff --git a/testsuite/tests/th/T8932.stderr b/testsuite/tests/th/T8932.stderr index c861235091..68fb024938 100644 --- a/testsuite/tests/th/T8932.stderr +++ b/testsuite/tests/th/T8932.stderr @@ -1,11 +1,5 @@ - -T8932.hs:5:3: - Duplicate exact Name ‘foo’ - Probable cause: you used a unique Template Haskell name (NameU), - perhaps via newName, but bound it multiple times - If that's it, then -ddump-splices might be useful - -T8932.hs:11:1: - Multiple declarations of ‘foo’ - Declared at: T8932.hs:5:3 - T8932.hs:11:1 +
+T8932.hs:11:1: error:
+ Multiple declarations of ‘foo’
+ Declared at: T8932.hs:5:3
+ T8932.hs:11:1
diff --git a/testsuite/tests/typecheck/should_fail/tcfail037.stderr b/testsuite/tests/typecheck/should_fail/tcfail037.stderr index 5ada45cc84..eefd822973 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail037.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail037.stderr @@ -1,8 +1,7 @@ - -tcfail037.hs:7:11: - Ambiguous occurrence ‘+’ - It could refer to either ‘ShouldFail.+’, - defined at tcfail037.hs:10:5 - or ‘Prelude.+’, - imported from ‘Prelude’ at tcfail037.hs:3:8-17 - (and originally defined in ‘GHC.Num’) +
+tcfail037.hs:7:11: error:
+ Ambiguous occurrence ‘+’
+ It could refer to either ‘Prelude.+’,
+ imported from ‘Prelude’ at tcfail037.hs:3:8-17
+ (and originally defined in ‘GHC.Num’)
+ or ‘ShouldFail.+’, defined at tcfail037.hs:10:5
|