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 extractRuleBndrsTyVars, 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,
28 bindTyVarsRn, bindTyVars2Rn,
29 bindTyVarsFV2Rn, extendTyVarEnvFVRn,
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 ( deRefStablePtr_RDR, newStablePtr_RDR,
41 bindIO_RDR, returnIO_RDR
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 lookupOccRn name `thenRn` \ name' ->
134 rnHsTypeFVs (fo_decl_msg name) ty `thenRn` \ (ty', fvs1) ->
135 lookupOrigNames (extras spec) `thenRn` \ fvs2 ->
136 returnRn (ForeignImport name' ty' spec src_loc, fvs1 `plusFV` fvs2)
138 extras (CDynImport _) = [newStablePtr_RDR, deRefStablePtr_RDR, bindIO_RDR, returnIO_RDR]
141 rnHsForeignDecl (ForeignExport name ty spec src_loc)
142 = pushSrcLocRn src_loc $
143 lookupOccRn name `thenRn` \ name' ->
144 rnHsTypeFVs (fo_decl_msg name) ty `thenRn` \ (ty', fvs1) ->
145 lookupOrigNames [bindIO_RDR, returnIO_RDR] `thenRn` \ fvs2 ->
146 returnRn (ForeignExport name' ty' spec src_loc, fvs1 `plusFV` fvs2)
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 = case inst_ty of
182 HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
184 -- (Slightly strangely) the forall-d tyvars scope over
185 -- the method bindings too
188 -- Rename the bindings
189 -- NB meth_names can be qualified!
190 checkDupNames meth_doc meth_names `thenRn_`
191 extendTyVarEnvFVRn (map hsTyVarName inst_tyvars) (
192 rnMethodBinds [] mbinds
193 ) `thenRn` \ (mbinds', meth_fvs) ->
195 binders = collectMonoBinders mbinds'
196 binder_set = mkNameSet binders
198 -- Rename the prags and signatures.
199 -- Note that the type variables are not in scope here,
200 -- so that instance Eq a => Eq (T a) where
201 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
204 -- But the (unqualified) method names are in scope
205 bindLocalNames binders (
206 renameSigsFVs (okInstDclSig binder_set) uprags
207 ) `thenRn` \ (uprags', prag_fvs) ->
209 returnRn (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
210 meth_fvs `plusFV` prag_fvs)
213 %*********************************************************
217 %*********************************************************
220 rnIfaceRuleDecl (IfaceRule rule_name act vars fn args rhs src_loc)
221 = pushSrcLocRn src_loc $
222 lookupOccRn fn `thenRn` \ fn' ->
223 rnCoreBndrs vars $ \ vars' ->
224 mapRn rnCoreExpr args `thenRn` \ args' ->
225 rnCoreExpr rhs `thenRn` \ rhs' ->
226 returnRn (IfaceRule rule_name act vars' fn' args' rhs' src_loc)
228 rnIfaceRuleDecl (IfaceRuleOut fn rule) -- Builtin rules come this way
229 = lookupOccRn fn `thenRn` \ fn' ->
230 returnRn (IfaceRuleOut fn' rule)
232 rnHsRuleDecl (HsRule rule_name act tvs vars lhs rhs src_loc)
234 pushSrcLocRn src_loc $
236 bindTyVarsFV2Rn doc (map UserTyVar sig_tvs) $ \ sig_tvs' _ ->
237 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
238 mapFvRn rn_var (vars `zip` ids) `thenRn` \ (vars', fv_vars) ->
240 rnExpr lhs `thenRn` \ (lhs', fv_lhs) ->
241 rnExpr rhs `thenRn` \ (rhs', fv_rhs) ->
242 checkRn (validRuleLhs ids lhs')
243 (badRuleLhsErr rule_name lhs') `thenRn_`
245 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
247 mapRn (addErrRn . badRuleVar rule_name) bad_vars `thenRn_`
248 returnRn (HsRule rule_name act sig_tvs' vars' lhs' rhs' src_loc,
249 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
251 doc = text "In the transformation rule" <+> ptext rule_name
252 sig_tvs = extractRuleBndrsTyVars vars
254 get_var (RuleBndr v) = v
255 get_var (RuleBndrSig v _) = v
257 rn_var (RuleBndr v, id) = returnRn (RuleBndr id, emptyFVs)
258 rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t `thenRn` \ (t', fvs) ->
259 returnRn (RuleBndrSig id t', fvs)
263 %*********************************************************
265 \subsection{Type, class and iface sig declarations}
267 %*********************************************************
269 @rnTyDecl@ uses the `global name function' to create a new type
270 declaration in which local names have been replaced by their original
271 names, reporting any unknown names.
273 Renaming type variables is a pain. Because they now contain uniques,
274 it is necessary to pass in an association list which maps a parsed
275 tyvar to its @Name@ representation.
276 In some cases (type signatures of values),
277 it is even necessary to go over the type first
278 in order to get the set of tyvars used by it, make an assoc list,
279 and then go over it again to rename the tyvars!
280 However, we can also do some scoping checks at the same time.
283 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
285 lookupTopBndrRn name `thenRn` \ name' ->
286 rnHsType doc_str ty `thenRn` \ ty' ->
287 mapRn rnIdInfo id_infos `thenRn` \ id_infos' ->
288 returnRn (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
290 doc_str = text "In the interface signature for" <+> quotes (ppr name)
292 rnTyClDecl (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
294 lookupTopBndrRn name `thenRn` \ name' ->
295 returnRn (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
297 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
298 tcdTyVars = tyvars, tcdCons = condecls, tcdNCons = nconstrs,
299 tcdLoc = src_loc, tcdSysNames = sys_names})
300 = pushSrcLocRn src_loc $
301 lookupTopBndrRn tycon `thenRn` \ tycon' ->
302 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
303 rnContext data_doc context `thenRn` \ context' ->
304 checkDupOrQualNames data_doc con_names `thenRn_`
306 -- Check that there's at least one condecl,
307 -- or else we're reading an interface file, or -fglasgow-exts
308 (if null condecls then
309 doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
310 getModeRn `thenRn` \ mode ->
311 checkRn (glaExts || isInterfaceMode mode)
312 (emptyConDeclsErr tycon)
316 mapRn rnConDecl condecls `thenRn` \ condecls' ->
317 mapRn lookupSysBinder sys_names `thenRn` \ sys_names' ->
318 returnRn (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
319 tcdTyVars = tyvars', tcdCons = condecls', tcdNCons = nconstrs,
320 tcdDerivs = Nothing, tcdLoc = src_loc, tcdSysNames = sys_names'})
322 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
323 con_names = map conDeclName condecls
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 bindTyVars2Rn cls_doc tyvars $ \ clas_tyvar_names 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' clas_tyvar_names 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_tyvars 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 -- the derivings of a data decl
410 finishSourceTyClDecl (TyData {tcdDerivs = Just derivs, tcdLoc = src_loc}) -- Derivings in here
411 rn_ty_decl -- Everything else is here
412 = pushSrcLocRn src_loc $
413 mapRn rnDeriv derivs `thenRn` \ derivs' ->
414 returnRn (rn_ty_decl {tcdDerivs = Just derivs'}, mkNameSet derivs')
416 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc}) -- Get mbinds from here
417 rn_cls_decl@(ClassDecl {tcdTyVars = tyvars}) -- Everything else is here
418 -- There are some default-method bindings (abeit possibly empty) so
419 -- this is a source-code class declaration
420 = -- The newLocals call is tiresome: given a generic class decl
423 -- op {| x+y |} (Inl a) = ...
424 -- op {| x+y |} (Inr b) = ...
425 -- op {| a*b |} (a*b) = ...
426 -- we want to name both "x" tyvars with the same unique, so that they are
427 -- easy to group together in the typechecker.
429 pushSrcLocRn src_loc $
430 extendTyVarEnvFVRn (map hsTyVarName tyvars) $
431 getLocalNameEnv `thenRn` \ name_env ->
433 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
434 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
435 not (tv `elemRdrEnv` name_env)]
437 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
438 newLocalsRn gen_rdr_tyvars_w_locs `thenRn` \ gen_tyvars ->
439 rnMethodBinds gen_tyvars mbinds `thenRn` \ (mbinds', meth_fvs) ->
440 returnRn (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
442 meth_doc = text "In the default-methods for class" <+> ppr (tcdName rn_cls_decl)
444 finishSourceTyClDecl _ tycl_decl = returnRn (tycl_decl, emptyFVs)
445 -- Not a class or data type declaration
449 %*********************************************************
451 \subsection{Support code for type/data declarations}
453 %*********************************************************
456 rnDeriv :: RdrName -> RnMS Name
458 = lookupOccRn cls `thenRn` \ clas_name ->
459 checkRn (getUnique clas_name `elem` derivableClassKeys)
460 (derivingNonStdClassErr clas_name) `thenRn_`
465 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
466 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
468 rnConDecl :: RdrNameConDecl -> RnMS RenamedConDecl
469 rnConDecl (ConDecl name wkr tvs cxt details locn)
470 = pushSrcLocRn locn $
471 checkConName name `thenRn_`
472 lookupTopBndrRn name `thenRn` \ new_name ->
474 lookupSysBinder wkr `thenRn` \ new_wkr ->
475 -- See comments with ClassDecl
477 bindTyVarsRn doc tvs $ \ new_tyvars ->
478 rnContext doc cxt `thenRn` \ new_context ->
479 rnConDetails doc locn details `thenRn` \ new_details ->
480 returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn)
482 doc = text "In the definition of data constructor" <+> quotes (ppr name)
484 rnConDetails doc locn (VanillaCon tys)
485 = mapRn (rnBangTy doc) tys `thenRn` \ new_tys ->
486 returnRn (VanillaCon new_tys)
488 rnConDetails doc locn (InfixCon ty1 ty2)
489 = rnBangTy doc ty1 `thenRn` \ new_ty1 ->
490 rnBangTy doc ty2 `thenRn` \ new_ty2 ->
491 returnRn (InfixCon new_ty1 new_ty2)
493 rnConDetails doc locn (RecCon fields)
494 = checkDupOrQualNames doc field_names `thenRn_`
495 mapRn (rnField doc) fields `thenRn` \ new_fields ->
496 returnRn (RecCon new_fields)
498 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
500 rnField doc (names, ty)
501 = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
502 rnBangTy doc ty `thenRn` \ new_ty ->
503 returnRn (new_names, new_ty)
505 rnBangTy doc (BangType s ty)
506 = rnHsType doc ty `thenRn` \ new_ty ->
507 returnRn (BangType s new_ty)
509 -- This data decl will parse OK
511 -- treating "a" as the constructor.
512 -- It is really hard to make the parser spot this malformation.
513 -- So the renamer has to check that the constructor is legal
515 -- We can get an operator as the constructor, even in the prefix form:
516 -- data T = :% Int Int
517 -- from interface files, which always print in prefix form
520 = checkRn (isRdrDataCon name)
525 %*********************************************************
527 \subsection{Support code to rename types}
529 %*********************************************************
532 rnFds :: SDoc -> [FunDep RdrName] -> RnMS [FunDep Name]
538 = rnHsTyVars doc tys1 `thenRn` \ tys1' ->
539 rnHsTyVars doc tys2 `thenRn` \ tys2' ->
540 returnRn (tys1', tys2')
542 rnHsTyVars doc tvs = mapRn (rnHsTyvar doc) tvs
543 rnHsTyvar doc tyvar = lookupOccRn tyvar
546 %*********************************************************
550 %*********************************************************
553 rnIdInfo (HsWorker worker arity)
554 = lookupOccRn worker `thenRn` \ worker' ->
555 returnRn (HsWorker worker' arity)
557 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
558 returnRn (HsUnfold inline expr')
559 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str)
560 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
561 rnIdInfo HsNoCafRefs = returnRn HsNoCafRefs
564 @UfCore@ expressions.
567 rnCoreExpr (UfType ty)
568 = rnHsType (text "unfolding type") ty `thenRn` \ ty' ->
569 returnRn (UfType ty')
572 = lookupOccRn v `thenRn` \ v' ->
578 rnCoreExpr (UfLitLit l ty)
579 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
580 returnRn (UfLitLit l ty')
582 rnCoreExpr (UfFCall cc ty)
583 = rnHsType (text "ccall") ty `thenRn` \ ty' ->
584 returnRn (UfFCall cc ty')
586 rnCoreExpr (UfTuple (HsTupCon _ boxity arity) args)
587 = mapRn rnCoreExpr args `thenRn` \ args' ->
588 returnRn (UfTuple (HsTupCon tup_name boxity arity) args')
590 tup_name = getName (dataConId (tupleCon boxity arity))
591 -- Get the *worker* name and use that
593 rnCoreExpr (UfApp fun arg)
594 = rnCoreExpr fun `thenRn` \ fun' ->
595 rnCoreExpr arg `thenRn` \ arg' ->
596 returnRn (UfApp fun' arg')
598 rnCoreExpr (UfCase scrut bndr alts)
599 = rnCoreExpr scrut `thenRn` \ scrut' ->
600 bindCoreLocalRn bndr $ \ bndr' ->
601 mapRn rnCoreAlt alts `thenRn` \ alts' ->
602 returnRn (UfCase scrut' bndr' alts')
604 rnCoreExpr (UfNote note expr)
605 = rnNote note `thenRn` \ note' ->
606 rnCoreExpr expr `thenRn` \ expr' ->
607 returnRn (UfNote note' expr')
609 rnCoreExpr (UfLam bndr body)
610 = rnCoreBndr bndr $ \ bndr' ->
611 rnCoreExpr body `thenRn` \ body' ->
612 returnRn (UfLam bndr' body')
614 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
615 = rnCoreExpr rhs `thenRn` \ rhs' ->
616 rnCoreBndr bndr $ \ bndr' ->
617 rnCoreExpr body `thenRn` \ body' ->
618 returnRn (UfLet (UfNonRec bndr' rhs') body')
620 rnCoreExpr (UfLet (UfRec pairs) body)
621 = rnCoreBndrs bndrs $ \ bndrs' ->
622 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
623 rnCoreExpr body `thenRn` \ body' ->
624 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
626 (bndrs, rhss) = unzip pairs
630 rnCoreBndr (UfValBinder name ty) thing_inside
631 = rnHsType doc ty `thenRn` \ ty' ->
632 bindCoreLocalRn name $ \ name' ->
633 thing_inside (UfValBinder name' ty')
635 doc = text "unfolding id"
637 rnCoreBndr (UfTyBinder name kind) thing_inside
638 = bindCoreLocalRn name $ \ name' ->
639 thing_inside (UfTyBinder name' kind)
641 rnCoreBndrs [] thing_inside = thing_inside []
642 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
643 rnCoreBndrs bs $ \ names' ->
644 thing_inside (name':names')
648 rnCoreAlt (con, bndrs, rhs)
649 = rnUfCon con `thenRn` \ con' ->
650 bindCoreLocalsRn bndrs $ \ bndrs' ->
651 rnCoreExpr rhs `thenRn` \ rhs' ->
652 returnRn (con', bndrs', rhs')
655 = rnHsType (text "unfolding coerce") ty `thenRn` \ ty' ->
656 returnRn (UfCoerce ty')
658 rnNote (UfSCC cc) = returnRn (UfSCC cc)
659 rnNote UfInlineCall = returnRn UfInlineCall
660 rnNote UfInlineMe = returnRn UfInlineMe
666 rnUfCon (UfTupleAlt (HsTupCon _ boxity arity))
667 = returnRn (UfTupleAlt (HsTupCon tup_name boxity arity))
669 tup_name = getName (tupleCon boxity arity)
671 rnUfCon (UfDataAlt con)
672 = lookupOccRn con `thenRn` \ con' ->
673 returnRn (UfDataAlt con')
675 rnUfCon (UfLitAlt lit)
676 = returnRn (UfLitAlt lit)
678 rnUfCon (UfLitLitAlt lit ty)
679 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
680 returnRn (UfLitLitAlt lit ty')
683 %*********************************************************
685 \subsection{Rule shapes}
687 %*********************************************************
689 Check the shape of a transformation rule LHS. Currently
690 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
691 not one of the @forall@'d variables.
694 validRuleLhs foralls lhs
697 check (OpApp _ op _ _) = check op
698 check (HsApp e1 e2) = check e1
699 check (HsVar v) | v `notElem` foralls = True
704 %*********************************************************
708 %*********************************************************
711 derivingNonStdClassErr clas
712 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
715 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
716 badRuleLhsErr name lhs
717 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
718 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
720 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
723 = sep [ptext SLIT("Rule") <+> doubleQuotes (ptext name) <> colon,
724 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
725 ptext SLIT("does not appear on left hand side")]
727 emptyConDeclsErr tycon
728 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
729 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]