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 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 vars' fn' args' rhs' src_loc)
228 rnHsRuleDecl (HsRule rule_name tvs vars lhs rhs src_loc)
230 pushSrcLocRn src_loc $
232 bindTyVarsFV2Rn doc (map UserTyVar sig_tvs) $ \ sig_tvs' _ ->
233 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
234 mapFvRn rn_var (vars `zip` ids) `thenRn` \ (vars', fv_vars) ->
236 rnExpr lhs `thenRn` \ (lhs', fv_lhs) ->
237 rnExpr rhs `thenRn` \ (rhs', fv_rhs) ->
238 checkRn (validRuleLhs ids lhs')
239 (badRuleLhsErr rule_name lhs') `thenRn_`
241 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
243 mapRn (addErrRn . badRuleVar rule_name) bad_vars `thenRn_`
244 returnRn (HsRule rule_name sig_tvs' vars' lhs' rhs' src_loc,
245 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
247 doc = text "In the transformation rule" <+> ptext rule_name
248 sig_tvs = extractRuleBndrsTyVars vars
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 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 checkDupOrQualNames data_doc con_names `thenRn_`
302 -- Check that there's at least one condecl,
303 -- or else we're reading an interface file, or -fglasgow-exts
304 (if null condecls then
305 doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
306 getModeRn `thenRn` \ mode ->
307 checkRn (glaExts || isInterfaceMode mode)
308 (emptyConDeclsErr tycon)
312 mapRn rnConDecl condecls `thenRn` \ condecls' ->
313 mapRn lookupSysBinder sys_names `thenRn` \ sys_names' ->
314 returnRn (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
315 tcdTyVars = tyvars', tcdCons = condecls', tcdNCons = nconstrs,
316 tcdDerivs = Nothing, tcdLoc = src_loc, tcdSysNames = sys_names'})
318 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
319 con_names = map conDeclName condecls
321 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
322 = pushSrcLocRn src_loc $
323 lookupTopBndrRn name `thenRn` \ name' ->
324 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
325 rnHsType syn_doc ty `thenRn` \ ty' ->
326 returnRn (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
328 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
330 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
331 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
332 tcdSysNames = names, tcdLoc = src_loc})
333 -- Used for both source and interface file decls
334 = pushSrcLocRn src_loc $
336 lookupTopBndrRn cname `thenRn` \ cname' ->
338 -- Deal with the implicit tycon and datacon name
339 -- They aren't in scope (because they aren't visible to the user)
340 -- and what we want to do is simply look them up in the cache;
341 -- we jolly well ought to get a 'hit' there!
342 mapRn lookupSysBinder names `thenRn` \ names' ->
344 -- Tyvars scope over bindings and context
345 bindTyVars2Rn cls_doc tyvars $ \ clas_tyvar_names tyvars' ->
347 -- Check the superclasses
348 rnContext cls_doc context `thenRn` \ context' ->
350 -- Check the functional dependencies
351 rnFds cls_doc fds `thenRn` \ fds' ->
353 -- Check the signatures
354 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
356 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
357 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
359 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
360 mapRn (rnClassOp cname' clas_tyvar_names fds') op_sigs `thenRn` \ sigs' ->
362 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
364 renameSigs (okClsDclSig binders) non_op_sigs `thenRn` \ non_ops' ->
366 -- Typechecker is responsible for checking that we only
367 -- give default-method bindings for things in this class.
368 -- The renamer *could* check this for class decls, but can't
369 -- for instance decls.
371 returnRn (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
372 tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
373 tcdSysNames = names', tcdLoc = src_loc})
375 cls_doc = text "In the declaration for class" <+> ppr cname
376 sig_doc = text "In the signatures for class" <+> ppr cname
378 rnClassOp clas clas_tyvars clas_fds sig@(ClassOpSig op dm_stuff ty locn)
379 = pushSrcLocRn locn $
380 lookupTopBndrRn op `thenRn` \ op_name ->
382 -- Check the signature
383 rnHsSigType (quotes (ppr op)) ty `thenRn` \ new_ty ->
385 -- Make the default-method name
388 -> -- Imported class that has a default method decl
389 -- See comments with tname, snames, above
390 lookupSysBinder dm_rdr_name `thenRn` \ dm_name ->
391 returnRn (DefMeth dm_name)
392 -- An imported class decl for a class decl that had an explicit default
393 -- method, mentions, rather than defines,
394 -- the default method, so we must arrange to pull it in
396 GenDefMeth -> returnRn GenDefMeth
397 NoDefMeth -> returnRn NoDefMeth
398 ) `thenRn` \ dm_stuff' ->
400 returnRn (ClassOpSig op_name dm_stuff' new_ty locn)
402 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
403 -- Used for source file decls only
404 -- Renames the default-bindings of a class decl
405 -- the derivings of a data decl
406 finishSourceTyClDecl (TyData {tcdDerivs = Just derivs, tcdLoc = src_loc}) -- Derivings in here
407 rn_ty_decl -- Everything else is here
408 = pushSrcLocRn src_loc $
409 mapRn rnDeriv derivs `thenRn` \ derivs' ->
410 returnRn (rn_ty_decl {tcdDerivs = Just derivs'}, mkNameSet derivs')
412 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc}) -- Get mbinds from here
413 rn_cls_decl@(ClassDecl {tcdTyVars = tyvars}) -- Everything else is here
414 -- There are some default-method bindings (abeit possibly empty) so
415 -- this is a source-code class declaration
416 = -- The newLocals call is tiresome: given a generic class decl
419 -- op {| x+y |} (Inl a) = ...
420 -- op {| x+y |} (Inr b) = ...
421 -- op {| a*b |} (a*b) = ...
422 -- we want to name both "x" tyvars with the same unique, so that they are
423 -- easy to group together in the typechecker.
425 pushSrcLocRn src_loc $
426 extendTyVarEnvFVRn (map hsTyVarName tyvars) $
427 getLocalNameEnv `thenRn` \ name_env ->
429 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
430 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
431 not (tv `elemRdrEnv` name_env)]
433 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
434 newLocalsRn gen_rdr_tyvars_w_locs `thenRn` \ gen_tyvars ->
435 rnMethodBinds gen_tyvars mbinds `thenRn` \ (mbinds', meth_fvs) ->
436 returnRn (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
438 meth_doc = text "In the default-methods for class" <+> ppr (tcdName rn_cls_decl)
440 finishSourceTyClDecl _ tycl_decl = returnRn (tycl_decl, emptyFVs)
441 -- Not a class or data type declaration
445 %*********************************************************
447 \subsection{Support code for type/data declarations}
449 %*********************************************************
452 rnDeriv :: RdrName -> RnMS Name
454 = lookupOccRn cls `thenRn` \ clas_name ->
455 checkRn (getUnique clas_name `elem` derivableClassKeys)
456 (derivingNonStdClassErr clas_name) `thenRn_`
461 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
462 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
464 rnConDecl :: RdrNameConDecl -> RnMS RenamedConDecl
465 rnConDecl (ConDecl name wkr tvs cxt details locn)
466 = pushSrcLocRn locn $
467 checkConName name `thenRn_`
468 lookupTopBndrRn name `thenRn` \ new_name ->
470 lookupSysBinder wkr `thenRn` \ new_wkr ->
471 -- See comments with ClassDecl
473 bindTyVarsRn doc tvs $ \ new_tyvars ->
474 rnContext doc cxt `thenRn` \ new_context ->
475 rnConDetails doc locn details `thenRn` \ new_details ->
476 returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn)
478 doc = text "In the definition of data constructor" <+> quotes (ppr name)
480 rnConDetails doc locn (VanillaCon tys)
481 = mapRn (rnBangTy doc) tys `thenRn` \ new_tys ->
482 returnRn (VanillaCon new_tys)
484 rnConDetails doc locn (InfixCon ty1 ty2)
485 = rnBangTy doc ty1 `thenRn` \ new_ty1 ->
486 rnBangTy doc ty2 `thenRn` \ new_ty2 ->
487 returnRn (InfixCon new_ty1 new_ty2)
489 rnConDetails doc locn (RecCon fields)
490 = checkDupOrQualNames doc field_names `thenRn_`
491 mapRn (rnField doc) fields `thenRn` \ new_fields ->
492 returnRn (RecCon new_fields)
494 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
496 rnField doc (names, ty)
497 = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
498 rnBangTy doc ty `thenRn` \ new_ty ->
499 returnRn (new_names, new_ty)
501 rnBangTy doc (BangType s ty)
502 = rnHsType doc ty `thenRn` \ new_ty ->
503 returnRn (BangType s new_ty)
505 -- This data decl will parse OK
507 -- treating "a" as the constructor.
508 -- It is really hard to make the parser spot this malformation.
509 -- So the renamer has to check that the constructor is legal
511 -- We can get an operator as the constructor, even in the prefix form:
512 -- data T = :% Int Int
513 -- from interface files, which always print in prefix form
516 = checkRn (isRdrDataCon name)
521 %*********************************************************
523 \subsection{Support code to rename types}
525 %*********************************************************
528 rnFds :: SDoc -> [FunDep RdrName] -> RnMS [FunDep Name]
534 = rnHsTyVars doc tys1 `thenRn` \ tys1' ->
535 rnHsTyVars doc tys2 `thenRn` \ tys2' ->
536 returnRn (tys1', tys2')
538 rnHsTyVars doc tvs = mapRn (rnHsTyvar doc) tvs
539 rnHsTyvar doc tyvar = lookupOccRn tyvar
542 %*********************************************************
546 %*********************************************************
549 rnIdInfo (HsWorker worker arity)
550 = lookupOccRn worker `thenRn` \ worker' ->
551 returnRn (HsWorker worker' arity)
553 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
554 returnRn (HsUnfold inline expr')
555 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str)
556 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
557 rnIdInfo HsNoCafRefs = returnRn HsNoCafRefs
560 @UfCore@ expressions.
563 rnCoreExpr (UfType ty)
564 = rnHsType (text "unfolding type") ty `thenRn` \ ty' ->
565 returnRn (UfType ty')
568 = lookupOccRn v `thenRn` \ v' ->
574 rnCoreExpr (UfLitLit l ty)
575 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
576 returnRn (UfLitLit l ty')
578 rnCoreExpr (UfFCall cc ty)
579 = rnHsType (text "ccall") ty `thenRn` \ ty' ->
580 returnRn (UfFCall cc ty')
582 rnCoreExpr (UfTuple (HsTupCon _ boxity arity) args)
583 = mapRn rnCoreExpr args `thenRn` \ args' ->
584 returnRn (UfTuple (HsTupCon tup_name boxity arity) args')
586 tup_name = getName (dataConId (tupleCon boxity arity))
587 -- Get the *worker* name and use that
589 rnCoreExpr (UfApp fun arg)
590 = rnCoreExpr fun `thenRn` \ fun' ->
591 rnCoreExpr arg `thenRn` \ arg' ->
592 returnRn (UfApp fun' arg')
594 rnCoreExpr (UfCase scrut bndr alts)
595 = rnCoreExpr scrut `thenRn` \ scrut' ->
596 bindCoreLocalRn bndr $ \ bndr' ->
597 mapRn rnCoreAlt alts `thenRn` \ alts' ->
598 returnRn (UfCase scrut' bndr' alts')
600 rnCoreExpr (UfNote note expr)
601 = rnNote note `thenRn` \ note' ->
602 rnCoreExpr expr `thenRn` \ expr' ->
603 returnRn (UfNote note' expr')
605 rnCoreExpr (UfLam bndr body)
606 = rnCoreBndr bndr $ \ bndr' ->
607 rnCoreExpr body `thenRn` \ body' ->
608 returnRn (UfLam bndr' body')
610 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
611 = rnCoreExpr rhs `thenRn` \ rhs' ->
612 rnCoreBndr bndr $ \ bndr' ->
613 rnCoreExpr body `thenRn` \ body' ->
614 returnRn (UfLet (UfNonRec bndr' rhs') body')
616 rnCoreExpr (UfLet (UfRec pairs) body)
617 = rnCoreBndrs bndrs $ \ bndrs' ->
618 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
619 rnCoreExpr body `thenRn` \ body' ->
620 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
622 (bndrs, rhss) = unzip pairs
626 rnCoreBndr (UfValBinder name ty) thing_inside
627 = rnHsType doc ty `thenRn` \ ty' ->
628 bindCoreLocalRn name $ \ name' ->
629 thing_inside (UfValBinder name' ty')
631 doc = text "unfolding id"
633 rnCoreBndr (UfTyBinder name kind) thing_inside
634 = bindCoreLocalRn name $ \ name' ->
635 thing_inside (UfTyBinder name' kind)
637 rnCoreBndrs [] thing_inside = thing_inside []
638 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
639 rnCoreBndrs bs $ \ names' ->
640 thing_inside (name':names')
644 rnCoreAlt (con, bndrs, rhs)
645 = rnUfCon con `thenRn` \ con' ->
646 bindCoreLocalsRn bndrs $ \ bndrs' ->
647 rnCoreExpr rhs `thenRn` \ rhs' ->
648 returnRn (con', bndrs', rhs')
651 = rnHsType (text "unfolding coerce") ty `thenRn` \ ty' ->
652 returnRn (UfCoerce ty')
654 rnNote (UfSCC cc) = returnRn (UfSCC cc)
655 rnNote UfInlineCall = returnRn UfInlineCall
656 rnNote UfInlineMe = returnRn UfInlineMe
662 rnUfCon (UfTupleAlt (HsTupCon _ boxity arity))
663 = returnRn (UfTupleAlt (HsTupCon tup_name boxity arity))
665 tup_name = getName (tupleCon boxity arity)
667 rnUfCon (UfDataAlt con)
668 = lookupOccRn con `thenRn` \ con' ->
669 returnRn (UfDataAlt con')
671 rnUfCon (UfLitAlt lit)
672 = returnRn (UfLitAlt lit)
674 rnUfCon (UfLitLitAlt lit ty)
675 = rnHsType (text "litlit") ty `thenRn` \ ty' ->
676 returnRn (UfLitLitAlt lit ty')
679 %*********************************************************
681 \subsection{Rule shapes}
683 %*********************************************************
685 Check the shape of a transformation rule LHS. Currently
686 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
687 not one of the @forall@'d variables.
690 validRuleLhs foralls lhs
693 check (OpApp _ op _ _) = check op
694 check (HsApp e1 e2) = check e1
695 check (HsVar v) | v `notElem` foralls = True
700 %*********************************************************
704 %*********************************************************
707 derivingNonStdClassErr clas
708 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
711 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
712 badRuleLhsErr name lhs
713 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
714 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
716 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
719 = sep [ptext SLIT("Rule") <+> doubleQuotes (ptext name) <> colon,
720 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
721 ptext SLIT("does not appear on left hand side")]
723 emptyConDeclsErr tycon
724 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
725 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]