\begin{code}
module TcRnDriver (
#ifdef GHCI
- mkGlobalContext, getModuleContents,
+ mkGlobalContext, getModuleContents, tcRnStmt, tcRnThing, tcRnExpr,
#endif
tcRnModule, checkOldIface,
importSupportingDecls, tcTopSrcDecls,
- tcRnIface, tcRnExtCore, tcRnStmt, tcRnExpr, tcRnThing
+ tcRnIface, tcRnExtCore
) where
#include "HsVersions.h"
#endif
import CmdLineOpts ( DynFlag(..), opt_PprStyle_Debug, dopt )
+import DriverState ( v_MainModIs, v_MainFunIs )
+import DriverUtil ( split_longest_prefix )
import HsSyn ( HsModule(..), HsBinds(..), MonoBinds(..), HsExpr(..),
Stmt(..), Pat(VarPat), HsStmtContext(..), RuleDecl(..),
HsGroup(..), SpliceDecl(..),
isSrcRule, collectStmtsBinders
)
import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameStmt, RdrNameHsExpr,
- emptyGroup, mkGroup, findSplice, addImpDecls )
+ emptyGroup, mkGroup, findSplice, addImpDecls, main_RDR_Unqual )
-import PrelNames ( iNTERACTIVE, ioTyConName, printName,
- returnIOName, bindIOName, failIOName, thenIOName, runIOName,
- dollarMainName, itName, mAIN_Name
+import PrelNames ( iNTERACTIVE, ioTyConName, printName, monadNames,
+ returnIOName, runIOName,
+ dollarMainName, itName, mAIN_Name, unsafeCoerceName
)
import MkId ( unsafeCoerceId )
import RdrName ( RdrName, getRdrName, mkRdrUnqual,
import RnHsSyn ( RenamedStmt, RenamedTyClDecl,
ruleDeclFVs, instDeclFVs, tyClDeclFVs )
import TcHsSyn ( TypecheckedHsExpr, TypecheckedRuleDecl,
- zonkTopBinds, zonkTopDecls, mkHsLet,
+ zonkTopDecls, mkHsLet,
zonkTopExpr, zonkTopBndrs
)
-import TcExpr ( tcExpr_id )
+import TcExpr ( tcInferRho, tcCheckRho )
import TcRnMonad
import TcMType ( newTyVarTy, zonkTcType )
import TcType ( Type, liftedTypeKind,
- tyVarsOfType, tcFunResultTy,
+ tyVarsOfType, tcFunResultTy, tidyTopType,
mkForAllTys, mkFunTys, mkTyConApp, tcSplitForAllTys
)
-import TcMatches ( tcStmtsAndThen )
-import Inst ( showLIE )
+import TcMatches ( tcStmtsAndThen, TcStmtCtxt(..) )
+import Inst ( showLIE, tcStdSyntaxName )
import TcBinds ( tcTopBinds )
import TcClassDcl ( tcClassDecls2 )
import TcDefaults ( tcDefaults )
import TcEnv ( tcExtendGlobalValEnv,
- tcExtendGlobalEnv,
tcExtendInstEnv, tcExtendRules,
tcLookupTyCon, tcLookupGlobal,
tcLookupId
import TcTyClsDecls ( tcTyAndClassDecls )
import RnNames ( importsFromLocalDecls, rnImports, exportsFromAvail,
- reportUnusedNames, main_RDR_Unqual )
+ reportUnusedNames )
import RnIfaces ( slurpImpDecls, checkVersions, RecompileRequired, outOfDate )
import RnHiFiles ( readIface, loadOldIface )
import RnEnv ( lookupSrcName, lookupOccRn, plusGlobalRdrEnv,
import CoreSyn ( IdCoreRule, Bind(..) )
import PprCore ( pprIdRules, pprCoreBindings )
import TysWiredIn ( mkListTy, unitTy )
-import ErrUtils ( mkDumpDoc, showPass )
+import ErrUtils ( mkDumpDoc, showPass, pprBagOfErrors )
import Id ( Id, mkLocalId, isLocalId, idName, idType, idUnfolding, setIdLocalExported )
import IdInfo ( GlobalIdDetails(..) )
import Var ( Var, setGlobalIdDetails )
-import Module ( Module, moduleName, moduleUserString, moduleEnvElts )
+import Module ( Module, ModuleName, mkHomeModule, mkModuleName, moduleName, moduleUserString, moduleEnvElts )
+import OccName ( mkVarOcc )
import Name ( Name, isExternalName, getSrcLoc, nameOccName )
import NameEnv ( delListFromNameEnv )
import NameSet
isLocalGRE )
#endif
-import Maybe ( catMaybes )
+import DATA_IOREF ( readIORef )
+import FastString ( mkFastString )
import Panic ( showException )
import List ( partition )
import Util ( sortLt )
-> IO (PersistentCompilerState, Maybe TcGblEnv)
tcRnModule hsc_env pcs
- (HsModule this_mod _ exports import_decls local_decls mod_deprec loc)
+ (HsModule maybe_mod exports import_decls local_decls mod_deprec loc)
= do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
+ let { this_mod = case maybe_mod of
+ Nothing -> mkHomeModule mAIN_Name -- 'module M where' is omitted
+ Just mod -> mod } ; -- The normal case
+
initTc hsc_env pcs this_mod $ addSrcLoc loc $
do { -- Deal with imports; sets tcg_rdr_env, tcg_imports
(rdr_env, imports) <- rnImports import_decls ;
traceRn (text "rn1a") ;
-- Rename and type check the declarations
- (tcg_env, src_fvs) <- tcRnSrcDecls local_decls ;
+ (tcg_env, src_dus) <- tcRnSrcDecls local_decls ;
setGblEnv tcg_env $ do {
traceRn (text "rn3") ;
$ do {
-- Process the export list
- export_avails <- exportsFromAvail exports ;
+ export_avails <- exportsFromAvail maybe_mod exports ;
updGblEnv (\gbl -> gbl { tcg_exports = export_avails })
$ do {
setGblEnv tcg_env $ do {
-- Report unused names
- let { used_fvs = src_fvs `plusFV` export_fvs } ;
- reportUnusedNames tcg_env used_fvs ;
+ let { all_dus = src_dus `plusDU` usesOnly export_fvs } ;
+ reportUnusedNames tcg_env all_dus ;
-- Dump output and return
tcDump tcg_env ;
%************************************************************************
\begin{code}
+#ifdef GHCI
tcRnStmt :: HscEnv -> PersistentCompilerState
-> InteractiveContext
-> RdrNameStmt
---------------------------
tc_stmts stmts
- = do { io_ids <- mappM tcLookupId
- [returnIOName, failIOName, bindIOName, thenIOName] ;
- ioTyCon <- tcLookupTyCon ioTyConName ;
- res_ty <- newTyVarTy liftedTypeKind ;
+ = do { ioTyCon <- tcLookupTyCon ioTyConName ;
let {
- names = collectStmtsBinders stmts ;
- return_id = head io_ids ; -- Rather gruesome
+ ret_ty = mkListTy unitTy ;
+ names = collectStmtsBinders stmts ;
+
+ stmt_ctxt = SC { sc_what = DoExpr,
+ sc_rhs = check_rhs,
+ sc_body = check_body,
+ sc_ty = ret_ty } ;
+
+ check_rhs rhs rhs_ty = tcCheckRho rhs (mkTyConApp ioTyCon [rhs_ty]) ;
+ check_body body = tcCheckRho body (mkTyConApp ioTyCon [ret_ty]) ;
- io_ty = (\ ty -> mkTyConApp ioTyCon [ty], res_ty) ;
+ -- ret_expr is the expression
+ -- returnIO [coerce () x, .., coerce () z]
+ ret_stmt = ResultStmt ret_expr noSrcLoc ;
+ ret_expr = HsApp (HsVar returnIOName)
+ (ExplicitList placeHolderType (map mk_item names)) ;
+ mk_item name = HsApp (HsVar unsafeCoerceName) (HsVar name) ;
- -- mk_return builds the expression
- -- returnIO @ [()] [coerce () x, .., coerce () z]
- mk_return ids = HsApp (TyApp (HsVar return_id) [mkListTy unitTy])
- (ExplicitList unitTy (map mk_item ids)) ;
+ all_stmts = stmts ++ [ret_stmt] ;
- mk_item id = HsApp (TyApp (HsVar unsafeCoerceId) [idType id, unitTy])
- (HsVar id) } ;
+ io_ty = mkTyConApp ioTyCon []
+ } ;
-- OK, we're ready to typecheck the stmts
traceTc (text "tcs 2") ;
((ids, tc_stmts), lie) <-
- getLIE $ tcStmtsAndThen combine DoExpr io_ty stmts $
+ getLIE $
+ tcStmtsAndThen combine stmt_ctxt all_stmts $
do {
-- Look up the names right in the middle,
-- where they will all be in scope
ids <- mappM tcLookupId names ;
- return (ids, [ResultStmt (mk_return ids) noSrcLoc])
+ return (ids, [])
} ;
-- Simplify the context right here, so that we fail
const_binds <- tcSimplifyTop lie ;
-- Build result expression and zonk it
+ io_ids <- mappM (tcStdSyntaxName DoOrigin io_ty) monadNames ;
let { expr = mkHsLet const_binds $
HsDo DoExpr tc_stmts io_ids
- (mkTyConApp ioTyCon [mkListTy unitTy]) noSrcLoc } ;
+ (mkTyConApp ioTyCon [ret_ty]) noSrcLoc } ;
zonked_expr <- zonkTopExpr expr ;
zonked_ids <- zonkTopBndrs ids ;
-- Now typecheck the expression;
-- it might have a rank-2 type (e.g. :t runST)
- -- Hence the hole type (c.f. TcExpr.tcExpr_id)
- ((tc_expr, res_ty), lie) <- getLIE (tcExpr_id rn_expr) ;
+ ((tc_expr, res_ty), lie) <- getLIE (tcInferRho rn_expr) ;
((qtvs, _, dict_ids), lie_top) <- getLIE (tcSimplifyInfer smpl_doc (tyVarsOfType res_ty) lie) ;
tcSimplifyTop lie_top ;
-- constructor and type class identifiers.
let { rdr_names = dataTcOccs rdr_name } ;
- (msgs_s, mb_names) <- initRnInteractive ictxt
- (mapAndUnzipM (tryTc . lookupOccRn) rdr_names) ;
- let { names = catMaybes mb_names } ;
+ -- results :: [(Messages, Maybe Name)]
+ results <- initRnInteractive ictxt
+ (mapM (tryTc . lookupOccRn) rdr_names) ;
- if null names then
- do { addMessages (head msgs_s) ; failM }
- else do {
-
- -- Add deprecation warnings
- mapM_ addMessages msgs_s ;
+ -- The successful lookups will be (Just name)
+ let { (warns_s, good_names) = unzip [ (msgs, name)
+ | (msgs, Just name) <- results] ;
+ errs_s = [msgs | (msgs, Nothing) <- results] } ;
+ -- Fail if nothing good happened, else add warnings
+ if null good_names then -- Fail
+ do { addMessages (head errs_s) ; failM }
+ else -- Add deprecation warnings
+ mapM_ addMessages warns_s ;
+
-- Slurp in the supporting declarations
- tcg_env <- importSupportingDecls (mkFVs names) ;
+ tcg_env <- importSupportingDecls (mkFVs good_names) ;
setGblEnv tcg_env $ do {
-- And lookup up the entities
- mapM tcLookupGlobal names
- }}}
+ mapM tcLookupGlobal good_names
+ }}
\end{code}
= initRn CmdLineMode $
setLocalRdrEnv (ic_rn_local_env ictxt) $
rn_thing
+#endif
\end{code}
%************************************************************************
-> IO (PersistentCompilerState, Maybe ModGuts)
-- Nothing => some error occurred
-tcRnExtCore hsc_env pcs
- (HsModule this_mod _ _ _ local_decls _ loc)
+tcRnExtCore hsc_env pcs (HsModule (Just this_mod) _ _ decls _ loc)
+ -- For external core, the module name is syntactically reqd
-- Rename the (Core) module. It's a bit like an interface
-- file: all names are original names
= do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
-- Rename the source, only in interface mode.
-- rnSrcDecls handles fixity decls etc too, which won't occur
-- but that doesn't matter
- let { local_group = mkGroup local_decls } ;
- (_, rn_local_decls, fvs) <- initRn (InterfaceMode this_mod)
+ let { local_group = mkGroup decls } ;
+ (_, rn_decls, dus) <- initRn (InterfaceMode this_mod)
(rnSrcDecls local_group) ;
failIfErrsM ;
- -- Get the supporting decls, and typecheck them all together
- -- so that any mutually recursive types are done right
- extra_decls <- slurpImpDecls fvs ;
- tcg_env <- typecheckIfaceDecls (rn_local_decls `addImpDecls` extra_decls) ;
+ -- Get the supporting decls
+ rn_imp_decls <- slurpImpDecls (duUses dus) ;
+ let { rn_decls = rn_decls `addImpDecls` rn_imp_decls } ;
+
+ -- Dump trace of renaming part
+ rnDump (ppr rn_decls) ;
+ rnStats rn_imp_decls ;
+
+ -- Typecheck them all together so that
+ -- any mutually recursive types are done right
+ tcg_env <- typecheckIfaceDecls rn_decls ;
setGblEnv tcg_env $ do {
-- Now the core bindings
- core_prs <- tcCoreBinds (hs_coreds rn_local_decls) ;
+ core_prs <- tcCoreBinds (hs_coreds rn_decls) ;
tcExtendGlobalValEnv (map fst core_prs) $ do {
-- Wrap up
final_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) bndrs ;
mod_guts = ModGuts { mg_module = this_mod,
- mg_usages = [], -- ToDo: compute usage
- mg_dir_imps = [], -- ??
+ mg_usages = [], -- ToDo: compute usage
+ mg_dir_imps = [], -- ??
mg_deps = noDependencies, -- ??
mg_exports = my_exports,
mg_types = final_type_env,
%************************************************************************
\begin{code}
-tcRnSrcDecls :: [RdrNameHsDecl] -> TcM (TcGblEnv, FreeVars)
+tcRnSrcDecls :: [RdrNameHsDecl] -> TcM (TcGblEnv, DefUses)
-- Returns the variables free in the decls
-- Reason: solely to report unused imports and bindings
-
tcRnSrcDecls decls
= do { -- Do all the declarations
- ((tc_envs, fvs), lie) <- getLIE (tc_rn_src_decls decls) ;
+ ((tc_envs, dus), lie) <- getLIE (tc_rn_src_decls decls) ;
-- tcSimplifyTop deals with constant or ambiguous InstIds.
-- How could there be ambiguous ones? They can only arise if a
return (tcg_env { tcg_type_env = extendTypeEnvWithIds type_env bind_ids,
tcg_binds = binds', tcg_rules = rules', tcg_fords = fords' },
- fvs)
+ dus)
}}
-tc_rn_src_decls :: [RdrNameHsDecl] -> TcM ((TcGblEnv, TcLclEnv), FreeVars)
+tc_rn_src_decls :: [RdrNameHsDecl] -> TcM ((TcGblEnv, TcLclEnv), DefUses)
tc_rn_src_decls ds
= do { let { (first_group, group_tail) = findSplice ds } ;
-- If ds is [] we get ([], Nothing)
-- Type check the decls up to, but not including, the first splice
- (tc_envs@(_,tcl_env), src_fvs1) <- tcRnGroup first_group ;
+ (tc_envs@(_,tcl_env), src_dus1) <- tcRnGroup first_group ;
-- Bale out if errors; for example, error recovery when checking
-- the RHS of 'main' can mean that 'main' is not in the envt for
setEnvs tc_envs $
- -- If there is no splice, we're nearlydone
+ -- If there is no splice, we're nearly done
case group_tail of {
Nothing -> do { -- Last thing: check for `main'
(tcg_env, main_fvs) <- checkMain ;
- return ((tcg_env, tcl_env), src_fvs1 `plusFV` main_fvs)
+ return ((tcg_env, tcl_env),
+ src_dus1 `plusDU` usesOnly main_fvs)
} ;
-- If there's a splice, we must carry on
#else
-- Rename the splice expression, and get its supporting decls
- (rn_splice_expr, fvs) <- initRn SourceMode $
- addSrcLoc splice_loc $
- rnExpr splice_expr ;
- tcg_env <- importSupportingDecls (fvs `plusFV` templateHaskellNames) ;
+ (rn_splice_expr, splice_fvs) <- initRn SourceMode $
+ addSrcLoc splice_loc $
+ rnExpr splice_expr ;
+ tcg_env <- importSupportingDecls (splice_fvs `plusFV` templateHaskellNames) ;
setGblEnv tcg_env $ do {
-- Execute the splice
spliced_decls <- tcSpliceDecls rn_splice_expr ;
-- Glue them on the front of the remaining decls and loop
- (tc_envs, src_fvs2) <- tc_rn_src_decls (spliced_decls ++ rest_ds) ;
+ (tc_envs, src_dus2) <- tc_rn_src_decls (spliced_decls ++ rest_ds) ;
- return (tc_envs, src_fvs1 `plusFV` src_fvs2)
+ return (tc_envs, src_dus1 `plusDU` usesOnly splice_fvs `plusDU` src_dus2)
}
#endif /* GHCI */
}}}
monad; it augments it and returns the new TcGblEnv.
\begin{code}
-tcRnGroup :: HsGroup RdrName -> TcM ((TcGblEnv, TcLclEnv), FreeVars)
+tcRnGroup :: HsGroup RdrName -> TcM ((TcGblEnv, TcLclEnv), DefUses)
-- Returns the variables free in the decls, for unused-binding reporting
tcRnGroup decls
= do { -- Rename the declarations
- (tcg_env, rn_decls, src_fvs) <- rnTopSrcDecls decls ;
+ (tcg_env, rn_decls, src_dus) <- rnTopSrcDecls decls ;
setGblEnv tcg_env $ do {
-- Typecheck the declarations
tc_envs <- tcTopSrcDecls rn_decls ;
- return (tc_envs, src_fvs)
+
+ return (tc_envs, src_dus)
}}
------------------------------------------------
-rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name, FreeVars)
+rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name, DefUses)
rnTopSrcDecls group
= do { -- Bring top level binders into scope
(rdr_env, imports) <- importsFromLocalDecls group ;
failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
-- Rename the source decls
- (tcg_env, rn_src_decls, src_fvs) <- initRn SourceMode (rnSrcDecls group) ;
+ (tcg_env, rn_src_decls, src_dus) <- initRn SourceMode (rnSrcDecls group) ;
setGblEnv tcg_env $ do {
failIfErrsM ;
-- Import consquential imports
+ let { src_fvs = duUses src_dus } ;
rn_imp_decls <- slurpImpDecls (src_fvs `plusFV` implicitModuleFVs src_fvs) ;
let { rn_decls = rn_src_decls `addImpDecls` rn_imp_decls } ;
rnDump (ppr rn_decls) ;
rnStats rn_imp_decls ;
- return (tcg_env, rn_decls, src_fvs)
+ return (tcg_env, rn_decls, src_dus)
}}}
------------------------------------------------
(cls_dm_binds, dm_ids) <- tcClassDecls2 tycl_decls ;
tcExtendGlobalValEnv dm_ids $ do {
inst_binds <- tcInstDecls2 inst_infos ;
- showLIE "after instDecls2" ;
+ showLIE (text "after instDecls2") ;
-- Foreign exports
-- They need to be zonked, so we return them
returnM (outOfDate, maybe_iface)
else
- case maybe_iface of
+ case maybe_iface of {
Just old_iface -> -- Use the one we already have
checkVersions source_unchanged old_iface `thenM` \ recomp ->
returnM (recomp, Just old_iface)
- Nothing -- Try and read it from a file
- -> getModule `thenM` \ this_mod ->
- readIface this_mod iface_path False `thenM` \ read_result ->
- case read_result of
- Left err -> -- Old interface file not found, or garbled; give up
- traceHiDiffs (
- text "Cannot read old interface file:"
- $$ nest 4 (text (showException err))) `thenM_`
- returnM (outOfDate, Nothing)
-
- Right parsed_iface ->
- initRn (InterfaceMode this_mod)
- (loadOldIface parsed_iface) `thenM` \ m_iface ->
- checkVersions source_unchanged m_iface `thenM` \ recomp ->
- returnM (recomp, Just m_iface)
+ ; Nothing ->
+
+ -- Try and read the old interface for the current module
+ -- from the .hi file left from the last time we compiled it
+ getModule `thenM` \ this_mod ->
+ readIface this_mod iface_path False `thenM` \ read_result ->
+ case read_result of {
+ Left err -> -- Old interface file not found, or garbled; give up
+ traceHiDiffs (text "FYI: cannot read old interface file:"
+ $$ nest 4 (text (showException err))) `thenM_`
+ returnM (outOfDate, Nothing)
+
+ ; Right parsed_iface ->
+
+ -- We found the file and parsed it; now load it
+ tryTc (initRn (InterfaceMode this_mod)
+ (loadOldIface parsed_iface)) `thenM` \ ((_,errs), mb_iface) ->
+ case mb_iface of {
+ Nothing -> -- Something went wrong in loading. The main likely thing
+ -- is that the usages mentioned B.f, where B.hi and B.hs no
+ -- longer exist. Then newGlobalName2 fails with an error message
+ -- This isn't an error; we just don't have an old iface file to
+ -- look at. Spit out a traceHiDiffs for info though.
+ traceHiDiffs (text "FYI: loading old interface file failed"
+ $$ nest 4 (docToSDoc (pprBagOfErrors errs))) `thenM_`
+ return (outOfDate, Nothing)
+
+ ; Just iface ->
+
+ -- At last, we have got the old iface; check its versions
+ checkVersions source_unchanged iface `thenM` \ recomp ->
+ returnM (recomp, Just iface)
+ }}}
\end{code}
checkMain
= do { ghci_mode <- getGhciMode ;
tcg_env <- getGblEnv ;
- check_main ghci_mode tcg_env
+
+ mb_main_mod <- readMutVar v_MainModIs ;
+ mb_main_fn <- readMutVar v_MainFunIs ;
+ let { main_mod = case mb_main_mod of {
+ Just mod -> mkModuleName mod ;
+ Nothing -> mAIN_Name } ;
+ main_fn = case mb_main_fn of {
+ Just fn -> mkRdrUnqual (mkVarOcc (mkFastString fn)) ;
+ Nothing -> main_RDR_Unqual } } ;
+
+ check_main ghci_mode tcg_env main_mod main_fn
}
-check_main ghci_mode tcg_env
+
+check_main ghci_mode tcg_env main_mod main_fn
-- If we are in module Main, check that 'main' is defined.
-- It may be imported from another module, in which case
-- we have to drag in its.
--
-- Blimey: a whole page of code to do this...
- | mod_name /= mAIN_Name
+ | mod_name /= main_mod
= return (tcg_env, emptyFVs)
-- Check that 'main' is in scope
--
-- We use a guard for this (rather than letting lookupSrcName fail)
-- because it's not an error in ghci)
- | not (main_RDR_Unqual `elemRdrEnv` rdr_env)
+ | not (main_fn `elemRdrEnv` rdr_env)
= do { complain_no_main; return (tcg_env, emptyFVs) }
- | otherwise
- = do { main_name <- lookupSrcName main_RDR_Unqual ;
+ | otherwise -- OK, so the appropriate 'main' is in scope
+ --
+ = do { main_name <- lookupSrcName main_fn ;
tcg_env <- importSupportingDecls (unitFV runIOName) ;
-- $main :: IO () = runIO main
let { rhs = HsApp (HsVar runIOName) (HsVar main_name) } ;
- (main_expr, ty) <- tcExpr_id rhs ;
+ (main_expr, ty) <- tcInferRho rhs ;
let { dollar_main_id = setIdLocalExported (mkLocalId dollarMainName ty) ;
main_bind = VarMonoBind dollar_main_id main_expr ;
-- In other modes, fail altogether, so that we don't go on
-- and complain a second time when processing the export list.
- mainCtxt = ptext SLIT("When checking the type of 'main'")
- noMainMsg = ptext SLIT("No 'main' defined in module Main")
+ mainCtxt = ptext SLIT("When checking the type of the main function") <+> quotes (ppr main_fn)
+ noMainMsg = ptext SLIT("The main function") <+> quotes (ppr main_fn)
+ <+> ptext SLIT("is not defined in module") <+> quotes (ppr main_mod)
\end{code}
, ppr_insts dfun_ids
, vcat (map ppr rules)
, ppr_gen_tycons (typeEnvTyCons type_env)
- , ppr (moduleEnvElts (imp_dep_mods imports))
- , ppr (imp_dep_pkgs imports)]
+ , ptext SLIT("Dependent modules:") <+> ppr (moduleEnvElts (imp_dep_mods imports))
+ , ptext SLIT("Dependent packages:") <+> ppr (imp_dep_pkgs imports)]
pprModGuts :: ModGuts -> SDoc
pprModGuts (ModGuts { mg_types = type_env,
-- Convert to HsType so that we get source-language style printing
-- And sort by RdrName
= vcat $ map ppr_sig $ sortLt lt_sig $
- [ (getRdrName id, toHsType (idType id))
+ [ (getRdrName id, toHsType (tidyTopType (idType id)))
| id <- ids ]
where
lt_sig (n1,_) (n2,_) = n1 < n2
ptext SLIT("#-}")]
ppr_gen_tycons [] = empty
-ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"),
- vcat (map ppr_gen_tycon tcs),
- ptext SLIT("#-}")
+ppr_gen_tycons tcs = vcat [ptext SLIT("Generic type constructor details:"),
+ nest 2 (vcat (map ppr_gen_tycon tcs))
]
-- x&y are now Id's, not CoreExpr's
projects / ghc-hetmet.git / blobdiff