2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
9 rnHsType, rnLHsType, rnLHsTypes, rnContext,
10 rnHsSigType, rnHsTypeFVs, rnConDeclFields,
12 -- Precence related stuff
13 mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,
14 checkPrecMatch, checkSectionPrec,
16 -- Splice related stuff
20 import {-# SOURCE #-} RnExpr( rnLExpr )
22 import {-# SOURCE #-} TcSplice( runQuasiQuoteType )
27 import RdrHsSyn ( extractHsRhoRdrTyVars )
28 import RnHsSyn ( extractHsTyNames )
29 import RnHsDoc ( rnLHsDoc, rnMbLHsDoc )
34 import TypeRep ( funTyConName )
39 import BasicTypes ( compareFixity, funTyFixity, negateFixity,
40 Fixity(..), FixityDirection(..) )
43 import Control.Monad ( unless )
45 #include "HsVersions.h"
48 These type renamers are in a separate module, rather than in (say) RnSource,
49 to break several loop.
51 %*********************************************************
53 \subsection{Renaming types}
55 %*********************************************************
58 rnHsTypeFVs :: SDoc -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
59 rnHsTypeFVs doc_str ty = do
60 ty' <- rnLHsType doc_str ty
61 return (ty', extractHsTyNames ty')
63 rnHsSigType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
64 -- rnHsSigType is used for source-language type signatures,
65 -- which use *implicit* universal quantification.
66 rnHsSigType doc_str ty
67 = rnLHsType (text "In the type signature for" <+> doc_str) ty
70 rnHsType is here because we call it from loadInstDecl, and I didn't
71 want a gratuitous knot.
74 rnLHsType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
75 rnLHsType doc = wrapLocM (rnHsType doc)
77 rnHsType :: SDoc -> HsType RdrName -> RnM (HsType Name)
79 rnHsType doc (HsForAllTy Implicit _ ctxt ty) = do
80 -- Implicit quantifiction in source code (no kinds on tyvars)
81 -- Given the signature C => T we universally quantify
82 -- over FV(T) \ {in-scope-tyvars}
83 name_env <- getLocalRdrEnv
85 mentioned = extractHsRhoRdrTyVars ctxt ty
87 -- Don't quantify over type variables that are in scope;
88 -- when GlasgowExts is off, there usually won't be any, except for
90 -- class C a where { op :: a -> a }
91 forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env) . unLoc) mentioned
92 tyvar_bndrs = userHsTyVarBndrs forall_tyvars
94 rnForAll doc Implicit tyvar_bndrs ctxt ty
96 rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau) = do
97 -- Explicit quantification.
98 -- Check that the forall'd tyvars are actually
99 -- mentioned in the type, and produce a warning if not
101 mentioned = map unLoc (extractHsRhoRdrTyVars ctxt tau)
102 forall_tyvar_names = hsLTyVarLocNames forall_tyvars
104 -- Explicitly quantified but not mentioned in ctxt or tau
105 warn_guys = filter ((`notElem` mentioned) . unLoc) forall_tyvar_names
107 mapM_ (forAllWarn doc tau) warn_guys
108 rnForAll doc Explicit forall_tyvars ctxt tau
110 rnHsType _ (HsTyVar tyvar) = do
111 tyvar' <- lookupOccRn tyvar
112 return (HsTyVar tyvar')
114 -- If we see (forall a . ty), without foralls on, the forall will give
115 -- a sensible error message, but we don't want to complain about the dot too
116 -- Hence the jiggery pokery with ty1
117 rnHsType doc ty@(HsOpTy ty1 (L loc op) ty2)
119 do { ops_ok <- doptM Opt_TypeOperators
122 else do { addErr (opTyErr op ty)
123 ; return (mkUnboundName op) } -- Avoid double complaint
124 ; let l_op' = L loc op'
125 ; fix <- lookupTyFixityRn l_op'
126 ; ty1' <- rnLHsType doc ty1
127 ; ty2' <- rnLHsType doc ty2
128 ; mkHsOpTyRn (\t1 t2 -> HsOpTy t1 l_op' t2) op' fix ty1' ty2' }
130 rnHsType doc (HsParTy ty) = do
131 ty' <- rnLHsType doc ty
134 rnHsType doc (HsBangTy b ty)
135 = do { ty' <- rnLHsType doc ty
136 ; return (HsBangTy b ty') }
138 rnHsType doc (HsRecTy flds)
139 = do { flds' <- rnConDeclFields doc flds
140 ; return (HsRecTy flds') }
142 rnHsType _ (HsNumTy i)
143 | i == 1 = return (HsNumTy i)
144 | otherwise = addErr err_msg >> return (HsNumTy i)
146 err_msg = ptext (sLit "Only unit numeric type pattern is valid")
149 rnHsType doc (HsFunTy ty1 ty2) = do
150 ty1' <- rnLHsType doc ty1
151 -- Might find a for-all as the arg of a function type
152 ty2' <- rnLHsType doc ty2
153 -- Or as the result. This happens when reading Prelude.hi
154 -- when we find return :: forall m. Monad m -> forall a. a -> m a
156 -- Check for fixity rearrangements
157 mkHsOpTyRn HsFunTy funTyConName funTyFixity ty1' ty2'
159 rnHsType doc (HsListTy ty) = do
160 ty' <- rnLHsType doc ty
161 return (HsListTy ty')
163 rnHsType doc (HsKindSig ty k)
164 = do { kind_sigs_ok <- doptM Opt_KindSignatures
165 ; unless kind_sigs_ok (addErr (kindSigErr ty))
166 ; ty' <- rnLHsType doc ty
167 ; return (HsKindSig ty' k) }
169 rnHsType doc (HsPArrTy ty) = do
170 ty' <- rnLHsType doc ty
171 return (HsPArrTy ty')
173 -- Unboxed tuples are allowed to have poly-typed arguments. These
174 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
175 rnHsType doc (HsTupleTy tup_con tys) = do
176 tys' <- mapM (rnLHsType doc) tys
177 return (HsTupleTy tup_con tys')
179 rnHsType doc (HsAppTy ty1 ty2) = do
180 ty1' <- rnLHsType doc ty1
181 ty2' <- rnLHsType doc ty2
182 return (HsAppTy ty1' ty2')
184 rnHsType doc (HsPredTy pred) = do
185 pred' <- rnPred doc pred
186 return (HsPredTy pred')
188 rnHsType _ (HsSpliceTy sp)
189 = do { (sp', _fvs) <- rnSplice sp -- ToDo: deal with fvs
190 ; return (HsSpliceTy sp') }
192 rnHsType doc (HsDocTy ty haddock_doc) = do
193 ty' <- rnLHsType doc ty
194 haddock_doc' <- rnLHsDoc haddock_doc
195 return (HsDocTy ty' haddock_doc')
198 rnHsType _ ty@(HsQuasiQuoteTy _) = pprPanic "Can't do quasiquotation without GHCi" (ppr ty)
200 rnHsType doc (HsQuasiQuoteTy qq) = do { ty <- runQuasiQuoteType qq
201 ; rnHsType doc (unLoc ty) }
203 rnHsType _ (HsSpliceTyOut {}) = panic "rnHsType"
205 rnLHsTypes :: SDoc -> [LHsType RdrName]
206 -> IOEnv (Env TcGblEnv TcLclEnv) [LHsType Name]
207 rnLHsTypes doc tys = mapM (rnLHsType doc) tys
212 rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName]
213 -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
215 rnForAll doc _ [] (L _ []) (L _ ty) = rnHsType doc ty
216 -- One reason for this case is that a type like Int#
217 -- starts off as (HsForAllTy Nothing [] Int), in case
218 -- there is some quantification. Now that we have quantified
219 -- and discovered there are no type variables, it's nicer to turn
220 -- it into plain Int. If it were Int# instead of Int, we'd actually
221 -- get an error, because the body of a genuine for-all is
224 rnForAll doc exp forall_tyvars ctxt ty
225 = bindTyVarsRn forall_tyvars $ \ new_tyvars -> do
226 new_ctxt <- rnContext doc ctxt
227 new_ty <- rnLHsType doc ty
228 return (HsForAllTy exp new_tyvars new_ctxt new_ty)
229 -- Retain the same implicit/explicit flag as before
230 -- so that we can later print it correctly
232 rnConDeclFields :: SDoc -> [ConDeclField RdrName] -> RnM [ConDeclField Name]
233 rnConDeclFields doc fields = mapM (rnField doc) fields
235 rnField :: SDoc -> ConDeclField RdrName -> RnM (ConDeclField Name)
236 rnField doc (ConDeclField name ty haddock_doc)
237 = do { new_name <- lookupLocatedTopBndrRn name
238 ; new_ty <- rnLHsType doc ty
239 ; new_haddock_doc <- rnMbLHsDoc haddock_doc
240 ; return (ConDeclField new_name new_ty new_haddock_doc) }
243 %*********************************************************
245 \subsection{Contexts and predicates}
247 %*********************************************************
250 rnContext :: SDoc -> LHsContext RdrName -> RnM (LHsContext Name)
251 rnContext doc = wrapLocM (rnContext' doc)
253 rnContext' :: SDoc -> HsContext RdrName -> RnM (HsContext Name)
254 rnContext' doc ctxt = mapM (rnLPred doc) ctxt
256 rnLPred :: SDoc -> LHsPred RdrName -> RnM (LHsPred Name)
257 rnLPred doc = wrapLocM (rnPred doc)
259 rnPred :: SDoc -> HsPred RdrName
260 -> IOEnv (Env TcGblEnv TcLclEnv) (HsPred Name)
261 rnPred doc (HsClassP clas tys)
262 = do { clas_name <- lookupOccRn clas
263 ; tys' <- rnLHsTypes doc tys
264 ; return (HsClassP clas_name tys')
266 rnPred doc (HsEqualP ty1 ty2)
267 = do { ty1' <- rnLHsType doc ty1
268 ; ty2' <- rnLHsType doc ty2
269 ; return (HsEqualP ty1' ty2')
271 rnPred doc (HsIParam n ty)
272 = do { name <- newIPNameRn n
273 ; ty' <- rnLHsType doc ty
274 ; return (HsIParam name ty')
279 %************************************************************************
281 Fixities and precedence parsing
283 %************************************************************************
285 @mkOpAppRn@ deals with operator fixities. The argument expressions
286 are assumed to be already correctly arranged. It needs the fixities
287 recorded in the OpApp nodes, because fixity info applies to the things
288 the programmer actually wrote, so you can't find it out from the Name.
290 Furthermore, the second argument is guaranteed not to be another
291 operator application. Why? Because the parser parses all
292 operator appications left-associatively, EXCEPT negation, which
293 we need to handle specially.
294 Infix types are read in a *right-associative* way, so that
299 mkHsOpTyRn rearranges where necessary. The two arguments
300 have already been renamed and rearranged. It's made rather tiresome
301 by the presence of ->, which is a separate syntactic construct.
305 -- Building (ty1 `op1` (ty21 `op2` ty22))
306 mkHsOpTyRn :: (LHsType Name -> LHsType Name -> HsType Name)
307 -> Name -> Fixity -> LHsType Name -> LHsType Name
310 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy ty21 op2 ty22))
311 = do { fix2 <- lookupTyFixityRn op2
312 ; mk_hs_op_ty mk1 pp_op1 fix1 ty1
313 (\t1 t2 -> HsOpTy t1 op2 t2)
314 (unLoc op2) fix2 ty21 ty22 loc2 }
316 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsFunTy ty21 ty22))
317 = mk_hs_op_ty mk1 pp_op1 fix1 ty1
318 HsFunTy funTyConName funTyFixity ty21 ty22 loc2
320 mkHsOpTyRn mk1 _ _ ty1 ty2 -- Default case, no rearrangment
321 = return (mk1 ty1 ty2)
324 mk_hs_op_ty :: (LHsType Name -> LHsType Name -> HsType Name)
325 -> Name -> Fixity -> LHsType Name
326 -> (LHsType Name -> LHsType Name -> HsType Name)
327 -> Name -> Fixity -> LHsType Name -> LHsType Name -> SrcSpan
329 mk_hs_op_ty mk1 op1 fix1 ty1
330 mk2 op2 fix2 ty21 ty22 loc2
331 | nofix_error = do { precParseErr (op1,fix1) (op2,fix2)
332 ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) }
333 | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22)))
334 | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
335 new_ty <- mkHsOpTyRn mk1 op1 fix1 ty1 ty21
336 ; return (mk2 (noLoc new_ty) ty22) }
338 (nofix_error, associate_right) = compareFixity fix1 fix2
341 ---------------------------
342 mkOpAppRn :: LHsExpr Name -- Left operand; already rearranged
343 -> LHsExpr Name -> Fixity -- Operator and fixity
344 -> LHsExpr Name -- Right operand (not an OpApp, but might
348 -- (e11 `op1` e12) `op2` e2
349 mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2
351 = do precParseErr (get_op op1,fix1) (get_op op2,fix2)
352 return (OpApp e1 op2 fix2 e2)
354 | associate_right = do
355 new_e <- mkOpAppRn e12 op2 fix2 e2
356 return (OpApp e11 op1 fix1 (L loc' new_e))
358 loc'= combineLocs e12 e2
359 (nofix_error, associate_right) = compareFixity fix1 fix2
361 ---------------------------
362 -- (- neg_arg) `op` e2
363 mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
365 = do precParseErr (negateName,negateFixity) (get_op op2,fix2)
366 return (OpApp e1 op2 fix2 e2)
369 = do new_e <- mkOpAppRn neg_arg op2 fix2 e2
370 return (NegApp (L loc' new_e) neg_name)
372 loc' = combineLocs neg_arg e2
373 (nofix_error, associate_right) = compareFixity negateFixity fix2
375 ---------------------------
377 mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp _ _)) -- NegApp can occur on the right
378 | not associate_right -- We *want* right association
379 = do precParseErr (get_op op1, fix1) (negateName, negateFixity)
380 return (OpApp e1 op1 fix1 e2)
382 (_, associate_right) = compareFixity fix1 negateFixity
384 ---------------------------
386 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
387 = ASSERT2( right_op_ok fix (unLoc e2),
388 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
390 return (OpApp e1 op fix e2)
392 ----------------------------
393 get_op :: LHsExpr Name -> Name
394 get_op (L _ (HsVar n)) = n
395 get_op other = pprPanic "get_op" (ppr other)
397 -- Parser left-associates everything, but
398 -- derived instances may have correctly-associated things to
399 -- in the right operarand. So we just check that the right operand is OK
400 right_op_ok :: Fixity -> HsExpr Name -> Bool
401 right_op_ok fix1 (OpApp _ _ fix2 _)
402 = not error_please && associate_right
404 (error_please, associate_right) = compareFixity fix1 fix2
408 -- Parser initially makes negation bind more tightly than any other operator
409 -- And "deriving" code should respect this (use HsPar if not)
410 mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id)
411 mkNegAppRn neg_arg neg_name
412 = ASSERT( not_op_app (unLoc neg_arg) )
413 return (NegApp neg_arg neg_name)
415 not_op_app :: HsExpr id -> Bool
416 not_op_app (OpApp _ _ _ _) = False
419 ---------------------------
420 mkOpFormRn :: LHsCmdTop Name -- Left operand; already rearranged
421 -> LHsExpr Name -> Fixity -- Operator and fixity
422 -> LHsCmdTop Name -- Right operand (not an infix)
425 -- (e11 `op1` e12) `op2` e2
426 mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsArrForm op1 (Just fix1) [a11,a12])) _ _ _))
429 = do precParseErr (get_op op1,fix1) (get_op op2,fix2)
430 return (HsArrForm op2 (Just fix2) [a1, a2])
433 = do new_c <- mkOpFormRn a12 op2 fix2 a2
434 return (HsArrForm op1 (Just fix1)
435 [a11, L loc (HsCmdTop (L loc new_c) [] placeHolderType [])])
436 -- TODO: locs are wrong
438 (nofix_error, associate_right) = compareFixity fix1 fix2
441 mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment
442 = return (HsArrForm op (Just fix) [arg1, arg2])
445 --------------------------------------
446 mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name
449 mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
450 = do { fix1 <- lookupFixityRn (unLoc op1)
451 ; let (nofix_error, associate_right) = compareFixity fix1 fix2
453 ; if nofix_error then do
454 { precParseErr (unLoc op1,fix1) (unLoc op2,fix2)
455 ; return (ConPatIn op2 (InfixCon p1 p2)) }
457 else if associate_right then do
458 { new_p <- mkConOpPatRn op2 fix2 p12 p2
459 ; return (ConPatIn op1 (InfixCon p11 (L loc new_p))) } -- XXX loc right?
460 else return (ConPatIn op2 (InfixCon p1 p2)) }
462 mkConOpPatRn op _ p1 p2 -- Default case, no rearrangment
463 = ASSERT( not_op_pat (unLoc p2) )
464 return (ConPatIn op (InfixCon p1 p2))
466 not_op_pat :: Pat Name -> Bool
467 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
470 --------------------------------------
471 checkPrecMatch :: Name -> MatchGroup Name -> RnM ()
472 -- Check precedence of a function binding written infix
473 -- eg a `op` b `C` c = ...
474 -- See comments with rnExpr (OpApp ...) about "deriving"
476 checkPrecMatch op (MatchGroup ms _)
479 check (L _ (Match (L l1 p1 : L l2 p2 :_) _ _))
480 = setSrcSpan (combineSrcSpans l1 l2) $
481 do checkPrec op p1 False
485 -- This can happen. Consider
488 -- The infix flag comes from the first binding of the group
489 -- but the second eqn has no args (an error, but not discovered
490 -- until the type checker). So we don't want to crash on the
493 checkPrec :: Name -> Pat Name -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()
494 checkPrec op (ConPatIn op1 (InfixCon _ _)) right = do
495 op_fix@(Fixity op_prec op_dir) <- lookupFixityRn op
496 op1_fix@(Fixity op1_prec op1_dir) <- lookupFixityRn (unLoc op1)
498 inf_ok = op1_prec > op_prec ||
499 (op1_prec == op_prec &&
500 (op1_dir == InfixR && op_dir == InfixR && right ||
501 op1_dir == InfixL && op_dir == InfixL && not right))
504 info1 = (unLoc op1, op1_fix)
505 (infol, infor) = if right then (info, info1) else (info1, info)
506 unless inf_ok (precParseErr infol infor)
511 -- Check precedence of (arg op) or (op arg) respectively
512 -- If arg is itself an operator application, then either
513 -- (a) its precedence must be higher than that of op
514 -- (b) its precedency & associativity must be the same as that of op
515 checkSectionPrec :: FixityDirection -> HsExpr RdrName
516 -> LHsExpr Name -> LHsExpr Name -> RnM ()
517 checkSectionPrec direction section op arg
519 OpApp _ op fix _ -> go_for_it (get_op op) fix
520 NegApp _ _ -> go_for_it negateName negateFixity
524 go_for_it arg_op arg_fix@(Fixity arg_prec assoc) = do
525 op_fix@(Fixity op_prec _) <- lookupFixityRn op_name
526 unless (op_prec < arg_prec
527 || (op_prec == arg_prec && direction == assoc))
528 (sectionPrecErr (op_name, op_fix)
529 (arg_op, arg_fix) section)
532 Precedence-related error messages
535 precParseErr :: (Name, Fixity) -> (Name, Fixity) -> RnM ()
536 precParseErr op1@(n1,_) op2@(n2,_)
537 | isUnboundName n1 || isUnboundName n2
538 = return () -- Avoid error cascade
540 = addErr $ hang (ptext (sLit "Precedence parsing error"))
541 4 (hsep [ptext (sLit "cannot mix"), ppr_opfix op1, ptext (sLit "and"),
543 ptext (sLit "in the same infix expression")])
545 sectionPrecErr :: (Name, Fixity) -> (Name, Fixity) -> HsExpr RdrName -> RnM ()
546 sectionPrecErr op@(n1,_) arg_op@(n2,_) section
547 | isUnboundName n1 || isUnboundName n2
548 = return () -- Avoid error cascade
550 = addErr $ vcat [ptext (sLit "The operator") <+> ppr_opfix op <+> ptext (sLit "of a section"),
551 nest 4 (sep [ptext (sLit "must have lower precedence than that of the operand,"),
552 nest 2 (ptext (sLit "namely") <+> ppr_opfix arg_op)]),
553 nest 4 (ptext (sLit "in the section:") <+> quotes (ppr section))]
555 ppr_opfix :: (Name, Fixity) -> SDoc
556 ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity)
558 pp_op | op == negateName = ptext (sLit "prefix `-'")
559 | otherwise = quotes (ppr op)
562 %*********************************************************
566 %*********************************************************
569 forAllWarn :: SDoc -> LHsType RdrName -> Located RdrName
570 -> TcRnIf TcGblEnv TcLclEnv ()
571 forAllWarn doc ty (L loc tyvar)
572 = ifOptM Opt_WarnUnusedMatches $
573 addWarnAt loc (sep [ptext (sLit "The universally quantified type variable") <+> quotes (ppr tyvar),
574 nest 4 (ptext (sLit "does not appear in the type") <+> quotes (ppr ty))]
578 opTyErr :: RdrName -> HsType RdrName -> SDoc
579 opTyErr op ty@(HsOpTy ty1 _ _)
580 = hang (ptext (sLit "Illegal operator") <+> quotes (ppr op) <+> ptext (sLit "in type") <+> quotes (ppr ty))
583 extra | op == dot_tv_RDR && forall_head ty1
586 = ptext (sLit "Use -XTypeOperators to allow operators in types")
588 forall_head (L _ (HsTyVar tv)) = tv == forall_tv_RDR
589 forall_head (L _ (HsAppTy ty _)) = forall_head ty
590 forall_head _other = False
591 opTyErr _ ty = pprPanic "opTyErr: Not an op" (ppr ty)
594 %*********************************************************
598 %*********************************************************
604 h = ...$(thing "f")...
606 The splice can expand into literally anything, so when we do dependency
607 analysis we must assume that it might mention 'f'. So we simply treat
608 all locally-defined names as mentioned by any splice. This is terribly
609 brutal, but I don't see what else to do. For example, it'll mean
610 that every locally-defined thing will appear to be used, so no unused-binding
611 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
612 and that will crash the type checker because 'f' isn't in scope.
614 Currently, I'm not treating a splice as also mentioning every import,
615 which is a bit inconsistent -- but there are a lot of them. We might
616 thereby get some bogus unused-import warnings, but we won't crash the
617 type checker. Not very satisfactory really.
620 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
621 rnSplice (HsSplice n expr)
622 = do { checkTH expr "splice"
624 ; n' <- newLocalBndrRn (L loc n)
625 ; (expr', fvs) <- rnLExpr expr
627 -- Ugh! See Note [Splices] above
628 ; lcl_rdr <- getLocalRdrEnv
629 ; gbl_rdr <- getGlobalRdrEnv
630 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
632 lcl_names = mkNameSet (occEnvElts lcl_rdr)
634 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
636 checkTH :: Outputable a => a -> String -> RnM ()
638 checkTH _ _ = return () -- OK
640 checkTH e what -- Raise an error in a stage-1 compiler
641 = addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+>
642 ptext (sLit "illegal in a stage-1 compiler"),