[project @ 2000-11-09 08:18:11 by simonpj]

Make data constructors visible in unfoldings

ghc/compiler/main/MkIface.lhs

@@ -47,7 +47,7 @@ import Name		( isLocallyDefined, getName,
 import Name 	-- Env
 import OccName		( pprOccName )
 import TyCon		( TyCon, getSynTyConDefn, isSynTyCon, isNewTyCon, isAlgTyCon,
-			  tyConTheta, tyConTyVars, tyConDataCons, tyConFamilySize
+			  tyConTheta, tyConTyVars, tyConDataCons, tyConFamilySize, isClassTyCon
 			)
 import Class		( classExtraBigSig, DefMeth(..) )
 import FieldLabel	( fieldLabelType )
@@ -176,8 +176,8 @@ ifaceTyCls (AClass clas) so_far
 			 DefMeth id -> DefMeth (getName id)
 
 ifaceTyCls (ATyCon tycon) so_far
-  = ty_decl : so_far
-  
+  | isClassTyCon tycon = so_far
+  | otherwise	       = ty_decl : so_far
   where
     ty_decl | isSynTyCon tycon
 	    = TySynonym (getName tycon)(toHsTyVars tyvars) 

ghc/compiler/rename/Rename.lhs

@@ -523,9 +523,7 @@ reportUnusedNames my_mod_iface imports avail_env
     warnUnusedImports bad_imp_names				`thenRn_`
     printMinimalImports this_mod minimal_imports		`thenRn_`
     warnDeprecations this_mod export_avails my_deprecs 
-		     really_used_names				`thenRn_`
-    traceRn (text "Used" <+> fsep (map ppr (nameSetToList used_names)))	`thenRn_`
-    returnRn ()
+		     really_used_names
 
   where
     this_mod   = mi_module my_mod_iface

ghc/compiler/rename/RnHiFiles.lhs

@@ -111,8 +111,16 @@ tryLoadInterface doc_str mod_name from
 	
 	-- CHECK WHETHER WE HAVE IT ALREADY
    case lookupIfaceByModName hit pit mod_name of {
-	Just iface  -> returnRn (iface, Nothing) ;	-- Already loaded
-	Nothing	    -> 
+	Just iface |  case from of
+			ImportByUser	   -> not (mi_boot iface)
+			ImportByUserSource -> mi_boot iface
+			ImportBySystem 	   -> True
+		   -> returnRn (iface, Nothing) ;	-- Already loaded
+			-- The not (mi_boot iface) test checks that the already-loaded
+			-- interface isn't a boot iface.  This can conceivably happen,
+			-- if the version checking happened to load a boot interface
+			-- before we got to real imports.  
+	other	    -> 
 
    let
 	mod_map  = iImpModInfo ifaces

ghc/compiler/rename/RnIfaces.lhs

@@ -710,8 +710,21 @@ checkModUsage (mod_name, _, _, NothingAtAll)
 	-- In this case we don't even want to open Foo's interface.
   = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
 
-checkModUsage (mod_name, _, _, whats_imported)
-  = tryLoadInterface doc_str mod_name ImportBySystem	`thenRn` \ (iface, maybe_err) ->
+checkModUsage (mod_name, _, is_boot, whats_imported)
+  = 	-- Load the imported interface is possible
+	-- We use tryLoadInterface, because failure is not an error
+	-- (might just be that the old .hi file for this module is out of date)
+	-- We use ImportByUser/ImportByUserSource as the 'from' flag, 
+	-- 	a) because we need to know whether to load the .hi-boot file
+	--	b) because loadInterface things matters are amiss if we 
+	--	   ImportBySystem an interface it knows nothing about
+    let
+    	doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
+    	from    | is_boot   = ImportByUserSource
+	    	| otherwise = ImportByUser
+    in
+    tryLoadInterface doc_str mod_name from	`thenRn` \ (iface, maybe_err) ->
+
     case maybe_err of {
 	Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"), 
 				      ppr mod_name]) ;
@@ -758,8 +771,6 @@ checkModUsage (mod_name, _, _, whats_imported)
 	up_to_date (ptext SLIT("...but the bits I use haven't."))
 
     }}
-  where
-    doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
 
 ------------------------
 checkModuleVersion old_mod_vers new_vers

ghc/compiler/rename/RnMonad.lhs

@@ -264,10 +264,9 @@ data Ifaces = Ifaces {
     -- EPHEMERAL FIELDS
     -- These fields persist during the compilation of a single module only
 	iImpModInfo :: ImportedModuleInfo,
-			-- Modules this one depends on: that is, the union 
-			-- of the modules its *direct* imports depend on.
-			-- NB: The direct imports have .hi files that enumerate *all* the
-			-- dependencies (direct or not) of the imported module.
+			-- Modules that we know something about, because they are mentioned
+			-- in interface files, BUT which we have not loaded yet.  
+			-- No module is both in here and in the PIT
 
 	iSlurp :: NameSet,
 		-- All the names (whether "big" or "small", whether wired-in or not,

ghc/compiler/typecheck/TcModule.lhs

@@ -43,17 +43,16 @@ import Bag		( isEmptyBag )
 import ErrUtils		( printErrorsAndWarnings, dumpIfSet_dyn )
 import Id		( idType, idUnfolding )
 import Module           ( Module )
-import Name		( Name, isLocallyDefined, toRdrName )
+import Name		( Name, toRdrName )
 import Name		( nameEnvElts, lookupNameEnv )
 import TyCon		( tyConGenInfo )
-import Maybes		( thenMaybe )
 import Util
 import BasicTypes       ( EP(..), Fixity )
 import Bag		( isEmptyBag )
 import Outputable
-import HscTypes		( PersistentCompilerState(..), HomeSymbolTable, HomeIfaceTable,
+import HscTypes		( PersistentCompilerState(..), HomeSymbolTable, 
 			  PackageTypeEnv, DFunId, ModIface(..),
-			  TypeEnv, extendTypeEnvList, lookupIface,
+			  TypeEnv, extendTypeEnvList, 
 		          TyThing(..), mkTypeEnv )
 import List		( partition )
 \end{code}
@@ -106,7 +105,6 @@ typecheckModule dflags this_mod pcs hst mod_iface decls
     tc_module :: TcM (RecTcEnv, TcResults)
     tc_module = fixTc (\ ~(unf_env ,_) -> tcModule pcs hst get_fixity this_mod decls unf_env)
 
-    pit        = pcs_PIT pcs
     fixity_env = mi_fixities mod_iface
 
     get_fixity :: Name -> Maybe Fixity
@@ -160,7 +158,6 @@ tcModule pcs hst get_fixity this_mod decls unf_env
     -- imported
     tcInterfaceSigs unf_env decls		`thenTc` \ sig_ids ->
     tcExtendGlobalValEnv sig_ids		$
-    tcGetEnv					`thenTc` \ unf_env ->
     
     -- Create any necessary record selector Ids and their bindings
     -- "Necessary" includes data and newtype declarations
@@ -179,6 +176,7 @@ tcModule pcs hst get_fixity this_mod decls unf_env
     --	    will find they aren't there and complain.
     tcExtendGlobalValEnv data_ids		$
     tcExtendGlobalValEnv cls_ids		$
+    tcGetEnv					`thenTc` \ unf_env ->
     
         -- Foreign import declarations next
     tcForeignImports decls			`thenTc`    \ (fo_ids, foi_decls) ->
@@ -285,19 +283,19 @@ dump_sigs results	-- Print type signatures
   = 	-- Convert to HsType so that we get source-language style printing
 	-- And sort by RdrName
     vcat $ map ppr_sig $ sortLt lt_sig $
-    [(toRdrName id, toHsType (idType id))
-        | AnId id <- nameEnvElts (tc_env results), 
-          want_sig id
+    [ (toRdrName id, toHsType (idType id))
+    | AnId id <- nameEnvElts (tc_env results),
+      want_sig id
     ]
   where
     lt_sig (n1,_) (n2,_) = n1 < n2
     ppr_sig (n,t)        = ppr n <+> dcolon <+> ppr t
 
     want_sig id | opt_PprStyle_Debug = True
-	        | otherwise	     = isLocallyDefined id
+	        | otherwise	     = True	-- For now
 
 ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"),
-			   vcat (map ppr_gen_tycon (filter isLocallyDefined tcs)),
+			   vcat (map ppr_gen_tycon tcs),
 		   	   ptext SLIT("#-}")
 		     ]