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,
zonkTopExpr, zonkTopBndrs
)
-import TcExpr ( tcExpr_id )
+import TcExpr ( tcInferRho )
import TcRnMonad
import TcMType ( newTyVarTy, zonkTcType )
import TcType ( Type, liftedTypeKind,
- tyVarsOfType, tcFunResultTy,
+ tyVarsOfType, tcFunResultTy, tidyTopType,
mkForAllTys, mkFunTys, mkTyConApp, tcSplitForAllTys
)
import TcMatches ( tcStmtsAndThen )
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 )
-- 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 ;
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 ;
-- Glue them on the front of the remaining decls and loop
(tc_envs, src_dus2) <- tc_rn_src_decls (spliced_decls ++ rest_ds) ;
- return (tcg_envs, src_dus1 `plusDU` usesOnly splice_fvs `plusDU` src_dus2)
+ return (tc_envs, src_dus1 `plusDU` usesOnly splice_fvs `plusDU` src_dus2)
}
#endif /* GHCI */
}}}
tcRnGroup :: HsGroup RdrName -> TcM ((TcGblEnv, TcLclEnv), DefUses)
-- Returns the variables free in the decls, for unused-binding reporting
tcRnGroup decls
- = do { showLIE (text "LIE at start of tcRnGroup" <+> ppr decls) ;
-
- -- Rename the declarations
+ = do { -- Rename the declarations
(tcg_env, rn_decls, src_dus) <- rnTopSrcDecls decls ;
setGblEnv tcg_env $ do {
-- Typecheck the declarations
tc_envs <- tcTopSrcDecls rn_decls ;
- showLIE (text "LIE at end of tcRnGroup" <+> ppr decls) ;
return (tc_envs, src_dus)
}}
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}
-- $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 ;
, 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
projects / ghc-hetmet.git / blobdiff