2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
7 module RnSource ( 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, 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 DataCon ( dataConId )
38 import Name ( Name, NamedThing(..) )
40 import PrelInfo ( derivableClassKeys, cCallishClassKeys )
41 import PrelNames ( deRefStablePtr_RDR, newStablePtr_RDR,
42 bindIO_RDR, returnIO_RDR
44 import TysWiredIn ( tupleCon )
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 Maybes ( maybeToBool )
52 import ErrUtils ( Message )
53 import CStrings ( isCLabelString )
54 import ListSetOps ( removeDupsEq )
57 @rnSourceDecl@ `renames' declarations.
58 It simultaneously performs dependency analysis and precedence parsing.
59 It also does the following error checks:
62 Checks that tyvars are used properly. This includes checking
63 for undefined tyvars, and tyvars in contexts that are ambiguous.
64 (Some of this checking has now been moved to module @TcMonoType@,
65 since we don't have functional dependency information at this point.)
67 Checks that all variable occurences are defined.
69 Checks the @(..)@ etc constraints in the export list.
73 %*********************************************************
75 \subsection{Source code declarations}
77 %*********************************************************
80 rnSourceDecls :: GlobalRdrEnv -> LocalFixityEnv
82 -> RnMG ([RenamedHsDecl], FreeVars)
83 -- The decls get reversed, but that's ok
85 rnSourceDecls gbl_env local_fixity_env decls
86 = initRnMS gbl_env emptyRdrEnv local_fixity_env SourceMode (go emptyFVs [] decls)
88 -- Fixity and deprecations have been dealt with already; ignore them
89 go fvs ds' [] = returnRn (ds', fvs)
90 go fvs ds' (FixD _:ds) = go fvs ds' ds
91 go fvs ds' (DeprecD _:ds) = go fvs ds' ds
92 go fvs ds' (d:ds) = rnSourceDecl d `thenRn` \(d', fvs') ->
93 go (fvs `plusFV` fvs') (d':ds') ds
96 rnSourceDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
98 rnSourceDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
99 returnRn (ValD new_binds, fvs)
101 rnSourceDecl (TyClD tycl_decl)
102 = rnTyClDecl tycl_decl `thenRn` \ new_decl ->
103 finishSourceTyClDecl tycl_decl new_decl `thenRn` \ (new_decl', fvs) ->
104 returnRn (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
106 rnSourceDecl (InstD inst)
107 = rnInstDecl inst `thenRn` \ new_inst ->
108 finishSourceInstDecl inst new_inst `thenRn` \ (new_inst', fvs) ->
109 returnRn (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
111 rnSourceDecl (RuleD rule)
112 = rnHsRuleDecl rule `thenRn` \ (new_rule, fvs) ->
113 returnRn (RuleD new_rule, fvs)
115 rnSourceDecl (DefD (DefaultDecl tys src_loc))
116 = pushSrcLocRn src_loc $
117 mapFvRn (rnHsTypeFVs doc_str) tys `thenRn` \ (tys', fvs) ->
118 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
120 doc_str = text "a `default' declaration"
122 rnSourceDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
123 = pushSrcLocRn src_loc $
124 lookupOccRn name `thenRn` \ name' ->
127 | isDyn = lookupOrigNames [newStablePtr_RDR, deRefStablePtr_RDR,
128 bindIO_RDR, returnIO_RDR]
130 lookupOrigNames [bindIO_RDR, returnIO_RDR] `thenRn` \ fvs ->
131 returnRn (addOneFV fvs name')
132 extra_fvs other = returnRn emptyFVs
134 checkRn (ok_ext_nm ext_nm) (badExtName ext_nm) `thenRn_`
136 extra_fvs imp_exp `thenRn` \ fvs1 ->
138 rnHsTypeFVs fo_decl_msg ty `thenRn` \ (ty', fvs2) ->
139 returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc),
142 fo_decl_msg = ptext SLIT("The foreign declaration for") <+> ppr name
143 isDyn = isDynamicExtName ext_nm
145 ok_ext_nm Dynamic = True
146 ok_ext_nm (ExtName nm (Just mb)) = isCLabelString nm && isCLabelString mb
147 ok_ext_nm (ExtName nm Nothing) = isCLabelString nm
151 %*********************************************************
153 \subsection{Instance declarations}
155 %*********************************************************
158 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
159 -- Used for both source and interface file decls
160 = pushSrcLocRn src_loc $
161 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ inst_ty' ->
163 (case maybe_dfun_rdr_name of
164 Nothing -> returnRn Nothing
165 Just dfun_rdr_name -> lookupIfaceName dfun_rdr_name `thenRn` \ dfun_name ->
166 returnRn (Just dfun_name)
167 ) `thenRn` \ maybe_dfun_name ->
169 -- The typechecker checks that all the bindings are for the right class.
170 returnRn (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
172 -- Compare finishSourceTyClDecl
173 finishSourceInstDecl (InstDecl _ mbinds uprags _ _ )
174 (InstDecl inst_ty _ _ maybe_dfun_name src_loc)
175 -- Used for both source decls only
176 = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
178 meth_doc = text "the bindings in an instance declaration"
179 meth_names = collectLocatedMonoBinders mbinds
180 inst_tyvars = case inst_ty of
181 HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
183 -- (Slightly strangely) the forall-d tyvars scope over
184 -- the method bindings too
187 -- Rename the bindings
188 -- NB meth_names can be qualified!
189 checkDupNames meth_doc meth_names `thenRn_`
190 extendTyVarEnvFVRn (map hsTyVarName inst_tyvars) (
191 rnMethodBinds [] mbinds
192 ) `thenRn` \ (mbinds', meth_fvs) ->
194 binders = collectMonoBinders mbinds'
195 binder_set = mkNameSet binders
197 -- Rename the prags and signatures.
198 -- Note that the type variables are not in scope here,
199 -- so that instance Eq a => Eq (T a) where
200 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
203 -- But the (unqualified) method names are in scope
204 bindLocalNames binders (
205 renameSigsFVs (okInstDclSig binder_set) uprags
206 ) `thenRn` \ (uprags', prag_fvs) ->
208 returnRn (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
209 meth_fvs `plusFV` prag_fvs)
212 %*********************************************************
216 %*********************************************************
219 rnIfaceRuleDecl (IfaceRule rule_name vars fn args rhs src_loc)
220 = pushSrcLocRn src_loc $
221 lookupOccRn fn `thenRn` \ fn' ->
222 rnCoreBndrs vars $ \ vars' ->
223 mapRn rnCoreExpr args `thenRn` \ args' ->
224 rnCoreExpr rhs `thenRn` \ rhs' ->
225 returnRn (IfaceRule rule_name vars' fn' args' rhs' src_loc)
227 rnHsRuleDecl (HsRule rule_name tvs vars lhs rhs src_loc)
229 pushSrcLocRn src_loc $
231 bindTyVarsFV2Rn doc (map UserTyVar sig_tvs) $ \ sig_tvs' _ ->
232 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
233 mapFvRn rn_var (vars `zip` ids) `thenRn` \ (vars', fv_vars) ->
235 rnExpr lhs `thenRn` \ (lhs', fv_lhs) ->
236 rnExpr rhs `thenRn` \ (rhs', fv_rhs) ->
237 checkRn (validRuleLhs ids lhs')
238 (badRuleLhsErr rule_name lhs') `thenRn_`
240 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
242 mapRn (addErrRn . badRuleVar rule_name) bad_vars `thenRn_`
243 returnRn (HsRule rule_name sig_tvs' vars' lhs' rhs' src_loc,
244 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
246 doc = text "the transformation rule" <+> ptext rule_name
247 sig_tvs = extractRuleBndrsTyVars vars
249 get_var (RuleBndr v) = v
250 get_var (RuleBndrSig v _) = v
252 rn_var (RuleBndr v, id) = returnRn (RuleBndr id, emptyFVs)
253 rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t `thenRn` \ (t', fvs) ->
254 returnRn (RuleBndrSig id t', fvs)
258 %*********************************************************
260 \subsection{Type, class and iface sig declarations}
262 %*********************************************************
264 @rnTyDecl@ uses the `global name function' to create a new type
265 declaration in which local names have been replaced by their original
266 names, reporting any unknown names.
268 Renaming type variables is a pain. Because they now contain uniques,
269 it is necessary to pass in an association list which maps a parsed
270 tyvar to its @Name@ representation.
271 In some cases (type signatures of values),
272 it is even necessary to go over the type first
273 in order to get the set of tyvars used by it, make an assoc list,
274 and then go over it again to rename the tyvars!
275 However, we can also do some scoping checks at the same time.
278 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
280 lookupTopBndrRn name `thenRn` \ name' ->
281 rnHsType doc_str ty `thenRn` \ ty' ->
282 mapRn rnIdInfo id_infos `thenRn` \ id_infos' ->
283 returnRn (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
285 doc_str = text "the interface signature for" <+> quotes (ppr name)
287 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
288 tcdTyVars = tyvars, tcdCons = condecls, tcdNCons = nconstrs,
289 tcdLoc = src_loc, tcdSysNames = sys_names})
290 = pushSrcLocRn src_loc $
291 lookupTopBndrRn tycon `thenRn` \ tycon' ->
292 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
293 rnContext data_doc context `thenRn` \ context' ->
294 checkDupOrQualNames data_doc con_names `thenRn_`
295 mapRn rnConDecl condecls `thenRn` \ condecls' ->
296 mapRn lookupSysBinder sys_names `thenRn` \ sys_names' ->
297 returnRn (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
298 tcdTyVars = tyvars', tcdCons = condecls', tcdNCons = nconstrs,
299 tcdDerivs = Nothing, tcdLoc = src_loc, tcdSysNames = sys_names'})
301 data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
302 con_names = map conDeclName condecls
304 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
305 = pushSrcLocRn src_loc $
306 doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
307 lookupTopBndrRn name `thenRn` \ name' ->
308 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
309 rnHsType syn_doc (unquantify glaExts ty) `thenRn` \ ty' ->
310 returnRn (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
312 syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
314 -- For H98 we do *not* universally quantify on the RHS of a synonym
315 -- Silently discard context... but the tyvars in the rest won't be in scope
316 -- In interface files all types are quantified, so this is a no-op
317 unquantify glaExts (HsForAllTy Nothing ctxt ty) | glaExts = ty
318 unquantify glaExts ty = ty
320 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
321 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
322 tcdSysNames = names, tcdLoc = src_loc})
323 -- Used for both source and interface file decls
324 = pushSrcLocRn src_loc $
326 lookupTopBndrRn cname `thenRn` \ cname' ->
328 -- Deal with the implicit tycon and datacon name
329 -- They aren't in scope (because they aren't visible to the user)
330 -- and what we want to do is simply look them up in the cache;
331 -- we jolly well ought to get a 'hit' there!
332 mapRn lookupSysBinder names `thenRn` \ names' ->
334 -- Tyvars scope over bindings and context
335 bindTyVars2Rn cls_doc tyvars $ \ clas_tyvar_names tyvars' ->
337 -- Check the superclasses
338 rnContext cls_doc context `thenRn` \ context' ->
340 -- Check the functional dependencies
341 rnFds cls_doc fds `thenRn` \ fds' ->
343 -- Check the signatures
344 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
346 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
347 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
349 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
350 mapRn (rnClassOp cname' clas_tyvar_names fds') op_sigs `thenRn` \ sigs' ->
352 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
354 renameSigs (okClsDclSig binders) non_op_sigs `thenRn` \ non_ops' ->
356 -- Typechecker is responsible for checking that we only
357 -- give default-method bindings for things in this class.
358 -- The renamer *could* check this for class decls, but can't
359 -- for instance decls.
361 returnRn (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
362 tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
363 tcdSysNames = names', tcdLoc = 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 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
378 -> -- Imported class that has a default method decl
379 -- See comments with tname, snames, above
380 lookupSysBinder dm_rdr_name `thenRn` \ dm_name ->
381 returnRn (DefMeth dm_name)
382 -- An imported class decl for a class decl that had an explicit default
383 -- method, mentions, rather than defines,
384 -- the default method, so we must arrange to pull it in
386 GenDefMeth -> returnRn GenDefMeth
387 NoDefMeth -> returnRn NoDefMeth
388 ) `thenRn` \ dm_stuff' ->
390 returnRn (ClassOpSig op_name dm_stuff' new_ty locn)
392 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
393 -- Used for source file decls only
394 -- Renames the default-bindings of a class decl
395 -- the derivings of a data decl
396 finishSourceTyClDecl (TyData {tcdDerivs = Just derivs, tcdLoc = src_loc}) -- Derivings in here
397 rn_ty_decl -- Everything else is here
398 = pushSrcLocRn src_loc $
399 mapRn rnDeriv derivs `thenRn` \ derivs' ->
400 returnRn (rn_ty_decl {tcdDerivs = Just derivs'}, mkNameSet derivs')
402 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc}) -- Get mbinds from here
403 rn_cls_decl@(ClassDecl {tcdTyVars = tyvars}) -- Everything else is here
404 -- There are some default-method bindings (abeit possibly empty) so
405 -- this is a source-code class declaration
406 = -- The newLocals call is tiresome: given a generic class decl
409 -- op {| x+y |} (Inl a) = ...
410 -- op {| x+y |} (Inr b) = ...
411 -- op {| a*b |} (a*b) = ...
412 -- we want to name both "x" tyvars with the same unique, so that they are
413 -- easy to group together in the typechecker.
415 pushSrcLocRn src_loc $
416 extendTyVarEnvFVRn (map hsTyVarName tyvars) $
417 getLocalNameEnv `thenRn` \ name_env ->
419 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
420 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
421 not (tv `elemRdrEnv` name_env)]
423 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
424 newLocalsRn gen_rdr_tyvars_w_locs `thenRn` \ gen_tyvars ->
425 rnMethodBinds gen_tyvars mbinds `thenRn` \ (mbinds', meth_fvs) ->
426 returnRn (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
428 meth_doc = text "the default-methods for class" <+> ppr (tcdName rn_cls_decl)
430 finishSourceTyClDecl _ tycl_decl = returnRn (tycl_decl, emptyFVs)
431 -- Not a class declaration
435 %*********************************************************
437 \subsection{Support code for type/data declarations}
439 %*********************************************************
442 rnDeriv :: RdrName -> RnMS Name
444 = 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
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 bindTyVarsRn doc tvs $ \ new_tyvars ->
464 rnContext doc cxt `thenRn` \ new_context ->
465 rnConDetails doc locn details `thenRn` \ new_details ->
466 returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn)
468 doc = text "the definition of data constructor" <+> quotes (ppr name)
470 rnConDetails doc locn (VanillaCon tys)
471 = mapRn (rnBangTy doc) tys `thenRn` \ new_tys ->
472 returnRn (VanillaCon new_tys)
474 rnConDetails doc locn (InfixCon ty1 ty2)
475 = rnBangTy doc ty1 `thenRn` \ new_ty1 ->
476 rnBangTy doc ty2 `thenRn` \ new_ty2 ->
477 returnRn (InfixCon new_ty1 new_ty2)
479 rnConDetails doc locn (RecCon fields)
480 = checkDupOrQualNames doc field_names `thenRn_`
481 mapRn (rnField doc) fields `thenRn` \ new_fields ->
482 returnRn (RecCon new_fields)
484 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
486 rnField doc (names, ty)
487 = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
488 rnBangTy doc ty `thenRn` \ new_ty ->
489 returnRn (new_names, new_ty)
491 rnBangTy doc (Banged ty)
492 = rnHsType doc ty `thenRn` \ new_ty ->
493 returnRn (Banged new_ty)
495 rnBangTy doc (Unbanged ty)
496 = rnHsType doc ty `thenRn` \ new_ty ->
497 returnRn (Unbanged new_ty)
499 rnBangTy doc (Unpacked ty)
500 = rnHsType doc ty `thenRn` \ new_ty ->
501 returnRn (Unpacked new_ty)
503 -- This data decl will parse OK
505 -- treating "a" as the constructor.
506 -- It is really hard to make the parser spot this malformation.
507 -- So the renamer has to check that the constructor is legal
509 -- We can get an operator as the constructor, even in the prefix form:
510 -- data T = :% Int Int
511 -- from interface files, which always print in prefix form
514 = checkRn (isRdrDataCon name)
519 %*********************************************************
521 \subsection{Support code to rename types}
523 %*********************************************************
526 rnHsTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
527 rnHsTypeFVs doc_str ty
528 = rnHsType doc_str ty `thenRn` \ ty' ->
529 returnRn (ty', extractHsTyNames ty')
531 rnHsSigTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
532 rnHsSigTypeFVs doc_str ty
533 = rnHsSigType doc_str ty `thenRn` \ ty' ->
534 returnRn (ty', extractHsTyNames ty')
536 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
537 -- rnHsSigType is used for source-language type signatures,
538 -- which use *implicit* universal quantification.
539 rnHsSigType doc_str ty
540 = rnHsType (text "the type signature for" <+> doc_str) ty
542 ---------------------------------------
543 rnHsType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
545 rnHsType doc (HsForAllTy Nothing ctxt ty)
546 -- Implicit quantifiction in source code (no kinds on tyvars)
547 -- Given the signature C => T we universally quantify
548 -- over FV(T) \ {in-scope-tyvars}
549 = getLocalNameEnv `thenRn` \ name_env ->
551 mentioned_in_tau = extractHsTyRdrTyVars ty
552 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
553 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
554 forall_tyvars = filter (not . (`elemRdrEnv` name_env)) mentioned
556 rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
558 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
559 -- Explicit quantification.
560 -- Check that the forall'd tyvars are actually
561 -- mentioned in the type, and produce a warning if not
563 mentioned_in_tau = extractHsTyRdrTyVars tau
564 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
565 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
566 forall_tyvar_names = hsTyVarNames forall_tyvars
568 -- Explicitly quantified but not mentioned in ctxt or tau
569 warn_guys = filter (`notElem` mentioned) forall_tyvar_names
571 mapRn_ (forAllWarn doc tau) warn_guys `thenRn_`
572 rnForAll doc forall_tyvars ctxt tau
574 rnHsType doc (HsTyVar tyvar)
575 = lookupOccRn tyvar `thenRn` \ tyvar' ->
576 returnRn (HsTyVar tyvar')
578 rnHsType doc (HsOpTy ty1 opname ty2)
579 = lookupOccRn opname `thenRn` \ name' ->
580 rnHsType doc ty1 `thenRn` \ ty1' ->
581 rnHsType doc ty2 `thenRn` \ ty2' ->
582 returnRn (HsOpTy ty1' name' ty2')
584 rnHsType doc (HsNumTy i)
585 | i == 1 = returnRn (HsNumTy i)
586 | otherwise = failWithRn (HsNumTy i)
587 (ptext SLIT("Only unit numeric type pattern is valid"))
589 rnHsType doc (HsFunTy ty1 ty2)
590 = rnHsType doc ty1 `thenRn` \ ty1' ->
591 -- Might find a for-all as the arg of a function type
592 rnHsType doc ty2 `thenRn` \ ty2' ->
593 -- Or as the result. This happens when reading Prelude.hi
594 -- when we find return :: forall m. Monad m -> forall a. a -> m a
595 returnRn (HsFunTy ty1' ty2')
597 rnHsType doc (HsListTy ty)
598 = rnHsType doc ty `thenRn` \ ty' ->
599 returnRn (HsListTy ty')
601 -- Unboxed tuples are allowed to have poly-typed arguments. These
602 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
603 rnHsType doc (HsTupleTy (HsTupCon _ boxity arity) tys)
604 -- Don't do lookupOccRn, because this is built-in syntax
605 -- so it doesn't need to be in scope
606 = mapRn (rnHsType doc) tys `thenRn` \ tys' ->
607 returnRn (HsTupleTy (HsTupCon tup_name boxity arity) tys')
609 tup_name = tupleTyCon_name boxity arity
612 rnHsType doc (HsAppTy ty1 ty2)
613 = rnHsType doc ty1 `thenRn` \ ty1' ->
614 rnHsType doc ty2 `thenRn` \ ty2' ->
615 returnRn (HsAppTy ty1' ty2')
617 rnHsType doc (HsPredTy pred)
618 = rnPred doc pred `thenRn` \ pred' ->
619 returnRn (HsPredTy pred')
621 rnHsTypes doc tys = mapRn (rnHsType doc) tys
625 rnForAll doc forall_tyvars ctxt ty
626 = bindTyVarsRn doc forall_tyvars $ \ new_tyvars ->
627 rnContext doc ctxt `thenRn` \ new_ctxt ->
628 rnHsType doc ty `thenRn` \ new_ty ->
629 returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty)
633 rnContext :: SDoc -> RdrNameContext -> RnMS RenamedContext
635 = mapRn rn_pred ctxt `thenRn` \ theta ->
637 (_, dups) = removeDupsEq theta
638 -- We only have equality, not ordering
640 -- Check for duplicate assertions
641 -- If this isn't an error, then it ought to be:
642 mapRn (addWarnRn . dupClassAssertWarn theta) dups `thenRn_`
645 --Someone discovered that @CCallable@ and @CReturnable@
646 -- could be used in contexts such as:
647 -- foo :: CCallable a => a -> PrimIO Int
648 -- Doing this utterly wrecks the whole point of introducing these
649 -- classes so we specifically check that this isn't being done.
650 rn_pred pred = rnPred doc pred `thenRn` \ pred'->
651 checkRn (not (bad_pred pred'))
652 (naughtyCCallContextErr pred') `thenRn_`
655 bad_pred (HsClassP clas _) = getUnique clas `elem` cCallishClassKeys
656 bad_pred other = False
659 rnPred doc (HsClassP clas tys)
660 = lookupOccRn clas `thenRn` \ clas_name ->
661 rnHsTypes doc tys `thenRn` \ tys' ->
662 returnRn (HsClassP clas_name tys')
664 rnPred doc (HsIParam n ty)
665 = newIPName n `thenRn` \ name ->
666 rnHsType doc ty `thenRn` \ ty' ->
667 returnRn (HsIParam name ty')
671 rnFds :: SDoc -> [FunDep RdrName] -> RnMS [FunDep Name]
677 = rnHsTyVars doc tys1 `thenRn` \ tys1' ->
678 rnHsTyVars doc tys2 `thenRn` \ tys2' ->
679 returnRn (tys1', tys2')
681 rnHsTyVars doc tvs = mapRn (rnHsTyvar doc) tvs
682 rnHsTyvar doc tyvar = lookupOccRn tyvar
685 %*********************************************************
689 %*********************************************************
692 rnIdInfo (HsWorker worker arity)
693 = lookupOccRn worker `thenRn` \ worker' ->
694 returnRn (HsWorker worker' arity)
696 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
697 returnRn (HsUnfold inline expr')
698 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str)
699 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
700 rnIdInfo HsNoCafRefs = returnRn HsNoCafRefs
701 rnIdInfo HsCprInfo = returnRn HsCprInfo
704 @UfCore@ expressions.
707 rnCoreExpr (UfType ty)
708 = rnHsType (text "unfolding type") ty `thenRn` \ ty' ->
709 returnRn (UfType ty')
712 = lookupOccRn v `thenRn` \ v' ->
718 rnCoreExpr (UfLitLit l ty)
719 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
720 returnRn (UfLitLit l ty')
722 rnCoreExpr (UfCCall cc ty)
723 = rnHsType (text "ccall") ty `thenRn` \ ty' ->
724 returnRn (UfCCall cc ty')
726 rnCoreExpr (UfTuple (HsTupCon _ boxity arity) args)
727 = mapRn rnCoreExpr args `thenRn` \ args' ->
728 returnRn (UfTuple (HsTupCon tup_name boxity arity) args')
730 tup_name = getName (dataConId (tupleCon boxity arity))
731 -- Get the *worker* name and use that
733 rnCoreExpr (UfApp fun arg)
734 = rnCoreExpr fun `thenRn` \ fun' ->
735 rnCoreExpr arg `thenRn` \ arg' ->
736 returnRn (UfApp fun' arg')
738 rnCoreExpr (UfCase scrut bndr alts)
739 = rnCoreExpr scrut `thenRn` \ scrut' ->
740 bindCoreLocalRn bndr $ \ bndr' ->
741 mapRn rnCoreAlt alts `thenRn` \ alts' ->
742 returnRn (UfCase scrut' bndr' alts')
744 rnCoreExpr (UfNote note expr)
745 = rnNote note `thenRn` \ note' ->
746 rnCoreExpr expr `thenRn` \ expr' ->
747 returnRn (UfNote note' expr')
749 rnCoreExpr (UfLam bndr body)
750 = rnCoreBndr bndr $ \ bndr' ->
751 rnCoreExpr body `thenRn` \ body' ->
752 returnRn (UfLam bndr' body')
754 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
755 = rnCoreExpr rhs `thenRn` \ rhs' ->
756 rnCoreBndr bndr $ \ bndr' ->
757 rnCoreExpr body `thenRn` \ body' ->
758 returnRn (UfLet (UfNonRec bndr' rhs') body')
760 rnCoreExpr (UfLet (UfRec pairs) body)
761 = rnCoreBndrs bndrs $ \ bndrs' ->
762 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
763 rnCoreExpr body `thenRn` \ body' ->
764 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
766 (bndrs, rhss) = unzip pairs
770 rnCoreBndr (UfValBinder name ty) thing_inside
771 = rnHsType doc ty `thenRn` \ ty' ->
772 bindCoreLocalRn name $ \ name' ->
773 thing_inside (UfValBinder name' ty')
775 doc = text "unfolding id"
777 rnCoreBndr (UfTyBinder name kind) thing_inside
778 = bindCoreLocalRn name $ \ name' ->
779 thing_inside (UfTyBinder name' kind)
781 rnCoreBndrs [] thing_inside = thing_inside []
782 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
783 rnCoreBndrs bs $ \ names' ->
784 thing_inside (name':names')
788 rnCoreAlt (con, bndrs, rhs)
789 = rnUfCon con `thenRn` \ con' ->
790 bindCoreLocalsRn bndrs $ \ bndrs' ->
791 rnCoreExpr rhs `thenRn` \ rhs' ->
792 returnRn (con', bndrs', rhs')
795 = rnHsType (text "unfolding coerce") ty `thenRn` \ ty' ->
796 returnRn (UfCoerce ty')
798 rnNote (UfSCC cc) = returnRn (UfSCC cc)
799 rnNote UfInlineCall = returnRn UfInlineCall
800 rnNote UfInlineMe = returnRn UfInlineMe
806 rnUfCon (UfTupleAlt (HsTupCon _ boxity arity))
807 = returnRn (UfTupleAlt (HsTupCon tup_name boxity arity))
809 tup_name = getName (tupleCon boxity arity)
811 rnUfCon (UfDataAlt con)
812 = lookupOccRn con `thenRn` \ con' ->
813 returnRn (UfDataAlt con')
815 rnUfCon (UfLitAlt lit)
816 = returnRn (UfLitAlt lit)
818 rnUfCon (UfLitLitAlt lit ty)
819 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
820 returnRn (UfLitLitAlt lit ty')
823 %*********************************************************
825 \subsection{Rule shapes}
827 %*********************************************************
829 Check the shape of a transformation rule LHS. Currently
830 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
831 not one of the @forall@'d variables.
834 validRuleLhs foralls lhs
837 check (HsApp e1 e2) = check e1
838 check (HsVar v) | v `notElem` foralls = True
843 %*********************************************************
847 %*********************************************************
850 derivingNonStdClassErr clas
851 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
854 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
856 forAllWarn doc ty tyvar
857 = doptRn Opt_WarnUnusedMatches `thenRn` \ warn_unused -> case () of
858 () | not warn_unused -> returnRn ()
860 -> getModeRn `thenRn` \ mode ->
863 InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
864 -- unless DEBUG is on, in which case it is slightly
865 -- informative. They can arise from mkRhsTyLam,
866 #endif -- leading to (say) f :: forall a b. [b] -> [b]
869 sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
870 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
872 (ptext SLIT("In") <+> doc)
876 badRuleLhsErr name lhs
877 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
878 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
880 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
883 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
884 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
885 ptext SLIT("does not appear on left hand side")]
887 badExtName :: ExtName -> Message
889 = sep [quotes (ppr ext_nm) <+> ptext SLIT("is not a valid C identifier")]
891 dupClassAssertWarn ctxt (assertion : dups)
892 = sep [hsep [ptext SLIT("Duplicate class assertion"),
893 quotes (ppr assertion),
894 ptext SLIT("in the context:")],
895 nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
897 naughtyCCallContextErr (HsClassP clas _)
898 = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),
899 ptext SLIT("in a context")]