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 )
24 import RdrHsSyn ( extractHsRhoRdrTyVars )
25 import RnHsSyn ( extractHsTyNames )
26 import RnHsDoc ( rnLHsDoc, rnMbLHsDoc )
31 import TypeRep ( funTyConName )
36 import BasicTypes ( compareFixity, funTyFixity, negateFixity,
37 Fixity(..), FixityDirection(..) )
40 import Control.Monad ( unless )
42 #include "HsVersions.h"
45 These type renamers are in a separate module, rather than in (say) RnSource,
46 to break several loop.
48 %*********************************************************
50 \subsection{Renaming types}
52 %*********************************************************
55 rnHsTypeFVs :: SDoc -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
56 rnHsTypeFVs doc_str ty = do
57 ty' <- rnLHsType doc_str ty
58 return (ty', extractHsTyNames ty')
60 rnHsSigType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
61 -- rnHsSigType is used for source-language type signatures,
62 -- which use *implicit* universal quantification.
63 rnHsSigType doc_str ty
64 = rnLHsType (text "In the type signature for" <+> doc_str) ty
67 rnHsType is here because we call it from loadInstDecl, and I didn't
68 want a gratuitous knot.
71 rnLHsType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
72 rnLHsType doc = wrapLocM (rnHsType doc)
74 rnHsType :: SDoc -> HsType RdrName -> RnM (HsType Name)
76 rnHsType doc (HsForAllTy Implicit _ ctxt ty) = do
77 -- Implicit quantifiction in source code (no kinds on tyvars)
78 -- Given the signature C => T we universally quantify
79 -- over FV(T) \ {in-scope-tyvars}
80 name_env <- getLocalRdrEnv
82 mentioned = extractHsRhoRdrTyVars ctxt ty
84 -- Don't quantify over type variables that are in scope;
85 -- when GlasgowExts is off, there usually won't be any, except for
87 -- class C a where { op :: a -> a }
88 forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env) . unLoc) mentioned
89 tyvar_bndrs = userHsTyVarBndrs forall_tyvars
91 rnForAll doc Implicit tyvar_bndrs ctxt ty
93 rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau) = do
94 -- Explicit quantification.
95 -- Check that the forall'd tyvars are actually
96 -- mentioned in the type, and produce a warning if not
98 mentioned = map unLoc (extractHsRhoRdrTyVars ctxt tau)
99 forall_tyvar_names = hsLTyVarLocNames forall_tyvars
101 -- Explicitly quantified but not mentioned in ctxt or tau
102 warn_guys = filter ((`notElem` mentioned) . unLoc) forall_tyvar_names
104 mapM_ (forAllWarn doc tau) warn_guys
105 rnForAll doc Explicit forall_tyvars ctxt tau
107 rnHsType _ (HsTyVar tyvar) = do
108 tyvar' <- lookupOccRn tyvar
109 return (HsTyVar tyvar')
111 -- If we see (forall a . ty), without foralls on, the forall will give
112 -- a sensible error message, but we don't want to complain about the dot too
113 -- Hence the jiggery pokery with ty1
114 rnHsType doc ty@(HsOpTy ty1 (L loc op) ty2)
116 do { ops_ok <- doptM Opt_TypeOperators
119 else do { addErr (opTyErr op ty)
120 ; return (mkUnboundName op) } -- Avoid double complaint
121 ; let l_op' = L loc op'
122 ; fix <- lookupTyFixityRn l_op'
123 ; ty1' <- rnLHsType doc ty1
124 ; ty2' <- rnLHsType doc ty2
125 ; mkHsOpTyRn (\t1 t2 -> HsOpTy t1 l_op' t2) op' fix ty1' ty2' }
127 rnHsType doc (HsParTy ty) = do
128 ty' <- rnLHsType doc ty
131 rnHsType doc (HsBangTy b ty)
132 = do { ty' <- rnLHsType doc ty
133 ; return (HsBangTy b ty') }
135 rnHsType doc (HsRecTy flds)
136 = do { flds' <- rnConDeclFields doc flds
137 ; return (HsRecTy flds') }
139 rnHsType _ (HsNumTy i)
140 | i == 1 = return (HsNumTy i)
141 | otherwise = addErr err_msg >> return (HsNumTy i)
143 err_msg = ptext (sLit "Only unit numeric type pattern is valid")
146 rnHsType doc (HsFunTy ty1 ty2) = do
147 ty1' <- rnLHsType doc ty1
148 -- Might find a for-all as the arg of a function type
149 ty2' <- rnLHsType doc ty2
150 -- Or as the result. This happens when reading Prelude.hi
151 -- when we find return :: forall m. Monad m -> forall a. a -> m a
153 -- Check for fixity rearrangements
154 mkHsOpTyRn HsFunTy funTyConName funTyFixity ty1' ty2'
156 rnHsType doc (HsListTy ty) = do
157 ty' <- rnLHsType doc ty
158 return (HsListTy ty')
160 rnHsType doc (HsKindSig ty k)
161 = do { kind_sigs_ok <- doptM Opt_KindSignatures
162 ; unless kind_sigs_ok (addErr (kindSigErr ty))
163 ; ty' <- rnLHsType doc ty
164 ; return (HsKindSig ty' k) }
166 rnHsType doc (HsPArrTy ty) = do
167 ty' <- rnLHsType doc ty
168 return (HsPArrTy ty')
170 -- Unboxed tuples are allowed to have poly-typed arguments. These
171 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
172 rnHsType doc (HsTupleTy tup_con tys) = do
173 tys' <- mapM (rnLHsType doc) tys
174 return (HsTupleTy tup_con tys')
176 rnHsType doc (HsAppTy ty1 ty2) = do
177 ty1' <- rnLHsType doc ty1
178 ty2' <- rnLHsType doc ty2
179 return (HsAppTy ty1' ty2')
181 rnHsType doc (HsPredTy pred) = do
182 pred' <- rnPred doc pred
183 return (HsPredTy pred')
185 rnHsType _ (HsSpliceTy sp)
186 = do { (sp', _fvs) <- rnSplice sp -- ToDo: deal with fvs
187 ; return (HsSpliceTy sp') }
189 rnHsType doc (HsDocTy ty haddock_doc) = do
190 ty' <- rnLHsType doc ty
191 haddock_doc' <- rnLHsDoc haddock_doc
192 return (HsDocTy ty' haddock_doc')
194 rnHsType _ (HsSpliceTyOut {}) = panic "rnHsType"
196 rnLHsTypes :: SDoc -> [LHsType RdrName]
197 -> IOEnv (Env TcGblEnv TcLclEnv) [LHsType Name]
198 rnLHsTypes doc tys = mapM (rnLHsType doc) tys
203 rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName]
204 -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
206 rnForAll doc _ [] (L _ []) (L _ ty) = rnHsType doc ty
207 -- One reason for this case is that a type like Int#
208 -- starts off as (HsForAllTy Nothing [] Int), in case
209 -- there is some quantification. Now that we have quantified
210 -- and discovered there are no type variables, it's nicer to turn
211 -- it into plain Int. If it were Int# instead of Int, we'd actually
212 -- get an error, because the body of a genuine for-all is
215 rnForAll doc exp forall_tyvars ctxt ty
216 = bindTyVarsRn doc forall_tyvars $ \ new_tyvars -> do
217 new_ctxt <- rnContext doc ctxt
218 new_ty <- rnLHsType doc ty
219 return (HsForAllTy exp new_tyvars new_ctxt new_ty)
220 -- Retain the same implicit/explicit flag as before
221 -- so that we can later print it correctly
223 rnConDeclFields :: SDoc -> [ConDeclField RdrName] -> RnM [ConDeclField Name]
224 rnConDeclFields doc fields = mapM (rnField doc) fields
226 rnField :: SDoc -> ConDeclField RdrName -> RnM (ConDeclField Name)
227 rnField doc (ConDeclField name ty haddock_doc)
228 = do { new_name <- lookupLocatedTopBndrRn name
229 ; new_ty <- rnLHsType doc ty
230 ; new_haddock_doc <- rnMbLHsDoc haddock_doc
231 ; return (ConDeclField new_name new_ty new_haddock_doc) }
234 %*********************************************************
236 \subsection{Contexts and predicates}
238 %*********************************************************
241 rnContext :: SDoc -> LHsContext RdrName -> RnM (LHsContext Name)
242 rnContext doc = wrapLocM (rnContext' doc)
244 rnContext' :: SDoc -> HsContext RdrName -> RnM (HsContext Name)
245 rnContext' doc ctxt = mapM (rnLPred doc) ctxt
247 rnLPred :: SDoc -> LHsPred RdrName -> RnM (LHsPred Name)
248 rnLPred doc = wrapLocM (rnPred doc)
250 rnPred :: SDoc -> HsPred RdrName
251 -> IOEnv (Env TcGblEnv TcLclEnv) (HsPred Name)
252 rnPred doc (HsClassP clas tys)
253 = do { clas_name <- lookupOccRn clas
254 ; tys' <- rnLHsTypes doc tys
255 ; return (HsClassP clas_name tys')
257 rnPred doc (HsEqualP ty1 ty2)
258 = do { ty1' <- rnLHsType doc ty1
259 ; ty2' <- rnLHsType doc ty2
260 ; return (HsEqualP ty1' ty2')
262 rnPred doc (HsIParam n ty)
263 = do { name <- newIPNameRn n
264 ; ty' <- rnLHsType doc ty
265 ; return (HsIParam name ty')
270 %************************************************************************
272 Fixities and precedence parsing
274 %************************************************************************
276 @mkOpAppRn@ deals with operator fixities. The argument expressions
277 are assumed to be already correctly arranged. It needs the fixities
278 recorded in the OpApp nodes, because fixity info applies to the things
279 the programmer actually wrote, so you can't find it out from the Name.
281 Furthermore, the second argument is guaranteed not to be another
282 operator application. Why? Because the parser parses all
283 operator appications left-associatively, EXCEPT negation, which
284 we need to handle specially.
285 Infix types are read in a *right-associative* way, so that
290 mkHsOpTyRn rearranges where necessary. The two arguments
291 have already been renamed and rearranged. It's made rather tiresome
292 by the presence of ->, which is a separate syntactic construct.
296 -- Building (ty1 `op1` (ty21 `op2` ty22))
297 mkHsOpTyRn :: (LHsType Name -> LHsType Name -> HsType Name)
298 -> Name -> Fixity -> LHsType Name -> LHsType Name
301 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy ty21 op2 ty22))
302 = do { fix2 <- lookupTyFixityRn op2
303 ; mk_hs_op_ty mk1 pp_op1 fix1 ty1
304 (\t1 t2 -> HsOpTy t1 op2 t2)
305 (unLoc op2) fix2 ty21 ty22 loc2 }
307 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsFunTy ty21 ty22))
308 = mk_hs_op_ty mk1 pp_op1 fix1 ty1
309 HsFunTy funTyConName funTyFixity ty21 ty22 loc2
311 mkHsOpTyRn mk1 _ _ ty1 ty2 -- Default case, no rearrangment
312 = return (mk1 ty1 ty2)
315 mk_hs_op_ty :: (LHsType Name -> LHsType Name -> HsType Name)
316 -> Name -> Fixity -> LHsType Name
317 -> (LHsType Name -> LHsType Name -> HsType Name)
318 -> Name -> Fixity -> LHsType Name -> LHsType Name -> SrcSpan
320 mk_hs_op_ty mk1 op1 fix1 ty1
321 mk2 op2 fix2 ty21 ty22 loc2
322 | nofix_error = do { precParseErr (op1,fix1) (op2,fix2)
323 ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) }
324 | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22)))
325 | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
326 new_ty <- mkHsOpTyRn mk1 op1 fix1 ty1 ty21
327 ; return (mk2 (noLoc new_ty) ty22) }
329 (nofix_error, associate_right) = compareFixity fix1 fix2
332 ---------------------------
333 mkOpAppRn :: LHsExpr Name -- Left operand; already rearranged
334 -> LHsExpr Name -> Fixity -- Operator and fixity
335 -> LHsExpr Name -- Right operand (not an OpApp, but might
339 -- (e11 `op1` e12) `op2` e2
340 mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2
342 = do precParseErr (get_op op1,fix1) (get_op op2,fix2)
343 return (OpApp e1 op2 fix2 e2)
345 | associate_right = do
346 new_e <- mkOpAppRn e12 op2 fix2 e2
347 return (OpApp e11 op1 fix1 (L loc' new_e))
349 loc'= combineLocs e12 e2
350 (nofix_error, associate_right) = compareFixity fix1 fix2
352 ---------------------------
353 -- (- neg_arg) `op` e2
354 mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
356 = do precParseErr (negateName,negateFixity) (get_op op2,fix2)
357 return (OpApp e1 op2 fix2 e2)
360 = do new_e <- mkOpAppRn neg_arg op2 fix2 e2
361 return (NegApp (L loc' new_e) neg_name)
363 loc' = combineLocs neg_arg e2
364 (nofix_error, associate_right) = compareFixity negateFixity fix2
366 ---------------------------
368 mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp _ _)) -- NegApp can occur on the right
369 | not associate_right -- We *want* right association
370 = do precParseErr (get_op op1, fix1) (negateName, negateFixity)
371 return (OpApp e1 op1 fix1 e2)
373 (_, associate_right) = compareFixity fix1 negateFixity
375 ---------------------------
377 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
378 = ASSERT2( right_op_ok fix (unLoc e2),
379 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
381 return (OpApp e1 op fix e2)
383 ----------------------------
384 get_op :: LHsExpr Name -> Name
385 get_op (L _ (HsVar n)) = n
386 get_op other = pprPanic "get_op" (ppr other)
388 -- Parser left-associates everything, but
389 -- derived instances may have correctly-associated things to
390 -- in the right operarand. So we just check that the right operand is OK
391 right_op_ok :: Fixity -> HsExpr Name -> Bool
392 right_op_ok fix1 (OpApp _ _ fix2 _)
393 = not error_please && associate_right
395 (error_please, associate_right) = compareFixity fix1 fix2
399 -- Parser initially makes negation bind more tightly than any other operator
400 -- And "deriving" code should respect this (use HsPar if not)
401 mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id)
402 mkNegAppRn neg_arg neg_name
403 = ASSERT( not_op_app (unLoc neg_arg) )
404 return (NegApp neg_arg neg_name)
406 not_op_app :: HsExpr id -> Bool
407 not_op_app (OpApp _ _ _ _) = False
410 ---------------------------
411 mkOpFormRn :: LHsCmdTop Name -- Left operand; already rearranged
412 -> LHsExpr Name -> Fixity -- Operator and fixity
413 -> LHsCmdTop Name -- Right operand (not an infix)
416 -- (e11 `op1` e12) `op2` e2
417 mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsArrForm op1 (Just fix1) [a11,a12])) _ _ _))
420 = do precParseErr (get_op op1,fix1) (get_op op2,fix2)
421 return (HsArrForm op2 (Just fix2) [a1, a2])
424 = do new_c <- mkOpFormRn a12 op2 fix2 a2
425 return (HsArrForm op1 (Just fix1)
426 [a11, L loc (HsCmdTop (L loc new_c) [] placeHolderType [])])
427 -- TODO: locs are wrong
429 (nofix_error, associate_right) = compareFixity fix1 fix2
432 mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment
433 = return (HsArrForm op (Just fix) [arg1, arg2])
436 --------------------------------------
437 mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name
440 mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
441 = do { fix1 <- lookupFixityRn (unLoc op1)
442 ; let (nofix_error, associate_right) = compareFixity fix1 fix2
444 ; if nofix_error then do
445 { precParseErr (unLoc op1,fix1) (unLoc op2,fix2)
446 ; return (ConPatIn op2 (InfixCon p1 p2)) }
448 else if associate_right then do
449 { new_p <- mkConOpPatRn op2 fix2 p12 p2
450 ; return (ConPatIn op1 (InfixCon p11 (L loc new_p))) } -- XXX loc right?
451 else return (ConPatIn op2 (InfixCon p1 p2)) }
453 mkConOpPatRn op _ p1 p2 -- Default case, no rearrangment
454 = ASSERT( not_op_pat (unLoc p2) )
455 return (ConPatIn op (InfixCon p1 p2))
457 not_op_pat :: Pat Name -> Bool
458 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
461 --------------------------------------
462 checkPrecMatch :: Bool -> Name -> MatchGroup Name -> RnM ()
463 -- True indicates an infix lhs
464 -- See comments with rnExpr (OpApp ...) about "deriving"
466 checkPrecMatch False _ _
468 checkPrecMatch True op (MatchGroup ms _)
471 check (L _ (Match (p1:p2:_) _ _))
472 = do checkPrec op (unLoc p1) False
473 checkPrec op (unLoc p2) True
476 -- This can happen. Consider
479 -- The infix flag comes from the first binding of the group
480 -- but the second eqn has no args (an error, but not discovered
481 -- until the type checker). So we don't want to crash on the
484 checkPrec :: Name -> Pat Name -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()
485 checkPrec op (ConPatIn op1 (InfixCon _ _)) right = do
486 op_fix@(Fixity op_prec op_dir) <- lookupFixityRn op
487 op1_fix@(Fixity op1_prec op1_dir) <- lookupFixityRn (unLoc op1)
489 inf_ok = op1_prec > op_prec ||
490 (op1_prec == op_prec &&
491 (op1_dir == InfixR && op_dir == InfixR && right ||
492 op1_dir == InfixL && op_dir == InfixL && not right))
495 info1 = (unLoc op1, op1_fix)
496 (infol, infor) = if right then (info, info1) else (info1, info)
497 unless inf_ok (precParseErr infol infor)
502 -- Check precedence of (arg op) or (op arg) respectively
503 -- If arg is itself an operator application, then either
504 -- (a) its precedence must be higher than that of op
505 -- (b) its precedency & associativity must be the same as that of op
506 checkSectionPrec :: FixityDirection -> HsExpr RdrName
507 -> LHsExpr Name -> LHsExpr Name -> RnM ()
508 checkSectionPrec direction section op arg
510 OpApp _ op fix _ -> go_for_it (get_op op) fix
511 NegApp _ _ -> go_for_it negateName negateFixity
515 go_for_it arg_op arg_fix@(Fixity arg_prec assoc) = do
516 op_fix@(Fixity op_prec _) <- lookupFixityRn op_name
517 unless (op_prec < arg_prec
518 || (op_prec == arg_prec && direction == assoc))
519 (sectionPrecErr (op_name, op_fix)
520 (arg_op, arg_fix) section)
523 Precedence-related error messages
526 precParseErr :: (Name, Fixity) -> (Name, Fixity) -> RnM ()
527 precParseErr op1@(n1,_) op2@(n2,_)
528 | isUnboundName n1 || isUnboundName n2
529 = return () -- Avoid error cascade
531 = addErr $ hang (ptext (sLit "Precedence parsing error"))
532 4 (hsep [ptext (sLit "cannot mix"), ppr_opfix op1, ptext (sLit "and"),
534 ptext (sLit "in the same infix expression")])
536 sectionPrecErr :: (Name, Fixity) -> (Name, Fixity) -> HsExpr RdrName -> RnM ()
537 sectionPrecErr op@(n1,_) arg_op@(n2,_) section
538 | isUnboundName n1 || isUnboundName n2
539 = return () -- Avoid error cascade
541 = addErr $ vcat [ptext (sLit "The operator") <+> ppr_opfix op <+> ptext (sLit "of a section"),
542 nest 4 (sep [ptext (sLit "must have lower precedence than that of the operand,"),
543 nest 2 (ptext (sLit "namely") <+> ppr_opfix arg_op)]),
544 nest 4 (ptext (sLit "in the section:") <+> quotes (ppr section))]
546 ppr_opfix :: (Name, Fixity) -> SDoc
547 ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity)
549 pp_op | op == negateName = ptext (sLit "prefix `-'")
550 | otherwise = quotes (ppr op)
553 %*********************************************************
557 %*********************************************************
560 forAllWarn :: SDoc -> LHsType RdrName -> Located RdrName
561 -> TcRnIf TcGblEnv TcLclEnv ()
562 forAllWarn doc ty (L loc tyvar)
563 = ifOptM Opt_WarnUnusedMatches $
564 addWarnAt loc (sep [ptext (sLit "The universally quantified type variable") <+> quotes (ppr tyvar),
565 nest 4 (ptext (sLit "does not appear in the type") <+> quotes (ppr ty))]
569 opTyErr :: RdrName -> HsType RdrName -> SDoc
570 opTyErr op ty@(HsOpTy ty1 _ _)
571 = hang (ptext (sLit "Illegal operator") <+> quotes (ppr op) <+> ptext (sLit "in type") <+> quotes (ppr ty))
574 extra | op == dot_tv_RDR && forall_head ty1
577 = ptext (sLit "Use -XTypeOperators to allow operators in types")
579 forall_head (L _ (HsTyVar tv)) = tv == forall_tv_RDR
580 forall_head (L _ (HsAppTy ty _)) = forall_head ty
581 forall_head _other = False
582 opTyErr _ ty = pprPanic "opTyErr: Not an op" (ppr ty)
585 %*********************************************************
589 %*********************************************************
595 h = ...$(thing "f")...
597 The splice can expand into literally anything, so when we do dependency
598 analysis we must assume that it might mention 'f'. So we simply treat
599 all locally-defined names as mentioned by any splice. This is terribly
600 brutal, but I don't see what else to do. For example, it'll mean
601 that every locally-defined thing will appear to be used, so no unused-binding
602 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
603 and that will crash the type checker because 'f' isn't in scope.
605 Currently, I'm not treating a splice as also mentioning every import,
606 which is a bit inconsistent -- but there are a lot of them. We might
607 thereby get some bogus unused-import warnings, but we won't crash the
608 type checker. Not very satisfactory really.
611 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
612 rnSplice (HsSplice n expr)
613 = do { checkTH expr "splice"
615 ; n' <- newLocalBndrRn (L loc n)
616 ; (expr', fvs) <- rnLExpr expr
618 -- Ugh! See Note [Splices] above
619 ; lcl_rdr <- getLocalRdrEnv
620 ; gbl_rdr <- getGlobalRdrEnv
621 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
623 lcl_names = mkNameSet (occEnvElts lcl_rdr)
625 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
627 checkTH :: Outputable a => a -> String -> RnM ()
629 checkTH _ _ = return () -- OK
631 checkTH e what -- Raise an error in a stage-1 compiler
632 = addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+>
633 ptext (sLit "illegal in a stage-1 compiler"),