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,
30 elemNameSet, nameOccName, NamedThing(..)
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 ->
245 -- We use the class name and the name of the first
246 -- type constructor the class is applied to.
247 (cl_nm, tycon_nm) = mkDictPrefix inst_ty'
249 mkDictPrefix (MonoDictTy cl tys) =
251 [] -> (c_nm, nilOccName )
252 (ty:_) -> (c_nm, getInstHeadTy ty)
254 c_nm = nameOccName (getName cl)
256 mkDictPrefix (HsPreForAllTy _ ty) = mkDictPrefix ty
257 mkDictPrefix (HsForAllTy _ _ ty) = mkDictPrefix ty -- can this
258 mkDictPrefix _ = (nilOccName, nilOccName)
262 MonoTyVar tv -> nameOccName (getName tv)
263 MonoTyApp t _ -> getInstHeadTy t
265 -- I cannot see how the rest of HsType constructors
266 -- can occur, but this isn't really a failure condition,
267 -- so we return silently.
269 nilOccName = (VarOcc _NIL_) -- ToDo: add OccName constructor fun for this.
271 newDfunName cl_nm tycon_nm maybe_dfun src_loc `thenRn` \ dfun_name ->
272 addOccurrenceName dfun_name `thenRn_`
273 -- The dfun is not optional, because we use its version number
274 -- to identify the version of the instance declaration
276 -- The typechecker checks that all the bindings are for the right class.
277 returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags (Just dfun_name) src_loc))
279 meth_doc = text "the bindings in an instance declaration"
280 meth_names = bagToList (collectMonoBinders mbinds)
282 rn_uprag (SpecSig op ty using locn)
283 = pushSrcLocRn src_loc $
284 lookupBndrRn op `thenRn` \ op_name ->
285 rnHsSigType (quotes (ppr op)) ty `thenRn` \ new_ty ->
286 rn_using using `thenRn` \ new_using ->
287 returnRn (SpecSig op_name new_ty new_using locn)
289 rn_uprag (InlineSig op locn)
290 = pushSrcLocRn locn $
291 lookupBndrRn op `thenRn` \ op_name ->
292 returnRn (InlineSig op_name locn)
294 rn_uprag (MagicUnfoldingSig op str locn)
295 = pushSrcLocRn locn $
296 lookupBndrRn op `thenRn` \ op_name ->
297 returnRn (MagicUnfoldingSig op_name str locn)
299 rn_using Nothing = returnRn Nothing
300 rn_using (Just v) = lookupOccRn v `thenRn` \ new_v ->
301 returnRn (Just new_v)
304 %*********************************************************
306 \subsection{Default declarations}
308 %*********************************************************
311 rnDecl (DefD (DefaultDecl tys src_loc))
312 = pushSrcLocRn src_loc $
313 mapRn rnHsType tys `thenRn` \ tys' ->
314 lookupImplicitOccRn numClass_RDR `thenRn_`
315 returnRn (DefD (DefaultDecl tys' src_loc))
318 %*********************************************************
320 \subsection{Support code for type/data declarations}
322 %*********************************************************
325 rnDerivs :: Maybe [RdrName] -> RnMS s (Maybe [Name])
327 rnDerivs Nothing -- derivs not specified
328 = lookupImplicitOccRn evalClass_RDR `thenRn_`
332 = lookupImplicitOccRn evalClass_RDR `thenRn_`
333 mapRn rn_deriv ds `thenRn` \ derivs ->
334 returnRn (Just derivs)
337 = lookupOccRn clas `thenRn` \ clas_name ->
339 -- Now add extra "occurrences" for things that
340 -- the deriving mechanism will later need in order to
341 -- generate code for this class.
342 case lookupUFM derivingOccurrences clas_name of
343 Nothing -> addErrRn (derivingNonStdClassErr clas_name) `thenRn_`
346 Just occs -> mapRn lookupImplicitOccRn occs `thenRn_`
351 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
352 conDeclName (ConDecl n _ _ l) = (n,l)
354 rnConDecl :: RdrNameConDecl -> RnMS s RenamedConDecl
355 rnConDecl (ConDecl name cxt details locn)
356 = pushSrcLocRn locn $
357 checkConName name `thenRn_`
358 lookupBndrRn name `thenRn` \ new_name ->
359 rnConDetails name locn details `thenRn` \ new_details ->
360 rnContext cxt `thenRn` \ new_context ->
361 returnRn (ConDecl new_name new_context new_details locn)
363 rnConDetails con locn (VanillaCon tys)
364 = mapRn rnBangTy tys `thenRn` \ new_tys ->
365 returnRn (VanillaCon new_tys)
367 rnConDetails con locn (InfixCon ty1 ty2)
368 = rnBangTy ty1 `thenRn` \ new_ty1 ->
369 rnBangTy ty2 `thenRn` \ new_ty2 ->
370 returnRn (InfixCon new_ty1 new_ty2)
372 rnConDetails con locn (NewCon ty)
373 = rnHsType ty `thenRn` \ new_ty ->
374 returnRn (NewCon new_ty)
376 rnConDetails con locn (RecCon fields)
377 = checkDupOrQualNames fld_doc field_names `thenRn_`
378 mapRn rnField fields `thenRn` \ new_fields ->
379 returnRn (RecCon new_fields)
381 fld_doc = text "the fields of constructor" <> ppr con
382 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
385 = mapRn lookupBndrRn names `thenRn` \ new_names ->
386 rnBangTy ty `thenRn` \ new_ty ->
387 returnRn (new_names, new_ty)
390 = rnHsType ty `thenRn` \ new_ty ->
391 returnRn (Banged new_ty)
393 rnBangTy (Unbanged ty)
394 = rnHsType ty `thenRn` \ new_ty ->
395 returnRn (Unbanged new_ty)
397 -- This data decl will parse OK
399 -- treating "a" as the constructor.
400 -- It is really hard to make the parser spot this malformation.
401 -- So the renamer has to check that the constructor is legal
403 -- We can get an operator as the constructor, even in the prefix form:
404 -- data T = :% Int Int
405 -- from interface files, which always print in prefix form
408 = checkRn (isLexCon (occNameString (rdrNameOcc name)))
413 %*********************************************************
415 \subsection{Support code to rename types}
417 %*********************************************************
420 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS s RenamedHsType
421 -- rnHsSigType is used for source-language type signatures,
422 -- which use *implicit* universal quantification.
424 -- Given the signature C => T we universally quantify over FV(T) \ {in-scope-tyvars}
426 -- We insist that the universally quantified type vars is a superset of FV(C)
427 -- It follows that FV(T) is a superset of FV(C), so that the context constrains
428 -- no type variables that don't appear free in the tau-type part.
430 rnHsSigType doc_str full_ty@(HsPreForAllTy ctxt ty) -- From source code (no kinds on tyvars)
431 = getLocalNameEnv `thenRn` \ name_env ->
433 mentioned_tyvars = extractHsTyVars ty
434 forall_tyvars = filter (not . in_scope) mentioned_tyvars
435 in_scope tv = maybeToBool (lookupFM name_env tv)
437 constrained_tyvars = extractHsCtxtTyVars ctxt
438 constrained_and_in_scope = filter in_scope constrained_tyvars
439 constrained_and_not_mentioned = filter (not . (`elem` mentioned_tyvars)) constrained_tyvars
441 -- Zap the context if there's a problem, to avoid duplicate error message.
442 ctxt' | null constrained_and_in_scope && null constrained_and_not_mentioned = ctxt
445 checkRn (null constrained_and_in_scope)
446 (ctxtErr1 sig_doc constrained_and_in_scope) `thenRn_`
447 checkRn (null constrained_and_not_mentioned)
448 (ctxtErr2 sig_doc constrained_and_not_mentioned ty) `thenRn_`
450 (bindTyVarsRn sig_doc (map UserTyVar forall_tyvars) $ \ new_tyvars ->
451 rnContext ctxt' `thenRn` \ new_ctxt ->
452 rnHsType ty `thenRn` \ new_ty ->
453 returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
456 sig_doc = text "the type signature for" <+> doc_str
459 rnHsSigType doc_str other_ty = rnHsType other_ty
461 rnHsType :: RdrNameHsType -> RnMS s RenamedHsType
462 rnHsType (HsForAllTy tvs ctxt ty) -- From an interface file (tyvars may be kinded)
463 = rn_poly_help tvs ctxt ty
465 rnHsType full_ty@(HsPreForAllTy ctxt ty) -- A (context => ty) embedded in a type.
466 -- Universally quantify over tyvars in context
467 = getLocalNameEnv `thenRn` \ name_env ->
469 forall_tyvars = extractHsCtxtTyVars ctxt
471 rn_poly_help (map UserTyVar forall_tyvars) ctxt ty
473 rnHsType (MonoTyVar tyvar)
474 = lookupOccRn tyvar `thenRn` \ tyvar' ->
475 returnRn (MonoTyVar tyvar')
477 rnHsType (MonoFunTy ty1 ty2)
478 = andRn MonoFunTy (rnHsType ty1) (rnHsType ty2)
480 rnHsType (MonoListTy _ ty)
481 = lookupImplicitOccRn listType_RDR `thenRn` \ tycon_name ->
482 rnHsType ty `thenRn` \ ty' ->
483 returnRn (MonoListTy tycon_name ty')
485 rnHsType (MonoTupleTy _ tys)
486 = lookupImplicitOccRn (tupleType_RDR (length tys)) `thenRn` \ tycon_name ->
487 mapRn rnHsType tys `thenRn` \ tys' ->
488 returnRn (MonoTupleTy tycon_name tys')
490 rnHsType (MonoTyApp ty1 ty2)
491 = rnHsType ty1 `thenRn` \ ty1' ->
492 rnHsType ty2 `thenRn` \ ty2' ->
493 returnRn (MonoTyApp ty1' ty2')
495 rnHsType (MonoDictTy clas tys)
496 = lookupOccRn clas `thenRn` \ clas' ->
497 mapRn rnHsType tys `thenRn` \ tys' ->
498 returnRn (MonoDictTy clas' tys')
500 rn_poly_help :: [HsTyVar RdrName] -- Universally quantified tyvars
503 -> RnMS s RenamedHsType
504 rn_poly_help tyvars ctxt ty
505 = bindTyVarsRn sig_doc tyvars $ \ new_tyvars ->
506 rnContext ctxt `thenRn` \ new_ctxt ->
507 rnHsType ty `thenRn` \ new_ty ->
508 returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
510 sig_doc = text "a nested for-all type"
515 rnContext :: RdrNameContext -> RnMS s RenamedContext
518 = mapRn rn_ctxt ctxt `thenRn` \ result ->
520 (_, dup_asserts) = removeDups cmp_assert result
521 (alls, theta) = partition (\(c,_) -> c == allClass_NAME) result
524 -- Check for duplicate assertions
525 -- If this isn't an error, then it ought to be:
526 mapRn (addWarnRn . dupClassAssertWarn theta) dup_asserts `thenRn_`
528 -- Check for All constraining a non-type-variable
529 mapRn check_All alls `thenRn_`
531 -- Done. Return a theta omitting all the "All" constraints.
532 -- They have done done their work by ensuring that we universally
533 -- quantify over their tyvar.
537 = -- Mini hack here. If the class is our pseudo-class "All",
538 -- then we don't want to record it as an occurrence, otherwise
539 -- we try to slurp it in later and it doesn't really exist at all.
540 -- Easiest thing is simply not to put it in the occurrence set.
541 lookupBndrRn clas `thenRn` \ clas_name ->
542 (if clas_name /= allClass_NAME then
543 addOccurrenceName clas_name
547 mapRn rnHsType tys `thenRn` \ tys' ->
548 returnRn (clas_name, tys')
551 cmp_assert (c1,tys1) (c2,tys2)
552 = (c1 `compare` c2) `thenCmp` (cmpHsTypes compare tys1 tys2)
554 check_All (c, [MonoTyVar _]) = returnRn () -- OK!
555 check_All assertion = addErrRn (wierdAllErr assertion)
559 %*********************************************************
563 %*********************************************************
566 rnIdInfo (HsStrictness strict)
567 = rnStrict strict `thenRn` \ strict' ->
568 returnRn (HsStrictness strict')
570 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
571 returnRn (HsUnfold inline expr')
572 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
573 rnIdInfo (HsUpdate update) = returnRn (HsUpdate update)
574 rnIdInfo (HsFBType fb) = returnRn (HsFBType fb)
575 rnIdInfo (HsArgUsage au) = returnRn (HsArgUsage au)
577 rnStrict (HsStrictnessInfo demands (Just (worker,cons)))
578 -- The sole purpose of the "cons" field is so that we can mark the constructors
579 -- needed to build the wrapper as "needed", so that their data type decl will be
580 -- slurped in. After that their usefulness is o'er, so we just put in the empty list.
581 = lookupOccRn worker `thenRn` \ worker' ->
582 mapRn lookupOccRn cons `thenRn_`
583 returnRn (HsStrictnessInfo demands (Just (worker',[])))
585 -- Boring, but necessary for the type checker.
586 rnStrict (HsStrictnessInfo demands Nothing) = returnRn (HsStrictnessInfo demands Nothing)
587 rnStrict HsBottom = returnRn HsBottom
594 = lookupOccRn v `thenRn` \ v' ->
597 rnCoreExpr (UfLit lit) = returnRn (UfLit lit)
599 rnCoreExpr (UfCon con args)
600 = lookupOccRn con `thenRn` \ con' ->
601 mapRn rnCoreArg args `thenRn` \ args' ->
602 returnRn (UfCon con' args')
604 rnCoreExpr (UfPrim prim args)
605 = rnCorePrim prim `thenRn` \ prim' ->
606 mapRn rnCoreArg args `thenRn` \ args' ->
607 returnRn (UfPrim prim' args')
609 rnCoreExpr (UfApp fun arg)
610 = rnCoreExpr fun `thenRn` \ fun' ->
611 rnCoreArg arg `thenRn` \ arg' ->
612 returnRn (UfApp fun' arg')
614 rnCoreExpr (UfCase scrut alts)
615 = rnCoreExpr scrut `thenRn` \ scrut' ->
616 rnCoreAlts alts `thenRn` \ alts' ->
617 returnRn (UfCase scrut' alts')
619 rnCoreExpr (UfNote note expr)
620 = rnNote note `thenRn` \ note' ->
621 rnCoreExpr expr `thenRn` \ expr' ->
622 returnRn (UfNote note' expr')
624 rnCoreExpr (UfLam bndr body)
625 = rnCoreBndr bndr $ \ bndr' ->
626 rnCoreExpr body `thenRn` \ body' ->
627 returnRn (UfLam bndr' body')
629 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
630 = rnCoreExpr rhs `thenRn` \ rhs' ->
631 rnCoreBndr bndr $ \ bndr' ->
632 rnCoreExpr body `thenRn` \ body' ->
633 returnRn (UfLet (UfNonRec bndr' rhs') body')
635 rnCoreExpr (UfLet (UfRec pairs) body)
636 = rnCoreBndrs bndrs $ \ bndrs' ->
637 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
638 rnCoreExpr body `thenRn` \ body' ->
639 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
641 (bndrs, rhss) = unzip pairs
645 rnCoreBndr (UfValBinder name ty) thing_inside
646 = rnHsType ty `thenRn` \ ty' ->
647 bindLocalsRn "unfolding value" [name] $ \ [name'] ->
648 thing_inside (UfValBinder name' ty')
650 rnCoreBndr (UfTyBinder name kind) thing_inside
651 = bindLocalsRn "unfolding tyvar" [name] $ \ [name'] ->
652 thing_inside (UfTyBinder name' kind)
654 rnCoreBndrs bndrs thing_inside -- Expect them all to be ValBinders
655 = mapRn rnHsType tys `thenRn` \ tys' ->
656 bindLocalsRn "unfolding value" names $ \ names' ->
657 thing_inside (zipWith UfValBinder names' tys')
659 names = map (\ (UfValBinder name _) -> name) bndrs
660 tys = map (\ (UfValBinder _ ty) -> ty) bndrs
662 rnCoreBndrNamess names thing_inside
663 = bindLocalsRn "unfolding value" names $ \ names' ->
668 rnCoreArg (UfVarArg v) = lookupOccRn v `thenRn` \ v' -> returnRn (UfVarArg v')
669 rnCoreArg (UfTyArg ty) = rnHsType ty `thenRn` \ ty' -> returnRn (UfTyArg ty')
670 rnCoreArg (UfLitArg lit) = returnRn (UfLitArg lit)
672 rnCoreAlts (UfAlgAlts alts deflt)
673 = mapRn rn_alt alts `thenRn` \ alts' ->
674 rnCoreDefault deflt `thenRn` \ deflt' ->
675 returnRn (UfAlgAlts alts' deflt')
677 rn_alt (con, bndrs, rhs) = lookupOccRn con `thenRn` \ con' ->
678 bindLocalsRn "unfolding alt" bndrs $ \ bndrs' ->
679 rnCoreExpr rhs `thenRn` \ rhs' ->
680 returnRn (con', bndrs', rhs')
682 rnCoreAlts (UfPrimAlts alts deflt)
683 = mapRn rn_alt alts `thenRn` \ alts' ->
684 rnCoreDefault deflt `thenRn` \ deflt' ->
685 returnRn (UfPrimAlts alts' deflt')
687 rn_alt (lit, rhs) = rnCoreExpr rhs `thenRn` \ rhs' ->
690 rnCoreDefault UfNoDefault = returnRn UfNoDefault
691 rnCoreDefault (UfBindDefault bndr rhs) = bindLocalsRn "unfolding default" [bndr] $ \ [bndr'] ->
692 rnCoreExpr rhs `thenRn` \ rhs' ->
693 returnRn (UfBindDefault bndr' rhs')
696 = rnHsType ty `thenRn` \ ty' ->
697 returnRn (UfCoerce ty')
699 rnNote (UfSCC cc) = returnRn (UfSCC cc)
700 rnNote UfInlineCall = returnRn UfInlineCall
702 rnCorePrim (UfOtherOp op)
703 = lookupOccRn op `thenRn` \ op' ->
704 returnRn (UfOtherOp op')
706 rnCorePrim (UfCCallOp str casm gc arg_tys res_ty)
707 = mapRn rnHsType arg_tys `thenRn` \ arg_tys' ->
708 rnHsType res_ty `thenRn` \ res_ty' ->
709 returnRn (UfCCallOp str casm gc arg_tys' res_ty')
712 %*********************************************************
716 %*********************************************************
719 derivingNonStdClassErr clas
720 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
722 classTyVarNotInOpTyErr clas_tyvar sig
723 = hang (hsep [ptext SLIT("Class type variable"),
724 quotes (ppr clas_tyvar),
725 ptext SLIT("does not appear in method signature")])
728 dupClassAssertWarn ctxt (assertion : dups)
729 = sep [hsep [ptext SLIT("Duplicated class assertion"),
730 quotes (pprClassAssertion assertion),
731 ptext SLIT("in the context:")],
732 nest 4 (pprContext ctxt)]
735 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
737 wierdAllErr assertion
738 = ptext SLIT("Mal-formed use of `All':") <+> pprClassAssertion assertion
741 = hsep [ptext SLIT("Context constrains in-scope type variable(s)"),
742 pprQuotedList tyvars]
744 nest 4 (ptext SLIT("in") <+> doc)
746 ctxtErr2 doc tyvars ty
747 = (ptext SLIT("Context constrains type variable(s)")
748 <+> pprQuotedList tyvars)
750 nest 4 (vcat [ptext SLIT("that do not appear in") <+> quotes (ppr ty),
751 ptext SLIT("in") <+> doc])