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 HsTypes ( hsTyVarNames, pprHsContext )
16 import RdrName ( RdrName, isRdrDataCon, rdrNameOcc, mkRdrNameWkr, elemRdrEnv )
17 import RdrHsSyn ( RdrNameContext, RdrNameHsType, RdrNameConDecl, RdrNameTyClDecl,
18 extractRuleBndrsTyVars, extractHsTyRdrTyVars,
19 extractHsCtxtRdrTyVars, extractGenericPatTyVars
24 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, renameSigsFVs )
25 import RnEnv ( lookupTopBndrRn, lookupOccRn, newIPName,
26 lookupOrigNames, lookupSysBinder, newLocalsRn,
27 bindLocalsFVRn, bindUVarRn,
28 bindTyVarsRn, bindTyVars2Rn,
29 bindTyVarsFV2Rn, extendTyVarEnvFVRn,
30 bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
31 checkDupOrQualNames, checkDupNames, mapFvRn
35 import Class ( FunDep, DefMeth (..) )
36 import Name ( Name, OccName, nameOccName, NamedThing(..) )
38 import PrelInfo ( derivableClassKeys, cCallishClassKeys )
39 import PrelNames ( deRefStablePtr_RDR, makeStablePtr_RDR,
40 bindIO_RDR, returnIO_RDR
42 import List ( partition, nub )
44 import SrcLoc ( SrcLoc )
45 import CmdLineOpts ( DynFlag(..) )
46 -- Warn of unused for-all'd tyvars
47 import Unique ( Uniquable(..) )
48 import ErrUtils ( Message )
49 import CStrings ( isCLabelString )
50 import ListSetOps ( removeDupsEq )
53 @rnDecl@ `renames' declarations.
54 It simultaneously performs dependency analysis and precedence parsing.
55 It also does the following error checks:
58 Checks that tyvars are used properly. This includes checking
59 for undefined tyvars, and tyvars in contexts that are ambiguous.
60 (Some of this checking has now been moved to module @TcMonoType@,
61 since we don't have functional dependency information at this point.)
63 Checks that all variable occurences are defined.
65 Checks the @(..)@ etc constraints in the export list.
69 %*********************************************************
71 \subsection{Value declarations}
73 %*********************************************************
76 rnSourceDecls :: [RdrNameHsDecl] -> RnMS ([RenamedHsDecl], FreeVars)
77 -- The decls get reversed, but that's ok
80 = go emptyFVs [] decls
82 -- Fixity and deprecations have been dealt with already; ignore them
83 go fvs ds' [] = returnRn (ds', fvs)
84 go fvs ds' (FixD _:ds) = go fvs ds' ds
85 go fvs ds' (DeprecD _:ds) = go fvs ds' ds
86 go fvs ds' (d:ds) = rnDecl d `thenRn` \(d', fvs') ->
87 go (fvs `plusFV` fvs') (d':ds') ds
91 %*********************************************************
93 \subsection{Value declarations}
95 %*********************************************************
98 -- rnDecl does all the work
99 rnDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
101 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
102 returnRn (ValD new_binds, fvs)
104 rnDecl (TyClD tycl_decl)
105 = rnTyClDecl tycl_decl `thenRn` \ new_decl ->
106 rnClassBinds tycl_decl new_decl `thenRn` \ (new_decl', fvs) ->
107 returnRn (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
110 = rnInstDecl inst `thenRn` \ new_inst ->
111 rnInstBinds inst new_inst `thenRn` \ (new_inst', fvs) ->
112 returnRn (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
115 | isIfaceRuleDecl rule
116 = rnIfaceRuleDecl rule `thenRn` \ new_rule ->
117 returnRn (RuleD new_rule, ruleDeclFVs new_rule)
119 = rnHsRuleDecl rule `thenRn` \ (new_rule, fvs) ->
120 returnRn (RuleD new_rule, fvs)
122 rnDecl (DefD (DefaultDecl tys src_loc))
123 = pushSrcLocRn src_loc $
124 mapFvRn (rnHsTypeFVs doc_str) tys `thenRn` \ (tys', fvs) ->
125 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
127 doc_str = text "a `default' declaration"
129 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
130 = pushSrcLocRn src_loc $
131 lookupOccRn name `thenRn` \ name' ->
134 | isDyn = lookupOrigNames [makeStablePtr_RDR, deRefStablePtr_RDR,
135 bindIO_RDR, returnIO_RDR]
137 lookupOrigNames [bindIO_RDR, returnIO_RDR] `thenRn` \ fvs ->
138 returnRn (addOneFV fvs name')
139 extra_fvs other = returnRn emptyFVs
141 checkRn (ok_ext_nm ext_nm) (badExtName ext_nm) `thenRn_`
143 extra_fvs imp_exp `thenRn` \ fvs1 ->
145 rnHsTypeFVs fo_decl_msg ty `thenRn` \ (ty', fvs2) ->
146 returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc),
149 fo_decl_msg = ptext SLIT("The foreign declaration for") <+> ppr name
150 isDyn = isDynamicExtName ext_nm
152 ok_ext_nm Dynamic = True
153 ok_ext_nm (ExtName nm (Just mb)) = isCLabelString nm && isCLabelString mb
154 ok_ext_nm (ExtName nm Nothing) = isCLabelString nm
158 %*********************************************************
160 \subsection{Instance declarations}
162 %*********************************************************
165 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
166 = pushSrcLocRn src_loc $
167 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ inst_ty' ->
169 (case maybe_dfun_rdr_name of
170 Nothing -> returnRn Nothing
171 Just dfun_rdr_name -> lookupSysBinder dfun_rdr_name `thenRn` \ dfun_name ->
172 returnRn (Just dfun_name)
173 ) `thenRn` \ maybe_dfun_name ->
175 -- The typechecker checks that all the bindings are for the right class.
176 returnRn (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
178 -- Compare rnClassBinds
179 rnInstBinds (InstDecl _ mbinds uprags _ _ )
180 (InstDecl inst_ty _ _ maybe_dfun_rdr_name src_loc)
182 meth_doc = text "the bindings in an instance declaration"
183 meth_names = collectLocatedMonoBinders mbinds
184 inst_tyvars = case inst_ty of
185 HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
187 -- (Slightly strangely) the forall-d tyvars scope over
188 -- the method bindings too
191 -- Rename the bindings
192 -- NB meth_names can be qualified!
193 checkDupNames meth_doc meth_names `thenRn_`
194 extendTyVarEnvFVRn (map hsTyVarName inst_tyvars) (
195 rnMethodBinds [] mbinds
196 ) `thenRn` \ (mbinds', meth_fvs) ->
198 binders = collectMonoBinders mbinds'
199 binder_set = mkNameSet binders
201 -- Rename the prags and signatures.
202 -- Note that the type variables are not in scope here,
203 -- so that instance Eq a => Eq (T a) where
204 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
207 -- But the (unqualified) method names are in scope
208 bindLocalNames binders (
209 renameSigsFVs (okInstDclSig binder_set) uprags
210 ) `thenRn` \ (uprags', prag_fvs) ->
212 returnRn (InstDecl inst_ty mbinds' uprags' maybe_dfun_rdr_name src_loc,
213 meth_fvs `plusFV` prag_fvs)
216 %*********************************************************
220 %*********************************************************
223 rnIfaceRuleDecl (IfaceRule rule_name vars fn args rhs src_loc)
224 = pushSrcLocRn src_loc $
225 lookupOccRn fn `thenRn` \ fn' ->
226 rnCoreBndrs vars $ \ vars' ->
227 mapRn rnCoreExpr args `thenRn` \ args' ->
228 rnCoreExpr rhs `thenRn` \ rhs' ->
229 returnRn (IfaceRule rule_name vars' fn' args' rhs' src_loc)
231 rnHsRuleDecl (HsRule rule_name tvs vars lhs rhs src_loc)
233 pushSrcLocRn src_loc $
235 bindTyVarsFV2Rn doc (map UserTyVar sig_tvs) $ \ sig_tvs' _ ->
236 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
237 mapFvRn rn_var (vars `zip` ids) `thenRn` \ (vars', fv_vars) ->
239 rnExpr lhs `thenRn` \ (lhs', fv_lhs) ->
240 rnExpr rhs `thenRn` \ (rhs', fv_rhs) ->
241 checkRn (validRuleLhs ids lhs')
242 (badRuleLhsErr rule_name lhs') `thenRn_`
244 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
246 mapRn (addErrRn . badRuleVar rule_name) bad_vars `thenRn_`
247 returnRn (HsRule rule_name sig_tvs' vars' lhs' rhs' src_loc,
248 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
250 doc = text "the transformation rule" <+> ptext rule_name
251 sig_tvs = extractRuleBndrsTyVars vars
253 get_var (RuleBndr v) = v
254 get_var (RuleBndrSig v _) = v
256 rn_var (RuleBndr v, id) = returnRn (RuleBndr id, emptyFVs)
257 rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t `thenRn` \ (t', fvs) ->
258 returnRn (RuleBndrSig id t', fvs)
262 %*********************************************************
264 \subsection{Type, class and iface sig declarations}
266 %*********************************************************
268 @rnTyDecl@ uses the `global name function' to create a new type
269 declaration in which local names have been replaced by their original
270 names, reporting any unknown names.
272 Renaming type variables is a pain. Because they now contain uniques,
273 it is necessary to pass in an association list which maps a parsed
274 tyvar to its @Name@ representation.
275 In some cases (type signatures of values),
276 it is even necessary to go over the type first
277 in order to get the set of tyvars used by it, make an assoc list,
278 and then go over it again to rename the tyvars!
279 However, we can also do some scoping checks at the same time.
282 rnTyClDecl (IfaceSig name ty id_infos loc)
284 lookupTopBndrRn name `thenRn` \ name' ->
285 rnHsType doc_str ty `thenRn` \ ty' ->
286 mapRn rnIdInfo id_infos `thenRn` \ id_infos' ->
287 returnRn (IfaceSig name' ty' id_infos' loc)
289 doc_str = text "the interface signature for" <+> quotes (ppr name)
291 rnTyClDecl (TyData new_or_data context tycon tyvars condecls nconstrs derivings src_loc gen_name1 gen_name2)
292 = pushSrcLocRn src_loc $
293 lookupTopBndrRn tycon `thenRn` \ tycon' ->
294 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
295 rnContext data_doc context `thenRn` \ context' ->
296 checkDupOrQualNames data_doc con_names `thenRn_`
297 mapRn rnConDecl condecls `thenRn` \ condecls' ->
298 lookupSysBinder gen_name1 `thenRn` \ name1' ->
299 lookupSysBinder gen_name2 `thenRn` \ name2' ->
300 rnDerivs derivings `thenRn` \ derivings' ->
301 returnRn (TyData new_or_data context' tycon' tyvars' condecls' nconstrs
302 derivings' src_loc name1' name2')
304 data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
305 con_names = map conDeclName condecls
307 rnTyClDecl (TySynonym name tyvars ty src_loc)
308 = pushSrcLocRn src_loc $
309 doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
310 lookupTopBndrRn name `thenRn` \ name' ->
311 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
312 rnHsType syn_doc (unquantify glaExts ty) `thenRn` \ ty' ->
313 returnRn (TySynonym name' tyvars' ty' src_loc)
315 syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
317 -- For H98 we do *not* universally quantify on the RHS of a synonym
318 -- Silently discard context... but the tyvars in the rest won't be in scope
319 unquantify glaExts (HsForAllTy Nothing ctxt ty) | glaExts = ty
320 unquantify glaExys ty = ty
322 rnTyClDecl (ClassDecl context cname tyvars fds sigs mbinds names src_loc)
323 = pushSrcLocRn src_loc $
325 lookupTopBndrRn cname `thenRn` \ cname' ->
327 -- Deal with the implicit tycon and datacon name
328 -- They aren't in scope (because they aren't visible to the user)
329 -- and what we want to do is simply look them up in the cache;
330 -- we jolly well ought to get a 'hit' there!
331 mapRn lookupSysBinder names `thenRn` \ names' ->
333 -- Tyvars scope over bindings and context
334 bindTyVars2Rn cls_doc tyvars $ \ clas_tyvar_names tyvars' ->
336 -- Check the superclasses
337 rnContext cls_doc context `thenRn` \ context' ->
339 -- Check the functional dependencies
340 rnFds cls_doc fds `thenRn` \ fds' ->
342 -- Check the signatures
343 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
345 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
346 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
348 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
349 mapRn (rnClassOp cname' clas_tyvar_names fds') op_sigs `thenRn` \ sigs' ->
351 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
353 renameSigs (okClsDclSig binders) non_op_sigs `thenRn` \ non_ops' ->
355 -- Typechecker is responsible for checking that we only
356 -- give default-method bindings for things in this class.
357 -- The renamer *could* check this for class decls, but can't
358 -- for instance decls.
360 returnRn (ClassDecl context' cname' tyvars' fds' (non_ops' ++ sigs') EmptyMonoBinds names' src_loc)
362 cls_doc = text "the declaration for class" <+> ppr cname
363 sig_doc = text "the signatures for class" <+> ppr cname
365 rnClassOp clas clas_tyvars clas_fds sig@(ClassOpSig op maybe_dm_stuff ty locn)
366 = pushSrcLocRn locn $
367 lookupTopBndrRn op `thenRn` \ op_name ->
369 -- Check the signature
370 rnHsSigType (quotes (ppr op)) ty `thenRn` \ new_ty ->
372 -- Make the default-method name
373 (case maybe_dm_stuff of
374 Nothing -> returnRn Nothing -- Source-file class decl
376 Just (DefMeth dm_rdr_name)
377 -> -- Imported class that has a default method decl
378 -- See comments with tname, snames, above
379 lookupSysBinder dm_rdr_name `thenRn` \ dm_name ->
380 returnRn (Just (DefMeth dm_name))
381 -- An imported class decl for a class decl that had an explicit default
382 -- method, mentions, rather than defines,
383 -- the default method, so we must arrange to pull it in
385 Just GenDefMeth -> returnRn (Just GenDefMeth)
386 Just NoDefMeth -> returnRn (Just NoDefMeth)
387 ) `thenRn` \ maybe_dm_stuff' ->
389 returnRn (ClassOpSig op_name maybe_dm_stuff' new_ty locn)
391 rnClassBinds :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
392 -- Rename the mbinds only; the rest is done already
393 rnClassBinds (ClassDecl _ _ _ _ _ mbinds _ _ ) -- Get mbinds from here
394 (ClassDecl context cname tyvars fds sigs _ names src_loc) -- Everything else is here
395 = -- The newLocals call is tiresome: given a generic class decl
398 -- op {| x+y |} (Inl a) = ...
399 -- op {| x+y |} (Inr b) = ...
400 -- op {| a*b |} (a*b) = ...
401 -- we want to name both "x" tyvars with the same unique, so that they are
402 -- easy to group together in the typechecker.
404 extendTyVarEnvFVRn (map hsTyVarName tyvars) $
405 getLocalNameEnv `thenRn` \ name_env ->
407 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
408 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
409 not (tv `elemRdrEnv` name_env)]
411 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
412 newLocalsRn gen_rdr_tyvars_w_locs `thenRn` \ gen_tyvars ->
413 rnMethodBinds gen_tyvars mbinds `thenRn` \ (mbinds', meth_fvs) ->
414 returnRn (ClassDecl context cname tyvars fds sigs mbinds' names src_loc, meth_fvs)
416 meth_doc = text "the default-methods for class" <+> ppr cname
418 rnClassBinds _ tycl_decl = returnRn (tycl_decl, emptyFVs)
419 -- Not a class declaration
423 %*********************************************************
425 \subsection{Support code for type/data declarations}
427 %*********************************************************
430 rnDerivs :: Maybe [RdrName] -> RnMS (Maybe [Name])
432 rnDerivs Nothing -- derivs not specified
436 = mapRn do_one clss `thenRn` \ clss' ->
437 returnRn (Just clss')
439 do_one cls = lookupOccRn cls `thenRn` \ clas_name ->
440 checkRn (getUnique clas_name `elem` derivableClassKeys)
441 (derivingNonStdClassErr clas_name) `thenRn_`
446 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
447 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
449 rnConDecl :: RdrNameConDecl -> RnMS RenamedConDecl
450 rnConDecl (ConDecl name wkr tvs cxt details locn)
451 = pushSrcLocRn locn $
452 checkConName name `thenRn_`
453 lookupTopBndrRn name `thenRn` \ new_name ->
455 lookupSysBinder wkr `thenRn` \ new_wkr ->
456 -- See comments with ClassDecl
458 bindTyVarsRn doc tvs $ \ new_tyvars ->
459 rnContext doc cxt `thenRn` \ new_context ->
460 rnConDetails doc locn details `thenRn` \ new_details ->
461 returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn)
463 doc = text "the definition of data constructor" <+> quotes (ppr name)
465 rnConDetails doc locn (VanillaCon tys)
466 = mapRn (rnBangTy doc) tys `thenRn` \ new_tys ->
467 returnRn (VanillaCon new_tys)
469 rnConDetails doc locn (InfixCon ty1 ty2)
470 = rnBangTy doc ty1 `thenRn` \ new_ty1 ->
471 rnBangTy doc ty2 `thenRn` \ new_ty2 ->
472 returnRn (InfixCon new_ty1 new_ty2)
474 rnConDetails doc locn (RecCon fields)
475 = checkDupOrQualNames doc field_names `thenRn_`
476 mapRn (rnField doc) fields `thenRn` \ new_fields ->
477 returnRn (RecCon new_fields)
479 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
481 rnField doc (names, ty)
482 = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
483 rnBangTy doc ty `thenRn` \ new_ty ->
484 returnRn (new_names, new_ty)
486 rnBangTy doc (Banged ty)
487 = rnHsType doc ty `thenRn` \ new_ty ->
488 returnRn (Banged new_ty)
490 rnBangTy doc (Unbanged ty)
491 = rnHsType doc ty `thenRn` \ new_ty ->
492 returnRn (Unbanged new_ty)
494 rnBangTy doc (Unpacked ty)
495 = rnHsType doc ty `thenRn` \ new_ty ->
496 returnRn (Unpacked new_ty)
498 -- This data decl will parse OK
500 -- treating "a" as the constructor.
501 -- It is really hard to make the parser spot this malformation.
502 -- So the renamer has to check that the constructor is legal
504 -- We can get an operator as the constructor, even in the prefix form:
505 -- data T = :% Int Int
506 -- from interface files, which always print in prefix form
509 = checkRn (isRdrDataCon name)
514 %*********************************************************
516 \subsection{Support code to rename types}
518 %*********************************************************
521 rnHsTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
522 rnHsTypeFVs doc_str ty
523 = rnHsType doc_str ty `thenRn` \ ty' ->
524 returnRn (ty', extractHsTyNames ty')
526 rnHsSigTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
527 rnHsSigTypeFVs doc_str ty
528 = rnHsSigType doc_str ty `thenRn` \ ty' ->
529 returnRn (ty', extractHsTyNames ty')
531 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
532 -- rnHsSigType is used for source-language type signatures,
533 -- which use *implicit* universal quantification.
534 rnHsSigType doc_str ty
535 = rnHsType (text "the type signature for" <+> doc_str) ty
537 ---------------------------------------
538 rnHsType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
540 rnHsType doc (HsForAllTy Nothing ctxt ty)
541 -- Implicit quantifiction in source code (no kinds on tyvars)
542 -- Given the signature C => T we universally quantify
543 -- over FV(T) \ {in-scope-tyvars}
544 = getLocalNameEnv `thenRn` \ name_env ->
546 mentioned_in_tau = extractHsTyRdrTyVars ty
547 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
548 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
549 forall_tyvars = filter (not . (`elemRdrEnv` name_env)) mentioned
551 rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
553 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
554 -- Explicit quantification.
555 -- Check that the forall'd tyvars are actually
556 -- mentioned in the type, and produce a warning if not
558 mentioned_in_tau = extractHsTyRdrTyVars tau
559 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
560 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
561 forall_tyvar_names = hsTyVarNames forall_tyvars
563 -- Explicitly quantified but not mentioned in ctxt or tau
564 warn_guys = filter (`notElem` mentioned) forall_tyvar_names
566 mapRn_ (forAllWarn doc tau) warn_guys `thenRn_`
567 rnForAll doc forall_tyvars ctxt tau
569 rnHsType doc (HsTyVar tyvar)
570 = lookupOccRn tyvar `thenRn` \ tyvar' ->
571 returnRn (HsTyVar tyvar')
573 rnHsType doc (HsOpTy ty1 opname ty2)
574 = lookupOccRn opname `thenRn` \ name' ->
575 rnHsType doc ty1 `thenRn` \ ty1' ->
576 rnHsType doc ty2 `thenRn` \ ty2' ->
577 returnRn (HsOpTy ty1' name' ty2')
579 rnHsType doc (HsNumTy i)
580 | i == 1 = returnRn (HsNumTy i)
581 | otherwise = failWithRn (HsNumTy i)
582 (ptext SLIT("Only unit numeric type pattern is valid"))
584 rnHsType doc (HsFunTy ty1 ty2)
585 = rnHsType doc ty1 `thenRn` \ ty1' ->
586 -- Might find a for-all as the arg of a function type
587 rnHsType doc ty2 `thenRn` \ ty2' ->
588 -- Or as the result. This happens when reading Prelude.hi
589 -- when we find return :: forall m. Monad m -> forall a. a -> m a
590 returnRn (HsFunTy ty1' ty2')
592 rnHsType doc (HsListTy ty)
593 = rnHsType doc ty `thenRn` \ ty' ->
594 returnRn (HsListTy ty')
596 -- Unboxed tuples are allowed to have poly-typed arguments. These
597 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
598 rnHsType doc (HsTupleTy (HsTupCon _ boxity) tys)
599 -- Don't do lookupOccRn, because this is built-in syntax
600 -- so it doesn't need to be in scope
601 = mapRn (rnHsType doc) tys `thenRn` \ tys' ->
602 returnRn (HsTupleTy (HsTupCon n' boxity) tys')
604 n' = tupleTyCon_name boxity (length tys)
607 rnHsType doc (HsAppTy ty1 ty2)
608 = rnHsType doc ty1 `thenRn` \ ty1' ->
609 rnHsType doc ty2 `thenRn` \ ty2' ->
610 returnRn (HsAppTy ty1' ty2')
612 rnHsType doc (HsPredTy pred)
613 = rnPred doc pred `thenRn` \ pred' ->
614 returnRn (HsPredTy pred')
616 rnHsType doc (HsUsgForAllTy uv_rdr ty)
617 = bindUVarRn uv_rdr $ \ uv_name ->
618 rnHsType doc ty `thenRn` \ ty' ->
619 returnRn (HsUsgForAllTy uv_name ty')
621 rnHsType doc (HsUsgTy usg ty)
622 = newUsg usg `thenRn` \ usg' ->
623 rnHsType doc ty `thenRn` \ ty' ->
624 -- A for-all can occur inside a usage annotation
625 returnRn (HsUsgTy usg' ty')
627 newUsg usg = case usg of
628 HsUsOnce -> returnRn HsUsOnce
629 HsUsMany -> returnRn HsUsMany
630 HsUsVar uv_rdr -> lookupOccRn uv_rdr `thenRn` \ uv_name ->
631 returnRn (HsUsVar uv_name)
633 rnHsTypes doc tys = mapRn (rnHsType doc) tys
637 -- We use lookupOcc here because this is interface file only stuff
638 -- and we need the workers...
639 rnHsTupCon (HsTupCon n boxity)
640 = lookupOccRn n `thenRn` \ n' ->
641 returnRn (HsTupCon n' boxity)
643 rnHsTupConWkr (HsTupCon n boxity)
644 -- Tuple construtors are for the *worker* of the tuple
645 -- Going direct saves needless messing about
646 = lookupOccRn (mkRdrNameWkr n) `thenRn` \ n' ->
647 returnRn (HsTupCon n' boxity)
651 rnForAll doc forall_tyvars ctxt ty
652 = bindTyVarsRn doc forall_tyvars $ \ new_tyvars ->
653 rnContext doc ctxt `thenRn` \ new_ctxt ->
654 rnHsType doc ty `thenRn` \ new_ty ->
655 returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty)
659 rnContext :: SDoc -> RdrNameContext -> RnMS RenamedContext
661 = mapRn rn_pred ctxt `thenRn` \ theta ->
663 (_, dups) = removeDupsEq theta
664 -- We only have equality, not ordering
666 -- Check for duplicate assertions
667 -- If this isn't an error, then it ought to be:
668 mapRn (addWarnRn . dupClassAssertWarn theta) dups `thenRn_`
671 --Someone discovered that @CCallable@ and @CReturnable@
672 -- could be used in contexts such as:
673 -- foo :: CCallable a => a -> PrimIO Int
674 -- Doing this utterly wrecks the whole point of introducing these
675 -- classes so we specifically check that this isn't being done.
676 rn_pred pred = rnPred doc pred `thenRn` \ pred'->
677 checkRn (not (bad_pred pred'))
678 (naughtyCCallContextErr pred') `thenRn_`
681 bad_pred (HsPClass clas _) = getUnique clas `elem` cCallishClassKeys
682 bad_pred other = False
685 rnPred doc (HsPClass clas tys)
686 = lookupOccRn clas `thenRn` \ clas_name ->
687 rnHsTypes doc tys `thenRn` \ tys' ->
688 returnRn (HsPClass clas_name tys')
690 rnPred doc (HsPIParam n ty)
691 = newIPName n `thenRn` \ name ->
692 rnHsType doc ty `thenRn` \ ty' ->
693 returnRn (HsPIParam name ty')
697 rnFds :: SDoc -> [FunDep RdrName] -> RnMS [FunDep Name]
703 = rnHsTyVars doc tys1 `thenRn` \ tys1' ->
704 rnHsTyVars doc tys2 `thenRn` \ tys2' ->
705 returnRn (tys1', tys2')
707 rnHsTyVars doc tvs = mapRn (rnHsTyvar doc) tvs
708 rnHsTyvar doc tyvar = lookupOccRn tyvar
711 %*********************************************************
715 %*********************************************************
718 rnIdInfo (HsWorker worker)
719 = lookupOccRn worker `thenRn` \ worker' ->
720 returnRn (HsWorker worker')
722 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
723 returnRn (HsUnfold inline expr')
724 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str)
725 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
726 rnIdInfo HsNoCafRefs = returnRn HsNoCafRefs
727 rnIdInfo HsCprInfo = returnRn HsCprInfo
730 @UfCore@ expressions.
733 rnCoreExpr (UfType ty)
734 = rnHsType (text "unfolding type") ty `thenRn` \ ty' ->
735 returnRn (UfType ty')
738 = lookupOccRn v `thenRn` \ v' ->
744 rnCoreExpr (UfLitLit l ty)
745 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
746 returnRn (UfLitLit l ty')
748 rnCoreExpr (UfCCall cc ty)
749 = rnHsType (text "ccall") ty `thenRn` \ ty' ->
750 returnRn (UfCCall cc ty')
752 rnCoreExpr (UfTuple con args)
753 = rnHsTupConWkr con `thenRn` \ con' ->
754 mapRn rnCoreExpr args `thenRn` \ args' ->
755 returnRn (UfTuple con' args')
757 rnCoreExpr (UfApp fun arg)
758 = rnCoreExpr fun `thenRn` \ fun' ->
759 rnCoreExpr arg `thenRn` \ arg' ->
760 returnRn (UfApp fun' arg')
762 rnCoreExpr (UfCase scrut bndr alts)
763 = rnCoreExpr scrut `thenRn` \ scrut' ->
764 bindCoreLocalRn bndr $ \ bndr' ->
765 mapRn rnCoreAlt alts `thenRn` \ alts' ->
766 returnRn (UfCase scrut' bndr' alts')
768 rnCoreExpr (UfNote note expr)
769 = rnNote note `thenRn` \ note' ->
770 rnCoreExpr expr `thenRn` \ expr' ->
771 returnRn (UfNote note' expr')
773 rnCoreExpr (UfLam bndr body)
774 = rnCoreBndr bndr $ \ bndr' ->
775 rnCoreExpr body `thenRn` \ body' ->
776 returnRn (UfLam bndr' body')
778 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
779 = rnCoreExpr rhs `thenRn` \ rhs' ->
780 rnCoreBndr bndr $ \ bndr' ->
781 rnCoreExpr body `thenRn` \ body' ->
782 returnRn (UfLet (UfNonRec bndr' rhs') body')
784 rnCoreExpr (UfLet (UfRec pairs) body)
785 = rnCoreBndrs bndrs $ \ bndrs' ->
786 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
787 rnCoreExpr body `thenRn` \ body' ->
788 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
790 (bndrs, rhss) = unzip pairs
794 rnCoreBndr (UfValBinder name ty) thing_inside
795 = rnHsType doc ty `thenRn` \ ty' ->
796 bindCoreLocalRn name $ \ name' ->
797 thing_inside (UfValBinder name' ty')
799 doc = text "unfolding id"
801 rnCoreBndr (UfTyBinder name kind) thing_inside
802 = bindCoreLocalRn name $ \ name' ->
803 thing_inside (UfTyBinder name' kind)
805 rnCoreBndrs [] thing_inside = thing_inside []
806 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
807 rnCoreBndrs bs $ \ names' ->
808 thing_inside (name':names')
812 rnCoreAlt (con, bndrs, rhs)
813 = rnUfCon con bndrs `thenRn` \ con' ->
814 bindCoreLocalsRn bndrs $ \ bndrs' ->
815 rnCoreExpr rhs `thenRn` \ rhs' ->
816 returnRn (con', bndrs', rhs')
819 = rnHsType (text "unfolding coerce") ty `thenRn` \ ty' ->
820 returnRn (UfCoerce ty')
822 rnNote (UfSCC cc) = returnRn (UfSCC cc)
823 rnNote UfInlineCall = returnRn UfInlineCall
824 rnNote UfInlineMe = returnRn UfInlineMe
830 rnUfCon (UfTupleAlt tup_con) bndrs
831 = rnHsTupCon tup_con `thenRn` \ (HsTupCon con' _) ->
832 returnRn (UfDataAlt con')
833 -- Makes the type checker a little easier
835 rnUfCon (UfDataAlt con) _
836 = lookupOccRn con `thenRn` \ con' ->
837 returnRn (UfDataAlt con')
839 rnUfCon (UfLitAlt lit) _
840 = returnRn (UfLitAlt lit)
842 rnUfCon (UfLitLitAlt lit ty) _
843 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
844 returnRn (UfLitLitAlt lit ty')
847 %*********************************************************
849 \subsection{Rule shapes}
851 %*********************************************************
853 Check the shape of a transformation rule LHS. Currently
854 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
855 not one of the @forall@'d variables.
858 validRuleLhs foralls lhs
861 check (HsApp e1 e2) = check e1
862 check (HsVar v) | v `notElem` foralls = True
867 %*********************************************************
871 %*********************************************************
874 derivingNonStdClassErr clas
875 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
878 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
880 forAllWarn doc ty tyvar
881 = doptRn Opt_WarnUnusedMatches `thenRn` \ warn_unused -> case () of
882 () | not warn_unused -> returnRn ()
884 -> getModeRn `thenRn` \ mode ->
887 InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
888 -- unless DEBUG is on, in which case it is slightly
889 -- informative. They can arise from mkRhsTyLam,
890 #endif -- leading to (say) f :: forall a b. [b] -> [b]
893 sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
894 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
896 (ptext SLIT("In") <+> doc)
900 badRuleLhsErr name lhs
901 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
902 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
904 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
907 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
908 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
909 ptext SLIT("does not appear on left hand side")]
911 badExtName :: ExtName -> Message
913 = sep [quotes (ppr ext_nm) <+> ptext SLIT("is not a valid C identifier")]
915 dupClassAssertWarn ctxt (assertion : dups)
916 = sep [hsep [ptext SLIT("Duplicate class assertion"),
917 quotes (ppr assertion),
918 ptext SLIT("in the context:")],
919 nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
921 naughtyCCallContextErr (HsPClass clas _)
922 = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),
923 ptext SLIT("in a context")]