tcExtendLocalInstEnv, tcGetInstEnvs, getOverlapFlag,
isDict, isClassDict, isMethod,
- isLinearInst, linearInstType, isIPDict, isInheritableInst,
+ isIPDict, isInheritableInst,
isTyVarDict, isMethodFor,
zonkInst, zonkInsts,
import {-# SOURCE #-} TcUnify( unifyType )
import HsSyn ( HsLit(..), HsOverLit(..), HsExpr(..), LHsExpr, mkHsApp,
- ExprCoFn(..), (<.>), mkCoTyApps, idCoercion,
+ HsWrapper(..), (<.>), mkWpTyApps, idHsWrapper,
nlHsLit, nlHsVar )
import TcHsSyn ( zonkId )
import TcRnMonad
isIntTy,isFloatTy, isIntegerTy, isDoubleTy,
mkPredTy, mkTyVarTys,
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tidyPred,
- isClassPred, isTyVarClassPred, isLinearPred,
+ isClassPred, isTyVarClassPred,
getClassPredTys, mkPredName,
isInheritablePred, isIPPred,
tidyType, tidyTypes, tidyFreeTyVars, tcSplitSigmaTy,
isMethodFor :: TcIdSet -> Inst -> Bool
isMethodFor ids (Method uniq id tys _ loc) = id `elemVarSet` ids
isMethodFor ids inst = False
-
-isLinearInst :: Inst -> Bool
-isLinearInst (Dict _ pred _) = isLinearPred pred
-isLinearInst other = False
- -- We never build Method Insts that have
- -- linear implicit paramters in them.
- -- Hence no need to look for Methods
- -- See TcExpr.tcId
-
-linearInstType :: Inst -> TcType -- %x::t --> t
-linearInstType (Dict _ (IParam _ ty) _) = ty
\end{code}
; return (Dict name pred inst_loc) }
----------------
-instCall :: InstOrigin -> [TcType] -> TcThetaType -> TcM ExprCoFn
+instCall :: InstOrigin -> [TcType] -> TcThetaType -> TcM HsWrapper
-- Instantiate the constraints of a call
-- (instCall o tys theta)
-- (a) Makes fresh dictionaries as necessary for the constraints (theta)
-- (b) Throws these dictionaries into the LIE
--- (c) Eeturns an ExprCoFn ([.] tys dicts)
+-- (c) Eeturns an HsWrapper ([.] tys dicts)
instCall orig tys theta
= do { loc <- getInstLoc orig
; (dicts, dict_app) <- instCallDicts loc theta
; extendLIEs dicts
- ; return (dict_app <.> mkCoTyApps tys) }
+ ; return (dict_app <.> mkWpTyApps tys) }
----------------
instStupidTheta :: InstOrigin -> TcThetaType -> TcM ()
; extendLIEs dicts }
----------------
-instCallDicts :: InstLoc -> TcThetaType -> TcM ([Inst], ExprCoFn)
+instCallDicts :: InstLoc -> TcThetaType -> TcM ([Inst], HsWrapper)
-- This is the key place where equality predicates
-- are unleashed into the world
-instCallDicts loc [] = return ([], idCoercion)
+instCallDicts loc [] = return ([], idHsWrapper)
instCallDicts loc (EqPred ty1 ty2 : preds)
= do { unifyType ty1 ty2 -- For now, we insist that they unify right away
-- Later on, when we do associated types,
- -- unifyType might return a coercion
+ -- unifyType :: Type -> Type -> TcM ([Inst], Coercion)
; (dicts, co_fn) <- instCallDicts loc preds
- ; return (dicts, co_fn <.> CoTyApp ty1) }
+ ; return (dicts, co_fn <.> WpTyApp ty1) }
-- We use type application to apply the function to the
-- coercion; here ty1 *is* the appropriate identity coercion
; let name = mkPredName uniq (instLocSrcLoc loc) pred
dict = Dict name pred loc
; (dicts, co_fn) <- instCallDicts loc preds
- ; return (dict:dicts, co_fn <.> CoApp (instToId dict)) }
+ ; return (dict:dicts, co_fn <.> WpApp (instToId dict)) }
-------------
cloneDict :: Inst -> TcM Inst -- Only used for linear implicit params
lookupInst inst@(Method _ id tys theta loc)
= do { (dicts, dict_app) <- instCallDicts loc theta
- ; let co_fn = dict_app <.> mkCoTyApps tys
- ; return (GenInst dicts (L span $ HsCoerce co_fn (HsVar id))) }
+ ; let co_fn = dict_app <.> mkWpTyApps tys
+ ; return (GenInst dicts (L span $ HsWrap co_fn (HsVar id))) }
where
span = instLocSrcSpan loc
dfun = HsVar dfun_id
tys = map (substTyVar tenv') tyvars
; if null theta then
- returnM (SimpleInst (L src_loc $ HsCoerce (mkCoTyApps tys) dfun))
+ returnM (SimpleInst (L src_loc $ HsWrap (mkWpTyApps tys) dfun))
else do
{ (dicts, dict_app) <- instCallDicts loc theta
- ; let co_fn = dict_app <.> mkCoTyApps tys
- ; returnM (GenInst dicts (L src_loc $ HsCoerce co_fn dfun))
+ ; let co_fn = dict_app <.> mkWpTyApps tys
+ ; returnM (GenInst dicts (L src_loc $ HsWrap co_fn dfun))
}}}}
---------------