Commit dd99b6f8 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Rename WpCo to WpCast

parent e314b86f
......@@ -466,7 +466,7 @@ addDictScc _ rhs = return rhs
dsCoercion :: HsWrapper -> DsM CoreExpr -> DsM CoreExpr
dsCoercion WpHole thing_inside = thing_inside
dsCoercion (WpCompose c1 c2) thing_inside = dsCoercion c1 (dsCoercion c2 thing_inside)
dsCoercion (WpCo co) thing_inside = do { expr <- thing_inside
dsCoercion (WpCast co) thing_inside = do { expr <- thing_inside
; return (Cast expr co) }
dsCoercion (WpLam id) thing_inside = do { expr <- thing_inside
; return (Lam id expr) }
......
......@@ -843,8 +843,8 @@ viewLExprEq (e1,_) (e2,_) =
-- equating different ways of writing a coercion)
wrap WpHole WpHole = True
wrap (WpCompose w1 w2) (WpCompose w1' w2') = wrap w1 w1' && wrap w2 w2'
wrap (WpCo c) (WpCo c') = tcEqType c c'
wrap (WpApp d) (WpApp d') = d == d'
wrap (WpCast c) (WpCast c') = tcEqType c c'
wrap (WpApp d) (WpApp d') = d == d'
wrap (WpTyApp t) (WpTyApp t') = tcEqType t t'
-- Enhancement: could implement equality for more wrappers
-- if it seems useful (lams and lets)
......
......@@ -339,7 +339,7 @@ data HsWrapper
| WpCompose HsWrapper HsWrapper -- (\a1..an. []) `WpCompose` (\x1..xn. [])
-- = (\a1..an \x1..xn. [])
| WpCo Coercion -- A cast: [] `cast` co
| WpCast Coercion -- A cast: [] `cast` co
-- Guaranteedn not the identity coercion
| WpApp Var -- [] d the 'd' is a type-class dictionary
......@@ -361,7 +361,7 @@ pprHsWrapper it wrap =
let
help it WpHole = it
help it (WpCompose f1 f2) = help (help it f2) f1
help it (WpCo co) = sep [it, nest 2 (ptext SLIT("`cast`") <+> pprParendType co)]
help it (WpCast co) = sep [it, nest 2 (ptext SLIT("`cast`") <+> pprParendType co)]
help it (WpApp id) = sep [it, nest 2 (ppr id)]
help it (WpTyApp ty) = sep [it, ptext SLIT("@") <+> pprParendType ty]
help it (WpLam id) = sep [ptext SLIT("\\") <> pprBndr LambdaBind id <> dot, it]
......
......@@ -328,7 +328,7 @@ mkCoPat co pat ty
mkCoPatCoI :: CoercionI -> Pat id -> Type -> Pat id
mkCoPatCoI IdCo pat _ = pat
mkCoPatCoI (ACo co) pat ty = mkCoPat (WpCo co) pat ty
mkCoPatCoI (ACo co) pat ty = mkCoPat (WpCast co) pat ty
\end{code}
......
......@@ -85,11 +85,11 @@ mkHsWrap co_fn e | isIdHsWrapper co_fn = e
mkHsWrapCoI :: CoercionI -> HsExpr id -> HsExpr id
mkHsWrapCoI IdCo e = e
mkHsWrapCoI (ACo co) e = mkHsWrap (WpCo co) e
mkHsWrapCoI (ACo co) e = mkHsWrap (WpCast co) e
coiToHsWrapper :: CoercionI -> HsWrapper
coiToHsWrapper IdCo = idHsWrapper
coiToHsWrapper (ACo co) = WpCo co
coiToHsWrapper (ACo co) = WpCast co
mkHsLam :: [LPat id] -> LHsExpr id -> LHsExpr id
mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches))
......
......@@ -497,7 +497,7 @@ tcExpr expr@(RecordUpd record_expr rbinds _ _ _) res_ty = do
-- Step 7: make a cast for the scrutinee, in the case that it's from a type family
let scrut_co | Just co_con <- tyConFamilyCoercion_maybe tycon
= WpCo $ mkTyConApp co_con scrut_inst_tys
= WpCast $ mkTyConApp co_con scrut_inst_tys
| otherwise
= idHsWrapper
......
......@@ -563,8 +563,8 @@ zonkCoFn env WpInline = return (env, WpInline)
zonkCoFn env (WpCompose c1 c2) = do { (env1, c1') <- zonkCoFn env c1
; (env2, c2') <- zonkCoFn env1 c2
; return (env2, WpCompose c1' c2') }
zonkCoFn env (WpCo co) = do { co' <- zonkTcTypeToType env co
; return (env, WpCo co') }
zonkCoFn env (WpCast co) = do { co' <- zonkTcTypeToType env co
; return (env, WpCast co') }
zonkCoFn env (WpLam id) = do { id' <- zonkDictBndr env id
; let env1 = extendZonkEnv1 env id'
; return (env1, WpLam id') }
......
......@@ -541,7 +541,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = NewTypeDerived })
make_coercion cls_tycon initial_cls_inst_tys nt_tycon tc_args
| Just co_con <- newTyConCo_maybe nt_tycon
, let co = mkSymCoercion (mkTyConApp co_con tc_args)
= WpCo (mkTyConApp cls_tycon (initial_cls_inst_tys ++ [co]))
= WpCast (mkTyConApp cls_tycon (initial_cls_inst_tys ++ [co]))
| otherwise -- The newtype is transparent; no need for a cast
= idHsWrapper
......
......@@ -714,7 +714,7 @@ tcConPat pstate con_span data_con tycon pat_ty arg_pats thing_inside
-- NB: We can use CoPat directly, rather than mkCoPat, as we know the
-- coercion is not the identity; mkCoPat is inconvenient as it
-- wants a located pattern.
= CoPat (WpCo $ mkTyConApp co_con args) -- co fam ty to repr ty
= CoPat (WpCast $ mkTyConApp co_con args) -- co fam ty to repr ty
(pat {pat_ty = mkTyConApp tycon args}) -- representation type
pat_ty -- family inst type
| otherwise
......
......@@ -1152,7 +1152,7 @@ genericNormaliseInsts isWanted fun insts
-- else
-- dict' = dict `cast` co
expr = HsVar $ instToId source_dict
cast_expr = HsWrap (WpCo st_co) expr
cast_expr = HsWrap (WpCast st_co) expr
rhs = L (instLocSpan loc) cast_expr
binds = instToDictBind target_dict rhs
-- return the new inst
......
......@@ -866,7 +866,7 @@ tc_sub_funs orig act_arg act_res exp_ib exp_arg exp_res
; wrapper1 <- wrapFunResCoercion [exp_arg] co_fn_res
; let wrapper2 = case arg_coi of
IdCo -> idHsWrapper
ACo co -> WpCo $ FunTy co act_res
ACo co -> WpCast $ FunTy co act_res
; return (wrapper1 <.> wrapper2) }
-----------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment