2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
7 module RnSource ( rnDecl, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl, rnSourceDecls,
8 rnHsType, rnHsSigType, rnHsTypeFVs, rnHsSigTypeFVs
11 #include "HsVersions.h"
15 import HscTypes ( GlobalRdrEnv )
16 import HsTypes ( hsTyVarNames, pprHsContext )
17 import RdrName ( RdrName, isRdrDataCon, rdrNameOcc, mkRdrNameWkr, elemRdrEnv )
18 import RdrHsSyn ( RdrNameContext, RdrNameHsType, RdrNameConDecl, RdrNameTyClDecl,
19 extractRuleBndrsTyVars, extractHsTyRdrTyVars,
20 extractHsCtxtRdrTyVars, extractGenericPatTyVars
25 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, renameSigsFVs )
26 import RnEnv ( lookupTopBndrRn, lookupOccRn, newIPName, lookupIfaceName,
27 lookupOrigNames, lookupSysBinder, newLocalsRn,
29 bindTyVarsRn, bindTyVars2Rn,
30 bindTyVarsFV2Rn, extendTyVarEnvFVRn,
31 bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
32 checkDupOrQualNames, checkDupNames, mapFvRn
36 import Class ( FunDep, DefMeth (..) )
37 import Name ( Name, OccName, nameOccName, NamedThing(..) )
39 import PrelInfo ( derivableClassKeys, cCallishClassKeys )
40 import PrelNames ( deRefStablePtr_RDR, newStablePtr_RDR,
41 bindIO_RDR, returnIO_RDR
43 import List ( partition, nub )
45 import SrcLoc ( SrcLoc )
46 import CmdLineOpts ( DynFlag(..) )
47 -- Warn of unused for-all'd tyvars
48 import Unique ( Uniquable(..) )
49 import ErrUtils ( Message )
50 import CStrings ( isCLabelString )
51 import ListSetOps ( removeDupsEq )
54 @rnDecl@ `renames' declarations.
55 It simultaneously performs dependency analysis and precedence parsing.
56 It also does the following error checks:
59 Checks that tyvars are used properly. This includes checking
60 for undefined tyvars, and tyvars in contexts that are ambiguous.
61 (Some of this checking has now been moved to module @TcMonoType@,
62 since we don't have functional dependency information at this point.)
64 Checks that all variable occurences are defined.
66 Checks the @(..)@ etc constraints in the export list.
70 %*********************************************************
72 \subsection{Value declarations}
74 %*********************************************************
77 rnSourceDecls :: GlobalRdrEnv -> LocalFixityEnv
79 -> RnMG ([RenamedHsDecl], FreeVars)
80 -- The decls get reversed, but that's ok
82 rnSourceDecls gbl_env local_fixity_env decls
83 = initRnMS gbl_env local_fixity_env SourceMode (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)
108 = rnTyClDecl tycl_decl `thenRn` \ new_decl ->
109 rnClassBinds tycl_decl new_decl `thenRn` \ (new_decl', fvs) ->
110 returnRn (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
113 = rnInstDecl inst `thenRn` \ new_inst ->
114 rnInstBinds inst new_inst `thenRn` \ (new_inst', fvs) ->
115 returnRn (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
118 | isIfaceRuleDecl rule
119 = rnIfaceRuleDecl rule `thenRn` \ new_rule ->
120 returnRn (RuleD new_rule, ruleDeclFVs new_rule)
122 = rnHsRuleDecl rule `thenRn` \ (new_rule, fvs) ->
123 returnRn (RuleD new_rule, fvs)
125 rnDecl (DefD (DefaultDecl tys src_loc))
126 = pushSrcLocRn src_loc $
127 mapFvRn (rnHsTypeFVs doc_str) tys `thenRn` \ (tys', fvs) ->
128 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
130 doc_str = text "a `default' declaration"
132 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
133 = pushSrcLocRn src_loc $
134 lookupOccRn name `thenRn` \ name' ->
137 | isDyn = lookupOrigNames [newStablePtr_RDR, deRefStablePtr_RDR,
138 bindIO_RDR, returnIO_RDR]
140 lookupOrigNames [bindIO_RDR, returnIO_RDR] `thenRn` \ fvs ->
141 returnRn (addOneFV fvs name')
142 extra_fvs other = returnRn emptyFVs
144 checkRn (ok_ext_nm ext_nm) (badExtName ext_nm) `thenRn_`
146 extra_fvs imp_exp `thenRn` \ fvs1 ->
148 rnHsTypeFVs fo_decl_msg ty `thenRn` \ (ty', fvs2) ->
149 returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc),
152 fo_decl_msg = ptext SLIT("The foreign declaration for") <+> ppr name
153 isDyn = isDynamicExtName ext_nm
155 ok_ext_nm Dynamic = True
156 ok_ext_nm (ExtName nm (Just mb)) = isCLabelString nm && isCLabelString mb
157 ok_ext_nm (ExtName nm Nothing) = isCLabelString nm
161 %*********************************************************
163 \subsection{Instance declarations}
165 %*********************************************************
168 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
169 = pushSrcLocRn src_loc $
170 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ inst_ty' ->
172 (case maybe_dfun_rdr_name of
173 Nothing -> returnRn Nothing
174 Just dfun_rdr_name -> lookupIfaceName dfun_rdr_name `thenRn` \ dfun_name ->
175 returnRn (Just dfun_name)
176 ) `thenRn` \ maybe_dfun_name ->
178 -- The typechecker checks that all the bindings are for the right class.
179 returnRn (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
181 -- Compare rnClassBinds
182 rnInstBinds (InstDecl _ mbinds uprags _ _ )
183 (InstDecl inst_ty _ _ maybe_dfun_rdr_name src_loc)
185 meth_doc = text "the bindings in an instance declaration"
186 meth_names = collectLocatedMonoBinders mbinds
187 inst_tyvars = case inst_ty of
188 HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
190 -- (Slightly strangely) the forall-d tyvars scope over
191 -- the method bindings too
194 -- Rename the bindings
195 -- NB meth_names can be qualified!
196 checkDupNames meth_doc meth_names `thenRn_`
197 extendTyVarEnvFVRn (map hsTyVarName inst_tyvars) (
198 rnMethodBinds [] mbinds
199 ) `thenRn` \ (mbinds', meth_fvs) ->
201 binders = collectMonoBinders mbinds'
202 binder_set = mkNameSet binders
204 -- Rename the prags and signatures.
205 -- Note that the type variables are not in scope here,
206 -- so that instance Eq a => Eq (T a) where
207 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
210 -- But the (unqualified) method names are in scope
211 bindLocalNames binders (
212 renameSigsFVs (okInstDclSig binder_set) uprags
213 ) `thenRn` \ (uprags', prag_fvs) ->
215 returnRn (InstDecl inst_ty mbinds' uprags' maybe_dfun_rdr_name src_loc,
216 meth_fvs `plusFV` prag_fvs)
219 %*********************************************************
223 %*********************************************************
226 rnIfaceRuleDecl (IfaceRule rule_name vars fn args rhs src_loc)
227 = pushSrcLocRn src_loc $
228 lookupOccRn fn `thenRn` \ fn' ->
229 rnCoreBndrs vars $ \ vars' ->
230 mapRn rnCoreExpr args `thenRn` \ args' ->
231 rnCoreExpr rhs `thenRn` \ rhs' ->
232 returnRn (IfaceRule rule_name vars' fn' args' rhs' src_loc)
234 rnHsRuleDecl (HsRule rule_name tvs vars lhs rhs src_loc)
236 pushSrcLocRn src_loc $
238 bindTyVarsFV2Rn doc (map UserTyVar sig_tvs) $ \ sig_tvs' _ ->
239 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
240 mapFvRn rn_var (vars `zip` ids) `thenRn` \ (vars', fv_vars) ->
242 rnExpr lhs `thenRn` \ (lhs', fv_lhs) ->
243 rnExpr rhs `thenRn` \ (rhs', fv_rhs) ->
244 checkRn (validRuleLhs ids lhs')
245 (badRuleLhsErr rule_name lhs') `thenRn_`
247 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
249 mapRn (addErrRn . badRuleVar rule_name) bad_vars `thenRn_`
250 returnRn (HsRule rule_name sig_tvs' vars' lhs' rhs' src_loc,
251 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
253 doc = text "the transformation rule" <+> ptext rule_name
254 sig_tvs = extractRuleBndrsTyVars vars
256 get_var (RuleBndr v) = v
257 get_var (RuleBndrSig v _) = v
259 rn_var (RuleBndr v, id) = returnRn (RuleBndr id, emptyFVs)
260 rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t `thenRn` \ (t', fvs) ->
261 returnRn (RuleBndrSig id t', fvs)
265 %*********************************************************
267 \subsection{Type, class and iface sig declarations}
269 %*********************************************************
271 @rnTyDecl@ uses the `global name function' to create a new type
272 declaration in which local names have been replaced by their original
273 names, reporting any unknown names.
275 Renaming type variables is a pain. Because they now contain uniques,
276 it is necessary to pass in an association list which maps a parsed
277 tyvar to its @Name@ representation.
278 In some cases (type signatures of values),
279 it is even necessary to go over the type first
280 in order to get the set of tyvars used by it, make an assoc list,
281 and then go over it again to rename the tyvars!
282 However, we can also do some scoping checks at the same time.
285 rnTyClDecl (IfaceSig name ty id_infos loc)
287 lookupTopBndrRn name `thenRn` \ name' ->
288 rnHsType doc_str ty `thenRn` \ ty' ->
289 mapRn rnIdInfo id_infos `thenRn` \ id_infos' ->
290 returnRn (IfaceSig name' ty' id_infos' loc)
292 doc_str = text "the interface signature for" <+> quotes (ppr name)
294 rnTyClDecl (TyData new_or_data context tycon tyvars condecls nconstrs derivings src_loc gen_name1 gen_name2)
295 = pushSrcLocRn src_loc $
296 lookupTopBndrRn tycon `thenRn` \ tycon' ->
297 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
298 rnContext data_doc context `thenRn` \ context' ->
299 checkDupOrQualNames data_doc con_names `thenRn_`
300 mapRn rnConDecl condecls `thenRn` \ condecls' ->
301 lookupSysBinder gen_name1 `thenRn` \ name1' ->
302 lookupSysBinder gen_name2 `thenRn` \ name2' ->
303 rnDerivs derivings `thenRn` \ derivings' ->
304 returnRn (TyData new_or_data context' tycon' tyvars' condecls' nconstrs
305 derivings' src_loc name1' name2')
307 data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
308 con_names = map conDeclName condecls
310 rnTyClDecl (TySynonym name tyvars ty src_loc)
311 = pushSrcLocRn src_loc $
312 doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
313 lookupTopBndrRn name `thenRn` \ name' ->
314 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
315 rnHsType syn_doc (unquantify glaExts ty) `thenRn` \ ty' ->
316 returnRn (TySynonym name' tyvars' ty' src_loc)
318 syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
320 -- For H98 we do *not* universally quantify on the RHS of a synonym
321 -- Silently discard context... but the tyvars in the rest won't be in scope
322 unquantify glaExts (HsForAllTy Nothing ctxt ty) | glaExts = ty
323 unquantify glaExys ty = ty
325 rnTyClDecl (ClassDecl context cname tyvars fds sigs mbinds names src_loc)
326 = pushSrcLocRn src_loc $
328 lookupTopBndrRn cname `thenRn` \ cname' ->
330 -- Deal with the implicit tycon and datacon name
331 -- They aren't in scope (because they aren't visible to the user)
332 -- and what we want to do is simply look them up in the cache;
333 -- we jolly well ought to get a 'hit' there!
334 mapRn lookupSysBinder names `thenRn` \ names' ->
336 -- Tyvars scope over bindings and context
337 bindTyVars2Rn cls_doc tyvars $ \ clas_tyvar_names tyvars' ->
339 -- Check the superclasses
340 rnContext cls_doc context `thenRn` \ context' ->
342 -- Check the functional dependencies
343 rnFds cls_doc fds `thenRn` \ fds' ->
345 -- Check the signatures
346 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
348 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
349 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
351 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
352 mapRn (rnClassOp cname' clas_tyvar_names fds') op_sigs `thenRn` \ sigs' ->
354 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
356 renameSigs (okClsDclSig binders) non_op_sigs `thenRn` \ non_ops' ->
358 -- Typechecker is responsible for checking that we only
359 -- give default-method bindings for things in this class.
360 -- The renamer *could* check this for class decls, but can't
361 -- for instance decls.
363 returnRn (ClassDecl context' cname' tyvars' fds' (non_ops' ++ sigs') EmptyMonoBinds names' src_loc)
365 cls_doc = text "the declaration for class" <+> ppr cname
366 sig_doc = text "the signatures for class" <+> ppr cname
368 rnClassOp clas clas_tyvars clas_fds sig@(ClassOpSig op maybe_dm_stuff ty locn)
369 = pushSrcLocRn locn $
370 lookupTopBndrRn op `thenRn` \ op_name ->
372 -- Check the signature
373 rnHsSigType (quotes (ppr op)) ty `thenRn` \ new_ty ->
375 -- Make the default-method name
376 (case maybe_dm_stuff of
377 Nothing -> returnRn Nothing -- Source-file class decl
379 Just (DefMeth dm_rdr_name)
380 -> -- Imported class that has a default method decl
381 -- See comments with tname, snames, above
382 lookupSysBinder dm_rdr_name `thenRn` \ dm_name ->
383 returnRn (Just (DefMeth dm_name))
384 -- An imported class decl for a class decl that had an explicit default
385 -- method, mentions, rather than defines,
386 -- the default method, so we must arrange to pull it in
388 Just GenDefMeth -> returnRn (Just GenDefMeth)
389 Just NoDefMeth -> returnRn (Just NoDefMeth)
390 ) `thenRn` \ maybe_dm_stuff' ->
392 returnRn (ClassOpSig op_name maybe_dm_stuff' new_ty locn)
394 rnClassBinds :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
395 -- Rename the mbinds only; the rest is done already
396 rnClassBinds (ClassDecl _ _ _ _ _ mbinds _ _ ) -- Get mbinds from here
397 (ClassDecl context cname tyvars fds sigs _ names src_loc) -- Everything else is here
398 = -- The newLocals call is tiresome: given a generic class decl
401 -- op {| x+y |} (Inl a) = ...
402 -- op {| x+y |} (Inr b) = ...
403 -- op {| a*b |} (a*b) = ...
404 -- we want to name both "x" tyvars with the same unique, so that they are
405 -- easy to group together in the typechecker.
407 extendTyVarEnvFVRn (map hsTyVarName tyvars) $
408 getLocalNameEnv `thenRn` \ name_env ->
410 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
411 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
412 not (tv `elemRdrEnv` name_env)]
414 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
415 newLocalsRn gen_rdr_tyvars_w_locs `thenRn` \ gen_tyvars ->
416 rnMethodBinds gen_tyvars mbinds `thenRn` \ (mbinds', meth_fvs) ->
417 returnRn (ClassDecl context cname tyvars fds sigs mbinds' names src_loc, meth_fvs)
419 meth_doc = text "the default-methods for class" <+> ppr cname
421 rnClassBinds _ tycl_decl = returnRn (tycl_decl, emptyFVs)
422 -- Not a class declaration
426 %*********************************************************
428 \subsection{Support code for type/data declarations}
430 %*********************************************************
433 rnDerivs :: Maybe [RdrName] -> RnMS (Maybe [Name])
435 rnDerivs Nothing -- derivs not specified
439 = mapRn do_one clss `thenRn` \ clss' ->
440 returnRn (Just clss')
442 do_one cls = lookupOccRn cls `thenRn` \ clas_name ->
443 checkRn (getUnique clas_name `elem` derivableClassKeys)
444 (derivingNonStdClassErr clas_name) `thenRn_`
449 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
450 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
452 rnConDecl :: RdrNameConDecl -> RnMS RenamedConDecl
453 rnConDecl (ConDecl name wkr tvs cxt details locn)
454 = pushSrcLocRn locn $
455 checkConName name `thenRn_`
456 lookupTopBndrRn name `thenRn` \ new_name ->
458 lookupSysBinder wkr `thenRn` \ new_wkr ->
459 -- See comments with ClassDecl
461 bindTyVarsRn doc tvs $ \ new_tyvars ->
462 rnContext doc cxt `thenRn` \ new_context ->
463 rnConDetails doc locn details `thenRn` \ new_details ->
464 returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn)
466 doc = text "the definition of data constructor" <+> quotes (ppr name)
468 rnConDetails doc locn (VanillaCon tys)
469 = mapRn (rnBangTy doc) tys `thenRn` \ new_tys ->
470 returnRn (VanillaCon new_tys)
472 rnConDetails doc locn (InfixCon ty1 ty2)
473 = rnBangTy doc ty1 `thenRn` \ new_ty1 ->
474 rnBangTy doc ty2 `thenRn` \ new_ty2 ->
475 returnRn (InfixCon new_ty1 new_ty2)
477 rnConDetails doc locn (RecCon fields)
478 = checkDupOrQualNames doc field_names `thenRn_`
479 mapRn (rnField doc) fields `thenRn` \ new_fields ->
480 returnRn (RecCon new_fields)
482 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
484 rnField doc (names, ty)
485 = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
486 rnBangTy doc ty `thenRn` \ new_ty ->
487 returnRn (new_names, new_ty)
489 rnBangTy doc (Banged ty)
490 = rnHsType doc ty `thenRn` \ new_ty ->
491 returnRn (Banged new_ty)
493 rnBangTy doc (Unbanged ty)
494 = rnHsType doc ty `thenRn` \ new_ty ->
495 returnRn (Unbanged new_ty)
497 rnBangTy doc (Unpacked ty)
498 = rnHsType doc ty `thenRn` \ new_ty ->
499 returnRn (Unpacked new_ty)
501 -- This data decl will parse OK
503 -- treating "a" as the constructor.
504 -- It is really hard to make the parser spot this malformation.
505 -- So the renamer has to check that the constructor is legal
507 -- We can get an operator as the constructor, even in the prefix form:
508 -- data T = :% Int Int
509 -- from interface files, which always print in prefix form
512 = checkRn (isRdrDataCon name)
517 %*********************************************************
519 \subsection{Support code to rename types}
521 %*********************************************************
524 rnHsTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
525 rnHsTypeFVs doc_str ty
526 = rnHsType doc_str ty `thenRn` \ ty' ->
527 returnRn (ty', extractHsTyNames ty')
529 rnHsSigTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
530 rnHsSigTypeFVs doc_str ty
531 = rnHsSigType doc_str ty `thenRn` \ ty' ->
532 returnRn (ty', extractHsTyNames ty')
534 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
535 -- rnHsSigType is used for source-language type signatures,
536 -- which use *implicit* universal quantification.
537 rnHsSigType doc_str ty
538 = rnHsType (text "the type signature for" <+> doc_str) ty
540 ---------------------------------------
541 rnHsType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
543 rnHsType doc (HsForAllTy Nothing ctxt ty)
544 -- Implicit quantifiction in source code (no kinds on tyvars)
545 -- Given the signature C => T we universally quantify
546 -- over FV(T) \ {in-scope-tyvars}
547 = getLocalNameEnv `thenRn` \ name_env ->
549 mentioned_in_tau = extractHsTyRdrTyVars ty
550 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
551 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
552 forall_tyvars = filter (not . (`elemRdrEnv` name_env)) mentioned
554 rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
556 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
557 -- Explicit quantification.
558 -- Check that the forall'd tyvars are actually
559 -- mentioned in the type, and produce a warning if not
561 mentioned_in_tau = extractHsTyRdrTyVars tau
562 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
563 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
564 forall_tyvar_names = hsTyVarNames forall_tyvars
566 -- Explicitly quantified but not mentioned in ctxt or tau
567 warn_guys = filter (`notElem` mentioned) forall_tyvar_names
569 mapRn_ (forAllWarn doc tau) warn_guys `thenRn_`
570 rnForAll doc forall_tyvars ctxt tau
572 rnHsType doc (HsTyVar tyvar)
573 = lookupOccRn tyvar `thenRn` \ tyvar' ->
574 returnRn (HsTyVar tyvar')
576 rnHsType doc (HsOpTy ty1 opname ty2)
577 = lookupOccRn opname `thenRn` \ name' ->
578 rnHsType doc ty1 `thenRn` \ ty1' ->
579 rnHsType doc ty2 `thenRn` \ ty2' ->
580 returnRn (HsOpTy ty1' name' ty2')
582 rnHsType doc (HsNumTy i)
583 | i == 1 = returnRn (HsNumTy i)
584 | otherwise = failWithRn (HsNumTy i)
585 (ptext SLIT("Only unit numeric type pattern is valid"))
587 rnHsType doc (HsFunTy ty1 ty2)
588 = rnHsType doc ty1 `thenRn` \ ty1' ->
589 -- Might find a for-all as the arg of a function type
590 rnHsType doc ty2 `thenRn` \ ty2' ->
591 -- Or as the result. This happens when reading Prelude.hi
592 -- when we find return :: forall m. Monad m -> forall a. a -> m a
593 returnRn (HsFunTy ty1' ty2')
595 rnHsType doc (HsListTy ty)
596 = rnHsType doc ty `thenRn` \ ty' ->
597 returnRn (HsListTy ty')
599 -- Unboxed tuples are allowed to have poly-typed arguments. These
600 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
601 rnHsType doc (HsTupleTy (HsTupCon _ boxity) tys)
602 -- Don't do lookupOccRn, because this is built-in syntax
603 -- so it doesn't need to be in scope
604 = mapRn (rnHsType doc) tys `thenRn` \ tys' ->
605 returnRn (HsTupleTy (HsTupCon n' boxity) tys')
607 n' = tupleTyCon_name boxity (length tys)
610 rnHsType doc (HsAppTy ty1 ty2)
611 = rnHsType doc ty1 `thenRn` \ ty1' ->
612 rnHsType doc ty2 `thenRn` \ ty2' ->
613 returnRn (HsAppTy ty1' ty2')
615 rnHsType doc (HsPredTy pred)
616 = rnPred doc pred `thenRn` \ pred' ->
617 returnRn (HsPredTy pred')
619 rnHsTypes doc tys = mapRn (rnHsType doc) tys
623 -- We use lookupOcc here because this is interface file only stuff
624 -- and we need the workers...
625 rnHsTupCon (HsTupCon n boxity)
626 = lookupOccRn n `thenRn` \ n' ->
627 returnRn (HsTupCon n' boxity)
629 rnHsTupConWkr (HsTupCon n boxity)
630 -- Tuple construtors are for the *worker* of the tuple
631 -- Going direct saves needless messing about
632 = lookupOccRn (mkRdrNameWkr n) `thenRn` \ n' ->
633 returnRn (HsTupCon n' boxity)
637 rnForAll doc forall_tyvars ctxt ty
638 = bindTyVarsRn doc forall_tyvars $ \ new_tyvars ->
639 rnContext doc ctxt `thenRn` \ new_ctxt ->
640 rnHsType doc ty `thenRn` \ new_ty ->
641 returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty)
645 rnContext :: SDoc -> RdrNameContext -> RnMS RenamedContext
647 = mapRn rn_pred ctxt `thenRn` \ theta ->
649 (_, dups) = removeDupsEq theta
650 -- We only have equality, not ordering
652 -- Check for duplicate assertions
653 -- If this isn't an error, then it ought to be:
654 mapRn (addWarnRn . dupClassAssertWarn theta) dups `thenRn_`
657 --Someone discovered that @CCallable@ and @CReturnable@
658 -- could be used in contexts such as:
659 -- foo :: CCallable a => a -> PrimIO Int
660 -- Doing this utterly wrecks the whole point of introducing these
661 -- classes so we specifically check that this isn't being done.
662 rn_pred pred = rnPred doc pred `thenRn` \ pred'->
663 checkRn (not (bad_pred pred'))
664 (naughtyCCallContextErr pred') `thenRn_`
667 bad_pred (HsPClass clas _) = getUnique clas `elem` cCallishClassKeys
668 bad_pred other = False
671 rnPred doc (HsPClass clas tys)
672 = lookupOccRn clas `thenRn` \ clas_name ->
673 rnHsTypes doc tys `thenRn` \ tys' ->
674 returnRn (HsPClass clas_name tys')
676 rnPred doc (HsPIParam n ty)
677 = newIPName n `thenRn` \ name ->
678 rnHsType doc ty `thenRn` \ ty' ->
679 returnRn (HsPIParam name ty')
683 rnFds :: SDoc -> [FunDep RdrName] -> RnMS [FunDep Name]
689 = rnHsTyVars doc tys1 `thenRn` \ tys1' ->
690 rnHsTyVars doc tys2 `thenRn` \ tys2' ->
691 returnRn (tys1', tys2')
693 rnHsTyVars doc tvs = mapRn (rnHsTyvar doc) tvs
694 rnHsTyvar doc tyvar = lookupOccRn tyvar
697 %*********************************************************
701 %*********************************************************
704 rnIdInfo (HsWorker worker)
705 = lookupOccRn worker `thenRn` \ worker' ->
706 returnRn (HsWorker worker')
708 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
709 returnRn (HsUnfold inline expr')
710 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str)
711 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
712 rnIdInfo HsNoCafRefs = returnRn HsNoCafRefs
713 rnIdInfo HsCprInfo = returnRn HsCprInfo
716 @UfCore@ expressions.
719 rnCoreExpr (UfType ty)
720 = rnHsType (text "unfolding type") ty `thenRn` \ ty' ->
721 returnRn (UfType ty')
724 = lookupOccRn v `thenRn` \ v' ->
730 rnCoreExpr (UfLitLit l ty)
731 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
732 returnRn (UfLitLit l ty')
734 rnCoreExpr (UfCCall cc ty)
735 = rnHsType (text "ccall") ty `thenRn` \ ty' ->
736 returnRn (UfCCall cc ty')
738 rnCoreExpr (UfTuple con args)
739 = rnHsTupConWkr con `thenRn` \ con' ->
740 mapRn rnCoreExpr args `thenRn` \ args' ->
741 returnRn (UfTuple con' args')
743 rnCoreExpr (UfApp fun arg)
744 = rnCoreExpr fun `thenRn` \ fun' ->
745 rnCoreExpr arg `thenRn` \ arg' ->
746 returnRn (UfApp fun' arg')
748 rnCoreExpr (UfCase scrut bndr alts)
749 = rnCoreExpr scrut `thenRn` \ scrut' ->
750 bindCoreLocalRn bndr $ \ bndr' ->
751 mapRn rnCoreAlt alts `thenRn` \ alts' ->
752 returnRn (UfCase scrut' bndr' alts')
754 rnCoreExpr (UfNote note expr)
755 = rnNote note `thenRn` \ note' ->
756 rnCoreExpr expr `thenRn` \ expr' ->
757 returnRn (UfNote note' expr')
759 rnCoreExpr (UfLam bndr body)
760 = rnCoreBndr bndr $ \ bndr' ->
761 rnCoreExpr body `thenRn` \ body' ->
762 returnRn (UfLam bndr' body')
764 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
765 = rnCoreExpr rhs `thenRn` \ rhs' ->
766 rnCoreBndr bndr $ \ bndr' ->
767 rnCoreExpr body `thenRn` \ body' ->
768 returnRn (UfLet (UfNonRec bndr' rhs') body')
770 rnCoreExpr (UfLet (UfRec pairs) body)
771 = rnCoreBndrs bndrs $ \ bndrs' ->
772 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
773 rnCoreExpr body `thenRn` \ body' ->
774 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
776 (bndrs, rhss) = unzip pairs
780 rnCoreBndr (UfValBinder name ty) thing_inside
781 = rnHsType doc ty `thenRn` \ ty' ->
782 bindCoreLocalRn name $ \ name' ->
783 thing_inside (UfValBinder name' ty')
785 doc = text "unfolding id"
787 rnCoreBndr (UfTyBinder name kind) thing_inside
788 = bindCoreLocalRn name $ \ name' ->
789 thing_inside (UfTyBinder name' kind)
791 rnCoreBndrs [] thing_inside = thing_inside []
792 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
793 rnCoreBndrs bs $ \ names' ->
794 thing_inside (name':names')
798 rnCoreAlt (con, bndrs, rhs)
799 = rnUfCon con bndrs `thenRn` \ con' ->
800 bindCoreLocalsRn bndrs $ \ bndrs' ->
801 rnCoreExpr rhs `thenRn` \ rhs' ->
802 returnRn (con', bndrs', rhs')
805 = rnHsType (text "unfolding coerce") ty `thenRn` \ ty' ->
806 returnRn (UfCoerce ty')
808 rnNote (UfSCC cc) = returnRn (UfSCC cc)
809 rnNote UfInlineCall = returnRn UfInlineCall
810 rnNote UfInlineMe = returnRn UfInlineMe
816 rnUfCon (UfTupleAlt tup_con) bndrs
817 = rnHsTupCon tup_con `thenRn` \ (HsTupCon con' _) ->
818 returnRn (UfDataAlt con')
819 -- Makes the type checker a little easier
821 rnUfCon (UfDataAlt con) _
822 = lookupOccRn con `thenRn` \ con' ->
823 returnRn (UfDataAlt con')
825 rnUfCon (UfLitAlt lit) _
826 = returnRn (UfLitAlt lit)
828 rnUfCon (UfLitLitAlt lit ty) _
829 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
830 returnRn (UfLitLitAlt lit ty')
833 %*********************************************************
835 \subsection{Rule shapes}
837 %*********************************************************
839 Check the shape of a transformation rule LHS. Currently
840 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
841 not one of the @forall@'d variables.
844 validRuleLhs foralls lhs
847 check (HsApp e1 e2) = check e1
848 check (HsVar v) | v `notElem` foralls = True
853 %*********************************************************
857 %*********************************************************
860 derivingNonStdClassErr clas
861 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
864 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
866 forAllWarn doc ty tyvar
867 = doptRn Opt_WarnUnusedMatches `thenRn` \ warn_unused -> case () of
868 () | not warn_unused -> returnRn ()
870 -> getModeRn `thenRn` \ mode ->
873 InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
874 -- unless DEBUG is on, in which case it is slightly
875 -- informative. They can arise from mkRhsTyLam,
876 #endif -- leading to (say) f :: forall a b. [b] -> [b]
879 sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
880 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
882 (ptext SLIT("In") <+> doc)
886 badRuleLhsErr name lhs
887 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
888 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
890 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
893 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
894 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
895 ptext SLIT("does not appear on left hand side")]
897 badExtName :: ExtName -> Message
899 = sep [quotes (ppr ext_nm) <+> ptext SLIT("is not a valid C identifier")]
901 dupClassAssertWarn ctxt (assertion : dups)
902 = sep [hsep [ptext SLIT("Duplicate class assertion"),
903 quotes (ppr assertion),
904 ptext SLIT("in the context:")],
905 nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
907 naughtyCCallContextErr (HsPClass clas _)
908 = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),
909 ptext SLIT("in a context")]