2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
7 module RnSource ( rnTyClDecl, rnIfaceRuleDecl, rnInstDecl, rnSourceDecls,
10 #include "HsVersions.h"
14 import HscTypes ( GlobalRdrEnv, AvailEnv )
15 import RdrName ( RdrName, isRdrDataCon, elemRdrEnv )
16 import RdrHsSyn ( RdrNameConDecl, RdrNameTyClDecl,
17 extractGenericPatTyVars
22 import RnTypes ( rnHsType, rnHsSigType, rnHsTypeFVs, rnContext )
24 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, renameSigsFVs )
25 import RnEnv ( lookupTopBndrRn, lookupOccRn, lookupIfaceName,
26 lookupOrigNames, lookupSysBinder, newLocalsRn,
27 bindLocalsFVRn, bindPatSigTyVars,
28 bindTyVarsRn, extendTyVarEnvFVRn,
29 bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
30 checkDupOrQualNames, checkDupNames, mapFvRn
34 import Class ( FunDep, DefMeth (..) )
35 import DataCon ( dataConId )
36 import Name ( Name, NamedThing(..) )
38 import PrelInfo ( derivableClassKeys )
39 import PrelNames ( deRefStablePtrName, newStablePtrName,
40 bindIOName, returnIOName
42 import TysWiredIn ( tupleCon )
43 import List ( partition )
45 import SrcLoc ( SrcLoc )
46 import CmdLineOpts ( DynFlag(..) )
47 -- Warn of unused for-all'd tyvars
48 import Unique ( Uniquable(..) )
49 import Maybes ( maybeToBool )
52 @rnSourceDecl@ `renames' declarations.
53 It simultaneously performs dependency analysis and precedence parsing.
54 It also does the following error checks:
57 Checks that tyvars are used properly. This includes checking
58 for undefined tyvars, and tyvars in contexts that are ambiguous.
59 (Some of this checking has now been moved to module @TcMonoType@,
60 since we don't have functional dependency information at this point.)
62 Checks that all variable occurences are defined.
64 Checks the @(..)@ etc constraints in the export list.
68 %*********************************************************
70 \subsection{Source code declarations}
72 %*********************************************************
75 rnSourceDecls :: GlobalRdrEnv -> AvailEnv -> LocalFixityEnv
77 -> RnMG ([RenamedHsDecl], FreeVars)
78 -- The decls get reversed, but that's ok
80 rnSourceDecls gbl_env avails local_fixity_env decls
81 = initRnMS gbl_env avails emptyRdrEnv local_fixity_env SourceMode (go emptyFVs [] decls)
83 -- Fixity and deprecations have been dealt with already; ignore them
84 go fvs ds' [] = returnRn (ds', fvs)
85 go fvs ds' (FixD _:ds) = go fvs ds' ds
86 go fvs ds' (DeprecD _:ds) = go fvs ds' ds
87 go fvs ds' (d:ds) = rnSourceDecl d `thenRn` \(d', fvs') ->
88 go (fvs `plusFV` fvs') (d':ds') ds
91 rnSourceDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
93 rnSourceDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
94 returnRn (ValD new_binds, fvs)
96 rnSourceDecl (TyClD tycl_decl)
97 = rnTyClDecl tycl_decl `thenRn` \ new_decl ->
98 finishSourceTyClDecl tycl_decl new_decl `thenRn` \ (new_decl', fvs) ->
99 returnRn (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
101 rnSourceDecl (InstD inst)
102 = rnInstDecl inst `thenRn` \ new_inst ->
103 finishSourceInstDecl inst new_inst `thenRn` \ (new_inst', fvs) ->
104 returnRn (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
106 rnSourceDecl (RuleD rule)
107 = rnHsRuleDecl rule `thenRn` \ (new_rule, fvs) ->
108 returnRn (RuleD new_rule, fvs)
110 rnSourceDecl (ForD ford)
111 = rnHsForeignDecl ford `thenRn` \ (new_ford, fvs) ->
112 returnRn (ForD new_ford, fvs)
114 rnSourceDecl (DefD (DefaultDecl tys src_loc))
115 = pushSrcLocRn src_loc $
116 mapFvRn (rnHsTypeFVs doc_str) tys `thenRn` \ (tys', fvs) ->
117 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
119 doc_str = text "In a `default' declaration"
123 %*********************************************************
125 \subsection{Foreign declarations}
127 %*********************************************************
130 rnHsForeignDecl (ForeignImport name ty spec src_loc)
131 = pushSrcLocRn src_loc $
132 lookupTopBndrRn name `thenRn` \ name' ->
133 rnHsTypeFVs (fo_decl_msg name) ty `thenRn` \ (ty', fvs) ->
134 returnRn (ForeignImport name' ty' spec src_loc, fvs `plusFV` extras spec)
136 extras (CDynImport _) = mkFVs [newStablePtrName, deRefStablePtrName, bindIOName, returnIOName]
137 extras other = emptyFVs
139 rnHsForeignDecl (ForeignExport name ty spec src_loc)
140 = pushSrcLocRn src_loc $
141 lookupOccRn name `thenRn` \ name' ->
142 rnHsTypeFVs (fo_decl_msg name) ty `thenRn` \ (ty', fvs) ->
143 returnRn (ForeignExport name' ty' spec src_loc,
144 mkFVs [bindIOName, returnIOName] `plusFV` fvs)
146 fo_decl_msg name = ptext SLIT("The foreign declaration for") <+> ppr name
150 %*********************************************************
152 \subsection{Instance declarations}
154 %*********************************************************
157 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
158 -- Used for both source and interface file decls
159 = pushSrcLocRn src_loc $
160 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ inst_ty' ->
162 (case maybe_dfun_rdr_name of
163 Nothing -> returnRn Nothing
164 Just dfun_rdr_name -> lookupIfaceName dfun_rdr_name `thenRn` \ dfun_name ->
165 returnRn (Just dfun_name)
166 ) `thenRn` \ maybe_dfun_name ->
168 -- The typechecker checks that all the bindings are for the right class.
169 returnRn (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
171 -- Compare finishSourceTyClDecl
172 finishSourceInstDecl (InstDecl _ mbinds uprags _ _ )
173 (InstDecl inst_ty _ _ maybe_dfun_name src_loc)
174 -- Used for both source decls only
175 = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
177 meth_doc = text "In the bindings in an instance declaration"
178 meth_names = collectLocatedMonoBinders mbinds
179 (inst_tyvars, (cls,_)) = getHsInstHead inst_ty
180 -- (Slightly strangely) the forall-d tyvars scope over
181 -- the method bindings too
184 -- Rename the bindings
185 -- NB meth_names can be qualified!
186 checkDupNames meth_doc meth_names `thenRn_`
187 extendTyVarEnvFVRn (map hsTyVarName inst_tyvars) (
188 rnMethodBinds cls [] mbinds
189 ) `thenRn` \ (mbinds', meth_fvs) ->
191 binders = collectMonoBinders mbinds'
192 binder_set = mkNameSet binders
194 -- Rename the prags and signatures.
195 -- Note that the type variables are not in scope here,
196 -- so that instance Eq a => Eq (T a) where
197 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
200 -- But the (unqualified) method names are in scope
201 bindLocalNames binders (
202 renameSigsFVs (okInstDclSig binder_set) uprags
203 ) `thenRn` \ (uprags', prag_fvs) ->
205 returnRn (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
206 meth_fvs `plusFV` prag_fvs)
209 %*********************************************************
213 %*********************************************************
216 rnIfaceRuleDecl (IfaceRule rule_name act vars fn args rhs src_loc)
217 = pushSrcLocRn src_loc $
218 lookupOccRn fn `thenRn` \ fn' ->
219 rnCoreBndrs vars $ \ vars' ->
220 mapRn rnCoreExpr args `thenRn` \ args' ->
221 rnCoreExpr rhs `thenRn` \ rhs' ->
222 returnRn (IfaceRule rule_name act vars' fn' args' rhs' src_loc)
224 rnIfaceRuleDecl (IfaceRuleOut fn rule) -- Builtin rules come this way
225 = lookupOccRn fn `thenRn` \ fn' ->
226 returnRn (IfaceRuleOut fn' rule)
228 rnHsRuleDecl (HsRule rule_name act vars lhs rhs src_loc)
229 = pushSrcLocRn src_loc $
230 bindPatSigTyVars (collectRuleBndrSigTys vars) $
232 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
233 mapFvRn rn_var (vars `zip` ids) `thenRn` \ (vars', fv_vars) ->
235 rnExpr lhs `thenRn` \ (lhs', fv_lhs) ->
236 rnExpr rhs `thenRn` \ (rhs', fv_rhs) ->
237 checkRn (validRuleLhs ids lhs')
238 (badRuleLhsErr rule_name lhs') `thenRn_`
240 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
242 mapRn (addErrRn . badRuleVar rule_name) bad_vars `thenRn_`
243 returnRn (HsRule rule_name act vars' lhs' rhs' src_loc,
244 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
246 doc = text "In the transformation rule" <+> ptext rule_name
248 get_var (RuleBndr v) = v
249 get_var (RuleBndrSig v _) = v
251 rn_var (RuleBndr v, id) = returnRn (RuleBndr id, emptyFVs)
252 rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t `thenRn` \ (t', fvs) ->
253 returnRn (RuleBndrSig id t', fvs)
257 %*********************************************************
259 \subsection{Type, class and iface sig declarations}
261 %*********************************************************
263 @rnTyDecl@ uses the `global name function' to create a new type
264 declaration in which local names have been replaced by their original
265 names, reporting any unknown names.
267 Renaming type variables is a pain. Because they now contain uniques,
268 it is necessary to pass in an association list which maps a parsed
269 tyvar to its @Name@ representation.
270 In some cases (type signatures of values),
271 it is even necessary to go over the type first
272 in order to get the set of tyvars used by it, make an assoc list,
273 and then go over it again to rename the tyvars!
274 However, we can also do some scoping checks at the same time.
277 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
279 lookupTopBndrRn name `thenRn` \ name' ->
280 rnHsType doc_str ty `thenRn` \ ty' ->
281 mapRn rnIdInfo id_infos `thenRn` \ id_infos' ->
282 returnRn (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
284 doc_str = text "In the interface signature for" <+> quotes (ppr name)
286 rnTyClDecl (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
288 lookupTopBndrRn name `thenRn` \ name' ->
289 returnRn (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
291 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
292 tcdTyVars = tyvars, tcdCons = condecls, tcdNCons = nconstrs,
293 tcdLoc = src_loc, tcdSysNames = sys_names})
294 = pushSrcLocRn src_loc $
295 lookupTopBndrRn tycon `thenRn` \ tycon' ->
296 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
297 rnContext data_doc context `thenRn` \ context' ->
298 checkDupOrQualNames data_doc con_names `thenRn_`
300 -- Check that there's at least one condecl,
301 -- or else we're reading an interface file, or -fglasgow-exts
302 (if null condecls then
303 doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
304 getModeRn `thenRn` \ mode ->
305 checkRn (glaExts || isInterfaceMode mode)
306 (emptyConDeclsErr tycon)
310 mapRn rnConDecl condecls `thenRn` \ condecls' ->
311 mapRn lookupSysBinder sys_names `thenRn` \ sys_names' ->
312 returnRn (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
313 tcdTyVars = tyvars', tcdCons = condecls', tcdNCons = nconstrs,
314 tcdDerivs = Nothing, tcdLoc = src_loc, tcdSysNames = sys_names'})
316 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
317 con_names = map conDeclName condecls
319 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
320 = pushSrcLocRn src_loc $
321 lookupTopBndrRn name `thenRn` \ name' ->
322 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
323 rnHsType syn_doc ty `thenRn` \ ty' ->
324 returnRn (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
326 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
328 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
329 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
330 tcdSysNames = names, tcdLoc = src_loc})
331 -- Used for both source and interface file decls
332 = pushSrcLocRn src_loc $
334 lookupTopBndrRn cname `thenRn` \ cname' ->
336 -- Deal with the implicit tycon and datacon name
337 -- They aren't in scope (because they aren't visible to the user)
338 -- and what we want to do is simply look them up in the cache;
339 -- we jolly well ought to get a 'hit' there!
340 mapRn lookupSysBinder names `thenRn` \ names' ->
342 -- Tyvars scope over bindings and context
343 bindTyVarsRn cls_doc tyvars $ \ tyvars' ->
345 -- Check the superclasses
346 rnContext cls_doc context `thenRn` \ context' ->
348 -- Check the functional dependencies
349 rnFds cls_doc fds `thenRn` \ fds' ->
351 -- Check the signatures
352 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
354 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
355 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
357 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
358 mapRn (rnClassOp cname' fds') op_sigs `thenRn` \ sigs' ->
360 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
362 renameSigs (okClsDclSig binders) non_op_sigs `thenRn` \ non_ops' ->
364 -- Typechecker is responsible for checking that we only
365 -- give default-method bindings for things in this class.
366 -- The renamer *could* check this for class decls, but can't
367 -- for instance decls.
369 returnRn (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
370 tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
371 tcdSysNames = names', tcdLoc = src_loc})
373 cls_doc = text "In the declaration for class" <+> ppr cname
374 sig_doc = text "In the signatures for class" <+> ppr cname
376 rnClassOp clas clas_fds sig@(ClassOpSig op dm_stuff ty locn)
377 = pushSrcLocRn locn $
378 lookupTopBndrRn op `thenRn` \ op_name ->
380 -- Check the signature
381 rnHsSigType (quotes (ppr op)) ty `thenRn` \ new_ty ->
383 -- Make the default-method name
386 -> -- Imported class that has a default method decl
387 -- See comments with tname, snames, above
388 lookupSysBinder dm_rdr_name `thenRn` \ dm_name ->
389 returnRn (DefMeth dm_name)
390 -- An imported class decl for a class decl that had an explicit default
391 -- method, mentions, rather than defines,
392 -- the default method, so we must arrange to pull it in
394 GenDefMeth -> returnRn GenDefMeth
395 NoDefMeth -> returnRn NoDefMeth
396 ) `thenRn` \ dm_stuff' ->
398 returnRn (ClassOpSig op_name dm_stuff' new_ty locn)
400 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
401 -- Used for source file decls only
402 -- Renames the default-bindings of a class decl
403 -- the derivings of a data decl
404 finishSourceTyClDecl (TyData {tcdDerivs = Just derivs, tcdLoc = src_loc}) -- Derivings in here
405 rn_ty_decl -- Everything else is here
406 = pushSrcLocRn src_loc $
407 mapRn rnDeriv derivs `thenRn` \ derivs' ->
408 returnRn (rn_ty_decl {tcdDerivs = Just derivs'}, mkNameSet derivs')
410 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc}) -- Get mbinds from here
411 rn_cls_decl@(ClassDecl {tcdName = cls, tcdTyVars = tyvars}) -- Everything else is here
412 -- There are some default-method bindings (abeit possibly empty) so
413 -- this is a source-code class declaration
414 = -- The newLocals call is tiresome: given a generic class decl
417 -- op {| x+y |} (Inl a) = ...
418 -- op {| x+y |} (Inr b) = ...
419 -- op {| a*b |} (a*b) = ...
420 -- we want to name both "x" tyvars with the same unique, so that they are
421 -- easy to group together in the typechecker.
423 pushSrcLocRn src_loc $
424 extendTyVarEnvFVRn (map hsTyVarName tyvars) $
425 getLocalNameEnv `thenRn` \ name_env ->
427 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
428 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
429 not (tv `elemRdrEnv` name_env)]
431 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
432 newLocalsRn gen_rdr_tyvars_w_locs `thenRn` \ gen_tyvars ->
433 rnMethodBinds cls gen_tyvars mbinds `thenRn` \ (mbinds', meth_fvs) ->
434 returnRn (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
436 meth_doc = text "In the default-methods for class" <+> ppr (tcdName rn_cls_decl)
438 finishSourceTyClDecl _ tycl_decl = returnRn (tycl_decl, emptyFVs)
439 -- Not a class or data type declaration
443 %*********************************************************
445 \subsection{Support code for type/data declarations}
447 %*********************************************************
450 rnDeriv :: RdrName -> RnMS Name
452 = lookupOccRn cls `thenRn` \ clas_name ->
453 checkRn (getUnique clas_name `elem` derivableClassKeys)
454 (derivingNonStdClassErr clas_name) `thenRn_`
459 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
460 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
462 rnConDecl :: RdrNameConDecl -> RnMS RenamedConDecl
463 rnConDecl (ConDecl name wkr tvs cxt details locn)
464 = pushSrcLocRn locn $
465 checkConName name `thenRn_`
466 lookupTopBndrRn name `thenRn` \ new_name ->
468 lookupSysBinder wkr `thenRn` \ new_wkr ->
469 -- See comments with ClassDecl
471 bindTyVarsRn doc tvs $ \ new_tyvars ->
472 rnContext doc cxt `thenRn` \ new_context ->
473 rnConDetails doc locn details `thenRn` \ new_details ->
474 returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn)
476 doc = text "In the definition of data constructor" <+> quotes (ppr name)
478 rnConDetails doc locn (VanillaCon tys)
479 = mapRn (rnBangTy doc) tys `thenRn` \ new_tys ->
480 returnRn (VanillaCon new_tys)
482 rnConDetails doc locn (InfixCon ty1 ty2)
483 = rnBangTy doc ty1 `thenRn` \ new_ty1 ->
484 rnBangTy doc ty2 `thenRn` \ new_ty2 ->
485 returnRn (InfixCon new_ty1 new_ty2)
487 rnConDetails doc locn (RecCon fields)
488 = checkDupOrQualNames doc field_names `thenRn_`
489 mapRn (rnField doc) fields `thenRn` \ new_fields ->
490 returnRn (RecCon new_fields)
492 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
494 rnField doc (names, ty)
495 = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
496 rnBangTy doc ty `thenRn` \ new_ty ->
497 returnRn (new_names, new_ty)
499 rnBangTy doc (BangType s ty)
500 = rnHsType doc ty `thenRn` \ new_ty ->
501 returnRn (BangType s new_ty)
503 -- This data decl will parse OK
505 -- treating "a" as the constructor.
506 -- It is really hard to make the parser spot this malformation.
507 -- So the renamer has to check that the constructor is legal
509 -- We can get an operator as the constructor, even in the prefix form:
510 -- data T = :% Int Int
511 -- from interface files, which always print in prefix form
514 = checkRn (isRdrDataCon name)
519 %*********************************************************
521 \subsection{Support code to rename types}
523 %*********************************************************
526 rnFds :: SDoc -> [FunDep RdrName] -> RnMS [FunDep Name]
532 = rnHsTyVars doc tys1 `thenRn` \ tys1' ->
533 rnHsTyVars doc tys2 `thenRn` \ tys2' ->
534 returnRn (tys1', tys2')
536 rnHsTyVars doc tvs = mapRn (rnHsTyvar doc) tvs
537 rnHsTyvar doc tyvar = lookupOccRn tyvar
540 %*********************************************************
544 %*********************************************************
547 rnIdInfo (HsWorker worker arity)
548 = lookupOccRn worker `thenRn` \ worker' ->
549 returnRn (HsWorker worker' arity)
551 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
552 returnRn (HsUnfold inline expr')
553 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str)
554 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
555 rnIdInfo HsNoCafRefs = returnRn HsNoCafRefs
558 @UfCore@ expressions.
561 rnCoreExpr (UfType ty)
562 = rnHsType (text "unfolding type") ty `thenRn` \ ty' ->
563 returnRn (UfType ty')
566 = lookupOccRn v `thenRn` \ v' ->
572 rnCoreExpr (UfLitLit l ty)
573 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
574 returnRn (UfLitLit l ty')
576 rnCoreExpr (UfFCall cc ty)
577 = rnHsType (text "ccall") ty `thenRn` \ ty' ->
578 returnRn (UfFCall cc ty')
580 rnCoreExpr (UfTuple (HsTupCon _ boxity arity) args)
581 = mapRn rnCoreExpr args `thenRn` \ args' ->
582 returnRn (UfTuple (HsTupCon tup_name boxity arity) args')
584 tup_name = getName (dataConId (tupleCon boxity arity))
585 -- Get the *worker* name and use that
587 rnCoreExpr (UfApp fun arg)
588 = rnCoreExpr fun `thenRn` \ fun' ->
589 rnCoreExpr arg `thenRn` \ arg' ->
590 returnRn (UfApp fun' arg')
592 rnCoreExpr (UfCase scrut bndr alts)
593 = rnCoreExpr scrut `thenRn` \ scrut' ->
594 bindCoreLocalRn bndr $ \ bndr' ->
595 mapRn rnCoreAlt alts `thenRn` \ alts' ->
596 returnRn (UfCase scrut' bndr' alts')
598 rnCoreExpr (UfNote note expr)
599 = rnNote note `thenRn` \ note' ->
600 rnCoreExpr expr `thenRn` \ expr' ->
601 returnRn (UfNote note' expr')
603 rnCoreExpr (UfLam bndr body)
604 = rnCoreBndr bndr $ \ bndr' ->
605 rnCoreExpr body `thenRn` \ body' ->
606 returnRn (UfLam bndr' body')
608 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
609 = rnCoreExpr rhs `thenRn` \ rhs' ->
610 rnCoreBndr bndr $ \ bndr' ->
611 rnCoreExpr body `thenRn` \ body' ->
612 returnRn (UfLet (UfNonRec bndr' rhs') body')
614 rnCoreExpr (UfLet (UfRec pairs) body)
615 = rnCoreBndrs bndrs $ \ bndrs' ->
616 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
617 rnCoreExpr body `thenRn` \ body' ->
618 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
620 (bndrs, rhss) = unzip pairs
624 rnCoreBndr (UfValBinder name ty) thing_inside
625 = rnHsType doc ty `thenRn` \ ty' ->
626 bindCoreLocalRn name $ \ name' ->
627 thing_inside (UfValBinder name' ty')
629 doc = text "unfolding id"
631 rnCoreBndr (UfTyBinder name kind) thing_inside
632 = bindCoreLocalRn name $ \ name' ->
633 thing_inside (UfTyBinder name' kind)
635 rnCoreBndrs [] thing_inside = thing_inside []
636 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
637 rnCoreBndrs bs $ \ names' ->
638 thing_inside (name':names')
642 rnCoreAlt (con, bndrs, rhs)
643 = rnUfCon con `thenRn` \ con' ->
644 bindCoreLocalsRn bndrs $ \ bndrs' ->
645 rnCoreExpr rhs `thenRn` \ rhs' ->
646 returnRn (con', bndrs', rhs')
649 = rnHsType (text "unfolding coerce") ty `thenRn` \ ty' ->
650 returnRn (UfCoerce ty')
652 rnNote (UfSCC cc) = returnRn (UfSCC cc)
653 rnNote UfInlineCall = returnRn UfInlineCall
654 rnNote UfInlineMe = returnRn UfInlineMe
660 rnUfCon (UfTupleAlt (HsTupCon _ boxity arity))
661 = returnRn (UfTupleAlt (HsTupCon tup_name boxity arity))
663 tup_name = getName (tupleCon boxity arity)
665 rnUfCon (UfDataAlt con)
666 = lookupOccRn con `thenRn` \ con' ->
667 returnRn (UfDataAlt con')
669 rnUfCon (UfLitAlt lit)
670 = returnRn (UfLitAlt lit)
672 rnUfCon (UfLitLitAlt lit ty)
673 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
674 returnRn (UfLitLitAlt lit ty')
677 %*********************************************************
679 \subsection{Rule shapes}
681 %*********************************************************
683 Check the shape of a transformation rule LHS. Currently
684 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
685 not one of the @forall@'d variables.
688 validRuleLhs foralls lhs
691 check (OpApp _ op _ _) = check op
692 check (HsApp e1 e2) = check e1
693 check (HsVar v) | v `notElem` foralls = True
698 %*********************************************************
702 %*********************************************************
705 derivingNonStdClassErr clas
706 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
709 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
710 badRuleLhsErr name lhs
711 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
712 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
714 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
717 = sep [ptext SLIT("Rule") <+> doubleQuotes (ptext name) <> colon,
718 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
719 ptext SLIT("does not appear on left hand side")]
721 emptyConDeclsErr tycon
722 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
723 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]