+#ifndef GHCI
+ tc_local_id id th_bind_lvl proc_lvl -- Non-TH case
+ = checkProcLevel id proc_lvl `thenM_`
+ loop (HsVar id) (idType id)
+
+#else /* GHCI and TH is on */
+ tc_local_id id th_bind_lvl proc_lvl -- TH case
+ = checkProcLevel id proc_lvl `thenM_`
+
+ -- 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
+ -> -- 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 ((name, nlHsApp (nlHsVar lift) (nlHsVar id)) : ps) `thenM_`
+
+ returnM (HsVar id, id_ty))
+
+ other ->
+ checkWellStaged (quotes (ppr id)) th_bind_lvl use_stage `thenM_`
+ loop (HsVar id) (idType id)
+#endif /* GHCI */
+
+ loop (HsVar fun_id) fun_ty
+ | want_method_inst fun_ty
+ = tcInstType VanillaTv fun_ty `thenM` \ (tyvars, theta, tau) ->
+ newMethodWithGivenTy orig fun_id
+ (mkTyVarTys tyvars) theta tau `thenM` \ meth_id ->
+ loop (HsVar meth_id) tau
+
+ loop fun fun_ty
+ | isSigmaTy fun_ty
+ = tcInstCall orig fun_ty `thenM` \ (inst_fn, tau) ->
+ loop (inst_fn <$> fun) tau
+
+ | otherwise
+ = returnM (fun, 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)
+
+
+ -- We treat data constructors differently, because we have to generate
+ -- constraints for their silly theta, which no longer appears in
+ -- the type of dataConWrapId (see note on "stupid context" in DataCon.lhs
+ -- It's dual to TcPat.tcConstructor
+ inst_data_con data_con
+ = tcInstDataCon orig data_con `thenM` \ (ty_args, ex_dicts, arg_tys, result_ty, _) ->
+ extendLIEs ex_dicts `thenM_`
+ getSrcSpanM `thenM` \ loc ->
+ returnM (unLoc (mkHsDictApp (mkHsTyApp (L loc (HsVar (dataConWrapId data_con))) ty_args)
+ (map instToId ex_dicts)),
+ mkFunTys arg_tys result_ty)
+ -- ToDo: nasty loc/unloc stuff here
+
+ orig = OccurrenceOf name
+\end{code}