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, renameSigs )
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, mkNameSet,
30 elemNameSet, nameOccName, NamedThing(..)
32 import BasicTypes ( TopLevelFlag(..) )
33 import FiniteMap ( lookupFM )
34 import Id ( GenId{-instance NamedThing-} )
35 import IdInfo ( FBTypeInfo, ArgUsageInfo )
36 import Lex ( isLexCon )
37 import PrelInfo ( derivingOccurrences, evalClass_RDR, numClass_RDR, allClass_NAME )
38 import Maybes ( maybeToBool )
39 import Bag ( bagToList )
41 import SrcLoc ( SrcLoc )
42 import Unique ( Unique )
43 import UniqSet ( UniqSet )
44 import UniqFM ( UniqFM, lookupUFM )
46 import List ( partition, nub )
49 rnDecl `renames' declarations.
50 It simultaneously performs dependency analysis and precedence parsing.
51 It also does the following error checks:
54 Checks that tyvars are used properly. This includes checking
55 for undefined tyvars, and tyvars in contexts that are ambiguous.
57 Checks that all variable occurences are defined.
59 Checks the (..) etc constraints in the export list.
63 %*********************************************************
65 \subsection{Value declarations}
67 %*********************************************************
70 rnDecl :: RdrNameHsDecl -> RnMS s RenamedHsDecl
72 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ new_binds ->
73 returnRn (ValD new_binds)
76 rnDecl (SigD (IfaceSig name ty id_infos loc))
78 lookupBndrRn name `thenRn` \ name' ->
79 rnHsType ty `thenRn` \ ty' ->
81 -- Get the pragma info (if any).
82 getModeRn `thenRn` \ (InterfaceMode _ print_unqual) ->
83 setModeRn (InterfaceMode Optional print_unqual) $
84 -- In all the rest of the signature we read in optional mode,
85 -- so that (a) we don't die
86 mapRn rnIdInfo id_infos `thenRn` \ id_infos' ->
87 returnRn (SigD (IfaceSig name' ty' id_infos' loc))
90 %*********************************************************
92 \subsection{Type declarations}
94 %*********************************************************
96 @rnTyDecl@ uses the `global name function' to create a new type
97 declaration in which local names have been replaced by their original
98 names, reporting any unknown names.
100 Renaming type variables is a pain. Because they now contain uniques,
101 it is necessary to pass in an association list which maps a parsed
102 tyvar to its Name representation. In some cases (type signatures of
103 values), it is even necessary to go over the type first in order to
104 get the set of tyvars used by it, make an assoc list, and then go over
105 it again to rename the tyvars! However, we can also do some scoping
106 checks at the same time.
109 rnDecl (TyD (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc))
110 = pushSrcLocRn src_loc $
111 lookupBndrRn tycon `thenRn` \ tycon' ->
112 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
113 rnContext context `thenRn` \ context' ->
114 checkDupOrQualNames data_doc con_names `thenRn_`
115 mapRn rnConDecl condecls `thenRn` \ condecls' ->
116 rnDerivs derivings `thenRn` \ derivings' ->
117 ASSERT(isNoDataPragmas pragmas)
118 returnRn (TyD (TyData new_or_data context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc))
120 data_doc = text "the data type declaration for" <+> ppr tycon
121 con_names = map conDeclName condecls
123 rnDecl (TyD (TySynonym name tyvars ty src_loc))
124 = pushSrcLocRn src_loc $
125 lookupBndrRn name `thenRn` \ name' ->
126 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
127 rnHsType ty `thenRn` \ ty' ->
128 returnRn (TyD (TySynonym name' tyvars' ty' src_loc))
130 syn_doc = text "the declaration for type synonym" <+> ppr name
133 %*********************************************************
135 \subsection{Class declarations}
137 %*********************************************************
139 @rnClassDecl@ uses the `global name function' to create a new
140 class declaration in which local names have been replaced by their
141 original names, reporting any unknown names.
144 rnDecl (ClD (ClassDecl context cname tyvars sigs mbinds pragmas tname dname src_loc))
145 = pushSrcLocRn src_loc $
147 lookupBndrRn cname `thenRn` \ cname' ->
148 lookupBndrRn tname `thenRn` \ tname' ->
149 lookupBndrRn dname `thenRn` \ dname' ->
151 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
152 rnContext context `thenRn` \ context' ->
154 -- Check the signatures
156 clas_tyvar_names = map getTyVarName tyvars'
158 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
159 mapRn (rn_op cname' clas_tyvar_names) sigs `thenRn` \ sigs' ->
160 returnRn (tyvars', context', sigs')
161 ) `thenRn` \ (tyvars', context', sigs') ->
164 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
165 rnMethodBinds mbinds `thenRn` \ mbinds' ->
167 -- Typechecker is responsible for checking that we only
168 -- give default-method bindings for things in this class.
169 -- The renamer *could* check this for class decls, but can't
170 -- for instance decls.
172 ASSERT(isNoClassPragmas pragmas)
173 returnRn (ClD (ClassDecl context' cname' tyvars' sigs' mbinds' NoClassPragmas tname' dname' src_loc))
175 cls_doc = text "the declaration for class" <+> ppr cname
176 sig_doc = text "the signatures for class" <+> ppr cname
177 meth_doc = text "the default-methods for class" <+> ppr cname
179 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
180 meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
181 meth_rdr_names = map fst meth_rdr_names_w_locs
183 rn_op clas clas_tyvars sig@(ClassOpSig op maybe_dm ty locn)
184 = pushSrcLocRn locn $
185 lookupBndrRn op `thenRn` \ op_name ->
186 rnHsSigType (quotes (ppr op)) ty `thenRn` \ new_ty ->
188 -- Make the default-method name
190 dm_occ = prefixOccName SLIT("$m") (rdrNameOcc op)
192 getModuleRn `thenRn` \ mod_name ->
193 getModeRn `thenRn` \ mode ->
194 (case (mode, maybe_dm) of
195 (SourceMode, _) | op `elem` meth_rdr_names
196 -> -- There's an explicit method decl
197 newLocallyDefinedGlobalName mod_name dm_occ
198 (\_ -> Exported) locn `thenRn` \ dm_name ->
199 returnRn (Just dm_name)
201 (InterfaceMode _ _, Just _)
202 -> -- Imported class that has a default method decl
203 newImportedGlobalName mod_name dm_occ (ifaceFlavour clas) `thenRn` \ dm_name ->
204 addOccurrenceName dm_name `thenRn_`
205 returnRn (Just dm_name)
207 other -> returnRn Nothing
208 ) `thenRn` \ maybe_dm_name ->
210 -- Check that each class tyvar appears in op_ty
212 (ctxt, op_ty) = case new_ty of
213 HsForAllTy tvs ctxt op_ty -> (ctxt, op_ty)
214 other -> ([], new_ty)
215 ctxt_fvs = extractHsCtxtTyNames ctxt -- Includes tycons/classes but we
216 op_ty_fvs = extractHsTyNames op_ty -- don't care about that
218 check_in_op_ty clas_tyvar = checkRn (clas_tyvar `elemNameSet` op_ty_fvs)
219 (classTyVarNotInOpTyErr clas_tyvar sig)
221 mapRn check_in_op_ty clas_tyvars `thenRn_`
223 returnRn (ClassOpSig op_name maybe_dm_name new_ty locn)
227 %*********************************************************
229 \subsection{Instance declarations}
231 %*********************************************************
234 rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc))
235 = pushSrcLocRn src_loc $
236 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ inst_ty' ->
239 -- Rename the bindings
240 -- NB meth_names can be qualified!
241 checkDupNames meth_doc meth_names `thenRn_`
242 rnMethodBinds mbinds `thenRn` \ mbinds' ->
244 binders = mkNameSet (map fst (bagToList (collectMonoBinders mbinds')))
246 renameSigs NotTopLevel True binders uprags `thenRn` \ new_uprags ->
249 -- We use the class name and the name of the first
250 -- type constructor the class is applied to.
251 (cl_nm, tycon_nm) = mkDictPrefix inst_ty'
253 mkDictPrefix (MonoDictTy cl tys) =
255 [] -> (c_nm, nilOccName )
256 (ty:_) -> (c_nm, getInstHeadTy ty)
258 c_nm = nameOccName (getName cl)
260 mkDictPrefix (HsPreForAllTy _ ty) = mkDictPrefix ty
261 mkDictPrefix (HsForAllTy _ _ ty) = mkDictPrefix ty -- can this
262 mkDictPrefix _ = (nilOccName, nilOccName)
266 MonoTyVar tv -> nameOccName (getName tv)
267 MonoTyApp t _ -> getInstHeadTy t
269 -- I cannot see how the rest of HsType constructors
270 -- can occur, but this isn't really a failure condition,
271 -- so we return silently.
273 nilOccName = (VarOcc _NIL_) -- ToDo: add OccName constructor fun for this.
275 newDfunName cl_nm tycon_nm maybe_dfun src_loc `thenRn` \ dfun_name ->
276 addOccurrenceName dfun_name `thenRn_`
277 -- The dfun is not optional, because we use its version number
278 -- to identify the version of the instance declaration
280 -- The typechecker checks that all the bindings are for the right class.
281 returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags (Just dfun_name) src_loc))
283 meth_doc = text "the bindings in an instance declaration"
284 meth_names = bagToList (collectMonoBinders mbinds)
287 %*********************************************************
289 \subsection{Default declarations}
291 %*********************************************************
294 rnDecl (DefD (DefaultDecl tys src_loc))
295 = pushSrcLocRn src_loc $
296 mapRn rnHsType tys `thenRn` \ tys' ->
297 lookupImplicitOccRn numClass_RDR `thenRn_`
298 returnRn (DefD (DefaultDecl tys' src_loc))
301 %*********************************************************
303 \subsection{Support code for type/data declarations}
305 %*********************************************************
308 rnDerivs :: Maybe [RdrName] -> RnMS s (Maybe [Name])
310 rnDerivs Nothing -- derivs not specified
311 = lookupImplicitOccRn evalClass_RDR `thenRn_`
315 = lookupImplicitOccRn evalClass_RDR `thenRn_`
316 mapRn rn_deriv ds `thenRn` \ derivs ->
317 returnRn (Just derivs)
320 = lookupOccRn clas `thenRn` \ clas_name ->
322 -- Now add extra "occurrences" for things that
323 -- the deriving mechanism will later need in order to
324 -- generate code for this class.
325 case lookupUFM derivingOccurrences clas_name of
326 Nothing -> addErrRn (derivingNonStdClassErr clas_name) `thenRn_`
329 Just occs -> mapRn lookupImplicitOccRn occs `thenRn_`
334 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
335 conDeclName (ConDecl n _ _ l) = (n,l)
337 rnConDecl :: RdrNameConDecl -> RnMS s RenamedConDecl
338 rnConDecl (ConDecl name cxt details locn)
339 = pushSrcLocRn locn $
340 checkConName name `thenRn_`
341 lookupBndrRn name `thenRn` \ new_name ->
342 rnConDetails name locn details `thenRn` \ new_details ->
343 rnContext cxt `thenRn` \ new_context ->
344 returnRn (ConDecl new_name new_context new_details locn)
346 rnConDetails con locn (VanillaCon tys)
347 = mapRn rnBangTy tys `thenRn` \ new_tys ->
348 returnRn (VanillaCon new_tys)
350 rnConDetails con locn (InfixCon ty1 ty2)
351 = rnBangTy ty1 `thenRn` \ new_ty1 ->
352 rnBangTy ty2 `thenRn` \ new_ty2 ->
353 returnRn (InfixCon new_ty1 new_ty2)
355 rnConDetails con locn (NewCon ty)
356 = rnHsType ty `thenRn` \ new_ty ->
357 returnRn (NewCon new_ty)
359 rnConDetails con locn (RecCon fields)
360 = checkDupOrQualNames fld_doc field_names `thenRn_`
361 mapRn rnField fields `thenRn` \ new_fields ->
362 returnRn (RecCon new_fields)
364 fld_doc = text "the fields of constructor" <> ppr con
365 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
368 = mapRn lookupBndrRn names `thenRn` \ new_names ->
369 rnBangTy ty `thenRn` \ new_ty ->
370 returnRn (new_names, new_ty)
373 = rnHsType ty `thenRn` \ new_ty ->
374 returnRn (Banged new_ty)
376 rnBangTy (Unbanged ty)
377 = rnHsType ty `thenRn` \ new_ty ->
378 returnRn (Unbanged new_ty)
380 -- This data decl will parse OK
382 -- treating "a" as the constructor.
383 -- It is really hard to make the parser spot this malformation.
384 -- So the renamer has to check that the constructor is legal
386 -- We can get an operator as the constructor, even in the prefix form:
387 -- data T = :% Int Int
388 -- from interface files, which always print in prefix form
391 = checkRn (isLexCon (occNameString (rdrNameOcc name)))
396 %*********************************************************
398 \subsection{Support code to rename types}
400 %*********************************************************
403 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS s RenamedHsType
404 -- rnHsSigType is used for source-language type signatures,
405 -- which use *implicit* universal quantification.
407 -- Given the signature C => T we universally quantify over FV(T) \ {in-scope-tyvars}
409 -- We insist that the universally quantified type vars is a superset of FV(C)
410 -- It follows that FV(T) is a superset of FV(C), so that the context constrains
411 -- no type variables that don't appear free in the tau-type part.
413 rnHsSigType doc_str full_ty@(HsPreForAllTy ctxt ty) -- From source code (no kinds on tyvars)
414 = getLocalNameEnv `thenRn` \ name_env ->
416 mentioned_tyvars = extractHsTyVars ty
417 forall_tyvars = filter (not . in_scope) mentioned_tyvars
418 in_scope tv = maybeToBool (lookupFM name_env tv)
420 constrained_tyvars = extractHsCtxtTyVars ctxt
421 constrained_and_in_scope = filter in_scope constrained_tyvars
422 constrained_and_not_mentioned = filter (not . (`elem` mentioned_tyvars)) constrained_tyvars
424 -- Zap the context if there's a problem, to avoid duplicate error message.
425 ctxt' | null constrained_and_in_scope && null constrained_and_not_mentioned = ctxt
428 checkRn (null constrained_and_in_scope)
429 (ctxtErr1 sig_doc constrained_and_in_scope) `thenRn_`
430 checkRn (null constrained_and_not_mentioned)
431 (ctxtErr2 sig_doc constrained_and_not_mentioned ty) `thenRn_`
433 (bindTyVarsRn sig_doc (map UserTyVar forall_tyvars) $ \ new_tyvars ->
434 rnContext ctxt' `thenRn` \ new_ctxt ->
435 rnHsType ty `thenRn` \ new_ty ->
436 returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
439 sig_doc = text "the type signature for" <+> doc_str
442 rnHsSigType doc_str other_ty = rnHsType other_ty
444 rnHsType :: RdrNameHsType -> RnMS s RenamedHsType
445 rnHsType (HsForAllTy tvs ctxt ty) -- From an interface file (tyvars may be kinded)
446 = rn_poly_help tvs ctxt ty
448 rnHsType full_ty@(HsPreForAllTy ctxt ty) -- A (context => ty) embedded in a type.
449 -- Universally quantify over tyvars in context
450 = getLocalNameEnv `thenRn` \ name_env ->
452 forall_tyvars = extractHsCtxtTyVars ctxt
454 rn_poly_help (map UserTyVar forall_tyvars) ctxt ty
456 rnHsType (MonoTyVar tyvar)
457 = lookupOccRn tyvar `thenRn` \ tyvar' ->
458 returnRn (MonoTyVar tyvar')
460 rnHsType (MonoFunTy ty1 ty2)
461 = andRn MonoFunTy (rnHsType ty1) (rnHsType ty2)
463 rnHsType (MonoListTy _ ty)
464 = lookupImplicitOccRn listType_RDR `thenRn` \ tycon_name ->
465 rnHsType ty `thenRn` \ ty' ->
466 returnRn (MonoListTy tycon_name ty')
468 rnHsType (MonoTupleTy _ tys)
469 = lookupImplicitOccRn (tupleType_RDR (length tys)) `thenRn` \ tycon_name ->
470 mapRn rnHsType tys `thenRn` \ tys' ->
471 returnRn (MonoTupleTy tycon_name tys')
473 rnHsType (MonoTyApp ty1 ty2)
474 = rnHsType ty1 `thenRn` \ ty1' ->
475 rnHsType ty2 `thenRn` \ ty2' ->
476 returnRn (MonoTyApp ty1' ty2')
478 rnHsType (MonoDictTy clas tys)
479 = lookupOccRn clas `thenRn` \ clas' ->
480 mapRn rnHsType tys `thenRn` \ tys' ->
481 returnRn (MonoDictTy clas' tys')
483 rn_poly_help :: [HsTyVar RdrName] -- Universally quantified tyvars
486 -> RnMS s RenamedHsType
487 rn_poly_help tyvars ctxt ty
488 = bindTyVarsRn sig_doc tyvars $ \ new_tyvars ->
489 rnContext ctxt `thenRn` \ new_ctxt ->
490 rnHsType ty `thenRn` \ new_ty ->
491 returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
493 sig_doc = text "a nested for-all type"
498 rnContext :: RdrNameContext -> RnMS s RenamedContext
501 = mapRn rn_ctxt ctxt `thenRn` \ result ->
503 (_, dup_asserts) = removeDups cmp_assert result
504 (alls, theta) = partition (\(c,_) -> c == allClass_NAME) result
507 -- Check for duplicate assertions
508 -- If this isn't an error, then it ought to be:
509 mapRn (addWarnRn . dupClassAssertWarn theta) dup_asserts `thenRn_`
511 -- Check for All constraining a non-type-variable
512 mapRn check_All alls `thenRn_`
514 -- Done. Return a theta omitting all the "All" constraints.
515 -- They have done done their work by ensuring that we universally
516 -- quantify over their tyvar.
520 = -- Mini hack here. If the class is our pseudo-class "All",
521 -- then we don't want to record it as an occurrence, otherwise
522 -- we try to slurp it in later and it doesn't really exist at all.
523 -- Easiest thing is simply not to put it in the occurrence set.
524 lookupBndrRn clas `thenRn` \ clas_name ->
525 (if clas_name /= allClass_NAME then
526 addOccurrenceName clas_name
530 mapRn rnHsType tys `thenRn` \ tys' ->
531 returnRn (clas_name, tys')
534 cmp_assert (c1,tys1) (c2,tys2)
535 = (c1 `compare` c2) `thenCmp` (cmpHsTypes compare tys1 tys2)
537 check_All (c, [MonoTyVar _]) = returnRn () -- OK!
538 check_All assertion = addErrRn (wierdAllErr assertion)
542 %*********************************************************
546 %*********************************************************
549 rnIdInfo (HsStrictness strict)
550 = rnStrict strict `thenRn` \ strict' ->
551 returnRn (HsStrictness strict')
553 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
554 returnRn (HsUnfold inline expr')
555 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
556 rnIdInfo (HsUpdate update) = returnRn (HsUpdate update)
557 rnIdInfo (HsFBType fb) = returnRn (HsFBType fb)
558 rnIdInfo (HsArgUsage au) = returnRn (HsArgUsage au)
559 rnIdInfo (HsSpecialise tyvars tys expr)
560 = bindTyVarsRn doc tyvars $ \ tyvars' ->
561 rnCoreExpr expr `thenRn` \ expr' ->
562 mapRn rnHsType tys `thenRn` \ tys' ->
563 returnRn (HsSpecialise tyvars' tys' expr')
565 doc = text "Specialise in interface pragma"
568 rnStrict (HsStrictnessInfo demands (Just (worker,cons)))
569 -- The sole purpose of the "cons" field is so that we can mark the constructors
570 -- needed to build the wrapper as "needed", so that their data type decl will be
571 -- slurped in. After that their usefulness is o'er, so we just put in the empty list.
572 = lookupOccRn worker `thenRn` \ worker' ->
573 mapRn lookupOccRn cons `thenRn_`
574 returnRn (HsStrictnessInfo demands (Just (worker',[])))
576 -- Boring, but necessary for the type checker.
577 rnStrict (HsStrictnessInfo demands Nothing) = returnRn (HsStrictnessInfo demands Nothing)
578 rnStrict HsBottom = returnRn HsBottom
585 = lookupOccRn v `thenRn` \ v' ->
588 rnCoreExpr (UfLit lit) = returnRn (UfLit lit)
590 rnCoreExpr (UfCon con args)
591 = lookupOccRn con `thenRn` \ con' ->
592 mapRn rnCoreArg args `thenRn` \ args' ->
593 returnRn (UfCon con' args')
595 rnCoreExpr (UfPrim prim args)
596 = rnCorePrim prim `thenRn` \ prim' ->
597 mapRn rnCoreArg args `thenRn` \ args' ->
598 returnRn (UfPrim prim' args')
600 rnCoreExpr (UfApp fun arg)
601 = rnCoreExpr fun `thenRn` \ fun' ->
602 rnCoreArg arg `thenRn` \ arg' ->
603 returnRn (UfApp fun' arg')
605 rnCoreExpr (UfCase scrut alts)
606 = rnCoreExpr scrut `thenRn` \ scrut' ->
607 rnCoreAlts alts `thenRn` \ alts' ->
608 returnRn (UfCase scrut' alts')
610 rnCoreExpr (UfNote note expr)
611 = rnNote note `thenRn` \ note' ->
612 rnCoreExpr expr `thenRn` \ expr' ->
613 returnRn (UfNote note' expr')
615 rnCoreExpr (UfLam bndr body)
616 = rnCoreBndr bndr $ \ bndr' ->
617 rnCoreExpr body `thenRn` \ body' ->
618 returnRn (UfLam bndr' body')
620 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
621 = rnCoreExpr rhs `thenRn` \ rhs' ->
622 rnCoreBndr bndr $ \ bndr' ->
623 rnCoreExpr body `thenRn` \ body' ->
624 returnRn (UfLet (UfNonRec bndr' rhs') body')
626 rnCoreExpr (UfLet (UfRec pairs) body)
627 = rnCoreBndrs bndrs $ \ bndrs' ->
628 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
629 rnCoreExpr body `thenRn` \ body' ->
630 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
632 (bndrs, rhss) = unzip pairs
636 rnCoreBndr (UfValBinder name ty) thing_inside
637 = rnHsType ty `thenRn` \ ty' ->
638 bindLocalsRn "unfolding value" [name] $ \ [name'] ->
639 thing_inside (UfValBinder name' ty')
641 rnCoreBndr (UfTyBinder name kind) thing_inside
642 = bindLocalsRn "unfolding tyvar" [name] $ \ [name'] ->
643 thing_inside (UfTyBinder name' kind)
645 rnCoreBndrs bndrs thing_inside -- Expect them all to be ValBinders
646 = mapRn rnHsType tys `thenRn` \ tys' ->
647 bindLocalsRn "unfolding value" names $ \ names' ->
648 thing_inside (zipWith UfValBinder names' tys')
650 names = map (\ (UfValBinder name _) -> name) bndrs
651 tys = map (\ (UfValBinder _ ty) -> ty) bndrs
653 rnCoreBndrNamess names thing_inside
654 = bindLocalsRn "unfolding value" names $ \ names' ->
659 rnCoreArg (UfVarArg v) = lookupOccRn v `thenRn` \ v' -> returnRn (UfVarArg v')
660 rnCoreArg (UfTyArg ty) = rnHsType ty `thenRn` \ ty' -> returnRn (UfTyArg ty')
661 rnCoreArg (UfLitArg lit) = returnRn (UfLitArg lit)
663 rnCoreAlts (UfAlgAlts alts deflt)
664 = mapRn rn_alt alts `thenRn` \ alts' ->
665 rnCoreDefault deflt `thenRn` \ deflt' ->
666 returnRn (UfAlgAlts alts' deflt')
668 rn_alt (con, bndrs, rhs) = lookupOccRn con `thenRn` \ con' ->
669 bindLocalsRn "unfolding alt" bndrs $ \ bndrs' ->
670 rnCoreExpr rhs `thenRn` \ rhs' ->
671 returnRn (con', bndrs', rhs')
673 rnCoreAlts (UfPrimAlts alts deflt)
674 = mapRn rn_alt alts `thenRn` \ alts' ->
675 rnCoreDefault deflt `thenRn` \ deflt' ->
676 returnRn (UfPrimAlts alts' deflt')
678 rn_alt (lit, rhs) = rnCoreExpr rhs `thenRn` \ rhs' ->
681 rnCoreDefault UfNoDefault = returnRn UfNoDefault
682 rnCoreDefault (UfBindDefault bndr rhs) = bindLocalsRn "unfolding default" [bndr] $ \ [bndr'] ->
683 rnCoreExpr rhs `thenRn` \ rhs' ->
684 returnRn (UfBindDefault bndr' rhs')
687 = rnHsType ty `thenRn` \ ty' ->
688 returnRn (UfCoerce ty')
690 rnNote (UfSCC cc) = returnRn (UfSCC cc)
691 rnNote UfInlineCall = returnRn UfInlineCall
693 rnCorePrim (UfOtherOp op)
694 = lookupOccRn op `thenRn` \ op' ->
695 returnRn (UfOtherOp op')
697 rnCorePrim (UfCCallOp str casm gc arg_tys res_ty)
698 = mapRn rnHsType arg_tys `thenRn` \ arg_tys' ->
699 rnHsType res_ty `thenRn` \ res_ty' ->
700 returnRn (UfCCallOp str casm gc arg_tys' res_ty')
703 %*********************************************************
707 %*********************************************************
710 derivingNonStdClassErr clas
711 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
713 classTyVarNotInOpTyErr clas_tyvar sig
714 = hang (hsep [ptext SLIT("Class type variable"),
715 quotes (ppr clas_tyvar),
716 ptext SLIT("does not appear in method signature")])
719 dupClassAssertWarn ctxt (assertion : dups)
720 = sep [hsep [ptext SLIT("Duplicated class assertion"),
721 quotes (pprClassAssertion assertion),
722 ptext SLIT("in the context:")],
723 nest 4 (pprContext ctxt)]
726 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
728 wierdAllErr assertion
729 = ptext SLIT("Mal-formed use of `All':") <+> pprClassAssertion assertion
732 = hsep [ptext SLIT("Context constrains in-scope type variable(s)"),
733 pprQuotedList tyvars]
735 nest 4 (ptext SLIT("in") <+> doc)
737 ctxtErr2 doc tyvars ty
738 = (ptext SLIT("Context constrains type variable(s)")
739 <+> pprQuotedList tyvars)
741 nest 4 (vcat [ptext SLIT("that do not appear in") <+> quotes (ppr ty),
742 ptext SLIT("in") <+> doc])