X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnEnv.lhs;h=10fe8f61b093bbc5515fe52bfe7dcc0fa70f80b7;hb=ba58028475f0607b880ea3cad9cb646f90011092;hp=f5f3eabc9301b1c8eeae35af663fde6af22a9b0c;hpb=e0445ffa5a89632b542e7d7bc2ad46d944716453;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index f5f3eab..10fe8f6 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -31,7 +31,7 @@ import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv, import TcRnMonad import Name ( Name, getName, getSrcLoc, nameIsLocalOrFrom, isWiredInName, mkInternalName, mkExternalName, mkIPName, nameSrcLoc, - nameOccName, setNameModuleAndLoc, nameModule ) + nameOccName, setNameSrcLoc, nameModule ) import NameSet import OccName ( OccName, tcName, isDataOcc, occNameUserString, occNameFlavour ) import Module ( Module, ModuleName, moduleName, mkHomeModule, @@ -66,19 +66,15 @@ import FastString ( FastString ) \begin{code} newTopBinder :: Module -> RdrName -> SrcLoc -> TcRn m Name - -- newTopBinder puts into the cache the binder with the - -- module information set correctly. When the decl is later renamed, - -- the binding site will thereby get the correct module. - -- There maybe occurrences that don't have the correct Module, but - -- by the typechecker will propagate the binding definition to all - -- the occurrences, so that doesn't matter - newTopBinder mod rdr_name loc | Just name <- isExact_maybe rdr_name = returnM name | otherwise - = newGlobalName mod (rdrNameOcc rdr_name) loc + = ASSERT( not (isOrig rdr_name) || rdrNameModule rdr_name == moduleName mod ) + -- When reading External Core we get Orig names as binders, + -- but they should agree with the module gotten from the monad + newGlobalName mod (rdrNameOcc rdr_name) loc newGlobalName :: Module -> OccName -> SrcLoc -> TcRn m Name newGlobalName mod occ loc @@ -88,15 +84,21 @@ newGlobalName mod occ loc -- A hit in the cache! We are at the binding site of the name. -- This is the moment when we know the defining SrcLoc - -- of the Name. However, since we must have encountered an - -- occurrence before the binding site, this must be an - -- implicitly-imported name and we can't give a useful SrcLoc to - -- it. So we just leave it alone. + -- of the Name, so we set the SrcLoc of the name we return. + -- + -- Main reason: then (bogus) multiple bindings of the same Name + -- get different SrcLocs can can be reported as such. -- - -- IMPORTANT: don't mess with wired-in names. - -- Their wired-in-ness is in the SrcLoc + -- Possible other reason: it might be in the cache because we + -- encountered an occurrence before the binding site for an + -- implicitly-imported Name. Perhaps the current SrcLoc is + -- better... but not really: it'll still just say 'imported' + -- + -- IMPORTANT: Don't mess with wired-in names. + -- Their wired-in-ness is in the SrcLoc - Just name -> returnM name + Just name | isWiredInName name -> returnM name + | otherwise -> returnM (setNameSrcLoc name loc) -- Miss in the cache! -- Build a completely new Name, and put it in the cache @@ -145,14 +147,14 @@ newGlobalName2 mod_name occ Nothing -> -- No names from this module yet ioToTcRn (findModule mod_name) `thenM` \ mb_loc -> case mb_loc of - Just (mod, _) -> new_name mod - Nothing -> addErr (noModule mod_name) `thenM_` - -- Things have really gone wrong at this point, - -- so having the wrong package info in the - -- Module is the least of our worries. - new_name (mkHomeModule mod_name) - where - noModule mod_name = ptext SLIT("Can't find interface for module") <+> ppr mod_name + Right (mod, _) -> new_name mod + Left files -> + getDOpts `thenM` \ dflags -> + addErr (noIfaceErr dflags mod_name False files) `thenM_` + -- Things have really gone wrong at this point, + -- so having the wrong package info in the + -- Module is the least of our worries. + new_name (mkHomeModule mod_name) newIPName rdr_name_ip @@ -234,19 +236,12 @@ lookupTopBndrRn rdr_name -- A separate function (importsFromLocalDecls) reports duplicate top level -- decls, so here it's safe just to choose an arbitrary one. - -- There should never be a qualified name in a binding position - -- The parser could check this, but doesn't (yet) - | isQual rdr_name - = getSrcLocM `thenM` \ loc -> - qualNameErr (text "In its declaration") (rdr_name,loc) `thenM_` - returnM (mkUnboundName rdr_name) - - | otherwise - = ASSERT( not (isOrig rdr_name) ) - -- Original names are used only for occurrences, - -- not binding sites +-- There should never be a qualified name in a binding position in Haskell, +-- but there can be if we have read in an external-Core file. +-- The Haskell parser checks for the illegal qualified name in Haskell +-- source files, so we don't need to do so here. - getModeRn `thenM` \ mode -> + = getModeRn `thenM` \ mode -> case mode of InterfaceMode mod -> getSrcLocM `thenM` \ loc -> @@ -339,15 +334,12 @@ lookupInstDeclBndr cls_name rdr_name other -> pprPanic "lookupInstDeclBndr" (ppr cls_name) - | isQual rdr_name -- Should never have a qualified name in a binding position - = getSrcLocM `thenM` \ loc -> - qualNameErr (text "In an instance method") (rdr_name,loc) `thenM_` - returnM (mkUnboundName rdr_name) - + | otherwise -- Occurs in derived instances, where we just -- refer directly to the right method, and avail_env -- isn't available = ASSERT2( not (isQual rdr_name), ppr rdr_name ) + -- NB: qualified names are rejected by the parser lookupOrigName rdr_name where @@ -582,19 +574,32 @@ implicitModuleFVs source_fvs namesNeededForFlattening `plusFV` ubiquitousNames + +thProxyName :: NameSet +mkTemplateHaskellFVs :: NameSet -> NameSet -- This is a bit of a hack. When we see the Template-Haskell construct -- [| expr |] -- we are going to need lots of the ``smart constructors'' defined in -- the main Template Haskell data type module. Rather than treat them -- all as free vars at every occurrence site, we just make the Q type -- consructor a free var.... and then use that here to haul in the others -mkTemplateHaskellFVs source_fvs + #ifdef GHCI - -- Only if Template Haskell is enabled +--------------- Template Haskell enabled -------------- +thProxyName = unitFV qTyConName + +mkTemplateHaskellFVs source_fvs | qTyConName `elemNameSet` source_fvs = templateHaskellNames -#endif | otherwise = emptyFVs +#else +--------------- Template Haskell disabled -------------- + +thProxyName = emptyFVs +mkTemplateHaskellFVs source_fvs = emptyFVs +#endif +-------------------------------------------------------- + -- ubiquitous_names are loaded regardless, because -- they are needed in virtually every program ubiquitousNames @@ -820,8 +825,11 @@ checkDupOrQualNames, checkDupNames :: SDoc -- Works in any variant of the renamer monad checkDupOrQualNames doc_str rdr_names_w_loc - = -- Check for use of qualified names - mappM_ (qualNameErr doc_str) quals `thenM_` + = -- Qualified names in patterns are now rejected by the parser + -- but I'm not 100% certain that it finds all cases, so I've left + -- this check in for now. Should go eventually. + -- Hmm. Sooner rather than later.. data type decls +-- mappM_ (qualNameErr doc_str) quals `thenM_` checkDupNames doc_str rdr_names_w_loc where quals = filter (isQual . fst) rdr_names_w_loc @@ -882,7 +890,9 @@ mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails deprecs where occ = nameOccName name elt = GRE {gre_name = name, - gre_parent = parent, + gre_parent = if name == parent + then Nothing + else Just parent, gre_prov = mk_provenance name, gre_deprec = lookupDeprec deprecs name} @@ -978,44 +988,41 @@ warnUnusedLocals names = warnUnusedBinds [(n,LocalDef) | n<-names] warnUnusedBinds :: [(Name,Provenance)] -> TcRn m () warnUnusedBinds names - = mappM_ warnUnusedGroup groups + = mappM_ warnUnusedGroup groups where -- Group by provenance - groups = equivClasses cmp names + groups = equivClasses cmp (filter reportable names) (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2 + reportable (name,_) = case occNameUserString (nameOccName name) of + ('_' : _) -> False + zz_other -> True + -- Haskell 98 encourages compilers to suppress warnings about + -- unused names in a pattern if they start with "_". + ------------------------- warnUnusedGroup :: [(Name,Provenance)] -> TcRn m () warnUnusedGroup names - | null filtered_names = returnM () - | not is_local = returnM () - | otherwise = addSrcLoc def_loc $ - addWarn $ - sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))] + addWarn $ + sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) names)))] where - filtered_names = filter reportable names - (name1, prov1) = head filtered_names - (is_local, def_loc, msg) - = case prov1 of - LocalDef -> (True, getSrcLoc name1, text "Defined but not used") - - NonLocalDef (UserImport mod loc _) - -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used") - - reportable (name,_) = case occNameUserString (nameOccName name) of - ('_' : _) -> False - zz_other -> True - -- Haskell 98 encourages compilers to suppress warnings about - -- unused names in a pattern if they start with "_". + (name1, prov1) = head names + loc1 = getSrcLoc name1 + (def_loc, msg) = case prov1 of + LocalDef -> (loc1, unused_msg) + NonLocalDef (UserImport mod loc _) -> (loc, imp_from mod) + + unused_msg = text "Defined but not used" + imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used" \end{code} \begin{code} addNameClashErrRn rdr_name (np1:nps) = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name), - ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)]) + ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)]) where msg1 = ptext SLIT("either") <+> mk_ref np1 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps] @@ -1046,6 +1053,16 @@ dupNamesErr descriptor ((name,loc) : dup_things) $$ descriptor) +noIfaceErr dflags mod_name boot_file files + = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name) + $$ extra + where + extra + | verbosity dflags < 3 = + text "(use -v to see a list of the files searched for)" + | otherwise = + hang (ptext SLIT("locations searched:")) 4 (vcat (map text files)) + warnDeprec :: GlobalRdrElt -> TcRn m () warnDeprec (GRE {gre_name = name, gre_deprec = Just txt}) = ifOptM Opt_WarnDeprecations $