2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
7 module RnSource ( rnDecl, rnTyClDecl, rnRuleDecl, rnInstDecl,
8 rnSourceDecls, rnHsType, rnHsSigType
11 #include "HsVersions.h"
15 import HsTypes ( hsTyVarNames, pprHsContext )
16 import RdrName ( RdrName, isRdrDataCon, rdrNameOcc, mkRdrNameWkr )
17 import RdrHsSyn ( RdrNameContext, RdrNameHsType, RdrNameConDecl,
18 extractRuleBndrsTyVars, extractHsTyRdrTyVars,
19 extractHsCtxtRdrTyVars, extractGenericPatTyVars
24 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs )
25 import RnEnv ( lookupTopBndrRn, lookupOccRn, newIPName,
26 lookupOrigNames, lookupSysBinder, newLocalsRn,
27 bindLocalsFVRn, bindUVarRn,
28 bindTyVarsFVRn, bindTyVarsFV2Rn, extendTyVarEnvFVRn,
29 bindCoreLocalFVRn, bindCoreLocalsFVRn, bindLocalNames,
30 checkDupOrQualNames, checkDupNames,
31 FreeVars, emptyFVs, plusFV, plusFVs, unitFV,
36 import FunDeps ( oclose )
37 import Class ( FunDep, DefMeth (..) )
38 import Name ( Name, OccName, nameOccName, NamedThing(..) )
40 import FiniteMap ( elemFM )
41 import PrelInfo ( derivableClassKeys, cCallishClassKeys )
42 import PrelNames ( deRefStablePtr_RDR, makeStablePtr_RDR,
43 bindIO_RDR, returnIO_RDR
45 import List ( partition, nub )
47 import SrcLoc ( SrcLoc )
48 import CmdLineOpts ( DynFlag(..) )
49 -- Warn of unused for-all'd tyvars
50 import Unique ( Uniquable(..) )
51 import ErrUtils ( Message )
52 import CStrings ( isCLabelString )
53 import ListSetOps ( removeDupsEq )
56 @rnDecl@ `renames' declarations.
57 It simultaneously performs dependency analysis and precedence parsing.
58 It also does the following error checks:
61 Checks that tyvars are used properly. This includes checking
62 for undefined tyvars, and tyvars in contexts that are ambiguous.
63 (Some of this checking has now been moved to module @TcMonoType@,
64 since we don't have functional dependency information at this point.)
66 Checks that all variable occurences are defined.
68 Checks the @(..)@ etc constraints in the export list.
72 %*********************************************************
74 \subsection{Value declarations}
76 %*********************************************************
79 rnSourceDecls :: [RdrNameHsDecl] -> RnMS ([RenamedHsDecl], FreeVars)
80 -- The decls get reversed, but that's ok
83 = go emptyFVs [] decls
85 -- Fixity and deprecations have been dealt with already; ignore them
86 go fvs ds' [] = returnRn (ds', fvs)
87 go fvs ds' (FixD _:ds) = go fvs ds' ds
88 go fvs ds' (DeprecD _:ds) = go fvs ds' ds
89 go fvs ds' (d:ds) = rnDecl d `thenRn` \(d', fvs') ->
90 go (fvs `plusFV` fvs') (d':ds') ds
94 %*********************************************************
96 \subsection{Value declarations}
98 %*********************************************************
101 -- rnDecl does all the work
102 rnDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
104 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
105 returnRn (ValD new_binds, fvs)
107 rnDecl (TyClD tycl_decl) = rnTyClDecl tycl_decl `thenRn` \ (new_decl, fvs) ->
108 returnRn (TyClD new_decl, fvs)
111 = rnRuleDecl rule `thenRn` \ (new_rule, fvs) ->
112 returnRn (RuleD new_rule, fvs)
115 = rnInstDecl inst `thenRn` \ (new_inst, fvs) ->
116 returnRn (InstD new_inst, fvs)
118 rnDecl (DefD (DefaultDecl tys src_loc))
119 = pushSrcLocRn src_loc $
120 rnHsTypes doc_str tys `thenRn` \ (tys', fvs) ->
121 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
123 doc_str = text "a `default' declaration"
125 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
126 = pushSrcLocRn src_loc $
127 lookupOccRn name `thenRn` \ name' ->
130 | isDyn = lookupOrigNames [makeStablePtr_RDR, deRefStablePtr_RDR,
131 bindIO_RDR, returnIO_RDR]
133 lookupOrigNames [bindIO_RDR, returnIO_RDR] `thenRn` \ fvs ->
134 returnRn (addOneFV fvs name')
135 extra_fvs other = returnRn emptyFVs
137 checkRn (ok_ext_nm ext_nm) (badExtName ext_nm) `thenRn_`
139 extra_fvs imp_exp `thenRn` \ fvs1 ->
141 rnHsSigType fo_decl_msg ty `thenRn` \ (ty', fvs2) ->
142 returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc),
145 fo_decl_msg = ptext SLIT("a foreign declaration")
146 isDyn = isDynamicExtName ext_nm
148 ok_ext_nm Dynamic = True
149 ok_ext_nm (ExtName nm (Just mb)) = isCLabelString nm && isCLabelString mb
150 ok_ext_nm (ExtName nm Nothing) = isCLabelString nm
154 %*********************************************************
156 \subsection{Instance declarations}
158 %*********************************************************
161 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
162 = pushSrcLocRn src_loc $
163 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ (inst_ty', inst_fvs) ->
165 inst_tyvars = case inst_ty' of
166 HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
168 -- (Slightly strangely) the forall-d tyvars scope over
169 -- the method bindings too
172 -- Rename the bindings
173 -- NB meth_names can be qualified!
174 checkDupNames meth_doc meth_names `thenRn_`
175 extendTyVarEnvFVRn (map hsTyVarName inst_tyvars) (
176 rnMethodBinds [] mbinds
177 ) `thenRn` \ (mbinds', meth_fvs) ->
179 binders = collectMonoBinders mbinds'
180 binder_set = mkNameSet binders
182 -- Rename the prags and signatures.
183 -- Note that the type variables are not in scope here,
184 -- so that instance Eq a => Eq (T a) where
185 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
188 -- But the (unqualified) method names are in scope
189 bindLocalNames binders (
190 renameSigs (okInstDclSig binder_set) uprags
191 ) `thenRn` \ (new_uprags, prag_fvs) ->
193 (case maybe_dfun_rdr_name of
194 Nothing -> returnRn (Nothing, emptyFVs)
196 Just dfun_rdr_name -> lookupSysBinder dfun_rdr_name `thenRn` \ dfun_name ->
197 returnRn (Just dfun_name, unitFV dfun_name)
198 ) `thenRn` \ (maybe_dfun_name, dfun_fv) ->
200 -- The typechecker checks that all the bindings are for the right class.
201 returnRn (InstDecl inst_ty' mbinds' new_uprags maybe_dfun_name src_loc,
202 inst_fvs `plusFV` meth_fvs `plusFV` prag_fvs `plusFV` dfun_fv)
204 meth_doc = text "the bindings in an instance declaration"
205 meth_names = collectLocatedMonoBinders mbinds
208 %*********************************************************
212 %*********************************************************
215 rnRuleDecl (IfaceRule rule_name vars fn args rhs src_loc)
216 = pushSrcLocRn src_loc $
217 lookupOccRn fn `thenRn` \ fn' ->
218 rnCoreBndrs vars $ \ vars' ->
219 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs1) ->
220 rnCoreExpr rhs `thenRn` \ (rhs', fvs2) ->
221 returnRn (IfaceRule rule_name vars' fn' args' rhs' src_loc,
222 (fvs1 `plusFV` fvs2) `addOneFV` fn')
224 rnRuleDecl (HsRule rule_name tvs vars lhs rhs src_loc)
226 pushSrcLocRn src_loc $
228 bindTyVarsFV2Rn doc (map UserTyVar sig_tvs) $ \ sig_tvs' _ ->
229 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
230 mapFvRn rn_var (vars `zip` ids) `thenRn` \ (vars', fv_vars) ->
232 rnExpr lhs `thenRn` \ (lhs', fv_lhs) ->
233 rnExpr rhs `thenRn` \ (rhs', fv_rhs) ->
234 checkRn (validRuleLhs ids lhs')
235 (badRuleLhsErr rule_name lhs') `thenRn_`
237 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
239 mapRn (addErrRn . badRuleVar rule_name) bad_vars `thenRn_`
240 returnRn (HsRule rule_name sig_tvs' vars' lhs' rhs' src_loc,
241 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
243 doc = text "the transformation rule" <+> ptext rule_name
244 sig_tvs = extractRuleBndrsTyVars vars
246 get_var (RuleBndr v) = v
247 get_var (RuleBndrSig v _) = v
249 rn_var (RuleBndr v, id) = returnRn (RuleBndr id, emptyFVs)
250 rn_var (RuleBndrSig v t, id) = rnHsType doc t `thenRn` \ (t', fvs) ->
251 returnRn (RuleBndrSig id t', fvs)
255 %*********************************************************
257 \subsection{Type, class and iface sig declarations}
259 %*********************************************************
261 @rnTyDecl@ uses the `global name function' to create a new type
262 declaration in which local names have been replaced by their original
263 names, reporting any unknown names.
265 Renaming type variables is a pain. Because they now contain uniques,
266 it is necessary to pass in an association list which maps a parsed
267 tyvar to its @Name@ representation.
268 In some cases (type signatures of values),
269 it is even necessary to go over the type first
270 in order to get the set of tyvars used by it, make an assoc list,
271 and then go over it again to rename the tyvars!
272 However, we can also do some scoping checks at the same time.
275 rnTyClDecl (IfaceSig name ty id_infos loc)
277 lookupTopBndrRn name `thenRn` \ name' ->
278 rnHsType doc_str ty `thenRn` \ (ty',fvs1) ->
279 mapFvRn rnIdInfo id_infos `thenRn` \ (id_infos', fvs2) ->
280 returnRn (IfaceSig name' ty' id_infos' loc, fvs1 `plusFV` fvs2)
282 doc_str = text "the interface signature for" <+> quotes (ppr name)
284 rnTyClDecl (TyData new_or_data context tycon tyvars condecls nconstrs derivings src_loc gen_name1 gen_name2)
285 = pushSrcLocRn src_loc $
286 lookupTopBndrRn tycon `thenRn` \ tycon' ->
287 bindTyVarsFVRn data_doc tyvars $ \ tyvars' ->
288 rnContext data_doc context `thenRn` \ (context', cxt_fvs) ->
289 checkDupOrQualNames data_doc con_names `thenRn_`
290 mapFvRn rnConDecl condecls `thenRn` \ (condecls', con_fvs) ->
291 lookupSysBinder gen_name1 `thenRn` \ name1' ->
292 lookupSysBinder gen_name2 `thenRn` \ name2' ->
293 rnDerivs derivings `thenRn` \ (derivings', deriv_fvs) ->
294 returnRn (TyData new_or_data context' tycon' tyvars' condecls' nconstrs
295 derivings' src_loc name1' name2',
296 cxt_fvs `plusFV` con_fvs `plusFV` deriv_fvs)
298 data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
299 con_names = map conDeclName condecls
301 rnTyClDecl (TySynonym name tyvars ty src_loc)
302 = pushSrcLocRn src_loc $
303 doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
304 lookupTopBndrRn name `thenRn` \ name' ->
305 bindTyVarsFVRn syn_doc tyvars $ \ tyvars' ->
306 rnHsType syn_doc (unquantify glaExts ty) `thenRn` \ (ty', ty_fvs) ->
307 returnRn (TySynonym name' tyvars' ty' src_loc, ty_fvs)
309 syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
311 -- For H98 we do *not* universally quantify on the RHS of a synonym
312 -- Silently discard context... but the tyvars in the rest won't be in scope
313 unquantify glaExts (HsForAllTy Nothing ctxt ty) | glaExts = ty
314 unquantify glaExys ty = ty
316 rnTyClDecl (ClassDecl context cname tyvars fds sigs mbinds names src_loc)
317 = pushSrcLocRn src_loc $
319 lookupTopBndrRn cname `thenRn` \ cname' ->
321 -- Deal with the implicit tycon and datacon name
322 -- They aren't in scope (because they aren't visible to the user)
323 -- and what we want to do is simply look them up in the cache;
324 -- we jolly well ought to get a 'hit' there!
325 -- So the 'Imported' part of this call is not relevant.
326 -- Unclean; but since these two are the only place this happens
327 -- I can't work up the energy to do it more beautifully
329 mapRn lookupSysBinder names `thenRn` \ names' ->
331 -- Tyvars scope over bindings and context
332 bindTyVarsFV2Rn cls_doc tyvars ( \ clas_tyvar_names tyvars' ->
334 -- Check the superclasses
335 rnContext cls_doc context `thenRn` \ (context', cxt_fvs) ->
337 -- Check the functional dependencies
338 rnFds cls_doc fds `thenRn` \ (fds', fds_fvs) ->
340 -- Check the signatures
341 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
343 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
344 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
346 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
347 mapFvRn (rn_op cname' clas_tyvar_names fds') op_sigs `thenRn` \ (sigs', sig_fvs) ->
349 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
351 renameSigs (okClsDclSig binders) non_op_sigs `thenRn` \ (non_ops', fix_fvs) ->
354 -- The newLocals call is tiresome: given a generic class decl
357 -- op {| x+y |} (Inl a) = ...
358 -- op {| x+y |} (Inr b) = ...
359 -- op {| a*b |} (a*b) = ...
360 -- we want to name both "x" tyvars with the same unique, so that they are
361 -- easy to group together in the typechecker.
363 getLocalNameEnv `thenRn` \ name_env ->
365 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
366 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
367 not (tv `elemFM` name_env)]
369 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
370 newLocalsRn mkLocalName gen_rdr_tyvars_w_locs `thenRn` \ gen_tyvars ->
371 rnMethodBinds gen_tyvars mbinds `thenRn` \ (mbinds', meth_fvs) ->
373 -- Typechecker is responsible for checking that we only
374 -- give default-method bindings for things in this class.
375 -- The renamer *could* check this for class decls, but can't
376 -- for instance decls.
378 returnRn (ClassDecl context' cname' tyvars' fds' (non_ops' ++ sigs') mbinds'
389 cls_doc = text "the declaration for class" <+> ppr cname
390 sig_doc = text "the signatures for class" <+> ppr cname
391 meth_doc = text "the default-methods for class" <+> ppr cname
393 rn_op clas clas_tyvars clas_fds sig@(ClassOpSig op maybe_dm_stuff ty locn)
394 = pushSrcLocRn locn $
395 lookupTopBndrRn op `thenRn` \ op_name ->
397 -- Check the signature
398 rnHsSigType (quotes (ppr op)) ty `thenRn` \ (new_ty, op_ty_fvs) ->
400 check_in_op_ty clas_tyvar =
401 checkRn (clas_tyvar `elemNameSet` oclose clas_fds op_ty_fvs)
402 (classTyVarNotInOpTyErr clas_tyvar sig)
404 mapRn_ check_in_op_ty clas_tyvars `thenRn_`
406 -- Make the default-method name
407 (case maybe_dm_stuff of
408 Nothing -> returnRn (Nothing, emptyFVs) -- Source-file class decl
410 Just (DefMeth dm_rdr_name)
411 -> -- Imported class that has a default method decl
412 -- See comments with tname, snames, above
413 lookupSysBinder dm_rdr_name `thenRn` \ dm_name ->
414 returnRn (Just (DefMeth dm_name), unitFV dm_name)
415 -- An imported class decl for a class decl that had an explicit default
416 -- method, mentions, rather than defines,
417 -- the default method, so we must arrange to pull it in
419 -> returnRn (Just GenDefMeth, emptyFVs)
421 -> returnRn (Just NoDefMeth, emptyFVs)
422 ) `thenRn` \ (maybe_dm_stuff', dm_fvs) ->
424 returnRn (ClassOpSig op_name maybe_dm_stuff' new_ty locn, op_ty_fvs `plusFV` dm_fvs)
428 %*********************************************************
430 \subsection{Support code for type/data declarations}
432 %*********************************************************
435 rnDerivs :: Maybe [RdrName] -> RnMS (Maybe [Name], FreeVars)
437 rnDerivs Nothing -- derivs not specified
438 = returnRn (Nothing, emptyFVs)
441 = mapRn do_one clss `thenRn` \ clss' ->
442 returnRn (Just clss', mkNameSet clss')
444 do_one cls = lookupOccRn cls `thenRn` \ clas_name ->
445 checkRn (getUnique clas_name `elem` derivableClassKeys)
446 (derivingNonStdClassErr clas_name) `thenRn_`
451 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
452 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
454 rnConDecl :: RdrNameConDecl -> RnMS (RenamedConDecl, FreeVars)
455 rnConDecl (ConDecl name wkr tvs cxt details locn)
456 = pushSrcLocRn locn $
457 checkConName name `thenRn_`
458 lookupTopBndrRn name `thenRn` \ new_name ->
460 lookupSysBinder wkr `thenRn` \ new_wkr ->
461 -- See comments with ClassDecl
463 bindTyVarsFVRn doc tvs $ \ new_tyvars ->
464 rnContext doc cxt `thenRn` \ (new_context, cxt_fvs) ->
465 rnConDetails doc locn details `thenRn` \ (new_details, det_fvs) ->
466 returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn,
467 cxt_fvs `plusFV` det_fvs)
469 doc = text "the definition of data constructor" <+> quotes (ppr name)
471 rnConDetails doc locn (VanillaCon tys)
472 = mapFvRn (rnBangTy doc) tys `thenRn` \ (new_tys, fvs) ->
473 returnRn (VanillaCon new_tys, fvs)
475 rnConDetails doc locn (InfixCon ty1 ty2)
476 = rnBangTy doc ty1 `thenRn` \ (new_ty1, fvs1) ->
477 rnBangTy doc ty2 `thenRn` \ (new_ty2, fvs2) ->
478 returnRn (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2)
480 rnConDetails doc locn (RecCon fields)
481 = checkDupOrQualNames doc field_names `thenRn_`
482 mapFvRn (rnField doc) fields `thenRn` \ (new_fields, fvs) ->
483 returnRn (RecCon new_fields, fvs)
485 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
487 rnField doc (names, ty)
488 = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
489 rnBangTy doc ty `thenRn` \ (new_ty, fvs) ->
490 returnRn ((new_names, new_ty), fvs)
492 rnBangTy doc (Banged ty)
493 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
494 returnRn (Banged new_ty, fvs)
496 rnBangTy doc (Unbanged ty)
497 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
498 returnRn (Unbanged new_ty, fvs)
500 rnBangTy doc (Unpacked ty)
501 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
502 returnRn (Unpacked new_ty, fvs)
504 -- This data decl will parse OK
506 -- treating "a" as the constructor.
507 -- It is really hard to make the parser spot this malformation.
508 -- So the renamer has to check that the constructor is legal
510 -- We can get an operator as the constructor, even in the prefix form:
511 -- data T = :% Int Int
512 -- from interface files, which always print in prefix form
515 = checkRn (isRdrDataCon name)
520 %*********************************************************
522 \subsection{Support code to rename types}
524 %*********************************************************
527 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
528 -- rnHsSigType is used for source-language type signatures,
529 -- which use *implicit* universal quantification.
530 rnHsSigType doc_str ty
531 = rnHsType (text "the type signature for" <+> doc_str) ty
533 ---------------------------------------
534 rnHsType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
536 rnHsType doc (HsForAllTy Nothing ctxt ty)
537 -- Implicit quantifiction in source code (no kinds on tyvars)
538 -- Given the signature C => T we universally quantify
539 -- over FV(T) \ {in-scope-tyvars}
540 = getLocalNameEnv `thenRn` \ name_env ->
542 mentioned_in_tau = extractHsTyRdrTyVars ty
543 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
544 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
545 forall_tyvars = filter (not . (`elemFM` name_env)) mentioned
547 rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
549 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
550 -- Explicit quantification.
551 -- Check that the forall'd tyvars are actually
552 -- mentioned in the type, and produce a warning if not
554 mentioned_in_tau = extractHsTyRdrTyVars tau
555 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
556 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
557 forall_tyvar_names = hsTyVarNames forall_tyvars
559 -- Explicitly quantified but not mentioned in ctxt or tau
560 warn_guys = filter (`notElem` mentioned) forall_tyvar_names
562 mapRn_ (forAllWarn doc tau) warn_guys `thenRn_`
563 rnForAll doc forall_tyvars ctxt tau
565 rnHsType doc (HsTyVar tyvar)
566 = lookupOccRn tyvar `thenRn` \ tyvar' ->
567 returnRn (HsTyVar tyvar', unitFV tyvar')
569 rnHsType doc (HsOpTy ty1 opname ty2)
570 = lookupOccRn opname `thenRn` \ name' ->
571 rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
572 rnHsType doc ty2 `thenRn` \ (ty2',fvs2) ->
573 returnRn (HsOpTy ty1' name' ty2', fvs1 `plusFV` fvs2 `addOneFV` name')
575 rnHsType doc (HsNumTy i)
576 | i == 1 = returnRn (HsNumTy i, emptyFVs)
577 | otherwise = failWithRn (HsNumTy i, emptyFVs)
578 (ptext SLIT("Only unit numeric type pattern is valid"))
580 rnHsType doc (HsFunTy ty1 ty2)
581 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
582 -- Might find a for-all as the arg of a function type
583 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
584 -- Or as the result. This happens when reading Prelude.hi
585 -- when we find return :: forall m. Monad m -> forall a. a -> m a
586 returnRn (HsFunTy ty1' ty2', fvs1 `plusFV` fvs2)
588 rnHsType doc (HsListTy ty)
589 = rnHsType doc ty `thenRn` \ (ty', fvs) ->
590 returnRn (HsListTy ty', fvs `addOneFV` listTyCon_name)
592 -- Unboxed tuples are allowed to have poly-typed arguments. These
593 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
594 rnHsType doc (HsTupleTy (HsTupCon _ boxity) tys)
595 -- Don't do lookupOccRn, because this is built-in syntax
596 -- so it doesn't need to be in scope
597 = mapFvRn (rnHsType doc) tys `thenRn` \ (tys', fvs) ->
598 returnRn (HsTupleTy (HsTupCon n' boxity) tys', fvs `addOneFV` n')
600 n' = tupleTyCon_name boxity (length tys)
603 rnHsType doc (HsAppTy ty1 ty2)
604 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
605 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
606 returnRn (HsAppTy ty1' ty2', fvs1 `plusFV` fvs2)
608 rnHsType doc (HsPredTy pred)
609 = rnPred doc pred `thenRn` \ (pred', fvs) ->
610 returnRn (HsPredTy pred', fvs)
612 rnHsType doc (HsUsgForAllTy uv_rdr ty)
613 = bindUVarRn doc uv_rdr $ \ uv_name ->
614 rnHsType doc ty `thenRn` \ (ty', fvs) ->
615 returnRn (HsUsgForAllTy uv_name ty',
618 rnHsType doc (HsUsgTy usg ty)
619 = newUsg usg `thenRn` \ (usg', usg_fvs) ->
620 rnHsType doc ty `thenRn` \ (ty', ty_fvs) ->
621 -- A for-all can occur inside a usage annotation
622 returnRn (HsUsgTy usg' ty',
623 usg_fvs `plusFV` ty_fvs)
625 newUsg usg = case usg of
626 HsUsOnce -> returnRn (HsUsOnce, emptyFVs)
627 HsUsMany -> returnRn (HsUsMany, emptyFVs)
628 HsUsVar uv_rdr -> lookupOccRn uv_rdr `thenRn` \ uv_name ->
629 returnRn (HsUsVar uv_name, emptyFVs)
631 rnHsTypes doc tys = mapFvRn (rnHsType doc) tys
635 -- We use lookupOcc here because this is interface file only stuff
636 -- and we need the workers...
637 rnHsTupCon (HsTupCon n boxity)
638 = lookupOccRn n `thenRn` \ n' ->
639 returnRn (HsTupCon n' boxity, unitFV n')
641 rnHsTupConWkr (HsTupCon n boxity)
642 -- Tuple construtors are for the *worker* of the tuple
643 -- Going direct saves needless messing about
644 = lookupOccRn (mkRdrNameWkr n) `thenRn` \ n' ->
645 returnRn (HsTupCon n' boxity, unitFV n')
649 rnForAll doc forall_tyvars ctxt ty
650 = bindTyVarsFVRn doc forall_tyvars $ \ new_tyvars ->
651 rnContext doc ctxt `thenRn` \ (new_ctxt, cxt_fvs) ->
652 rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) ->
653 returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty,
654 cxt_fvs `plusFV` ty_fvs)
658 rnContext :: SDoc -> RdrNameContext -> RnMS (RenamedContext, FreeVars)
660 = mapAndUnzipRn rn_pred ctxt `thenRn` \ (theta, fvs_s) ->
662 (_, dups) = removeDupsEq theta
663 -- We only have equality, not ordering
665 -- Check for duplicate assertions
666 -- If this isn't an error, then it ought to be:
667 mapRn (addWarnRn . dupClassAssertWarn theta) dups `thenRn_`
668 returnRn (theta, plusFVs fvs_s)
670 --Someone discovered that @CCallable@ and @CReturnable@
671 -- could be used in contexts such as:
672 -- foo :: CCallable a => a -> PrimIO Int
673 -- Doing this utterly wrecks the whole point of introducing these
674 -- classes so we specifically check that this isn't being done.
675 rn_pred pred = rnPred doc pred `thenRn` \ (pred', fvs)->
676 checkRn (not (bad_pred pred'))
677 (naughtyCCallContextErr pred') `thenRn_`
678 returnRn (pred', fvs)
680 bad_pred (HsPClass clas _) = getUnique clas `elem` cCallishClassKeys
681 bad_pred other = False
684 rnPred doc (HsPClass clas tys)
685 = lookupOccRn clas `thenRn` \ clas_name ->
686 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
687 returnRn (HsPClass clas_name tys', fvs `addOneFV` clas_name)
689 rnPred doc (HsPIParam n ty)
690 = newIPName n `thenRn` \ name ->
691 rnHsType doc ty `thenRn` \ (ty', fvs) ->
692 returnRn (HsPIParam name ty', fvs)
696 rnFds :: SDoc -> [FunDep RdrName] -> RnMS ([FunDep Name], FreeVars)
699 = mapAndUnzipRn rn_fds fds `thenRn` \ (theta, fvs_s) ->
700 returnRn (theta, plusFVs fvs_s)
703 = rnHsTyVars doc tys1 `thenRn` \ (tys1', fvs1) ->
704 rnHsTyVars doc tys2 `thenRn` \ (tys2', fvs2) ->
705 returnRn ((tys1', tys2'), fvs1 `plusFV` fvs2)
707 rnHsTyVars doc tvs = mapFvRn (rnHsTyvar doc) tvs
709 = lookupOccRn tyvar `thenRn` \ tyvar' ->
710 returnRn (tyvar', unitFV tyvar')
713 %*********************************************************
717 %*********************************************************
720 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str, emptyFVs)
722 rnIdInfo (HsWorker worker)
723 = lookupOccRn worker `thenRn` \ worker' ->
724 returnRn (HsWorker worker', unitFV worker')
726 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ (expr', fvs) ->
727 returnRn (HsUnfold inline expr', fvs)
728 rnIdInfo (HsArity arity) = returnRn (HsArity arity, emptyFVs)
729 rnIdInfo HsNoCafRefs = returnRn (HsNoCafRefs, emptyFVs)
730 rnIdInfo HsCprInfo = returnRn (HsCprInfo, emptyFVs)
734 @UfCore@ expressions.
737 rnCoreExpr (UfType ty)
738 = rnHsType (text "unfolding type") ty `thenRn` \ (ty', fvs) ->
739 returnRn (UfType ty', fvs)
742 = lookupOccRn v `thenRn` \ v' ->
743 returnRn (UfVar v', unitFV v')
746 = returnRn (UfLit l, emptyFVs)
748 rnCoreExpr (UfLitLit l ty)
749 = rnHsType (text "litlit") ty `thenRn` \ (ty', fvs) ->
750 returnRn (UfLitLit l ty', fvs)
752 rnCoreExpr (UfCCall cc ty)
753 = rnHsType (text "ccall") ty `thenRn` \ (ty', fvs) ->
754 returnRn (UfCCall cc ty', fvs)
756 rnCoreExpr (UfTuple con args)
757 = rnHsTupConWkr con `thenRn` \ (con', fvs1) ->
758 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs2) ->
759 returnRn (UfTuple con' args', fvs1 `plusFV` fvs2)
761 rnCoreExpr (UfApp fun arg)
762 = rnCoreExpr fun `thenRn` \ (fun', fv1) ->
763 rnCoreExpr arg `thenRn` \ (arg', fv2) ->
764 returnRn (UfApp fun' arg', fv1 `plusFV` fv2)
766 rnCoreExpr (UfCase scrut bndr alts)
767 = rnCoreExpr scrut `thenRn` \ (scrut', fvs1) ->
768 bindCoreLocalFVRn bndr ( \ bndr' ->
769 mapFvRn rnCoreAlt alts `thenRn` \ (alts', fvs2) ->
770 returnRn (UfCase scrut' bndr' alts', fvs2)
771 ) `thenRn` \ (case', fvs3) ->
772 returnRn (case', fvs1 `plusFV` fvs3)
774 rnCoreExpr (UfNote note expr)
775 = rnNote note `thenRn` \ (note', fvs1) ->
776 rnCoreExpr expr `thenRn` \ (expr', fvs2) ->
777 returnRn (UfNote note' expr', fvs1 `plusFV` fvs2)
779 rnCoreExpr (UfLam bndr body)
780 = rnCoreBndr bndr $ \ bndr' ->
781 rnCoreExpr body `thenRn` \ (body', fvs) ->
782 returnRn (UfLam bndr' body', fvs)
784 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
785 = rnCoreExpr rhs `thenRn` \ (rhs', fvs1) ->
786 rnCoreBndr bndr ( \ bndr' ->
787 rnCoreExpr body `thenRn` \ (body', fvs2) ->
788 returnRn (UfLet (UfNonRec bndr' rhs') body', fvs2)
789 ) `thenRn` \ (result, fvs3) ->
790 returnRn (result, fvs1 `plusFV` fvs3)
792 rnCoreExpr (UfLet (UfRec pairs) body)
793 = rnCoreBndrs bndrs $ \ bndrs' ->
794 mapFvRn rnCoreExpr rhss `thenRn` \ (rhss', fvs1) ->
795 rnCoreExpr body `thenRn` \ (body', fvs2) ->
796 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body', fvs1 `plusFV` fvs2)
798 (bndrs, rhss) = unzip pairs
802 rnCoreBndr (UfValBinder name ty) thing_inside
803 = rnHsType doc ty `thenRn` \ (ty', fvs1) ->
804 bindCoreLocalFVRn name ( \ name' ->
805 thing_inside (UfValBinder name' ty')
806 ) `thenRn` \ (result, fvs2) ->
807 returnRn (result, fvs1 `plusFV` fvs2)
809 doc = text "unfolding id"
811 rnCoreBndr (UfTyBinder name kind) thing_inside
812 = bindCoreLocalFVRn name $ \ name' ->
813 thing_inside (UfTyBinder name' kind)
815 rnCoreBndrs [] thing_inside = thing_inside []
816 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
817 rnCoreBndrs bs $ \ names' ->
818 thing_inside (name':names')
822 rnCoreAlt (con, bndrs, rhs)
823 = rnUfCon con bndrs `thenRn` \ (con', fvs1) ->
824 bindCoreLocalsFVRn bndrs ( \ bndrs' ->
825 rnCoreExpr rhs `thenRn` \ (rhs', fvs2) ->
826 returnRn ((con', bndrs', rhs'), fvs2)
827 ) `thenRn` \ (result, fvs3) ->
828 returnRn (result, fvs1 `plusFV` fvs3)
831 = rnHsType (text "unfolding coerce") ty `thenRn` \ (ty', fvs) ->
832 returnRn (UfCoerce ty', fvs)
834 rnNote (UfSCC cc) = returnRn (UfSCC cc, emptyFVs)
835 rnNote UfInlineCall = returnRn (UfInlineCall, emptyFVs)
836 rnNote UfInlineMe = returnRn (UfInlineMe, emptyFVs)
840 = returnRn (UfDefault, emptyFVs)
842 rnUfCon (UfTupleAlt tup_con) bndrs
843 = rnHsTupCon tup_con `thenRn` \ (HsTupCon con' _, fvs) ->
844 returnRn (UfDataAlt con', fvs)
845 -- Makes the type checker a little easier
847 rnUfCon (UfDataAlt con) _
848 = lookupOccRn con `thenRn` \ con' ->
849 returnRn (UfDataAlt con', unitFV con')
851 rnUfCon (UfLitAlt lit) _
852 = returnRn (UfLitAlt lit, emptyFVs)
854 rnUfCon (UfLitLitAlt lit ty) _
855 = rnHsType (text "litlit") ty `thenRn` \ (ty', fvs) ->
856 returnRn (UfLitLitAlt lit ty', fvs)
859 %*********************************************************
861 \subsection{Rule shapes}
863 %*********************************************************
865 Check the shape of a transformation rule LHS. Currently
866 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
867 not one of the @forall@'d variables.
870 validRuleLhs foralls lhs
873 check (HsApp e1 e2) = check e1
874 check (HsVar v) | v `notElem` foralls = True
879 %*********************************************************
883 %*********************************************************
886 derivingNonStdClassErr clas
887 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
889 classTyVarNotInOpTyErr clas_tyvar sig
890 = hang (hsep [ptext SLIT("Class type variable"),
891 quotes (ppr clas_tyvar),
892 ptext SLIT("does not appear in method signature")])
896 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
898 forAllWarn doc ty tyvar
899 = doptRn Opt_WarnUnusedMatches `thenRn` \ warn_unused -> case () of
900 () | not warn_unused -> returnRn ()
902 -> getModeRn `thenRn` \ mode ->
905 InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
906 -- unless DEBUG is on, in which case it is slightly
907 -- informative. They can arise from mkRhsTyLam,
908 #endif -- leading to (say) f :: forall a b. [b] -> [b]
911 sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
912 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
914 (ptext SLIT("In") <+> doc)
918 badRuleLhsErr name lhs
919 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
920 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
922 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
925 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
926 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
927 ptext SLIT("does not appear on left hand side")]
929 badExtName :: ExtName -> Message
931 = sep [quotes (ppr ext_nm) <+> ptext SLIT("is not a valid C identifier")]
933 dupClassAssertWarn ctxt (assertion : dups)
934 = sep [hsep [ptext SLIT("Duplicate class assertion"),
935 quotes (ppr assertion),
936 ptext SLIT("in the context:")],
937 nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
939 naughtyCCallContextErr (HsPClass clas _)
940 = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),
941 ptext SLIT("in a context")]