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 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 PrelNames ( deRefStablePtrName, newStablePtrName,
39 bindIOName, returnIOName
41 import TysWiredIn ( tupleCon )
42 import List ( partition )
44 import SrcLoc ( SrcLoc )
45 import CmdLineOpts ( DynFlag(..) )
46 -- Warn of unused for-all'd tyvars
47 import Maybes ( maybeToBool )
48 import Maybe ( maybe )
51 @rnSourceDecl@ `renames' declarations.
52 It simultaneously performs dependency analysis and precedence parsing.
53 It also does the following error checks:
56 Checks that tyvars are used properly. This includes checking
57 for undefined tyvars, and tyvars in contexts that are ambiguous.
58 (Some of this checking has now been moved to module @TcMonoType@,
59 since we don't have functional dependency information at this point.)
61 Checks that all variable occurences are defined.
63 Checks the @(..)@ etc constraints in the export list.
67 %*********************************************************
69 \subsection{Source code declarations}
71 %*********************************************************
74 rnSourceDecls :: GlobalRdrEnv -> AvailEnv -> LocalFixityEnv
76 -> RnMG ([RenamedHsDecl], FreeVars)
77 -- The decls get reversed, but that's ok
79 rnSourceDecls gbl_env avails local_fixity_env decls
80 = initRnMS gbl_env avails emptyRdrEnv local_fixity_env SourceMode (go emptyFVs [] decls)
82 -- Fixity and deprecations have been dealt with already; ignore them
83 go fvs ds' [] = returnRn (ds', fvs)
84 go fvs ds' (FixD _:ds) = go fvs ds' ds
85 go fvs ds' (DeprecD _:ds) = go fvs ds' ds
86 go fvs ds' (d:ds) = rnSourceDecl d `thenRn` \(d', fvs') ->
87 go (fvs `plusFV` fvs') (d':ds') ds
90 rnSourceDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
92 rnSourceDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
93 returnRn (ValD new_binds, fvs)
95 rnSourceDecl (TyClD tycl_decl)
96 = rnTyClDecl tycl_decl `thenRn` \ new_decl ->
97 finishSourceTyClDecl tycl_decl new_decl `thenRn` \ (new_decl', fvs) ->
98 returnRn (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
100 rnSourceDecl (InstD inst)
101 = rnInstDecl inst `thenRn` \ new_inst ->
102 finishSourceInstDecl inst new_inst `thenRn` \ (new_inst', fvs) ->
103 returnRn (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
105 rnSourceDecl (RuleD rule)
106 = rnHsRuleDecl rule `thenRn` \ (new_rule, fvs) ->
107 returnRn (RuleD new_rule, fvs)
109 rnSourceDecl (ForD ford)
110 = rnHsForeignDecl ford `thenRn` \ (new_ford, fvs) ->
111 returnRn (ForD new_ford, fvs)
113 rnSourceDecl (DefD (DefaultDecl tys src_loc))
114 = pushSrcLocRn src_loc $
115 mapFvRn (rnHsTypeFVs doc_str) tys `thenRn` \ (tys', fvs) ->
116 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
118 doc_str = text "In a `default' declaration"
122 %*********************************************************
124 \subsection{Foreign declarations}
126 %*********************************************************
129 rnHsForeignDecl (ForeignImport name ty spec isDeprec src_loc)
130 = pushSrcLocRn src_loc $
131 lookupTopBndrRn name `thenRn` \ name' ->
132 rnHsTypeFVs (fo_decl_msg name) ty `thenRn` \ (ty', fvs) ->
133 returnRn (ForeignImport name' ty' spec isDeprec src_loc,
134 fvs `plusFV` extras spec)
136 extras (CImport _ _ _ _ CWrapper) = mkFVs [newStablePtrName,
138 bindIOName, returnIOName]
141 rnHsForeignDecl (ForeignExport name ty spec isDeprec src_loc)
142 = pushSrcLocRn src_loc $
143 lookupOccRn name `thenRn` \ name' ->
144 rnHsTypeFVs (fo_decl_msg name) ty `thenRn` \ (ty', fvs) ->
145 returnRn (ForeignExport name' ty' spec isDeprec src_loc,
146 mkFVs [bindIOName, returnIOName] `plusFV` fvs)
148 fo_decl_msg name = ptext SLIT("The foreign declaration for") <+> ppr name
152 %*********************************************************
154 \subsection{Instance declarations}
156 %*********************************************************
159 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
160 -- Used for both source and interface file decls
161 = pushSrcLocRn src_loc $
162 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ inst_ty' ->
164 (case maybe_dfun_rdr_name of
165 Nothing -> returnRn Nothing
166 Just dfun_rdr_name -> lookupIfaceName dfun_rdr_name `thenRn` \ dfun_name ->
167 returnRn (Just dfun_name)
168 ) `thenRn` \ maybe_dfun_name ->
170 -- The typechecker checks that all the bindings are for the right class.
171 returnRn (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
173 -- Compare finishSourceTyClDecl
174 finishSourceInstDecl (InstDecl _ mbinds uprags _ _ )
175 (InstDecl inst_ty _ _ maybe_dfun_name src_loc)
176 -- Used for both source decls only
177 = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
179 meth_doc = text "In the bindings in an instance declaration"
180 meth_names = collectLocatedMonoBinders mbinds
181 (inst_tyvars, (cls,_)) = getHsInstHead inst_ty
182 -- (Slightly strangely) the forall-d tyvars scope over
183 -- the method bindings too
186 -- Rename the bindings
187 -- NB meth_names can be qualified!
188 checkDupNames meth_doc meth_names `thenRn_`
189 extendTyVarEnvFVRn (map hsTyVarName inst_tyvars) (
190 rnMethodBinds cls [] mbinds
191 ) `thenRn` \ (mbinds', meth_fvs) ->
193 binders = collectMonoBinders mbinds'
194 binder_set = mkNameSet binders
196 -- Rename the prags and signatures.
197 -- Note that the type variables are not in scope here,
198 -- so that instance Eq a => Eq (T a) where
199 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
202 -- But the (unqualified) method names are in scope
203 bindLocalNames binders (
204 renameSigsFVs (okInstDclSig binder_set) uprags
205 ) `thenRn` \ (uprags', prag_fvs) ->
207 returnRn (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
208 meth_fvs `plusFV` prag_fvs)
211 %*********************************************************
215 %*********************************************************
218 rnIfaceRuleDecl (IfaceRule rule_name act vars fn args rhs src_loc)
219 = pushSrcLocRn src_loc $
220 lookupOccRn fn `thenRn` \ fn' ->
221 rnCoreBndrs vars $ \ vars' ->
222 mapRn rnCoreExpr args `thenRn` \ args' ->
223 rnCoreExpr rhs `thenRn` \ rhs' ->
224 returnRn (IfaceRule rule_name act vars' fn' args' rhs' src_loc)
226 rnIfaceRuleDecl (IfaceRuleOut fn rule) -- Builtin rules come this way
227 = lookupOccRn fn `thenRn` \ fn' ->
228 returnRn (IfaceRuleOut fn' rule)
230 rnHsRuleDecl (HsRule rule_name act vars lhs rhs src_loc)
231 = pushSrcLocRn src_loc $
232 bindPatSigTyVars (collectRuleBndrSigTys vars) $
234 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
235 mapFvRn rn_var (vars `zip` ids) `thenRn` \ (vars', fv_vars) ->
237 rnExpr lhs `thenRn` \ (lhs', fv_lhs) ->
238 rnExpr rhs `thenRn` \ (rhs', fv_rhs) ->
239 checkRn (validRuleLhs ids lhs')
240 (badRuleLhsErr rule_name lhs') `thenRn_`
242 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
244 mapRn (addErrRn . badRuleVar rule_name) bad_vars `thenRn_`
245 returnRn (HsRule rule_name act vars' lhs' rhs' src_loc,
246 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
248 doc = text "In the transformation rule" <+> ptext rule_name
250 get_var (RuleBndr v) = v
251 get_var (RuleBndrSig v _) = v
253 rn_var (RuleBndr v, id) = returnRn (RuleBndr id, emptyFVs)
254 rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t `thenRn` \ (t', fvs) ->
255 returnRn (RuleBndrSig id t', fvs)
259 %*********************************************************
261 \subsection{Type, class and iface sig declarations}
263 %*********************************************************
265 @rnTyDecl@ uses the `global name function' to create a new type
266 declaration in which local names have been replaced by their original
267 names, reporting any unknown names.
269 Renaming type variables is a pain. Because they now contain uniques,
270 it is necessary to pass in an association list which maps a parsed
271 tyvar to its @Name@ representation.
272 In some cases (type signatures of values),
273 it is even necessary to go over the type first
274 in order to get the set of tyvars used by it, make an assoc list,
275 and then go over it again to rename the tyvars!
276 However, we can also do some scoping checks at the same time.
279 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
281 lookupTopBndrRn name `thenRn` \ name' ->
282 rnHsType doc_str ty `thenRn` \ ty' ->
283 mapRn rnIdInfo id_infos `thenRn` \ id_infos' ->
284 returnRn (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
286 doc_str = text "In the interface signature for" <+> quotes (ppr name)
288 rnTyClDecl (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
290 lookupTopBndrRn name `thenRn` \ name' ->
291 returnRn (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
293 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
294 tcdTyVars = tyvars, tcdCons = condecls, tcdNCons = nconstrs,
295 tcdDerivs = derivs, tcdLoc = src_loc, tcdSysNames = sys_names})
296 = pushSrcLocRn src_loc $
297 lookupTopBndrRn tycon `thenRn` \ tycon' ->
298 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
299 rnContext data_doc context `thenRn` \ context' ->
300 rn_derivs derivs `thenRn` \ derivs' ->
301 checkDupOrQualNames data_doc con_names `thenRn_`
303 -- Check that there's at least one condecl,
304 -- or else we're reading an interface file, or -fglasgow-exts
305 (if null condecls then
306 doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
307 getModeRn `thenRn` \ mode ->
308 checkRn (glaExts || isInterfaceMode mode)
309 (emptyConDeclsErr tycon)
313 mapRn rnConDecl condecls `thenRn` \ condecls' ->
314 mapRn lookupSysBinder sys_names `thenRn` \ sys_names' ->
315 returnRn (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
316 tcdTyVars = tyvars', tcdCons = condecls', tcdNCons = nconstrs,
317 tcdDerivs = derivs', tcdLoc = src_loc, tcdSysNames = sys_names'})
319 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
320 con_names = map conDeclName condecls
322 rn_derivs Nothing = returnRn Nothing
323 rn_derivs (Just ds) = rnContext data_doc ds `thenRn` \ ds' -> returnRn (Just ds')
325 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
326 = pushSrcLocRn src_loc $
327 lookupTopBndrRn name `thenRn` \ name' ->
328 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
329 rnHsType syn_doc ty `thenRn` \ ty' ->
330 returnRn (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
332 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
334 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
335 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
336 tcdSysNames = names, tcdLoc = src_loc})
337 -- Used for both source and interface file decls
338 = pushSrcLocRn src_loc $
340 lookupTopBndrRn cname `thenRn` \ cname' ->
342 -- Deal with the implicit tycon and datacon name
343 -- They aren't in scope (because they aren't visible to the user)
344 -- and what we want to do is simply look them up in the cache;
345 -- we jolly well ought to get a 'hit' there!
346 mapRn lookupSysBinder names `thenRn` \ names' ->
348 -- Tyvars scope over bindings and context
349 bindTyVarsRn cls_doc tyvars $ \ tyvars' ->
351 -- Check the superclasses
352 rnContext cls_doc context `thenRn` \ context' ->
354 -- Check the functional dependencies
355 rnFds cls_doc fds `thenRn` \ fds' ->
357 -- Check the signatures
358 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
360 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
361 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
363 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
364 mapRn (rnClassOp cname' fds') op_sigs `thenRn` \ sigs' ->
366 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
368 renameSigs (okClsDclSig binders) non_op_sigs `thenRn` \ non_ops' ->
370 -- Typechecker is responsible for checking that we only
371 -- give default-method bindings for things in this class.
372 -- The renamer *could* check this for class decls, but can't
373 -- for instance decls.
375 returnRn (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
376 tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
377 tcdSysNames = names', tcdLoc = src_loc})
379 cls_doc = text "In the declaration for class" <+> ppr cname
380 sig_doc = text "In the signatures for class" <+> ppr cname
382 rnClassOp clas clas_fds sig@(ClassOpSig op dm_stuff ty locn)
383 = pushSrcLocRn locn $
384 lookupTopBndrRn op `thenRn` \ op_name ->
386 -- Check the signature
387 rnHsSigType (quotes (ppr op)) ty `thenRn` \ new_ty ->
389 -- Make the default-method name
392 -> -- Imported class that has a default method decl
393 -- See comments with tname, snames, above
394 lookupSysBinder dm_rdr_name `thenRn` \ dm_name ->
395 returnRn (DefMeth dm_name)
396 -- An imported class decl for a class decl that had an explicit default
397 -- method, mentions, rather than defines,
398 -- the default method, so we must arrange to pull it in
400 GenDefMeth -> returnRn GenDefMeth
401 NoDefMeth -> returnRn NoDefMeth
402 ) `thenRn` \ dm_stuff' ->
404 returnRn (ClassOpSig op_name dm_stuff' new_ty locn)
406 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
407 -- Used for source file decls only
408 -- Renames the default-bindings of a class decl
409 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc}) -- Get mbinds from here
410 rn_cls_decl@(ClassDecl {tcdName = cls, tcdTyVars = tyvars}) -- Everything else is here
411 -- There are some default-method bindings (abeit possibly empty) so
412 -- this is a source-code class declaration
413 = -- The newLocals call is tiresome: given a generic class decl
416 -- op {| x+y |} (Inl a) = ...
417 -- op {| x+y |} (Inr b) = ...
418 -- op {| a*b |} (a*b) = ...
419 -- we want to name both "x" tyvars with the same unique, so that they are
420 -- easy to group together in the typechecker.
422 pushSrcLocRn src_loc $
423 extendTyVarEnvFVRn (map hsTyVarName tyvars) $
424 getLocalNameEnv `thenRn` \ name_env ->
426 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
427 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
428 not (tv `elemRdrEnv` name_env)]
430 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
431 newLocalsRn gen_rdr_tyvars_w_locs `thenRn` \ gen_tyvars ->
432 rnMethodBinds cls gen_tyvars mbinds `thenRn` \ (mbinds', meth_fvs) ->
433 returnRn (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
435 meth_doc = text "In the default-methods for class" <+> ppr (tcdName rn_cls_decl)
437 finishSourceTyClDecl _ tycl_decl@(TyData {tcdDerivs = derivings})
438 -- Derivings are returned here so that they don't form part of the tyClDeclFVs.
439 -- This is important, because tyClDeclFVs should contain only the
440 -- FVs that are `needed' by the interface file declaration, and
441 -- derivings do not appear in this. It also means that the tcGroups
442 -- are smaller, which turned out to be important for the usage inference. KSW 2002-02.
443 = returnRn (tycl_decl,
444 maybe emptyFVs extractHsCtxtTyNames derivings)
446 finishSourceTyClDecl _ tycl_decl = returnRn (tycl_decl, emptyFVs)
447 -- Not a class declaration
451 %*********************************************************
453 \subsection{Support code for type/data declarations}
455 %*********************************************************
458 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
459 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
461 rnConDecl :: RdrNameConDecl -> RnMS RenamedConDecl
462 rnConDecl (ConDecl name wkr tvs cxt details locn)
463 = pushSrcLocRn locn $
464 checkConName name `thenRn_`
465 lookupTopBndrRn name `thenRn` \ new_name ->
467 lookupSysBinder wkr `thenRn` \ new_wkr ->
468 -- See comments with ClassDecl
470 bindTyVarsRn doc tvs $ \ new_tyvars ->
471 rnContext doc cxt `thenRn` \ new_context ->
472 rnConDetails doc locn details `thenRn` \ new_details ->
473 returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn)
475 doc = text "In the definition of data constructor" <+> quotes (ppr name)
477 rnConDetails doc locn (VanillaCon tys)
478 = mapRn (rnBangTy doc) tys `thenRn` \ new_tys ->
479 returnRn (VanillaCon new_tys)
481 rnConDetails doc locn (InfixCon ty1 ty2)
482 = rnBangTy doc ty1 `thenRn` \ new_ty1 ->
483 rnBangTy doc ty2 `thenRn` \ new_ty2 ->
484 returnRn (InfixCon new_ty1 new_ty2)
486 rnConDetails doc locn (RecCon fields)
487 = checkDupOrQualNames doc field_names `thenRn_`
488 mapRn (rnField doc) fields `thenRn` \ new_fields ->
489 returnRn (RecCon new_fields)
491 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
493 rnField doc (names, ty)
494 = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
495 rnBangTy doc ty `thenRn` \ new_ty ->
496 returnRn (new_names, new_ty)
498 rnBangTy doc (BangType s ty)
499 = rnHsType doc ty `thenRn` \ new_ty ->
500 returnRn (BangType s new_ty)
502 -- This data decl will parse OK
504 -- treating "a" as the constructor.
505 -- It is really hard to make the parser spot this malformation.
506 -- So the renamer has to check that the constructor is legal
508 -- We can get an operator as the constructor, even in the prefix form:
509 -- data T = :% Int Int
510 -- from interface files, which always print in prefix form
513 = checkRn (isRdrDataCon name)
518 %*********************************************************
520 \subsection{Support code to rename types}
522 %*********************************************************
525 rnFds :: SDoc -> [FunDep RdrName] -> RnMS [FunDep Name]
531 = rnHsTyVars doc tys1 `thenRn` \ tys1' ->
532 rnHsTyVars doc tys2 `thenRn` \ tys2' ->
533 returnRn (tys1', tys2')
535 rnHsTyVars doc tvs = mapRn (rnHsTyvar doc) tvs
536 rnHsTyvar doc tyvar = lookupOccRn tyvar
539 %*********************************************************
543 %*********************************************************
546 rnIdInfo (HsWorker worker arity)
547 = lookupOccRn worker `thenRn` \ worker' ->
548 returnRn (HsWorker worker' arity)
550 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
551 returnRn (HsUnfold inline expr')
552 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str)
553 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
554 rnIdInfo HsNoCafRefs = returnRn HsNoCafRefs
557 @UfCore@ expressions.
560 rnCoreExpr (UfType ty)
561 = rnHsType (text "unfolding type") ty `thenRn` \ ty' ->
562 returnRn (UfType ty')
565 = lookupOccRn v `thenRn` \ v' ->
571 rnCoreExpr (UfLitLit l ty)
572 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
573 returnRn (UfLitLit l ty')
575 rnCoreExpr (UfFCall cc ty)
576 = rnHsType (text "ccall") ty `thenRn` \ ty' ->
577 returnRn (UfFCall cc ty')
579 rnCoreExpr (UfTuple (HsTupCon _ boxity arity) args)
580 = mapRn rnCoreExpr args `thenRn` \ args' ->
581 returnRn (UfTuple (HsTupCon tup_name boxity arity) args')
583 tup_name = getName (dataConId (tupleCon boxity arity))
584 -- Get the *worker* name and use that
586 rnCoreExpr (UfApp fun arg)
587 = rnCoreExpr fun `thenRn` \ fun' ->
588 rnCoreExpr arg `thenRn` \ arg' ->
589 returnRn (UfApp fun' arg')
591 rnCoreExpr (UfCase scrut bndr alts)
592 = rnCoreExpr scrut `thenRn` \ scrut' ->
593 bindCoreLocalRn bndr $ \ bndr' ->
594 mapRn rnCoreAlt alts `thenRn` \ alts' ->
595 returnRn (UfCase scrut' bndr' alts')
597 rnCoreExpr (UfNote note expr)
598 = rnNote note `thenRn` \ note' ->
599 rnCoreExpr expr `thenRn` \ expr' ->
600 returnRn (UfNote note' expr')
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 doc ty `thenRn` \ ty' ->
625 bindCoreLocalRn name $ \ name' ->
626 thing_inside (UfValBinder name' ty')
628 doc = text "unfolding id"
630 rnCoreBndr (UfTyBinder name kind) thing_inside
631 = bindCoreLocalRn name $ \ name' ->
632 thing_inside (UfTyBinder name' kind)
634 rnCoreBndrs [] thing_inside = thing_inside []
635 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
636 rnCoreBndrs bs $ \ names' ->
637 thing_inside (name':names')
641 rnCoreAlt (con, bndrs, rhs)
642 = rnUfCon con `thenRn` \ con' ->
643 bindCoreLocalsRn bndrs $ \ bndrs' ->
644 rnCoreExpr rhs `thenRn` \ rhs' ->
645 returnRn (con', bndrs', rhs')
648 = rnHsType (text "unfolding coerce") ty `thenRn` \ ty' ->
649 returnRn (UfCoerce ty')
651 rnNote (UfSCC cc) = returnRn (UfSCC cc)
652 rnNote UfInlineCall = returnRn UfInlineCall
653 rnNote UfInlineMe = returnRn UfInlineMe
659 rnUfCon (UfTupleAlt (HsTupCon _ boxity arity))
660 = returnRn (UfTupleAlt (HsTupCon tup_name boxity arity))
662 tup_name = getName (tupleCon boxity arity)
664 rnUfCon (UfDataAlt con)
665 = lookupOccRn con `thenRn` \ con' ->
666 returnRn (UfDataAlt con')
668 rnUfCon (UfLitAlt lit)
669 = returnRn (UfLitAlt lit)
671 rnUfCon (UfLitLitAlt lit ty)
672 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
673 returnRn (UfLitLitAlt lit ty')
676 %*********************************************************
678 \subsection{Rule shapes}
680 %*********************************************************
682 Check the shape of a transformation rule LHS. Currently
683 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
684 not one of the @forall@'d variables.
687 validRuleLhs foralls lhs
690 check (OpApp _ op _ _) = check op
691 check (HsApp e1 e2) = check e1
692 check (HsVar v) | v `notElem` foralls = True
697 %*********************************************************
701 %*********************************************************
705 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
707 badRuleLhsErr name lhs
708 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
709 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
711 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
714 = sep [ptext SLIT("Rule") <+> doubleQuotes (ptext name) <> colon,
715 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
716 ptext SLIT("does not appear on left hand side")]
718 emptyConDeclsErr tycon
719 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
720 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]