X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2Frename%2FRnEnv.lhs;h=10fe8f61b093bbc5515fe52bfe7dcc0fa70f80b7;hb=ba58028475f0607b880ea3cad9cb646f90011092;hp=689d9a3f13fdc1e82c90b3bbaf062f91b6561b7a;hpb=ff8cd2c58cdc05c05964a631664a9347a86f8964;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index 689d9a3..10fe8f6 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -71,7 +71,10 @@ newTopBinder mod rdr_name loc = 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 @@ -144,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 @@ -233,16 +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 in Haskell, - -- but there can be if we have read in an external-Core file. - -- The Haskell parser checks for the illegal qualified name, so we - -- don't need to do so here. - - = 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 -> @@ -829,7 +828,8 @@ checkDupOrQualNames doc_str rdr_names_w_loc = -- 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. - mappM_ (qualNameErr doc_str) quals `thenM_` + -- 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 @@ -890,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} @@ -986,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] @@ -1054,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 $