checkModule, CheckedModule(..),
TypecheckedSource, ParsedSource, RenamedSource,
+ -- * Parsing Haddock comments
+ parseHaddockComment,
+
-- * Inspecting the module structure of the program
ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
getModuleGraph,
-- ** Names
Name,
- nameModule, nameParent_maybe, pprParenSymName, nameSrcLoc,
+ nameModule, pprParenSymName, nameSrcLoc,
NamedThing(..),
RdrName(Qual,Unqual),
TyCon,
tyConTyVars, tyConDataCons, tyConArity,
isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
- synTyConDefn, synTyConRhs,
+ isOpenTyCon,
+ synTyConDefn, synTyConType, synTyConResKind,
-- ** Type variables
TyVar,
import RdrName ( GlobalRdrEnv, GlobalRdrElt(..), RdrName(..),
globalRdrEnvElts, extendGlobalRdrEnv,
emptyGlobalRdrEnv )
-import HsSyn
+import HsSyn
import Type ( Kind, Type, dropForAlls, PredType, ThetaType,
pprThetaArrow, pprParendType, splitForAllTys,
funResultTy )
import Var ( TyVar )
import TysPrim ( alphaTyVars )
import TyCon ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon,
- isPrimTyCon, isFunTyCon, tyConArity,
- tyConTyVars, tyConDataCons, synTyConDefn, synTyConRhs )
+ isPrimTyCon, isFunTyCon, isOpenTyCon, tyConArity,
+ tyConTyVars, tyConDataCons, synTyConDefn,
+ synTyConType, synTyConResKind )
import Class ( Class, classSCTheta, classTvsFds, classMethods )
import FunDeps ( pprFundeps )
import DataCon ( DataCon, dataConWrapId, dataConSig, dataConTyCon,
dataConFieldLabels, dataConStrictMarks,
dataConIsInfix, isVanillaDataCon )
-import Name ( Name, nameModule, NamedThing(..), nameParent_maybe,
- nameSrcLoc )
+import Name ( Name, nameModule, NamedThing(..), nameSrcLoc )
import OccName ( parenSymOcc )
import NameEnv ( nameEnvElts )
import InstEnv ( Instance, instanceDFunId, pprInstance, pprInstanceHdr )
import FiniteMap
import Panic
import Digraph
-import Bag ( unitBag )
+import Bag ( unitBag, listToBag )
import ErrUtils ( Severity(..), showPass, fatalErrorMsg, debugTraceMsg,
- mkPlainErrMsg, printBagOfErrors )
+ mkPlainErrMsg, printBagOfErrors, printBagOfWarnings,
+ WarnMsg )
import qualified ErrUtils
import Util
import StringBuffer ( StringBuffer, hGetStringBuffer )
import BasicTypes
import TcType ( tcSplitSigmaTy, isDictTy )
import Maybes ( expectJust, mapCatMaybes )
+import HaddockParse ( parseHaddockParagraphs, parseHaddockString )
+import HaddockLex ( tokenise )
import Control.Concurrent
import System.Directory ( getModificationTime, doesFileExist )
hscEnv{ hsc_global_type_env = extendTypeEnvWithIds emptyTypeEnv ids }
-- -----------------------------------------------------------------------------
+-- Parsing Haddock comments
+
+parseHaddockComment :: String -> Either String (HsDoc RdrName)
+parseHaddockComment string = parseHaddockParagraphs (tokenise string)
+
+-- -----------------------------------------------------------------------------
-- Loading the program
-- Perform a dependency analysis starting from the current targets
let mg2_with_srcimps :: [SCC ModSummary]
mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
+ -- If we can determine that any of the {-# SOURCE #-} imports
+ -- are definitely unnecessary, then emit a warning.
+ warnUnnecessarySourceImports dflags mg2_with_srcimps
+
+ let
-- check the stability property for each module.
stable_mods@(stable_obj,stable_bco)
| BatchCompile <- ghci_mode = ([],[])
let cleanup = cleanTempFilesExcept dflags
(ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
+ debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
+ 2 (ppr mg))
(upsweep_ok, hsc_env1, modsUpswept)
<- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
pruned_hpt stable_mods cleanup mg
-- fields within CheckedModule.
type ParsedSource = Located (HsModule RdrName)
-type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name])
+type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
+ Maybe (HsDoc Name), HaddockModInfo Name)
type TypecheckedSource = LHsBinds Id
-- NOTE:
(Just (tc_binds, rdr_env, details))) -> do
let minf = ModuleInfo {
minf_type_env = md_types details,
- minf_exports = md_exports details,
+ minf_exports = availsToNameSet $
+ md_exports details,
minf_rdr_env = Just rdr_env,
minf_instances = md_insts details
}
-- We use integers as the keys for the SCC algorithm
nodes :: [(ModSummary, Int, [Int])]
- nodes = [(s, expectJust "topSort" (lookup_key (ms_hsc_src s) (ms_mod_name s)),
+ nodes = [(s, expectJust "topSort" $
+ lookup_key (ms_hsc_src s) (ms_mod_name s),
out_edge_keys hs_boot_key (map unLoc (ms_srcimps s)) ++
- out_edge_keys HsSrcFile (map unLoc (ms_imps s)) )
+ out_edge_keys HsSrcFile (map unLoc (ms_imps s)) ++
+ (-- see [boot-edges] below
+ if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
+ then []
+ else case lookup_key HsBootFile (ms_mod_name s) of
+ Nothing -> []
+ Just k -> [k])
+ )
| s <- summaries
, not (isBootSummary s && drop_hs_boot_nodes) ]
-- Drop the hi-boot ones if told to do so
+ -- [boot-edges] if this is a .hs and there is an equivalent
+ -- .hs-boot, add a link from the former to the latter. This
+ -- has the effect of detecting bogus cases where the .hs-boot
+ -- depends on the .hs, by introducing a cycle. Additionally,
+ -- it ensures that we will always process the .hs-boot before
+ -- the .hs, and so the HomePackageTable will always have the
+ -- most up to date information.
+
key_map :: NodeMap Int
key_map = listToFM ([(moduleName (ms_mod s), ms_hsc_src s)
| s <- summaries]
ms_mod_name :: ModSummary -> ModuleName
ms_mod_name = moduleName . ms_mod
+-- If there are {-# SOURCE #-} imports between strongly connected
+-- components in the topological sort, then those imports can
+-- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
+-- were necessary, then the edge would be part of a cycle.
+warnUnnecessarySourceImports :: DynFlags -> [SCC ModSummary] -> IO ()
+warnUnnecessarySourceImports dflags sccs =
+ printBagOfWarnings dflags (listToBag (concat (map (check.flattenSCC) sccs)))
+ where check ms =
+ let mods_in_this_cycle = map ms_mod_name ms in
+ [ warn m i | m <- ms, i <- ms_srcimps m,
+ unLoc i `notElem` mods_in_this_cycle ]
+
+ warn :: ModSummary -> Located ModuleName -> WarnMsg
+ warn ms (L loc mod) =
+ mkPlainErrMsg loc
+ (ptext SLIT("Warning: {-# SOURCE #-} unnecessary in import of ")
+ <+> quotes (ppr mod))
+
-----------------------------------------------------------------------------
-- Downsweep (dependency analysis)
-- | Container for information about a 'Module'.
data ModuleInfo = ModuleInfo {
minf_type_env :: TypeEnv,
- minf_exports :: NameSet,
+ minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
minf_instances :: [Instance]
-- ToDo: this should really contain the ModIface too
getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
getPackageModuleInfo hsc_env mdl = do
#ifdef GHCI
- (_msgs, mb_names) <- getModuleExports hsc_env mdl
- case mb_names of
+ (_msgs, mb_avails) <- getModuleExports hsc_env mdl
+ case mb_avails of
Nothing -> return Nothing
- Just names -> do
+ Just avails -> do
eps <- readIORef (hsc_EPS hsc_env)
let
+ names = availsToNameSet avails
pte = eps_PTE eps
- n_list = nameSetToList names
- tys = [ ty | name <- n_list,
+ tys = [ ty | name <- concatMap availNames avails,
Just ty <- [lookupTypeEnv pte name] ]
--
return (Just (ModuleInfo {
let details = hm_details hmi
return (Just (ModuleInfo {
minf_type_env = md_types details,
- minf_exports = md_exports details,
+ minf_exports = availsToNameSet (md_exports details),
minf_rdr_env = mi_globals $! hm_iface hmi,
minf_instances = md_insts details
}))
stuff <- mapM (getModuleExports hsc_env) mods
let
(_msgs, mb_name_sets) = unzip stuff
- gres = [ nameSetToGlobalRdrEnv name_set (moduleName mod)
- | (Just name_set, mod) <- zip mb_name_sets mods ]
+ gres = [ nameSetToGlobalRdrEnv (availsToNameSet avails) (moduleName mod)
+ | (Just avails, mod) <- zip mb_name_sets mods ]
--
return $! foldr plusGlobalRdrEnv emptyGlobalRdrEnv gres
projects / ghc-hetmet.git / blobdiff