import CmdLineOpts ( DynFlag(..), dopt )
import HsSyn ( HsDecl(..), InstDecl(..), TyClDecl(..), HsType(..),
- MonoBinds(..), HsExpr(..), HsLit(..), Sig(..),
+ MonoBinds(..), HsExpr(..), HsLit(..), Sig(..), HsTyVarBndr(..),
andMonoBindList, collectMonoBinders, isClassDecl, toHsType
)
import RnHsSyn ( RenamedHsBinds, RenamedInstDecl, RenamedHsDecl,
tcExtendTyVarEnvForMeths,
tcAddImportedIdInfo, tcLookupClass,
InstInfo(..), pprInstInfo, simpleInstInfoTyCon,
- simpleInstInfoTy, newDFunName, tcExtendTyVarEnv,
+ simpleInstInfoTy, newDFunName,
isLocalThing,
)
import InstEnv ( InstEnv, extendInstEnv )
-import TcMonoType ( tcTyVars, tcHsSigType, kcHsSigType, checkSigTyVars )
+import TcMonoType ( tcHsTyVars, tcHsSigType, kcHsSigType, checkSigTyVars )
import TcSimplify ( tcSimplifyCheck )
import HscTypes ( HomeSymbolTable, DFunId,
ModDetails(..), PackageInstEnv, PersistentRenamerState
import Generics ( validGenericInstanceType )
import Module ( Module, foldModuleEnv )
import Name ( getSrcLoc )
-import NameSet ( emptyNameSet, unitNameSet, nameSetToList )
+import NameSet ( unitNameSet, nameSetToList )
import PrelInfo ( eRROR_ID )
import PprType ( pprClassPred, pprPred )
import TyCon ( TyCon, isSynTyCon )
import Subst ( mkTopTyVarSubst, substTheta )
import VarSet ( varSetElems )
import TysWiredIn ( genericTyCons, isFFIArgumentTy, isFFIImportResultTy )
+import ForeignCall ( Safety(..) )
import PrelNames ( cCallableClassKey, cReturnableClassKey, hasKey )
import Name ( Name )
import SrcLoc ( SrcLoc )
-- For example: instance (C a, C b) => C (a+b) where { binds }
= -- Extract the universally quantified type variables
- tcTyVars (nameSetToList (extractHsTyVars hs_ty))
- (kcHsSigType hs_ty) `thenTc` \ tyvars ->
- tcExtendTyVarEnv tyvars $
+ let
+ sig_tvs = map UserTyVar (nameSetToList (extractHsTyVars hs_ty))
+ in
+ tcHsTyVars sig_tvs (kcHsSigType hs_ty) $ \ tyvars ->
-- Type-check the instance type, and check its form
tcHsSigType hs_ty `thenTc` \ inst_ty ->
maybe_tycon_app = splitTyConApp_maybe first_inst_tau
Just (tycon, arg_tys) = maybe_tycon_app
- ccallable_type dflags ty = isFFIArgumentTy dflags False {- Not safe call -} ty
+ ccallable_type dflags ty = isFFIArgumentTy dflags PlayRisky ty
creturnable_type ty = isFFIImportResultTy dflags ty
check_tyvars dflags clas inst_taus