X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=43063beddb43b7fe6c03a882595b93599e777be0;hp=85cf73e2e1f61bf8d6da074e38a935a69cdccdb2;hb=deda0c55629600e886f47a5e90bad67953df1ad8;hpb=c1681a73fa4ca4cf8758264ae387ac09a9e900d8 diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 85cf73e..43063be 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -4,6 +4,13 @@ \section[HscTypes]{Types for the per-module compiler} \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module HscTypes ( -- * Sessions and compilation state Session(..), withSession, modifySession, @@ -78,9 +85,7 @@ import ByteCodeAsm ( CompiledByteCode ) import {-# SOURCE #-} InteractiveEval ( Resume ) #endif -import RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv, GlobalRdrElt(..), - mkRdrUnqual, ImpDeclSpec(..), Provenance(..), - ImportSpec(..), lookupGlobalRdrEnv, lookupGRE_RdrName ) +import RdrName import Name ( Name, NamedThing, getName, nameOccName, nameModule ) import NameEnv import NameSet @@ -101,7 +106,7 @@ import Class ( Class, classSelIds, classATs, classTyCon ) import TyCon import DataCon ( DataCon, dataConImplicitIds ) import PrelNames ( gHC_PRIM ) -import Packages ( PackageId ) +import Packages hiding ( Version(..) ) import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) ) import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase ) import BasicTypes ( Version, initialVersion, IPName, @@ -117,6 +122,7 @@ import UniqFM ( lookupUFM, eltsUFM, emptyUFM ) import UniqSupply ( UniqSupply ) import FastString ( FastString ) import StringBuffer ( StringBuffer ) +import Util import System.Time ( ClockTime ) import Data.IORef @@ -492,7 +498,6 @@ data ModDetails md_insts :: ![Instance], -- Dfun-ids for the instances in this module md_fam_insts :: ![FamInst], md_rules :: ![CoreRule], -- Domain may include Ids from other modules - md_modBreaks :: !ModBreaks, -- Breakpoint information for this module md_vect_info :: !VectInfo -- Vectorisation information } @@ -501,7 +506,6 @@ emptyModDetails = ModDetails { md_types = emptyTypeEnv, md_insts = [], md_rules = [], md_fam_insts = [], - md_modBreaks = emptyModBreaks, md_vect_info = noVectInfo } @@ -522,16 +526,9 @@ data ModGuts mg_usages :: ![Usage], -- Version info for what it needed mg_rdr_env :: !GlobalRdrEnv, -- Top-level lexical environment - mg_fix_env :: !FixityEnv, -- Fixity env, for things declared in - -- this module - - mg_inst_env :: InstEnv, -- Class instance enviroment fro - -- *home-package* modules (including - -- this one); c.f. tcg_inst_env - mg_fam_inst_env :: FamInstEnv, -- Type-family instance enviroment - -- for *home-package* modules (including - -- this one); c.f. tcg_fam_inst_env + -- These fields all describe the things **declared in this module** + mg_fix_env :: !FixityEnv, -- Fixities mg_types :: !TypeEnv, mg_insts :: ![Instance], -- Instances mg_fam_insts :: ![FamInst], -- Instances @@ -541,7 +538,19 @@ data ModGuts mg_deprecs :: !Deprecations, -- Deprecations declared in the module mg_hpc_info :: !HpcInfo, -- info about coverage tick boxes mg_modBreaks :: !ModBreaks, - mg_vect_info :: !VectInfo -- Pool of vectorised declarations + mg_vect_info :: !VectInfo, -- Pool of vectorised declarations + + -- The next two fields are unusual, because they give instance + -- environments for *all* modules in the home package, including + -- this module, rather than for *just* this module. + -- Reason: when looking up an instance we don't want to have to + -- look at each module in the home package in turn + mg_inst_env :: InstEnv, -- Class instance enviroment fro + -- *home-package* modules (including + -- this one); c.f. tcg_inst_env + mg_fam_inst_env :: FamInstEnv -- Type-family instance enviroment + -- for *home-package* modules (including + -- this one); c.f. tcg_fam_inst_env } -- The ModGuts takes on several slightly different forms: @@ -579,7 +588,8 @@ data CgGuts cg_foreign :: !ForeignStubs, cg_dep_pkgs :: ![PackageId], -- Used to generate #includes for C code gen - cg_hpc_info :: !HpcInfo -- info about coverage tick boxes + cg_hpc_info :: !HpcInfo, -- info about coverage tick boxes + cg_modBreaks :: !ModBreaks } ----------------------------------- @@ -603,8 +613,6 @@ data ForeignStubs = NoStubs -- "foreign exported" functions [FastString] -- Headers that need to be included -- into C code generated for this module - [Id] -- Foreign-exported binders - -- we have to generate code to register these \end{code} @@ -682,8 +690,8 @@ emptyInteractiveContext #endif } -icPrintUnqual :: InteractiveContext -> PrintUnqualified -icPrintUnqual ictxt = mkPrintUnqualified (ic_rn_gbl_env ictxt) +icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified +icPrintUnqual dflags ictxt = mkPrintUnqualified dflags (ic_rn_gbl_env ictxt) extendInteractiveContext @@ -720,20 +728,44 @@ substInteractiveContext ictxt@InteractiveContext{ic_tmp_ids=ids} subst = %* * %************************************************************************ +Deciding how to print names is pretty tricky. We are given a name +P:M.T, where P is the package name, M is the defining module, and T is +the occurrence name, and we have to decide in which form to display +the name given a GlobalRdrEnv describing the current scope. + +Ideally we want to display the name in the form in which it is in +scope. However, the name might not be in scope at all, and that's +where it gets tricky. Here are the cases: + + 1. T uniquely maps to P:M.T ---> "T" + 2. there is an X for which X.T uniquely maps to P:M.T ---> "X.T" + 3. there is no binding for "M.T" ---> "M.T" + 4. otherwise ---> "P:M.T" + +3 and 4 apply when P:M.T is not in scope. In these cases we want to +refer to the name as "M.T", but "M.T" might mean something else in the +current scope (e.g. if there's an "import X as M"), so to avoid +confusion we avoid using "M.T" if there's already a binding for it. + +There's one further subtlety: if the module M cannot be imported +because it is not exposed by any package, then we must refer to it as +"P:M". This is handled by the qual_mod component of PrintUnqualified. + \begin{code} -mkPrintUnqualified :: GlobalRdrEnv -> PrintUnqualified -mkPrintUnqualified env = (qual_name, qual_mod) +mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified +mkPrintUnqualified dflags env = (qual_name, qual_mod) where qual_name mod occ -- The (mod,occ) pair is the original name of the thing - | [gre] <- unqual_gres, right_name gre = Nothing + | [gre] <- unqual_gres, right_name gre = NameUnqual -- If there's a unique entity that's in scope unqualified with 'occ' -- AND that entity is the right one, then we can use the unqualified name - | [gre] <- qual_gres = Just (get_qual_mod (gre_prov gre)) + | [gre] <- qual_gres = NameQual (get_qual_mod (gre_prov gre)) - | null qual_gres = Just (moduleName mod) - -- it isn't in scope at all, this probably shouldn't happen, - -- but we'll qualify it by the original module anyway. + | null qual_gres = + if null (lookupGRE_RdrName (mkRdrQual (moduleName mod) occ) env) + then NameNotInScope1 + else NameNotInScope2 | otherwise = panic "mkPrintUnqualified" where @@ -745,7 +777,22 @@ mkPrintUnqualified env = (qual_name, qual_mod) get_qual_mod LocalDef = moduleName mod get_qual_mod (Imported is) = ASSERT( not (null is) ) is_as (is_decl (head is)) - qual_mod mod = Nothing -- For now, we never qualify module names with their packages + -- we can mention a module P:M without the P: qualifier iff + -- "import M" would resolve unambiguously to P:M. (if P is the + -- current package we can just assume it is unqualified). + + qual_mod mod + | modulePackageId mod == thisPackage dflags = False + + | [pkgconfig] <- [pkg | (pkg,exposed_module) <- lookup, + exposed pkg && exposed_module], + packageConfigId pkgconfig == modulePackageId mod + -- this says: we are given a module P:M, is there just one exposed package + -- that exposes a module M, and is it package P? + = False + + | otherwise = True + where lookup = lookupModuleInAllPackages dflags (moduleName mod) \end{code} @@ -861,16 +908,16 @@ lookupType dflags hpt pte name \begin{code} tyThingTyCon (ATyCon tc) = tc -tyThingTyCon other = pprPanic "tyThingTyCon" (ppr other) +tyThingTyCon other = pprPanic "tyThingTyCon" (pprTyThing other) tyThingClass (AClass cls) = cls -tyThingClass other = pprPanic "tyThingClass" (ppr other) +tyThingClass other = pprPanic "tyThingClass" (pprTyThing other) tyThingDataCon (ADataCon dc) = dc -tyThingDataCon other = pprPanic "tyThingDataCon" (ppr other) +tyThingDataCon other = pprPanic "tyThingDataCon" (pprTyThing other) tyThingId (AnId id) = id -tyThingId other = pprPanic "tyThingId" (ppr other) +tyThingId other = pprPanic "tyThingId" (pprTyThing other) \end{code} %************************************************************************ @@ -1302,6 +1349,7 @@ data VectInfo vectInfoVar :: VarEnv (Var , Var ), -- (f, f_v) keyed on f vectInfoTyCon :: NameEnv (TyCon , TyCon), -- (T, T_v) keyed on T vectInfoDataCon :: NameEnv (DataCon, DataCon), -- (C, C_v) keyed on C + vectInfoPADFun :: NameEnv (TyCon , Var), -- (T_v, paT) keyed on T_v vectInfoIso :: NameEnv (TyCon , Var) -- (T, isoT) keyed on T } -- all of this is always tidy, even in ModGuts @@ -1325,13 +1373,14 @@ data IfaceVectInfo } noVectInfo :: VectInfo -noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv +noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyNameEnv plusVectInfo :: VectInfo -> VectInfo -> VectInfo plusVectInfo vi1 vi2 = VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2) (vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2) (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2) + (vectInfoPADFun vi1 `plusNameEnv` vectInfoPADFun vi2) (vectInfoIso vi1 `plusNameEnv` vectInfoIso vi2) noIfaceVectInfo :: IfaceVectInfo @@ -1374,7 +1423,7 @@ data Unlinked = DotO FilePath | DotA FilePath | DotDLL FilePath - | BCOs CompiledByteCode + | BCOs CompiledByteCode ModBreaks #ifndef GHCI data CompiledByteCode = NoByteCode @@ -1385,9 +1434,9 @@ instance Outputable Unlinked where ppr (DotA path) = text "DotA" <+> text path ppr (DotDLL path) = text "DotDLL" <+> text path #ifdef GHCI - ppr (BCOs bcos) = text "BCOs" <+> ppr bcos + ppr (BCOs bcos _) = text "BCOs" <+> ppr bcos #else - ppr (BCOs bcos) = text "No byte code" + ppr (BCOs bcos _) = text "No byte code" #endif isObject (DotO _) = True @@ -1402,8 +1451,8 @@ nameOfObject (DotA fn) = fn nameOfObject (DotDLL fn) = fn nameOfObject other = pprPanic "nameOfObject" (ppr other) -byteCodeOfObject (BCOs bc) = bc -byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other) +byteCodeOfObject (BCOs bc _) = bc +byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other) \end{code} %************************************************************************