RnSplice.lhs 20.6 KB
Newer Older
1 2
\begin{code}
module RnSplice (
3 4 5
        rnTopSpliceDecls,
        rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,
        rnBracket,
gmainland's avatar
gmainland committed
6
        checkThLocalName
7 8
  ) where

9

10 11 12 13
import Name
import NameSet
import HsSyn
import RdrName
gmainland's avatar
gmainland committed
14 15 16 17 18
import TcRnMonad

#ifdef GHCI
import Control.Monad    ( unless, when )
import DynFlags
19
import DsMeta           ( decsQTyConName, expQTyConName, patQTyConName, typeQTyConName )
gmainland's avatar
gmainland committed
20 21
import LoadIface        ( loadInterfaceForName )
import Module
22
import RnEnv
23
import RnPat            ( rnPat )
24
import RnSource         ( rnSrcDecls, findSplice )
25
import RnTypes          ( rnLHsType )
26
import SrcLoc
27
import TcEnv            ( checkWellStaged, tcMetaTy )
28
import Outputable
29
import BasicTypes       ( TopLevelFlag, isTopLevel )
30
import FastString
31

gmainland's avatar
gmainland committed
32 33
import {-# SOURCE #-} RnExpr   ( rnLExpr )
import {-# SOURCE #-} TcExpr   ( tcMonoExpr )
34
import {-# SOURCE #-} TcSplice ( runMetaD, runMetaE, runMetaP, runMetaT, tcTopSpliceExpr )
gmainland's avatar
gmainland committed
35 36 37 38 39 40
#endif
\end{code}

\begin{code}
#ifndef GHCI
rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars)
41
rnBracket e _ = failTH e "Template Haskell bracket"
gmainland's avatar
gmainland committed
42

43 44
rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
rnTopSpliceDecls e = failTH e "Template Haskell top splice"
45

gmainland's avatar
gmainland committed
46
rnSpliceType :: HsSplice RdrName -> PostTcKind -> RnM (HsType Name, FreeVars)
47
rnSpliceType e _ = failTH e "Template Haskell type splice"
gmainland's avatar
gmainland committed
48

49 50
rnSpliceExpr :: Bool -> HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
rnSpliceExpr _ e = failTH e "Template Haskell splice"
gmainland's avatar
gmainland committed
51

gmainland's avatar
gmainland committed
52
rnSplicePat :: HsSplice RdrName -> RnM (Pat Name, FreeVars)
53
rnSplicePat e = failTH e "Template Haskell pattern splice"
gmainland's avatar
gmainland committed
54

55
rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
56
rnSpliceDecl e = failTH e "Template Haskell declaration splice"
gmainland's avatar
gmainland committed
57
#else
58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85
\end{code}

%*********************************************************
%*                                                      *
                Splices
%*                                                      *
%*********************************************************

Note [Splices]
~~~~~~~~~~~~~~
Consider
        f = ...
        h = ...$(thing "f")...

The splice can expand into literally anything, so when we do dependency
analysis we must assume that it might mention 'f'.  So we simply treat
all locally-defined names as mentioned by any splice.  This is terribly
brutal, but I don't see what else to do.  For example, it'll mean
that every locally-defined thing will appear to be used, so no unused-binding
warnings.  But if we miss the dependency, then we might typecheck 'h' before 'f',
and that will crash the type checker because 'f' isn't in scope.

Currently, I'm not treating a splice as also mentioning every import,
which is a bit inconsistent -- but there are a lot of them.  We might
thereby get some bogus unused-import warnings, but we won't crash the
type checker.  Not very satisfactory really.

\begin{code}
86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118
rnSpliceGen :: Bool                                     -- Typed splice?
            -> (HsSplice Name -> RnM (a, FreeVars))     -- Outside brackets, run splice
            -> (HsSplice Name -> (PendingRnSplice, a))  -- Inside brackets, make it pending
            -> HsSplice RdrName
            -> RnM (a, FreeVars)
rnSpliceGen is_typed_splice run_splice pend_splice splice@(HsSplice _ expr)
  = addErrCtxt (spliceCtxt (HsSpliceE is_typed_splice splice)) $
    setSrcSpan (getLoc expr) $ do
    { stage <- getStage
    ; case stage of
        Brack pop_stage RnPendingTyped
          -> do { checkTc is_typed_splice illegalUntypedSplice
                ; (splice', fvs) <- setStage pop_stage $
                                    rnSplice splice
                ; let (_pending_splice, result) = pend_splice splice'
                ; return (result, fvs) }

        Brack pop_stage (RnPendingUntyped ps_var)
          -> do { checkTc (not is_typed_splice) illegalTypedSplice
                ; (splice', fvs) <- setStage pop_stage $
                                    rnSplice splice
                ; let (pending_splice, result) = pend_splice splice'
                ; ps <- readMutVar ps_var
                ; writeMutVar ps_var (pending_splice : ps)
                ; return (result, fvs) }

        _ ->  do { (splice', fvs1) <- setStage (Splice is_typed_splice) $
                                      rnSplice splice

                 ; (result, fvs2) <- run_splice splice'
                 ; return (result, fvs1 `plusFV` fvs2) } }

---------------------
119
rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
120
-- Not exported...used for all
121
rnSplice (HsSplice n expr)
122
  = do  { checkTH expr "Template Haskell splice"
123 124 125
        ; loc  <- getSrcSpanM
        ; n' <- newLocalBndrRn (L loc n)
        ; (expr', fvs) <- rnLExpr expr
126
        ; return (HsSplice n' expr', fvs) }
127

gmainland's avatar
gmainland committed
128

129 130 131 132
---------------------
rnSpliceExpr :: Bool -> HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
rnSpliceExpr is_typed splice
  = rnSpliceGen is_typed run_expr_splice pend_expr_splice splice
gmainland's avatar
gmainland committed
133
  where
134 135 136 137 138 139 140 141 142 143 144 145 146
    pend_expr_splice :: HsSplice Name -> (PendingRnSplice, HsExpr Name)
    pend_expr_splice rn_splice
        = (PendingRnExpSplice rn_splice, HsSpliceE is_typed rn_splice)

    run_expr_splice :: HsSplice Name -> RnM (HsExpr Name, FreeVars)
    run_expr_splice rn_splice@(HsSplice _ expr)
      | is_typed   -- Run it later, in the type checker
      = do {  -- Ugh!  See Note [Splices] above
              lcl_rdr <- getLocalRdrEnv
           ; gbl_rdr <- getGlobalRdrEnv
           ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr
                                                     , isLocalGRE gre]
                 lcl_names = mkNameSet (localRdrEnvElts lcl_rdr)
gmainland's avatar
gmainland committed
147

148 149 150 151 152
           ; return (HsSpliceE is_typed rn_splice, lcl_names `plusFV` gbl_names) }

      | otherwise  -- Run it here
      = do { -- The splice must have type ExpQ
           ; meta_exp_ty <- tcMetaTy expQTyConName
gmainland's avatar
gmainland committed
153 154 155 156 157 158

             -- Typecheck the expression
           ; zonked_q_expr <- tcTopSpliceExpr False $
                              tcMonoExpr expr meta_exp_ty

             -- Run the expression
159 160
           ; expr2 <- runMetaE zonked_q_expr
           ; showSplice "expression" expr (ppr expr2)
161

162 163 164 165 166 167 168 169
           ; (lexpr3, fvs) <- checkNoErrs $
                              rnLExpr expr2
           ; return (unLoc lexpr3, fvs)  }

----------------------
rnSpliceType :: HsSplice RdrName -> PostTcKind -> RnM (HsType Name, FreeVars)
rnSpliceType splice k
  = rnSpliceGen False run_type_splice pend_type_splice splice
170
  where
171 172
    pend_type_splice rn_splice
       = (PendingRnTypeSplice rn_splice, HsSpliceTy rn_splice k)
gmainland's avatar
gmainland committed
173

174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200
    run_type_splice (HsSplice _ expr)
       = do { meta_exp_ty <- tcMetaTy typeQTyConName

              -- Typecheck the expression
            ; zonked_q_expr <- tcTopSpliceExpr False $
                               tcMonoExpr expr meta_exp_ty

              -- Run the expression
            ; hs_ty2 <- runMetaT zonked_q_expr
            ; showSplice "type" expr (ppr hs_ty2)

            ; (hs_ty3, fvs) <- do { let doc = SpliceTypeCtx hs_ty2
                                  ; checkNoErrs $ rnLHsType doc hs_ty2
                                    -- checkNoErrs: see Note [Renamer errors]
                                  }
            ; return (unLoc hs_ty3, fvs) }

----------------------
rnSplicePat :: HsSplice RdrName -> RnM (Pat Name, FreeVars)
rnSplicePat splice
  = rnSpliceGen False run_pat_splice pend_pat_splice splice
  where
    pend_pat_splice rn_splice
      = (PendingRnPatSplice rn_splice, SplicePat rn_splice)

    run_pat_splice (HsSplice _ expr)
      = do { meta_exp_ty <- tcMetaTy patQTyConName
gmainland's avatar
gmainland committed
201 202 203 204 205 206

             -- Typecheck the expression
           ; zonked_q_expr <- tcTopSpliceExpr False $
                              tcMonoExpr expr meta_exp_ty

             -- Run the expression
207 208
           ; pat <- runMetaP zonked_q_expr
           ; showSplice "pattern" expr (ppr pat)
gmainland's avatar
gmainland committed
209

210 211
           ; (pat', fvs) <- checkNoErrs $
                            rnPat ThPatSplice pat $ \pat' -> return (pat', emptyFVs)
212

213
           ; return (unLoc pat', fvs) }
gmainland's avatar
gmainland committed
214

215 216 217 218 219 220 221
----------------------
rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
rnSpliceDecl (SpliceDecl (L loc splice) flg)
  = rnSpliceGen False run_decl_splice pend_decl_splice splice
  where
    pend_decl_splice rn_splice
       = (PendingRnDeclSplice rn_splice, SpliceDecl(L loc rn_splice) flg)
gmainland's avatar
gmainland committed
222

223
    run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
gmainland's avatar
gmainland committed
224 225
\end{code}

226
\begin{code}
227 228 229 230 231
rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
-- Declaration splice at the very top level of the module
rnTopSpliceDecls (HsSplice _ expr)
   = do  { (expr', fvs) <- setStage (Splice False) $
                           rnLExpr expr
232

233 234
         ; list_q <- tcMetaTy decsQTyConName     -- Q [Dec]
         ; zonked_q_expr <- tcTopSpliceExpr False (tcMonoExpr expr' list_q)
235

236 237 238 239
                -- Run the expression
         ; decls <- runMetaD zonked_q_expr
         ; showSplice "declarations" expr'
                 (ppr (getLoc expr) $$ (vcat (map ppr decls)))
240

241
         ; return (decls,fvs) }
242 243
\end{code}

244 245 246 247 248 249 250
%************************************************************************
%*                                                                      *
        Template Haskell brackets
%*                                                                      *
%************************************************************************

\begin{code}
gmainland's avatar
gmainland committed
251 252
rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars)
rnBracket e br_body
253
  = addErrCtxt (quotationCtxtDoc br_body) $
254 255
    do { -- Check that Template Haskell is enabled and available
         thEnabled <- xoptM Opt_TemplateHaskell
gmainland's avatar
gmainland committed
256 257 258
       ; unless thEnabled $
           failWith ( vcat [ ptext (sLit "Syntax error on") <+> ppr e
                           , ptext (sLit "Perhaps you intended to use TemplateHaskell") ] )
259
       ; checkTH e "Template Haskell bracket"
260 261 262 263 264 265 266 267 268 269 270 271 272

         -- Check for nested brackets
       ; cur_stage <- getStage
       ; case cur_stage of
           { Splice True  -> checkTc (isTypedBracket br_body) illegalUntypedBracket
           ; Splice False -> checkTc (not (isTypedBracket br_body)) illegalTypedBracket
           ; Comp         -> return ()
           ; Brack {}     -> failWithTc illegalBracket
           }

         -- Brackets are desugared to code that mentions the TH package
       ; recordThUse

273 274 275 276
       ; case isTypedBracket br_body of
            True  -> do { (body', fvs_e) <- setStage (Brack cur_stage RnPendingTyped) $
                                            rn_bracket cur_stage br_body
                        ; return (HsBracket body', fvs_e) }
277

278 279 280 281 282
            False -> do { ps_var <- newMutVar []
                        ; (body', fvs_e) <- setStage (Brack cur_stage (RnPendingUntyped ps_var)) $
                                            rn_bracket cur_stage br_body
                        ; pendings <- readMutVar ps_var
                        ; return (HsRnBracketOut body' pendings, fvs_e) }
gmainland's avatar
gmainland committed
283 284
       }

285
rn_bracket :: ThStage -> HsBracket RdrName -> RnM (HsBracket Name, FreeVars)
286 287
rn_bracket outer_stage br@(VarBr flg rdr_name)
  = do { name <- lookupOccRn rdr_name
288
       ; this_mod <- getModule
289

gmainland's avatar
gmainland committed
290 291 292 293
       ; case flg of
           { -- Type variables can be quoted in TH. See #5721.
             False -> return ()
           ; True | nameIsLocalOrFrom this_mod name ->
294
                 do { mb_bind_lvl <- lookupLocalOccThLvl_maybe name
gmainland's avatar
gmainland committed
295
                    ; case mb_bind_lvl of
296 297
                        { Nothing -> return ()      -- Can happen for data constructors,
                                                    -- but nothign needs doing for them
298 299 300 301 302 303 304 305

                        ; Just (top_lvl, bind_lvl)  -- See Note [Quoting names]
                             | isTopLevel top_lvl
                             -> when (isExternalName name) (keepAlive name)
                             | otherwise
                             -> do { traceRn (text "rn_bracket VarBr" <+> ppr name <+> ppr bind_lvl <+> ppr outer_stage)
                                   ; checkTc (thLevel outer_stage + 1 == bind_lvl)
                                             (quotedNameStageErr br) }
gmainland's avatar
gmainland committed
306 307
                        }
                    }
308 309 310 311 312
           ; True | otherwise ->  -- Imported thing
                 discardResult (loadInterfaceForName msg name)
                     -- Reason for loadInterface: deprecation checking
                     -- assumes that the home interface is loaded, and
                     -- this is the only way that is going to happen
gmainland's avatar
gmainland committed
313
           }
314 315 316 317
       ; return (VarBr flg name, unitFV name) }
  where
    msg = ptext (sLit "Need interface for Template Haskell quoted Name")

318 319
rn_bracket _ (ExpBr e) = do { (e', fvs) <- rnLExpr e
                            ; return (ExpBr e', fvs) }
320

321
rn_bracket _ (PatBr p) = rnPat ThPatQuote p $ \ p' -> return (PatBr p', emptyFVs)
322

323 324
rn_bracket _ (TypBr t) = do { (t', fvs) <- rnLHsType TypBrCtx t
                            ; return (TypBr t', fvs) }
325

326
rn_bracket _ (DecBrL decls)
327
  = do { group <- groupDecls decls
328 329 330 331 332 333 334 335 336 337
       ; gbl_env  <- getGblEnv
       ; let new_gbl_env = gbl_env { tcg_dus = emptyDUs }
                          -- The emptyDUs is so that we just collect uses for this
                          -- group alone in the call to rnSrcDecls below
       ; (tcg_env, group') <- setGblEnv new_gbl_env $
                              rnSrcDecls [] group
   -- The empty list is for extra dependencies coming from .hs-boot files
   -- See Note [Extra dependencies from .hs-boot files] in RnSource

              -- Discard the tcg_env; it contains only extra info about fixity
gmainland's avatar
gmainland committed
338
        ; traceRn (text "rn_bracket dec" <+> (ppr (tcg_dus tcg_env) $$
339 340
                   ppr (duUses (tcg_dus tcg_env))))
        ; return (DecBrG group', duUses (tcg_dus tcg_env)) }
341 342 343 344 345 346 347 348 349 350 351 352
  where
    groupDecls :: [LHsDecl RdrName] -> RnM (HsGroup RdrName)
    groupDecls decls
      = do { (group, mb_splice) <- findSplice decls
           ; case mb_splice of
           { Nothing -> return group
           ; Just (splice, rest) ->
               do { group' <- groupDecls rest
                  ; let group'' = appendGroups group group'
                  ; return group'' { hs_splcds = noLoc splice : hs_splcds group' }
                  }
           }}
353

354 355 356 357 358 359 360
rn_bracket _ (DecBrG _) = panic "rn_bracket: unexpected DecBrG"

rn_bracket _ (TExpBr e) = do { (e', fvs) <- rnLExpr e
                             ; return (TExpBr e', fvs) }
\end{code}

\begin{code}
361 362
spliceCtxt :: HsExpr RdrName -> SDoc
spliceCtxt expr= hang (ptext (sLit "In the splice:")) 2 (ppr expr)
gmainland's avatar
gmainland committed
363 364 365 366 367 368 369 370 371 372 373 374 375 376

showSplice :: String -> LHsExpr Name -> SDoc -> TcM ()
-- Note that 'before' is *renamed* but not *typechecked*
-- Reason (a) less typechecking crap
--        (b) data constructors after type checking have been
--            changed to their *wrappers*, and that makes them
--            print always fully qualified
showSplice what before after
  = do { loc <- getSrcSpanM
       ; traceSplice (vcat [ppr loc <> colon <+> text "Splicing" <+> text what,
                            nest 2 (sep [nest 2 (ppr before),
                                         text "======>",
                                         nest 2 after])]) }

377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395
illegalBracket :: SDoc
illegalBracket = ptext (sLit "Template Haskell brackets cannot be nested (without intervening splices)")

illegalTypedBracket :: SDoc
illegalTypedBracket = ptext (sLit "Typed brackets may only appear in typed slices.")

illegalUntypedBracket :: SDoc
illegalUntypedBracket = ptext (sLit "Untyped brackets may only appear in untyped slices.")

illegalTypedSplice :: SDoc
illegalTypedSplice = ptext (sLit "Typed splices may not appear in untyped brackets")

illegalUntypedSplice :: SDoc
illegalUntypedSplice = ptext (sLit "Untyped splices may not appear in typed brackets")

quotedNameStageErr :: HsBracket RdrName -> SDoc
quotedNameStageErr br
  = sep [ ptext (sLit "Stage error: the non-top-level quoted name") <+> ppr br
        , ptext (sLit "must be used at the same stage at which is is bound")]
396

397 398 399 400 401
quotationCtxtDoc :: HsBracket RdrName -> SDoc
quotationCtxtDoc br_body
  = hang (ptext (sLit "In the Template Haskell quotation"))
         2 (ppr br_body)

402 403 404 405 406
-- spliceResultDoc :: OutputableBndr id => LHsExpr id -> SDoc
-- spliceResultDoc expr
--  = vcat [ hang (ptext (sLit "In the splice:"))
--              2 (char '$' <> pprParendExpr expr)
--        , ptext (sLit "To see what the splice expanded to, use -ddump-splices") ]
gmainland's avatar
gmainland committed
407 408 409 410
#endif
\end{code}

\begin{code}
411
checkThLocalName :: Name -> RnM ()
gmainland's avatar
gmainland committed
412 413 414
#ifndef GHCI  /* GHCI and TH is off */
--------------------------------------
-- Check for cross-stage lifting
415
checkThLocalName _name
gmainland's avatar
gmainland committed
416 417 418
  = return ()

#else         /* GHCI and TH is on */
419 420 421 422 423 424 425
checkThLocalName name 
  = do  { traceRn (text "checkThLocalName" <+> ppr name)
        ; mb_local_use <- getStageAndBindLevel name
        ; case mb_local_use of {
             Nothing -> return () ;  -- Not a locally-bound thing
             Just (top_lvl, bind_lvl, use_stage) ->
    do  { let use_lvl = thLevel use_stage
gmainland's avatar
gmainland committed
426
        ; checkWellStaged (quotes (ppr name)) bind_lvl use_lvl
427
        ; traceRn (text "checkThLocalName" <+> ppr name <+> ppr bind_lvl <+> ppr use_stage <+> ppr use_lvl)
gmainland's avatar
gmainland committed
428
        ; when (use_lvl > bind_lvl) $
429
          checkCrossStageLifting top_lvl name use_stage } } }
gmainland's avatar
gmainland committed
430 431

--------------------------------------
432
checkCrossStageLifting :: TopLevelFlag -> Name -> ThStage -> TcM ()
gmainland's avatar
gmainland committed
433 434 435 436 437
-- We are inside brackets, and (use_lvl > bind_lvl)
-- Now we must check whether there's a cross-stage lift to do
-- Examples   \x -> [| x |]
--            [| map |]

438
checkCrossStageLifting top_lvl name (Brack _ (RnPendingUntyped ps_var))
439 440
  | isTopLevel top_lvl
        -- Top-level identifiers in this module,
gmainland's avatar
gmainland committed
441 442 443 444 445 446
        -- (which have External Names)
        -- are just like the imported case:
        -- no need for the 'lifting' treatment
        -- E.g.  this is fine:
        --   f x = x
        --   g y = [| f 3 |]
447 448 449
  = when (isExternalName name) (keepAlive name)
    -- See Note [Keeping things alive for Template Haskell]

gmainland's avatar
gmainland committed
450 451 452 453 454 455 456 457 458 459 460 461 462
  | otherwise
  =     -- Nested identifiers, such as 'x' in
        -- E.g. \x -> [| h x |]
        -- We must behave as if the reference to x was
        --      h $(lift x)
        -- We use 'x' itself as the splice proxy, used by
        -- the desugarer to stitch it all back together.
        -- If 'x' occurs many times we may get many identical
        -- bindings of the same splice proxy, but that doesn't
        -- matter, although it's a mite untidy.
    do  { traceRn (text "checkCrossStageLifting" <+> ppr name)
        ; -- Update the pending splices
        ; ps <- readMutVar ps_var
463 464 465
        ; writeMutVar ps_var (PendingRnCrossStageSplice name : ps) }

checkCrossStageLifting _ _ _ = return ()
gmainland's avatar
gmainland committed
466
#endif /* GHCI */
467
\end{code}
468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528

Note [Keeping things alive for Template Haskell]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
  f x = x+1
  g y = [| f 3 |]

Here 'f' is referred to from inside the bracket, which turns into data
and mentions only f's *name*, not 'f' itself. So we need some other
way to keep 'f' alive, lest it get dropped as dead code.  That's what
keepAlive does. It puts it in the keep-alive set, which subsequently
ensures that 'f' stays as a top level binding.

This must be done by the renamer, not the type checker (as of old),
because the type checker doesn't typecheck the body of untyped
brackets (Trac #8540).

A thing can have a bind_lvl of outerLevel, but have an internal name:
   foo = [d| op = 3
             bop = op + 1 |]
Here the bind_lvl of 'op' is (bogusly) outerLevel, even though it is
bound inside a bracket.  That is because we don't even even record
binding levels for top-level things; the binding levels are in the
LocalRdrEnv.

So the occurrence of 'op' in the rhs of 'bop' looks a bit like a
cross-stage thing, but it isn't really.  And in fact we never need
to do anything here for top-level bound things, so all is fine, if
a bit hacky.

For these chaps (which have Internal Names) we don't want to put
them in the keep-alive set.

Note [Quoting names]
~~~~~~~~~~~~~~~~~~~~
A quoted name 'n is a bit like a quoted expression [| n |], except that we
have no cross-stage lifting (c.f. TcExpr.thBrackId).  So, after incrementing
the use-level to account for the brackets, the cases are:

        bind > use                      Error
        bind = use+1                    OK
        bind < use
                Imported things         OK
                Top-level things        OK
                Non-top-level           Error

where 'use' is the binding level of the 'n quote. (So inside the implied
bracket the level would be use+1.)

Examples:

  f 'map        -- OK; also for top-level defns of this module

  \x. f 'x      -- Not ok (bind = 1, use = 1)
                -- (whereas \x. f [| x |] might have been ok, by
                --                               cross-stage lifting

  \y. [| \x. $(f 'y) |] -- Not ok (bind =1, use = 1)

  [| \x. $(f 'x) |]     -- OK (bind = 2, use = 1)