2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[TcModule]{Typechecking a whole module}
8 typecheckModule, typecheckIface, typecheckStmt, typecheckExpr,
12 #include "HsVersions.h"
14 import CmdLineOpts ( DynFlag(..), DynFlags, dopt )
15 import HsSyn ( HsBinds(..), MonoBinds(..), HsDecl(..), HsExpr(..),
16 Stmt(..), InPat(..), HsMatchContext(..), HsDoContext(..), RuleDecl(..),
17 isIfaceRuleDecl, nullBinds, andMonoBindList, mkSimpleMatch
19 import PrelNames ( SyntaxMap, mAIN_Name, mainName, ioTyConName, printName,
20 returnIOName, bindIOName, failIOName,
23 import MkId ( unsafeCoerceId )
24 import RnHsSyn ( RenamedHsBinds, RenamedHsDecl, RenamedStmt,
26 import TcHsSyn ( TypecheckedMonoBinds, TypecheckedHsExpr,
27 TypecheckedForeignDecl, TypecheckedRuleDecl,
28 zonkTopBinds, zonkForeignExports, zonkRules, mkHsLet,
32 import MkIface ( pprModDetails )
33 import TcExpr ( tcMonoExpr )
35 import TcMType ( unifyTauTy, newTyVarTy, zonkTcType, tcInstType )
36 import TcType ( Type, liftedTypeKind, openTypeKind,
37 tyVarsOfType, tidyType, tcFunResultTy,
38 mkForAllTys, mkFunTys, mkTyConApp, tcSplitForAllTys
40 import TcMatches ( tcStmtsAndThen )
41 import Inst ( emptyLIE, plusLIE )
42 import TcBinds ( tcTopBinds )
43 import TcClassDcl ( tcClassDecls2 )
44 import TcDefaults ( tcDefaults, defaultDefaultTys )
45 import TcEnv ( TcEnv, RecTcEnv, InstInfo(iDFunId), tcExtendGlobalValEnv, tcLookup_maybe,
46 isLocalThing, tcSetEnv, tcSetInstEnv, initTcEnv, getTcGEnv,
47 tcExtendGlobalTypeEnv, tcLookupGlobalId, tcLookupTyCon,
48 TcTyThing(..), tcLookupId
50 import TcRules ( tcIfaceRules, tcSourceRules )
51 import TcForeign ( tcForeignImports, tcForeignExports )
52 import TcIfaceSig ( tcInterfaceSigs )
53 import TcInstDcls ( tcInstDecls1, tcInstDecls2 )
54 import TcSimplify ( tcSimplifyTop, tcSimplifyInfer )
55 import TcTyClsDecls ( tcTyAndClassDecls )
56 import CoreUnfold ( unfoldingTemplate, hasUnfolding )
57 import TysWiredIn ( mkListTy, unitTy )
58 import ErrUtils ( printErrorsAndWarnings, errorsFound,
59 dumpIfSet_dyn, dumpIfSet_dyn_or, showPass )
60 import Id ( Id, idType, idUnfolding )
61 import Module ( Module, moduleName )
63 import NameEnv ( nameEnvElts, lookupNameEnv )
64 import TyCon ( tyConGenInfo )
65 import BasicTypes ( EP(..), Fixity, RecFlag(..) )
66 import SrcLoc ( noSrcLoc )
69 import HscTypes ( PersistentCompilerState(..), HomeSymbolTable,
70 PackageTypeEnv, ModIface(..),
71 ModDetails(..), DFunId,
72 TypeEnv, extendTypeEnvList,
73 TyThing(..), implicitTyThingIds,
79 %************************************************************************
81 \subsection{The stmt interface}
83 %************************************************************************
88 -> PersistentCompilerState
90 -> TypeEnv -- The interactive context's type envt
91 -> PrintUnqualified -- For error printing
92 -> Module -- Is this really needed
93 -> [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 (syn_map, stmt, iface_decls)
105 = typecheck dflags syn_map 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 Nothing 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)) 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 (ExplicitListOut 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
239 RenamedHsExpr, -- The expression itself
240 [RenamedHsDecl]) -- Plus extra decls it sucked in from interface files
241 -> IO (Maybe (PersistentCompilerState,
243 [Id], -- always empty (matches typecheckStmt)
246 typecheckExpr dflags pcs hst ic_type_env unqual this_mod (syn_map, expr, decls)
247 = typecheck dflags syn_map pcs hst unqual $
249 -- use the default default settings, i.e. [Integer, Double]
250 tcSetDefaultTys defaultDefaultTys $
252 -- Typecheck the extra declarations
253 fixTc (\ ~(unf_env, _, _, _, _) ->
254 tcImports unf_env pcs hst get_fixity this_mod decls
255 ) `thenTc` \ (env, new_pcs, local_inst_info, deriv_binds, local_rules) ->
256 ASSERT( null local_inst_info && nullBinds deriv_binds && null local_rules )
258 -- Now typecheck the expression
260 tcExtendGlobalTypeEnv ic_type_env $
262 newTyVarTy openTypeKind `thenTc` \ ty ->
263 tcMonoExpr expr ty `thenTc` \ (e', lie) ->
264 tcSimplifyInfer smpl_doc (tyVarsOfType ty) lie
265 `thenTc` \ (qtvs, lie_free, dict_binds, dict_ids) ->
266 tcSimplifyTop lie_free `thenTc` \ const_binds ->
268 let all_expr = mkHsLet const_binds $
274 all_expr_ty = mkForAllTys qtvs $
275 mkFunTys (map idType dict_ids) $
279 zonkExpr all_expr `thenNF_Tc` \ zonked_expr ->
280 zonkTcType all_expr_ty `thenNF_Tc` \ zonked_ty ->
281 ioToTc (dumpIfSet_dyn dflags
282 Opt_D_dump_tc "Typechecked" (ppr zonked_expr)) `thenNF_Tc_`
283 returnTc (new_pcs, zonked_expr, [], zonked_ty)
286 get_fixity :: Name -> Maybe Fixity
287 get_fixity n = pprPanic "typecheckExpr" (ppr n)
289 smpl_doc = ptext SLIT("main expression")
292 %************************************************************************
294 \subsection{Typechecking a module}
296 %************************************************************************
301 -> PersistentCompilerState
303 -> ModIface -- Iface for this module
304 -> PrintUnqualified -- For error printing
305 -> (SyntaxMap, [RenamedHsDecl])
306 -> IO (Maybe (PersistentCompilerState, TcResults))
307 -- The new PCS is Augmented with imported information,
308 -- (but not stuff from this module)
312 -- All these fields have info *just for this module*
313 tc_env :: TypeEnv, -- The top level TypeEnv
314 tc_insts :: [DFunId], -- Instances
315 tc_rules :: [TypecheckedRuleDecl], -- Transformation rules
316 tc_binds :: TypecheckedMonoBinds, -- Bindings
317 tc_fords :: [TypecheckedForeignDecl] -- Foreign import & exports.
321 typecheckModule dflags pcs hst mod_iface unqual (syn_map, decls)
322 = do { maybe_tc_result <- typecheck dflags syn_map pcs hst unqual $
323 tcModule pcs hst get_fixity this_mod decls
324 ; printTcDump dflags unqual maybe_tc_result
325 ; return maybe_tc_result }
327 this_mod = mi_module mod_iface
328 fixity_env = mi_fixities mod_iface
330 get_fixity :: Name -> Maybe Fixity
331 get_fixity nm = lookupNameEnv fixity_env nm
334 tcModule :: PersistentCompilerState
336 -> (Name -> Maybe Fixity)
339 -> TcM (PersistentCompilerState, TcResults)
341 tcModule pcs hst get_fixity this_mod decls
342 = fixTc (\ ~(unf_env, _, _) ->
343 -- Loop back the final environment, including the fully zonked
344 -- versions of bindings from this module. In the presence of mutual
345 -- recursion, interface type signatures may mention variables defined
346 -- in this module, which is why the knot is so big
348 -- Type-check the type and class decls, and all imported decls
349 tcImports unf_env pcs hst get_fixity this_mod decls
350 `thenTc` \ (env, new_pcs, local_insts, deriv_binds, local_rules) ->
354 -- Foreign import declarations next
355 traceTc (text "Tc4") `thenNF_Tc_`
356 tcForeignImports decls `thenTc` \ (fo_ids, foi_decls) ->
357 tcExtendGlobalValEnv fo_ids $
359 -- Default declarations
360 tcDefaults decls `thenTc` \ defaulting_tys ->
361 tcSetDefaultTys defaulting_tys $
363 -- Value declarations next.
364 -- We also typecheck any extra binds that came out of the "deriving" process
365 traceTc (text "Default types" <+> ppr defaulting_tys) `thenNF_Tc_`
366 traceTc (text "Tc5") `thenNF_Tc_`
367 tcTopBinds (val_binds `ThenBinds` deriv_binds) `thenTc` \ ((val_binds, env), lie_valdecls) ->
369 -- Second pass over class and instance declarations,
370 -- plus rules and foreign exports, to generate bindings
372 tcInstDecls2 local_insts `thenNF_Tc` \ (lie_instdecls, inst_binds) ->
373 tcClassDecls2 this_mod tycl_decls `thenNF_Tc` \ (lie_clasdecls, cls_dm_binds) ->
374 tcForeignExports decls `thenTc` \ (lie_fodecls, foe_binds, foe_decls) ->
375 tcSourceRules source_rules `thenNF_Tc` \ (lie_rules, more_local_rules) ->
377 -- CHECK THAT main IS DEFINED WITH RIGHT TYPE, IF REQUIRED
378 traceTc (text "Tc6") `thenNF_Tc_`
379 tcCheckMain this_mod `thenTc_`
381 -- Deal with constant or ambiguous InstIds. How could
382 -- there be ambiguous ones? They can only arise if a
383 -- top-level decl falls under the monomorphism
384 -- restriction, and no subsequent decl instantiates its
385 -- type. (Usually, ambiguous type variables are resolved
386 -- during the generalisation step.)
388 -- Note that we must do this *after* tcCheckMain, because of the
389 -- following bizarre case:
391 -- Here, we infer main :: forall a. m a, where m is a free
392 -- type variable. tcCheckMain will unify it with IO, and that
393 -- must happen before tcSimplifyTop, since the latter will report
396 lie_alldecls = lie_valdecls `plusLIE`
397 lie_instdecls `plusLIE`
398 lie_clasdecls `plusLIE`
399 lie_fodecls `plusLIE`
402 tcSimplifyTop lie_alldecls `thenTc` \ const_inst_binds ->
403 traceTc (text "endsimpltop") `thenTc_`
405 -- Backsubstitution. This must be done last.
406 -- Even tcSimplifyTop may do some unification.
408 all_binds = val_binds `AndMonoBinds`
409 inst_binds `AndMonoBinds`
410 cls_dm_binds `AndMonoBinds`
411 const_inst_binds `AndMonoBinds`
414 traceTc (text "Tc7") `thenNF_Tc_`
415 zonkTopBinds all_binds `thenNF_Tc` \ (all_binds', final_env) ->
417 -- zonkTopBinds puts all the top-level Ids into the tcGEnv
418 traceTc (text "Tc8") `thenNF_Tc_`
419 zonkForeignExports foe_decls `thenNF_Tc` \ foe_decls' ->
420 traceTc (text "Tc9") `thenNF_Tc_`
421 zonkRules more_local_rules `thenNF_Tc` \ more_local_rules' ->
424 let local_things = filter (isLocalThing this_mod) (nameEnvElts (getTcGEnv final_env))
426 -- Create any necessary "implicit" bindings (data constructors etc)
427 -- Should we create bindings for dictionary constructors?
428 -- They are always fully applied, and the bindings are just there
429 -- to support partial applications. But it's easier to let them through.
430 implicit_binds = andMonoBindList [ CoreMonoBind id (unfoldingTemplate unf)
431 | id <- implicitTyThingIds local_things
432 , let unf = idUnfolding id
436 local_type_env :: TypeEnv
437 local_type_env = mkTypeEnv local_things
439 all_local_rules = local_rules ++ more_local_rules'
441 traceTc (text "Tc10") `thenNF_Tc_`
444 TcResults { tc_env = local_type_env,
445 tc_insts = map iDFunId local_insts,
446 tc_binds = implicit_binds `AndMonoBinds` all_binds',
447 tc_fords = foi_decls ++ foe_decls',
448 tc_rules = all_local_rules
451 ) `thenTc` \ (_, pcs, tc_result) ->
452 returnTc (pcs, tc_result)
454 tycl_decls = [d | TyClD d <- decls]
455 val_binds = foldr ThenBinds EmptyBinds [binds | ValD binds <- decls]
456 source_rules = [d | RuleD d <- decls, not (isIfaceRuleDecl d)]
460 %************************************************************************
462 \subsection{Typechecking interface decls}
464 %************************************************************************
469 -> PersistentCompilerState
471 -> ModIface -- Iface for this module (just module & fixities)
472 -> (SyntaxMap, [RenamedHsDecl])
473 -> IO (Maybe (PersistentCompilerState, ModDetails))
474 -- The new PCS is Augmented with imported information,
475 -- (but not stuff from this module).
477 typecheckIface dflags pcs hst mod_iface (syn_map, decls)
478 = do { maybe_tc_stuff <- typecheck dflags syn_map pcs hst alwaysQualify $
479 tcIfaceImports pcs hst get_fixity this_mod decls
480 ; printIfaceDump dflags maybe_tc_stuff
481 ; return maybe_tc_stuff }
483 this_mod = mi_module mod_iface
484 fixity_env = mi_fixities mod_iface
486 get_fixity :: Name -> Maybe Fixity
487 get_fixity nm = lookupNameEnv fixity_env nm
489 tcIfaceImports pcs hst get_fixity this_mod decls
490 = fixTc (\ ~(unf_env, _, _, _, _) ->
491 tcImports unf_env pcs hst get_fixity this_mod decls
492 ) `thenTc` \ (env, new_pcs, local_inst_info,
493 deriv_binds, local_rules) ->
494 ASSERT(nullBinds deriv_binds)
496 local_things = filter (isLocalThing this_mod) (nameEnvElts (getTcGEnv env))
498 mod_details = ModDetails { md_types = mkTypeEnv local_things,
499 md_insts = map iDFunId local_inst_info,
500 md_rules = [(id,rule) | IfaceRuleOut id rule <- local_rules],
502 -- All the rules from an interface are of the IfaceRuleOut form
504 returnTc (new_pcs, mod_details)
506 tcImports :: RecTcEnv
507 -> PersistentCompilerState
509 -> (Name -> Maybe Fixity)
512 -> TcM (TcEnv, PersistentCompilerState, [InstInfo],
513 RenamedHsBinds, [TypecheckedRuleDecl])
515 -- tcImports is a slight mis-nomer.
516 -- It deals with everything that could be an import:
517 -- type and class decls
518 -- interface signatures (checked lazily)
521 -- These can occur in source code too, of course
523 tcImports unf_env pcs hst get_fixity this_mod decls
524 -- (unf_env :: RecTcEnv) is used for type-checking interface pragmas
525 -- which is done lazily [ie failure just drops the pragma
526 -- without having any global-failure effect].
528 -- unf_env is also used to get the pragama info
529 -- for imported dfuns and default methods
532 -- tcImports recovers internally, but if anything gave rise to
533 -- an error we'd better stop now, to avoid a cascade
535 traceTc (text "Tc1") `thenNF_Tc_`
536 tcTyAndClassDecls unf_env tycl_decls `thenTc` \ env ->
539 -- Typecheck the instance decls, includes deriving
540 traceTc (text "Tc2") `thenNF_Tc_`
541 tcInstDecls1 (pcs_insts pcs) (pcs_PRS pcs)
542 hst unf_env get_fixity this_mod
543 decls `thenTc` \ (new_pcs_insts, inst_env, local_insts, deriv_binds) ->
544 tcSetInstEnv inst_env $
546 -- Interface type signatures
547 -- We tie a knot so that the Ids read out of interfaces are in scope
548 -- when we read their pragmas.
549 -- What we rely on is that pragmas are typechecked lazily; if
550 -- any type errors are found (ie there's an inconsistency)
551 -- we silently discard the pragma
552 traceTc (text "Tc3") `thenNF_Tc_`
553 tcInterfaceSigs unf_env this_mod tycl_decls `thenTc` \ sig_ids ->
554 tcExtendGlobalValEnv sig_ids $
557 tcIfaceRules (pcs_rules pcs) this_mod iface_rules `thenNF_Tc` \ (new_pcs_rules, local_rules) ->
558 -- When relinking this module from its interface-file decls
559 -- we'll have IfaceRules that are in fact local to this module
560 -- That's the reason we we get any local_rules out here
562 tcGetEnv `thenTc` \ unf_env ->
564 all_things = nameEnvElts (getTcGEnv unf_env)
566 -- sometimes we're compiling in the context of a package module
567 -- (on the GHCi command line, for example). In this case, we
568 -- want to treat everything we pulled in as an imported thing.
570 = filter (not . isLocalThing this_mod) all_things
572 new_pte :: PackageTypeEnv
573 new_pte = extendTypeEnvList (pcs_PTE pcs) imported_things
575 new_pcs :: PersistentCompilerState
576 new_pcs = pcs { pcs_PTE = new_pte,
577 pcs_insts = new_pcs_insts,
578 pcs_rules = new_pcs_rules
581 returnTc (unf_env, new_pcs, local_insts, deriv_binds, local_rules)
583 tycl_decls = [d | TyClD d <- decls]
584 iface_rules = [d | RuleD d <- decls, isIfaceRuleDecl d]
588 %************************************************************************
590 \subsection{Checking the type of main}
592 %************************************************************************
594 We must check that in module Main,
596 b) main :: forall a1...an. IO t, for some type t
600 then the type of main will be
602 and that should pass the test too.
604 So we just instantiate the type and unify with IO t, and declare
605 victory if doing so succeeds.
608 tcCheckMain :: Module -> TcM ()
610 | not (moduleName this_mod == mAIN_Name )
614 = -- First unify the main_id with IO t, for any old t
615 tcLookup_maybe mainName `thenNF_Tc` \ maybe_thing ->
617 Just (ATcId main_id) -> check_main_ty (idType main_id)
618 other -> addErrTc noMainErr
620 check_main_ty main_ty
621 = tcInstType main_ty `thenNF_Tc` \ (tvs, theta, main_tau) ->
622 newTyVarTy liftedTypeKind `thenNF_Tc` \ arg_ty ->
623 tcLookupTyCon ioTyConName `thenNF_Tc` \ ioTyCon ->
624 tcAddErrCtxtM (mainTypeCtxt main_ty) $
625 if not (null theta) then
626 failWithTc empty -- Context has the error message
628 unifyTauTy main_tau (mkTyConApp ioTyCon [arg_ty])
630 mainTypeCtxt main_ty tidy_env
631 = zonkTcType main_ty `thenNF_Tc` \ main_ty' ->
632 returnNF_Tc (tidy_env, ptext SLIT("`main' has the illegal type") <+>
633 quotes (ppr (tidyType tidy_env main_ty')))
635 noMainErr = hsep [ptext SLIT("Module") <+> quotes (ppr mAIN_Name),
636 ptext SLIT("must include a definition for") <+> quotes (ptext SLIT("main"))]
640 %************************************************************************
642 \subsection{Interfacing the Tc monad to the IO monad}
644 %************************************************************************
647 typecheck :: DynFlags
649 -> PersistentCompilerState
651 -> PrintUnqualified -- For error printing
655 typecheck dflags syn_map pcs hst unqual thing_inside
656 = do { showPass dflags "Typechecker";
657 ; env <- initTcEnv syn_map hst (pcs_PTE pcs)
659 ; (maybe_tc_result, errs) <- initTc dflags env thing_inside
661 ; printErrorsAndWarnings unqual errs
663 ; if errorsFound errs then
666 return maybe_tc_result
671 %************************************************************************
673 \subsection{Dumping output}
675 %************************************************************************
678 printTcDump dflags unqual Nothing = return ()
679 printTcDump dflags unqual (Just (_, results))
680 = do if dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags then
681 printForUser stdout unqual (dump_tc_iface dflags results)
684 dumpIfSet_dyn dflags Opt_D_dump_tc
685 "Typechecked" (ppr (tc_binds results))
688 printIfaceDump dflags Nothing = return ()
689 printIfaceDump dflags (Just (_, details))
690 = dumpIfSet_dyn_or dflags [Opt_D_dump_types, Opt_D_dump_tc]
691 "Interface" (pprModDetails details)
693 dump_tc_iface dflags results
694 = vcat [pprModDetails (ModDetails {md_types = tc_env results,
695 md_insts = tc_insts results,
696 md_rules = [], md_binds = []}) ,
697 ppr_rules (tc_rules results),
699 if dopt Opt_Generics dflags then
700 ppr_gen_tycons [tc | ATyCon tc <- nameEnvElts (tc_env results)]
706 ppr_rules rs = vcat [ptext SLIT("{-# RULES"),
707 nest 4 (vcat (map ppr rs)),
710 ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"),
711 vcat (map ppr_gen_tycon tcs),
715 -- x&y are now Id's, not CoreExpr's
717 | Just ep <- tyConGenInfo tycon
718 = (ppr tycon <> colon) $$ nest 4 (ppr_ep ep)
720 | otherwise = ppr tycon <> colon <+> ptext SLIT("Not derivable")
723 = vcat [ ptext SLIT("Rep type:") <+> ppr (tcFunResultTy from_tau),
724 ptext SLIT("From:") <+> ppr (unfoldingTemplate (idUnfolding from)),
725 ptext SLIT("To:") <+> ppr (unfoldingTemplate (idUnfolding to))
728 (_,from_tau) = tcSplitForAllTys (idType from)