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 isSourceInstDecl, 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,
26 RenamedHsExpr, RenamedRuleDecl, RenamedTyClDecl, RenamedInstDecl )
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 tcExtendGlobalEnv, tcExtendGlobalTypeEnv,
49 tcLookupGlobalId, tcLookupTyCon,
50 TcTyThing(..), TyThing(..), tcLookupId
52 import TcRules ( tcIfaceRules, tcSourceRules )
53 import TcForeign ( tcForeignImports, tcForeignExports )
54 import TcIfaceSig ( tcInterfaceSigs )
55 import TcInstDcls ( tcInstDecls1, tcIfaceInstDecls1, addInstDFuns, initInstEnv, tcInstDecls2 )
56 import TcUnify ( unifyTauTy )
57 import TcSimplify ( tcSimplifyTop, tcSimplifyInfer )
58 import TcTyClsDecls ( tcTyAndClassDecls )
59 import CoreUnfold ( unfoldingTemplate )
60 import TysWiredIn ( mkListTy, unitTy )
61 import ErrUtils ( printErrorsAndWarnings, errorsFound,
62 dumpIfSet_dyn, dumpIfSet_dyn_or, showPass )
63 import Rules ( extendRuleBase )
64 import Id ( Id, idType, idUnfolding )
65 import Module ( Module, moduleName )
67 import NameEnv ( lookupNameEnv )
68 import TyCon ( tyConGenInfo )
69 import BasicTypes ( EP(..), Fixity, RecFlag(..) )
70 import SrcLoc ( noSrcLoc )
73 import HscTypes ( PersistentCompilerState(..), HomeSymbolTable,
74 PackageTypeEnv, ModIface(..),
75 ModDetails(..), DFunId,
76 TypeEnv, extendTypeEnvList, typeEnvTyCons, typeEnvElts,
79 import List ( partition )
83 %************************************************************************
85 \subsection{The stmt interface}
87 %************************************************************************
92 -> PersistentCompilerState
94 -> TypeEnv -- The interactive context's type envt
95 -> PrintUnqualified -- For error printing
96 -> Module -- Is this really needed
97 -> [Name] -- Names bound by the Stmt (empty for expressions)
98 -> (RenamedStmt, -- The stmt itself
99 [RenamedHsDecl]) -- Plus extra decls it sucked in from interface files
100 -> IO (Maybe (PersistentCompilerState,
104 -- The returned [Id] is the same as the input except for
105 -- ExprStmt, in which case the returned [Name] is [itName]
107 typecheckStmt dflags pcs hst ic_type_env unqual this_mod names (stmt, iface_decls)
108 = typecheck dflags pcs hst unqual $
110 -- use the default default settings, i.e. [Integer, Double]
111 tcSetDefaultTys defaultDefaultTys $
113 -- Typecheck the extra declarations
114 tcExtraDecls pcs hst this_mod iface_decls `thenTc` \ (new_pcs, env) ->
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 Here is the grand plan, implemented in tcUserStmt
134 What you type The IO [HValue] that hscStmt returns
135 ------------- ------------------------------------
136 let pat = expr ==> let pat = expr in return [coerce HVal x, coerce HVal y, ...]
139 pat <- expr ==> expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
142 expr (of IO type) ==> expr >>= \ v -> return [v]
143 [NB: result not printed] bindings: [it]
146 expr (of non-IO type,
147 result showable) ==> let v = expr in print v >> return [v]
150 expr (of non-IO type,
151 result not showable) ==> error
155 tcUserStmt :: [Name] -> RenamedStmt -> TcM (TypecheckedHsExpr, [Id])
157 tcUserStmt names (ExprStmt expr _ loc)
158 = ASSERT( null names )
159 tcGetUnique `thenNF_Tc` \ uniq ->
161 fresh_it = itName uniq
162 the_bind = FunMonoBind fresh_it False
163 [ mkSimpleMatch [] expr placeHolderType loc ] loc
165 tryTc_ (traceTc (text "tcs 1b") `thenNF_Tc_`
166 tc_stmts [fresh_it] [
167 LetStmt (MonoBind the_bind [] NonRecursive),
168 ExprStmt (HsApp (HsVar printName) (HsVar fresh_it)) placeHolderType loc])
169 ( traceTc (text "tcs 1a") `thenNF_Tc_`
170 tc_stmts [fresh_it] [BindStmt (VarPatIn fresh_it) expr loc])
172 tcUserStmt names stmt
173 = tc_stmts names [stmt]
177 = tcLookupGlobalId returnIOName `thenNF_Tc` \ return_id ->
178 tcLookupGlobalId bindIOName `thenNF_Tc` \ bind_id ->
179 tcLookupGlobalId failIOName `thenNF_Tc` \ fail_id ->
180 tcLookupTyCon ioTyConName `thenNF_Tc` \ ioTyCon ->
181 newTyVarTy liftedTypeKind `thenNF_Tc` \ res_ty ->
183 io_ty = (\ ty -> mkTyConApp ioTyCon [ty], res_ty)
185 -- mk_return builds the expression
186 -- returnIO @ [()] [coerce () x, .., coerce () z]
187 mk_return ids = HsApp (TyApp (HsVar return_id) [mkListTy unitTy])
188 (ExplicitList unitTy (map mk_item ids))
190 mk_item id = HsApp (TyApp (HsVar unsafeCoerceId) [idType id, unitTy])
194 traceTc (text "tcs 2") `thenNF_Tc_`
195 tcStmtsAndThen combine (DoCtxt DoExpr) io_ty stmts (
196 -- Look up the names right in the middle,
197 -- where they will all be in scope
198 mapNF_Tc tcLookupId names `thenNF_Tc` \ ids ->
199 returnTc ((ids, [ResultStmt (mk_return ids) noSrcLoc]), emptyLIE)
200 ) `thenTc` \ ((ids, tc_stmts), lie) ->
202 -- Simplify the context right here, so that we fail
203 -- if there aren't enough instances. Notably, when we see
205 -- we use tryTc_ to try it <- e
206 -- and then let it = e
207 -- It's the simplify step that rejects the first.
209 traceTc (text "tcs 3") `thenNF_Tc_`
210 tcSimplifyTop lie `thenTc` \ const_binds ->
211 traceTc (text "tcs 4") `thenNF_Tc_`
213 returnTc (mkHsLet const_binds $
214 HsDoOut DoExpr tc_stmts return_id bind_id fail_id
215 (mkTyConApp ioTyCon [mkListTy unitTy]) noSrcLoc,
218 combine stmt (ids, stmts) = (ids, stmt:stmts)
221 %************************************************************************
223 \subsection{Typechecking an expression}
225 %************************************************************************
228 typecheckExpr :: DynFlags
229 -> PersistentCompilerState
231 -> TypeEnv -- The interactive context's type envt
232 -> PrintUnqualified -- For error printing
234 -> (RenamedHsExpr, -- The expression itself
235 [RenamedHsDecl]) -- Plus extra decls it sucked in from interface files
236 -> IO (Maybe (PersistentCompilerState,
238 [Id], -- always empty (matches typecheckStmt)
241 typecheckExpr dflags pcs hst ic_type_env unqual this_mod (expr, decls)
242 = typecheck dflags pcs hst unqual $
244 -- use the default default settings, i.e. [Integer, Double]
245 tcSetDefaultTys defaultDefaultTys $
247 -- Typecheck the extra declarations
248 tcExtraDecls pcs hst this_mod decls `thenTc` \ (new_pcs, env) ->
250 -- Now typecheck the expression
252 tcExtendGlobalTypeEnv ic_type_env $
254 newTyVarTy openTypeKind `thenTc` \ ty ->
255 tcMonoExpr expr ty `thenTc` \ (e', lie) ->
256 tcSimplifyInfer smpl_doc (tyVarsOfType ty) lie
257 `thenTc` \ (qtvs, lie_free, dict_binds, dict_ids) ->
258 tcSimplifyTop lie_free `thenTc` \ const_binds ->
260 let all_expr = mkHsLet const_binds $
266 all_expr_ty = mkForAllTys qtvs $
267 mkFunTys (map idType dict_ids) $
271 zonkExpr all_expr `thenNF_Tc` \ zonked_expr ->
272 zonkTcType all_expr_ty `thenNF_Tc` \ zonked_ty ->
273 ioToTc (dumpIfSet_dyn dflags
274 Opt_D_dump_tc "Typechecked" (ppr zonked_expr)) `thenNF_Tc_`
275 returnTc (new_pcs, zonked_expr, [], zonked_ty)
278 smpl_doc = ptext SLIT("main expression")
281 %************************************************************************
283 \subsection{Typechecking extra declarations}
285 %************************************************************************
290 -> PersistentCompilerState
292 -> PrintUnqualified -- For error printing
293 -> Module -- Is this really needed
294 -> [RenamedHsDecl] -- extra decls sucked in from interface files
295 -> IO (Maybe PersistentCompilerState)
297 typecheckExtraDecls dflags pcs hst unqual this_mod decls
298 = typecheck dflags pcs hst unqual $
299 tcExtraDecls pcs hst this_mod decls `thenTc` \ (new_pcs, _) ->
302 tcExtraDecls :: PersistentCompilerState
306 -> TcM (PersistentCompilerState, TcEnv)
307 -- Returned environment includes instances
309 tcExtraDecls pcs hst this_mod decls
310 = tcIfaceImports this_mod decls `thenTc` \ (env, all_things, dfuns, rules) ->
311 addInstDFuns (pcs_insts pcs) dfuns `thenNF_Tc` \ new_pcs_insts ->
313 new_pcs_pte = extendTypeEnvList (pcs_PTE pcs) all_things
314 new_pcs_rules = addIfaceRules (pcs_rules pcs) rules
316 new_pcs :: PersistentCompilerState
317 new_pcs = pcs { pcs_PTE = new_pcs_pte,
318 pcs_insts = new_pcs_insts,
319 pcs_rules = new_pcs_rules
322 -- Initialise the instance environment
324 initInstEnv new_pcs hst `thenNF_Tc` \ inst_env ->
325 tcSetInstEnv inst_env tcGetEnv
326 ) `thenNF_Tc` \ new_env ->
327 returnTc (new_pcs, new_env)
331 %************************************************************************
333 \subsection{Typechecking a module}
335 %************************************************************************
340 -> PersistentCompilerState
342 -> ModIface -- Iface for this module
343 -> PrintUnqualified -- For error printing
345 -> IO (Maybe (PersistentCompilerState, TcResults))
346 -- The new PCS is Augmented with imported information,
347 -- (but not stuff from this module)
351 -- All these fields have info *just for this module*
352 tc_env :: TypeEnv, -- The top level TypeEnv
353 tc_insts :: [DFunId], -- Instances
354 tc_rules :: [TypecheckedRuleDecl], -- Transformation rules
355 tc_binds :: TypecheckedMonoBinds, -- Bindings
356 tc_fords :: [TypecheckedForeignDecl] -- Foreign import & exports.
360 typecheckModule dflags pcs hst mod_iface unqual decls
361 = do { maybe_tc_result <- typecheck dflags pcs hst unqual $
362 tcModule pcs hst get_fixity this_mod decls
363 ; printTcDump dflags unqual maybe_tc_result
364 ; return maybe_tc_result }
366 this_mod = mi_module mod_iface
367 fixity_env = mi_fixities mod_iface
369 get_fixity :: Name -> Maybe Fixity
370 get_fixity nm = lookupNameEnv fixity_env nm
373 tcModule :: PersistentCompilerState
375 -> (Name -> Maybe Fixity)
378 -> TcM (PersistentCompilerState, TcResults)
380 tcModule pcs hst get_fixity this_mod decls
381 = fixTc (\ ~(unf_env, _, _) ->
382 -- Loop back the final environment, including the fully zonked
383 -- versions of bindings from this module. In the presence of mutual
384 -- recursion, interface type signatures may mention variables defined
385 -- in this module, which is why the knot is so big
387 -- Type-check the type and class decls, and all imported decls
388 tcImports unf_env pcs hst get_fixity this_mod
389 tycl_decls iface_inst_decls iface_rule_decls `thenTc` \ (env1, new_pcs) ->
393 -- Do the source-language instances, including derivings
394 initInstEnv new_pcs hst `thenNF_Tc` \ inst_env1 ->
395 tcInstDecls1 (pcs_PRS new_pcs) inst_env1
397 tycl_decls src_inst_decls `thenTc` \ (inst_env2, inst_info, deriv_binds) ->
398 tcSetInstEnv inst_env2 $
400 -- Foreign import declarations next
401 traceTc (text "Tc4") `thenNF_Tc_`
402 tcForeignImports decls `thenTc` \ (fo_ids, foi_decls) ->
403 tcExtendGlobalValEnv fo_ids $
405 -- Default declarations
406 tcDefaults decls `thenTc` \ defaulting_tys ->
407 tcSetDefaultTys defaulting_tys $
409 -- Value declarations next.
410 -- We also typecheck any extra binds that came out of the "deriving" process
411 traceTc (text "Default types" <+> ppr defaulting_tys) `thenNF_Tc_`
412 traceTc (text "Tc5") `thenNF_Tc_`
413 tcTopBinds (val_binds `ThenBinds` deriv_binds) `thenTc` \ ((val_binds, env2), lie_valdecls) ->
415 -- Second pass over class and instance declarations,
416 -- plus rules and foreign exports, to generate bindings
418 traceTc (text "Tc6") `thenNF_Tc_`
419 traceTc (ppr (getTcGEnv env2)) `thenNF_Tc_`
420 tcClassDecls2 this_mod tycl_decls `thenNF_Tc` \ (lie_clasdecls, cls_dm_binds, dm_ids) ->
421 tcExtendGlobalValEnv dm_ids $
422 traceTc (text "Tc7") `thenNF_Tc_`
423 tcInstDecls2 inst_info `thenNF_Tc` \ (lie_instdecls, inst_binds) ->
424 traceTc (text "Tc8") `thenNF_Tc_`
425 tcForeignExports decls `thenTc` \ (lie_fodecls, foe_binds, foe_decls) ->
426 traceTc (text "Tc9") `thenNF_Tc_`
427 tcSourceRules src_rule_decls `thenNF_Tc` \ (lie_rules, src_rules) ->
429 -- CHECK THAT main IS DEFINED WITH RIGHT TYPE, IF REQUIRED
430 traceTc (text "Tc10") `thenNF_Tc_`
431 tcCheckMain this_mod `thenTc_`
433 -- Deal with constant or ambiguous InstIds. How could
434 -- there be ambiguous ones? They can only arise if a
435 -- top-level decl falls under the monomorphism
436 -- restriction, and no subsequent decl instantiates its
437 -- type. (Usually, ambiguous type variables are resolved
438 -- during the generalisation step.)
440 -- Note that we must do this *after* tcCheckMain, because of the
441 -- following bizarre case:
443 -- Here, we infer main :: forall a. m a, where m is a free
444 -- type variable. tcCheckMain will unify it with IO, and that
445 -- must happen before tcSimplifyTop, since the latter will report
448 lie_alldecls = lie_valdecls `plusLIE`
449 lie_instdecls `plusLIE`
450 lie_clasdecls `plusLIE`
451 lie_fodecls `plusLIE`
454 tcSimplifyTop lie_alldecls `thenTc` \ const_inst_binds ->
455 traceTc (text "endsimpltop") `thenTc_`
457 -- Backsubstitution. This must be done last.
458 -- Even tcSimplifyTop may do some unification.
460 all_binds = val_binds `AndMonoBinds`
461 inst_binds `AndMonoBinds`
462 cls_dm_binds `AndMonoBinds`
463 const_inst_binds `AndMonoBinds`
466 traceTc (text "Tc7") `thenNF_Tc_`
467 zonkTopBinds all_binds `thenNF_Tc` \ (all_binds', final_env) ->
469 -- zonkTopBinds puts all the top-level Ids into the tcGEnv
470 traceTc (text "Tc8") `thenNF_Tc_`
471 zonkForeignExports foe_decls `thenNF_Tc` \ foe_decls' ->
472 traceTc (text "Tc9") `thenNF_Tc_`
473 zonkRules src_rules `thenNF_Tc` \ src_rules' ->
476 let src_things = filter (isLocalThing this_mod) (typeEnvElts (getTcGEnv final_env))
477 -- This is horribly crude; the env might be jolly big
479 traceTc (text "Tc10") `thenNF_Tc_`
482 TcResults { tc_env = mkTypeEnv src_things,
483 tc_insts = map iDFunId inst_info,
484 tc_binds = all_binds',
485 tc_fords = foi_decls ++ foe_decls',
486 tc_rules = src_rules'
489 ) `thenTc` \ (_, pcs, tc_result) ->
490 returnTc (pcs, tc_result)
492 tycl_decls = [d | TyClD d <- decls]
493 rule_decls = [d | RuleD d <- decls]
494 inst_decls = [d | InstD d <- decls]
495 val_decls = [d | ValD d <- decls]
497 (src_inst_decls, iface_inst_decls) = partition isSourceInstDecl inst_decls
498 (src_rule_decls, iface_rule_decls) = partition (isSourceRuleDecl this_mod) rule_decls
499 val_binds = foldr ThenBinds EmptyBinds val_decls
503 %************************************************************************
505 \subsection{Typechecking interface decls}
507 %************************************************************************
512 -> PersistentCompilerState
514 -> ModIface -- Iface for this module (just module & fixities)
516 -> IO (Maybe (PersistentCompilerState, ModDetails))
517 -- The new PCS is Augmented with imported information,
518 -- (but not stuff from this module).
520 typecheckIface dflags pcs hst mod_iface decls
521 = do { maybe_tc_stuff <- typecheck dflags pcs hst alwaysQualify $
522 tcIface pcs this_mod decls
523 ; printIfaceDump dflags maybe_tc_stuff
524 ; return maybe_tc_stuff }
526 this_mod = mi_module mod_iface
528 tcIface pcs this_mod decls
529 -- The decls are coming from this_mod's interface file, together
530 -- with imported interface decls that belong in the "package" stuff.
531 -- (With GHCi, all the home modules have already been processed.)
532 -- That is why we need to do the partitioning below.
533 = tcIfaceImports this_mod decls `thenTc` \ (_, all_things, dfuns, rules) ->
536 -- Do the partitioning (see notes above)
537 (local_things, imported_things) = partition (isLocalThing this_mod) all_things
538 (local_rules, imported_rules) = partition is_local_rule rules
539 (local_dfuns, imported_dfuns) = partition (isLocalThing this_mod) dfuns
540 is_local_rule (IfaceRuleOut n _) = isLocalThing this_mod n
542 addInstDFuns (pcs_insts pcs) imported_dfuns `thenNF_Tc` \ new_pcs_insts ->
544 new_pcs_pte :: PackageTypeEnv
545 new_pcs_pte = extendTypeEnvList (pcs_PTE pcs) imported_things
546 new_pcs_rules = addIfaceRules (pcs_rules pcs) imported_rules
548 new_pcs :: PersistentCompilerState
549 new_pcs = pcs { pcs_PTE = new_pcs_pte,
550 pcs_insts = new_pcs_insts,
551 pcs_rules = new_pcs_rules
554 mod_details = ModDetails { md_types = mkTypeEnv local_things,
555 md_insts = local_dfuns,
556 md_rules = [(id,rule) | IfaceRuleOut id rule <- local_rules],
558 -- All the rules from an interface are of the IfaceRuleOut form
560 returnTc (new_pcs, mod_details)
563 tcIfaceImports :: Module
564 -> [RenamedHsDecl] -- All interface-file decls
565 -> TcM (TcEnv, [TyThing], [DFunId], [TypecheckedRuleDecl])
566 tcIfaceImports this_mod decls
567 -- The decls are all interface-file declarations
569 inst_decls = [d | InstD d <- decls]
570 tycl_decls = [d | TyClD d <- decls]
571 rule_decls = [d | RuleD d <- decls]
573 fixTc (\ ~(unf_env, _, _, _) ->
574 -- This fixTc follows the same general plan as tcImports,
575 -- which is better commented (below)
576 tcTyAndClassDecls unf_env this_mod tycl_decls `thenTc` \ tycl_things ->
577 tcExtendGlobalEnv tycl_things $
578 tcInterfaceSigs unf_env this_mod tycl_decls `thenTc` \ sig_ids ->
579 tcExtendGlobalValEnv sig_ids $
580 tcIfaceInstDecls1 inst_decls `thenTc` \ dfuns ->
581 tcIfaceRules rule_decls `thenTc` \ rules ->
582 tcGetEnv `thenTc` \ env ->
584 all_things = map AnId sig_ids ++ tycl_things
586 returnTc (env, all_things, dfuns, rules)
590 tcImports :: RecTcEnv
591 -> PersistentCompilerState
593 -> (Name -> Maybe Fixity)
598 -> TcM (TcEnv, PersistentCompilerState)
600 -- tcImports is a slight mis-nomer.
601 -- It deals with everything that could be an import:
602 -- type and class decls (some source, some imported)
603 -- interface signatures (checked lazily)
604 -- instance decls (some source, some imported)
605 -- rule decls (all imported)
606 -- These can occur in source code too, of course
608 -- tcImports is only called when processing source code,
609 -- so that any interface-file declarations are for other modules, not this one
611 tcImports unf_env pcs hst get_fixity this_mod
612 tycl_decls inst_decls rule_decls
613 -- (unf_env :: RecTcEnv) is used for type-checking interface pragmas
614 -- which is done lazily [ie failure just drops the pragma
615 -- without having any global-failure effect].
617 -- unf_env is also used to get the pragama info
618 -- for imported dfuns and default methods
621 -- tcImports recovers internally, but if anything gave rise to
622 -- an error we'd better stop now, to avoid a cascade
624 traceTc (text "Tc1") `thenNF_Tc_`
625 tcTyAndClassDecls unf_env this_mod tycl_decls `thenTc` \ tycl_things ->
626 tcExtendGlobalEnv tycl_things $
628 -- Interface type signatures
629 -- We tie a knot so that the Ids read out of interfaces are in scope
630 -- when we read their pragmas.
631 -- What we rely on is that pragmas are typechecked lazily; if
632 -- any type errors are found (ie there's an inconsistency)
633 -- we silently discard the pragma
634 traceTc (text "Tc2") `thenNF_Tc_`
635 tcInterfaceSigs unf_env this_mod tycl_decls `thenTc` \ sig_ids ->
636 tcExtendGlobalValEnv sig_ids $
638 -- Typecheck the instance decls, includes deriving
639 -- Note that imported dictionary functions are already
640 -- in scope from the preceding tcInterfaceSigs
641 traceTc (text "Tc3") `thenNF_Tc_`
642 tcIfaceInstDecls1 inst_decls `thenTc` \ dfuns ->
643 tcIfaceRules rule_decls `thenNF_Tc` \ rules ->
645 addInstDFuns (pcs_insts pcs) dfuns `thenNF_Tc` \ new_pcs_insts ->
646 tcGetEnv `thenTc` \ unf_env ->
648 -- sometimes we're compiling in the context of a package module
649 -- (on the GHCi command line, for example). In this case, we
650 -- want to treat everything we pulled in as an imported thing.
651 imported_things = map AnId sig_ids ++ -- All imported
652 filter (not . isLocalThing this_mod) tycl_things
654 new_pte :: PackageTypeEnv
655 new_pte = extendTypeEnvList (pcs_PTE pcs) imported_things
657 new_pcs_rules = addIfaceRules (pcs_rules pcs) rules
659 new_pcs :: PersistentCompilerState
660 new_pcs = pcs { pcs_PTE = new_pte,
661 pcs_insts = new_pcs_insts,
662 pcs_rules = new_pcs_rules
665 returnTc (unf_env, new_pcs)
667 isSourceRuleDecl :: Module -> RenamedRuleDecl -> Bool
668 -- This is a bit gruesome.
669 -- Usually, HsRules come only from source files; IfaceRules only from interface files
670 -- But built-in rules appear as an IfaceRuleOut... and when compiling
671 -- the source file for that built-in rule, we want to treat it as a source
672 -- rule, so it gets put with the other rules for that module.
673 isSourceRuleDecl this_mod (HsRule _ _ _ _ _ _) = True
674 isSourceRuleDecl this_mod (IfaceRule _ _ _ n _ _ _) = False
675 isSourceRuleDecl this_mod (IfaceRuleOut name _) = isLocalThing this_mod name
677 addIfaceRules rule_base rules
678 = foldl add_rule rule_base rules
680 add_rule rule_base (IfaceRuleOut id rule) = extendRuleBase rule_base (id, rule)
684 %************************************************************************
686 \subsection{Checking the type of main}
688 %************************************************************************
690 We must check that in module Main,
692 b) main :: forall a1...an. IO t, for some type t
696 then the type of main will be
698 and that should pass the test too.
700 So we just instantiate the type and unify with IO t, and declare
701 victory if doing so succeeds.
704 tcCheckMain :: Module -> TcM ()
706 | not (moduleName this_mod == mAIN_Name )
710 = -- First unify the main_id with IO t, for any old t
711 tcLookup_maybe mainName `thenNF_Tc` \ maybe_thing ->
713 Just (ATcId main_id) -> check_main_ty (idType main_id)
714 other -> addErrTc noMainErr
716 check_main_ty main_ty
717 = tcInstType main_ty `thenNF_Tc` \ (tvs, theta, main_tau) ->
718 newTyVarTy liftedTypeKind `thenNF_Tc` \ arg_ty ->
719 tcLookupTyCon ioTyConName `thenNF_Tc` \ ioTyCon ->
720 tcAddErrCtxtM (mainTypeCtxt main_ty) $
721 if not (null theta) then
722 failWithTc empty -- Context has the error message
724 unifyTauTy main_tau (mkTyConApp ioTyCon [arg_ty])
726 mainTypeCtxt main_ty tidy_env
727 = zonkTcType main_ty `thenNF_Tc` \ main_ty' ->
728 returnNF_Tc (tidy_env, ptext SLIT("`main' has the illegal type") <+>
729 quotes (ppr (tidyType tidy_env main_ty')))
731 noMainErr = hsep [ptext SLIT("Module") <+> quotes (ppr mAIN_Name),
732 ptext SLIT("must include a definition for") <+> quotes (ptext SLIT("main"))]
736 %************************************************************************
738 \subsection{Interfacing the Tc monad to the IO monad}
740 %************************************************************************
743 typecheck :: DynFlags
744 -> PersistentCompilerState
746 -> PrintUnqualified -- For error printing
750 typecheck dflags pcs hst unqual thing_inside
751 = do { showPass dflags "Typechecker";
752 ; env <- initTcEnv hst (pcs_PTE pcs)
754 ; (maybe_tc_result, errs) <- initTc dflags env thing_inside
756 ; printErrorsAndWarnings unqual errs
758 ; if errorsFound errs then
761 return maybe_tc_result
766 %************************************************************************
768 \subsection{Dumping output}
770 %************************************************************************
773 printTcDump dflags unqual Nothing = return ()
774 printTcDump dflags unqual (Just (_, results))
775 = do if dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags then
776 printForUser stdout unqual (dump_tc_iface dflags results)
779 dumpIfSet_dyn dflags Opt_D_dump_tc
780 "Typechecked" (ppr (tc_binds results))
783 printIfaceDump dflags Nothing = return ()
784 printIfaceDump dflags (Just (_, details))
785 = dumpIfSet_dyn_or dflags [Opt_D_dump_types, Opt_D_dump_tc]
786 "Interface" (pprModDetails details)
788 dump_tc_iface dflags results
789 = vcat [pprModDetails (ModDetails {md_types = tc_env results,
790 md_insts = tc_insts results,
791 md_rules = [], md_binds = []}) ,
792 ppr_rules (tc_rules results),
794 if dopt Opt_Generics dflags then
795 ppr_gen_tycons (typeEnvTyCons (tc_env results))
801 ppr_rules rs = vcat [ptext SLIT("{-# RULES"),
802 nest 4 (vcat (map ppr rs)),
805 ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"),
806 vcat (map ppr_gen_tycon tcs),
810 -- x&y are now Id's, not CoreExpr's
812 | Just ep <- tyConGenInfo tycon
813 = (ppr tycon <> colon) $$ nest 4 (ppr_ep ep)
815 | otherwise = ppr tycon <> colon <+> ptext SLIT("Not derivable")
818 = vcat [ ptext SLIT("Rep type:") <+> ppr (tcFunResultTy from_tau),
819 ptext SLIT("From:") <+> ppr (unfoldingTemplate (idUnfolding from)),
820 ptext SLIT("To:") <+> ppr (unfoldingTemplate (idUnfolding to))
823 (_,from_tau) = tcSplitForAllTys (idType from)