}
| otherwise
= do {
- hPutStr stderr "compilation IS NOT required";
- when (verbosity dflags /= 1) $ hPutStrLn stderr "";
+ hPutStrLn stderr "compilation IS NOT required";
-- CLOSURE
(pcs_cl, closure_errs, cl_hs_decls)
-- TYPECHECK
maybe_tc_result <- typecheckModule dflags pcs_cl hst
- old_iface alwaysQualify cl_hs_decls;
+ old_iface alwaysQualify cl_hs_decls
+ False{-don't check for Main.main-};
case maybe_tc_result of {
Nothing -> return (HscFail pcs_cl);
Just (pcs_tc, tc_result) -> do {
hscRecomp ghci_mode dflags location maybe_checked_iface hst hit pcs_ch
= do {
; when (verbosity dflags >= 1) $
- hPutStr stderr "compilation IS required";
- -- mode -v1 tries to keep everything on one line
- when (verbosity dflags > 1) $
- hPutStrLn stderr "";
+ hPutStrLn stderr "compilation IS required";
-- what target are we shooting for?
; let toInterp = dopt_HscLang dflags == HscInterpreted
<- _scc_ "Rename"
renameModule dflags hit hst pcs_ch this_mod rdr_module
; case maybe_rn_result of {
- Nothing -> return (HscFail pcs_rn);
+ Nothing -> return (HscFail pcs_ch{-was: pcs_rn-});
Just (print_unqualified, (is_exported, new_iface, rn_hs_decls)) -> do {
-- In interactive mode, we don't want to discard any top-level entities at
-------------------
; maybe_tc_result
<- _scc_ "TypeCheck" typecheckModule dflags pcs_rn hst new_iface
- print_unqualified rn_hs_decls
+ print_unqualified rn_hs_decls
+ True{-check for Main.main if necessary-}
; case maybe_tc_result of {
- Nothing -> return (HscFail pcs_rn);
+ Nothing -> return (HscFail pcs_ch{-was: pcs_rn-});
Just (pcs_tc, tc_result) -> do {
; let env_tc = tc_env tc_result
loc = mkSrcLoc (_PK_ src_filename) 1 } of {
PFailed err -> do { hPutStrLn stderr (showSDoc err);
+ freeStringBuffer buf;
return Nothing };
POk _ rdr_module@(HsModule mod_name _ _ _ _ _ _) -> do {
(ppSourceStats False rdr_module) ;
return (Just rdr_module)
+ -- ToDo: free the string buffer later.
}}
TyThing(..), implicitTyThingIds,
mkTypeEnv
)
-import IOExts
\end{code}
Outside-world interface:
-> ModIface -- Iface for this module
-> PrintUnqualified -- For error printing
-> [RenamedHsDecl]
+ -> Bool -- True <=> check for Main.main if Module==Main
-> IO (Maybe (PersistentCompilerState, TcResults))
-- The new PCS is Augmented with imported information,
-- (but not stuff from this module)
-typecheckModule dflags pcs hst mod_iface unqual decls
+typecheckModule dflags pcs hst mod_iface unqual decls check_main
= do { maybe_tc_result <- typecheck dflags pcs hst unqual $
- tcModule pcs hst get_fixity this_mod decls
+ tcModule pcs hst get_fixity this_mod decls check_main
; printTcDump dflags maybe_tc_result
; return maybe_tc_result }
where
ASSERT( null local_inst_info && nullBinds deriv_binds && null local_rules )
tcSetEnv env $
- tc_expr expr `thenTc` \ (expr', lie, expr_ty) ->
- tcSimplifyInfer smpl_doc
- (varSetElems (tyVarsOfType expr_ty)) lie `thenTc` \ (qtvs, lie_free, dict_binds, dict_ids) ->
- tcSimplifyTop lie_free `thenTc` \ const_binds ->
- let all_expr = mkHsLet const_binds $
- TyLam qtvs $
- DictLam dict_ids $
- mkHsLet dict_binds $
- expr'
- all_expr_ty = mkForAllTys qtvs (mkFunTys (map idType dict_ids) expr_ty)
- in
- zonkExpr all_expr `thenNF_Tc` \ zonked_expr ->
- zonkTcType all_expr_ty `thenNF_Tc` \ zonked_ty ->
+ tc_expr expr `thenTc` \ (expr', expr_ty) ->
+ zonkExpr expr' `thenNF_Tc` \ zonked_expr ->
+ zonkTcType expr_ty `thenNF_Tc` \ zonked_ty ->
ioToTc (dumpIfSet_dyn dflags
Opt_D_dump_tc "Typechecked" (ppr zonked_expr)) `thenNF_Tc_`
returnTc (new_pcs, zonked_expr, zonked_ty)
(tc_io_expr e) -- Main case
| otherwise = newTyVarTy openTypeKind `thenTc` \ ty ->
tcMonoExpr e ty `thenTc` \ (e', lie) ->
- returnTc (e', lie, ty)
-
+ tcSimplifyInfer smpl_doc (varSetElems (tyVarsOfType ty)) lie
+ `thenTc` \ (qtvs, lie_free, dict_binds, dict_ids) ->
+ tcSimplifyTop lie_free `thenTc` \ const_binds ->
+ let all_expr = mkHsLet const_binds $
+ TyLam qtvs $
+ DictLam dict_ids $
+ mkHsLet dict_binds $
+ e'
+ all_expr_ty = mkForAllTys qtvs $
+ mkFunTys (map idType dict_ids) $
+ ty
+ in
+ returnTc (all_expr, all_expr_ty)
where
tc_io_expr e = newTyVarTy openTypeKind `thenTc` \ ty ->
tcLookupTyCon ioTyConName `thenNF_Tc` \ ioTyCon ->
res_ty = mkTyConApp ioTyCon [ty]
in
tcMonoExpr e res_ty `thenTc` \ (e', lie) ->
- returnTc (e', lie, res_ty)
+ tcSimplifyTop lie `thenTc` \ const_binds ->
+ let all_expr = mkHsLet const_binds e' in
+ returnTc (all_expr, res_ty)
---------------
typecheck :: DynFlags
-> (Name -> Maybe Fixity)
-> Module
-> [RenamedHsDecl]
+ -> Bool -- True <=> check for Main.main if Mod==Main
-> TcM (PersistentCompilerState, TcResults)
-tcModule pcs hst get_fixity this_mod decls
+tcModule pcs hst get_fixity this_mod decls check_main
= -- Type-check the type and class decls, and all imported decls
-- tcImports recovers internally, but if anything gave rise to
-- an error we'd better stop now, to avoid a cascade
tcSimplifyTop lie_alldecls `thenTc` \ const_inst_binds ->
-- CHECK THAT main IS DEFINED WITH RIGHT TYPE, IF REQUIRED
- tcCheckMain this_mod `thenTc_`
+ (if check_main
+ then tcCheckMain this_mod
+ else returnTc ()) `thenTc_`
-- Backsubstitution. This must be done last.
-- Even tcSimplifyTop may do some unification.