- loop (HsVar id) (idType id) -- Non-TH case
-
-#else /* GHCI is on */
- -- Check for cross-stage lifting
- getStage `thenM` \ use_stage ->
- case use_stage of
- Brack use_lvl ps_var lie_var
- | use_lvl > bind_lvl && not (isExternalName name)
- -> -- 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.
- --
- -- NB: During type-checking, isExernalName is true of
- -- top level things, and false of nested bindings
- -- Top-level things don't need lifting.
-
- let
- id_ty = idType id
- in
- checkTc (isTauTy id_ty) (polySpliceErr id) `thenM_`
- -- If x is polymorphic, its occurrence sites might
- -- have different instantiations, so we can't use plain
- -- 'x' as the splice proxy name. I don't know how to
- -- solve this, and it's probably unimportant, so I'm
- -- just going to flag an error for now
-
- setLIEVar lie_var (
- newMethodFromName orig id_ty DsMeta.liftName `thenM` \ lift ->
- -- Put the 'lift' constraint into the right LIE
-
- -- Update the pending splices
- readMutVar ps_var `thenM` \ ps ->
- writeMutVar ps_var ((name, HsApp (HsVar lift) (HsVar id)) : ps) `thenM_`
-
- returnM (HsVar id, id_ty))
-
- other ->
- checkWellStaged (quotes (ppr id)) bind_lvl use_stage `thenM_`
- loop (HsVar id) (idType id)
-#endif
- }
+ tc_local_id id th_bind_lvl -- Non-TH case
+ = instantiate id
+
+#else /* GHCI and TH is on */
+ tc_local_id id th_bind_lvl -- TH case
+ = -- Check for cross-stage lifting
+ getStage `thenM` \ use_stage ->
+ case use_stage of
+ Brack use_lvl ps_var lie_var
+ | use_lvl > th_bind_lvl
+ -> if isExternalName id_name then
+ -- Top-level identifiers in this module,
+ -- (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 |]
+ -- But we do need to put f into the keep-alive
+ -- set, because after desugaring the code will
+ -- only mention f's *name*, not f itself.
+ keepAliveTc id_name `thenM_`
+ instantiate id
+
+ else -- 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.
+ let
+ id_ty = idType id
+ in
+ checkTc (isTauTy id_ty) (polySpliceErr id) `thenM_`
+ -- If x is polymorphic, its occurrence sites might
+ -- have different instantiations, so we can't use plain
+ -- 'x' as the splice proxy name. I don't know how to
+ -- solve this, and it's probably unimportant, so I'm
+ -- just going to flag an error for now
+
+ setLIEVar lie_var (
+ newMethodFromName orig id_ty DsMeta.liftName `thenM` \ lift ->
+ -- Put the 'lift' constraint into the right LIE
+
+ -- Update the pending splices
+ readMutVar ps_var `thenM` \ ps ->
+ writeMutVar ps_var ((id_name, nlHsApp (nlHsVar lift) (nlHsVar id)) : ps) `thenM_`
+
+ returnM (HsVar id, [], id_ty))
+
+ other ->
+ checkWellStaged (quotes (ppr id)) th_bind_lvl use_stage `thenM_`
+ instantiate id
+#endif /* GHCI */