2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
7 module RnSource ( rnIfaceDecl, rnSourceDecls, rnHsType, rnHsSigType ) where
9 #include "HsVersions.h"
13 import HsDecls ( HsIdInfo(..), HsStrictnessInfo(..) )
15 import HsTypes ( getTyVarName, pprClassAssertion, cmpHsTypes )
16 import RdrName ( RdrName, isRdrDataCon, rdrNameOcc )
17 import RdrHsSyn ( RdrNameContext, RdrNameHsType, RdrNameConDecl,
23 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs )
24 import RnEnv ( bindTyVarsRn, lookupBndrRn, lookupOccRn,
25 lookupImplicitOccRn, addImplicitOccRn,
27 bindTyVarsFVRn, bindTyVarsFV2Rn, extendTyVarEnvFVRn,
28 checkDupOrQualNames, checkDupNames,
29 newLocallyDefinedGlobalName, newImportedGlobalName,
30 newImportedGlobalFromRdrName,
32 FreeVars, emptyFVs, plusFV, plusFVs, unitFV, addOneFV
36 import Name ( Name, OccName,
37 ExportFlag(..), Provenance(..),
38 nameOccName, NamedThing(..),
39 mkDefaultMethodOcc, mkDFunOcc
42 import BasicTypes ( TopLevelFlag(..) )
43 import TysWiredIn ( tupleTyCon, unboxedTupleTyCon, listTyCon )
44 import Type ( funTyCon )
45 import FiniteMap ( elemFM )
46 import PrelInfo ( derivingOccurrences, numClass_RDR,
47 deRefStablePtr_NAME, makeStablePtr_NAME,
50 import Bag ( bagToList )
52 import SrcLoc ( SrcLoc )
53 import UniqFM ( lookupUFM )
54 import Maybes ( maybeToBool )
58 rnDecl `renames' declarations.
59 It simultaneously performs dependency analysis and precedence parsing.
60 It also does the following error checks:
63 Checks that tyvars are used properly. This includes checking
64 for undefined tyvars, and tyvars in contexts that are ambiguous.
66 Checks that all variable occurences are defined.
68 Checks the (..) etc constraints in the export list.
72 %*********************************************************
74 \subsection{Value declarations}
76 %*********************************************************
79 rnSourceDecls :: [RdrNameHsDecl] -> RnMS s ([RenamedHsDecl], FreeVars)
80 -- The decls get reversed, but that's ok
83 = go emptyFVs [] decls
85 -- Fixity decls 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' (d:ds) = rnDecl d `thenRn` \(d', fvs') ->
89 go (fvs `plusFV` fvs') (d':ds') ds
91 rnIfaceDecl :: RdrNameHsDecl -> RnMS s RenamedHsDecl
93 = rnDecl d `thenRn` \ (d', fvs) ->
98 %*********************************************************
100 \subsection{Value declarations}
102 %*********************************************************
105 -- rnDecl does all the work
106 rnDecl :: RdrNameHsDecl -> RnMS s (RenamedHsDecl, FreeVars)
108 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
109 returnRn (ValD new_binds, fvs)
112 rnDecl (SigD (IfaceSig name ty id_infos loc))
114 lookupBndrRn name `thenRn` \ name' ->
115 rnIfaceType doc_str ty `thenRn` \ ty' ->
117 -- Get the pragma info (if any).
118 setModeRn (InterfaceMode Optional) $
119 -- In all the rest of the signature we read in optional mode,
120 -- so that (a) we don't die
121 mapRn rnIdInfo id_infos `thenRn` \ id_infos' ->
122 returnRn (SigD (IfaceSig name' ty' id_infos' loc), emptyFVs)
123 -- Don't need free-var info for iface binds
125 doc_str = text "the interface signature for" <+> quotes (ppr name)
128 %*********************************************************
130 \subsection{Type declarations}
132 %*********************************************************
134 @rnTyDecl@ uses the `global name function' to create a new type
135 declaration in which local names have been replaced by their original
136 names, reporting any unknown names.
138 Renaming type variables is a pain. Because they now contain uniques,
139 it is necessary to pass in an association list which maps a parsed
140 tyvar to its Name representation. In some cases (type signatures of
141 values), it is even necessary to go over the type first in order to
142 get the set of tyvars used by it, make an assoc list, and then go over
143 it again to rename the tyvars! However, we can also do some scoping
144 checks at the same time.
147 rnDecl (TyClD (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc))
148 = pushSrcLocRn src_loc $
149 lookupBndrRn tycon `thenRn` \ tycon' ->
150 bindTyVarsFVRn data_doc tyvars $ \ tyvars' ->
151 rnContext data_doc context `thenRn` \ (context', cxt_fvs) ->
152 checkDupOrQualNames data_doc con_names `thenRn_`
153 mapAndUnzipRn rnConDecl condecls `thenRn` \ (condecls', con_fvs_s) ->
154 rnDerivs derivings `thenRn` \ (derivings', deriv_fvs) ->
155 ASSERT(isNoDataPragmas pragmas)
156 returnRn (TyClD (TyData new_or_data context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc),
157 cxt_fvs `plusFV` plusFVs con_fvs_s `plusFV` deriv_fvs)
159 data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
160 con_names = map conDeclName condecls
162 rnDecl (TyClD (TySynonym name tyvars ty src_loc))
163 = pushSrcLocRn src_loc $
164 lookupBndrRn name `thenRn` \ name' ->
165 bindTyVarsFVRn syn_doc tyvars $ \ tyvars' ->
166 rnHsType syn_doc ty `thenRn` \ (ty', ty_fvs) ->
167 returnRn (TyClD (TySynonym name' tyvars' ty' src_loc), ty_fvs)
169 syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
171 rnDecl (TyClD (ClassDecl context cname tyvars sigs mbinds pragmas tname dname src_loc))
172 = pushSrcLocRn src_loc $
174 lookupBndrRn cname `thenRn` \ cname' ->
176 -- Deal with the implicit tycon and datacon name
177 -- They aren't in scope (because they aren't visible to the user)
178 -- and what we want to do is simply look them up in the cache;
179 -- we jolly well ought to get a 'hit' there!
180 -- So the 'Imported' part of this call is not relevant.
181 -- Unclean; but since these two are the only place this happens
182 -- I can't work up the energy to do it more beautifully
183 newImportedGlobalFromRdrName tname `thenRn` \ tname' ->
184 newImportedGlobalFromRdrName dname `thenRn` \ dname' ->
186 -- Tyvars scope over bindings and context
187 bindTyVarsFV2Rn cls_doc tyvars ( \ clas_tyvar_names tyvars' ->
189 -- Check the superclasses
190 rnContext cls_doc context `thenRn` \ (context', cxt_fvs) ->
192 -- Check the signatures
194 -- Filter out fixity signatures;
195 -- they are done at top level
196 nofix_sigs = nonFixitySigs sigs
198 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
199 mapAndUnzipRn (rn_op cname' clas_tyvar_names) nofix_sigs `thenRn` \ (sigs', sig_fvs_s) ->
202 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
203 rnMethodBinds mbinds `thenRn` \ (mbinds', meth_fvs) ->
205 -- Typechecker is responsible for checking that we only
206 -- give default-method bindings for things in this class.
207 -- The renamer *could* check this for class decls, but can't
208 -- for instance decls.
210 ASSERT(isNoClassPragmas pragmas)
211 returnRn (TyClD (ClassDecl context' cname' tyvars' sigs' mbinds' NoClassPragmas tname' dname' src_loc),
212 plusFVs sig_fvs_s `plusFV` cxt_fvs `plusFV` meth_fvs)
215 cls_doc = text "the declaration for class" <+> ppr cname
216 sig_doc = text "the signatures for class" <+> ppr cname
217 meth_doc = text "the default-methods for class" <+> ppr cname
219 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
220 meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
221 meth_rdr_names = map fst meth_rdr_names_w_locs
223 rn_op clas clas_tyvars sig@(ClassOpSig op maybe_dm ty locn)
224 = pushSrcLocRn locn $
225 lookupBndrRn op `thenRn` \ op_name ->
227 -- Check the signature
228 rnHsSigType (quotes (ppr op)) ty `thenRn` \ (new_ty, op_ty_fvs) ->
230 check_in_op_ty clas_tyvar = checkRn (clas_tyvar `elemNameSet` op_ty_fvs)
231 (classTyVarNotInOpTyErr clas_tyvar sig)
233 mapRn check_in_op_ty clas_tyvars `thenRn_`
235 -- Make the default-method name
237 dm_occ = mkDefaultMethodOcc (rdrNameOcc op)
239 getModuleRn `thenRn` \ mod_name ->
240 getModeRn `thenRn` \ mode ->
241 (case (mode, maybe_dm) of
242 (SourceMode, _) | op `elem` meth_rdr_names
243 -> -- There's an explicit method decl
244 newLocallyDefinedGlobalName mod_name dm_occ
245 (\_ -> Exported) locn `thenRn` \ dm_name ->
246 returnRn (Just dm_name)
248 (InterfaceMode _, Just _)
249 -> -- Imported class that has a default method decl
250 newImportedGlobalName mod_name dm_occ `thenRn` \ dm_name ->
251 addOccurrenceName dm_name `thenRn_`
252 returnRn (Just dm_name)
254 other -> returnRn Nothing
255 ) `thenRn` \ maybe_dm_name ->
258 returnRn (ClassOpSig op_name maybe_dm_name new_ty locn, op_ty_fvs)
262 %*********************************************************
264 \subsection{Instance declarations}
266 %*********************************************************
269 rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc))
270 = pushSrcLocRn src_loc $
271 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ (inst_ty', inst_fvs) ->
273 inst_tyvars = case inst_ty' of
274 HsForAllTy inst_tyvars _ _ -> inst_tyvars
276 -- (Slightly strangely) the forall-d tyvars scope over
277 -- the method bindings too
279 extendTyVarEnvFVRn inst_tyvars $
281 -- Rename the bindings
282 -- NB meth_names can be qualified!
283 checkDupNames meth_doc meth_names `thenRn_`
284 rnMethodBinds mbinds `thenRn` \ (mbinds', meth_fvs) ->
286 binders = mkNameSet (map fst (bagToList (collectMonoBinders mbinds')))
288 renameSigs NotTopLevel True binders uprags `thenRn` \ (new_uprags, prag_fvs) ->
289 mkDFunName inst_ty' maybe_dfun src_loc `thenRn` \ dfun_name ->
290 addOccurrenceName dfun_name `thenRn_`
291 -- The dfun is not optional, because we use its version number
292 -- to identify the version of the instance declaration
294 -- The typechecker checks that all the bindings are for the right class.
295 returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags (Just dfun_name) src_loc),
296 inst_fvs `plusFV` meth_fvs `plusFV` prag_fvs)
298 meth_doc = text "the bindings in an instance declaration"
299 meth_names = bagToList (collectMonoBinders mbinds)
302 %*********************************************************
304 \subsection{Default declarations}
306 %*********************************************************
309 rnDecl (DefD (DefaultDecl tys src_loc))
310 = pushSrcLocRn src_loc $
311 rnHsTypes doc_str tys `thenRn` \ (tys', fvs) ->
312 lookupImplicitOccRn numClass_RDR `thenRn_`
313 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
315 doc_str = text "a `default' declaration"
318 %*********************************************************
320 \subsection{Foreign declarations}
322 %*********************************************************
325 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
326 = pushSrcLocRn src_loc $
327 lookupBndrRn name `thenRn` \ name' ->
329 FoImport _ | not isDyn -> addImplicitOccRn name'
330 FoLabel -> addImplicitOccRn name'
332 addImplicitOccRn makeStablePtr_NAME `thenRn_`
333 addImplicitOccRn deRefStablePtr_NAME `thenRn_`
334 addImplicitOccRn bindIO_NAME `thenRn_`
336 _ -> returnRn name') `thenRn_`
337 rnHsSigType fo_decl_msg ty `thenRn` \ (ty', fvs) ->
338 returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc), fvs)
340 fo_decl_msg = ptext SLIT("a foreign declaration")
341 isDyn = isDynamic ext_nm
345 %*********************************************************
347 \subsection{Support code for type/data declarations}
349 %*********************************************************
352 rnDerivs :: Maybe [RdrName] -> RnMS s (Maybe [Name], FreeVars)
354 rnDerivs Nothing -- derivs not specified
355 = returnRn (Nothing, emptyFVs)
358 = mapRn rn_deriv ds `thenRn` \ derivs ->
359 returnRn (Just derivs, foldl addOneFV emptyFVs derivs)
362 = lookupOccRn clas `thenRn` \ clas_name ->
364 -- Now add extra "occurrences" for things that
365 -- the deriving mechanism will later need in order to
366 -- generate code for this class.
367 case lookupUFM derivingOccurrences clas_name of
368 Nothing -> addErrRn (derivingNonStdClassErr clas_name) `thenRn_`
371 Just occs -> mapRn lookupImplicitOccRn occs `thenRn_`
377 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
378 conDeclName (ConDecl n _ _ _ l) = (n,l)
380 rnConDecl :: RdrNameConDecl -> RnMS s (RenamedConDecl, FreeVars)
381 rnConDecl (ConDecl name tvs cxt details locn)
382 = pushSrcLocRn locn $
383 checkConName name `thenRn_`
384 lookupBndrRn name `thenRn` \ new_name ->
385 bindTyVarsFVRn doc tvs $ \ new_tyvars ->
386 rnContext doc cxt `thenRn` \ (new_context, cxt_fvs) ->
387 rnConDetails doc locn details `thenRn` \ (new_details, det_fvs) ->
388 returnRn (ConDecl new_name new_tyvars new_context new_details locn,
389 cxt_fvs `plusFV` det_fvs)
391 doc = text "the definition of data constructor" <+> quotes (ppr name)
393 rnConDetails doc locn (VanillaCon tys)
394 = mapAndUnzipRn (rnBangTy doc) tys `thenRn` \ (new_tys, fvs_s) ->
395 returnRn (VanillaCon new_tys, plusFVs fvs_s)
397 rnConDetails doc locn (InfixCon ty1 ty2)
398 = rnBangTy doc ty1 `thenRn` \ (new_ty1, fvs1) ->
399 rnBangTy doc ty2 `thenRn` \ (new_ty2, fvs2) ->
400 returnRn (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2)
402 rnConDetails doc locn (NewCon ty mb_field)
403 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
404 rn_field mb_field `thenRn` \ new_mb_field ->
405 returnRn (NewCon new_ty new_mb_field, fvs)
407 rn_field Nothing = returnRn Nothing
409 lookupBndrRn f `thenRn` \ new_f ->
410 returnRn (Just new_f)
412 rnConDetails doc locn (RecCon fields)
413 = checkDupOrQualNames doc field_names `thenRn_`
414 mapAndUnzipRn (rnField doc) fields `thenRn` \ (new_fields, fvs_s) ->
415 returnRn (RecCon new_fields, plusFVs fvs_s)
417 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
419 rnField doc (names, ty)
420 = mapRn lookupBndrRn names `thenRn` \ new_names ->
421 rnBangTy doc ty `thenRn` \ (new_ty, fvs) ->
422 returnRn ((new_names, new_ty), fvs)
424 rnBangTy doc (Banged ty)
425 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
426 returnRn (Banged new_ty, fvs)
428 rnBangTy doc (Unbanged ty)
429 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
430 returnRn (Unbanged new_ty, fvs)
432 -- This data decl will parse OK
434 -- treating "a" as the constructor.
435 -- It is really hard to make the parser spot this malformation.
436 -- So the renamer has to check that the constructor is legal
438 -- We can get an operator as the constructor, even in the prefix form:
439 -- data T = :% Int Int
440 -- from interface files, which always print in prefix form
443 = checkRn (isRdrDataCon name)
448 %*********************************************************
450 \subsection{Naming a dfun}
452 %*********************************************************
454 Make a name for the dict fun for an instance decl
457 mkDFunName :: RenamedHsType -- Instance type
458 -> Maybe RdrName -- Dfun thing from decl; Nothing <=> source
462 mkDFunName inst_ty maybe_df src_loc
463 = newDFunName cl_occ tycon_occ maybe_df src_loc
465 (cl_occ, tycon_occ) = get_key inst_ty
467 get_key (HsForAllTy _ _ ty) = get_key ty
468 get_key (MonoFunTy _ ty) = get_key ty
469 get_key (MonoDictTy cls (ty:_)) = (nameOccName cls, get_tycon_key ty)
471 get_tycon_key (MonoTyVar tv) = nameOccName (getName tv)
472 get_tycon_key (MonoTyApp ty _) = get_tycon_key ty
473 get_tycon_key (MonoTupleTy tys True) = getOccName (tupleTyCon (length tys))
474 get_tycon_key (MonoTupleTy tys False) = getOccName (unboxedTupleTyCon (length tys))
475 get_tycon_key (MonoListTy _) = getOccName listTyCon
476 get_tycon_key (MonoFunTy _ _) = getOccName funTyCon
480 %*********************************************************
482 \subsection{Support code to rename types}
484 %*********************************************************
487 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS s (RenamedHsType, FreeVars)
488 -- rnHsSigType is used for source-language type signatures,
489 -- which use *implicit* universal quantification.
490 rnHsSigType doc_str ty
491 = rnHsType (text "the type signature for" <+> doc_str) ty
493 rnIfaceType :: SDoc -> RdrNameHsType -> RnMS s RenamedHsType
495 = rnHsType doc ty `thenRn` \ (ty,_) ->
498 rnHsType :: SDoc -> RdrNameHsType -> RnMS s (RenamedHsType, FreeVars)
500 rnHsType doc (HsForAllTy [] ctxt ty)
501 -- From source code (no kinds on tyvars)
503 -- Given the signature C => T we universally quantify
504 -- over FV(T) \ {in-scope-tyvars}
506 -- We insist that the universally quantified type vars is a superset of FV(C)
507 -- It follows that FV(T) is a superset of FV(C), so that the context constrains
508 -- no type variables that don't appear free in the tau-type part.
510 = getLocalNameEnv `thenRn` \ name_env ->
512 mentioned_tyvars = extractHsTyVars ty
513 forall_tyvars = filter (not . (`elemFM` name_env)) mentioned_tyvars
515 ctxt_w_ftvs :: [((RdrName,[RdrNameHsType]), [RdrName])]
516 ctxt_w_ftvs = [ (constraint, foldr ((++) . extractHsTyVars) [] tys)
517 | constraint@(_,tys) <- ctxt]
519 -- A 'non-poly constraint' is one that does not mention *any*
520 -- of the forall'd type variables
521 non_poly_constraints = filter non_poly ctxt_w_ftvs
522 non_poly (c,ftvs) = not (any (`elem` forall_tyvars) ftvs)
524 -- A 'non-mentioned' constraint is one that mentions a
525 -- type variable that does not appear in 'ty'
526 non_mentioned_constraints = filter non_mentioned ctxt_w_ftvs
527 non_mentioned (c,ftvs) = any (not . (`elem` mentioned_tyvars)) ftvs
529 -- Zap the context if there's a problem, to avoid duplicate error message.
530 ctxt' | null non_poly_constraints && null non_mentioned_constraints = ctxt
533 mapRn (ctxtErr1 doc forall_tyvars ty) non_poly_constraints `thenRn_`
534 mapRn (ctxtErr2 doc ty) non_mentioned_constraints `thenRn_`
536 (bindTyVarsFVRn doc (map UserTyVar forall_tyvars) $ \ new_tyvars ->
537 rnContext doc ctxt' `thenRn` \ (new_ctxt, cxt_fvs) ->
538 rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) ->
539 returnRn (mkHsForAllTy new_tyvars new_ctxt new_ty,
540 cxt_fvs `plusFV` ty_fvs)
543 rnHsType doc (HsForAllTy tvs ctxt ty)
544 -- tvs are non-empty, hence must be from an interface file
545 -- (tyvars may be kinded)
546 = bindTyVarsFVRn doc tvs $ \ new_tyvars ->
547 rnContext doc ctxt `thenRn` \ (new_ctxt, cxt_fvs) ->
548 rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) ->
549 returnRn (mkHsForAllTy new_tyvars new_ctxt new_ty,
550 cxt_fvs `plusFV` ty_fvs)
552 rnHsType doc (MonoTyVar tyvar)
553 = lookupOccRn tyvar `thenRn` \ tyvar' ->
554 returnRn (MonoTyVar tyvar', unitFV tyvar')
556 rnHsType doc (MonoFunTy ty1 ty2)
557 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
558 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
559 returnRn (MonoFunTy ty1' ty2', fvs1 `plusFV` fvs2)
561 rnHsType doc (MonoListTy ty)
562 = addImplicitOccRn listTyCon_name `thenRn_`
563 rnHsType doc ty `thenRn` \ (ty', fvs) ->
564 returnRn (MonoListTy ty', fvs `addOneFV` listTyCon_name)
566 rnHsType doc (MonoTupleTy tys boxed)
567 = addImplicitOccRn tup_con_name `thenRn_`
568 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
569 returnRn (MonoTupleTy tys' boxed, fvs `addOneFV` tup_con_name)
571 tup_con_name = tupleTyCon_name boxed (length tys)
573 rnHsType doc (MonoTyApp ty1 ty2)
574 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
575 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
576 returnRn (MonoTyApp ty1' ty2', fvs1 `plusFV` fvs2)
578 rnHsType doc (MonoDictTy clas tys)
579 = lookupOccRn clas `thenRn` \ clas' ->
580 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
581 returnRn (MonoDictTy clas' tys', fvs `addOneFV` clas')
584 = mapAndUnzipRn (rnHsType doc) tys `thenRn` \ (tys, fvs_s) ->
585 returnRn (tys, plusFVs fvs_s)
590 rnContext :: SDoc -> RdrNameContext -> RnMS s (RenamedContext, FreeVars)
593 = mapAndUnzipRn rn_ctxt ctxt `thenRn` \ (theta, fvs_s) ->
595 (_, dup_asserts) = removeDups cmp_assert theta
597 -- Check for duplicate assertions
598 -- If this isn't an error, then it ought to be:
599 mapRn (addWarnRn . dupClassAssertWarn theta) dup_asserts `thenRn_`
601 returnRn (theta, plusFVs fvs_s)
604 = lookupOccRn clas `thenRn` \ clas_name ->
605 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
606 returnRn ((clas_name, tys'), fvs `addOneFV` clas_name)
608 cmp_assert (c1,tys1) (c2,tys2)
609 = (c1 `compare` c2) `thenCmp` (cmpHsTypes compare tys1 tys2)
613 %*********************************************************
617 %*********************************************************
620 rnIdInfo (HsStrictness strict)
621 = rnStrict strict `thenRn` \ strict' ->
622 returnRn (HsStrictness strict')
624 rnIdInfo (HsUnfold inline (Just expr)) = rnCoreExpr expr `thenRn` \ expr' ->
625 returnRn (HsUnfold inline (Just expr'))
626 rnIdInfo (HsUnfold inline Nothing) = returnRn (HsUnfold inline Nothing)
627 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
628 rnIdInfo (HsUpdate update) = returnRn (HsUpdate update)
629 rnIdInfo (HsNoCafRefs) = returnRn (HsNoCafRefs)
630 rnIdInfo (HsSpecialise tyvars tys expr)
631 = bindTyVarsRn doc tyvars $ \ tyvars' ->
632 rnCoreExpr expr `thenRn` \ expr' ->
633 mapRn (rnIfaceType doc) tys `thenRn` \ tys' ->
634 returnRn (HsSpecialise tyvars' tys' expr')
636 doc = text "Specialise in interface pragma"
639 rnStrict (HsStrictnessInfo demands (Just (worker,cons)))
640 -- The sole purpose of the "cons" field is so that we can mark the constructors
641 -- needed to build the wrapper as "needed", so that their data type decl will be
642 -- slurped in. After that their usefulness is o'er, so we just put in the empty list.
643 = lookupOccRn worker `thenRn` \ worker' ->
644 mapRn lookupOccRn cons `thenRn_`
645 returnRn (HsStrictnessInfo demands (Just (worker',[])))
647 -- Boring, but necessary for the type checker.
648 rnStrict (HsStrictnessInfo demands Nothing) = returnRn (HsStrictnessInfo demands Nothing)
649 rnStrict HsBottom = returnRn HsBottom
655 rnCoreExpr (UfType ty)
656 = rnIfaceType (text "unfolding type") ty `thenRn` \ ty' ->
657 returnRn (UfType ty')
660 = lookupOccRn v `thenRn` \ v' ->
663 rnCoreExpr (UfCon con args)
664 = rnUfCon con `thenRn` \ con' ->
665 mapRn rnCoreExpr args `thenRn` \ args' ->
666 returnRn (UfCon con' args')
668 rnCoreExpr (UfTuple con args)
669 = lookupOccRn con `thenRn` \ con' ->
670 mapRn rnCoreExpr args `thenRn` \ args' ->
671 returnRn (UfTuple con' args')
673 rnCoreExpr (UfApp fun arg)
674 = rnCoreExpr fun `thenRn` \ fun' ->
675 rnCoreExpr arg `thenRn` \ arg' ->
676 returnRn (UfApp fun' arg')
678 rnCoreExpr (UfCase scrut bndr alts)
679 = rnCoreExpr scrut `thenRn` \ scrut' ->
680 bindLocalsRn "a UfCase" [bndr] $ \ [bndr'] ->
681 mapRn rnCoreAlt alts `thenRn` \ alts' ->
682 returnRn (UfCase scrut' bndr' alts')
684 rnCoreExpr (UfNote note expr)
685 = rnNote note `thenRn` \ note' ->
686 rnCoreExpr expr `thenRn` \ expr' ->
687 returnRn (UfNote note' expr')
689 rnCoreExpr (UfLam bndr body)
690 = rnCoreBndr bndr $ \ bndr' ->
691 rnCoreExpr body `thenRn` \ body' ->
692 returnRn (UfLam bndr' body')
694 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
695 = rnCoreExpr rhs `thenRn` \ rhs' ->
696 rnCoreBndr bndr $ \ bndr' ->
697 rnCoreExpr body `thenRn` \ body' ->
698 returnRn (UfLet (UfNonRec bndr' rhs') body')
700 rnCoreExpr (UfLet (UfRec pairs) body)
701 = rnCoreBndrs bndrs $ \ bndrs' ->
702 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
703 rnCoreExpr body `thenRn` \ body' ->
704 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
706 (bndrs, rhss) = unzip pairs
710 rnCoreBndr (UfValBinder name ty) thing_inside
711 = rnIfaceType (text str) ty `thenRn` \ ty' ->
712 bindLocalsRn str [name] $ \ [name'] ->
713 thing_inside (UfValBinder name' ty')
717 rnCoreBndr (UfTyBinder name kind) thing_inside
718 = bindLocalsRn "an unfolding tyvar" [name] $ \ [name'] ->
719 thing_inside (UfTyBinder name' kind)
721 rnCoreBndrs bndrs thing_inside -- Expect them all to be ValBinders
722 = mapRn (rnIfaceType (text str)) tys `thenRn` \ tys' ->
723 bindLocalsRn str names $ \ names' ->
724 thing_inside (zipWith UfValBinder names' tys')
727 names = map (\ (UfValBinder name _ ) -> name) bndrs
728 tys = map (\ (UfValBinder _ ty) -> ty) bndrs
732 rnCoreAlt (con, bndrs, rhs)
733 = rnUfCon con `thenRn` \ con' ->
734 bindLocalsRn "an unfolding alt" bndrs $ \ bndrs' ->
735 rnCoreExpr rhs `thenRn` \ rhs' ->
736 returnRn (con', bndrs', rhs')
740 = rnIfaceType (text "unfolding coerce") ty `thenRn` \ ty' ->
741 returnRn (UfCoerce ty')
743 rnNote (UfSCC cc) = returnRn (UfSCC cc)
744 rnNote UfInlineCall = returnRn UfInlineCall
750 rnUfCon (UfDataCon con)
751 = lookupOccRn con `thenRn` \ con' ->
752 returnRn (UfDataCon con')
754 rnUfCon (UfLitCon lit)
755 = returnRn (UfLitCon lit)
757 rnUfCon (UfLitLitCon lit ty)
758 = rnIfaceType (text "litlit") ty `thenRn` \ ty' ->
759 returnRn (UfLitLitCon lit ty')
761 rnUfCon (UfPrimOp op)
762 = lookupOccRn op `thenRn` \ op' ->
763 returnRn (UfPrimOp op')
765 rnUfCon (UfCCallOp str is_dyn casm gc)
766 = returnRn (UfCCallOp str is_dyn casm gc)
769 %*********************************************************
773 %*********************************************************
776 derivingNonStdClassErr clas
777 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
779 classTyVarNotInOpTyErr clas_tyvar sig
780 = hang (hsep [ptext SLIT("Class type variable"),
781 quotes (ppr clas_tyvar),
782 ptext SLIT("does not appear in method signature")])
785 dupClassAssertWarn ctxt (assertion : dups)
786 = sep [hsep [ptext SLIT("Duplicate class assertion"),
787 quotes (pprClassAssertion assertion),
788 ptext SLIT("in the context:")],
789 nest 4 (pprContext ctxt <+> ptext SLIT("..."))]
792 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
794 ctxtErr1 doc tyvars ty (constraint, _)
796 sep [ptext SLIT("The constraint") <+> quotes (pprClassAssertion constraint) <+>
797 ptext SLIT("does not mention any of"),
798 nest 4 (ptext SLIT("the universally quantified type variables") <+> braces (interpp'SP tyvars)),
799 nest 4 (ptext SLIT("of the type") <+> quotes (ppr ty))
802 (ptext SLIT("In") <+> doc)
805 ctxtErr2 doc ty (constraint,_)
807 sep [ptext SLIT("The constraint") <+> quotes (pprClassAssertion constraint),
808 nest 4 (ptext SLIT("mentions type variables that do not appear in the type")),
809 nest 4 (quotes (ppr ty))]
811 (ptext SLIT("In") <+> doc)