2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[RnSource]{Main pass of renamer}
7 #include "HsVersions.h"
9 module RnSource ( rnDecl, rnHsType, rnHsSigType ) where
11 IMPORT_1_3(List(partition))
14 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
15 IMPORT_DELOOPER(RnLoop) -- *check* the RnPass/RnExpr/RnBinds loop-breaking
17 import {-# SOURCE #-} RnExpr
21 import HsDecls ( HsIdInfo(..) )
23 import HsTypes ( getTyVarName )
27 import CmdLineOpts ( opt_IgnoreIfacePragmas )
29 import RnBinds ( rnTopBinds, rnMethodBinds )
30 import RnEnv ( bindTyVarsRn, lookupBndrRn, lookupOccRn, lookupImplicitOccRn, bindLocalsRn,
31 newSysName, newDfunName, checkDupOrQualNames, checkDupNames,
32 listType_RDR, tupleType_RDR )
35 import Name ( Name, isLocallyDefined,
36 OccName(..), occNameString, prefixOccName,
39 SYN_IE(NameSet), unionNameSets, emptyNameSet, mkNameSet, unitNameSet,
42 import ErrUtils ( addErrLoc, addShortErrLocLine, addShortWarnLocLine )
43 import FiniteMap ( emptyFM, lookupFM, addListToFM_C )
44 import Id ( GenId{-instance NamedThing-} )
45 import IdInfo ( IdInfo, StrictnessInfo(..), FBTypeInfo, DemandInfo, ArgUsageInfo )
46 import SpecEnv ( SpecEnv )
47 import Lex ( isLexCon )
48 import CoreUnfold ( Unfolding(..), SimpleUnfolding )
49 import MagicUFs ( MagicUnfoldingFun )
50 import PrelInfo ( derivingOccurrences, evalClass_RDR, numClass_RDR, allClass_NAME )
51 import ListSetOps ( unionLists, minusList )
52 import Maybes ( maybeToBool, catMaybes )
53 import Bag ( emptyBag, unitBag, consBag, unionManyBags, unionBags, listToBag, bagToList )
54 import Outputable ( PprStyle(..), Outputable(..){-instances-} )
56 import SrcLoc ( SrcLoc )
57 import Unique ( Unique )
58 import UniqSet ( SYN_IE(UniqSet) )
59 import UniqFM ( UniqFM, lookupUFM )
60 import Util {- ( isIn, isn'tIn, thenCmp, removeDups, cmpPString,
61 panic, assertPanic{- , pprTrace ToDo:rm-} ) -}
64 rnDecl `renames' declarations.
65 It simultaneously performs dependency analysis and precedence parsing.
66 It also does the following error checks:
69 Checks that tyvars are used properly. This includes checking
70 for undefined tyvars, and tyvars in contexts that are ambiguous.
72 Checks that all variable occurences are defined.
74 Checks the (..) etc constraints in the export list.
78 %*********************************************************
80 \subsection{Value declarations}
82 %*********************************************************
85 rnDecl :: RdrNameHsDecl -> RnMS s RenamedHsDecl
87 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ new_binds ->
88 returnRn (ValD new_binds)
91 rnDecl (SigD (IfaceSig name ty id_infos loc))
93 lookupBndrRn name `thenRn` \ name' ->
94 rnHsType ty `thenRn` \ ty' ->
95 -- Get the pragma info (if any).
96 setModeRn (InterfaceMode Optional) $
97 -- In all the rest of the signature we read in optional mode,
98 -- so that (a) we don't die
99 mapRn rnIdInfo id_infos `thenRn` \ id_infos' ->
100 returnRn (SigD (IfaceSig name' ty' id_infos' loc))
103 %*********************************************************
105 \subsection{Type declarations}
107 %*********************************************************
109 @rnTyDecl@ uses the `global name function' to create a new type
110 declaration in which local names have been replaced by their original
111 names, reporting any unknown names.
113 Renaming type variables is a pain. Because they now contain uniques,
114 it is necessary to pass in an association list which maps a parsed
115 tyvar to its Name representation. In some cases (type signatures of
116 values), it is even necessary to go over the type first in order to
117 get the set of tyvars used by it, make an assoc list, and then go over
118 it again to rename the tyvars! However, we can also do some scoping
119 checks at the same time.
122 rnDecl (TyD (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc))
123 = pushSrcLocRn src_loc $
124 lookupBndrRn tycon `thenRn` \ tycon' ->
125 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
126 rnContext context `thenRn` \ context' ->
127 checkDupOrQualNames data_doc con_names `thenRn_`
128 mapRn rnConDecl condecls `thenRn` \ condecls' ->
129 rnDerivs derivings `thenRn` \ derivings' ->
130 ASSERT(isNoDataPragmas pragmas)
131 returnRn (TyD (TyData new_or_data context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc))
133 data_doc sty = text "the data type declaration for" <+> ppr sty tycon
134 con_names = map conDeclName condecls
136 rnDecl (TyD (TySynonym name tyvars ty src_loc))
137 = pushSrcLocRn src_loc $
138 lookupBndrRn name `thenRn` \ name' ->
139 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
140 rnHsType ty `thenRn` \ ty' ->
141 returnRn (TyD (TySynonym name' tyvars' ty' src_loc))
143 syn_doc sty = text "the declaration for type synonym" <+> ppr sty name
146 %*********************************************************
148 \subsection{Class declarations}
150 %*********************************************************
152 @rnClassDecl@ uses the `global name function' to create a new
153 class declaration in which local names have been replaced by their
154 original names, reporting any unknown names.
157 rnDecl (ClD (ClassDecl context cname tyvar sigs mbinds pragmas src_loc))
158 = pushSrcLocRn src_loc $
159 bindTyVarsRn cls_doc [tyvar] ( \ [tyvar'] ->
160 rnContext context `thenRn` \ context' ->
161 lookupBndrRn cname `thenRn` \ cname' ->
163 -- Check the signatures
164 checkDupOrQualNames sig_doc sig_names `thenRn_`
165 mapRn (rn_op cname' (getTyVarName tyvar')) sigs `thenRn` \ sigs' ->
166 returnRn (tyvar', context', cname', sigs')
167 ) `thenRn` \ (tyvar', context', cname', sigs') ->
170 checkDupOrQualNames meth_doc meth_names `thenRn_`
171 rnMethodBinds mbinds `thenRn` \ mbinds' ->
173 -- Typechecker is responsible for checking that we only
174 -- give default-method bindings for things in this class.
175 -- The renamer *could* check this for class decls, but can't
176 -- for instance decls.
178 ASSERT(isNoClassPragmas pragmas)
179 returnRn (ClD (ClassDecl context' cname' tyvar' sigs' mbinds' NoClassPragmas src_loc))
181 cls_doc sty = text "the declaration for class" <+> ppr sty cname
182 sig_doc sty = text "the signatures for class" <+> ppr sty cname
183 meth_doc sty = text "the default-methods for class" <+> ppr sty cname
185 sig_names = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
186 meth_names = bagToList (collectMonoBinders mbinds)
188 rn_op clas clas_tyvar sig@(ClassOpSig op _ ty locn)
189 = pushSrcLocRn locn $
190 lookupBndrRn op `thenRn` \ op_name ->
191 rnHsSigType (\sty -> ppr sty op) ty `thenRn` \ new_ty ->
193 -- Call up interface info for default method, if such info exists
195 dm_occ = prefixOccName SLIT("$m") (rdrNameOcc op)
197 newSysName dm_occ Exported locn `thenRn` \ dm_name ->
198 setModeRn (InterfaceMode Optional) (
199 addOccurrenceName dm_name
204 (ctxt, op_ty) = case new_ty of
205 HsForAllTy tvs ctxt op_ty -> (ctxt, op_ty)
206 other -> ([], new_ty)
207 ctxt_fvs = extractCtxtTyNames ctxt
208 op_ty_fvs = extractHsTyNames op_ty -- Includes tycons/classes but we
209 -- don't care about that
211 -- Check that class tyvar appears in op_ty
212 checkRn (clas_tyvar `elemNameSet` op_ty_fvs)
213 (classTyVarNotInOpTyErr clas_tyvar sig)
216 -- Check that class tyvar *doesn't* appear in the sig's context
217 checkRn (not (clas_tyvar `elemNameSet` ctxt_fvs))
218 (classTyVarInOpCtxtErr clas_tyvar sig)
221 returnRn (ClassOpSig op_name dm_name new_ty locn)
225 %*********************************************************
227 \subsection{Instance declarations}
229 %*********************************************************
232 rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc))
233 = pushSrcLocRn src_loc $
234 rnHsSigType (\sty -> text "an instance decl") inst_ty `thenRn` \ inst_ty' ->
237 -- Rename the bindings
238 -- NB meth_names can be qualified!
239 checkDupNames meth_doc meth_names `thenRn_`
240 rnMethodBinds mbinds `thenRn` \ mbinds' ->
241 mapRn rn_uprag uprags `thenRn` \ new_uprags ->
243 newDfunName maybe_dfun src_loc `thenRn` \ dfun_name ->
244 addOccurrenceName dfun_name `thenRn_`
245 -- The dfun is not optional, because we use its version number
246 -- to identify the version of the instance declaration
248 -- The typechecker checks that all the bindings are for the right class.
249 returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags (Just dfun_name) src_loc))
251 meth_doc sty = text "the bindings in an instance declaration"
252 meth_names = bagToList (collectMonoBinders mbinds)
254 rn_uprag (SpecSig op ty using locn)
255 = pushSrcLocRn src_loc $
256 lookupBndrRn op `thenRn` \ op_name ->
257 rnHsSigType (\sty -> ppr sty op) ty `thenRn` \ new_ty ->
258 rn_using using `thenRn` \ new_using ->
259 returnRn (SpecSig op_name new_ty new_using locn)
261 rn_uprag (InlineSig op locn)
262 = pushSrcLocRn locn $
263 lookupBndrRn op `thenRn` \ op_name ->
264 returnRn (InlineSig op_name locn)
266 rn_uprag (DeforestSig op locn)
267 = pushSrcLocRn locn $
268 lookupBndrRn op `thenRn` \ op_name ->
269 returnRn (DeforestSig op_name locn)
271 rn_uprag (MagicUnfoldingSig op str locn)
272 = pushSrcLocRn locn $
273 lookupBndrRn op `thenRn` \ op_name ->
274 returnRn (MagicUnfoldingSig op_name str locn)
276 rn_using Nothing = returnRn Nothing
277 rn_using (Just v) = lookupOccRn v `thenRn` \ new_v ->
278 returnRn (Just new_v)
281 %*********************************************************
283 \subsection{Default declarations}
285 %*********************************************************
288 rnDecl (DefD (DefaultDecl tys src_loc))
289 = pushSrcLocRn src_loc $
290 mapRn rnHsType tys `thenRn` \ tys' ->
291 lookupImplicitOccRn numClass_RDR `thenRn_`
292 returnRn (DefD (DefaultDecl tys' src_loc))
295 %*********************************************************
297 \subsection{Support code for type/data declarations}
299 %*********************************************************
302 rnDerivs :: Maybe [RdrName] -> RnMS s (Maybe [Name])
304 rnDerivs Nothing -- derivs not specified
305 = lookupImplicitOccRn evalClass_RDR `thenRn_`
309 = lookupImplicitOccRn evalClass_RDR `thenRn_`
310 mapRn rn_deriv ds `thenRn` \ derivs ->
311 returnRn (Just derivs)
314 = lookupOccRn clas `thenRn` \ clas_name ->
316 -- Now add extra "occurrences" for things that
317 -- the deriving mechanism will later need in order to
318 -- generate code for this class.
319 case lookupUFM derivingOccurrences clas_name of
320 Nothing -> addErrRn (derivingNonStdClassErr clas_name) `thenRn_`
323 Just occs -> mapRn lookupImplicitOccRn occs `thenRn_`
328 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
329 conDeclName (ConDecl n _ _ l) = (n,l)
331 rnConDecl :: RdrNameConDecl -> RnMS s RenamedConDecl
332 rnConDecl (ConDecl name cxt details locn)
333 = pushSrcLocRn locn $
334 checkConName name `thenRn_`
335 lookupBndrRn name `thenRn` \ new_name ->
336 rnConDetails name locn details `thenRn` \ new_details ->
337 rnContext cxt `thenRn` \ new_context ->
338 returnRn (ConDecl new_name new_context new_details locn)
340 rnConDetails con locn (VanillaCon tys)
341 = mapRn rnBangTy tys `thenRn` \ new_tys ->
342 returnRn (VanillaCon new_tys)
344 rnConDetails con locn (InfixCon ty1 ty2)
345 = rnBangTy ty1 `thenRn` \ new_ty1 ->
346 rnBangTy ty2 `thenRn` \ new_ty2 ->
347 returnRn (InfixCon new_ty1 new_ty2)
349 rnConDetails con locn (NewCon ty)
350 = rnHsType ty `thenRn` \ new_ty ->
351 returnRn (NewCon new_ty)
353 rnConDetails con locn (RecCon fields)
354 = checkDupOrQualNames fld_doc field_names `thenRn_`
355 mapRn rnField fields `thenRn` \ new_fields ->
356 returnRn (RecCon new_fields)
358 fld_doc sty = text "the fields of constructor" <> ppr sty con
359 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
362 = mapRn lookupBndrRn names `thenRn` \ new_names ->
363 rnBangTy ty `thenRn` \ new_ty ->
364 returnRn (new_names, new_ty)
367 = rnHsType ty `thenRn` \ new_ty ->
368 returnRn (Banged new_ty)
370 rnBangTy (Unbanged ty)
371 = rnHsType ty `thenRn` \ new_ty ->
372 returnRn (Unbanged new_ty)
374 -- This data decl will parse OK
376 -- treating "a" as the constructor.
377 -- It is really hard to make the parser spot this malformation.
378 -- So the renamer has to check that the constructor is legal
380 -- We can get an operator as the constructor, even in the prefix form:
381 -- data T = :% Int Int
382 -- from interface files, which always print in prefix form
385 = checkRn (isLexCon (occNameString (rdrNameOcc name)))
390 %*********************************************************
392 \subsection{Support code to rename types}
394 %*********************************************************
397 rnHsSigType :: (PprStyle -> Doc) -> RdrNameHsType -> RnMS s RenamedHsType
398 -- rnHsSigType is used for source-language type signatures,
399 -- which use *implicit* universal quantification.
401 rnHsSigType doc_str full_ty@(HsPreForAllTy ctxt ty) -- From source code (no kinds on tyvars)
402 = getNameEnv `thenRn` \ name_env ->
404 mentioned_tyvars = extractHsTyVars full_ty
405 forall_tyvars = filter not_in_scope mentioned_tyvars
406 not_in_scope tv = case lookupFM name_env tv of
410 non_foralld_constrained = [tv | (clas, ty) <- ctxt,
411 tv <- extractHsTyVars ty,
412 not (tv `elem` forall_tyvars)
415 checkRn (null non_foralld_constrained)
416 (ctxtErr sig_doc non_foralld_constrained) `thenRn_`
418 (bindTyVarsRn sig_doc (map UserTyVar forall_tyvars) $ \ new_tyvars ->
419 rnContext ctxt `thenRn` \ new_ctxt ->
420 rnHsType ty `thenRn` \ new_ty ->
421 returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
424 sig_doc sty = text "the type signature for" <+> doc_str sty
427 rnHsSigType doc_str other_ty = rnHsType other_ty
429 rnHsType :: RdrNameHsType -> RnMS s RenamedHsType
430 rnHsType (HsForAllTy tvs ctxt ty) -- From an interface file (tyvars may be kinded)
431 = rn_poly_help tvs ctxt ty
433 rnHsType full_ty@(HsPreForAllTy ctxt ty) -- A (context => ty) embedded in a type.
434 -- Universally quantify over tyvars in context
435 = getNameEnv `thenRn` \ name_env ->
437 forall_tyvars = foldr unionLists [] (map (extractHsTyVars . snd) ctxt)
439 rn_poly_help (map UserTyVar forall_tyvars) ctxt ty
441 rnHsType (MonoTyVar tyvar)
442 = lookupOccRn tyvar `thenRn` \ tyvar' ->
443 returnRn (MonoTyVar tyvar')
445 rnHsType (MonoFunTy ty1 ty2)
446 = andRn MonoFunTy (rnHsType ty1) (rnHsType ty2)
448 rnHsType (MonoListTy _ ty)
449 = lookupImplicitOccRn listType_RDR `thenRn` \ tycon_name ->
450 rnHsType ty `thenRn` \ ty' ->
451 returnRn (MonoListTy tycon_name ty')
453 rnHsType (MonoTupleTy _ tys)
454 = lookupImplicitOccRn (tupleType_RDR (length tys)) `thenRn` \ tycon_name ->
455 mapRn rnHsType tys `thenRn` \ tys' ->
456 returnRn (MonoTupleTy tycon_name tys')
458 rnHsType (MonoTyApp ty1 ty2)
459 = rnHsType ty1 `thenRn` \ ty1' ->
460 rnHsType ty2 `thenRn` \ ty2' ->
461 returnRn (MonoTyApp ty1' ty2')
463 rnHsType (MonoDictTy clas ty)
464 = lookupOccRn clas `thenRn` \ clas' ->
465 rnHsType ty `thenRn` \ ty' ->
466 returnRn (MonoDictTy clas' ty')
468 rn_poly_help :: [HsTyVar RdrName] -- Universally quantified tyvars
471 -> RnMS s RenamedHsType
472 rn_poly_help tyvars ctxt ty
473 = bindTyVarsRn sig_doc tyvars $ \ new_tyvars ->
474 rnContext ctxt `thenRn` \ new_ctxt ->
475 rnHsType ty `thenRn` \ new_ty ->
476 returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
478 sig_doc sty = text "a nested for-all type"
483 rnContext :: RdrNameContext -> RnMS s RenamedContext
486 = mapRn rn_ctxt ctxt `thenRn` \ result ->
488 (_, dup_asserts) = removeDups cmp_assert result
489 (alls, theta) = partition (\(c,_) -> c == allClass_NAME) result
490 non_tyvar_alls = [(c,t) | (c,t) <- alls, not (is_tyvar t)]
493 -- Check for duplicate assertions
494 -- If this isn't an error, then it ought to be:
495 mapRn (addWarnRn . dupClassAssertWarn theta) dup_asserts `thenRn_`
497 -- Check for All constraining a non-type-variable
498 mapRn (addWarnRn . allOfNonTyVar) non_tyvar_alls `thenRn_`
500 -- Done. Return a theta omitting all the "All" constraints.
501 -- They have done done their work by ensuring that we universally
502 -- quantify over their tyvar.
506 = -- Mini hack here. If the class is our pseudo-class "All",
507 -- then we don't want to record it as an occurrence, otherwise
508 -- we try to slurp it in later and it doesn't really exist at all.
509 -- Easiest thing is simply not to put it in the occurrence set.
510 lookupBndrRn clas `thenRn` \ clas_name ->
511 (if clas_name /= allClass_NAME then
512 addOccurrenceName clas_name
516 rnHsType ty `thenRn` \ ty' ->
517 returnRn (clas_name, ty')
519 cmp_assert (c1,ty1) (c2,ty2)
520 = (c1 `cmp` c2) `thenCmp` (cmpHsType cmp ty1 ty2)
522 is_tyvar (MonoTyVar _) = True
523 is_tyvar other = False
527 %*********************************************************
531 %*********************************************************
534 rnIdInfo (HsStrictness strict)
535 = rnStrict strict `thenRn` \ strict' ->
536 returnRn (HsStrictness strict')
538 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
539 returnRn (HsUnfold inline expr')
540 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
541 rnIdInfo (HsUpdate update) = returnRn (HsUpdate update)
542 rnIdInfo (HsFBType fb) = returnRn (HsFBType fb)
543 rnIdInfo (HsArgUsage au) = returnRn (HsArgUsage au)
544 rnIdInfo (HsDeforest df) = returnRn (HsDeforest df)
546 rnStrict (StrictnessInfo demands (Just (worker,cons)))
547 -- The sole purpose of the "cons" field is so that we can mark the constructors
548 -- needed to build the wrapper as "needed", so that their data type decl will be
549 -- slurped in. After that their usefulness is o'er, so we just put in the empty list.
550 = lookupOccRn worker `thenRn` \ worker' ->
551 mapRn lookupOccRn cons `thenRn_`
552 returnRn (StrictnessInfo demands (Just (worker',[])))
554 -- Boring, but necessary for the type checker.
555 rnStrict (StrictnessInfo demands Nothing) = returnRn (StrictnessInfo demands Nothing)
556 rnStrict BottomGuaranteed = returnRn BottomGuaranteed
557 rnStrict NoStrictnessInfo = returnRn NoStrictnessInfo
564 = lookupOccRn v `thenRn` \ v' ->
567 rnCoreExpr (UfLit lit) = returnRn (UfLit lit)
569 rnCoreExpr (UfCon con args)
570 = lookupOccRn con `thenRn` \ con' ->
571 mapRn rnCoreArg args `thenRn` \ args' ->
572 returnRn (UfCon con' args')
574 rnCoreExpr (UfPrim prim args)
575 = rnCorePrim prim `thenRn` \ prim' ->
576 mapRn rnCoreArg args `thenRn` \ args' ->
577 returnRn (UfPrim prim' args')
579 rnCoreExpr (UfApp fun arg)
580 = rnCoreExpr fun `thenRn` \ fun' ->
581 rnCoreArg arg `thenRn` \ arg' ->
582 returnRn (UfApp fun' arg')
584 rnCoreExpr (UfCase scrut alts)
585 = rnCoreExpr scrut `thenRn` \ scrut' ->
586 rnCoreAlts alts `thenRn` \ alts' ->
587 returnRn (UfCase scrut' alts')
589 rnCoreExpr (UfSCC cc expr)
590 = rnCoreExpr expr `thenRn` \ expr' ->
591 returnRn (UfSCC cc expr')
593 rnCoreExpr(UfCoerce coercion ty body)
594 = rnCoercion coercion `thenRn` \ coercion' ->
595 rnHsType ty `thenRn` \ ty' ->
596 rnCoreExpr body `thenRn` \ body' ->
597 returnRn (UfCoerce coercion' ty' body')
599 rnCoreExpr (UfLam bndr body)
600 = rnCoreBndr bndr $ \ bndr' ->
601 rnCoreExpr body `thenRn` \ body' ->
602 returnRn (UfLam bndr' body')
604 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
605 = rnCoreExpr rhs `thenRn` \ rhs' ->
606 rnCoreBndr bndr $ \ bndr' ->
607 rnCoreExpr body `thenRn` \ body' ->
608 returnRn (UfLet (UfNonRec bndr' rhs') body')
610 rnCoreExpr (UfLet (UfRec pairs) body)
611 = rnCoreBndrs bndrs $ \ bndrs' ->
612 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
613 rnCoreExpr body `thenRn` \ body' ->
614 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
616 (bndrs, rhss) = unzip pairs
620 rnCoreBndr (UfValBinder name ty) thing_inside
621 = rnHsType ty `thenRn` \ ty' ->
622 bindLocalsRn "unfolding value" [name] $ \ [name'] ->
623 thing_inside (UfValBinder name' ty')
625 rnCoreBndr (UfTyBinder name kind) thing_inside
626 = bindLocalsRn "unfolding tyvar" [name] $ \ [name'] ->
627 thing_inside (UfTyBinder name' kind)
629 rnCoreBndr (UfUsageBinder name) thing_inside
630 = bindLocalsRn "unfolding usage" [name] $ \ [name'] ->
631 thing_inside (UfUsageBinder name')
633 rnCoreBndrs bndrs thing_inside -- Expect them all to be ValBinders
634 = mapRn rnHsType tys `thenRn` \ tys' ->
635 bindLocalsRn "unfolding value" names $ \ names' ->
636 thing_inside (zipWith UfValBinder names' tys')
638 names = map (\ (UfValBinder name _) -> name) bndrs
639 tys = map (\ (UfValBinder _ ty) -> ty) bndrs
641 rnCoreBndrNamess names thing_inside
642 = bindLocalsRn "unfolding value" names $ \ names' ->
647 rnCoreArg (UfVarArg v) = lookupOccRn v `thenRn` \ v' -> returnRn (UfVarArg v')
648 rnCoreArg (UfUsageArg u) = lookupOccRn u `thenRn` \ u' -> returnRn (UfUsageArg u')
649 rnCoreArg (UfTyArg ty) = rnHsType ty `thenRn` \ ty' -> returnRn (UfTyArg ty')
650 rnCoreArg (UfLitArg lit) = returnRn (UfLitArg lit)
652 rnCoreAlts (UfAlgAlts alts deflt)
653 = mapRn rn_alt alts `thenRn` \ alts' ->
654 rnCoreDefault deflt `thenRn` \ deflt' ->
655 returnRn (UfAlgAlts alts' deflt')
657 rn_alt (con, bndrs, rhs) = lookupOccRn con `thenRn` \ con' ->
658 bindLocalsRn "unfolding alt" bndrs $ \ bndrs' ->
659 rnCoreExpr rhs `thenRn` \ rhs' ->
660 returnRn (con', bndrs', rhs')
662 rnCoreAlts (UfPrimAlts alts deflt)
663 = mapRn rn_alt alts `thenRn` \ alts' ->
664 rnCoreDefault deflt `thenRn` \ deflt' ->
665 returnRn (UfPrimAlts alts' deflt')
667 rn_alt (lit, rhs) = rnCoreExpr rhs `thenRn` \ rhs' ->
670 rnCoreDefault UfNoDefault = returnRn UfNoDefault
671 rnCoreDefault (UfBindDefault bndr rhs) = bindLocalsRn "unfolding default" [bndr] $ \ [bndr'] ->
672 rnCoreExpr rhs `thenRn` \ rhs' ->
673 returnRn (UfBindDefault bndr' rhs')
675 rnCoercion (UfIn n) = lookupOccRn n `thenRn` \ n' -> returnRn (UfIn n')
676 rnCoercion (UfOut n) = lookupOccRn n `thenRn` \ n' -> returnRn (UfOut n')
678 rnCorePrim (UfOtherOp op)
679 = lookupOccRn op `thenRn` \ op' ->
680 returnRn (UfOtherOp op')
682 rnCorePrim (UfCCallOp str casm gc arg_tys res_ty)
683 = mapRn rnHsType arg_tys `thenRn` \ arg_tys' ->
684 rnHsType res_ty `thenRn` \ res_ty' ->
685 returnRn (UfCCallOp str casm gc arg_tys' res_ty')
688 %*********************************************************
692 %*********************************************************
695 derivingNonStdClassErr clas sty
696 = hsep [ptext SLIT("non-standard class in deriving:"), ppr sty clas]
698 classTyVarNotInOpTyErr clas_tyvar sig sty
699 = hang (hcat [ptext SLIT("Class type variable `"),
701 ptext SLIT("' does not appear in method signature:")])
704 classTyVarInOpCtxtErr clas_tyvar sig sty
705 = hang (hcat [ ptext SLIT("Class type variable `"), ppr sty clas_tyvar,
706 ptext SLIT("' present in method's local overloading context:")])
709 dupClassAssertWarn ctxt dups sty
710 = hang (hcat [ptext SLIT("Duplicate class assertion `"),
712 ptext SLIT("' in context:")])
716 = hsep [ptext SLIT("Illegal data constructor name:"), ppr sty name]
719 = hsep [ptext SLIT("`All' applied to a non-type variable:"), ppr sty ty]
721 ctxtErr doc tyvars sty
722 = hsep [ptext SLIT("Context constrains type variable(s)"),
723 hsep (punctuate comma (map (ppr sty) tyvars))]
724 $$ nest 4 (ptext SLIT("in") <+> doc sty)