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 TyCon ( DataConDetails(..), visibleDataCons )
36 import DataCon ( dataConWorkId )
37 import Name ( Name, NamedThing(..) )
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 Maybes ( maybeToBool )
49 import Maybe ( maybe )
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 -> RnMode
77 -> RnMG ([RenamedHsDecl], FreeVars)
78 -- The decls get reversed, but that's ok
80 rnSourceDecls gbl_env avails local_fixity_env mode decls
81 = initRnMS gbl_env avails emptyRdrEnv local_fixity_env mode (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 isDeprec 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 isDeprec src_loc,
135 fvs `plusFV` extras spec)
137 extras (CImport _ _ _ _ CWrapper) = mkFVs [newStablePtrName,
139 bindIOName, returnIOName]
142 rnHsForeignDecl (ForeignExport name ty spec isDeprec src_loc)
143 = pushSrcLocRn src_loc $
144 lookupOccRn name `thenRn` \ name' ->
145 rnHsTypeFVs (fo_decl_msg name) ty `thenRn` \ (ty', fvs) ->
146 returnRn (ForeignExport name' ty' spec isDeprec src_loc,
147 mkFVs [bindIOName, returnIOName] `plusFV` fvs)
149 fo_decl_msg name = ptext SLIT("The foreign declaration for") <+> ppr name
153 %*********************************************************
155 \subsection{Instance declarations}
157 %*********************************************************
160 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
161 -- Used for both source and interface file decls
162 = pushSrcLocRn src_loc $
163 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ inst_ty' ->
165 (case maybe_dfun_rdr_name of
166 Nothing -> returnRn Nothing
167 Just dfun_rdr_name -> lookupIfaceName dfun_rdr_name `thenRn` \ dfun_name ->
168 returnRn (Just dfun_name)
169 ) `thenRn` \ maybe_dfun_name ->
171 -- The typechecker checks that all the bindings are for the right class.
172 returnRn (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
174 -- Compare finishSourceTyClDecl
175 finishSourceInstDecl (InstDecl _ mbinds uprags _ _ )
176 (InstDecl inst_ty _ _ maybe_dfun_name src_loc)
177 -- Used for both source decls only
178 = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
180 meth_doc = text "In the bindings in an instance declaration"
181 meth_names = collectLocatedMonoBinders mbinds
182 (inst_tyvars, (cls,_)) = getHsInstHead inst_ty
183 -- (Slightly strangely) the forall-d tyvars scope over
184 -- the method bindings too
187 -- Rename the bindings
188 -- NB meth_names can be qualified!
189 checkDupNames meth_doc meth_names `thenRn_`
190 extendTyVarEnvForMethodBinds inst_tyvars (
191 rnMethodBinds cls [] mbinds
192 ) `thenRn` \ (mbinds', meth_fvs) ->
194 binders = collectMonoBinders mbinds'
195 binder_set = mkNameSet binders
197 -- Rename the prags and signatures.
198 -- Note that the type variables are not in scope here,
199 -- so that instance Eq a => Eq (T a) where
200 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
203 -- But the (unqualified) method names are in scope
204 bindLocalNames binders (
205 renameSigsFVs (okInstDclSig binder_set) uprags
206 ) `thenRn` \ (uprags', prag_fvs) ->
208 returnRn (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
209 meth_fvs `plusFV` prag_fvs)
212 %*********************************************************
216 %*********************************************************
219 rnIfaceRuleDecl (IfaceRule rule_name act vars fn args rhs src_loc)
220 = pushSrcLocRn src_loc $
221 lookupOccRn fn `thenRn` \ fn' ->
222 rnCoreBndrs vars $ \ vars' ->
223 mapRn rnCoreExpr args `thenRn` \ args' ->
224 rnCoreExpr rhs `thenRn` \ rhs' ->
225 returnRn (IfaceRule rule_name act vars' fn' args' rhs' src_loc)
227 rnIfaceRuleDecl (IfaceRuleOut fn rule) -- Builtin rules come this way
228 = lookupOccRn fn `thenRn` \ fn' ->
229 returnRn (IfaceRuleOut fn' rule)
231 rnHsRuleDecl (HsRule rule_name act vars lhs rhs src_loc)
232 = pushSrcLocRn src_loc $
233 bindPatSigTyVars (collectRuleBndrSigTys vars) $
235 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
236 mapFvRn rn_var (vars `zip` ids) `thenRn` \ (vars', fv_vars) ->
238 rnExpr lhs `thenRn` \ (lhs', fv_lhs) ->
239 rnExpr rhs `thenRn` \ (rhs', fv_rhs) ->
240 checkRn (validRuleLhs ids lhs')
241 (badRuleLhsErr rule_name lhs') `thenRn_`
243 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
245 mapRn (addErrRn . badRuleVar rule_name) bad_vars `thenRn_`
246 returnRn (HsRule rule_name act vars' lhs' rhs' src_loc,
247 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
249 doc = text "In the transformation rule" <+> ftext rule_name
251 get_var (RuleBndr v) = v
252 get_var (RuleBndrSig v _) = v
254 rn_var (RuleBndr v, id) = returnRn (RuleBndr id, emptyFVs)
255 rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t `thenRn` \ (t', fvs) ->
256 returnRn (RuleBndrSig id t', fvs)
260 %*********************************************************
262 \subsection{Type, class and iface sig declarations}
264 %*********************************************************
266 @rnTyDecl@ uses the `global name function' to create a new type
267 declaration in which local names have been replaced by their original
268 names, reporting any unknown names.
270 Renaming type variables is a pain. Because they now contain uniques,
271 it is necessary to pass in an association list which maps a parsed
272 tyvar to its @Name@ representation.
273 In some cases (type signatures of values),
274 it is even necessary to go over the type first
275 in order to get the set of tyvars used by it, make an assoc list,
276 and then go over it again to rename the tyvars!
277 However, we can also do some scoping checks at the same time.
280 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
282 lookupTopBndrRn name `thenRn` \ name' ->
283 rnHsType doc_str ty `thenRn` \ ty' ->
284 mapRn rnIdInfo id_infos `thenRn` \ id_infos' ->
285 returnRn (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
287 doc_str = text "In the interface signature for" <+> quotes (ppr name)
289 rnTyClDecl (CoreDecl {tcdName = name, tcdType = ty, tcdRhs = rhs, tcdLoc = loc})
291 lookupTopBndrRn name `thenRn` \ name' ->
292 rnHsType doc_str ty `thenRn` \ ty' ->
293 rnCoreExpr rhs `thenRn` \ rhs' ->
294 returnRn (CoreDecl {tcdName = name', tcdType = ty', tcdRhs = rhs', tcdLoc = loc})
296 doc_str = text "In the Core declaration for" <+> quotes (ppr name)
298 rnTyClDecl (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
300 lookupTopBndrRn name `thenRn` \ name' ->
301 returnRn (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
303 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
304 tcdTyVars = tyvars, tcdCons = condecls,
305 tcdDerivs = derivs, tcdLoc = src_loc, tcdSysNames = sys_names})
306 = pushSrcLocRn src_loc $
307 lookupTopBndrRn tycon `thenRn` \ tycon' ->
308 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
309 rnContext data_doc context `thenRn` \ context' ->
310 rn_derivs derivs `thenRn` \ derivs' ->
311 checkDupOrQualNames data_doc con_names `thenRn_`
313 rnConDecls tycon' 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',
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 (visibleDataCons 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 superclass context and method signatures
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 extendTyVarEnvForMethodBinds 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
450 For the method bindings in class and instance decls, we extend the
451 type variable environment iff -fglasgow-exts
454 extendTyVarEnvForMethodBinds tyvars thing_inside
455 = doptRn Opt_GlasgowExts `thenRn` \ opt_GlasgowExts ->
456 if opt_GlasgowExts then
457 extendTyVarEnvFVRn (map hsTyVarName tyvars) thing_inside
463 %*********************************************************
465 \subsection{Support code for type/data declarations}
467 %*********************************************************
470 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
471 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
473 rnConDecls :: Name -> DataConDetails RdrNameConDecl -> RnMS (DataConDetails RenamedConDecl)
474 rnConDecls tycon Unknown = returnRn Unknown
475 rnConDecls tycon (HasCons n) = returnRn (HasCons n)
476 rnConDecls tycon (DataCons condecls)
477 = -- Check that there's at least one condecl,
478 -- or else we're reading an interface file, or -fglasgow-exts
479 (if null condecls then
480 doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
481 getModeRn `thenRn` \ mode ->
482 checkRn (glaExts || isInterfaceMode mode)
483 (emptyConDeclsErr tycon)
487 mapRn rnConDecl condecls `thenRn` \ condecls' ->
488 returnRn (DataCons condecls')
490 rnConDecl :: RdrNameConDecl -> RnMS RenamedConDecl
491 rnConDecl (ConDecl name wkr tvs cxt details locn)
492 = pushSrcLocRn locn $
493 checkConName name `thenRn_`
494 lookupTopBndrRn name `thenRn` \ new_name ->
496 lookupSysBinder wkr `thenRn` \ new_wkr ->
497 -- See comments with ClassDecl
499 bindTyVarsRn doc tvs $ \ new_tyvars ->
500 rnContext doc cxt `thenRn` \ new_context ->
501 rnConDetails doc locn details `thenRn` \ new_details ->
502 returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn)
504 doc = text "In the definition of data constructor" <+> quotes (ppr name)
506 rnConDetails doc locn (VanillaCon tys)
507 = mapRn (rnBangTy doc) tys `thenRn` \ new_tys ->
508 returnRn (VanillaCon new_tys)
510 rnConDetails doc locn (InfixCon ty1 ty2)
511 = rnBangTy doc ty1 `thenRn` \ new_ty1 ->
512 rnBangTy doc ty2 `thenRn` \ new_ty2 ->
513 returnRn (InfixCon new_ty1 new_ty2)
515 rnConDetails doc locn (RecCon fields)
516 = checkDupOrQualNames doc field_names `thenRn_`
517 mapRn (rnField doc) fields `thenRn` \ new_fields ->
518 returnRn (RecCon new_fields)
520 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
522 rnField doc (names, ty)
523 = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
524 rnBangTy doc ty `thenRn` \ new_ty ->
525 returnRn (new_names, new_ty)
527 rnBangTy doc (BangType s ty)
528 = rnHsType doc ty `thenRn` \ new_ty ->
529 returnRn (BangType s new_ty)
531 -- This data decl will parse OK
533 -- treating "a" as the constructor.
534 -- It is really hard to make the parser spot this malformation.
535 -- So the renamer has to check that the constructor is legal
537 -- We can get an operator as the constructor, even in the prefix form:
538 -- data T = :% Int Int
539 -- from interface files, which always print in prefix form
542 = checkRn (isRdrDataCon name)
547 %*********************************************************
549 \subsection{Support code to rename types}
551 %*********************************************************
554 rnFds :: SDoc -> [FunDep RdrName] -> RnMS [FunDep Name]
560 = rnHsTyVars doc tys1 `thenRn` \ tys1' ->
561 rnHsTyVars doc tys2 `thenRn` \ tys2' ->
562 returnRn (tys1', tys2')
564 rnHsTyVars doc tvs = mapRn (rnHsTyvar doc) tvs
565 rnHsTyvar doc tyvar = lookupOccRn tyvar
568 %*********************************************************
572 %*********************************************************
575 rnIdInfo (HsWorker worker arity)
576 = lookupOccRn worker `thenRn` \ worker' ->
577 returnRn (HsWorker worker' arity)
579 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
580 returnRn (HsUnfold inline expr')
581 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str)
582 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
583 rnIdInfo HsNoCafRefs = returnRn HsNoCafRefs
586 @UfCore@ expressions.
589 rnCoreExpr (UfType ty)
590 = rnHsType (text "unfolding type") ty `thenRn` \ ty' ->
591 returnRn (UfType ty')
594 = lookupOccRn v `thenRn` \ v' ->
600 rnCoreExpr (UfLitLit l ty)
601 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
602 returnRn (UfLitLit l ty')
604 rnCoreExpr (UfFCall cc ty)
605 = rnHsType (text "ccall") ty `thenRn` \ ty' ->
606 returnRn (UfFCall cc ty')
608 rnCoreExpr (UfTuple (HsTupCon _ boxity arity) args)
609 = mapRn rnCoreExpr args `thenRn` \ args' ->
610 returnRn (UfTuple (HsTupCon tup_name boxity arity) args')
612 tup_name = getName (dataConWorkId (tupleCon boxity arity))
613 -- Get the *worker* name and use that
615 rnCoreExpr (UfApp fun arg)
616 = rnCoreExpr fun `thenRn` \ fun' ->
617 rnCoreExpr arg `thenRn` \ arg' ->
618 returnRn (UfApp fun' arg')
620 rnCoreExpr (UfCase scrut bndr alts)
621 = rnCoreExpr scrut `thenRn` \ scrut' ->
622 bindCoreLocalRn bndr $ \ bndr' ->
623 mapRn rnCoreAlt alts `thenRn` \ alts' ->
624 returnRn (UfCase scrut' bndr' alts')
626 rnCoreExpr (UfNote note expr)
627 = rnNote note `thenRn` \ note' ->
628 rnCoreExpr expr `thenRn` \ expr' ->
629 returnRn (UfNote note' expr')
631 rnCoreExpr (UfLam bndr body)
632 = rnCoreBndr bndr $ \ bndr' ->
633 rnCoreExpr body `thenRn` \ body' ->
634 returnRn (UfLam bndr' body')
636 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
637 = rnCoreExpr rhs `thenRn` \ rhs' ->
638 rnCoreBndr bndr $ \ bndr' ->
639 rnCoreExpr body `thenRn` \ body' ->
640 returnRn (UfLet (UfNonRec bndr' rhs') body')
642 rnCoreExpr (UfLet (UfRec pairs) body)
643 = rnCoreBndrs bndrs $ \ bndrs' ->
644 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
645 rnCoreExpr body `thenRn` \ body' ->
646 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
648 (bndrs, rhss) = unzip pairs
652 rnCoreBndr (UfValBinder name ty) thing_inside
653 = rnHsType doc ty `thenRn` \ ty' ->
654 bindCoreLocalRn name $ \ name' ->
655 thing_inside (UfValBinder name' ty')
657 doc = text "unfolding id"
659 rnCoreBndr (UfTyBinder name kind) thing_inside
660 = bindCoreLocalRn name $ \ name' ->
661 thing_inside (UfTyBinder name' kind)
663 rnCoreBndrs [] thing_inside = thing_inside []
664 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
665 rnCoreBndrs bs $ \ names' ->
666 thing_inside (name':names')
670 rnCoreAlt (con, bndrs, rhs)
671 = rnUfCon con `thenRn` \ con' ->
672 bindCoreLocalsRn bndrs $ \ bndrs' ->
673 rnCoreExpr rhs `thenRn` \ rhs' ->
674 returnRn (con', bndrs', rhs')
677 = rnHsType (text "unfolding coerce") ty `thenRn` \ ty' ->
678 returnRn (UfCoerce ty')
680 rnNote (UfSCC cc) = returnRn (UfSCC cc)
681 rnNote UfInlineCall = returnRn UfInlineCall
682 rnNote UfInlineMe = returnRn UfInlineMe
688 rnUfCon (UfTupleAlt (HsTupCon _ boxity arity))
689 = returnRn (UfTupleAlt (HsTupCon tup_name boxity arity))
691 tup_name = getName (tupleCon boxity arity)
693 rnUfCon (UfDataAlt con)
694 = lookupOccRn con `thenRn` \ con' ->
695 returnRn (UfDataAlt con')
697 rnUfCon (UfLitAlt lit)
698 = returnRn (UfLitAlt lit)
700 rnUfCon (UfLitLitAlt lit ty)
701 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
702 returnRn (UfLitLitAlt lit ty')
705 %*********************************************************
707 \subsection{Rule shapes}
709 %*********************************************************
711 Check the shape of a transformation rule LHS. Currently
712 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
713 not one of the @forall@'d variables.
716 validRuleLhs foralls lhs
719 check (OpApp _ op _ _) = check op
720 check (HsApp e1 e2) = check e1
721 check (HsVar v) | v `notElem` foralls = True
726 %*********************************************************
730 %*********************************************************
734 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
736 badRuleLhsErr name lhs
737 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
738 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
740 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
743 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
744 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
745 ptext SLIT("does not appear on left hand side")]
747 emptyConDeclsErr tycon
748 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
749 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]