X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscTypes.lhs;h=c29421c1dd2ac00f64c46648f6ca825c6b09f691;hb=685e04e4af2e2332f2555990122596c7931cb543;hp=2c8757fc605ac32573dd235c3d7dc53fc5c68a00;hpb=972d6442ee3a6ee0a5fa20655d882e0041646892;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index 2c8757f..c29421c 100644
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -26,11 +26,11 @@ module HscTypes (
 
 	TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
 	extendTypeEnvList, extendTypeEnvWithIds,
-	typeEnvClasses, typeEnvTyCons, typeEnvIds,
+	typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
 
 	ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..),
 	PersistentRenamerState(..), IsBootInterface, DeclsMap,
-	IfaceInsts, IfaceRules, GatedDecl, GatedDecls, IsExported,
+	IfaceInsts, IfaceRules, GatedDecl, GatedDecls, GateFn, IsExported,
 	NameSupply(..), OrigNameCache, OrigIParamCache,
 	Avails, AvailEnv, GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
 	PersistentCompilerState(..),
@@ -64,7 +64,7 @@ import Rules		( RuleBase )
 import CoreSyn		( CoreBind )
 import Id		( Id )
 import Class		( Class, classSelIds )
-import TyCon		( TyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable )
+import TyCon		( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable )
 import DataCon		( dataConId, dataConWrapId )
 
 import BasicTypes	( Version, initialVersion, Fixity )
@@ -189,7 +189,7 @@ data ModDetails
 -- The ModDetails takes on several slightly different forms:
 --
 -- After typecheck + desugar
---	md_types	Contains TyCons, Classes, and hasNoBinding Ids
+--	md_types	Contains TyCons, Classes, and implicit Ids
 --	md_insts	All instances from this module (incl derived ones)
 --	md_rules	All rules from this module
 --	md_binds	Desugared bindings
@@ -317,9 +317,16 @@ instance Outputable TyThing where
   ppr (ATyCon tc) = ptext SLIT("ATyCon") <+> ppr tc
   ppr (AClass cl) = ptext SLIT("AClass") <+> ppr cl
 
-typeEnvClasses env = [cl | AClass cl <- nameEnvElts env]
-typeEnvTyCons  env = [tc | ATyCon tc <- nameEnvElts env] 
-typeEnvIds     env = [id | AnId id   <- nameEnvElts env] 
+
+typeEnvElts    :: TypeEnv -> [TyThing]
+typeEnvClasses :: TypeEnv -> [Class]
+typeEnvTyCons  :: TypeEnv -> [TyCon]
+typeEnvIds     :: TypeEnv -> [Id]
+
+typeEnvElts    env = nameEnvElts env
+typeEnvClasses env = [cl | AClass cl <- typeEnvElts env]
+typeEnvTyCons  env = [tc | ATyCon tc <- typeEnvElts env] 
+typeEnvIds     env = [id | AnId id   <- typeEnvElts env] 
 
 implicitTyThingIds :: [TyThing] -> [Id]
 -- Add the implicit data cons and selectors etc 
@@ -331,8 +338,13 @@ implicitTyThingIds things
     go (ATyCon tc) = tyConGenIds tc ++
 		     tyConSelIds tc ++
 		     [ n | dc <- tyConDataConsIfAvailable tc, 
-			   n  <- [dataConId dc, dataConWrapId dc] ] 
+			   n  <- implicitConIds tc dc]
 		-- Synonyms return empty list of constructors and selectors
+
+    implicitConIds tc dc	-- Newtypes have a constructor wrapper,
+				-- but no worker
+	| isNewTyCon tc = [dataConWrapId dc]
+	| otherwise     = [dataConId dc, dataConWrapId dc]
 \end{code}
 
 
@@ -599,7 +611,13 @@ type IfaceInsts = GatedDecls RdrNameInstDecl
 type IfaceRules = GatedDecls RdrNameRuleDecl
 
 type GatedDecls d = (Bag (GatedDecl d), Int)	-- The Int says how many have been sucked in
-type GatedDecl  d = ([Name], (Module, d))
+type GatedDecl  d = (GateFn, (Module, d))
+type GateFn       = (Name -> Bool) -> Bool	-- Returns True <=> gate is open
+						-- The (Name -> Bool) fn returns True for visible Names
+	-- For example, suppose this is in an interface file
+	--	instance C T where ...
+	-- We want to slurp this decl if both C and T are "visible" in 
+	-- the importing module.  See "The gating story" in RnIfaces for details.
 \end{code}