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
12 IMPORT_DELOOPER(RnLoop) -- *check* the RnPass/RnExpr/RnBinds loop-breaking
13 IMPORT_1_3(List(partition))
16 import HsDecls ( HsIdInfo(..) )
18 import HsTypes ( getTyVarName )
22 import CmdLineOpts ( opt_IgnoreIfacePragmas )
24 import RnBinds ( rnTopBinds, rnMethodBinds )
25 import RnEnv ( bindTyVarsRn, lookupBndrRn, lookupOccRn, lookupImplicitOccRn, bindLocalsRn,
26 lookupOptionalOccRn, newSysName, newDfunName, checkDupOrQualNames, checkDupNames,
27 listType_RDR, tupleType_RDR )
30 import Name ( Name, isLocallyDefined,
31 OccName(..), occNameString, prefixOccName,
34 SYN_IE(NameSet), unionNameSets, emptyNameSet, mkNameSet, unitNameSet,
37 import ErrUtils ( addErrLoc, addShortErrLocLine, addShortWarnLocLine )
38 import FiniteMap ( emptyFM, lookupFM, addListToFM_C )
39 import Id ( GenId{-instance NamedThing-} )
40 import IdInfo ( IdInfo, StrictnessInfo(..), FBTypeInfo, DemandInfo, ArgUsageInfo )
41 import SpecEnv ( SpecEnv )
42 import Lex ( isLexCon )
43 import CoreUnfold ( Unfolding(..), SimpleUnfolding )
44 import MagicUFs ( MagicUnfoldingFun )
45 import PrelInfo ( derivingOccurrences, evalClass_RDR, numClass_RDR, allClass_NAME )
46 import ListSetOps ( unionLists, minusList )
47 import Maybes ( maybeToBool, catMaybes )
48 import Bag ( emptyBag, unitBag, consBag, unionManyBags, unionBags, listToBag, bagToList )
49 import Outputable ( Outputable(..){-instances-} )
52 import SrcLoc ( SrcLoc )
53 -- import TyCon ( TyCon{-instance NamedThing-} )
54 import Unique ( Unique )
55 import UniqSet ( SYN_IE(UniqSet) )
56 import UniqFM ( UniqFM, lookupUFM )
57 import Util {- ( isIn, isn'tIn, thenCmp, removeDups, cmpPString,
58 panic, assertPanic{- , pprTrace ToDo:rm-} ) -}
61 rnDecl `renames' declarations.
62 It simultaneously performs dependency analysis and precedence parsing.
63 It also does the following error checks:
66 Checks that tyvars are used properly. This includes checking
67 for undefined tyvars, and tyvars in contexts that are ambiguous.
69 Checks that all variable occurences are defined.
71 Checks the (..) etc constraints in the export list.
75 %*********************************************************
77 \subsection{Value declarations}
79 %*********************************************************
82 rnDecl :: RdrNameHsDecl -> RnMS s RenamedHsDecl
84 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ new_binds ->
85 returnRn (ValD new_binds)
88 rnDecl (SigD (IfaceSig name ty id_infos loc))
90 lookupBndrRn name `thenRn` \ name' ->
91 rnHsType ty `thenRn` \ ty' ->
93 -- Get the pragma info, unless we should ignore it
94 (if opt_IgnoreIfacePragmas then
97 mapRn rnIdInfo id_infos
98 ) `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' ->
169 checkDupOrQualNames meth_doc meth_names `thenRn_`
170 rnMethodBinds mbinds `thenRn` \ mbinds' ->
172 -- Typechecker is responsible for checking that we only
173 -- give default-method bindings for things in this class.
174 -- The renamer *could* check this for class decls, but can't
175 -- for instance decls.
177 ASSERT(isNoClassPragmas pragmas)
178 returnRn (ClD (ClassDecl context' cname' tyvar' sigs' mbinds' NoClassPragmas src_loc))
180 cls_doc sty = text "the declaration for class" <+> ppr sty cname
181 sig_doc sty = text "the signatures for class" <+> ppr sty cname
182 meth_doc sty = text "the default-methods for class" <+> ppr sty cname
184 sig_names = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
185 meth_names = bagToList (collectMonoBinders mbinds)
187 rn_op clas clas_tyvar sig@(ClassOpSig op _ ty locn)
188 = pushSrcLocRn locn $
189 lookupBndrRn op `thenRn` \ op_name ->
190 rnHsSigType (\sty -> ppr sty op) ty `thenRn` \ new_ty ->
192 -- Call up interface info for default method, if such info exists
194 dm_occ = prefixOccName SLIT("$m") (rdrNameOcc op)
196 newSysName dm_occ Exported locn `thenRn` \ dm_name ->
197 addOccurrenceName Optional dm_name `thenRn_`
202 (ctxt, op_ty) = case new_ty of
203 HsForAllTy tvs ctxt op_ty -> (ctxt, op_ty)
204 other -> ([], new_ty)
205 ctxt_fvs = extractCtxtTyNames ctxt
206 op_ty_fvs = extractHsTyNames op_ty -- Includes tycons/classes but we
207 -- don't care about that
209 -- Check that class tyvar appears in op_ty
210 checkRn (clas_tyvar `elemNameSet` op_ty_fvs)
211 (classTyVarNotInOpTyErr clas_tyvar sig)
214 -- Check that class tyvar *doesn't* appear in the sig's context
215 checkRn (not (clas_tyvar `elemNameSet` ctxt_fvs))
216 (classTyVarInOpCtxtErr clas_tyvar sig)
219 returnRn (ClassOpSig op_name dm_name new_ty locn)
223 %*********************************************************
225 \subsection{Instance declarations}
227 %*********************************************************
230 rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc))
231 = pushSrcLocRn src_loc $
232 rnHsSigType (\sty -> text "an instance decl") inst_ty `thenRn` \ inst_ty' ->
235 -- Rename the bindings
236 -- NB meth_names can be qualified!
237 checkDupNames meth_doc meth_names `thenRn_`
238 rnMethodBinds mbinds `thenRn` \ mbinds' ->
239 mapRn rn_uprag uprags `thenRn` \ new_uprags ->
241 newDfunName maybe_dfun src_loc `thenRn` \ dfun_name ->
242 addOccurrenceName Compulsory dfun_name `thenRn_`
243 -- The dfun is not optional, because we use its version number
244 -- to identify the version of the instance declaration
246 -- The typechecker checks that all the bindings are for the right class.
247 returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags (Just dfun_name) src_loc))
249 meth_doc sty = text "the bindings in an instance declaration"
250 meth_names = bagToList (collectMonoBinders mbinds)
252 rn_uprag (SpecSig op ty using locn)
253 = pushSrcLocRn src_loc $
254 lookupBndrRn op `thenRn` \ op_name ->
255 rnHsSigType (\sty -> ppr sty op) ty `thenRn` \ new_ty ->
256 rn_using using `thenRn` \ new_using ->
257 returnRn (SpecSig op_name new_ty new_using locn)
259 rn_uprag (InlineSig op locn)
260 = pushSrcLocRn locn $
261 lookupBndrRn op `thenRn` \ op_name ->
262 returnRn (InlineSig op_name locn)
264 rn_uprag (DeforestSig op locn)
265 = pushSrcLocRn locn $
266 lookupBndrRn op `thenRn` \ op_name ->
267 returnRn (DeforestSig op_name locn)
269 rn_uprag (MagicUnfoldingSig op str locn)
270 = pushSrcLocRn locn $
271 lookupBndrRn op `thenRn` \ op_name ->
272 returnRn (MagicUnfoldingSig op_name str locn)
274 rn_using Nothing = returnRn Nothing
275 rn_using (Just v) = lookupOccRn v `thenRn` \ new_v ->
276 returnRn (Just new_v)
279 %*********************************************************
281 \subsection{Default declarations}
283 %*********************************************************
286 rnDecl (DefD (DefaultDecl tys src_loc))
287 = pushSrcLocRn src_loc $
288 mapRn rnHsType tys `thenRn` \ tys' ->
289 lookupImplicitOccRn numClass_RDR `thenRn_`
290 returnRn (DefD (DefaultDecl tys' src_loc))
293 %*********************************************************
295 \subsection{Support code for type/data declarations}
297 %*********************************************************
300 rnDerivs :: Maybe [RdrName] -> RnMS s (Maybe [Name])
302 rnDerivs Nothing -- derivs not specified
303 = lookupImplicitOccRn evalClass_RDR `thenRn_`
307 = lookupImplicitOccRn evalClass_RDR `thenRn_`
308 mapRn rn_deriv ds `thenRn` \ derivs ->
309 returnRn (Just derivs)
312 = lookupOccRn clas `thenRn` \ clas_name ->
314 -- Now add extra "occurrences" for things that
315 -- the deriving mechanism will later need in order to
316 -- generate code for this class.
317 case lookupUFM derivingOccurrences clas_name of
318 Nothing -> addErrRn (derivingNonStdClassErr clas_name) `thenRn_`
321 Just occs -> mapRn lookupImplicitOccRn occs `thenRn_`
326 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
327 conDeclName (ConDecl n _ _ l) = (n,l)
329 rnConDecl :: RdrNameConDecl -> RnMS s RenamedConDecl
330 rnConDecl (ConDecl name cxt details locn)
331 = pushSrcLocRn locn $
332 checkConName name `thenRn_`
333 lookupBndrRn name `thenRn` \ new_name ->
334 rnConDetails name locn details `thenRn` \ new_details ->
335 rnContext cxt `thenRn` \ new_context ->
336 returnRn (ConDecl new_name new_context new_details locn)
338 rnConDetails con locn (VanillaCon tys)
339 = mapRn rnBangTy tys `thenRn` \ new_tys ->
340 returnRn (VanillaCon new_tys)
342 rnConDetails con locn (InfixCon ty1 ty2)
343 = rnBangTy ty1 `thenRn` \ new_ty1 ->
344 rnBangTy ty2 `thenRn` \ new_ty2 ->
345 returnRn (InfixCon new_ty1 new_ty2)
347 rnConDetails con locn (NewCon ty)
348 = rnHsType ty `thenRn` \ new_ty ->
349 returnRn (NewCon new_ty)
351 rnConDetails con locn (RecCon fields)
352 = checkDupOrQualNames fld_doc field_names `thenRn_`
353 mapRn rnField fields `thenRn` \ new_fields ->
354 returnRn (RecCon new_fields)
356 fld_doc sty = text "the fields of constructor" <> ppr sty con
357 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
360 = mapRn lookupBndrRn names `thenRn` \ new_names ->
361 rnBangTy ty `thenRn` \ new_ty ->
362 returnRn (new_names, new_ty)
365 = rnHsType ty `thenRn` \ new_ty ->
366 returnRn (Banged new_ty)
368 rnBangTy (Unbanged ty)
369 = rnHsType ty `thenRn` \ new_ty ->
370 returnRn (Unbanged new_ty)
372 -- This data decl will parse OK
374 -- treating "a" as the constructor.
375 -- It is really hard to make the parser spot this malformation.
376 -- So the renamer has to check that the constructor is legal
378 -- We can get an operator as the constructor, even in the prefix form:
379 -- data T = :% Int Int
380 -- from interface files, which always print in prefix form
383 = checkRn (isLexCon (occNameString (rdrNameOcc name)))
388 %*********************************************************
390 \subsection{Support code to rename types}
392 %*********************************************************
395 rnHsSigType :: (PprStyle -> Doc) -> RdrNameHsType -> RnMS s RenamedHsType
396 -- rnHsSigType is used for source-language type signatures,
397 -- which use *implicit* universal quantification.
399 rnHsSigType doc_str full_ty@(HsPreForAllTy ctxt ty) -- From source code (no kinds on tyvars)
400 = getNameEnv `thenRn` \ name_env ->
402 mentioned_tyvars = extractHsTyVars full_ty
403 forall_tyvars = filter not_in_scope mentioned_tyvars
404 not_in_scope tv = case lookupFM name_env tv of
408 non_foralld_constrained = [tv | (clas, ty) <- ctxt,
409 tv <- extractHsTyVars ty,
410 not (tv `elem` forall_tyvars)
413 -- checkRn (null non_foralld_constrained)
414 -- (ctxtErr sig_doc non_foralld_constrained) `thenRn_`
416 (bindTyVarsRn sig_doc (map UserTyVar forall_tyvars) $ \ new_tyvars ->
417 rnContext ctxt `thenRn` \ new_ctxt ->
418 rnHsType ty `thenRn` \ new_ty ->
419 returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
422 sig_doc sty = text "the type signature for" <+> doc_str sty
425 rnHsSigType doc_str other_ty = rnHsType other_ty
427 rnHsType :: RdrNameHsType -> RnMS s RenamedHsType
428 rnHsType (HsForAllTy tvs ctxt ty) -- From an interface file (tyvars may be kinded)
429 = rn_poly_help tvs ctxt ty
431 rnHsType full_ty@(HsPreForAllTy ctxt ty) -- A (context => ty) embedded in a type.
432 -- Universally quantify over tyvars in context
433 = getNameEnv `thenRn` \ name_env ->
435 forall_tyvars = foldr unionLists [] (map (extractHsTyVars . snd) ctxt)
437 rn_poly_help (map UserTyVar forall_tyvars) ctxt ty
439 rnHsType (MonoTyVar tyvar)
440 = lookupOccRn tyvar `thenRn` \ tyvar' ->
441 returnRn (MonoTyVar tyvar')
443 rnHsType (MonoFunTy ty1 ty2)
444 = andRn MonoFunTy (rnHsType ty1) (rnHsType ty2)
446 rnHsType (MonoListTy _ ty)
447 = lookupImplicitOccRn listType_RDR `thenRn` \ tycon_name ->
448 rnHsType ty `thenRn` \ ty' ->
449 returnRn (MonoListTy tycon_name ty')
451 rnHsType (MonoTupleTy _ tys)
452 = lookupImplicitOccRn (tupleType_RDR (length tys)) `thenRn` \ tycon_name ->
453 mapRn rnHsType tys `thenRn` \ tys' ->
454 returnRn (MonoTupleTy tycon_name tys')
456 rnHsType (MonoTyApp ty1 ty2)
457 = rnHsType ty1 `thenRn` \ ty1' ->
458 rnHsType ty2 `thenRn` \ ty2' ->
459 returnRn (MonoTyApp ty1' ty2')
461 rnHsType (MonoDictTy clas ty)
462 = lookupOccRn clas `thenRn` \ clas' ->
463 rnHsType ty `thenRn` \ ty' ->
464 returnRn (MonoDictTy clas' ty')
466 rn_poly_help :: [HsTyVar RdrName] -- Universally quantified tyvars
469 -> RnMS s RenamedHsType
470 rn_poly_help tyvars ctxt ty
471 = bindTyVarsRn sig_doc tyvars $ \ new_tyvars ->
472 rnContext ctxt `thenRn` \ new_ctxt ->
473 rnHsType ty `thenRn` \ new_ty ->
474 returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
476 sig_doc sty = text "a nested for-all type"
481 rnContext :: RdrNameContext -> RnMS s RenamedContext
484 = mapRn rn_ctxt ctxt `thenRn` \ result ->
486 (_, dup_asserts) = removeDups cmp_assert result
487 (alls, theta) = partition (\(c,_) -> c == allClass_NAME) result
488 non_tyvar_alls = [(c,t) | (c,t) <- alls, not (is_tyvar t)]
491 -- Check for duplicate assertions
492 -- If this isn't an error, then it ought to be:
493 mapRn (addWarnRn . dupClassAssertWarn theta) dup_asserts `thenRn_`
495 -- Check for All constraining a non-type-variable
496 mapRn (addWarnRn . allOfNonTyVar) non_tyvar_alls `thenRn_`
498 -- Done. Return a theta omitting all the "All" constraints.
499 -- They have done done their work by ensuring that we universally
500 -- quantify over their tyvar.
504 = -- Mini hack here. If the class is our pseudo-class "All",
505 -- then we don't want to record it as an occurrence, otherwise
506 -- we try to slurp it in later and it doesn't really exist at all.
507 -- Easiest thing is simply not to put it in the occurrence set.
508 lookupBndrRn clas `thenRn` \ clas_name ->
509 (if clas_name /= allClass_NAME then
510 addOccurrenceName Compulsory clas_name
514 rnHsType ty `thenRn` \ ty' ->
515 returnRn (clas_name, ty')
517 cmp_assert (c1,ty1) (c2,ty2)
518 = (c1 `cmp` c2) `thenCmp` (cmpHsType cmp ty1 ty2)
520 is_tyvar (MonoTyVar _) = True
521 is_tyvar other = False
525 %*********************************************************
529 %*********************************************************
532 rnIdInfo (HsStrictness strict)
533 = rnStrict strict `thenRn` \ strict' ->
534 returnRn (HsStrictness strict')
536 rnIdInfo (HsUnfold expr) = rnCoreExpr expr `thenRn` \ expr' ->
537 returnRn (HsUnfold expr')
538 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
539 rnIdInfo (HsUpdate update) = returnRn (HsUpdate update)
540 rnIdInfo (HsFBType fb) = returnRn (HsFBType fb)
541 rnIdInfo (HsArgUsage au) = returnRn (HsArgUsage au)
542 rnIdInfo (HsDeforest df) = returnRn (HsDeforest df)
544 rnStrict (StrictnessInfo demands (Just worker))
545 = lookupOptionalOccRn worker `thenRn` \ worker' ->
546 returnRn (StrictnessInfo demands (Just worker'))
548 -- Boring, but necessary for the type checker.
549 rnStrict (StrictnessInfo demands Nothing) = returnRn (StrictnessInfo demands Nothing)
550 rnStrict BottomGuaranteed = returnRn BottomGuaranteed
551 rnStrict NoStrictnessInfo = returnRn NoStrictnessInfo
558 = lookupOptionalOccRn v `thenRn` \ v' ->
561 rnCoreExpr (UfLit lit) = returnRn (UfLit lit)
563 rnCoreExpr (UfCon con args)
564 = lookupOptionalOccRn con `thenRn` \ con' ->
565 mapRn rnCoreArg args `thenRn` \ args' ->
566 returnRn (UfCon con' args')
568 rnCoreExpr (UfPrim prim args)
569 = rnCorePrim prim `thenRn` \ prim' ->
570 mapRn rnCoreArg args `thenRn` \ args' ->
571 returnRn (UfPrim prim' args')
573 rnCoreExpr (UfApp fun arg)
574 = rnCoreExpr fun `thenRn` \ fun' ->
575 rnCoreArg arg `thenRn` \ arg' ->
576 returnRn (UfApp fun' arg')
578 rnCoreExpr (UfCase scrut alts)
579 = rnCoreExpr scrut `thenRn` \ scrut' ->
580 rnCoreAlts alts `thenRn` \ alts' ->
581 returnRn (UfCase scrut' alts')
583 rnCoreExpr (UfSCC cc expr)
584 = rnCoreExpr expr `thenRn` \ expr' ->
585 returnRn (UfSCC cc expr')
587 rnCoreExpr(UfCoerce coercion ty body)
588 = rnCoercion coercion `thenRn` \ coercion' ->
589 rnHsType ty `thenRn` \ ty' ->
590 rnCoreExpr body `thenRn` \ body' ->
591 returnRn (UfCoerce coercion' ty' body')
593 rnCoreExpr (UfLam bndr body)
594 = rnCoreBndr bndr $ \ bndr' ->
595 rnCoreExpr body `thenRn` \ body' ->
596 returnRn (UfLam bndr' body')
598 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
599 = rnCoreExpr rhs `thenRn` \ rhs' ->
600 rnCoreBndr bndr $ \ bndr' ->
601 rnCoreExpr body `thenRn` \ body' ->
602 returnRn (UfLet (UfNonRec bndr' rhs') body')
604 rnCoreExpr (UfLet (UfRec pairs) body)
605 = rnCoreBndrs bndrs $ \ bndrs' ->
606 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
607 rnCoreExpr body `thenRn` \ body' ->
608 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
610 (bndrs, rhss) = unzip pairs
614 rnCoreBndr (UfValBinder name ty) thing_inside
615 = rnHsType ty `thenRn` \ ty' ->
616 bindLocalsRn "unfolding value" [name] $ \ [name'] ->
617 thing_inside (UfValBinder name' ty')
619 rnCoreBndr (UfTyBinder name kind) thing_inside
620 = bindLocalsRn "unfolding tyvar" [name] $ \ [name'] ->
621 thing_inside (UfTyBinder name' kind)
623 rnCoreBndr (UfUsageBinder name) thing_inside
624 = bindLocalsRn "unfolding usage" [name] $ \ [name'] ->
625 thing_inside (UfUsageBinder name')
627 rnCoreBndrs bndrs thing_inside -- Expect them all to be ValBinders
628 = mapRn rnHsType tys `thenRn` \ tys' ->
629 bindLocalsRn "unfolding value" names $ \ names' ->
630 thing_inside (zipWith UfValBinder names' tys')
632 names = map (\ (UfValBinder name _) -> name) bndrs
633 tys = map (\ (UfValBinder _ ty) -> ty) bndrs
635 rnCoreBndrNamess names thing_inside
636 = bindLocalsRn "unfolding value" names $ \ names' ->
641 rnCoreArg (UfVarArg v) = lookupOptionalOccRn v `thenRn` \ v' -> returnRn (UfVarArg v')
642 rnCoreArg (UfUsageArg u) = lookupOptionalOccRn u `thenRn` \ u' -> returnRn (UfUsageArg u')
643 rnCoreArg (UfTyArg ty) = rnHsType ty `thenRn` \ ty' -> returnRn (UfTyArg ty')
644 rnCoreArg (UfLitArg lit) = returnRn (UfLitArg lit)
646 rnCoreAlts (UfAlgAlts alts deflt)
647 = mapRn rn_alt alts `thenRn` \ alts' ->
648 rnCoreDefault deflt `thenRn` \ deflt' ->
649 returnRn (UfAlgAlts alts' deflt')
651 rn_alt (con, bndrs, rhs) = lookupOptionalOccRn con `thenRn` \ con' ->
652 bindLocalsRn "unfolding alt" bndrs $ \ bndrs' ->
653 rnCoreExpr rhs `thenRn` \ rhs' ->
654 returnRn (con', bndrs', rhs')
656 rnCoreAlts (UfPrimAlts alts deflt)
657 = mapRn rn_alt alts `thenRn` \ alts' ->
658 rnCoreDefault deflt `thenRn` \ deflt' ->
659 returnRn (UfPrimAlts alts' deflt')
661 rn_alt (lit, rhs) = rnCoreExpr rhs `thenRn` \ rhs' ->
664 rnCoreDefault UfNoDefault = returnRn UfNoDefault
665 rnCoreDefault (UfBindDefault bndr rhs) = bindLocalsRn "unfolding default" [bndr] $ \ [bndr'] ->
666 rnCoreExpr rhs `thenRn` \ rhs' ->
667 returnRn (UfBindDefault bndr' rhs')
669 rnCoercion (UfIn n) = lookupOptionalOccRn n `thenRn` \ n' -> returnRn (UfIn n')
670 rnCoercion (UfOut n) = lookupOptionalOccRn n `thenRn` \ n' -> returnRn (UfOut n')
672 rnCorePrim (UfOtherOp op)
673 = lookupOptionalOccRn op `thenRn` \ op' ->
674 returnRn (UfOtherOp op')
676 rnCorePrim (UfCCallOp str casm gc arg_tys res_ty)
677 = mapRn rnHsType arg_tys `thenRn` \ arg_tys' ->
678 rnHsType res_ty `thenRn` \ res_ty' ->
679 returnRn (UfCCallOp str casm gc arg_tys' res_ty')
682 %*********************************************************
686 %*********************************************************
689 derivingNonStdClassErr clas sty
690 = hsep [ptext SLIT("non-standard class in deriving:"), ppr sty clas]
692 classTyVarNotInOpTyErr clas_tyvar sig sty
693 = hang (hcat [ptext SLIT("Class type variable `"),
695 ptext SLIT("' does not appear in method signature:")])
698 classTyVarInOpCtxtErr clas_tyvar sig sty
699 = hang (hcat [ ptext SLIT("Class type variable `"), ppr sty clas_tyvar,
700 ptext SLIT("' present in method's local overloading context:")])
703 dupClassAssertWarn ctxt dups sty
704 = hang (hcat [ptext SLIT("Duplicate class assertion `"),
706 ptext SLIT("' in context:")])
710 = hsep [ptext SLIT("Illegal data constructor name:"), ppr sty name]
713 = hsep [ptext SLIT("`All' applied to a non-type variable:"), ppr sty ty]
715 ctxtErr doc tyvars sty
716 = hsep [ptext SLIT("Context constrains type variable(s)"),
717 hsep (punctuate comma (map (ppr sty) tyvars))]
718 $$ nest 4 (ptext SLIT("in") <+> doc sty)