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
18 --import {-# SOURCE #-} RnExpr
22 import HsDecls ( HsIdInfo(..), HsStrictnessInfo(..) )
24 import HsTypes ( getTyVarName )
28 import CmdLineOpts ( opt_IgnoreIfacePragmas )
30 import RnBinds ( rnTopBinds, rnMethodBinds )
31 import RnEnv ( bindTyVarsRn, lookupBndrRn, lookupOccRn, lookupImplicitOccRn, bindLocalsRn,
32 newDfunName, checkDupOrQualNames, checkDupNames,
33 newLocallyDefinedGlobalName, newGlobalName, ifaceFlavour,
34 listType_RDR, tupleType_RDR )
37 import Name ( Name, isLocallyDefined,
38 OccName(..), occNameString, prefixOccName,
40 Provenance(..), getNameProvenance,
41 SYN_IE(NameSet), unionNameSets, emptyNameSet, mkNameSet, unitNameSet,
44 import ErrUtils ( addErrLoc, addShortErrLocLine, addShortWarnLocLine )
45 import FiniteMap ( emptyFM, lookupFM, addListToFM_C )
46 import Id ( GenId{-instance NamedThing-} )
47 import IdInfo ( IdInfo, StrictnessInfo(..), FBTypeInfo, DemandInfo, ArgUsageInfo )
48 import SpecEnv ( SpecEnv )
49 import Lex ( isLexCon )
50 import CoreUnfold ( Unfolding(..), SimpleUnfolding )
51 import MagicUFs ( MagicUnfoldingFun )
52 import PrelInfo ( derivingOccurrences, evalClass_RDR, numClass_RDR, allClass_NAME )
53 import ListSetOps ( unionLists, minusList )
54 import Maybes ( maybeToBool, catMaybes )
55 import Bag ( emptyBag, unitBag, consBag, unionManyBags, unionBags, listToBag, bagToList )
56 import Outputable ( PprStyle(..), Outputable(..){-instances-}, pprQuote )
58 import SrcLoc ( SrcLoc )
59 import Unique ( Unique )
60 import UniqSet ( SYN_IE(UniqSet) )
61 import UniqFM ( UniqFM, lookupUFM )
66 rnDecl `renames' declarations.
67 It simultaneously performs dependency analysis and precedence parsing.
68 It also does the following error checks:
71 Checks that tyvars are used properly. This includes checking
72 for undefined tyvars, and tyvars in contexts that are ambiguous.
74 Checks that all variable occurences are defined.
76 Checks the (..) etc constraints in the export list.
80 %*********************************************************
82 \subsection{Value declarations}
84 %*********************************************************
87 rnDecl :: RdrNameHsDecl -> RnMS s RenamedHsDecl
89 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ new_binds ->
90 returnRn (ValD new_binds)
93 rnDecl (SigD (IfaceSig name ty id_infos loc))
95 lookupBndrRn name `thenRn` \ name' ->
96 rnHsType ty `thenRn` \ ty' ->
97 -- Get the pragma info (if any).
98 setModeRn (InterfaceMode Optional) $
99 -- In all the rest of the signature we read in optional mode,
100 -- so that (a) we don't die
101 mapRn rnIdInfo id_infos `thenRn` \ id_infos' ->
102 returnRn (SigD (IfaceSig name' ty' id_infos' loc))
105 %*********************************************************
107 \subsection{Type declarations}
109 %*********************************************************
111 @rnTyDecl@ uses the `global name function' to create a new type
112 declaration in which local names have been replaced by their original
113 names, reporting any unknown names.
115 Renaming type variables is a pain. Because they now contain uniques,
116 it is necessary to pass in an association list which maps a parsed
117 tyvar to its Name representation. In some cases (type signatures of
118 values), it is even necessary to go over the type first in order to
119 get the set of tyvars used by it, make an assoc list, and then go over
120 it again to rename the tyvars! However, we can also do some scoping
121 checks at the same time.
124 rnDecl (TyD (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc))
125 = pushSrcLocRn src_loc $
126 lookupBndrRn tycon `thenRn` \ tycon' ->
127 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
128 rnContext context `thenRn` \ context' ->
129 checkDupOrQualNames data_doc con_names `thenRn_`
130 mapRn rnConDecl condecls `thenRn` \ condecls' ->
131 rnDerivs derivings `thenRn` \ derivings' ->
132 ASSERT(isNoDataPragmas pragmas)
133 returnRn (TyD (TyData new_or_data context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc))
135 data_doc sty = text "the data type declaration for" <+> ppr sty tycon
136 con_names = map conDeclName condecls
138 rnDecl (TyD (TySynonym name tyvars ty src_loc))
139 = pushSrcLocRn src_loc $
140 lookupBndrRn name `thenRn` \ name' ->
141 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
142 rnHsType ty `thenRn` \ ty' ->
143 returnRn (TyD (TySynonym name' tyvars' ty' src_loc))
145 syn_doc sty = text "the declaration for type synonym" <+> ppr sty name
148 %*********************************************************
150 \subsection{Class declarations}
152 %*********************************************************
154 @rnClassDecl@ uses the `global name function' to create a new
155 class declaration in which local names have been replaced by their
156 original names, reporting any unknown names.
159 rnDecl (ClD (ClassDecl context cname tyvar sigs mbinds pragmas src_loc))
160 = pushSrcLocRn src_loc $
162 bindTyVarsRn cls_doc [tyvar] ( \ [tyvar'] ->
163 rnContext context `thenRn` \ context' ->
164 lookupBndrRn cname `thenRn` \ cname' ->
166 -- Check the signatures
167 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
168 mapRn (rn_op cname' (getTyVarName tyvar')) sigs `thenRn` \ sigs' ->
169 returnRn (tyvar', context', cname', sigs')
170 ) `thenRn` \ (tyvar', context', cname', sigs') ->
173 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
174 rnMethodBinds mbinds `thenRn` \ mbinds' ->
176 -- Typechecker is responsible for checking that we only
177 -- give default-method bindings for things in this class.
178 -- The renamer *could* check this for class decls, but can't
179 -- for instance decls.
181 ASSERT(isNoClassPragmas pragmas)
182 returnRn (ClD (ClassDecl context' cname' tyvar' sigs' mbinds' NoClassPragmas src_loc))
184 cls_doc sty = text "the declaration for class" <+> ppr sty cname
185 sig_doc sty = text "the signatures for class" <+> ppr sty cname
186 meth_doc sty = text "the default-methods for class" <+> ppr sty cname
188 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
189 meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
190 meth_rdr_names = map fst meth_rdr_names_w_locs
192 rn_op clas clas_tyvar sig@(ClassOpSig op maybe_dm ty locn)
193 = pushSrcLocRn locn $
194 lookupBndrRn op `thenRn` \ op_name ->
195 rnHsSigType (\sty -> ppr sty op) ty `thenRn` \ new_ty ->
197 -- Make the default-method name
199 dm_occ = prefixOccName SLIT("$m") (rdrNameOcc op)
201 getModuleRn `thenRn` \ mod_name ->
202 getModeRn `thenRn` \ mode ->
203 (case (mode, maybe_dm) of
204 (SourceMode, _) | op `elem` meth_rdr_names
205 -> -- There's an explicit method decl
206 newLocallyDefinedGlobalName mod_name dm_occ
207 (\_ -> Exported) locn `thenRn` \ dm_name ->
208 returnRn (Just dm_name)
210 (InterfaceMode _, Just _)
211 -> -- Imported class that has a default method decl
212 newGlobalName mod_name dm_occ (ifaceFlavour clas) `thenRn` \ dm_name ->
213 addOccurrenceName dm_name `thenRn_`
214 returnRn (Just dm_name)
216 other -> returnRn Nothing
217 ) `thenRn` \ maybe_dm_name ->
221 (ctxt, op_ty) = case new_ty of
222 HsForAllTy tvs ctxt op_ty -> (ctxt, op_ty)
223 other -> ([], new_ty)
224 ctxt_fvs = extractCtxtTyNames ctxt
225 op_ty_fvs = extractHsTyNames op_ty -- Includes tycons/classes but we
226 -- don't care about that
228 -- Check that class tyvar appears in op_ty
229 checkRn (clas_tyvar `elemNameSet` op_ty_fvs)
230 (classTyVarNotInOpTyErr clas_tyvar sig)
233 returnRn (ClassOpSig op_name maybe_dm_name new_ty locn)
237 %*********************************************************
239 \subsection{Instance declarations}
241 %*********************************************************
244 rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc))
245 = pushSrcLocRn src_loc $
246 rnHsSigType (\sty -> text "an instance decl") inst_ty `thenRn` \ inst_ty' ->
249 -- Rename the bindings
250 -- NB meth_names can be qualified!
251 checkDupNames meth_doc meth_names `thenRn_`
252 rnMethodBinds mbinds `thenRn` \ mbinds' ->
253 mapRn rn_uprag uprags `thenRn` \ new_uprags ->
255 newDfunName maybe_dfun src_loc `thenRn` \ dfun_name ->
256 addOccurrenceName dfun_name `thenRn_`
257 -- The dfun is not optional, because we use its version number
258 -- to identify the version of the instance declaration
260 -- The typechecker checks that all the bindings are for the right class.
261 returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags (Just dfun_name) src_loc))
263 meth_doc sty = text "the bindings in an instance declaration"
264 meth_names = bagToList (collectMonoBinders mbinds)
266 rn_uprag (SpecSig op ty using locn)
267 = pushSrcLocRn src_loc $
268 lookupBndrRn op `thenRn` \ op_name ->
269 rnHsSigType (\sty -> ppr sty op) ty `thenRn` \ new_ty ->
270 rn_using using `thenRn` \ new_using ->
271 returnRn (SpecSig op_name new_ty new_using locn)
273 rn_uprag (InlineSig op locn)
274 = pushSrcLocRn locn $
275 lookupBndrRn op `thenRn` \ op_name ->
276 returnRn (InlineSig op_name locn)
278 rn_uprag (MagicUnfoldingSig op str locn)
279 = pushSrcLocRn locn $
280 lookupBndrRn op `thenRn` \ op_name ->
281 returnRn (MagicUnfoldingSig op_name str locn)
283 rn_using Nothing = returnRn Nothing
284 rn_using (Just v) = lookupOccRn v `thenRn` \ new_v ->
285 returnRn (Just new_v)
288 %*********************************************************
290 \subsection{Default declarations}
292 %*********************************************************
295 rnDecl (DefD (DefaultDecl tys src_loc))
296 = pushSrcLocRn src_loc $
297 mapRn rnHsType tys `thenRn` \ tys' ->
298 lookupImplicitOccRn numClass_RDR `thenRn_`
299 returnRn (DefD (DefaultDecl tys' src_loc))
302 %*********************************************************
304 \subsection{Support code for type/data declarations}
306 %*********************************************************
309 rnDerivs :: Maybe [RdrName] -> RnMS s (Maybe [Name])
311 rnDerivs Nothing -- derivs not specified
312 = lookupImplicitOccRn evalClass_RDR `thenRn_`
316 = lookupImplicitOccRn evalClass_RDR `thenRn_`
317 mapRn rn_deriv ds `thenRn` \ derivs ->
318 returnRn (Just derivs)
321 = lookupOccRn clas `thenRn` \ clas_name ->
323 -- Now add extra "occurrences" for things that
324 -- the deriving mechanism will later need in order to
325 -- generate code for this class.
326 case lookupUFM derivingOccurrences clas_name of
327 Nothing -> addErrRn (derivingNonStdClassErr clas_name) `thenRn_`
330 Just occs -> mapRn lookupImplicitOccRn occs `thenRn_`
335 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
336 conDeclName (ConDecl n _ _ l) = (n,l)
338 rnConDecl :: RdrNameConDecl -> RnMS s RenamedConDecl
339 rnConDecl (ConDecl name cxt details locn)
340 = pushSrcLocRn locn $
341 checkConName name `thenRn_`
342 lookupBndrRn name `thenRn` \ new_name ->
343 rnConDetails name locn details `thenRn` \ new_details ->
344 rnContext cxt `thenRn` \ new_context ->
345 returnRn (ConDecl new_name new_context new_details locn)
347 rnConDetails con locn (VanillaCon tys)
348 = mapRn rnBangTy tys `thenRn` \ new_tys ->
349 returnRn (VanillaCon new_tys)
351 rnConDetails con locn (InfixCon ty1 ty2)
352 = rnBangTy ty1 `thenRn` \ new_ty1 ->
353 rnBangTy ty2 `thenRn` \ new_ty2 ->
354 returnRn (InfixCon new_ty1 new_ty2)
356 rnConDetails con locn (NewCon ty)
357 = rnHsType ty `thenRn` \ new_ty ->
358 returnRn (NewCon new_ty)
360 rnConDetails con locn (RecCon fields)
361 = checkDupOrQualNames fld_doc field_names `thenRn_`
362 mapRn rnField fields `thenRn` \ new_fields ->
363 returnRn (RecCon new_fields)
365 fld_doc sty = text "the fields of constructor" <> ppr sty con
366 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
369 = mapRn lookupBndrRn names `thenRn` \ new_names ->
370 rnBangTy ty `thenRn` \ new_ty ->
371 returnRn (new_names, new_ty)
374 = rnHsType ty `thenRn` \ new_ty ->
375 returnRn (Banged new_ty)
377 rnBangTy (Unbanged ty)
378 = rnHsType ty `thenRn` \ new_ty ->
379 returnRn (Unbanged new_ty)
381 -- This data decl will parse OK
383 -- treating "a" as the constructor.
384 -- It is really hard to make the parser spot this malformation.
385 -- So the renamer has to check that the constructor is legal
387 -- We can get an operator as the constructor, even in the prefix form:
388 -- data T = :% Int Int
389 -- from interface files, which always print in prefix form
392 = checkRn (isLexCon (occNameString (rdrNameOcc name)))
397 %*********************************************************
399 \subsection{Support code to rename types}
401 %*********************************************************
404 rnHsSigType :: (PprStyle -> Doc) -> RdrNameHsType -> RnMS s RenamedHsType
405 -- rnHsSigType is used for source-language type signatures,
406 -- which use *implicit* universal quantification.
408 -- Given the signature C => T we universally quantify over FV(T) \ {in-scope-tyvars}
410 -- We insist that the universally quantified type vars is a superset of FV(C)
411 -- It follows that FV(T) is a superset of FV(C), so that the context constrains
412 -- no type variables that don't appear free in the tau-type part.
414 rnHsSigType doc_str full_ty@(HsPreForAllTy ctxt ty) -- From source code (no kinds on tyvars)
415 = getNameEnv `thenRn` \ name_env ->
417 mentioned_tyvars = extractHsTyVars ty
418 forall_tyvars = filter (not . in_scope) mentioned_tyvars
419 in_scope tv = maybeToBool (lookupFM name_env tv)
421 constrained_tyvars = nub (concat (map (extractHsTyVars . snd) ctxt))
422 constrained_and_in_scope = filter in_scope constrained_tyvars
423 constrained_and_not_mentioned = filter (not . (`elem` mentioned_tyvars)) constrained_tyvars
425 -- Zap the context if there's a problem, to avoid duplicate error message.
426 ctxt' | null constrained_and_in_scope && null constrained_and_not_mentioned = ctxt
429 checkRn (null constrained_and_in_scope)
430 (ctxtErr1 sig_doc constrained_and_in_scope) `thenRn_`
431 checkRn (null constrained_and_not_mentioned)
432 (ctxtErr2 sig_doc constrained_and_not_mentioned ty) `thenRn_`
434 (bindTyVarsRn sig_doc (map UserTyVar forall_tyvars) $ \ new_tyvars ->
435 rnContext ctxt' `thenRn` \ new_ctxt ->
436 rnHsType ty `thenRn` \ new_ty ->
437 returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
440 sig_doc sty = text "the type signature for" <+> doc_str sty
443 rnHsSigType doc_str other_ty = rnHsType other_ty
445 rnHsType :: RdrNameHsType -> RnMS s RenamedHsType
446 rnHsType (HsForAllTy tvs ctxt ty) -- From an interface file (tyvars may be kinded)
447 = rn_poly_help tvs ctxt ty
449 rnHsType full_ty@(HsPreForAllTy ctxt ty) -- A (context => ty) embedded in a type.
450 -- Universally quantify over tyvars in context
451 = getNameEnv `thenRn` \ name_env ->
453 forall_tyvars = foldr unionLists [] (map (extractHsTyVars . snd) ctxt)
455 rn_poly_help (map UserTyVar forall_tyvars) ctxt ty
457 rnHsType (MonoTyVar tyvar)
458 = lookupOccRn tyvar `thenRn` \ tyvar' ->
459 returnRn (MonoTyVar tyvar')
461 rnHsType (MonoFunTy ty1 ty2)
462 = andRn MonoFunTy (rnHsType ty1) (rnHsType ty2)
464 rnHsType (MonoListTy _ ty)
465 = lookupImplicitOccRn listType_RDR `thenRn` \ tycon_name ->
466 rnHsType ty `thenRn` \ ty' ->
467 returnRn (MonoListTy tycon_name ty')
469 rnHsType (MonoTupleTy _ tys)
470 = lookupImplicitOccRn (tupleType_RDR (length tys)) `thenRn` \ tycon_name ->
471 mapRn rnHsType tys `thenRn` \ tys' ->
472 returnRn (MonoTupleTy tycon_name tys')
474 rnHsType (MonoTyApp ty1 ty2)
475 = rnHsType ty1 `thenRn` \ ty1' ->
476 rnHsType ty2 `thenRn` \ ty2' ->
477 returnRn (MonoTyApp ty1' ty2')
479 rnHsType (MonoDictTy clas ty)
480 = lookupOccRn clas `thenRn` \ clas' ->
481 rnHsType ty `thenRn` \ ty' ->
482 returnRn (MonoDictTy clas' ty')
484 rn_poly_help :: [HsTyVar RdrName] -- Universally quantified tyvars
487 -> RnMS s RenamedHsType
488 rn_poly_help tyvars ctxt ty
489 = bindTyVarsRn sig_doc tyvars $ \ new_tyvars ->
490 rnContext ctxt `thenRn` \ new_ctxt ->
491 rnHsType ty `thenRn` \ new_ty ->
492 returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
494 sig_doc sty = text "a nested for-all type"
499 rnContext :: RdrNameContext -> RnMS s RenamedContext
502 = mapRn rn_ctxt ctxt `thenRn` \ result ->
504 (_, dup_asserts) = removeDups cmp_assert result
505 (alls, theta) = partition (\(c,_) -> c == allClass_NAME) result
506 non_tyvar_alls = [(c,t) | (c,t) <- alls, not (is_tyvar t)]
509 -- Check for duplicate assertions
510 -- If this isn't an error, then it ought to be:
511 mapRn (addWarnRn . dupClassAssertWarn theta) dup_asserts `thenRn_`
513 -- Check for All constraining a non-type-variable
514 mapRn (addWarnRn . allOfNonTyVar) non_tyvar_alls `thenRn_`
516 -- Done. Return a theta omitting all the "All" constraints.
517 -- They have done done their work by ensuring that we universally
518 -- quantify over their tyvar.
522 = -- Mini hack here. If the class is our pseudo-class "All",
523 -- then we don't want to record it as an occurrence, otherwise
524 -- we try to slurp it in later and it doesn't really exist at all.
525 -- Easiest thing is simply not to put it in the occurrence set.
526 lookupBndrRn clas `thenRn` \ clas_name ->
527 (if clas_name /= allClass_NAME then
528 addOccurrenceName clas_name
532 rnHsType ty `thenRn` \ ty' ->
533 returnRn (clas_name, ty')
535 cmp_assert (c1,ty1) (c2,ty2)
536 = (c1 `cmp` c2) `thenCmp` (cmpHsType cmp ty1 ty2)
538 is_tyvar (MonoTyVar _) = True
539 is_tyvar other = False
543 %*********************************************************
547 %*********************************************************
550 rnIdInfo (HsStrictness strict)
551 = rnStrict strict `thenRn` \ strict' ->
552 returnRn (HsStrictness strict')
554 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
555 returnRn (HsUnfold inline expr')
556 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
557 rnIdInfo (HsUpdate update) = returnRn (HsUpdate update)
558 rnIdInfo (HsFBType fb) = returnRn (HsFBType fb)
559 rnIdInfo (HsArgUsage au) = returnRn (HsArgUsage au)
561 rnStrict (HsStrictnessInfo demands (Just (worker,cons)))
562 -- The sole purpose of the "cons" field is so that we can mark the constructors
563 -- needed to build the wrapper as "needed", so that their data type decl will be
564 -- slurped in. After that their usefulness is o'er, so we just put in the empty list.
565 = lookupOccRn worker `thenRn` \ worker' ->
566 mapRn lookupOccRn cons `thenRn_`
567 returnRn (HsStrictnessInfo demands (Just (worker',[])))
569 -- Boring, but necessary for the type checker.
570 rnStrict (HsStrictnessInfo demands Nothing) = returnRn (HsStrictnessInfo demands Nothing)
571 rnStrict HsBottom = returnRn HsBottom
578 = lookupOccRn v `thenRn` \ v' ->
581 rnCoreExpr (UfLit lit) = returnRn (UfLit lit)
583 rnCoreExpr (UfCon con args)
584 = lookupOccRn con `thenRn` \ con' ->
585 mapRn rnCoreArg args `thenRn` \ args' ->
586 returnRn (UfCon con' args')
588 rnCoreExpr (UfPrim prim args)
589 = rnCorePrim prim `thenRn` \ prim' ->
590 mapRn rnCoreArg args `thenRn` \ args' ->
591 returnRn (UfPrim prim' args')
593 rnCoreExpr (UfApp fun arg)
594 = rnCoreExpr fun `thenRn` \ fun' ->
595 rnCoreArg arg `thenRn` \ arg' ->
596 returnRn (UfApp fun' arg')
598 rnCoreExpr (UfCase scrut alts)
599 = rnCoreExpr scrut `thenRn` \ scrut' ->
600 rnCoreAlts alts `thenRn` \ alts' ->
601 returnRn (UfCase scrut' alts')
603 rnCoreExpr (UfSCC cc expr)
604 = rnCoreExpr expr `thenRn` \ expr' ->
605 returnRn (UfSCC cc expr')
607 rnCoreExpr(UfCoerce coercion ty body)
608 = rnCoercion coercion `thenRn` \ coercion' ->
609 rnHsType ty `thenRn` \ ty' ->
610 rnCoreExpr body `thenRn` \ body' ->
611 returnRn (UfCoerce coercion' ty' body')
613 rnCoreExpr (UfLam bndr body)
614 = rnCoreBndr bndr $ \ bndr' ->
615 rnCoreExpr body `thenRn` \ body' ->
616 returnRn (UfLam bndr' body')
618 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
619 = rnCoreExpr rhs `thenRn` \ rhs' ->
620 rnCoreBndr bndr $ \ bndr' ->
621 rnCoreExpr body `thenRn` \ body' ->
622 returnRn (UfLet (UfNonRec bndr' rhs') body')
624 rnCoreExpr (UfLet (UfRec pairs) body)
625 = rnCoreBndrs bndrs $ \ bndrs' ->
626 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
627 rnCoreExpr body `thenRn` \ body' ->
628 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
630 (bndrs, rhss) = unzip pairs
634 rnCoreBndr (UfValBinder name ty) thing_inside
635 = rnHsType ty `thenRn` \ ty' ->
636 bindLocalsRn "unfolding value" [name] $ \ [name'] ->
637 thing_inside (UfValBinder name' ty')
639 rnCoreBndr (UfTyBinder name kind) thing_inside
640 = bindLocalsRn "unfolding tyvar" [name] $ \ [name'] ->
641 thing_inside (UfTyBinder name' kind)
643 rnCoreBndr (UfUsageBinder name) thing_inside
644 = bindLocalsRn "unfolding usage" [name] $ \ [name'] ->
645 thing_inside (UfUsageBinder name')
647 rnCoreBndrs bndrs thing_inside -- Expect them all to be ValBinders
648 = mapRn rnHsType tys `thenRn` \ tys' ->
649 bindLocalsRn "unfolding value" names $ \ names' ->
650 thing_inside (zipWith UfValBinder names' tys')
652 names = map (\ (UfValBinder name _) -> name) bndrs
653 tys = map (\ (UfValBinder _ ty) -> ty) bndrs
655 rnCoreBndrNamess names thing_inside
656 = bindLocalsRn "unfolding value" names $ \ names' ->
661 rnCoreArg (UfVarArg v) = lookupOccRn v `thenRn` \ v' -> returnRn (UfVarArg v')
662 rnCoreArg (UfUsageArg u) = lookupOccRn u `thenRn` \ u' -> returnRn (UfUsageArg u')
663 rnCoreArg (UfTyArg ty) = rnHsType ty `thenRn` \ ty' -> returnRn (UfTyArg ty')
664 rnCoreArg (UfLitArg lit) = returnRn (UfLitArg lit)
666 rnCoreAlts (UfAlgAlts alts deflt)
667 = mapRn rn_alt alts `thenRn` \ alts' ->
668 rnCoreDefault deflt `thenRn` \ deflt' ->
669 returnRn (UfAlgAlts alts' deflt')
671 rn_alt (con, bndrs, rhs) = lookupOccRn con `thenRn` \ con' ->
672 bindLocalsRn "unfolding alt" bndrs $ \ bndrs' ->
673 rnCoreExpr rhs `thenRn` \ rhs' ->
674 returnRn (con', bndrs', rhs')
676 rnCoreAlts (UfPrimAlts alts deflt)
677 = mapRn rn_alt alts `thenRn` \ alts' ->
678 rnCoreDefault deflt `thenRn` \ deflt' ->
679 returnRn (UfPrimAlts alts' deflt')
681 rn_alt (lit, rhs) = rnCoreExpr rhs `thenRn` \ rhs' ->
684 rnCoreDefault UfNoDefault = returnRn UfNoDefault
685 rnCoreDefault (UfBindDefault bndr rhs) = bindLocalsRn "unfolding default" [bndr] $ \ [bndr'] ->
686 rnCoreExpr rhs `thenRn` \ rhs' ->
687 returnRn (UfBindDefault bndr' rhs')
689 rnCoercion (UfIn n) = lookupOccRn n `thenRn` \ n' -> returnRn (UfIn n')
690 rnCoercion (UfOut n) = lookupOccRn n `thenRn` \ n' -> returnRn (UfOut n')
692 rnCorePrim (UfOtherOp op)
693 = lookupOccRn op `thenRn` \ op' ->
694 returnRn (UfOtherOp op')
696 rnCorePrim (UfCCallOp str casm gc arg_tys res_ty)
697 = mapRn rnHsType arg_tys `thenRn` \ arg_tys' ->
698 rnHsType res_ty `thenRn` \ res_ty' ->
699 returnRn (UfCCallOp str casm gc arg_tys' res_ty')
702 %*********************************************************
706 %*********************************************************
709 derivingNonStdClassErr clas sty
710 = hsep [ptext SLIT("non-standard class"), ppr sty clas, ptext SLIT("in deriving clause")]
712 classTyVarNotInOpTyErr clas_tyvar sig sty
713 = hang (hsep [ptext SLIT("Class type variable"),
715 ptext SLIT("does not appear in method signature")])
718 dupClassAssertWarn ctxt ((clas,ty) : dups) sty
719 = sep [hsep [ptext SLIT("Duplicated class assertion"),
720 pprQuote sty $ \ sty -> ppr sty clas <+> ppr sty ty,
721 ptext SLIT("in context:")],
722 nest 4 (pprQuote sty $ \ sty -> pprContext sty ctxt)]
725 = hsep [ptext SLIT("Illegal data constructor name"), ppr sty name]
728 = hsep [ptext SLIT("`All' applied to a non-type variable"), ppr sty ty]
730 ctxtErr1 doc tyvars sty
731 = hsep [ptext SLIT("Context constrains in-scope type variable(s)"),
732 hsep (punctuate comma (map (ppr sty) tyvars))]
734 nest 4 (ptext SLIT("in") <+> doc sty)
736 ctxtErr2 doc tyvars ty sty
737 = (ptext SLIT("Context constrains type variable(s)")
738 <+> hsep (punctuate comma (map (ppr sty) tyvars)))
740 nest 4 (vcat [ptext SLIT("that do not appear in") <+> ppr sty ty,
741 ptext SLIT("in") <+> doc sty])