+
+
+%************************************************************************
+%* *
+ Re-mappable syntax
+%* *
+%************************************************************************
+
+
+Suppose we are doing the -fno-implicit-prelude thing, and we encounter
+a do-expression. We have to find (>>) in the current environment, which is
+done by the rename. Then we have to check that it has the same type as
+Control.Monad.(>>). Or, more precisely, a compatible type. One 'customer' had
+this:
+
+ (>>) :: HB m n mn => m a -> n b -> mn b
+
+So the idea is to generate a local binding for (>>), thus:
+
+ let then72 :: forall a b. m a -> m b -> m b
+ then72 = ...something involving the user's (>>)...
+ in
+ ...the do-expression...
+
+Now the do-expression can proceed using then72, which has exactly
+the expected type.
+
+In fact tcSyntaxName just generates the RHS for then72, because we only
+want an actual binding in the do-expression case. For literals, we can
+just use the expression inline.
+
+\begin{code}
+tcSyntaxName :: InstOrigin
+ -> TcType -- Type to instantiate it at
+ -> Name -> Name -- (Standard name, user name)
+ -> TcM (TcExpr, LIE, TcType) -- Suitable expression with its type
+
+-- NB: tcSyntaxName calls tcExpr, and hence can do unification.
+-- So we do not call it from lookupInst, which is called from tcSimplify
+
+tcSyntaxName orig ty std_nm user_nm
+ | std_nm == user_nm
+ = newMethodFromName orig ty std_nm `thenNF_Tc` \ inst ->
+ let
+ id = instToId inst
+ in
+ returnTc (HsVar id, unitLIE inst, idType id)
+
+ | otherwise
+ = tcLookupGlobalId std_nm `thenNF_Tc` \ std_id ->
+ let
+ -- C.f. newMethodAtLoc
+ ([tv], _, tau) = tcSplitSigmaTy (idType std_id)
+ tau1 = substTy (mkTopTyVarSubst [tv] [ty]) tau
+ in
+ tcAddErrCtxtM (syntaxNameCtxt user_nm orig tau1) $
+ tcExpr (HsVar user_nm) tau1 `thenTc` \ (user_fn, lie) ->
+ returnTc (user_fn, lie, tau1)
+
+syntaxNameCtxt name orig ty tidy_env
+ = tcGetInstLoc orig `thenNF_Tc` \ inst_loc ->
+ let
+ msg = vcat [ptext SLIT("When checking that") <+> quotes (ppr name) <+>
+ ptext SLIT("(needed by a syntactic construct)"),
+ nest 2 (ptext SLIT("has the required type:") <+> ppr (tidyType tidy_env ty)),
+ nest 2 (pprInstLoc inst_loc)]
+ in
+ returnNF_Tc (tidy_env, msg)
+\end{code}