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, placeHolderType
19 import PrelNames ( 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)
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 (stmt, iface_decls)
104 = typecheck dflags 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 placeHolderType 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)) placeHolderType 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 (ExplicitList 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 (DoCtxt 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, [ResultStmt (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
237 -> (RenamedHsExpr, -- The expression itself
238 [RenamedHsDecl]) -- Plus extra decls it sucked in from interface files
239 -> IO (Maybe (PersistentCompilerState,
241 [Id], -- always empty (matches typecheckStmt)
244 typecheckExpr dflags pcs hst ic_type_env unqual this_mod (expr, decls)
245 = typecheck dflags pcs hst unqual $
247 -- use the default default settings, i.e. [Integer, Double]
248 tcSetDefaultTys defaultDefaultTys $
250 -- Typecheck the extra declarations
251 fixTc (\ ~(unf_env, _, _, _, _) ->
252 tcImports unf_env pcs hst get_fixity this_mod decls
253 ) `thenTc` \ (env, new_pcs, local_inst_info, deriv_binds, local_rules) ->
254 ASSERT( null local_inst_info && nullBinds deriv_binds && null local_rules )
256 -- Now typecheck the expression
258 tcExtendGlobalTypeEnv ic_type_env $
260 newTyVarTy openTypeKind `thenTc` \ ty ->
261 tcMonoExpr expr ty `thenTc` \ (e', lie) ->
262 tcSimplifyInfer smpl_doc (tyVarsOfType ty) lie
263 `thenTc` \ (qtvs, lie_free, dict_binds, dict_ids) ->
264 tcSimplifyTop lie_free `thenTc` \ const_binds ->
266 let all_expr = mkHsLet const_binds $
272 all_expr_ty = mkForAllTys qtvs $
273 mkFunTys (map idType dict_ids) $
277 zonkExpr all_expr `thenNF_Tc` \ zonked_expr ->
278 zonkTcType all_expr_ty `thenNF_Tc` \ zonked_ty ->
279 ioToTc (dumpIfSet_dyn dflags
280 Opt_D_dump_tc "Typechecked" (ppr zonked_expr)) `thenNF_Tc_`
281 returnTc (new_pcs, zonked_expr, [], zonked_ty)
284 get_fixity :: Name -> Maybe Fixity
285 get_fixity n = pprPanic "typecheckExpr" (ppr n)
287 smpl_doc = ptext SLIT("main expression")
290 %************************************************************************
292 \subsection{Typechecking a module}
294 %************************************************************************
299 -> PersistentCompilerState
301 -> ModIface -- Iface for this module
302 -> PrintUnqualified -- For error printing
304 -> IO (Maybe (PersistentCompilerState, TcResults))
305 -- The new PCS is Augmented with imported information,
306 -- (but not stuff from this module)
310 -- All these fields have info *just for this module*
311 tc_env :: TypeEnv, -- The top level TypeEnv
312 tc_insts :: [DFunId], -- Instances
313 tc_rules :: [TypecheckedRuleDecl], -- Transformation rules
314 tc_binds :: TypecheckedMonoBinds, -- Bindings
315 tc_fords :: [TypecheckedForeignDecl] -- Foreign import & exports.
319 typecheckModule dflags pcs hst mod_iface unqual decls
320 = do { maybe_tc_result <- typecheck dflags pcs hst unqual $
321 tcModule pcs hst get_fixity this_mod decls
322 ; printTcDump dflags unqual maybe_tc_result
323 ; return maybe_tc_result }
325 this_mod = mi_module mod_iface
326 fixity_env = mi_fixities mod_iface
328 get_fixity :: Name -> Maybe Fixity
329 get_fixity nm = lookupNameEnv fixity_env nm
332 tcModule :: PersistentCompilerState
334 -> (Name -> Maybe Fixity)
337 -> TcM (PersistentCompilerState, TcResults)
339 tcModule pcs hst get_fixity this_mod decls
340 = fixTc (\ ~(unf_env, _, _) ->
341 -- Loop back the final environment, including the fully zonked
342 -- versions of bindings from this module. In the presence of mutual
343 -- recursion, interface type signatures may mention variables defined
344 -- in this module, which is why the knot is so big
346 -- Type-check the type and class decls, and all imported decls
347 tcImports unf_env pcs hst get_fixity this_mod decls
348 `thenTc` \ (env, new_pcs, local_insts, deriv_binds, local_rules) ->
352 -- Foreign import declarations next
353 traceTc (text "Tc4") `thenNF_Tc_`
354 tcForeignImports decls `thenTc` \ (fo_ids, foi_decls) ->
355 tcExtendGlobalValEnv fo_ids $
357 -- Default declarations
358 tcDefaults decls `thenTc` \ defaulting_tys ->
359 tcSetDefaultTys defaulting_tys $
361 -- Value declarations next.
362 -- We also typecheck any extra binds that came out of the "deriving" process
363 traceTc (text "Default types" <+> ppr defaulting_tys) `thenNF_Tc_`
364 traceTc (text "Tc5") `thenNF_Tc_`
365 tcTopBinds (val_binds `ThenBinds` deriv_binds) `thenTc` \ ((val_binds, env), lie_valdecls) ->
367 -- Second pass over class and instance declarations,
368 -- plus rules and foreign exports, to generate bindings
370 tcInstDecls2 local_insts `thenNF_Tc` \ (lie_instdecls, inst_binds) ->
371 tcClassDecls2 this_mod tycl_decls `thenNF_Tc` \ (lie_clasdecls, cls_dm_binds) ->
372 tcForeignExports decls `thenTc` \ (lie_fodecls, foe_binds, foe_decls) ->
373 tcSourceRules source_rules `thenNF_Tc` \ (lie_rules, more_local_rules) ->
375 -- CHECK THAT main IS DEFINED WITH RIGHT TYPE, IF REQUIRED
376 traceTc (text "Tc6") `thenNF_Tc_`
377 tcCheckMain this_mod `thenTc_`
379 -- Deal with constant or ambiguous InstIds. How could
380 -- there be ambiguous ones? They can only arise if a
381 -- top-level decl falls under the monomorphism
382 -- restriction, and no subsequent decl instantiates its
383 -- type. (Usually, ambiguous type variables are resolved
384 -- during the generalisation step.)
386 -- Note that we must do this *after* tcCheckMain, because of the
387 -- following bizarre case:
389 -- Here, we infer main :: forall a. m a, where m is a free
390 -- type variable. tcCheckMain will unify it with IO, and that
391 -- must happen before tcSimplifyTop, since the latter will report
394 lie_alldecls = lie_valdecls `plusLIE`
395 lie_instdecls `plusLIE`
396 lie_clasdecls `plusLIE`
397 lie_fodecls `plusLIE`
400 tcSimplifyTop lie_alldecls `thenTc` \ const_inst_binds ->
401 traceTc (text "endsimpltop") `thenTc_`
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)
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 decls
476 = do { maybe_tc_stuff <- typecheck dflags 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
646 -> PersistentCompilerState
648 -> PrintUnqualified -- For error printing
652 typecheck dflags pcs hst unqual thing_inside
653 = do { showPass dflags "Typechecker";
654 ; env <- initTcEnv hst (pcs_PTE pcs)
656 ; (maybe_tc_result, errs) <- initTc dflags env thing_inside
658 ; printErrorsAndWarnings unqual errs
660 ; if errorsFound errs then
663 return maybe_tc_result
668 %************************************************************************
670 \subsection{Dumping output}
672 %************************************************************************
675 printTcDump dflags unqual Nothing = return ()
676 printTcDump dflags unqual (Just (_, results))
677 = do if dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags then
678 printForUser stdout unqual (dump_tc_iface dflags 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 dflags 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 if dopt Opt_Generics dflags then
697 ppr_gen_tycons [tc | ATyCon tc <- nameEnvElts (tc_env results)]
703 ppr_rules rs = vcat [ptext SLIT("{-# RULES"),
704 nest 4 (vcat (map ppr rs)),
707 ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"),
708 vcat (map ppr_gen_tycon tcs),
712 -- x&y are now Id's, not CoreExpr's
714 | Just ep <- tyConGenInfo tycon
715 = (ppr tycon <> colon) $$ nest 4 (ppr_ep ep)
717 | otherwise = ppr tycon <> colon <+> ptext SLIT("Not derivable")
720 = vcat [ ptext SLIT("Rep type:") <+> ppr (tcFunResultTy from_tau),
721 ptext SLIT("From:") <+> ppr (unfoldingTemplate (idUnfolding from)),
722 ptext SLIT("To:") <+> ppr (unfoldingTemplate (idUnfolding to))
725 (_,from_tau) = tcSplitForAllTys (idType from)