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 tryTc_ (traceTc (text "tcs 1b") `thenNF_Tc_`
163 tc_stmts [itName] [LetStmt (MonoBind the_bind [] NonRecursive),
164 ExprStmt (HsApp (HsVar printName) (HsVar itName)) loc])
165 ( traceTc (text "tcs 1a") `thenNF_Tc_`
166 tc_stmts [itName] [BindStmt (VarPatIn itName) expr loc])
168 the_bind = FunMonoBind itName False [mkSimpleMatch [] expr Nothing loc] loc
170 tcUserStmt names stmt
171 = tc_stmts names [stmt]
175 = tcLookupGlobalId returnIOName `thenNF_Tc` \ return_id ->
176 tcLookupGlobalId bindIOName `thenNF_Tc` \ bind_id ->
177 tcLookupGlobalId failIOName `thenNF_Tc` \ fail_id ->
178 tcLookupTyCon ioTyConName `thenNF_Tc` \ ioTyCon ->
179 newTyVarTy liftedTypeKind `thenNF_Tc` \ res_ty ->
181 io_ty = (\ ty -> mkTyConApp ioTyCon [ty], res_ty)
183 -- mk_return builds the expression
184 -- returnIO @ [()] [coerce () x, .., coerce () z]
185 mk_return ids = HsApp (TyApp (HsVar return_id) [mkListTy unitTy])
186 (ExplicitListOut unitTy (map mk_item ids))
188 mk_item id = HsApp (TyApp (HsVar unsafeCoerceId) [idType id, unitTy])
192 traceTc (text "tcs 2") `thenNF_Tc_`
193 tcStmtsAndThen combine DoExpr io_ty stmts (
194 -- Look up the names right in the middle,
195 -- where they will all be in scope
196 mapNF_Tc tcLookupId names `thenNF_Tc` \ ids ->
197 returnTc ((ids, [ExprStmt (mk_return ids) noSrcLoc]), emptyLIE)
198 ) `thenTc` \ ((ids, tc_stmts), lie) ->
200 -- Simplify the context right here, so that we fail
201 -- if there aren't enough instances. Notably, when we see
203 -- we use tryTc_ to try it <- e
204 -- and then let it = e
205 -- It's the simplify step that rejects the first.
207 traceTc (text "tcs 3") `thenNF_Tc_`
208 tcSimplifyTop lie `thenTc` \ const_binds ->
209 traceTc (text "tcs 4") `thenNF_Tc_`
211 returnTc (mkHsLet const_binds $
212 HsDoOut DoExpr tc_stmts return_id bind_id fail_id
213 (mkTyConApp ioTyCon [mkListTy unitTy]) noSrcLoc,
216 combine stmt (ids, stmts) = (ids, stmt:stmts)
219 %************************************************************************
221 \subsection{Typechecking an expression}
223 %************************************************************************
226 typecheckExpr :: DynFlags
227 -> PersistentCompilerState
229 -> TypeEnv -- The interactive context's type envt
230 -> PrintUnqualified -- For error printing
233 RenamedHsExpr, -- The expression itself
234 [RenamedHsDecl]) -- Plus extra decls it sucked in from interface files
235 -> IO (Maybe (PersistentCompilerState,
237 [Id], -- always empty (matches typecheckStmt)
240 typecheckExpr dflags pcs hst ic_type_env unqual this_mod (syn_map, expr, decls)
241 = typecheck dflags syn_map pcs hst unqual $
243 -- use the default default settings, i.e. [Integer, Double]
244 tcSetDefaultTys defaultDefaultTys $
246 -- Typecheck the extra declarations
247 fixTc (\ ~(unf_env, _, _, _, _) ->
248 tcImports unf_env pcs hst get_fixity this_mod decls
249 ) `thenTc` \ (env, new_pcs, local_inst_info, deriv_binds, local_rules) ->
250 ASSERT( null local_inst_info && nullBinds deriv_binds && null local_rules )
252 -- Now typecheck the expression
254 tcExtendGlobalTypeEnv ic_type_env $
256 newTyVarTy openTypeKind `thenTc` \ ty ->
257 tcMonoExpr expr ty `thenTc` \ (e', lie) ->
258 tcSimplifyInfer smpl_doc (varSetElems (tyVarsOfType ty)) lie
259 `thenTc` \ (qtvs, lie_free, dict_binds, dict_ids) ->
260 tcSimplifyTop lie_free `thenTc` \ const_binds ->
262 let all_expr = mkHsLet const_binds $
268 all_expr_ty = mkForAllTys qtvs $
269 mkFunTys (map idType dict_ids) $
273 zonkExpr all_expr `thenNF_Tc` \ zonked_expr ->
274 zonkTcType all_expr_ty `thenNF_Tc` \ zonked_ty ->
275 ioToTc (dumpIfSet_dyn dflags
276 Opt_D_dump_tc "Typechecked" (ppr zonked_expr)) `thenNF_Tc_`
277 returnTc (new_pcs, zonked_expr, [], zonked_ty)
280 get_fixity :: Name -> Maybe Fixity
281 get_fixity n = pprPanic "typecheckExpr" (ppr n)
283 smpl_doc = ptext SLIT("main expression")
286 %************************************************************************
288 \subsection{Typechecking a module}
290 %************************************************************************
295 -> PersistentCompilerState
297 -> ModIface -- Iface for this module
298 -> PrintUnqualified -- For error printing
299 -> (SyntaxMap, [RenamedHsDecl])
300 -> IO (Maybe (PersistentCompilerState, TcResults))
301 -- The new PCS is Augmented with imported information,
302 -- (but not stuff from this module)
306 -- All these fields have info *just for this module*
307 tc_env :: TypeEnv, -- The top level TypeEnv
308 tc_insts :: [DFunId], -- Instances
309 tc_rules :: [TypecheckedRuleDecl], -- Transformation rules
310 tc_binds :: TypecheckedMonoBinds, -- Bindings
311 tc_fords :: [TypecheckedForeignDecl] -- Foreign import & exports.
315 typecheckModule dflags pcs hst mod_iface unqual (syn_map, decls)
316 = do { maybe_tc_result <- typecheck dflags syn_map pcs hst unqual $
317 tcModule pcs hst get_fixity this_mod decls
318 ; printTcDump dflags maybe_tc_result
319 ; return maybe_tc_result }
321 this_mod = mi_module mod_iface
322 fixity_env = mi_fixities mod_iface
324 get_fixity :: Name -> Maybe Fixity
325 get_fixity nm = lookupNameEnv fixity_env nm
328 tcModule :: PersistentCompilerState
330 -> (Name -> Maybe Fixity)
333 -> TcM (PersistentCompilerState, TcResults)
335 tcModule pcs hst get_fixity this_mod decls
336 = fixTc (\ ~(unf_env, _, _) ->
337 -- Loop back the final environment, including the fully zonkec
338 -- versions of bindings from this module. In the presence of mutual
339 -- recursion, interface type signatures may mention variables defined
340 -- in this module, which is why the knot is so big
342 -- Type-check the type and class decls, and all imported decls
343 tcImports unf_env pcs hst get_fixity this_mod decls
344 `thenTc` \ (env, new_pcs, local_insts, deriv_binds, local_rules) ->
348 -- Foreign import declarations next
349 traceTc (text "Tc4") `thenNF_Tc_`
350 tcForeignImports decls `thenTc` \ (fo_ids, foi_decls) ->
351 tcExtendGlobalValEnv fo_ids $
353 -- Default declarations
354 tcDefaults decls `thenTc` \ defaulting_tys ->
355 tcSetDefaultTys defaulting_tys $
357 -- Value declarations next.
358 -- We also typecheck any extra binds that came out of the "deriving" process
359 traceTc (text "Default types" <+> ppr defaulting_tys) `thenNF_Tc_`
360 traceTc (text "Tc5") `thenNF_Tc_`
361 tcTopBinds (val_binds `ThenBinds` deriv_binds) `thenTc` \ ((val_binds, env), lie_valdecls) ->
363 -- Second pass over class and instance declarations,
364 -- plus rules and foreign exports, to generate bindings
366 tcInstDecls2 local_insts `thenNF_Tc` \ (lie_instdecls, inst_binds) ->
367 tcClassDecls2 this_mod tycl_decls `thenNF_Tc` \ (lie_clasdecls, cls_dm_binds) ->
368 tcForeignExports decls `thenTc` \ (lie_fodecls, foe_binds, foe_decls) ->
369 tcSourceRules source_rules `thenNF_Tc` \ (lie_rules, more_local_rules) ->
371 -- Deal with constant or ambiguous InstIds. How could
372 -- there be ambiguous ones? They can only arise if a
373 -- top-level decl falls under the monomorphism
374 -- restriction, and no subsequent decl instantiates its
375 -- type. (Usually, ambiguous type variables are resolved
376 -- during the generalisation step.)
378 lie_alldecls = lie_valdecls `plusLIE`
379 lie_instdecls `plusLIE`
380 lie_clasdecls `plusLIE`
381 lie_fodecls `plusLIE`
384 traceTc (text "Tc6") `thenNF_Tc_`
385 tcSimplifyTop lie_alldecls `thenTc` \ const_inst_binds ->
387 -- CHECK THAT main IS DEFINED WITH RIGHT TYPE, IF REQUIRED
388 tcCheckMain this_mod `thenTc_`
390 -- Backsubstitution. This must be done last.
391 -- Even tcSimplifyTop may do some unification.
393 all_binds = val_binds `AndMonoBinds`
394 inst_binds `AndMonoBinds`
395 cls_dm_binds `AndMonoBinds`
396 const_inst_binds `AndMonoBinds`
399 traceTc (text "Tc7") `thenNF_Tc_`
400 zonkTopBinds all_binds `thenNF_Tc` \ (all_binds', final_env) ->
402 -- zonkTopBinds puts all the top-level Ids into the tcGEnv
403 traceTc (text "Tc8") `thenNF_Tc_`
404 zonkForeignExports foe_decls `thenNF_Tc` \ foe_decls' ->
405 traceTc (text "Tc9") `thenNF_Tc_`
406 zonkRules more_local_rules `thenNF_Tc` \ more_local_rules' ->
409 let local_things = filter (isLocalThing this_mod) (nameEnvElts (getTcGEnv final_env))
411 -- Create any necessary "implicit" bindings (data constructors etc)
412 -- Should we create bindings for dictionary constructors?
413 -- They are always fully applied, and the bindings are just there
414 -- to support partial applications. But it's easier to let them through.
415 implicit_binds = andMonoBindList [ CoreMonoBind id (unfoldingTemplate unf)
416 | id <- implicitTyThingIds local_things
417 , let unf = idUnfolding id
421 local_type_env :: TypeEnv
422 local_type_env = mkTypeEnv local_things
424 all_local_rules = local_rules ++ more_local_rules'
426 traceTc (text "Tc10") `thenNF_Tc_`
429 TcResults { tc_env = local_type_env,
430 tc_insts = map iDFunId local_insts,
431 tc_binds = implicit_binds `AndMonoBinds` all_binds',
432 tc_fords = foi_decls ++ foe_decls',
433 tc_rules = all_local_rules
436 ) `thenTc` \ (_, pcs, tc_result) ->
437 returnTc (pcs, tc_result)
439 tycl_decls = [d | TyClD d <- decls]
440 val_binds = foldr ThenBinds EmptyBinds [binds | ValD binds <- decls]
441 source_rules = [d | RuleD d <- decls, not (isIfaceRuleDecl d)]
445 %************************************************************************
447 \subsection{Typechecking interface decls}
449 %************************************************************************
454 -> PersistentCompilerState
456 -> ModIface -- Iface for this module (just module & fixities)
457 -> (SyntaxMap, [RenamedHsDecl])
458 -> IO (Maybe (PersistentCompilerState, ModDetails))
459 -- The new PCS is Augmented with imported information,
460 -- (but not stuff from this module).
462 typecheckIface dflags pcs hst mod_iface (syn_map, decls)
463 = do { maybe_tc_stuff <- typecheck dflags syn_map pcs hst alwaysQualify $
464 tcIfaceImports pcs hst get_fixity this_mod decls
465 ; printIfaceDump dflags maybe_tc_stuff
466 ; return maybe_tc_stuff }
468 this_mod = mi_module mod_iface
469 fixity_env = mi_fixities mod_iface
471 get_fixity :: Name -> Maybe Fixity
472 get_fixity nm = lookupNameEnv fixity_env nm
474 tcIfaceImports pcs hst get_fixity this_mod decls
475 = fixTc (\ ~(unf_env, _, _, _, _) ->
476 tcImports unf_env pcs hst get_fixity this_mod decls
477 ) `thenTc` \ (env, new_pcs, local_inst_info,
478 deriv_binds, local_rules) ->
479 ASSERT(nullBinds deriv_binds)
481 local_things = filter (isLocalThing this_mod) (nameEnvElts (getTcGEnv env))
483 mod_details = ModDetails { md_types = mkTypeEnv local_things,
484 md_insts = map iDFunId local_inst_info,
485 md_rules = [(id,rule) | IfaceRuleOut id rule <- local_rules] }
486 -- All the rules from an interface are of the IfaceRuleOut form
488 returnTc (new_pcs, mod_details)
490 tcImports :: RecTcEnv
491 -> PersistentCompilerState
493 -> (Name -> Maybe Fixity)
496 -> TcM (TcEnv, PersistentCompilerState, [InstInfo],
497 RenamedHsBinds, [TypecheckedRuleDecl])
499 -- tcImports is a slight mis-nomer.
500 -- It deals with everything that could be an import:
501 -- type and class decls
502 -- interface signatures (checked lazily)
505 -- These can occur in source code too, of course
507 tcImports unf_env pcs hst get_fixity this_mod decls
508 -- (unf_env :: RecTcEnv) is used for type-checking interface pragmas
509 -- which is done lazily [ie failure just drops the pragma
510 -- without having any global-failure effect].
512 -- unf_env is also used to get the pragama info
513 -- for imported dfuns and default methods
516 -- tcImports recovers internally, but if anything gave rise to
517 -- an error we'd better stop now, to avoid a cascade
519 traceTc (text "Tc1") `thenNF_Tc_`
520 tcTyAndClassDecls unf_env tycl_decls `thenTc` \ env ->
523 -- Typecheck the instance decls, includes deriving
524 traceTc (text "Tc2") `thenNF_Tc_`
525 tcInstDecls1 (pcs_insts pcs) (pcs_PRS pcs)
526 hst unf_env get_fixity this_mod
527 decls `thenTc` \ (new_pcs_insts, inst_env, local_insts, deriv_binds) ->
528 tcSetInstEnv inst_env $
530 -- Interface type signatures
531 -- We tie a knot so that the Ids read out of interfaces are in scope
532 -- when we read their pragmas.
533 -- What we rely on is that pragmas are typechecked lazily; if
534 -- any type errors are found (ie there's an inconsistency)
535 -- we silently discard the pragma
536 traceTc (text "Tc3") `thenNF_Tc_`
537 tcInterfaceSigs unf_env this_mod tycl_decls `thenTc` \ sig_ids ->
538 tcExtendGlobalValEnv sig_ids $
541 tcIfaceRules (pcs_rules pcs) this_mod iface_rules `thenNF_Tc` \ (new_pcs_rules, local_rules) ->
542 -- When relinking this module from its interface-file decls
543 -- we'll have IfaceRules that are in fact local to this module
544 -- That's the reason we we get any local_rules out here
546 tcGetEnv `thenTc` \ unf_env ->
548 all_things = nameEnvElts (getTcGEnv unf_env)
550 -- sometimes we're compiling in the context of a package module
551 -- (on the GHCi command line, for example). In this case, we
552 -- want to treat everything we pulled in as an imported thing.
554 = filter (not . isLocalThing this_mod) all_things
556 new_pte :: PackageTypeEnv
557 new_pte = extendTypeEnvList (pcs_PTE pcs) imported_things
559 new_pcs :: PersistentCompilerState
560 new_pcs = pcs { pcs_PTE = new_pte,
561 pcs_insts = new_pcs_insts,
562 pcs_rules = new_pcs_rules
565 returnTc (unf_env, new_pcs, local_insts, deriv_binds, local_rules)
567 tycl_decls = [d | TyClD d <- decls]
568 iface_rules = [d | RuleD d <- decls, isIfaceRuleDecl d]
572 %************************************************************************
574 \subsection{Checking the type of main}
576 %************************************************************************
578 We must check that in module Main,
580 b) main :: forall a1...an. IO t, for some type t
584 then the type of main will be
586 and that should pass the test too.
588 So we just instantiate the type and unify with IO t, and declare
589 victory if doing so succeeds.
592 tcCheckMain :: Module -> TcM ()
594 | not (moduleName this_mod == mAIN_Name )
598 = -- First unify the main_id with IO t, for any old t
599 tcLookup_maybe mainName `thenNF_Tc` \ maybe_thing ->
601 Just (ATcId main_id) -> check_main_ty (idType main_id)
602 other -> addErrTc noMainErr
604 check_main_ty main_ty
605 = tcInstType main_ty `thenNF_Tc` \ (tvs, theta, main_tau) ->
606 newTyVarTy liftedTypeKind `thenNF_Tc` \ arg_ty ->
607 tcLookupTyCon ioTyConName `thenNF_Tc` \ ioTyCon ->
608 tcAddErrCtxtM (mainTypeCtxt main_ty) $
609 if not (null theta) then
610 failWithTc empty -- Context has the error message
612 unifyTauTy main_tau (mkTyConApp ioTyCon [arg_ty])
614 mainTypeCtxt main_ty tidy_env
615 = zonkTcType main_ty `thenNF_Tc` \ main_ty' ->
616 returnNF_Tc (tidy_env, ptext SLIT("`main' has the illegal type") <+>
617 quotes (ppr (tidyType tidy_env main_ty')))
619 noMainErr = hsep [ptext SLIT("Module") <+> quotes (ppr mAIN_Name),
620 ptext SLIT("must include a definition for") <+> quotes (ptext SLIT("main"))]
624 %************************************************************************
626 \subsection{Interfacing the Tc monad to the IO monad}
628 %************************************************************************
631 typecheck :: DynFlags
633 -> PersistentCompilerState
635 -> PrintUnqualified -- For error printing
639 typecheck dflags syn_map pcs hst unqual thing_inside
640 = do { showPass dflags "Typechecker";
641 ; env <- initTcEnv syn_map hst (pcs_PTE pcs)
643 ; (maybe_tc_result, errs) <- initTc dflags env thing_inside
645 ; printErrorsAndWarnings unqual errs
647 ; if errorsFound errs then
650 return maybe_tc_result
655 %************************************************************************
657 \subsection{Dumping output}
659 %************************************************************************
662 printTcDump dflags Nothing = return ()
663 printTcDump dflags (Just (_, results))
664 = do dumpIfSet_dyn_or dflags [Opt_D_dump_types, Opt_D_dump_tc]
665 "Interface" (dump_tc_iface results)
667 dumpIfSet_dyn dflags Opt_D_dump_tc
668 "Typechecked" (ppr (tc_binds results))
671 printIfaceDump dflags Nothing = return ()
672 printIfaceDump dflags (Just (_, details))
673 = dumpIfSet_dyn_or dflags [Opt_D_dump_types, Opt_D_dump_tc]
674 "Interface" (pprModDetails details)
676 dump_tc_iface results
677 = vcat [pprModDetails (ModDetails {md_types = tc_env results,
678 md_insts = tc_insts results,
680 ppr_rules (tc_rules results),
682 ppr_gen_tycons [tc | ATyCon tc <- nameEnvElts (tc_env results)]
686 ppr_rules rs = vcat [ptext SLIT("{-# RULES"),
687 nest 4 (vcat (map ppr rs)),
690 ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"),
691 vcat (map ppr_gen_tycon tcs),
695 -- x&y are now Id's, not CoreExpr's
697 | Just ep <- tyConGenInfo tycon
698 = (ppr tycon <> colon) $$ nest 4 (ppr_ep ep)
700 | otherwise = ppr tycon <> colon <+> ptext SLIT("Not derivable")
703 = vcat [ ptext SLIT("Rep type:") <+> ppr (funResultTy from_tau),
704 ptext SLIT("From:") <+> ppr (unfoldingTemplate (idUnfolding from)),
705 ptext SLIT("To:") <+> ppr (unfoldingTemplate (idUnfolding to))
708 (_,from_tau) = splitForAllTys (idType from)