From 5dd916543a04bd22de43c242cb0a0c14aafc90f3 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 9 Nov 2000 08:18:12 +0000
Subject: [PATCH] [project @ 2000-11-09 08:18:11 by simonpj] Make data
constructors visible in unfoldings
---
ghc/compiler/main/MkIface.lhs | 6 +++---
ghc/compiler/rename/Rename.lhs | 4 +---
ghc/compiler/rename/RnHiFiles.lhs | 12 ++++++++++--
ghc/compiler/rename/RnIfaces.lhs | 19 +++++++++++++++----
ghc/compiler/rename/RnMonad.lhs | 7 +++----
ghc/compiler/typecheck/TcModule.lhs | 20 +++++++++-----------
6 files changed, 41 insertions(+), 27 deletions(-)
diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index adf89db91481..fb1e504c43d0 100644
--- a/ghc/compiler/main/MkIface.lhs
+++ b/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)
diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index 023145c8a353..3900bb30df91 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/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
diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs
index 20c6ece840f7..bb16c9f19d53 100644
--- a/ghc/compiler/rename/RnHiFiles.lhs
+++ b/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
diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index 43e3cd9b01b5..797e1804a003 100644
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/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
diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index edb98f867737..0b96e1668ae3 100644
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/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,
diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index ec9847976667..65257fdcf722 100644
--- a/ghc/compiler/typecheck/TcModule.lhs
+++ b/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("#-}")
]
--
GitLab