2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[TcModule]{Typechecking a whole module}
7 #include "HsVersions.h"
14 TcLocalTyConsAndClasses(..),
15 TcSpecialiseRequests(..),
21 import HsSyn ( HsModule(..), HsBinds(..), Bind, HsExpr,
22 TyDecl, SpecDataSig, ClassDecl, InstDecl,
23 SpecInstSig, DefaultDecl, Sig, Fake, InPat,
24 FixityDecl, IE, ImportDecl
26 import RnHsSyn ( RenamedHsModule(..), RenamedFixityDecl(..) )
27 import TcHsSyn ( TypecheckedHsBinds(..), TypecheckedHsExpr(..),
28 TcIdOcc(..), zonkBinds, zonkInst, zonkId )
31 import Inst ( Inst, plusLIE )
32 import TcBinds ( tcBindsAndThen )
33 import TcClassDcl ( tcClassDecls2 )
34 import TcDefaults ( tcDefaults )
35 import TcEnv ( tcExtendGlobalValEnv, getEnv_LocalIds,
36 getEnv_TyCons, getEnv_Classes,
37 tcLookupLocalValueByKey, tcLookupTyConByKey )
38 import TcIfaceSig ( tcInterfaceSigs )
39 import TcInstDcls ( tcInstDecls1, tcInstDecls2 )
40 import TcInstUtil ( buildInstanceEnvs, InstInfo )
41 import TcSimplify ( tcSimplifyTop )
42 import TcTyClsDecls ( tcTyAndClassDecls1 )
44 import Bag ( listToBag )
45 import Class ( GenClass )
46 import ErrUtils ( Warning(..), Error(..) )
47 import Id ( GenId, isDataCon, isMethodSelId, idType )
48 import Maybes ( catMaybes )
49 import Name ( isExported, isLocallyDefined )
50 import PrelInfo ( unitTy, mkPrimIoTy )
52 import RnUtils ( RnEnv(..) )
53 import TyCon ( TyCon )
54 import Type ( mkSynTy )
55 import Unify ( unifyTauTy )
56 import UniqFM ( lookupUFM_Directly, lookupWithDefaultUFM_Directly,
58 import Unique ( iOTyConKey, mainIdKey, mainPrimIOIdKey )
61 import FiniteMap ( emptyFM )
65 Outside-world interface:
67 -- Convenient type synonyms first:
71 TcLocalTyConsAndClasses,
76 = (TypecheckedHsBinds, -- record selector binds
77 TypecheckedHsBinds, -- binds from class decls; does NOT
78 -- include default-methods bindings
79 TypecheckedHsBinds, -- binds from instance decls; INCLUDES
80 -- class default-methods binds
81 TypecheckedHsBinds, -- binds from value decls
83 [(Id, TypecheckedHsExpr)]) -- constant instance binds
85 type TcIfaceInfo -- things for the interface generator
86 = ([Id], [TyCon], [Class], Bag InstInfo)
88 type TcLocalTyConsAndClasses -- things defined in this module
90 -- not sure the classes are used at all (ToDo)
92 type TcSpecialiseRequests
93 = FiniteMap TyCon [(Bool, [Maybe Type])]
94 -- source tycon specialisation requests
102 -> RnEnv -- for renaming derivings
105 (TcResults, -- if all goes well...
106 Bag Warning) -- (we can still get warnings)
107 (Bag Error, -- if we had errors...
110 typecheckModule us rn_env mod
111 = initTc us (tcModule rn_env mod)
114 The internal monster:
116 tcModule :: RnEnv -- for renaming derivings
117 -> RenamedHsModule -- input
118 -> TcM s TcResults -- output
121 (HsModule mod_name verion exports imports fixities
122 ty_decls specdata_sigs cls_decls inst_decls specinst_sigs
123 default_decls val_decls sigs src_loc)
125 = ASSERT(null imports)
127 tcAddSrcLoc src_loc $ -- record where we're starting
129 -- Tie the knot for inteface-file value declaration signatures
130 -- This info is only used inside the knot for type-checking the
131 -- pragmas, which is done lazily [ie failure just drops the pragma
132 -- without having any global-failure effect].
134 fixTc (\ ~(_, _, _, _, _, _, sig_ids) ->
135 tcExtendGlobalValEnv sig_ids (
137 -- The knot for instance information. This isn't used at all
138 -- till we type-check value declarations
139 fixTc ( \ ~(rec_inst_mapper, _, _, _, _, _) ->
141 -- Type-check the type and class decls
142 --trace "tcTyAndClassDecls:" $
143 tcTyAndClassDecls1 rec_inst_mapper ty_decls_bag cls_decls_bag
144 `thenTc` \ (env, record_binds) ->
146 -- Typecheck the instance decls, includes deriving
148 --trace "tcInstDecls:" $
149 tcInstDecls1 inst_decls_bag specinst_sigs
150 mod_name rn_env fixities
151 ) `thenTc` \ (inst_info, deriv_binds, ddump_deriv) ->
153 buildInstanceEnvs inst_info `thenTc` \ inst_mapper ->
155 returnTc (inst_mapper, env, record_binds, inst_info, deriv_binds, ddump_deriv)
157 ) `thenTc` \ (_, env, record_binds, inst_info, deriv_binds, ddump_deriv) ->
160 -- Default declarations
161 tcDefaults default_decls `thenTc` \ defaulting_tys ->
162 tcSetDefaultTys defaulting_tys ( -- for the iface sigs...
164 -- Interface type signatures
165 -- We tie a knot so that the Ids read out of interfaces are in scope
166 -- when we read their pragmas.
167 -- What we rely on is that pragmas are typechecked lazily; if
168 -- any type errors are found (ie there's an inconsistency)
169 -- we silently discard the pragma
170 tcInterfaceSigs sigs `thenTc` \ sig_ids ->
172 returnTc (env, inst_info, record_binds, deriv_binds, ddump_deriv, defaulting_tys, sig_ids)
174 )))) `thenTc` \ (env, inst_info, record_binds, deriv_binds, ddump_deriv, defaulting_tys, _) ->
176 tcSetEnv env ( -- to the end...
177 tcSetDefaultTys defaulting_tys ( -- ditto
179 -- Value declarations next.
180 -- We also typecheck any extra binds that came out of the "deriving" process
183 (\ binds1 (binds2, thing) -> (binds1 `ThenBinds` binds2, thing))
184 (val_decls `ThenBinds` deriv_binds)
185 ( -- Second pass over instance declarations,
186 -- to compile the bindings themselves.
187 tcInstDecls2 inst_info `thenNF_Tc` \ (lie_instdecls, inst_binds) ->
188 tcClassDecls2 cls_decls_bag `thenNF_Tc` \ (lie_clasdecls, cls_binds) ->
189 tcGetEnv `thenNF_Tc` \ env ->
190 returnTc ( (EmptyBinds, (inst_binds, cls_binds, env)),
191 lie_instdecls `plusLIE` lie_clasdecls,
194 `thenTc` \ ((val_binds, (inst_binds, cls_binds, final_env)), lie_alldecls, _) ->
196 checkTopLevelIds mod_name final_env `thenTc_`
198 -- Deal with constant or ambiguous InstIds. How could
199 -- there be ambiguous ones? They can only arise if a
200 -- top-level decl falls under the monomorphism
201 -- restriction, and no subsequent decl instantiates its
202 -- type. (Usually, ambiguous type variables are resolved
203 -- during the generalisation step.)
204 tcSimplifyTop lie_alldecls `thenTc` \ const_insts ->
206 localids = getEnv_LocalIds final_env
207 tycons = getEnv_TyCons final_env
208 classes = getEnv_Classes final_env
210 local_tycons = filter isLocallyDefined tycons
211 local_classes = filter isLocallyDefined classes
213 exported_ids = [v | v <- localids,
214 isExported v && not (isDataCon v) && not (isMethodSelId v)]
216 -- Backsubstitution. Monomorphic top-level decls may have
217 -- been instantiated by subsequent decls, and the final
218 -- simplification step may have instantiated some
219 -- ambiguous types. So, sadly, we need to back-substitute
220 -- over the whole bunch of bindings.
221 zonkBinds record_binds `thenNF_Tc` \ record_binds' ->
222 zonkBinds val_binds `thenNF_Tc` \ val_binds' ->
223 zonkBinds inst_binds `thenNF_Tc` \ inst_binds' ->
224 zonkBinds cls_binds `thenNF_Tc` \ cls_binds' ->
225 mapNF_Tc zonkInst const_insts `thenNF_Tc` \ const_insts' ->
226 mapNF_Tc (zonkId.TcId) exported_ids `thenNF_Tc` \ exported_ids' ->
230 (record_binds', cls_binds', inst_binds', val_binds', const_insts'),
232 -- the next collection is just for mkInterface
233 (exported_ids', tycons, classes, inst_info),
235 (local_tycons, local_classes),
242 ty_decls_bag = listToBag ty_decls
243 cls_decls_bag = listToBag cls_decls
244 inst_decls_bag = listToBag inst_decls
249 %************************************************************************
251 \subsection{Error checking code}
253 %************************************************************************
256 checkTopLevelIds checks that Main.main or Main.mainPrimIO has correct type.
259 checkTopLevelIds :: FAST_STRING -> TcEnv s -> TcM s ()
260 checkTopLevelIds mod final_env
261 | mod /= SLIT("Main")
265 = tcSetEnv final_env (
266 tcLookupLocalValueByKey mainIdKey `thenNF_Tc` \ maybe_main ->
267 tcLookupLocalValueByKey mainPrimIOIdKey `thenNF_Tc` \ maybe_prim ->
268 tcLookupTyConByKey iOTyConKey `thenNF_Tc` \ io_tc ->
270 case (maybe_main, maybe_prim) of
271 (Just main, Nothing) -> tcAddErrCtxt mainCtxt $
272 unifyTauTy (mkSynTy io_tc [unitTy])
275 (Nothing, Just prim) -> tcAddErrCtxt primCtxt $
276 unifyTauTy (mkPrimIoTy unitTy)
279 (Just _ , Just _ ) -> failTc mainBothIdErr
280 (Nothing, Nothing) -> failTc mainNoneIdErr
284 = ppStr "main should have type IO ()"
287 = ppStr "mainPrimIO should have type PrimIO ()"
290 = ppStr "module Main contains definitions for both main and mainPrimIO"
293 = ppStr "module Main does not contain a definition for main (or mainPrimIO)"