import TcHsSyn
import TcRnMonad
import TcEnv
-import TcRnTypes
import InstEnv
import FunDeps
import TcMType
newMethodFromName origin name inst_ty
= do { id <- tcLookupId name
-- Use tcLookupId not tcLookupGlobalId; the method is almost
- -- always a class op, but with -XNoImplicitPrelude GHC is
+ -- always a class op, but with -XRebindableSyntax GHC is
-- meant to find whatever thing is in scope, and that may
-- be an ordinary function.
deeplySkolemise skol_info ty
| Just (arg_tys, tvs, theta, ty') <- tcDeepSplitSigmaTy_maybe ty
- = do { ids1 <- newSysLocalIds (fsLit "dsk") arg_tys
+ = do { ids1 <- newSysLocalIds (fsLit "dk") arg_tys
; tvs1 <- mapM (tcInstSkolTyVar skol_info) tvs
; let subst = zipTopTvSubst tvs (mkTyVarTys tvs1)
; ev_vars1 <- newEvVars (substTheta subst theta)
deeplyInstantiate orig ty
| Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe ty
= do { (_, tys, subst) <- tcInstTyVars tvs
- ; ids1 <- newSysLocalIds (fsLit "dsk") (substTys subst arg_tys)
+ ; ids1 <- newSysLocalIds (fsLit "di") (substTys subst arg_tys)
; wrap1 <- instCall orig tys (substTheta subst theta)
- ; (wrap2, rho) <- deeplyInstantiate orig (substTy subst rho)
+ ; (wrap2, rho2) <- deeplyInstantiate orig (substTy subst rho)
; return (mkWpLams ids1
+ <.> wrap2
<.> wrap1
- <.> mkWpEvVarApps ids1
- <.> wrap2,
- mkFunTys arg_tys rho) }
+ <.> mkWpEvVarApps ids1,
+ mkFunTys arg_tys rho2) }
| otherwise = return (idHsWrapper, ty)
\end{code}
%* *
%************************************************************************
-Suppose we are doing the -XNoImplicitPrelude thing, and we encounter
+Suppose we are doing the -XRebindableSyntax 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
getOverlapFlag :: TcM OverlapFlag
getOverlapFlag
= do { dflags <- getDOpts
- ; let overlap_ok = dopt Opt_OverlappingInstances dflags
- incoherent_ok = dopt Opt_IncoherentInstances dflags
+ ; let overlap_ok = xopt Opt_OverlappingInstances dflags
+ incoherent_ok = xopt Opt_IncoherentInstances dflags
overlap_flag | incoherent_ok = Incoherent
| overlap_ok = OverlapOk
| otherwise = NoOverlap
-- Has a bunch of canonical constraints (all givens) got any equalities in it?
hasEqualities givens = any (has_eq . evVarPred) givens
where
- has_eq (EqPred {}) = True
- has_eq (IParam {}) = False
- has_eq (ClassP cls tys) = any has_eq (substTheta subst (classSCTheta cls))
- where
- subst = zipOpenTvSubst (classTyVars cls) tys
+ has_eq (EqPred {}) = True
+ has_eq (IParam {}) = False
+ has_eq (ClassP cls _tys) = any has_eq (classSCTheta cls)
----------------
tyVarsOfWanteds :: WantedConstraints -> TyVarSet