X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnEnv.lhs;h=2fb2549cfcc594e680f3da566a991a9e5abe7685;hb=487f186dfdf4cab27dd6cf03f7e178f3a4bd491d;hp=710bd6ebce96840908c99086940c0a6ba6e6d60f;hpb=c97ea0ce7025c0fc56b02b171843ed50c00ef75d;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index 710bd6e..2fb2549 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -10,10 +10,10 @@ module RnEnv ( lookupLocatedTopBndrRn, lookupTopBndrRn, lookupLocatedOccRn, lookupOccRn, lookupLocatedGlobalOccRn, lookupGlobalOccRn, - lookupTopFixSigNames, lookupSrcOcc_maybe, + lookupLocalDataTcNames, lookupSrcOcc_maybe, lookupFixityRn, lookupLocatedSigOccRn, lookupLocatedInstDeclBndr, - lookupSyntaxName, lookupSyntaxNames, lookupImportedName, + lookupSyntaxName, lookupSyntaxTable, lookupImportedName, newLocalsRn, newIPNameRn, bindLocalNames, bindLocalNamesFV, @@ -30,11 +30,13 @@ module RnEnv ( #include "HsVersions.h" -import LoadIface ( loadSrcInterface ) +import LoadIface ( loadHomeInterface, loadSrcInterface ) import IfaceEnv ( lookupOrig, newGlobalBinder, newIPName ) -import HsSyn +import HsSyn ( FixitySig(..), HsExpr(..), SyntaxExpr, SyntaxTable, + HsType(..), HsExplicitForAll(..), LHsTyVarBndr, LHsType, + LSig, Sig(..), Fixity, hsLTyVarName, hsLTyVarLocNames, replaceTyVarName ) import RdrHsSyn ( extractHsTyRdrTyVars ) -import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig, +import RdrName ( RdrName, rdrNameModule, isQual, isUnqual, isOrig, mkRdrUnqual, setRdrNameSpace, rdrNameOcc, pprGlobalRdrEnv, lookupGRE_RdrName, isExact_maybe, isSrcRdrName, @@ -42,7 +44,6 @@ import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig, isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv, Provenance(..), pprNameProvenance, ImportSpec(..) ) -import HsTypes ( replaceTyVarName ) import HscTypes ( availNames, ModIface(..), FixItem(..), lookupFixity ) import TcRnMonad import Name ( Name, nameIsLocalOrFrom, mkInternalName, @@ -59,8 +60,7 @@ import Outputable import Util ( sortLe ) import ListSetOps ( removeDups ) import List ( nubBy ) -import CmdLineOpts -import FastString ( FastString ) +import DynFlags \end{code} %********************************************************* @@ -253,7 +253,7 @@ lookupGlobalOccRn rdr_name Nothing -> -- We allow qualified names on the command line to refer to - -- *any* name exported by any module in scope, just as if + -- *any* name exported by any module in scope, just as if -- there was an "import qualified M" declaration for every -- module. getModule `thenM` \ mod -> @@ -338,6 +338,8 @@ lookupQualifiedName rdr_name mod = rdrNameModule rdr_name occ = rdrNameOcc rdr_name in + -- Note: we want to behave as we would for a source file import here, + -- and respect hiddenness of modules/packages, hence loadSrcInterface. loadSrcInterface doc mod False `thenM` \ iface -> case [ (mod,occ) | @@ -359,16 +361,21 @@ lookupQualifiedName rdr_name %********************************************************* \begin{code} -lookupTopFixSigNames :: RdrName -> RnM [Name] +lookupLocalDataTcNames :: RdrName -> RnM [Name] -- GHC extension: look up both the tycon and data con -- for con-like things -lookupTopFixSigNames rdr_name +-- Complain if neither is in scope +lookupLocalDataTcNames rdr_name | Just n <- isExact_maybe rdr_name -- Special case for (:), which doesn't get into the GlobalRdrEnv = return [n] -- For this we don't need to try the tycon too | otherwise = do { mb_gres <- mapM lookupGreLocalRn (dataTcOccs rdr_name) - ; return [gre_name gre | Just gre <- mb_gres] } + ; case [gre_name gre | Just gre <- mb_gres] of + [] -> do { addErr (unknownNameErr rdr_name) + ; return [] } + names -> return names + } -------------------------------- bindLocalFixities :: [FixitySig RdrName] -> RnM a -> RnM a @@ -423,11 +430,13 @@ lookupFixityRn name -- nothing from B will be used). When we come across a use of -- 'f', we need to know its fixity, and it's then, and only -- then, that we load B.hi. That is what's happening here. - loadSrcInterface doc name_mod False `thenM` \ iface -> + -- + -- loadHomeInterface will find B.hi even if B is a hidden module, + -- and that's what we want. + loadHomeInterface doc name `thenM` \ iface -> returnM (mi_fix_fn iface (nameOccName name)) where - doc = ptext SLIT("Checking fixity for") <+> ppr name - name_mod = nameModule name + doc = ptext SLIT("Checking fixity for") <+> ppr name dataTcOccs :: RdrName -> [RdrName] -- If the input is a data constructor, return both it and a type @@ -481,7 +490,7 @@ At the moment this just happens for We store the relevant Name in the HsSyn tree, in * HsIntegral/HsFractional * NegApp - * NPlusKPatIn + * NPlusKPat * HsDo respectively. Initially, we just store the "standard" name (PrelNames.fromIntegralName, fromRationalName etc), but the renamer changes this to the appropriate user @@ -491,21 +500,21 @@ We treat the orignal (standard) names as free-vars too, because the type checker checks the type of the user thing against the type of the standard thing. \begin{code} -lookupSyntaxName :: Name -- The standard name - -> RnM (Name, FreeVars) -- Possibly a non-standard name +lookupSyntaxName :: Name -- The standard name + -> RnM (SyntaxExpr Name, FreeVars) -- Possibly a non-standard name lookupSyntaxName std_name = doptM Opt_ImplicitPrelude `thenM` \ implicit_prelude -> if implicit_prelude then normal_case else -- Get the similarly named thing from the local environment lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name -> - returnM (usr_name, unitFV usr_name) + returnM (HsVar usr_name, unitFV usr_name) where - normal_case = returnM (std_name, emptyFVs) + normal_case = returnM (HsVar std_name, emptyFVs) -lookupSyntaxNames :: [Name] -- Standard names - -> RnM (ReboundNames Name, FreeVars) -- See comments with HsExpr.ReboundNames -lookupSyntaxNames std_names +lookupSyntaxTable :: [Name] -- Standard names + -> RnM (SyntaxTable Name, FreeVars) -- See comments with HsExpr.ReboundNames +lookupSyntaxTable std_names = doptM Opt_ImplicitPrelude `thenM` \ implicit_prelude -> if implicit_prelude then normal_case else @@ -741,12 +750,11 @@ warnUnusedName (name, prov) -- TODO should be a proper span where (loc,msg) = case prov of - Just (Imported is _) -> - ( is_loc (head is), imp_from (is_mod imp_spec) ) - where - imp_spec = head is - other -> - ( srcLocSpan (nameSrcLoc name), unused_msg ) + Just (Imported is) + -> (is_loc imp_spec, imp_from (is_mod imp_spec)) + where + imp_spec = head is + other -> (srcLocSpan (nameSrcLoc name), unused_msg) unused_msg = text "Defined but not used" imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"