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 ListSetOps ( removeDupsEq )
55 @rnSourceDecl@ `renames' declarations.
56 It simultaneously performs dependency analysis and precedence parsing.
57 It also does the following error checks:
60 Checks that tyvars are used properly. This includes checking
61 for undefined tyvars, and tyvars in contexts that are ambiguous.
62 (Some of this checking has now been moved to module @TcMonoType@,
63 since we don't have functional dependency information at this point.)
65 Checks that all variable occurences are defined.
67 Checks the @(..)@ etc constraints in the export list.
71 %*********************************************************
73 \subsection{Source code declarations}
75 %*********************************************************
78 rnSourceDecls :: GlobalRdrEnv -> LocalFixityEnv
80 -> RnMG ([RenamedHsDecl], FreeVars)
81 -- The decls get reversed, but that's ok
83 rnSourceDecls gbl_env local_fixity_env decls
84 = initRnMS gbl_env emptyRdrEnv local_fixity_env SourceMode (go emptyFVs [] decls)
86 -- Fixity and deprecations have been dealt with already; ignore them
87 go fvs ds' [] = returnRn (ds', fvs)
88 go fvs ds' (FixD _:ds) = go fvs ds' ds
89 go fvs ds' (DeprecD _:ds) = go fvs ds' ds
90 go fvs ds' (d:ds) = rnSourceDecl d `thenRn` \(d', fvs') ->
91 go (fvs `plusFV` fvs') (d':ds') ds
94 rnSourceDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
96 rnSourceDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
97 returnRn (ValD new_binds, fvs)
99 rnSourceDecl (TyClD tycl_decl)
100 = rnTyClDecl tycl_decl `thenRn` \ new_decl ->
101 finishSourceTyClDecl tycl_decl new_decl `thenRn` \ (new_decl', fvs) ->
102 returnRn (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
104 rnSourceDecl (InstD inst)
105 = rnInstDecl inst `thenRn` \ new_inst ->
106 finishSourceInstDecl inst new_inst `thenRn` \ (new_inst', fvs) ->
107 returnRn (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
109 rnSourceDecl (RuleD rule)
110 = rnHsRuleDecl rule `thenRn` \ (new_rule, fvs) ->
111 returnRn (RuleD new_rule, fvs)
113 rnSourceDecl (ForD ford)
114 = rnHsForeignDecl ford `thenRn` \ (new_ford, fvs) ->
115 returnRn (ForD new_ford, fvs)
117 rnSourceDecl (DefD (DefaultDecl tys src_loc))
118 = pushSrcLocRn src_loc $
119 mapFvRn (rnHsTypeFVs doc_str) tys `thenRn` \ (tys', fvs) ->
120 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
122 doc_str = text "In a `default' declaration"
126 %*********************************************************
128 \subsection{Foreign declarations}
130 %*********************************************************
133 rnHsForeignDecl (ForeignImport name ty spec src_loc)
134 = pushSrcLocRn src_loc $
135 lookupOccRn name `thenRn` \ name' ->
136 rnHsTypeFVs (fo_decl_msg name) ty `thenRn` \ (ty', fvs1) ->
137 lookupOrigNames (extras spec) `thenRn` \ fvs2 ->
138 returnRn (ForeignImport name' ty' spec src_loc, fvs1 `plusFV` fvs2)
140 extras (CDynImport _) = [newStablePtr_RDR, deRefStablePtr_RDR, bindIO_RDR, returnIO_RDR]
143 rnHsForeignDecl (ForeignExport name ty spec src_loc)
144 = pushSrcLocRn src_loc $
145 lookupOccRn name `thenRn` \ name' ->
146 rnHsTypeFVs (fo_decl_msg name) ty `thenRn` \ (ty', fvs1) ->
147 lookupOrigNames [bindIO_RDR, returnIO_RDR] `thenRn` \ fvs2 ->
148 returnRn (ForeignExport name' ty' spec src_loc, fvs1 `plusFV` fvs2)
150 fo_decl_msg name = ptext SLIT("The foreign declaration for") <+> ppr name
154 %*********************************************************
156 \subsection{Instance declarations}
158 %*********************************************************
161 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
162 -- Used for both source and interface file decls
163 = pushSrcLocRn src_loc $
164 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ inst_ty' ->
166 (case maybe_dfun_rdr_name of
167 Nothing -> returnRn Nothing
168 Just dfun_rdr_name -> lookupIfaceName dfun_rdr_name `thenRn` \ dfun_name ->
169 returnRn (Just dfun_name)
170 ) `thenRn` \ maybe_dfun_name ->
172 -- The typechecker checks that all the bindings are for the right class.
173 returnRn (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
175 -- Compare finishSourceTyClDecl
176 finishSourceInstDecl (InstDecl _ mbinds uprags _ _ )
177 (InstDecl inst_ty _ _ maybe_dfun_name src_loc)
178 -- Used for both source decls only
179 = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
181 meth_doc = text "In the bindings in an instance declaration"
182 meth_names = collectLocatedMonoBinders mbinds
183 inst_tyvars = case inst_ty of
184 HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
186 -- (Slightly strangely) the forall-d tyvars scope over
187 -- the method bindings too
190 -- Rename the bindings
191 -- NB meth_names can be qualified!
192 checkDupNames meth_doc meth_names `thenRn_`
193 extendTyVarEnvFVRn (map hsTyVarName inst_tyvars) (
194 rnMethodBinds [] mbinds
195 ) `thenRn` \ (mbinds', meth_fvs) ->
197 binders = collectMonoBinders mbinds'
198 binder_set = mkNameSet binders
200 -- Rename the prags and signatures.
201 -- Note that the type variables are not in scope here,
202 -- so that instance Eq a => Eq (T a) where
203 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
206 -- But the (unqualified) method names are in scope
207 bindLocalNames binders (
208 renameSigsFVs (okInstDclSig binder_set) uprags
209 ) `thenRn` \ (uprags', prag_fvs) ->
211 returnRn (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
212 meth_fvs `plusFV` prag_fvs)
215 %*********************************************************
219 %*********************************************************
222 rnIfaceRuleDecl (IfaceRule rule_name vars fn args rhs src_loc)
223 = pushSrcLocRn src_loc $
224 lookupOccRn fn `thenRn` \ fn' ->
225 rnCoreBndrs vars $ \ vars' ->
226 mapRn rnCoreExpr args `thenRn` \ args' ->
227 rnCoreExpr rhs `thenRn` \ rhs' ->
228 returnRn (IfaceRule rule_name vars' fn' args' rhs' src_loc)
230 rnHsRuleDecl (HsRule rule_name tvs vars lhs rhs src_loc)
232 pushSrcLocRn src_loc $
234 bindTyVarsFV2Rn doc (map UserTyVar sig_tvs) $ \ sig_tvs' _ ->
235 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
236 mapFvRn rn_var (vars `zip` ids) `thenRn` \ (vars', fv_vars) ->
238 rnExpr lhs `thenRn` \ (lhs', fv_lhs) ->
239 rnExpr rhs `thenRn` \ (rhs', fv_rhs) ->
240 checkRn (validRuleLhs ids lhs')
241 (badRuleLhsErr rule_name lhs') `thenRn_`
243 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
245 mapRn (addErrRn . badRuleVar rule_name) bad_vars `thenRn_`
246 returnRn (HsRule rule_name sig_tvs' vars' lhs' rhs' src_loc,
247 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
249 doc = text "In the transformation rule" <+> ptext rule_name
250 sig_tvs = extractRuleBndrsTyVars vars
252 get_var (RuleBndr v) = v
253 get_var (RuleBndrSig v _) = v
255 rn_var (RuleBndr v, id) = returnRn (RuleBndr id, emptyFVs)
256 rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t `thenRn` \ (t', fvs) ->
257 returnRn (RuleBndrSig id t', fvs)
261 %*********************************************************
263 \subsection{Type, class and iface sig declarations}
265 %*********************************************************
267 @rnTyDecl@ uses the `global name function' to create a new type
268 declaration in which local names have been replaced by their original
269 names, reporting any unknown names.
271 Renaming type variables is a pain. Because they now contain uniques,
272 it is necessary to pass in an association list which maps a parsed
273 tyvar to its @Name@ representation.
274 In some cases (type signatures of values),
275 it is even necessary to go over the type first
276 in order to get the set of tyvars used by it, make an assoc list,
277 and then go over it again to rename the tyvars!
278 However, we can also do some scoping checks at the same time.
281 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
283 lookupTopBndrRn name `thenRn` \ name' ->
284 rnHsType doc_str ty `thenRn` \ ty' ->
285 mapRn rnIdInfo id_infos `thenRn` \ id_infos' ->
286 returnRn (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
288 doc_str = text "In the interface signature for" <+> quotes (ppr name)
290 rnTyClDecl (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
292 lookupTopBndrRn name `thenRn` \ name' ->
293 returnRn (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
295 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
296 tcdTyVars = tyvars, tcdCons = condecls, tcdNCons = nconstrs,
297 tcdLoc = src_loc, tcdSysNames = sys_names})
298 = pushSrcLocRn src_loc $
299 lookupTopBndrRn tycon `thenRn` \ tycon' ->
300 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
301 rnContext data_doc context `thenRn` \ context' ->
302 checkDupOrQualNames data_doc con_names `thenRn_`
304 -- Check that there's at least one condecl,
305 -- or else we're reading an interface file, or -fglasgow-exts
306 (if null condecls then
307 doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
308 getModeRn `thenRn` \ mode ->
309 checkRn (glaExts || isInterfaceMode mode)
310 (emptyConDeclsErr tycon)
314 mapRn rnConDecl condecls `thenRn` \ condecls' ->
315 mapRn lookupSysBinder sys_names `thenRn` \ sys_names' ->
316 returnRn (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
317 tcdTyVars = tyvars', tcdCons = condecls', tcdNCons = nconstrs,
318 tcdDerivs = Nothing, tcdLoc = src_loc, tcdSysNames = sys_names'})
320 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
321 con_names = map conDeclName condecls
323 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
324 = pushSrcLocRn src_loc $
325 doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
326 lookupTopBndrRn name `thenRn` \ name' ->
327 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
328 rnHsType syn_doc (unquantify glaExts ty) `thenRn` \ ty' ->
329 returnRn (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
331 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
333 -- For H98 we do *not* universally quantify on the RHS of a synonym
334 -- Silently discard context... but the tyvars in the rest won't be in scope
335 -- In interface files all types are quantified, so this is a no-op
336 unquantify glaExts (HsForAllTy Nothing ctxt ty) | glaExts = ty
337 unquantify glaExts ty = ty
339 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
340 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
341 tcdSysNames = names, tcdLoc = src_loc})
342 -- Used for both source and interface file decls
343 = pushSrcLocRn src_loc $
345 lookupTopBndrRn cname `thenRn` \ cname' ->
347 -- Deal with the implicit tycon and datacon name
348 -- They aren't in scope (because they aren't visible to the user)
349 -- and what we want to do is simply look them up in the cache;
350 -- we jolly well ought to get a 'hit' there!
351 mapRn lookupSysBinder names `thenRn` \ names' ->
353 -- Tyvars scope over bindings and context
354 bindTyVars2Rn cls_doc tyvars $ \ clas_tyvar_names tyvars' ->
356 -- Check the superclasses
357 rnContext cls_doc context `thenRn` \ context' ->
359 -- Check the functional dependencies
360 rnFds cls_doc fds `thenRn` \ fds' ->
362 -- Check the signatures
363 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
365 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
366 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
368 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
369 mapRn (rnClassOp cname' clas_tyvar_names fds') op_sigs `thenRn` \ sigs' ->
371 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
373 renameSigs (okClsDclSig binders) non_op_sigs `thenRn` \ non_ops' ->
375 -- Typechecker is responsible for checking that we only
376 -- give default-method bindings for things in this class.
377 -- The renamer *could* check this for class decls, but can't
378 -- for instance decls.
380 returnRn (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
381 tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
382 tcdSysNames = names', tcdLoc = src_loc})
384 cls_doc = text "In the declaration for class" <+> ppr cname
385 sig_doc = text "In the signatures for class" <+> ppr cname
387 rnClassOp clas clas_tyvars clas_fds sig@(ClassOpSig op dm_stuff ty locn)
388 = pushSrcLocRn locn $
389 lookupTopBndrRn op `thenRn` \ op_name ->
391 -- Check the signature
392 rnHsSigType (quotes (ppr op)) ty `thenRn` \ new_ty ->
394 -- Make the default-method name
397 -> -- Imported class that has a default method decl
398 -- See comments with tname, snames, above
399 lookupSysBinder dm_rdr_name `thenRn` \ dm_name ->
400 returnRn (DefMeth dm_name)
401 -- An imported class decl for a class decl that had an explicit default
402 -- method, mentions, rather than defines,
403 -- the default method, so we must arrange to pull it in
405 GenDefMeth -> returnRn GenDefMeth
406 NoDefMeth -> returnRn NoDefMeth
407 ) `thenRn` \ dm_stuff' ->
409 returnRn (ClassOpSig op_name dm_stuff' new_ty locn)
411 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
412 -- Used for source file decls only
413 -- Renames the default-bindings of a class decl
414 -- the derivings of a data decl
415 finishSourceTyClDecl (TyData {tcdDerivs = Just derivs, tcdLoc = src_loc}) -- Derivings in here
416 rn_ty_decl -- Everything else is here
417 = pushSrcLocRn src_loc $
418 mapRn rnDeriv derivs `thenRn` \ derivs' ->
419 returnRn (rn_ty_decl {tcdDerivs = Just derivs'}, mkNameSet derivs')
421 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc}) -- Get mbinds from here
422 rn_cls_decl@(ClassDecl {tcdTyVars = tyvars}) -- Everything else is here
423 -- There are some default-method bindings (abeit possibly empty) so
424 -- this is a source-code class declaration
425 = -- The newLocals call is tiresome: given a generic class decl
428 -- op {| x+y |} (Inl a) = ...
429 -- op {| x+y |} (Inr b) = ...
430 -- op {| a*b |} (a*b) = ...
431 -- we want to name both "x" tyvars with the same unique, so that they are
432 -- easy to group together in the typechecker.
434 pushSrcLocRn src_loc $
435 extendTyVarEnvFVRn (map hsTyVarName tyvars) $
436 getLocalNameEnv `thenRn` \ name_env ->
438 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
439 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
440 not (tv `elemRdrEnv` name_env)]
442 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
443 newLocalsRn gen_rdr_tyvars_w_locs `thenRn` \ gen_tyvars ->
444 rnMethodBinds gen_tyvars mbinds `thenRn` \ (mbinds', meth_fvs) ->
445 returnRn (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
447 meth_doc = text "In the default-methods for class" <+> ppr (tcdName rn_cls_decl)
449 finishSourceTyClDecl _ tycl_decl = returnRn (tycl_decl, emptyFVs)
450 -- Not a class or data type declaration
454 %*********************************************************
456 \subsection{Support code for type/data declarations}
458 %*********************************************************
461 rnDeriv :: RdrName -> RnMS Name
463 = lookupOccRn cls `thenRn` \ clas_name ->
464 checkRn (getUnique clas_name `elem` derivableClassKeys)
465 (derivingNonStdClassErr clas_name) `thenRn_`
470 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
471 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
473 rnConDecl :: RdrNameConDecl -> RnMS RenamedConDecl
474 rnConDecl (ConDecl name wkr tvs cxt details locn)
475 = pushSrcLocRn locn $
476 checkConName name `thenRn_`
477 lookupTopBndrRn name `thenRn` \ new_name ->
479 lookupSysBinder wkr `thenRn` \ new_wkr ->
480 -- See comments with ClassDecl
482 bindTyVarsRn doc tvs $ \ new_tyvars ->
483 rnContext doc cxt `thenRn` \ new_context ->
484 rnConDetails doc locn details `thenRn` \ new_details ->
485 returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn)
487 doc = text "In the definition of data constructor" <+> quotes (ppr name)
489 rnConDetails doc locn (VanillaCon tys)
490 = mapRn (rnBangTy doc) tys `thenRn` \ new_tys ->
491 returnRn (VanillaCon new_tys)
493 rnConDetails doc locn (InfixCon ty1 ty2)
494 = rnBangTy doc ty1 `thenRn` \ new_ty1 ->
495 rnBangTy doc ty2 `thenRn` \ new_ty2 ->
496 returnRn (InfixCon new_ty1 new_ty2)
498 rnConDetails doc locn (RecCon fields)
499 = checkDupOrQualNames doc field_names `thenRn_`
500 mapRn (rnField doc) fields `thenRn` \ new_fields ->
501 returnRn (RecCon new_fields)
503 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
505 rnField doc (names, ty)
506 = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
507 rnBangTy doc ty `thenRn` \ new_ty ->
508 returnRn (new_names, new_ty)
510 rnBangTy doc (BangType s ty)
511 = rnHsType doc ty `thenRn` \ new_ty ->
512 returnRn (BangType s new_ty)
514 -- This data decl will parse OK
516 -- treating "a" as the constructor.
517 -- It is really hard to make the parser spot this malformation.
518 -- So the renamer has to check that the constructor is legal
520 -- We can get an operator as the constructor, even in the prefix form:
521 -- data T = :% Int Int
522 -- from interface files, which always print in prefix form
525 = checkRn (isRdrDataCon name)
530 %*********************************************************
532 \subsection{Support code to rename types}
534 %*********************************************************
537 rnHsTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
538 rnHsTypeFVs doc_str ty
539 = rnHsType doc_str ty `thenRn` \ ty' ->
540 returnRn (ty', extractHsTyNames ty')
542 rnHsSigTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
543 rnHsSigTypeFVs doc_str ty
544 = rnHsSigType doc_str ty `thenRn` \ ty' ->
545 returnRn (ty', extractHsTyNames ty')
547 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
548 -- rnHsSigType is used for source-language type signatures,
549 -- which use *implicit* universal quantification.
550 rnHsSigType doc_str ty
551 = rnHsType (text "In the type signature for" <+> doc_str) ty
553 ---------------------------------------
554 rnHsType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
556 rnHsType doc (HsForAllTy Nothing ctxt ty)
557 -- Implicit quantifiction in source code (no kinds on tyvars)
558 -- Given the signature C => T we universally quantify
559 -- over FV(T) \ {in-scope-tyvars}
560 = getLocalNameEnv `thenRn` \ name_env ->
562 mentioned_in_tau = extractHsTyRdrTyVars ty
563 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
564 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
565 forall_tyvars = filter (not . (`elemRdrEnv` name_env)) mentioned
567 rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
569 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
570 -- Explicit quantification.
571 -- Check that the forall'd tyvars are actually
572 -- mentioned in the type, and produce a warning if not
574 mentioned_in_tau = extractHsTyRdrTyVars tau
575 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
576 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
577 forall_tyvar_names = hsTyVarNames forall_tyvars
579 -- Explicitly quantified but not mentioned in ctxt or tau
580 warn_guys = filter (`notElem` mentioned) forall_tyvar_names
582 mapRn_ (forAllWarn doc tau) warn_guys `thenRn_`
583 rnForAll doc forall_tyvars ctxt tau
585 rnHsType doc (HsTyVar tyvar)
586 = lookupOccRn tyvar `thenRn` \ tyvar' ->
587 returnRn (HsTyVar tyvar')
589 rnHsType doc (HsOpTy ty1 opname ty2)
590 = lookupOccRn opname `thenRn` \ name' ->
591 rnHsType doc ty1 `thenRn` \ ty1' ->
592 rnHsType doc ty2 `thenRn` \ ty2' ->
593 returnRn (HsOpTy ty1' name' ty2')
595 rnHsType doc (HsNumTy i)
596 | i == 1 = returnRn (HsNumTy i)
597 | otherwise = failWithRn (HsNumTy i)
598 (ptext SLIT("Only unit numeric type pattern is valid"))
600 rnHsType doc (HsFunTy ty1 ty2)
601 = rnHsType doc ty1 `thenRn` \ ty1' ->
602 -- Might find a for-all as the arg of a function type
603 rnHsType doc ty2 `thenRn` \ ty2' ->
604 -- Or as the result. This happens when reading Prelude.hi
605 -- when we find return :: forall m. Monad m -> forall a. a -> m a
606 returnRn (HsFunTy ty1' ty2')
608 rnHsType doc (HsListTy ty)
609 = rnHsType doc ty `thenRn` \ ty' ->
610 returnRn (HsListTy ty')
612 -- Unboxed tuples are allowed to have poly-typed arguments. These
613 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
614 rnHsType doc (HsTupleTy (HsTupCon _ boxity arity) tys)
615 -- Don't do lookupOccRn, because this is built-in syntax
616 -- so it doesn't need to be in scope
617 = mapRn (rnHsType doc) tys `thenRn` \ tys' ->
618 returnRn (HsTupleTy (HsTupCon tup_name boxity arity) tys')
620 tup_name = tupleTyCon_name boxity arity
623 rnHsType doc (HsAppTy ty1 ty2)
624 = rnHsType doc ty1 `thenRn` \ ty1' ->
625 rnHsType doc ty2 `thenRn` \ ty2' ->
626 returnRn (HsAppTy ty1' ty2')
628 rnHsType doc (HsPredTy pred)
629 = rnPred doc pred `thenRn` \ pred' ->
630 returnRn (HsPredTy pred')
632 rnHsTypes doc tys = mapRn (rnHsType doc) tys
636 rnForAll doc forall_tyvars ctxt ty
637 = bindTyVarsRn doc forall_tyvars $ \ new_tyvars ->
638 rnContext doc ctxt `thenRn` \ new_ctxt ->
639 rnHsType doc ty `thenRn` \ new_ty ->
640 returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty)
644 rnContext :: SDoc -> RdrNameContext -> RnMS RenamedContext
646 = mapRn rn_pred ctxt `thenRn` \ theta ->
648 -- Check for duplicate assertions
649 -- If this isn't an error, then it ought to be:
650 ifOptRn Opt_WarnMisc (
652 (_, dups) = removeDupsEq theta
653 -- We only have equality, not ordering
655 mapRn (addWarnRn . dupClassAssertWarn theta) dups
660 --Someone discovered that @CCallable@ and @CReturnable@
661 -- could be used in contexts such as:
662 -- foo :: CCallable a => a -> PrimIO Int
663 -- Doing this utterly wrecks the whole point of introducing these
664 -- classes so we specifically check that this isn't being done.
665 rn_pred pred = rnPred doc pred `thenRn` \ pred'->
666 checkRn (not (bad_pred pred'))
667 (naughtyCCallContextErr pred') `thenRn_`
670 bad_pred (HsClassP clas _) = getUnique clas `elem` cCallishClassKeys
671 bad_pred other = False
674 rnPred doc (HsClassP clas tys)
675 = lookupOccRn clas `thenRn` \ clas_name ->
676 rnHsTypes doc tys `thenRn` \ tys' ->
677 returnRn (HsClassP clas_name tys')
679 rnPred doc (HsIParam n ty)
680 = newIPName n `thenRn` \ name ->
681 rnHsType doc ty `thenRn` \ ty' ->
682 returnRn (HsIParam name ty')
686 rnFds :: SDoc -> [FunDep RdrName] -> RnMS [FunDep Name]
692 = rnHsTyVars doc tys1 `thenRn` \ tys1' ->
693 rnHsTyVars doc tys2 `thenRn` \ tys2' ->
694 returnRn (tys1', tys2')
696 rnHsTyVars doc tvs = mapRn (rnHsTyvar doc) tvs
697 rnHsTyvar doc tyvar = lookupOccRn tyvar
700 %*********************************************************
704 %*********************************************************
707 rnIdInfo (HsWorker worker arity)
708 = lookupOccRn worker `thenRn` \ worker' ->
709 returnRn (HsWorker worker' arity)
711 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
712 returnRn (HsUnfold inline expr')
713 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str)
714 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
715 rnIdInfo HsNoCafRefs = returnRn HsNoCafRefs
718 @UfCore@ expressions.
721 rnCoreExpr (UfType ty)
722 = rnHsType (text "unfolding type") ty `thenRn` \ ty' ->
723 returnRn (UfType ty')
726 = lookupOccRn v `thenRn` \ v' ->
732 rnCoreExpr (UfLitLit l ty)
733 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
734 returnRn (UfLitLit l ty')
736 rnCoreExpr (UfFCall cc ty)
737 = rnHsType (text "ccall") ty `thenRn` \ ty' ->
738 returnRn (UfFCall cc ty')
740 rnCoreExpr (UfTuple (HsTupCon _ boxity arity) args)
741 = mapRn rnCoreExpr args `thenRn` \ args' ->
742 returnRn (UfTuple (HsTupCon tup_name boxity arity) args')
744 tup_name = getName (dataConId (tupleCon boxity arity))
745 -- Get the *worker* name and use that
747 rnCoreExpr (UfApp fun arg)
748 = rnCoreExpr fun `thenRn` \ fun' ->
749 rnCoreExpr arg `thenRn` \ arg' ->
750 returnRn (UfApp fun' arg')
752 rnCoreExpr (UfCase scrut bndr alts)
753 = rnCoreExpr scrut `thenRn` \ scrut' ->
754 bindCoreLocalRn bndr $ \ bndr' ->
755 mapRn rnCoreAlt alts `thenRn` \ alts' ->
756 returnRn (UfCase scrut' bndr' alts')
758 rnCoreExpr (UfNote note expr)
759 = rnNote note `thenRn` \ note' ->
760 rnCoreExpr expr `thenRn` \ expr' ->
761 returnRn (UfNote note' expr')
763 rnCoreExpr (UfLam bndr body)
764 = rnCoreBndr bndr $ \ bndr' ->
765 rnCoreExpr body `thenRn` \ body' ->
766 returnRn (UfLam bndr' body')
768 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
769 = rnCoreExpr rhs `thenRn` \ rhs' ->
770 rnCoreBndr bndr $ \ bndr' ->
771 rnCoreExpr body `thenRn` \ body' ->
772 returnRn (UfLet (UfNonRec bndr' rhs') body')
774 rnCoreExpr (UfLet (UfRec pairs) body)
775 = rnCoreBndrs bndrs $ \ bndrs' ->
776 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
777 rnCoreExpr body `thenRn` \ body' ->
778 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
780 (bndrs, rhss) = unzip pairs
784 rnCoreBndr (UfValBinder name ty) thing_inside
785 = rnHsType doc ty `thenRn` \ ty' ->
786 bindCoreLocalRn name $ \ name' ->
787 thing_inside (UfValBinder name' ty')
789 doc = text "unfolding id"
791 rnCoreBndr (UfTyBinder name kind) thing_inside
792 = bindCoreLocalRn name $ \ name' ->
793 thing_inside (UfTyBinder name' kind)
795 rnCoreBndrs [] thing_inside = thing_inside []
796 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
797 rnCoreBndrs bs $ \ names' ->
798 thing_inside (name':names')
802 rnCoreAlt (con, bndrs, rhs)
803 = rnUfCon con `thenRn` \ con' ->
804 bindCoreLocalsRn bndrs $ \ bndrs' ->
805 rnCoreExpr rhs `thenRn` \ rhs' ->
806 returnRn (con', bndrs', rhs')
809 = rnHsType (text "unfolding coerce") ty `thenRn` \ ty' ->
810 returnRn (UfCoerce ty')
812 rnNote (UfSCC cc) = returnRn (UfSCC cc)
813 rnNote UfInlineCall = returnRn UfInlineCall
814 rnNote UfInlineMe = returnRn UfInlineMe
820 rnUfCon (UfTupleAlt (HsTupCon _ boxity arity))
821 = returnRn (UfTupleAlt (HsTupCon tup_name boxity arity))
823 tup_name = getName (tupleCon boxity arity)
825 rnUfCon (UfDataAlt con)
826 = lookupOccRn con `thenRn` \ con' ->
827 returnRn (UfDataAlt con')
829 rnUfCon (UfLitAlt lit)
830 = returnRn (UfLitAlt lit)
832 rnUfCon (UfLitLitAlt lit ty)
833 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
834 returnRn (UfLitLitAlt lit ty')
837 %*********************************************************
839 \subsection{Rule shapes}
841 %*********************************************************
843 Check the shape of a transformation rule LHS. Currently
844 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
845 not one of the @forall@'d variables.
848 validRuleLhs foralls lhs
851 check (OpApp _ op _ _) = check op
852 check (HsApp e1 e2) = check e1
853 check (HsVar v) | v `notElem` foralls = True
858 %*********************************************************
862 %*********************************************************
865 derivingNonStdClassErr clas
866 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
869 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
871 forAllWarn doc ty tyvar
872 = ifOptRn Opt_WarnUnusedMatches $
873 getModeRn `thenRn` \ mode ->
876 InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
877 -- unless DEBUG is on, in which case it is slightly
878 -- informative. They can arise from mkRhsTyLam,
879 #endif -- leading to (say) f :: forall a b. [b] -> [b]
882 sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
883 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
889 badRuleLhsErr name lhs
890 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
891 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
893 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
896 = sep [ptext SLIT("Rule") <+> doubleQuotes (ptext name) <> colon,
897 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
898 ptext SLIT("does not appear on left hand side")]
900 dupClassAssertWarn ctxt (assertion : dups)
901 = sep [hsep [ptext SLIT("Duplicate class assertion"),
902 quotes (ppr assertion),
903 ptext SLIT("in the context:")],
904 nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
906 naughtyCCallContextErr (HsClassP clas _)
907 = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),
908 ptext SLIT("in a context")]
909 emptyConDeclsErr tycon
910 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
911 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]