From dd99b6f8c61f393087d03cd697c06051a43ca4e9 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Tue, 22 Apr 2008 11:28:04 +0000 Subject: [PATCH] Rename WpCo to WpCast --- compiler/deSugar/DsBinds.lhs | 2 +- compiler/deSugar/Match.lhs | 4 ++-- compiler/hsSyn/HsBinds.lhs | 4 ++-- compiler/hsSyn/HsPat.lhs | 2 +- compiler/hsSyn/HsUtils.lhs | 4 ++-- compiler/typecheck/TcExpr.lhs | 2 +- compiler/typecheck/TcHsSyn.lhs | 4 ++-- compiler/typecheck/TcInstDcls.lhs | 2 +- compiler/typecheck/TcPat.lhs | 2 +- compiler/typecheck/TcTyFuns.lhs | 2 +- compiler/typecheck/TcUnify.lhs | 2 +- 11 files changed, 15 insertions(+), 15 deletions(-) diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs index 6f4b4bb..5f0bdb7 100644 --- a/compiler/deSugar/DsBinds.lhs +++ b/compiler/deSugar/DsBinds.lhs @@ -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) } diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs index a7e9bce..c322686 100644 --- a/compiler/deSugar/Match.lhs +++ b/compiler/deSugar/Match.lhs @@ -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) diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index d1c2234..7de1d83 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -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] diff --git a/compiler/hsSyn/HsPat.lhs b/compiler/hsSyn/HsPat.lhs index 53a8bc0..6cad66c 100644 --- a/compiler/hsSyn/HsPat.lhs +++ b/compiler/hsSyn/HsPat.lhs @@ -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} diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs index ee10a42..d85db1a 100644 --- a/compiler/hsSyn/HsUtils.lhs +++ b/compiler/hsSyn/HsUtils.lhs @@ -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)) diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs index b4abd3d..567f2dc 100644 --- a/compiler/typecheck/TcExpr.lhs +++ b/compiler/typecheck/TcExpr.lhs @@ -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 diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs index 7afd9e8..c00329f 100644 --- a/compiler/typecheck/TcHsSyn.lhs +++ b/compiler/typecheck/TcHsSyn.lhs @@ -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') } diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index 8eb2d8e..6d566dd 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -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 diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs index f07ce91..1759257 100644 --- a/compiler/typecheck/TcPat.lhs +++ b/compiler/typecheck/TcPat.lhs @@ -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 diff --git a/compiler/typecheck/TcTyFuns.lhs b/compiler/typecheck/TcTyFuns.lhs index 625d4cd..5a6f084 100644 --- a/compiler/typecheck/TcTyFuns.lhs +++ b/compiler/typecheck/TcTyFuns.lhs @@ -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 diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index aa92829..a237a5d 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -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) } ----------------------------------- -- 1.7.10.4