+#ifndef GHCI
+ 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 */
+
+ instantiate :: TcId -> TcM (HsExpr TcId, [TcTyVar], TcRhoType)
+ instantiate fun_id = loop (HsVar fun_id) [] (idType fun_id)
+
+ loop (HsVar fun_id) tvs fun_ty
+ | want_method_inst fun_ty
+ = tcInstType fun_ty `thenM` \ (tyvars, theta, tau) ->
+ newMethodWithGivenTy orig fun_id
+ (mkTyVarTys tyvars) theta tau `thenM` \ meth_id ->
+ loop (HsVar meth_id) (tvs ++ tyvars) tau
+
+ loop fun tvs fun_ty
+ | isSigmaTy fun_ty
+ = tcInstCall orig fun_ty `thenM` \ (inst_fn, new_tvs, tau) ->
+ loop (inst_fn <$> fun) (tvs ++ new_tvs) tau
+
+ | otherwise
+ = returnM (fun, tvs, fun_ty)
+
+ -- Hack Alert (want_method_inst)!
+ -- If f :: (%x :: T) => Int -> Int
+ -- Then if we have two separate calls, (f 3, f 4), we cannot
+ -- make a method constraint that then gets shared, thus:
+ -- let m = f %x in (m 3, m 4)
+ -- because that loses the linearity of the constraint.
+ -- The simplest thing to do is never to construct a method constraint
+ -- in the first place that has a linear implicit parameter in it.
+ want_method_inst fun_ty
+ | opt_NoMethodSharing = False
+ | otherwise = case tcSplitSigmaTy fun_ty of
+ (_,[],_) -> False -- Not overloaded
+ (_,theta,_) -> not (any isLinearPred theta)
+
+ orig = OccurrenceOf id_name
+\end{code}