2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[RnSource]{Main pass of renamer}
7 module RnSource ( rnDecl, rnHsType, rnHsSigType ) where
9 #include "HsVersions.h"
13 import HsDecls ( HsIdInfo(..), HsStrictnessInfo(..) )
15 import HsTypes ( getTyVarName, pprClassAssertion, cmpHsTypes )
19 import CmdLineOpts ( opt_IgnoreIfacePragmas )
21 import RnBinds ( rnTopBinds, rnMethodBinds )
22 import RnEnv ( bindTyVarsRn, lookupBndrRn, lookupOccRn, lookupImplicitOccRn, bindLocalsRn,
23 newDfunName, checkDupOrQualNames, checkDupNames,
24 newLocallyDefinedGlobalName, newImportedGlobalName, ifaceFlavour,
25 listType_RDR, tupleType_RDR )
28 import Name ( Name, OccName(..), occNameString, prefixOccName,
29 ExportFlag(..), Provenance(..), NameSet,
32 import FiniteMap ( lookupFM )
33 import Id ( GenId{-instance NamedThing-} )
34 import IdInfo ( FBTypeInfo, ArgUsageInfo )
35 import Lex ( isLexCon )
36 import PrelInfo ( derivingOccurrences, evalClass_RDR, numClass_RDR, allClass_NAME )
37 import Maybes ( maybeToBool )
38 import Bag ( bagToList )
40 import SrcLoc ( SrcLoc )
41 import Unique ( Unique )
42 import UniqSet ( UniqSet )
43 import UniqFM ( UniqFM, lookupUFM )
45 import List ( partition, nub )
48 rnDecl `renames' declarations.
49 It simultaneously performs dependency analysis and precedence parsing.
50 It also does the following error checks:
53 Checks that tyvars are used properly. This includes checking
54 for undefined tyvars, and tyvars in contexts that are ambiguous.
56 Checks that all variable occurences are defined.
58 Checks the (..) etc constraints in the export list.
62 %*********************************************************
64 \subsection{Value declarations}
66 %*********************************************************
69 rnDecl :: RdrNameHsDecl -> RnMS s RenamedHsDecl
71 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ new_binds ->
72 returnRn (ValD new_binds)
75 rnDecl (SigD (IfaceSig name ty id_infos loc))
77 lookupBndrRn name `thenRn` \ name' ->
78 rnHsType ty `thenRn` \ ty' ->
80 -- Get the pragma info (if any).
81 getModeRn `thenRn` \ (InterfaceMode _ print_unqual) ->
82 setModeRn (InterfaceMode Optional print_unqual) $
83 -- In all the rest of the signature we read in optional mode,
84 -- so that (a) we don't die
85 mapRn rnIdInfo id_infos `thenRn` \ id_infos' ->
86 returnRn (SigD (IfaceSig name' ty' id_infos' loc))
89 %*********************************************************
91 \subsection{Type declarations}
93 %*********************************************************
95 @rnTyDecl@ uses the `global name function' to create a new type
96 declaration in which local names have been replaced by their original
97 names, reporting any unknown names.
99 Renaming type variables is a pain. Because they now contain uniques,
100 it is necessary to pass in an association list which maps a parsed
101 tyvar to its Name representation. In some cases (type signatures of
102 values), it is even necessary to go over the type first in order to
103 get the set of tyvars used by it, make an assoc list, and then go over
104 it again to rename the tyvars! However, we can also do some scoping
105 checks at the same time.
108 rnDecl (TyD (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc))
109 = pushSrcLocRn src_loc $
110 lookupBndrRn tycon `thenRn` \ tycon' ->
111 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
112 rnContext context `thenRn` \ context' ->
113 checkDupOrQualNames data_doc con_names `thenRn_`
114 mapRn rnConDecl condecls `thenRn` \ condecls' ->
115 rnDerivs derivings `thenRn` \ derivings' ->
116 ASSERT(isNoDataPragmas pragmas)
117 returnRn (TyD (TyData new_or_data context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc))
119 data_doc = text "the data type declaration for" <+> ppr tycon
120 con_names = map conDeclName condecls
122 rnDecl (TyD (TySynonym name tyvars ty src_loc))
123 = pushSrcLocRn src_loc $
124 lookupBndrRn name `thenRn` \ name' ->
125 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
126 rnHsType ty `thenRn` \ ty' ->
127 returnRn (TyD (TySynonym name' tyvars' ty' src_loc))
129 syn_doc = text "the declaration for type synonym" <+> ppr name
132 %*********************************************************
134 \subsection{Class declarations}
136 %*********************************************************
138 @rnClassDecl@ uses the `global name function' to create a new
139 class declaration in which local names have been replaced by their
140 original names, reporting any unknown names.
143 rnDecl (ClD (ClassDecl context cname tyvars sigs mbinds pragmas tname dname src_loc))
144 = pushSrcLocRn src_loc $
146 lookupBndrRn cname `thenRn` \ cname' ->
147 lookupBndrRn tname `thenRn` \ tname' ->
148 lookupBndrRn dname `thenRn` \ dname' ->
150 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
151 rnContext context `thenRn` \ context' ->
153 -- Check the signatures
155 clas_tyvar_names = map getTyVarName tyvars'
157 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
158 mapRn (rn_op cname' clas_tyvar_names) sigs `thenRn` \ sigs' ->
159 returnRn (tyvars', context', sigs')
160 ) `thenRn` \ (tyvars', context', sigs') ->
163 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
164 rnMethodBinds mbinds `thenRn` \ mbinds' ->
166 -- Typechecker is responsible for checking that we only
167 -- give default-method bindings for things in this class.
168 -- The renamer *could* check this for class decls, but can't
169 -- for instance decls.
171 ASSERT(isNoClassPragmas pragmas)
172 returnRn (ClD (ClassDecl context' cname' tyvars' sigs' mbinds' NoClassPragmas tname' dname' src_loc))
174 cls_doc = text "the declaration for class" <+> ppr cname
175 sig_doc = text "the signatures for class" <+> ppr cname
176 meth_doc = text "the default-methods for class" <+> ppr cname
178 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
179 meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
180 meth_rdr_names = map fst meth_rdr_names_w_locs
182 rn_op clas clas_tyvars sig@(ClassOpSig op maybe_dm ty locn)
183 = pushSrcLocRn locn $
184 lookupBndrRn op `thenRn` \ op_name ->
185 rnHsSigType (quotes (ppr op)) ty `thenRn` \ new_ty ->
187 -- Make the default-method name
189 dm_occ = prefixOccName SLIT("$m") (rdrNameOcc op)
191 getModuleRn `thenRn` \ mod_name ->
192 getModeRn `thenRn` \ mode ->
193 (case (mode, maybe_dm) of
194 (SourceMode, _) | op `elem` meth_rdr_names
195 -> -- There's an explicit method decl
196 newLocallyDefinedGlobalName mod_name dm_occ
197 (\_ -> Exported) locn `thenRn` \ dm_name ->
198 returnRn (Just dm_name)
200 (InterfaceMode _ _, Just _)
201 -> -- Imported class that has a default method decl
202 newImportedGlobalName mod_name dm_occ (ifaceFlavour clas) `thenRn` \ dm_name ->
203 addOccurrenceName dm_name `thenRn_`
204 returnRn (Just dm_name)
206 other -> returnRn Nothing
207 ) `thenRn` \ maybe_dm_name ->
209 -- Check that each class tyvar appears in op_ty
211 (ctxt, op_ty) = case new_ty of
212 HsForAllTy tvs ctxt op_ty -> (ctxt, op_ty)
213 other -> ([], new_ty)
214 ctxt_fvs = extractHsCtxtTyNames ctxt -- Includes tycons/classes but we
215 op_ty_fvs = extractHsTyNames op_ty -- don't care about that
217 check_in_op_ty clas_tyvar = checkRn (clas_tyvar `elemNameSet` op_ty_fvs)
218 (classTyVarNotInOpTyErr clas_tyvar sig)
220 mapRn check_in_op_ty clas_tyvars `thenRn_`
222 returnRn (ClassOpSig op_name maybe_dm_name new_ty locn)
226 %*********************************************************
228 \subsection{Instance declarations}
230 %*********************************************************
233 rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc))
234 = pushSrcLocRn src_loc $
235 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ inst_ty' ->
238 -- Rename the bindings
239 -- NB meth_names can be qualified!
240 checkDupNames meth_doc meth_names `thenRn_`
241 rnMethodBinds mbinds `thenRn` \ mbinds' ->
242 mapRn rn_uprag uprags `thenRn` \ new_uprags ->
244 newDfunName maybe_dfun src_loc `thenRn` \ dfun_name ->
245 addOccurrenceName dfun_name `thenRn_`
246 -- The dfun is not optional, because we use its version number
247 -- to identify the version of the instance declaration
249 -- The typechecker checks that all the bindings are for the right class.
250 returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags (Just dfun_name) src_loc))
252 meth_doc = text "the bindings in an instance declaration"
253 meth_names = bagToList (collectMonoBinders mbinds)
255 rn_uprag (SpecSig op ty using locn)
256 = pushSrcLocRn src_loc $
257 lookupBndrRn op `thenRn` \ op_name ->
258 rnHsSigType (quotes (ppr op)) ty `thenRn` \ new_ty ->
259 rn_using using `thenRn` \ new_using ->
260 returnRn (SpecSig op_name new_ty new_using locn)
262 rn_uprag (InlineSig op locn)
263 = pushSrcLocRn locn $
264 lookupBndrRn op `thenRn` \ op_name ->
265 returnRn (InlineSig op_name locn)
267 rn_uprag (MagicUnfoldingSig op str locn)
268 = pushSrcLocRn locn $
269 lookupBndrRn op `thenRn` \ op_name ->
270 returnRn (MagicUnfoldingSig op_name str locn)
272 rn_using Nothing = returnRn Nothing
273 rn_using (Just v) = lookupOccRn v `thenRn` \ new_v ->
274 returnRn (Just new_v)
277 %*********************************************************
279 \subsection{Default declarations}
281 %*********************************************************
284 rnDecl (DefD (DefaultDecl tys src_loc))
285 = pushSrcLocRn src_loc $
286 mapRn rnHsType tys `thenRn` \ tys' ->
287 lookupImplicitOccRn numClass_RDR `thenRn_`
288 returnRn (DefD (DefaultDecl tys' src_loc))
291 %*********************************************************
293 \subsection{Support code for type/data declarations}
295 %*********************************************************
298 rnDerivs :: Maybe [RdrName] -> RnMS s (Maybe [Name])
300 rnDerivs Nothing -- derivs not specified
301 = lookupImplicitOccRn evalClass_RDR `thenRn_`
305 = lookupImplicitOccRn evalClass_RDR `thenRn_`
306 mapRn rn_deriv ds `thenRn` \ derivs ->
307 returnRn (Just derivs)
310 = lookupOccRn clas `thenRn` \ clas_name ->
312 -- Now add extra "occurrences" for things that
313 -- the deriving mechanism will later need in order to
314 -- generate code for this class.
315 case lookupUFM derivingOccurrences clas_name of
316 Nothing -> addErrRn (derivingNonStdClassErr clas_name) `thenRn_`
319 Just occs -> mapRn lookupImplicitOccRn occs `thenRn_`
324 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
325 conDeclName (ConDecl n _ _ l) = (n,l)
327 rnConDecl :: RdrNameConDecl -> RnMS s RenamedConDecl
328 rnConDecl (ConDecl name cxt details locn)
329 = pushSrcLocRn locn $
330 checkConName name `thenRn_`
331 lookupBndrRn name `thenRn` \ new_name ->
332 rnConDetails name locn details `thenRn` \ new_details ->
333 rnContext cxt `thenRn` \ new_context ->
334 returnRn (ConDecl new_name new_context new_details locn)
336 rnConDetails con locn (VanillaCon tys)
337 = mapRn rnBangTy tys `thenRn` \ new_tys ->
338 returnRn (VanillaCon new_tys)
340 rnConDetails con locn (InfixCon ty1 ty2)
341 = rnBangTy ty1 `thenRn` \ new_ty1 ->
342 rnBangTy ty2 `thenRn` \ new_ty2 ->
343 returnRn (InfixCon new_ty1 new_ty2)
345 rnConDetails con locn (NewCon ty)
346 = rnHsType ty `thenRn` \ new_ty ->
347 returnRn (NewCon new_ty)
349 rnConDetails con locn (RecCon fields)
350 = checkDupOrQualNames fld_doc field_names `thenRn_`
351 mapRn rnField fields `thenRn` \ new_fields ->
352 returnRn (RecCon new_fields)
354 fld_doc = text "the fields of constructor" <> ppr con
355 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
358 = mapRn lookupBndrRn names `thenRn` \ new_names ->
359 rnBangTy ty `thenRn` \ new_ty ->
360 returnRn (new_names, new_ty)
363 = rnHsType ty `thenRn` \ new_ty ->
364 returnRn (Banged new_ty)
366 rnBangTy (Unbanged ty)
367 = rnHsType ty `thenRn` \ new_ty ->
368 returnRn (Unbanged new_ty)
370 -- This data decl will parse OK
372 -- treating "a" as the constructor.
373 -- It is really hard to make the parser spot this malformation.
374 -- So the renamer has to check that the constructor is legal
376 -- We can get an operator as the constructor, even in the prefix form:
377 -- data T = :% Int Int
378 -- from interface files, which always print in prefix form
381 = checkRn (isLexCon (occNameString (rdrNameOcc name)))
386 %*********************************************************
388 \subsection{Support code to rename types}
390 %*********************************************************
393 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS s RenamedHsType
394 -- rnHsSigType is used for source-language type signatures,
395 -- which use *implicit* universal quantification.
397 -- Given the signature C => T we universally quantify over FV(T) \ {in-scope-tyvars}
399 -- We insist that the universally quantified type vars is a superset of FV(C)
400 -- It follows that FV(T) is a superset of FV(C), so that the context constrains
401 -- no type variables that don't appear free in the tau-type part.
403 rnHsSigType doc_str full_ty@(HsPreForAllTy ctxt ty) -- From source code (no kinds on tyvars)
404 = getLocalNameEnv `thenRn` \ name_env ->
406 mentioned_tyvars = extractHsTyVars ty
407 forall_tyvars = filter (not . in_scope) mentioned_tyvars
408 in_scope tv = maybeToBool (lookupFM name_env tv)
410 constrained_tyvars = extractHsCtxtTyVars ctxt
411 constrained_and_in_scope = filter in_scope constrained_tyvars
412 constrained_and_not_mentioned = filter (not . (`elem` mentioned_tyvars)) constrained_tyvars
414 -- Zap the context if there's a problem, to avoid duplicate error message.
415 ctxt' | null constrained_and_in_scope && null constrained_and_not_mentioned = ctxt
418 checkRn (null constrained_and_in_scope)
419 (ctxtErr1 sig_doc constrained_and_in_scope) `thenRn_`
420 checkRn (null constrained_and_not_mentioned)
421 (ctxtErr2 sig_doc constrained_and_not_mentioned ty) `thenRn_`
423 (bindTyVarsRn sig_doc (map UserTyVar forall_tyvars) $ \ new_tyvars ->
424 rnContext ctxt' `thenRn` \ new_ctxt ->
425 rnHsType ty `thenRn` \ new_ty ->
426 returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
429 sig_doc = text "the type signature for" <+> doc_str
432 rnHsSigType doc_str other_ty = rnHsType other_ty
434 rnHsType :: RdrNameHsType -> RnMS s RenamedHsType
435 rnHsType (HsForAllTy tvs ctxt ty) -- From an interface file (tyvars may be kinded)
436 = rn_poly_help tvs ctxt ty
438 rnHsType full_ty@(HsPreForAllTy ctxt ty) -- A (context => ty) embedded in a type.
439 -- Universally quantify over tyvars in context
440 = getLocalNameEnv `thenRn` \ name_env ->
442 forall_tyvars = extractHsCtxtTyVars ctxt
444 rn_poly_help (map UserTyVar forall_tyvars) ctxt ty
446 rnHsType (MonoTyVar tyvar)
447 = lookupOccRn tyvar `thenRn` \ tyvar' ->
448 returnRn (MonoTyVar tyvar')
450 rnHsType (MonoFunTy ty1 ty2)
451 = andRn MonoFunTy (rnHsType ty1) (rnHsType ty2)
453 rnHsType (MonoListTy _ ty)
454 = lookupImplicitOccRn listType_RDR `thenRn` \ tycon_name ->
455 rnHsType ty `thenRn` \ ty' ->
456 returnRn (MonoListTy tycon_name ty')
458 rnHsType (MonoTupleTy _ tys)
459 = lookupImplicitOccRn (tupleType_RDR (length tys)) `thenRn` \ tycon_name ->
460 mapRn rnHsType tys `thenRn` \ tys' ->
461 returnRn (MonoTupleTy tycon_name tys')
463 rnHsType (MonoTyApp ty1 ty2)
464 = rnHsType ty1 `thenRn` \ ty1' ->
465 rnHsType ty2 `thenRn` \ ty2' ->
466 returnRn (MonoTyApp ty1' ty2')
468 rnHsType (MonoDictTy clas tys)
469 = lookupOccRn clas `thenRn` \ clas' ->
470 mapRn rnHsType tys `thenRn` \ tys' ->
471 returnRn (MonoDictTy clas' tys')
473 rn_poly_help :: [HsTyVar RdrName] -- Universally quantified tyvars
476 -> RnMS s RenamedHsType
477 rn_poly_help tyvars ctxt ty
478 = bindTyVarsRn sig_doc tyvars $ \ new_tyvars ->
479 rnContext ctxt `thenRn` \ new_ctxt ->
480 rnHsType ty `thenRn` \ new_ty ->
481 returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
483 sig_doc = text "a nested for-all type"
488 rnContext :: RdrNameContext -> RnMS s RenamedContext
491 = mapRn rn_ctxt ctxt `thenRn` \ result ->
493 (_, dup_asserts) = removeDups cmp_assert result
494 (alls, theta) = partition (\(c,_) -> c == allClass_NAME) result
497 -- Check for duplicate assertions
498 -- If this isn't an error, then it ought to be:
499 mapRn (addWarnRn . dupClassAssertWarn theta) dup_asserts `thenRn_`
501 -- Check for All constraining a non-type-variable
502 mapRn check_All alls `thenRn_`
504 -- Done. Return a theta omitting all the "All" constraints.
505 -- They have done done their work by ensuring that we universally
506 -- quantify over their tyvar.
510 = -- Mini hack here. If the class is our pseudo-class "All",
511 -- then we don't want to record it as an occurrence, otherwise
512 -- we try to slurp it in later and it doesn't really exist at all.
513 -- Easiest thing is simply not to put it in the occurrence set.
514 lookupBndrRn clas `thenRn` \ clas_name ->
515 (if clas_name /= allClass_NAME then
516 addOccurrenceName clas_name
520 mapRn rnHsType tys `thenRn` \ tys' ->
521 returnRn (clas_name, tys')
524 cmp_assert (c1,tys1) (c2,tys2)
525 = (c1 `compare` c2) `thenCmp` (cmpHsTypes compare tys1 tys2)
527 check_All (c, [MonoTyVar _]) = returnRn () -- OK!
528 check_All assertion = addErrRn (wierdAllErr assertion)
532 %*********************************************************
536 %*********************************************************
539 rnIdInfo (HsStrictness strict)
540 = rnStrict strict `thenRn` \ strict' ->
541 returnRn (HsStrictness strict')
543 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
544 returnRn (HsUnfold inline expr')
545 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
546 rnIdInfo (HsUpdate update) = returnRn (HsUpdate update)
547 rnIdInfo (HsFBType fb) = returnRn (HsFBType fb)
548 rnIdInfo (HsArgUsage au) = returnRn (HsArgUsage au)
550 rnStrict (HsStrictnessInfo demands (Just (worker,cons)))
551 -- The sole purpose of the "cons" field is so that we can mark the constructors
552 -- needed to build the wrapper as "needed", so that their data type decl will be
553 -- slurped in. After that their usefulness is o'er, so we just put in the empty list.
554 = lookupOccRn worker `thenRn` \ worker' ->
555 mapRn lookupOccRn cons `thenRn_`
556 returnRn (HsStrictnessInfo demands (Just (worker',[])))
558 -- Boring, but necessary for the type checker.
559 rnStrict (HsStrictnessInfo demands Nothing) = returnRn (HsStrictnessInfo demands Nothing)
560 rnStrict HsBottom = returnRn HsBottom
567 = lookupOccRn v `thenRn` \ v' ->
570 rnCoreExpr (UfLit lit) = returnRn (UfLit lit)
572 rnCoreExpr (UfCon con args)
573 = lookupOccRn con `thenRn` \ con' ->
574 mapRn rnCoreArg args `thenRn` \ args' ->
575 returnRn (UfCon con' args')
577 rnCoreExpr (UfPrim prim args)
578 = rnCorePrim prim `thenRn` \ prim' ->
579 mapRn rnCoreArg args `thenRn` \ args' ->
580 returnRn (UfPrim prim' args')
582 rnCoreExpr (UfApp fun arg)
583 = rnCoreExpr fun `thenRn` \ fun' ->
584 rnCoreArg arg `thenRn` \ arg' ->
585 returnRn (UfApp fun' arg')
587 rnCoreExpr (UfCase scrut alts)
588 = rnCoreExpr scrut `thenRn` \ scrut' ->
589 rnCoreAlts alts `thenRn` \ alts' ->
590 returnRn (UfCase scrut' alts')
592 rnCoreExpr (UfSCC cc expr)
593 = rnCoreExpr expr `thenRn` \ expr' ->
594 returnRn (UfSCC cc expr')
596 rnCoreExpr(UfCoerce coercion ty body)
597 = rnCoercion coercion `thenRn` \ coercion' ->
598 rnHsType ty `thenRn` \ ty' ->
599 rnCoreExpr body `thenRn` \ body' ->
600 returnRn (UfCoerce coercion' ty' body')
602 rnCoreExpr (UfLam bndr body)
603 = rnCoreBndr bndr $ \ bndr' ->
604 rnCoreExpr body `thenRn` \ body' ->
605 returnRn (UfLam bndr' body')
607 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
608 = rnCoreExpr rhs `thenRn` \ rhs' ->
609 rnCoreBndr bndr $ \ bndr' ->
610 rnCoreExpr body `thenRn` \ body' ->
611 returnRn (UfLet (UfNonRec bndr' rhs') body')
613 rnCoreExpr (UfLet (UfRec pairs) body)
614 = rnCoreBndrs bndrs $ \ bndrs' ->
615 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
616 rnCoreExpr body `thenRn` \ body' ->
617 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
619 (bndrs, rhss) = unzip pairs
623 rnCoreBndr (UfValBinder name ty) thing_inside
624 = rnHsType ty `thenRn` \ ty' ->
625 bindLocalsRn "unfolding value" [name] $ \ [name'] ->
626 thing_inside (UfValBinder name' ty')
628 rnCoreBndr (UfTyBinder name kind) thing_inside
629 = bindLocalsRn "unfolding tyvar" [name] $ \ [name'] ->
630 thing_inside (UfTyBinder name' kind)
632 rnCoreBndrs bndrs thing_inside -- Expect them all to be ValBinders
633 = mapRn rnHsType tys `thenRn` \ tys' ->
634 bindLocalsRn "unfolding value" names $ \ names' ->
635 thing_inside (zipWith UfValBinder names' tys')
637 names = map (\ (UfValBinder name _) -> name) bndrs
638 tys = map (\ (UfValBinder _ ty) -> ty) bndrs
640 rnCoreBndrNamess names thing_inside
641 = bindLocalsRn "unfolding value" names $ \ names' ->
646 rnCoreArg (UfVarArg v) = lookupOccRn v `thenRn` \ v' -> returnRn (UfVarArg v')
647 rnCoreArg (UfTyArg ty) = rnHsType ty `thenRn` \ ty' -> returnRn (UfTyArg ty')
648 rnCoreArg (UfLitArg lit) = returnRn (UfLitArg lit)
650 rnCoreAlts (UfAlgAlts alts deflt)
651 = mapRn rn_alt alts `thenRn` \ alts' ->
652 rnCoreDefault deflt `thenRn` \ deflt' ->
653 returnRn (UfAlgAlts alts' deflt')
655 rn_alt (con, bndrs, rhs) = lookupOccRn con `thenRn` \ con' ->
656 bindLocalsRn "unfolding alt" bndrs $ \ bndrs' ->
657 rnCoreExpr rhs `thenRn` \ rhs' ->
658 returnRn (con', bndrs', rhs')
660 rnCoreAlts (UfPrimAlts alts deflt)
661 = mapRn rn_alt alts `thenRn` \ alts' ->
662 rnCoreDefault deflt `thenRn` \ deflt' ->
663 returnRn (UfPrimAlts alts' deflt')
665 rn_alt (lit, rhs) = rnCoreExpr rhs `thenRn` \ rhs' ->
668 rnCoreDefault UfNoDefault = returnRn UfNoDefault
669 rnCoreDefault (UfBindDefault bndr rhs) = bindLocalsRn "unfolding default" [bndr] $ \ [bndr'] ->
670 rnCoreExpr rhs `thenRn` \ rhs' ->
671 returnRn (UfBindDefault bndr' rhs')
673 rnCoercion (UfIn n) = lookupOccRn n `thenRn` \ n' -> returnRn (UfIn n')
674 rnCoercion (UfOut n) = lookupOccRn n `thenRn` \ n' -> returnRn (UfOut n')
676 rnCorePrim (UfOtherOp op)
677 = lookupOccRn op `thenRn` \ op' ->
678 returnRn (UfOtherOp op')
680 rnCorePrim (UfCCallOp str casm gc arg_tys res_ty)
681 = mapRn rnHsType arg_tys `thenRn` \ arg_tys' ->
682 rnHsType res_ty `thenRn` \ res_ty' ->
683 returnRn (UfCCallOp str casm gc arg_tys' res_ty')
686 %*********************************************************
690 %*********************************************************
693 derivingNonStdClassErr clas
694 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
696 classTyVarNotInOpTyErr clas_tyvar sig
697 = hang (hsep [ptext SLIT("Class type variable"),
698 quotes (ppr clas_tyvar),
699 ptext SLIT("does not appear in method signature")])
702 dupClassAssertWarn ctxt (assertion : dups)
703 = sep [hsep [ptext SLIT("Duplicated class assertion"),
704 quotes (pprClassAssertion assertion),
705 ptext SLIT("in the context:")],
706 nest 4 (pprContext ctxt)]
709 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
711 wierdAllErr assertion
712 = ptext SLIT("Mal-formed use of `All':") <+> pprClassAssertion assertion
715 = hsep [ptext SLIT("Context constrains in-scope type variable(s)"),
716 pprQuotedList tyvars]
718 nest 4 (ptext SLIT("in") <+> doc)
720 ctxtErr2 doc tyvars ty
721 = (ptext SLIT("Context constrains type variable(s)")
722 <+> pprQuotedList tyvars)
724 nest 4 (vcat [ptext SLIT("that do not appear in") <+> quotes (ppr ty),
725 ptext SLIT("in") <+> doc])