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 )
15 import HsSyn ( HsBinds(..), MonoBinds(..), HsDecl(..), HsExpr(..),
16 Stmt(..), InPat(..), HsMatchContext(..), 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 TcType ( newTyVarTy, zonkTcType, tcInstType )
36 import TcMatches ( tcStmtsAndThen )
37 import TcUnify ( unifyTauTy )
38 import Inst ( emptyLIE, plusLIE )
39 import TcBinds ( tcTopBinds )
40 import TcClassDcl ( tcClassDecls2 )
41 import TcDefaults ( tcDefaults, defaultDefaultTys )
42 import TcEnv ( TcEnv, RecTcEnv, InstInfo(iDFunId), tcExtendGlobalValEnv, tcLookup_maybe,
43 isLocalThing, tcSetEnv, tcSetInstEnv, initTcEnv, getTcGEnv,
44 tcExtendGlobalTypeEnv, tcLookupGlobalId, tcLookupTyCon,
45 TcTyThing(..), tcLookupId
47 import TcRules ( tcIfaceRules, tcSourceRules )
48 import TcForeign ( tcForeignImports, tcForeignExports )
49 import TcIfaceSig ( tcInterfaceSigs )
50 import TcInstDcls ( tcInstDecls1, tcInstDecls2 )
51 import TcSimplify ( tcSimplifyTop, tcSimplifyInfer )
52 import TcTyClsDecls ( tcTyAndClassDecls )
54 import CoreUnfold ( unfoldingTemplate, hasUnfolding )
55 import TysWiredIn ( mkListTy, unitTy )
57 import ErrUtils ( printErrorsAndWarnings, errorsFound,
58 dumpIfSet_dyn, dumpIfSet_dyn_or, showPass )
59 import Id ( Id, idType, idUnfolding )
60 import Module ( Module, moduleName )
62 import NameEnv ( nameEnvElts, lookupNameEnv )
63 import TyCon ( tyConGenInfo )
64 import BasicTypes ( EP(..), Fixity, RecFlag(..) )
65 import SrcLoc ( noSrcLoc )
67 import HscTypes ( PersistentCompilerState(..), HomeSymbolTable,
68 PackageTypeEnv, ModIface(..),
69 ModDetails(..), DFunId,
70 TypeEnv, extendTypeEnvList,
71 TyThing(..), implicitTyThingIds,
78 %************************************************************************
80 \subsection{The stmt interface}
82 %************************************************************************
87 -> PersistentCompilerState
89 -> TypeEnv -- The interactive context's type envt
90 -> PrintUnqualified -- For error printing
91 -> Module -- Is this really needed
92 -> [Name] -- Names bound by the Stmt (empty for expressions)
94 RenamedStmt, -- The stmt itself
95 [RenamedHsDecl]) -- Plus extra decls it sucked in from interface files
96 -> IO (Maybe (PersistentCompilerState,
100 -- The returned [Id] is the same as the input except for
101 -- ExprStmt, in which case the returned [Name] is [itName]
103 typecheckStmt dflags pcs hst ic_type_env unqual this_mod names (syn_map, stmt, iface_decls)
104 = typecheck dflags syn_map pcs hst unqual $
106 -- use the default default settings, i.e. [Integer, Double]
107 tcSetDefaultTys defaultDefaultTys $
109 -- Typecheck the extra declarations
110 fixTc (\ ~(unf_env, _, _, _, _) ->
111 tcImports unf_env pcs hst get_fixity this_mod iface_decls
112 ) `thenTc` \ (env, new_pcs, local_inst_info, deriv_binds, local_rules) ->
113 ASSERT( null local_inst_info && nullBinds deriv_binds && null local_rules )
116 tcExtendGlobalTypeEnv ic_type_env $
118 -- The real work is done here
119 tcUserStmt names stmt `thenTc` \ (expr, bound_ids) ->
121 traceTc (text "tcs 1") `thenNF_Tc_`
122 zonkExpr expr `thenNF_Tc` \ zonked_expr ->
123 mapNF_Tc zonkIdBndr bound_ids `thenNF_Tc` \ zonked_ids ->
125 ioToTc (dumpIfSet_dyn dflags Opt_D_dump_tc "Bound Ids" (vcat (map ppr zonked_ids))) `thenNF_Tc_`
126 ioToTc (dumpIfSet_dyn dflags Opt_D_dump_tc "Typechecked" (ppr zonked_expr)) `thenNF_Tc_`
128 returnTc (new_pcs, zonked_expr, zonked_ids, error "typecheckStmt: no type")
131 get_fixity :: Name -> Maybe Fixity
132 get_fixity n = pprPanic "typecheckStmt" (ppr n)
135 Here is the grand plan, implemented in tcUserStmt
137 What you type The IO [HValue] that hscStmt returns
138 ------------- ------------------------------------
139 let pat = expr ==> let pat = expr in return [coerce HVal x, coerce HVal y, ...]
142 pat <- expr ==> expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
145 expr (of IO type) ==> expr >>= \ v -> return [v]
146 [NB: result not printed] bindings: [it]
149 expr (of non-IO type,
150 result showable) ==> let v = expr in print v >> return [v]
153 expr (of non-IO type,
154 result not showable) ==> error
158 tcUserStmt :: [Name] -> RenamedStmt -> TcM (TypecheckedHsExpr, [Id])
160 tcUserStmt names (ExprStmt expr loc)
161 = ASSERT( null names )
162 tcGetUnique `thenNF_Tc` \ uniq ->
164 fresh_it = itName uniq
165 the_bind = FunMonoBind fresh_it False
166 [ mkSimpleMatch [] expr Nothing loc ] loc
168 tryTc_ (traceTc (text "tcs 1b") `thenNF_Tc_`
169 tc_stmts [fresh_it] [
170 LetStmt (MonoBind the_bind [] NonRecursive),
171 ExprStmt (HsApp (HsVar printName) (HsVar fresh_it)) loc])
172 ( traceTc (text "tcs 1a") `thenNF_Tc_`
173 tc_stmts [fresh_it] [BindStmt (VarPatIn fresh_it) expr loc])
175 tcUserStmt names stmt
176 = tc_stmts names [stmt]
180 = tcLookupGlobalId returnIOName `thenNF_Tc` \ return_id ->
181 tcLookupGlobalId bindIOName `thenNF_Tc` \ bind_id ->
182 tcLookupGlobalId failIOName `thenNF_Tc` \ fail_id ->
183 tcLookupTyCon ioTyConName `thenNF_Tc` \ ioTyCon ->
184 newTyVarTy liftedTypeKind `thenNF_Tc` \ res_ty ->
186 io_ty = (\ ty -> mkTyConApp ioTyCon [ty], res_ty)
188 -- mk_return builds the expression
189 -- returnIO @ [()] [coerce () x, .., coerce () z]
190 mk_return ids = HsApp (TyApp (HsVar return_id) [mkListTy unitTy])
191 (ExplicitListOut unitTy (map mk_item ids))
193 mk_item id = HsApp (TyApp (HsVar unsafeCoerceId) [idType id, unitTy])
197 traceTc (text "tcs 2") `thenNF_Tc_`
198 tcStmtsAndThen combine DoExpr io_ty stmts (
199 -- Look up the names right in the middle,
200 -- where they will all be in scope
201 mapNF_Tc tcLookupId names `thenNF_Tc` \ ids ->
202 returnTc ((ids, [ExprStmt (mk_return ids) noSrcLoc]), emptyLIE)
203 ) `thenTc` \ ((ids, tc_stmts), lie) ->
205 -- Simplify the context right here, so that we fail
206 -- if there aren't enough instances. Notably, when we see
208 -- we use tryTc_ to try it <- e
209 -- and then let it = e
210 -- It's the simplify step that rejects the first.
212 traceTc (text "tcs 3") `thenNF_Tc_`
213 tcSimplifyTop lie `thenTc` \ const_binds ->
214 traceTc (text "tcs 4") `thenNF_Tc_`
216 returnTc (mkHsLet const_binds $
217 HsDoOut DoExpr tc_stmts return_id bind_id fail_id
218 (mkTyConApp ioTyCon [mkListTy unitTy]) noSrcLoc,
221 combine stmt (ids, stmts) = (ids, stmt:stmts)
224 %************************************************************************
226 \subsection{Typechecking an expression}
228 %************************************************************************
231 typecheckExpr :: DynFlags
232 -> PersistentCompilerState
234 -> TypeEnv -- The interactive context's type envt
235 -> 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 (syn_map, expr, decls)
246 = typecheck dflags syn_map 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 (varSetElems (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 a module}
295 %************************************************************************
300 -> PersistentCompilerState
302 -> ModIface -- Iface for this module
303 -> PrintUnqualified -- For error printing
304 -> (SyntaxMap, [RenamedHsDecl])
305 -> IO (Maybe (PersistentCompilerState, TcResults))
306 -- The new PCS is Augmented with imported information,
307 -- (but not stuff from this module)
311 -- All these fields have info *just for this module*
312 tc_env :: TypeEnv, -- The top level TypeEnv
313 tc_insts :: [DFunId], -- Instances
314 tc_rules :: [TypecheckedRuleDecl], -- Transformation rules
315 tc_binds :: TypecheckedMonoBinds, -- Bindings
316 tc_fords :: [TypecheckedForeignDecl] -- Foreign import & exports.
320 typecheckModule dflags pcs hst mod_iface unqual (syn_map, decls)
321 = do { maybe_tc_result <- typecheck dflags syn_map pcs hst unqual $
322 tcModule pcs hst get_fixity this_mod decls
323 ; printTcDump dflags maybe_tc_result
324 ; return maybe_tc_result }
326 this_mod = mi_module mod_iface
327 fixity_env = mi_fixities mod_iface
329 get_fixity :: Name -> Maybe Fixity
330 get_fixity nm = lookupNameEnv fixity_env nm
333 tcModule :: PersistentCompilerState
335 -> (Name -> Maybe Fixity)
338 -> TcM (PersistentCompilerState, TcResults)
340 tcModule pcs hst get_fixity this_mod decls
341 = fixTc (\ ~(unf_env, _, _) ->
342 -- Loop back the final environment, including the fully zonkec
343 -- versions of bindings from this module. In the presence of mutual
344 -- recursion, interface type signatures may mention variables defined
345 -- in this module, which is why the knot is so big
347 -- Type-check the type and class decls, and all imported decls
348 tcImports unf_env pcs hst get_fixity this_mod decls
349 `thenTc` \ (env, new_pcs, local_insts, deriv_binds, local_rules) ->
353 -- Foreign import declarations next
354 traceTc (text "Tc4") `thenNF_Tc_`
355 tcForeignImports decls `thenTc` \ (fo_ids, foi_decls) ->
356 tcExtendGlobalValEnv fo_ids $
358 -- Default declarations
359 tcDefaults decls `thenTc` \ defaulting_tys ->
360 tcSetDefaultTys defaulting_tys $
362 -- Value declarations next.
363 -- We also typecheck any extra binds that came out of the "deriving" process
364 traceTc (text "Default types" <+> ppr defaulting_tys) `thenNF_Tc_`
365 traceTc (text "Tc5") `thenNF_Tc_`
366 tcTopBinds (val_binds `ThenBinds` deriv_binds) `thenTc` \ ((val_binds, env), lie_valdecls) ->
368 -- Second pass over class and instance declarations,
369 -- plus rules and foreign exports, to generate bindings
371 tcInstDecls2 local_insts `thenNF_Tc` \ (lie_instdecls, inst_binds) ->
372 tcClassDecls2 this_mod tycl_decls `thenNF_Tc` \ (lie_clasdecls, cls_dm_binds) ->
373 tcForeignExports decls `thenTc` \ (lie_fodecls, foe_binds, foe_decls) ->
374 tcSourceRules source_rules `thenNF_Tc` \ (lie_rules, more_local_rules) ->
376 -- CHECK THAT main IS DEFINED WITH RIGHT TYPE, IF REQUIRED
377 traceTc (text "Tc6") `thenNF_Tc_`
378 tcCheckMain this_mod `thenTc_`
380 -- Deal with constant or ambiguous InstIds. How could
381 -- there be ambiguous ones? They can only arise if a
382 -- top-level decl falls under the monomorphism
383 -- restriction, and no subsequent decl instantiates its
384 -- type. (Usually, ambiguous type variables are resolved
385 -- during the generalisation step.)
387 -- Note that we must do this *after* tcCheckMain, because of the
388 -- following bizarre case:
390 -- Here, we infer main :: forall a. m a, where m is a free
391 -- type variable. tcCheckMain will unify it with IO, and that
392 -- must happen before tcSimplifyTop, since the latter will report
395 lie_alldecls = lie_valdecls `plusLIE`
396 lie_instdecls `plusLIE`
397 lie_clasdecls `plusLIE`
398 lie_fodecls `plusLIE`
401 tcSimplifyTop lie_alldecls `thenTc` \ const_inst_binds ->
403 -- Backsubstitution. This must be done last.
404 -- Even tcSimplifyTop may do some unification.
406 all_binds = val_binds `AndMonoBinds`
407 inst_binds `AndMonoBinds`
408 cls_dm_binds `AndMonoBinds`
409 const_inst_binds `AndMonoBinds`
412 traceTc (text "Tc7") `thenNF_Tc_`
413 zonkTopBinds all_binds `thenNF_Tc` \ (all_binds', final_env) ->
415 -- zonkTopBinds puts all the top-level Ids into the tcGEnv
416 traceTc (text "Tc8") `thenNF_Tc_`
417 zonkForeignExports foe_decls `thenNF_Tc` \ foe_decls' ->
418 traceTc (text "Tc9") `thenNF_Tc_`
419 zonkRules more_local_rules `thenNF_Tc` \ more_local_rules' ->
422 let local_things = filter (isLocalThing this_mod) (nameEnvElts (getTcGEnv final_env))
424 -- Create any necessary "implicit" bindings (data constructors etc)
425 -- Should we create bindings for dictionary constructors?
426 -- They are always fully applied, and the bindings are just there
427 -- to support partial applications. But it's easier to let them through.
428 implicit_binds = andMonoBindList [ CoreMonoBind id (unfoldingTemplate unf)
429 | id <- implicitTyThingIds local_things
430 , let unf = idUnfolding id
434 local_type_env :: TypeEnv
435 local_type_env = mkTypeEnv local_things
437 all_local_rules = local_rules ++ more_local_rules'
439 traceTc (text "Tc10") `thenNF_Tc_`
442 TcResults { tc_env = local_type_env,
443 tc_insts = map iDFunId local_insts,
444 tc_binds = implicit_binds `AndMonoBinds` all_binds',
445 tc_fords = foi_decls ++ foe_decls',
446 tc_rules = all_local_rules
449 ) `thenTc` \ (_, pcs, tc_result) ->
450 returnTc (pcs, tc_result)
452 tycl_decls = [d | TyClD d <- decls]
453 val_binds = foldr ThenBinds EmptyBinds [binds | ValD binds <- decls]
454 source_rules = [d | RuleD d <- decls, not (isIfaceRuleDecl d)]
458 %************************************************************************
460 \subsection{Typechecking interface decls}
462 %************************************************************************
467 -> PersistentCompilerState
469 -> ModIface -- Iface for this module (just module & fixities)
470 -> (SyntaxMap, [RenamedHsDecl])
471 -> IO (Maybe (PersistentCompilerState, ModDetails))
472 -- The new PCS is Augmented with imported information,
473 -- (but not stuff from this module).
475 typecheckIface dflags pcs hst mod_iface (syn_map, decls)
476 = do { maybe_tc_stuff <- typecheck dflags syn_map pcs hst alwaysQualify $
477 tcIfaceImports pcs hst get_fixity this_mod decls
478 ; printIfaceDump dflags maybe_tc_stuff
479 ; return maybe_tc_stuff }
481 this_mod = mi_module mod_iface
482 fixity_env = mi_fixities mod_iface
484 get_fixity :: Name -> Maybe Fixity
485 get_fixity nm = lookupNameEnv fixity_env nm
487 tcIfaceImports pcs hst get_fixity this_mod decls
488 = fixTc (\ ~(unf_env, _, _, _, _) ->
489 tcImports unf_env pcs hst get_fixity this_mod decls
490 ) `thenTc` \ (env, new_pcs, local_inst_info,
491 deriv_binds, local_rules) ->
492 ASSERT(nullBinds deriv_binds)
494 local_things = filter (isLocalThing this_mod) (nameEnvElts (getTcGEnv env))
496 mod_details = ModDetails { md_types = mkTypeEnv local_things,
497 md_insts = map iDFunId local_inst_info,
498 md_rules = [(id,rule) | IfaceRuleOut id rule <- local_rules],
500 -- All the rules from an interface are of the IfaceRuleOut form
502 returnTc (new_pcs, mod_details)
504 tcImports :: RecTcEnv
505 -> PersistentCompilerState
507 -> (Name -> Maybe Fixity)
510 -> TcM (TcEnv, PersistentCompilerState, [InstInfo],
511 RenamedHsBinds, [TypecheckedRuleDecl])
513 -- tcImports is a slight mis-nomer.
514 -- It deals with everything that could be an import:
515 -- type and class decls
516 -- interface signatures (checked lazily)
519 -- These can occur in source code too, of course
521 tcImports unf_env pcs hst get_fixity this_mod decls
522 -- (unf_env :: RecTcEnv) is used for type-checking interface pragmas
523 -- which is done lazily [ie failure just drops the pragma
524 -- without having any global-failure effect].
526 -- unf_env is also used to get the pragama info
527 -- for imported dfuns and default methods
530 -- tcImports recovers internally, but if anything gave rise to
531 -- an error we'd better stop now, to avoid a cascade
533 traceTc (text "Tc1") `thenNF_Tc_`
534 tcTyAndClassDecls unf_env tycl_decls `thenTc` \ env ->
537 -- Typecheck the instance decls, includes deriving
538 traceTc (text "Tc2") `thenNF_Tc_`
539 tcInstDecls1 (pcs_insts pcs) (pcs_PRS pcs)
540 hst unf_env get_fixity this_mod
541 decls `thenTc` \ (new_pcs_insts, inst_env, local_insts, deriv_binds) ->
542 tcSetInstEnv inst_env $
544 -- Interface type signatures
545 -- We tie a knot so that the Ids read out of interfaces are in scope
546 -- when we read their pragmas.
547 -- What we rely on is that pragmas are typechecked lazily; if
548 -- any type errors are found (ie there's an inconsistency)
549 -- we silently discard the pragma
550 traceTc (text "Tc3") `thenNF_Tc_`
551 tcInterfaceSigs unf_env this_mod tycl_decls `thenTc` \ sig_ids ->
552 tcExtendGlobalValEnv sig_ids $
555 tcIfaceRules (pcs_rules pcs) this_mod iface_rules `thenNF_Tc` \ (new_pcs_rules, local_rules) ->
556 -- When relinking this module from its interface-file decls
557 -- we'll have IfaceRules that are in fact local to this module
558 -- That's the reason we we get any local_rules out here
560 tcGetEnv `thenTc` \ unf_env ->
562 all_things = nameEnvElts (getTcGEnv unf_env)
564 -- sometimes we're compiling in the context of a package module
565 -- (on the GHCi command line, for example). In this case, we
566 -- want to treat everything we pulled in as an imported thing.
568 = filter (not . isLocalThing this_mod) all_things
570 new_pte :: PackageTypeEnv
571 new_pte = extendTypeEnvList (pcs_PTE pcs) imported_things
573 new_pcs :: PersistentCompilerState
574 new_pcs = pcs { pcs_PTE = new_pte,
575 pcs_insts = new_pcs_insts,
576 pcs_rules = new_pcs_rules
579 returnTc (unf_env, new_pcs, local_insts, deriv_binds, local_rules)
581 tycl_decls = [d | TyClD d <- decls]
582 iface_rules = [d | RuleD d <- decls, isIfaceRuleDecl d]
586 %************************************************************************
588 \subsection{Checking the type of main}
590 %************************************************************************
592 We must check that in module Main,
594 b) main :: forall a1...an. IO t, for some type t
598 then the type of main will be
600 and that should pass the test too.
602 So we just instantiate the type and unify with IO t, and declare
603 victory if doing so succeeds.
606 tcCheckMain :: Module -> TcM ()
608 | not (moduleName this_mod == mAIN_Name )
612 = -- First unify the main_id with IO t, for any old t
613 tcLookup_maybe mainName `thenNF_Tc` \ maybe_thing ->
615 Just (ATcId main_id) -> check_main_ty (idType main_id)
616 other -> addErrTc noMainErr
618 check_main_ty main_ty
619 = tcInstType main_ty `thenNF_Tc` \ (tvs, theta, main_tau) ->
620 newTyVarTy liftedTypeKind `thenNF_Tc` \ arg_ty ->
621 tcLookupTyCon ioTyConName `thenNF_Tc` \ ioTyCon ->
622 tcAddErrCtxtM (mainTypeCtxt main_ty) $
623 if not (null theta) then
624 failWithTc empty -- Context has the error message
626 unifyTauTy main_tau (mkTyConApp ioTyCon [arg_ty])
628 mainTypeCtxt main_ty tidy_env
629 = zonkTcType main_ty `thenNF_Tc` \ main_ty' ->
630 returnNF_Tc (tidy_env, ptext SLIT("`main' has the illegal type") <+>
631 quotes (ppr (tidyType tidy_env main_ty')))
633 noMainErr = hsep [ptext SLIT("Module") <+> quotes (ppr mAIN_Name),
634 ptext SLIT("must include a definition for") <+> quotes (ptext SLIT("main"))]
638 %************************************************************************
640 \subsection{Interfacing the Tc monad to the IO monad}
642 %************************************************************************
645 typecheck :: DynFlags
647 -> PersistentCompilerState
649 -> PrintUnqualified -- For error printing
653 typecheck dflags syn_map pcs hst unqual thing_inside
654 = do { showPass dflags "Typechecker";
655 ; env <- initTcEnv syn_map hst (pcs_PTE pcs)
657 ; (maybe_tc_result, errs) <- initTc dflags env thing_inside
659 ; printErrorsAndWarnings unqual errs
661 ; if errorsFound errs then
664 return maybe_tc_result
669 %************************************************************************
671 \subsection{Dumping output}
673 %************************************************************************
676 printTcDump dflags Nothing = return ()
677 printTcDump dflags (Just (_, results))
678 = do dumpIfSet_dyn_or dflags [Opt_D_dump_types, Opt_D_dump_tc]
679 "Interface" (dump_tc_iface results)
681 dumpIfSet_dyn dflags Opt_D_dump_tc
682 "Typechecked" (ppr (tc_binds results))
685 printIfaceDump dflags Nothing = return ()
686 printIfaceDump dflags (Just (_, details))
687 = dumpIfSet_dyn_or dflags [Opt_D_dump_types, Opt_D_dump_tc]
688 "Interface" (pprModDetails details)
690 dump_tc_iface results
691 = vcat [pprModDetails (ModDetails {md_types = tc_env results,
692 md_insts = tc_insts results,
693 md_rules = [], md_binds = []}) ,
694 ppr_rules (tc_rules results),
696 ppr_gen_tycons [tc | ATyCon tc <- nameEnvElts (tc_env results)]
700 ppr_rules rs = vcat [ptext SLIT("{-# RULES"),
701 nest 4 (vcat (map ppr rs)),
704 ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"),
705 vcat (map ppr_gen_tycon tcs),
709 -- x&y are now Id's, not CoreExpr's
711 | Just ep <- tyConGenInfo tycon
712 = (ppr tycon <> colon) $$ nest 4 (ppr_ep ep)
714 | otherwise = ppr tycon <> colon <+> ptext SLIT("Not derivable")
717 = vcat [ ptext SLIT("Rep type:") <+> ppr (funResultTy from_tau),
718 ptext SLIT("From:") <+> ppr (unfoldingTemplate (idUnfolding from)),
719 ptext SLIT("To:") <+> ppr (unfoldingTemplate (idUnfolding to))
722 (_,from_tau) = splitForAllTys (idType from)