Rename WpCo to WpCast

diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs
index 6f4b4bb..5f0bdb7 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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) }
 
 -----------------------------------