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 )
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, bindTyVars2Rn,
30 bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
31 checkDupOrQualNames, checkDupNames, mapFvRn
35 import Class ( FunDep, DefMeth (..) )
36 import DataCon ( dataConId )
37 import Name ( Name, NamedThing(..) )
39 import PrelInfo ( derivableClassKeys )
40 import PrelNames ( deRefStablePtrName, newStablePtrName,
41 bindIOName, returnIOName
43 import TysWiredIn ( tupleCon )
44 import List ( partition )
46 import SrcLoc ( SrcLoc )
47 import CmdLineOpts ( DynFlag(..) )
48 -- Warn of unused for-all'd tyvars
49 import Unique ( Uniquable(..) )
50 import Maybes ( maybeToBool )
53 @rnSourceDecl@ `renames' declarations.
54 It simultaneously performs dependency analysis and precedence parsing.
55 It also does the following error checks:
58 Checks that tyvars are used properly. This includes checking
59 for undefined tyvars, and tyvars in contexts that are ambiguous.
60 (Some of this checking has now been moved to module @TcMonoType@,
61 since we don't have functional dependency information at this point.)
63 Checks that all variable occurences are defined.
65 Checks the @(..)@ etc constraints in the export list.
69 %*********************************************************
71 \subsection{Source code declarations}
73 %*********************************************************
76 rnSourceDecls :: GlobalRdrEnv -> LocalFixityEnv
78 -> RnMG ([RenamedHsDecl], FreeVars)
79 -- The decls get reversed, but that's ok
81 rnSourceDecls gbl_env local_fixity_env decls
82 = initRnMS gbl_env emptyRdrEnv local_fixity_env SourceMode (go emptyFVs [] decls)
84 -- Fixity and deprecations have been dealt with already; ignore them
85 go fvs ds' [] = returnRn (ds', fvs)
86 go fvs ds' (FixD _:ds) = go fvs ds' ds
87 go fvs ds' (DeprecD _:ds) = go fvs ds' ds
88 go fvs ds' (d:ds) = rnSourceDecl d `thenRn` \(d', fvs') ->
89 go (fvs `plusFV` fvs') (d':ds') ds
92 rnSourceDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
94 rnSourceDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
95 returnRn (ValD new_binds, fvs)
97 rnSourceDecl (TyClD tycl_decl)
98 = rnTyClDecl tycl_decl `thenRn` \ new_decl ->
99 finishSourceTyClDecl tycl_decl new_decl `thenRn` \ (new_decl', fvs) ->
100 returnRn (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
102 rnSourceDecl (InstD inst)
103 = rnInstDecl inst `thenRn` \ new_inst ->
104 finishSourceInstDecl inst new_inst `thenRn` \ (new_inst', fvs) ->
105 returnRn (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
107 rnSourceDecl (RuleD rule)
108 = rnHsRuleDecl rule `thenRn` \ (new_rule, fvs) ->
109 returnRn (RuleD new_rule, fvs)
111 rnSourceDecl (ForD ford)
112 = rnHsForeignDecl ford `thenRn` \ (new_ford, fvs) ->
113 returnRn (ForD new_ford, fvs)
115 rnSourceDecl (DefD (DefaultDecl tys src_loc))
116 = pushSrcLocRn src_loc $
117 mapFvRn (rnHsTypeFVs doc_str) tys `thenRn` \ (tys', fvs) ->
118 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
120 doc_str = text "In a `default' declaration"
124 %*********************************************************
126 \subsection{Foreign declarations}
128 %*********************************************************
131 rnHsForeignDecl (ForeignImport name ty spec src_loc)
132 = pushSrcLocRn src_loc $
133 lookupTopBndrRn name `thenRn` \ name' ->
134 rnHsTypeFVs (fo_decl_msg name) ty `thenRn` \ (ty', fvs) ->
135 returnRn (ForeignImport name' ty' spec src_loc, fvs `plusFV` extras spec)
137 extras (CDynImport _) = mkFVs [newStablePtrName, deRefStablePtrName, bindIOName, returnIOName]
138 extras other = emptyFVs
140 rnHsForeignDecl (ForeignExport name ty spec src_loc)
141 = pushSrcLocRn src_loc $
142 lookupOccRn name `thenRn` \ name' ->
143 rnHsTypeFVs (fo_decl_msg name) ty `thenRn` \ (ty', fvs) ->
144 returnRn (ForeignExport name' ty' spec src_loc,
145 mkFVs [bindIOName, returnIOName] `plusFV` fvs)
147 fo_decl_msg name = ptext SLIT("The foreign declaration for") <+> ppr name
151 %*********************************************************
153 \subsection{Instance declarations}
155 %*********************************************************
158 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
159 -- Used for both source and interface file decls
160 = pushSrcLocRn src_loc $
161 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ inst_ty' ->
163 (case maybe_dfun_rdr_name of
164 Nothing -> returnRn Nothing
165 Just dfun_rdr_name -> lookupIfaceName dfun_rdr_name `thenRn` \ dfun_name ->
166 returnRn (Just dfun_name)
167 ) `thenRn` \ maybe_dfun_name ->
169 -- The typechecker checks that all the bindings are for the right class.
170 returnRn (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
172 -- Compare finishSourceTyClDecl
173 finishSourceInstDecl (InstDecl _ mbinds uprags _ _ )
174 (InstDecl inst_ty _ _ maybe_dfun_name src_loc)
175 -- Used for both source decls only
176 = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
178 meth_doc = text "In the bindings in an instance declaration"
179 meth_names = collectLocatedMonoBinders mbinds
180 inst_tyvars = case inst_ty of
181 HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
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 extendTyVarEnvFVRn (map hsTyVarName inst_tyvars) (
191 rnMethodBinds [] 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" <+> ptext 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 (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
291 lookupTopBndrRn name `thenRn` \ name' ->
292 returnRn (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
294 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
295 tcdTyVars = tyvars, tcdCons = condecls, tcdNCons = nconstrs,
296 tcdLoc = src_loc, tcdSysNames = sys_names})
297 = pushSrcLocRn src_loc $
298 lookupTopBndrRn tycon `thenRn` \ tycon' ->
299 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
300 rnContext data_doc context `thenRn` \ context' ->
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 = Nothing, 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 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
323 = pushSrcLocRn src_loc $
324 lookupTopBndrRn name `thenRn` \ name' ->
325 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
326 rnHsType syn_doc ty `thenRn` \ ty' ->
327 returnRn (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
329 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
331 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
332 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
333 tcdSysNames = names, tcdLoc = src_loc})
334 -- Used for both source and interface file decls
335 = pushSrcLocRn src_loc $
337 lookupTopBndrRn cname `thenRn` \ cname' ->
339 -- Deal with the implicit tycon and datacon name
340 -- They aren't in scope (because they aren't visible to the user)
341 -- and what we want to do is simply look them up in the cache;
342 -- we jolly well ought to get a 'hit' there!
343 mapRn lookupSysBinder names `thenRn` \ names' ->
345 -- Tyvars scope over bindings and context
346 bindTyVars2Rn cls_doc tyvars $ \ clas_tyvar_names tyvars' ->
348 -- Check the superclasses
349 rnContext cls_doc context `thenRn` \ context' ->
351 -- Check the functional dependencies
352 rnFds cls_doc fds `thenRn` \ fds' ->
354 -- Check the signatures
355 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
357 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
358 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
360 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
361 mapRn (rnClassOp cname' clas_tyvar_names fds') op_sigs `thenRn` \ sigs' ->
363 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
365 renameSigs (okClsDclSig binders) non_op_sigs `thenRn` \ non_ops' ->
367 -- Typechecker is responsible for checking that we only
368 -- give default-method bindings for things in this class.
369 -- The renamer *could* check this for class decls, but can't
370 -- for instance decls.
372 returnRn (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
373 tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
374 tcdSysNames = names', tcdLoc = src_loc})
376 cls_doc = text "In the declaration for class" <+> ppr cname
377 sig_doc = text "In the signatures for class" <+> ppr cname
379 rnClassOp clas clas_tyvars clas_fds sig@(ClassOpSig op dm_stuff ty locn)
380 = pushSrcLocRn locn $
381 lookupTopBndrRn op `thenRn` \ op_name ->
383 -- Check the signature
384 rnHsSigType (quotes (ppr op)) ty `thenRn` \ new_ty ->
386 -- Make the default-method name
389 -> -- Imported class that has a default method decl
390 -- See comments with tname, snames, above
391 lookupSysBinder dm_rdr_name `thenRn` \ dm_name ->
392 returnRn (DefMeth dm_name)
393 -- An imported class decl for a class decl that had an explicit default
394 -- method, mentions, rather than defines,
395 -- the default method, so we must arrange to pull it in
397 GenDefMeth -> returnRn GenDefMeth
398 NoDefMeth -> returnRn NoDefMeth
399 ) `thenRn` \ dm_stuff' ->
401 returnRn (ClassOpSig op_name dm_stuff' new_ty locn)
403 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
404 -- Used for source file decls only
405 -- Renames the default-bindings of a class decl
406 -- the derivings of a data decl
407 finishSourceTyClDecl (TyData {tcdDerivs = Just derivs, tcdLoc = src_loc}) -- Derivings in here
408 rn_ty_decl -- Everything else is here
409 = pushSrcLocRn src_loc $
410 mapRn rnDeriv derivs `thenRn` \ derivs' ->
411 returnRn (rn_ty_decl {tcdDerivs = Just derivs'}, mkNameSet derivs')
413 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc}) -- Get mbinds from here
414 rn_cls_decl@(ClassDecl {tcdTyVars = tyvars}) -- Everything else is here
415 -- There are some default-method bindings (abeit possibly empty) so
416 -- this is a source-code class declaration
417 = -- The newLocals call is tiresome: given a generic class decl
420 -- op {| x+y |} (Inl a) = ...
421 -- op {| x+y |} (Inr b) = ...
422 -- op {| a*b |} (a*b) = ...
423 -- we want to name both "x" tyvars with the same unique, so that they are
424 -- easy to group together in the typechecker.
426 pushSrcLocRn src_loc $
427 extendTyVarEnvFVRn (map hsTyVarName tyvars) $
428 getLocalNameEnv `thenRn` \ name_env ->
430 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
431 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
432 not (tv `elemRdrEnv` name_env)]
434 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
435 newLocalsRn gen_rdr_tyvars_w_locs `thenRn` \ gen_tyvars ->
436 rnMethodBinds gen_tyvars mbinds `thenRn` \ (mbinds', meth_fvs) ->
437 returnRn (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
439 meth_doc = text "In the default-methods for class" <+> ppr (tcdName rn_cls_decl)
441 finishSourceTyClDecl _ tycl_decl = returnRn (tycl_decl, emptyFVs)
442 -- Not a class or data type declaration
446 %*********************************************************
448 \subsection{Support code for type/data declarations}
450 %*********************************************************
453 rnDeriv :: RdrName -> RnMS Name
455 = lookupOccRn cls `thenRn` \ clas_name ->
456 checkRn (getUnique clas_name `elem` derivableClassKeys)
457 (derivingNonStdClassErr clas_name) `thenRn_`
462 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
463 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
465 rnConDecl :: RdrNameConDecl -> RnMS RenamedConDecl
466 rnConDecl (ConDecl name wkr tvs cxt details locn)
467 = pushSrcLocRn locn $
468 checkConName name `thenRn_`
469 lookupTopBndrRn name `thenRn` \ new_name ->
471 lookupSysBinder wkr `thenRn` \ new_wkr ->
472 -- See comments with ClassDecl
474 bindTyVarsRn doc tvs $ \ new_tyvars ->
475 rnContext doc cxt `thenRn` \ new_context ->
476 rnConDetails doc locn details `thenRn` \ new_details ->
477 returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn)
479 doc = text "In the definition of data constructor" <+> quotes (ppr name)
481 rnConDetails doc locn (VanillaCon tys)
482 = mapRn (rnBangTy doc) tys `thenRn` \ new_tys ->
483 returnRn (VanillaCon new_tys)
485 rnConDetails doc locn (InfixCon ty1 ty2)
486 = rnBangTy doc ty1 `thenRn` \ new_ty1 ->
487 rnBangTy doc ty2 `thenRn` \ new_ty2 ->
488 returnRn (InfixCon new_ty1 new_ty2)
490 rnConDetails doc locn (RecCon fields)
491 = checkDupOrQualNames doc field_names `thenRn_`
492 mapRn (rnField doc) fields `thenRn` \ new_fields ->
493 returnRn (RecCon new_fields)
495 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
497 rnField doc (names, ty)
498 = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
499 rnBangTy doc ty `thenRn` \ new_ty ->
500 returnRn (new_names, new_ty)
502 rnBangTy doc (BangType s ty)
503 = rnHsType doc ty `thenRn` \ new_ty ->
504 returnRn (BangType s new_ty)
506 -- This data decl will parse OK
508 -- treating "a" as the constructor.
509 -- It is really hard to make the parser spot this malformation.
510 -- So the renamer has to check that the constructor is legal
512 -- We can get an operator as the constructor, even in the prefix form:
513 -- data T = :% Int Int
514 -- from interface files, which always print in prefix form
517 = checkRn (isRdrDataCon name)
522 %*********************************************************
524 \subsection{Support code to rename types}
526 %*********************************************************
529 rnFds :: SDoc -> [FunDep RdrName] -> RnMS [FunDep Name]
535 = rnHsTyVars doc tys1 `thenRn` \ tys1' ->
536 rnHsTyVars doc tys2 `thenRn` \ tys2' ->
537 returnRn (tys1', tys2')
539 rnHsTyVars doc tvs = mapRn (rnHsTyvar doc) tvs
540 rnHsTyvar doc tyvar = lookupOccRn tyvar
543 %*********************************************************
547 %*********************************************************
550 rnIdInfo (HsWorker worker arity)
551 = lookupOccRn worker `thenRn` \ worker' ->
552 returnRn (HsWorker worker' arity)
554 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
555 returnRn (HsUnfold inline expr')
556 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str)
557 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
558 rnIdInfo HsNoCafRefs = returnRn HsNoCafRefs
561 @UfCore@ expressions.
564 rnCoreExpr (UfType ty)
565 = rnHsType (text "unfolding type") ty `thenRn` \ ty' ->
566 returnRn (UfType ty')
569 = lookupOccRn v `thenRn` \ v' ->
575 rnCoreExpr (UfLitLit l ty)
576 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
577 returnRn (UfLitLit l ty')
579 rnCoreExpr (UfFCall cc ty)
580 = rnHsType (text "ccall") ty `thenRn` \ ty' ->
581 returnRn (UfFCall cc ty')
583 rnCoreExpr (UfTuple (HsTupCon _ boxity arity) args)
584 = mapRn rnCoreExpr args `thenRn` \ args' ->
585 returnRn (UfTuple (HsTupCon tup_name boxity arity) args')
587 tup_name = getName (dataConId (tupleCon boxity arity))
588 -- Get the *worker* name and use that
590 rnCoreExpr (UfApp fun arg)
591 = rnCoreExpr fun `thenRn` \ fun' ->
592 rnCoreExpr arg `thenRn` \ arg' ->
593 returnRn (UfApp fun' arg')
595 rnCoreExpr (UfCase scrut bndr alts)
596 = rnCoreExpr scrut `thenRn` \ scrut' ->
597 bindCoreLocalRn bndr $ \ bndr' ->
598 mapRn rnCoreAlt alts `thenRn` \ alts' ->
599 returnRn (UfCase scrut' bndr' alts')
601 rnCoreExpr (UfNote note expr)
602 = rnNote note `thenRn` \ note' ->
603 rnCoreExpr expr `thenRn` \ expr' ->
604 returnRn (UfNote note' expr')
606 rnCoreExpr (UfLam bndr body)
607 = rnCoreBndr bndr $ \ bndr' ->
608 rnCoreExpr body `thenRn` \ body' ->
609 returnRn (UfLam bndr' body')
611 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
612 = rnCoreExpr rhs `thenRn` \ rhs' ->
613 rnCoreBndr bndr $ \ bndr' ->
614 rnCoreExpr body `thenRn` \ body' ->
615 returnRn (UfLet (UfNonRec bndr' rhs') body')
617 rnCoreExpr (UfLet (UfRec pairs) body)
618 = rnCoreBndrs bndrs $ \ bndrs' ->
619 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
620 rnCoreExpr body `thenRn` \ body' ->
621 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
623 (bndrs, rhss) = unzip pairs
627 rnCoreBndr (UfValBinder name ty) thing_inside
628 = rnHsType doc ty `thenRn` \ ty' ->
629 bindCoreLocalRn name $ \ name' ->
630 thing_inside (UfValBinder name' ty')
632 doc = text "unfolding id"
634 rnCoreBndr (UfTyBinder name kind) thing_inside
635 = bindCoreLocalRn name $ \ name' ->
636 thing_inside (UfTyBinder name' kind)
638 rnCoreBndrs [] thing_inside = thing_inside []
639 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
640 rnCoreBndrs bs $ \ names' ->
641 thing_inside (name':names')
645 rnCoreAlt (con, bndrs, rhs)
646 = rnUfCon con `thenRn` \ con' ->
647 bindCoreLocalsRn bndrs $ \ bndrs' ->
648 rnCoreExpr rhs `thenRn` \ rhs' ->
649 returnRn (con', bndrs', rhs')
652 = rnHsType (text "unfolding coerce") ty `thenRn` \ ty' ->
653 returnRn (UfCoerce ty')
655 rnNote (UfSCC cc) = returnRn (UfSCC cc)
656 rnNote UfInlineCall = returnRn UfInlineCall
657 rnNote UfInlineMe = returnRn UfInlineMe
663 rnUfCon (UfTupleAlt (HsTupCon _ boxity arity))
664 = returnRn (UfTupleAlt (HsTupCon tup_name boxity arity))
666 tup_name = getName (tupleCon boxity arity)
668 rnUfCon (UfDataAlt con)
669 = lookupOccRn con `thenRn` \ con' ->
670 returnRn (UfDataAlt con')
672 rnUfCon (UfLitAlt lit)
673 = returnRn (UfLitAlt lit)
675 rnUfCon (UfLitLitAlt lit ty)
676 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
677 returnRn (UfLitLitAlt lit ty')
680 %*********************************************************
682 \subsection{Rule shapes}
684 %*********************************************************
686 Check the shape of a transformation rule LHS. Currently
687 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
688 not one of the @forall@'d variables.
691 validRuleLhs foralls lhs
694 check (OpApp _ op _ _) = check op
695 check (HsApp e1 e2) = check e1
696 check (HsVar v) | v `notElem` foralls = True
701 %*********************************************************
705 %*********************************************************
708 derivingNonStdClassErr clas
709 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
712 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
713 badRuleLhsErr name lhs
714 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
715 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
717 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
720 = sep [ptext SLIT("Rule") <+> doubleQuotes (ptext name) <> colon,
721 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
722 ptext SLIT("does not appear on left hand side")]
724 emptyConDeclsErr tycon
725 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
726 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]