2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[TcModule]{Typechecking a whole module}
8 typecheckModule, typecheckIface, typecheckStmt, typecheckExpr,
13 #include "HsVersions.h"
15 import CmdLineOpts ( DynFlag(..), DynFlags, dopt )
16 import HsSyn ( HsBinds(..), MonoBinds(..), HsDecl(..), HsExpr(..),
17 Stmt(..), InPat(..), HsMatchContext(..), HsDoContext(..), RuleDecl(..),
18 isIfaceRuleDecl, nullBinds, mkSimpleMatch, placeHolderType
20 import PrelNames ( mAIN_Name, mainName, ioTyConName, printName,
21 returnIOName, bindIOName, failIOName,
24 import MkId ( unsafeCoerceId )
25 import RnHsSyn ( RenamedHsBinds, RenamedHsDecl, RenamedStmt,
27 import TcHsSyn ( TypecheckedMonoBinds, TypecheckedHsExpr,
28 TypecheckedForeignDecl, TypecheckedRuleDecl,
29 zonkTopBinds, zonkForeignExports, zonkRules, mkHsLet,
33 import MkIface ( pprModDetails )
34 import TcExpr ( tcMonoExpr )
36 import TcMType ( newTyVarTy, zonkTcType, tcInstType )
37 import TcType ( Type, liftedTypeKind, openTypeKind,
38 tyVarsOfType, tidyType, tcFunResultTy,
39 mkForAllTys, mkFunTys, mkTyConApp, tcSplitForAllTys
41 import TcMatches ( tcStmtsAndThen )
42 import Inst ( emptyLIE, plusLIE )
43 import TcBinds ( tcTopBinds )
44 import TcClassDcl ( tcClassDecls2 )
45 import TcDefaults ( tcDefaults, defaultDefaultTys )
46 import TcEnv ( TcEnv, RecTcEnv, InstInfo(iDFunId), tcExtendGlobalValEnv, tcLookup_maybe,
47 isLocalThing, tcSetEnv, tcSetInstEnv, initTcEnv, getTcGEnv,
48 tcExtendGlobalTypeEnv, tcLookupGlobalId, tcLookupTyCon,
49 TcTyThing(..), tcLookupId
51 import TcRules ( tcIfaceRules, tcSourceRules )
52 import TcForeign ( tcForeignImports, tcForeignExports )
53 import TcIfaceSig ( tcInterfaceSigs )
54 import TcInstDcls ( tcInstDecls1, tcInstDecls2 )
55 import TcUnify ( unifyTauTy )
56 import TcSimplify ( tcSimplifyTop, tcSimplifyInfer )
57 import TcTyClsDecls ( tcTyAndClassDecls )
58 import CoreUnfold ( unfoldingTemplate )
59 import TysWiredIn ( mkListTy, unitTy )
60 import ErrUtils ( printErrorsAndWarnings, errorsFound,
61 dumpIfSet_dyn, dumpIfSet_dyn_or, showPass )
62 import Id ( Id, idType, idUnfolding )
63 import Module ( Module, moduleName )
65 import NameEnv ( lookupNameEnv )
66 import TyCon ( tyConGenInfo )
67 import BasicTypes ( EP(..), Fixity, RecFlag(..) )
68 import SrcLoc ( noSrcLoc )
71 import HscTypes ( PersistentCompilerState(..), HomeSymbolTable,
72 PackageTypeEnv, ModIface(..),
73 ModDetails(..), DFunId,
74 TypeEnv, extendTypeEnvList, typeEnvTyCons, typeEnvElts,
80 %************************************************************************
82 \subsection{The stmt interface}
84 %************************************************************************
89 -> PersistentCompilerState
91 -> TypeEnv -- The interactive context's type envt
92 -> PrintUnqualified -- For error printing
93 -> Module -- Is this really needed
94 -> [Name] -- Names bound by the Stmt (empty for expressions)
95 -> (RenamedStmt, -- The stmt itself
96 [RenamedHsDecl]) -- Plus extra decls it sucked in from interface files
97 -> IO (Maybe (PersistentCompilerState,
101 -- The returned [Id] is the same as the input except for
102 -- ExprStmt, in which case the returned [Name] is [itName]
104 typecheckStmt dflags pcs hst ic_type_env unqual this_mod names (stmt, iface_decls)
105 = typecheck dflags pcs hst unqual $
107 -- use the default default settings, i.e. [Integer, Double]
108 tcSetDefaultTys defaultDefaultTys $
110 -- Typecheck the extra declarations
111 fixTc (\ ~(unf_env, _, _, _, _) ->
112 tcImports unf_env pcs hst get_fixity this_mod iface_decls
113 ) `thenTc` \ (env, new_pcs, local_inst_info, deriv_binds, local_rules) ->
114 ASSERT( null local_inst_info && nullBinds deriv_binds && null local_rules )
117 tcExtendGlobalTypeEnv ic_type_env $
119 -- The real work is done here
120 tcUserStmt names stmt `thenTc` \ (expr, bound_ids) ->
122 traceTc (text "tcs 1") `thenNF_Tc_`
123 zonkExpr expr `thenNF_Tc` \ zonked_expr ->
124 mapNF_Tc zonkIdBndr bound_ids `thenNF_Tc` \ zonked_ids ->
126 ioToTc (dumpIfSet_dyn dflags Opt_D_dump_tc "Bound Ids" (vcat (map ppr zonked_ids))) `thenNF_Tc_`
127 ioToTc (dumpIfSet_dyn dflags Opt_D_dump_tc "Typechecked" (ppr zonked_expr)) `thenNF_Tc_`
129 returnTc (new_pcs, zonked_expr, zonked_ids, error "typecheckStmt: no type")
132 get_fixity :: Name -> Maybe Fixity
133 get_fixity n = pprPanic "typecheckStmt" (ppr n)
136 Here is the grand plan, implemented in tcUserStmt
138 What you type The IO [HValue] that hscStmt returns
139 ------------- ------------------------------------
140 let pat = expr ==> let pat = expr in return [coerce HVal x, coerce HVal y, ...]
143 pat <- expr ==> expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
146 expr (of IO type) ==> expr >>= \ v -> return [v]
147 [NB: result not printed] bindings: [it]
150 expr (of non-IO type,
151 result showable) ==> let v = expr in print v >> return [v]
154 expr (of non-IO type,
155 result not showable) ==> error
159 tcUserStmt :: [Name] -> RenamedStmt -> TcM (TypecheckedHsExpr, [Id])
161 tcUserStmt names (ExprStmt expr _ loc)
162 = ASSERT( null names )
163 tcGetUnique `thenNF_Tc` \ uniq ->
165 fresh_it = itName uniq
166 the_bind = FunMonoBind fresh_it False
167 [ mkSimpleMatch [] expr placeHolderType loc ] loc
169 tryTc_ (traceTc (text "tcs 1b") `thenNF_Tc_`
170 tc_stmts [fresh_it] [
171 LetStmt (MonoBind the_bind [] NonRecursive),
172 ExprStmt (HsApp (HsVar printName) (HsVar fresh_it)) placeHolderType loc])
173 ( traceTc (text "tcs 1a") `thenNF_Tc_`
174 tc_stmts [fresh_it] [BindStmt (VarPatIn fresh_it) expr loc])
176 tcUserStmt names stmt
177 = tc_stmts names [stmt]
181 = tcLookupGlobalId returnIOName `thenNF_Tc` \ return_id ->
182 tcLookupGlobalId bindIOName `thenNF_Tc` \ bind_id ->
183 tcLookupGlobalId failIOName `thenNF_Tc` \ fail_id ->
184 tcLookupTyCon ioTyConName `thenNF_Tc` \ ioTyCon ->
185 newTyVarTy liftedTypeKind `thenNF_Tc` \ res_ty ->
187 io_ty = (\ ty -> mkTyConApp ioTyCon [ty], res_ty)
189 -- mk_return builds the expression
190 -- returnIO @ [()] [coerce () x, .., coerce () z]
191 mk_return ids = HsApp (TyApp (HsVar return_id) [mkListTy unitTy])
192 (ExplicitList unitTy (map mk_item ids))
194 mk_item id = HsApp (TyApp (HsVar unsafeCoerceId) [idType id, unitTy])
198 traceTc (text "tcs 2") `thenNF_Tc_`
199 tcStmtsAndThen combine (DoCtxt DoExpr) io_ty stmts (
200 -- Look up the names right in the middle,
201 -- where they will all be in scope
202 mapNF_Tc tcLookupId names `thenNF_Tc` \ ids ->
203 returnTc ((ids, [ResultStmt (mk_return ids) noSrcLoc]), emptyLIE)
204 ) `thenTc` \ ((ids, tc_stmts), lie) ->
206 -- Simplify the context right here, so that we fail
207 -- if there aren't enough instances. Notably, when we see
209 -- we use tryTc_ to try it <- e
210 -- and then let it = e
211 -- It's the simplify step that rejects the first.
213 traceTc (text "tcs 3") `thenNF_Tc_`
214 tcSimplifyTop lie `thenTc` \ const_binds ->
215 traceTc (text "tcs 4") `thenNF_Tc_`
217 returnTc (mkHsLet const_binds $
218 HsDoOut DoExpr tc_stmts return_id bind_id fail_id
219 (mkTyConApp ioTyCon [mkListTy unitTy]) noSrcLoc,
222 combine stmt (ids, stmts) = (ids, stmt:stmts)
225 %************************************************************************
227 \subsection{Typechecking an expression}
229 %************************************************************************
232 typecheckExpr :: DynFlags
233 -> PersistentCompilerState
235 -> TypeEnv -- The interactive context's type envt
236 -> PrintUnqualified -- For error printing
238 -> (RenamedHsExpr, -- The expression itself
239 [RenamedHsDecl]) -- Plus extra decls it sucked in from interface files
240 -> IO (Maybe (PersistentCompilerState,
242 [Id], -- always empty (matches typecheckStmt)
245 typecheckExpr dflags pcs hst ic_type_env unqual this_mod (expr, decls)
246 = typecheck dflags pcs hst unqual $
248 -- use the default default settings, i.e. [Integer, Double]
249 tcSetDefaultTys defaultDefaultTys $
251 -- Typecheck the extra declarations
252 fixTc (\ ~(unf_env, _, _, _, _) ->
253 tcImports unf_env pcs hst get_fixity this_mod decls
254 ) `thenTc` \ (env, new_pcs, local_inst_info, deriv_binds, local_rules) ->
255 ASSERT( null local_inst_info && nullBinds deriv_binds && null local_rules )
257 -- Now typecheck the expression
259 tcExtendGlobalTypeEnv ic_type_env $
261 newTyVarTy openTypeKind `thenTc` \ ty ->
262 tcMonoExpr expr ty `thenTc` \ (e', lie) ->
263 tcSimplifyInfer smpl_doc (tyVarsOfType ty) lie
264 `thenTc` \ (qtvs, lie_free, dict_binds, dict_ids) ->
265 tcSimplifyTop lie_free `thenTc` \ const_binds ->
267 let all_expr = mkHsLet const_binds $
273 all_expr_ty = mkForAllTys qtvs $
274 mkFunTys (map idType dict_ids) $
278 zonkExpr all_expr `thenNF_Tc` \ zonked_expr ->
279 zonkTcType all_expr_ty `thenNF_Tc` \ zonked_ty ->
280 ioToTc (dumpIfSet_dyn dflags
281 Opt_D_dump_tc "Typechecked" (ppr zonked_expr)) `thenNF_Tc_`
282 returnTc (new_pcs, zonked_expr, [], zonked_ty)
285 get_fixity :: Name -> Maybe Fixity
286 get_fixity n = pprPanic "typecheckExpr" (ppr n)
288 smpl_doc = ptext SLIT("main expression")
291 %************************************************************************
293 \subsection{Typechecking extra declarations}
295 %************************************************************************
300 -> PersistentCompilerState
302 -> PrintUnqualified -- For error printing
303 -> Module -- Is this really needed
304 -> [RenamedHsDecl] -- extra decls sucked in from interface files
305 -> IO (Maybe PersistentCompilerState)
307 typecheckExtraDecls dflags pcs hst unqual this_mod decls
308 = typecheck dflags pcs hst unqual $
309 fixTc (\ ~(unf_env, _, _, _, _) ->
310 tcImports unf_env pcs hst get_fixity this_mod decls
311 ) `thenTc` \ (env, new_pcs, local_inst_info, deriv_binds, local_rules) ->
312 ASSERT( null local_inst_info && nullBinds deriv_binds && null local_rules )
315 get_fixity n = pprPanic "typecheckExpr" (ppr n)
318 %************************************************************************
320 \subsection{Typechecking a module}
322 %************************************************************************
327 -> PersistentCompilerState
329 -> ModIface -- Iface for this module
330 -> PrintUnqualified -- For error printing
332 -> IO (Maybe (PersistentCompilerState, TcResults))
333 -- The new PCS is Augmented with imported information,
334 -- (but not stuff from this module)
338 -- All these fields have info *just for this module*
339 tc_env :: TypeEnv, -- The top level TypeEnv
340 tc_insts :: [DFunId], -- Instances
341 tc_rules :: [TypecheckedRuleDecl], -- Transformation rules
342 tc_binds :: TypecheckedMonoBinds, -- Bindings
343 tc_fords :: [TypecheckedForeignDecl] -- Foreign import & exports.
347 typecheckModule dflags pcs hst mod_iface unqual decls
348 = do { maybe_tc_result <- typecheck dflags pcs hst unqual $
349 tcModule pcs hst get_fixity this_mod decls
350 ; printTcDump dflags unqual maybe_tc_result
351 ; return maybe_tc_result }
353 this_mod = mi_module mod_iface
354 fixity_env = mi_fixities mod_iface
356 get_fixity :: Name -> Maybe Fixity
357 get_fixity nm = lookupNameEnv fixity_env nm
360 tcModule :: PersistentCompilerState
362 -> (Name -> Maybe Fixity)
365 -> TcM (PersistentCompilerState, TcResults)
367 tcModule pcs hst get_fixity this_mod decls
368 = fixTc (\ ~(unf_env, _, _) ->
369 -- Loop back the final environment, including the fully zonked
370 -- versions of bindings from this module. In the presence of mutual
371 -- recursion, interface type signatures may mention variables defined
372 -- in this module, which is why the knot is so big
374 -- Type-check the type and class decls, and all imported decls
375 tcImports unf_env pcs hst get_fixity this_mod decls
376 `thenTc` \ (env, new_pcs, local_insts, deriv_binds, local_rules) ->
380 -- Foreign import declarations next
381 traceTc (text "Tc4") `thenNF_Tc_`
382 tcForeignImports decls `thenTc` \ (fo_ids, foi_decls) ->
383 tcExtendGlobalValEnv fo_ids $
385 -- Default declarations
386 tcDefaults decls `thenTc` \ defaulting_tys ->
387 tcSetDefaultTys defaulting_tys $
389 -- Value declarations next.
390 -- We also typecheck any extra binds that came out of the "deriving" process
391 traceTc (text "Default types" <+> ppr defaulting_tys) `thenNF_Tc_`
392 traceTc (text "Tc5") `thenNF_Tc_`
393 tcTopBinds (val_binds `ThenBinds` deriv_binds) `thenTc` \ ((val_binds, env), lie_valdecls) ->
395 -- Second pass over class and instance declarations,
396 -- plus rules and foreign exports, to generate bindings
398 tcClassDecls2 this_mod tycl_decls `thenNF_Tc` \ (lie_clasdecls, cls_dm_binds, dm_ids) ->
399 tcExtendGlobalValEnv dm_ids $
400 tcInstDecls2 local_insts `thenNF_Tc` \ (lie_instdecls, inst_binds) ->
401 tcForeignExports decls `thenTc` \ (lie_fodecls, foe_binds, foe_decls) ->
402 tcSourceRules source_rules `thenNF_Tc` \ (lie_rules, more_local_rules) ->
404 -- CHECK THAT main IS DEFINED WITH RIGHT TYPE, IF REQUIRED
405 traceTc (text "Tc6") `thenNF_Tc_`
406 tcCheckMain this_mod `thenTc_`
408 -- Deal with constant or ambiguous InstIds. How could
409 -- there be ambiguous ones? They can only arise if a
410 -- top-level decl falls under the monomorphism
411 -- restriction, and no subsequent decl instantiates its
412 -- type. (Usually, ambiguous type variables are resolved
413 -- during the generalisation step.)
415 -- Note that we must do this *after* tcCheckMain, because of the
416 -- following bizarre case:
418 -- Here, we infer main :: forall a. m a, where m is a free
419 -- type variable. tcCheckMain will unify it with IO, and that
420 -- must happen before tcSimplifyTop, since the latter will report
423 lie_alldecls = lie_valdecls `plusLIE`
424 lie_instdecls `plusLIE`
425 lie_clasdecls `plusLIE`
426 lie_fodecls `plusLIE`
429 tcSimplifyTop lie_alldecls `thenTc` \ const_inst_binds ->
430 traceTc (text "endsimpltop") `thenTc_`
432 -- Backsubstitution. This must be done last.
433 -- Even tcSimplifyTop may do some unification.
435 all_binds = val_binds `AndMonoBinds`
436 inst_binds `AndMonoBinds`
437 cls_dm_binds `AndMonoBinds`
438 const_inst_binds `AndMonoBinds`
441 traceTc (text "Tc7") `thenNF_Tc_`
442 zonkTopBinds all_binds `thenNF_Tc` \ (all_binds', final_env) ->
444 -- zonkTopBinds puts all the top-level Ids into the tcGEnv
445 traceTc (text "Tc8") `thenNF_Tc_`
446 zonkForeignExports foe_decls `thenNF_Tc` \ foe_decls' ->
447 traceTc (text "Tc9") `thenNF_Tc_`
448 zonkRules more_local_rules `thenNF_Tc` \ more_local_rules' ->
451 let local_things = filter (isLocalThing this_mod) (typeEnvElts (getTcGEnv final_env))
453 local_type_env :: TypeEnv
454 local_type_env = mkTypeEnv local_things
456 all_local_rules = local_rules ++ more_local_rules'
458 traceTc (text "Tc10") `thenNF_Tc_`
461 TcResults { tc_env = local_type_env,
462 tc_insts = map iDFunId local_insts,
463 tc_binds = all_binds',
464 tc_fords = foi_decls ++ foe_decls',
465 tc_rules = all_local_rules
468 ) `thenTc` \ (_, pcs, tc_result) ->
469 returnTc (pcs, tc_result)
471 tycl_decls = [d | TyClD d <- decls]
472 val_binds = foldr ThenBinds EmptyBinds [binds | ValD binds <- decls]
473 source_rules = [d | RuleD d <- decls, not (isIfaceRuleDecl d)]
477 %************************************************************************
479 \subsection{Typechecking interface decls}
481 %************************************************************************
486 -> PersistentCompilerState
488 -> ModIface -- Iface for this module (just module & fixities)
490 -> IO (Maybe (PersistentCompilerState, ModDetails))
491 -- The new PCS is Augmented with imported information,
492 -- (but not stuff from this module).
494 typecheckIface dflags pcs hst mod_iface decls
495 = do { maybe_tc_stuff <- typecheck dflags pcs hst alwaysQualify $
496 tcIfaceImports pcs hst get_fixity this_mod decls
497 ; printIfaceDump dflags maybe_tc_stuff
498 ; return maybe_tc_stuff }
500 this_mod = mi_module mod_iface
501 fixity_env = mi_fixities mod_iface
503 get_fixity :: Name -> Maybe Fixity
504 get_fixity nm = lookupNameEnv fixity_env nm
506 tcIfaceImports pcs hst get_fixity this_mod decls
507 = fixTc (\ ~(unf_env, _, _, _, _) ->
508 tcImports unf_env pcs hst get_fixity this_mod decls
509 ) `thenTc` \ (env, new_pcs, local_inst_info,
510 deriv_binds, local_rules) ->
511 ASSERT(nullBinds deriv_binds)
513 local_things = filter (isLocalThing this_mod) (typeEnvElts (getTcGEnv env))
515 mod_details = ModDetails { md_types = mkTypeEnv local_things,
516 md_insts = map iDFunId local_inst_info,
517 md_rules = [(id,rule) | IfaceRuleOut id rule <- local_rules],
519 -- All the rules from an interface are of the IfaceRuleOut form
521 returnTc (new_pcs, mod_details)
523 tcImports :: RecTcEnv
524 -> PersistentCompilerState
526 -> (Name -> Maybe Fixity)
529 -> TcM (TcEnv, PersistentCompilerState, [InstInfo],
530 RenamedHsBinds, [TypecheckedRuleDecl])
532 -- tcImports is a slight mis-nomer.
533 -- It deals with everything that could be an import:
534 -- type and class decls
535 -- interface signatures (checked lazily)
538 -- These can occur in source code too, of course
540 tcImports unf_env pcs hst get_fixity this_mod decls
541 -- (unf_env :: RecTcEnv) is used for type-checking interface pragmas
542 -- which is done lazily [ie failure just drops the pragma
543 -- without having any global-failure effect].
545 -- unf_env is also used to get the pragama info
546 -- for imported dfuns and default methods
549 -- tcImports recovers internally, but if anything gave rise to
550 -- an error we'd better stop now, to avoid a cascade
552 traceTc (text "Tc1") `thenNF_Tc_`
553 tcTyAndClassDecls unf_env this_mod tycl_decls `thenTc` \ env ->
556 -- Interface type signatures
557 -- We tie a knot so that the Ids read out of interfaces are in scope
558 -- when we read their pragmas.
559 -- What we rely on is that pragmas are typechecked lazily; if
560 -- any type errors are found (ie there's an inconsistency)
561 -- we silently discard the pragma
562 traceTc (text "Tc2") `thenNF_Tc_`
563 tcInterfaceSigs unf_env this_mod tycl_decls `thenTc` \ sig_ids ->
564 tcExtendGlobalValEnv sig_ids $
566 -- Typecheck the instance decls, includes deriving
567 -- Note that imported dictionary functions are already
568 -- in scope from the preceding tcInterfaceSigs
569 traceTc (text "Tc3") `thenNF_Tc_`
570 tcInstDecls1 (pcs_insts pcs) (pcs_PRS pcs)
571 hst unf_env get_fixity this_mod
572 decls `thenTc` \ (new_pcs_insts, inst_env, local_insts, deriv_binds) ->
573 tcSetInstEnv inst_env $
575 tcIfaceRules unf_env (pcs_rules pcs) this_mod iface_rules `thenNF_Tc` \ (new_pcs_rules, local_rules) ->
576 -- When relinking this module from its interface-file decls
577 -- we'll have IfaceRules that are in fact local to this module
578 -- That's the reason we we get any local_rules out here
580 tcGetEnv `thenTc` \ unf_env ->
582 all_things = typeEnvElts (getTcGEnv unf_env)
584 -- sometimes we're compiling in the context of a package module
585 -- (on the GHCi command line, for example). In this case, we
586 -- want to treat everything we pulled in as an imported thing.
588 = filter (not . isLocalThing this_mod) all_things
590 new_pte :: PackageTypeEnv
591 new_pte = extendTypeEnvList (pcs_PTE pcs) imported_things
593 new_pcs :: PersistentCompilerState
594 new_pcs = pcs { pcs_PTE = new_pte,
595 pcs_insts = new_pcs_insts,
596 pcs_rules = new_pcs_rules
599 returnTc (unf_env, new_pcs, local_insts, deriv_binds, local_rules)
601 tycl_decls = [d | TyClD d <- decls]
602 iface_rules = [d | RuleD d <- decls, isIfaceRuleDecl d]
606 %************************************************************************
608 \subsection{Checking the type of main}
610 %************************************************************************
612 We must check that in module Main,
614 b) main :: forall a1...an. IO t, for some type t
618 then the type of main will be
620 and that should pass the test too.
622 So we just instantiate the type and unify with IO t, and declare
623 victory if doing so succeeds.
626 tcCheckMain :: Module -> TcM ()
628 | not (moduleName this_mod == mAIN_Name )
632 = -- First unify the main_id with IO t, for any old t
633 tcLookup_maybe mainName `thenNF_Tc` \ maybe_thing ->
635 Just (ATcId main_id) -> check_main_ty (idType main_id)
636 other -> addErrTc noMainErr
638 check_main_ty main_ty
639 = tcInstType main_ty `thenNF_Tc` \ (tvs, theta, main_tau) ->
640 newTyVarTy liftedTypeKind `thenNF_Tc` \ arg_ty ->
641 tcLookupTyCon ioTyConName `thenNF_Tc` \ ioTyCon ->
642 tcAddErrCtxtM (mainTypeCtxt main_ty) $
643 if not (null theta) then
644 failWithTc empty -- Context has the error message
646 unifyTauTy main_tau (mkTyConApp ioTyCon [arg_ty])
648 mainTypeCtxt main_ty tidy_env
649 = zonkTcType main_ty `thenNF_Tc` \ main_ty' ->
650 returnNF_Tc (tidy_env, ptext SLIT("`main' has the illegal type") <+>
651 quotes (ppr (tidyType tidy_env main_ty')))
653 noMainErr = hsep [ptext SLIT("Module") <+> quotes (ppr mAIN_Name),
654 ptext SLIT("must include a definition for") <+> quotes (ptext SLIT("main"))]
658 %************************************************************************
660 \subsection{Interfacing the Tc monad to the IO monad}
662 %************************************************************************
665 typecheck :: DynFlags
666 -> PersistentCompilerState
668 -> PrintUnqualified -- For error printing
672 typecheck dflags pcs hst unqual thing_inside
673 = do { showPass dflags "Typechecker";
674 ; env <- initTcEnv hst (pcs_PTE pcs)
676 ; (maybe_tc_result, errs) <- initTc dflags env thing_inside
678 ; printErrorsAndWarnings unqual errs
680 ; if errorsFound errs then
683 return maybe_tc_result
688 %************************************************************************
690 \subsection{Dumping output}
692 %************************************************************************
695 printTcDump dflags unqual Nothing = return ()
696 printTcDump dflags unqual (Just (_, results))
697 = do if dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags then
698 printForUser stdout unqual (dump_tc_iface dflags results)
701 dumpIfSet_dyn dflags Opt_D_dump_tc
702 "Typechecked" (ppr (tc_binds results))
705 printIfaceDump dflags Nothing = return ()
706 printIfaceDump dflags (Just (_, details))
707 = dumpIfSet_dyn_or dflags [Opt_D_dump_types, Opt_D_dump_tc]
708 "Interface" (pprModDetails details)
710 dump_tc_iface dflags results
711 = vcat [pprModDetails (ModDetails {md_types = tc_env results,
712 md_insts = tc_insts results,
713 md_rules = [], md_binds = []}) ,
714 ppr_rules (tc_rules results),
716 if dopt Opt_Generics dflags then
717 ppr_gen_tycons (typeEnvTyCons (tc_env results))
723 ppr_rules rs = vcat [ptext SLIT("{-# RULES"),
724 nest 4 (vcat (map ppr rs)),
727 ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"),
728 vcat (map ppr_gen_tycon tcs),
732 -- x&y are now Id's, not CoreExpr's
734 | Just ep <- tyConGenInfo tycon
735 = (ppr tycon <> colon) $$ nest 4 (ppr_ep ep)
737 | otherwise = ppr tycon <> colon <+> ptext SLIT("Not derivable")
740 = vcat [ ptext SLIT("Rep type:") <+> ppr (tcFunResultTy from_tau),
741 ptext SLIT("From:") <+> ppr (unfoldingTemplate (idUnfolding from)),
742 ptext SLIT("To:") <+> ppr (unfoldingTemplate (idUnfolding to))
745 (_,from_tau) = tcSplitForAllTys (idType from)