2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[TcModule]{Typechecking a whole module}
7 #include "HsVersions.h"
15 import HsSyn ( HsModule(..), HsBinds(..), Bind, HsExpr,
16 TyDecl, SpecDataSig, ClassDecl, InstDecl,
17 SpecInstSig, DefaultDecl, Sig, Fake, InPat,
18 FixityDecl, IE, ImportDecl
20 import RnHsSyn ( RenamedHsModule(..), RenamedFixityDecl(..) )
21 import TcHsSyn ( TypecheckedHsBinds(..), TypecheckedHsExpr(..),
22 TcIdOcc(..), zonkBinds, zonkInst, zonkId )
25 import Inst ( Inst, plusLIE )
26 import TcBinds ( tcBindsAndThen )
27 import TcClassDcl ( tcClassDecls2 )
28 import TcDefaults ( tcDefaults )
29 import TcEnv ( tcExtendGlobalValEnv, getEnv_LocalIds,
30 getEnv_TyCons, getEnv_Classes,
31 tcLookupLocalValueByKey, tcLookupTyConByKey )
32 import TcIfaceSig ( tcInterfaceSigs )
33 import TcInstDcls ( tcInstDecls1, tcInstDecls2 )
34 import TcInstUtil ( buildInstanceEnvs, InstInfo )
35 import TcSimplify ( tcSimplifyTop )
36 import TcTyClsDecls ( tcTyAndClassDecls1 )
38 import Bag ( listToBag )
39 import Class ( GenClass )
40 import Id ( GenId, isDataCon, isMethodSelId, idType )
41 import Maybes ( catMaybes )
42 import Name ( isExported, isLocallyDefined )
43 import PrelInfo ( unitTy, mkPrimIoTy )
45 import RnUtils ( GlobalNameMappers(..), GlobalNameMapper(..) )
46 import TyCon ( TyCon )
47 import Type ( applyTyCon )
48 import Unify ( unifyTauTy )
49 import UniqFM ( lookupUFM_Directly, lookupWithDefaultUFM_Directly,
51 import Unique ( iOTyConKey, mainIdKey, mainPrimIOIdKey )
55 import FiniteMap ( emptyFM )
62 tcModule :: GlobalNameMappers -- final renamer info for derivings
63 -> RenamedHsModule -- input
64 -> TcM s ((TypecheckedHsBinds, -- record selector binds
65 TypecheckedHsBinds, -- binds from class decls; does NOT
66 -- include default-methods bindings
67 TypecheckedHsBinds, -- binds from instance decls; INCLUDES
68 -- class default-methods binds
69 TypecheckedHsBinds, -- binds from value decls
71 [(Id, TypecheckedHsExpr)]), -- constant instance binds
73 ([RenamedFixityDecl], [Id], [TyCon], [Class], Bag InstInfo),
74 -- things for the interface generator
77 -- environments of info from this module only
79 FiniteMap TyCon [(Bool, [Maybe Type])],
80 -- source tycon specialisation requests
82 PprStyle -> Pretty) -- -ddump-deriving info
84 tcModule renamer_name_funs
85 (HsModule mod_name verion exports imports fixities
86 ty_decls specdata_sigs cls_decls inst_decls specinst_sigs
87 default_decls val_decls sigs src_loc)
89 = ASSERT(null imports)
91 tcAddSrcLoc src_loc $ -- record where we're starting
93 -- Tie the knot for inteface-file value declaration signatures
94 -- This info is only used inside the knot for type-checking the
95 -- pragmas, which is done lazily [ie failure just drops the pragma
96 -- without having any global-failure effect].
98 fixTc (\ ~(_, _, _, _, _, _, sig_ids) ->
99 tcExtendGlobalValEnv sig_ids (
101 -- The knot for instance information. This isn't used at all
102 -- till we type-check value declarations
103 fixTc ( \ ~(rec_inst_mapper, _, _, _, _, _) ->
105 -- Type-check the type and class decls
106 trace "tcTyAndClassDecls:" $
107 tcTyAndClassDecls1 rec_inst_mapper ty_decls_bag cls_decls_bag
108 `thenTc` \ (env, record_binds) ->
110 -- Typecheck the instance decls, includes deriving
112 trace "tcInstDecls:" $
113 tcInstDecls1 inst_decls_bag specinst_sigs
114 mod_name renamer_name_funs fixities
115 ) `thenTc` \ (inst_info, deriv_binds, ddump_deriv) ->
117 buildInstanceEnvs inst_info `thenTc` \ inst_mapper ->
119 returnTc (inst_mapper, env, record_binds, inst_info, deriv_binds, ddump_deriv)
121 ) `thenTc` \ (_, env, record_binds, inst_info, deriv_binds, ddump_deriv) ->
124 -- Default declarations
125 tcDefaults default_decls `thenTc` \ defaulting_tys ->
126 tcSetDefaultTys defaulting_tys ( -- for the iface sigs...
128 -- Interface type signatures
129 -- We tie a knot so that the Ids read out of interfaces are in scope
130 -- when we read their pragmas.
131 -- What we rely on is that pragmas are typechecked lazily; if
132 -- any type errors are found (ie there's an inconsistency)
133 -- we silently discard the pragma
134 tcInterfaceSigs sigs `thenTc` \ sig_ids ->
136 returnTc (env, inst_info, record_binds, deriv_binds, ddump_deriv, defaulting_tys, sig_ids)
138 )))) `thenTc` \ (env, inst_info, record_binds, deriv_binds, ddump_deriv, defaulting_tys, _) ->
140 tcSetEnv env ( -- to the end...
141 tcSetDefaultTys defaulting_tys ( -- ditto
143 -- Value declarations next.
144 -- We also typecheck any extra binds that came out of the "deriving" process
147 (\ binds1 (binds2, thing) -> (binds1 `ThenBinds` binds2, thing))
148 (val_decls `ThenBinds` deriv_binds)
149 ( -- Second pass over instance declarations,
150 -- to compile the bindings themselves.
151 tcInstDecls2 inst_info `thenNF_Tc` \ (lie_instdecls, inst_binds) ->
152 tcClassDecls2 cls_decls_bag `thenNF_Tc` \ (lie_clasdecls, cls_binds) ->
153 tcGetEnv `thenNF_Tc` \ env ->
154 returnTc ( (EmptyBinds, (inst_binds, cls_binds, env)),
155 lie_instdecls `plusLIE` lie_clasdecls,
158 `thenTc` \ ((val_binds, (inst_binds, cls_binds, final_env)), lie_alldecls, _) ->
160 checkTopLevelIds mod_name final_env `thenTc_`
162 -- Deal with constant or ambiguous InstIds. How could
163 -- there be ambiguous ones? They can only arise if a
164 -- top-level decl falls under the monomorphism
165 -- restriction, and no subsequent decl instantiates its
166 -- type. (Usually, ambiguous type variables are resolved
167 -- during the generalisation step.)
168 tcSimplifyTop lie_alldecls `thenTc` \ const_insts ->
170 localids = getEnv_LocalIds final_env
171 tycons = getEnv_TyCons final_env
172 classes = getEnv_Classes final_env
174 local_tycons = filter isLocallyDefined tycons
175 local_classes = filter isLocallyDefined classes
177 exported_ids = [v | v <- localids,
178 isExported v && not (isDataCon v) && not (isMethodSelId v)]
180 -- Backsubstitution. Monomorphic top-level decls may have
181 -- been instantiated by subsequent decls, and the final
182 -- simplification step may have instantiated some
183 -- ambiguous types. So, sadly, we need to back-substitute
184 -- over the whole bunch of bindings.
185 zonkBinds record_binds `thenNF_Tc` \ record_binds' ->
186 zonkBinds val_binds `thenNF_Tc` \ val_binds' ->
187 zonkBinds inst_binds `thenNF_Tc` \ inst_binds' ->
188 zonkBinds cls_binds `thenNF_Tc` \ cls_binds' ->
189 mapNF_Tc zonkInst const_insts `thenNF_Tc` \ const_insts' ->
190 mapNF_Tc (zonkId.TcId) exported_ids `thenNF_Tc` \ exported_ids' ->
194 (record_binds', cls_binds', inst_binds', val_binds', const_insts'),
196 -- the next collection is just for mkInterface
197 (fixities, exported_ids', tycons, classes, inst_info),
199 (local_tycons, local_classes),
206 ty_decls_bag = listToBag ty_decls
207 cls_decls_bag = listToBag cls_decls
208 inst_decls_bag = listToBag inst_decls
213 %************************************************************************
215 \subsection{Error checking code}
217 %************************************************************************
220 checkTopLevelIds checks that Main.main or Main.mainPrimIO has correct type.
223 checkTopLevelIds :: FAST_STRING -> TcEnv s -> TcM s ()
224 checkTopLevelIds mod final_env
225 | mod /= SLIT("Main")
229 = tcSetEnv final_env (
230 tcLookupLocalValueByKey mainIdKey `thenNF_Tc` \ maybe_main ->
231 tcLookupLocalValueByKey mainPrimIOIdKey `thenNF_Tc` \ maybe_prim ->
232 tcLookupTyConByKey iOTyConKey `thenNF_Tc` \ io_tc ->
234 case (maybe_main, maybe_prim) of
235 (Just main, Nothing) -> tcAddErrCtxt mainCtxt $
236 unifyTauTy (applyTyCon io_tc [unitTy])
239 (Nothing, Just prim) -> tcAddErrCtxt primCtxt $
240 unifyTauTy (mkPrimIoTy unitTy)
243 (Just _ , Just _ ) -> failTc mainBothIdErr
244 (Nothing, Nothing) -> failTc mainNoneIdErr
248 = ppStr "main should have type IO ()"
251 = ppStr "mainPrimIO should have type PrimIO ()"
254 = ppStr "module Main contains definitions for both main and mainPrimIO"
257 = panic "ToDo: sort out mainIdKey"
258 -- ppStr "module Main does not contain a definition for main (or mainPrimIO)"