summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/basicTypes/DataCon.hs4
-rw-r--r--compiler/typecheck/TcDeriv.hs8
-rw-r--r--compiler/typecheck/TcDerivInfer.hs2
-rw-r--r--compiler/typecheck/TcSplice.hs5
-rw-r--r--compiler/typecheck/TcTyClsDecls.hs3
-rw-r--r--compiler/types/Coercion.hs16
-rw-r--r--compiler/types/FamInstEnv.hs4
-rw-r--r--compiler/types/OptCoercion.hs2
-rw-r--r--compiler/types/TyCoRep.hs37
-rw-r--r--compiler/types/Type.hs8
10 files changed, 44 insertions, 45 deletions
diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index 0e1bb01221..5e7b4cb971 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -86,7 +86,7 @@ import Unique( mkAlphaTyVarUnique )
import qualified Data.Data as Data
import Data.Char
import Data.Word
-import Data.List( mapAccumL, find )
+import Data.List( find )
import qualified Data.Set as Set
{-
@@ -1189,7 +1189,7 @@ dataConInstSig (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs
, substTys subst arg_tys)
where
univ_subst = zipTvSubst univ_tvs univ_tys
- (subst, ex_tvs') = mapAccumL Type.substTyVarBndr univ_subst ex_tvs
+ (subst, ex_tvs') = Type.substTyVarBndrs univ_subst ex_tvs
-- | The \"full signature\" of the 'DataCon' returns, in order:
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index 1795131c79..b044d1fa3d 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -642,8 +642,7 @@ deriveStandalone (L loc (DerivDecl _ deriv_ty mbl_deriv_strat overlap_mode))
unmapped_tkvs = filter (\v -> v `notElemTCvSubst` kind_subst
&& not (v `elemVarSet` ki_subst_range))
tvs'
- (subst, _) = mapAccumL substTyVarBndr
- kind_subst unmapped_tkvs
+ (subst, _) = substTyVarBndrs kind_subst unmapped_tkvs
(final_deriv_ctxt, final_deriv_ctxt_tys)
= case deriv_ctxt' of
InferContext wc -> (InferContext wc, [])
@@ -813,8 +812,7 @@ deriveTyData tvs tc tc_args mb_deriv_strat deriv_pred
unmapped_tkvs = filter (\v -> v `notElemTCvSubst` kind_subst
&& not (v `elemVarSet` ki_subst_range))
tkvs'
- (subst, _) = mapAccumL substTyVarBndr
- kind_subst unmapped_tkvs
+ (subst, _) = substTyVarBndrs kind_subst unmapped_tkvs
final_tc_args = substTys subst tc_args'
final_cls_tys = substTys subst cls_tys'
final_tkvs = tyCoVarsOfTypesWellScoped $
@@ -1035,7 +1033,7 @@ the type variable binder for c, since its kind is (k2 -> k2 -> *).
We used to accomplish this by doing the following:
unmapped_tkvs = filter (`notElemTCvSubst` kind_subst) all_tkvs
- (subst, _) = mapAccumL substTyVarBndr kind_subst unmapped_tkvs
+ (subst, _) = substTyVarBndrs kind_subst unmapped_tkvs
Where all_tkvs contains all kind variables in the class and instance types (in
this case, all_tkvs = [k1,k2]). But since kind_subst only has one mapping,
diff --git a/compiler/typecheck/TcDerivInfer.hs b/compiler/typecheck/TcDerivInfer.hs
index 49578d93a7..d6c379ad74 100644
--- a/compiler/typecheck/TcDerivInfer.hs
+++ b/compiler/typecheck/TcDerivInfer.hs
@@ -148,7 +148,7 @@ inferConstraintsDataConArgs inst_ty inst_tys
emptyTCvSubst (catMaybes mbSubsts)
unmapped_tvs = filter (\v -> v `notElemTCvSubst` subst
&& not (v `isInScope` subst)) tvs
- (subst', _) = mapAccumL substTyVarBndr subst unmapped_tvs
+ (subst', _) = substTyVarBndrs subst unmapped_tvs
preds' = map (substPredOrigin subst') preds
inst_tys' = substTys subst' inst_tys
tvs' = tyCoVarsOfTypesWellScoped inst_tys'
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index b4d9d46513..34bf73eb57 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -103,7 +103,7 @@ import ErrUtils
import Util
import Unique
import VarSet
-import Data.List ( find, mapAccumL )
+import Data.List ( find )
import Data.Maybe
import FastString
import BasicTypes hiding( SuccessFlag(..) )
@@ -1495,8 +1495,7 @@ reifyDataCon isGadtDataCon tys dc
-- See Note [Freshen reified GADT constructors' universal tyvars]
<- freshenTyVarBndrs $
filterOut (`elemVarSet` eq_spec_tvs) g_univ_tvs
- ; let (tvb_subst, g_user_tvs)
- = mapAccumL substTyVarBndr univ_subst g_user_tvs'
+ ; let (tvb_subst, g_user_tvs) = substTyVarBndrs univ_subst g_user_tvs'
g_theta = substTys tvb_subst g_theta'
g_arg_tys = substTys tvb_subst g_arg_tys'
g_res_ty = substTy tvb_subst g_res_ty'
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 0e095de2ea..b90f1be1f9 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -2147,8 +2147,7 @@ rejigConRes tmpl_bndrs res_tmpl dc_inferred_tvs dc_specified_tvs res_ty
tcMatchTy res_tmpl res_ty
= let (univ_tvs, raw_eqs, kind_subst) = mkGADTVars tmpl_tvs dc_tvs subst
raw_ex_tvs = dc_tvs `minusList` univ_tvs
- (arg_subst, substed_ex_tvs)
- = mapAccumL substTyVarBndr kind_subst raw_ex_tvs
+ (arg_subst, substed_ex_tvs) = substTyVarBndrs kind_subst raw_ex_tvs
-- After rejigging the existential tyvars, the resulting substitution
-- gives us exactly what we need to rejig the user-written tyvars,
diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs
index 8085e10f2b..d0d0e97a56 100644
--- a/compiler/types/Coercion.hs
+++ b/compiler/types/Coercion.hs
@@ -81,10 +81,10 @@ module Coercion (
-- ** Lifting
liftCoSubst, liftCoSubstTyVar, liftCoSubstWith, liftCoSubstWithEx,
emptyLiftingContext, extendLiftingContext, extendLiftingContextAndInScope,
- liftCoSubstVarBndrCallback, isMappedByLC,
+ liftCoSubstVarBndrUsing, isMappedByLC,
mkSubstLiftingContext, zapLiftingContext,
- substForAllCoBndrCallbackLC, lcTCvSubst, lcInScopeSet,
+ substForAllCoBndrUsingLC, lcTCvSubst, lcInScopeSet,
LiftCoEnv, LiftingContext(..), liftEnvSubstLeft, liftEnvSubstRight,
substRightCo, substLeftCo, swapLiftCoEnv, lcSubstLeft, lcSubstRight,
@@ -1621,14 +1621,14 @@ zapLiftingContext :: LiftingContext -> LiftingContext
zapLiftingContext (LC subst _) = LC (zapTCvSubst subst) emptyVarEnv
-- | Like 'substForAllCoBndr', but works on a lifting context
-substForAllCoBndrCallbackLC :: Bool
+substForAllCoBndrUsingLC :: Bool
-> (Coercion -> Coercion)
-> LiftingContext -> TyVar -> Coercion
-> (LiftingContext, TyVar, Coercion)
-substForAllCoBndrCallbackLC sym sco (LC subst lc_env) tv co
+substForAllCoBndrUsingLC sym sco (LC subst lc_env) tv co
= (LC subst' lc_env, tv', co')
where
- (subst', tv', co') = substForAllCoBndrCallback sym sco subst tv co
+ (subst', tv', co') = substForAllCoBndrUsing sym sco subst tv co
-- | The \"lifting\" operation which substitutes coercions for type
-- variables in a type to produce a coercion.
@@ -1687,16 +1687,16 @@ liftCoSubstTyVar (LC subst env) r v
liftCoSubstVarBndr :: LiftingContext -> TyVar
-> (LiftingContext, TyVar, Coercion)
liftCoSubstVarBndr lc tv
- = let (lc', tv', h, _) = liftCoSubstVarBndrCallback callback lc tv in
+ = let (lc', tv', h, _) = liftCoSubstVarBndrUsing callback lc tv in
(lc', tv', h)
where
callback lc' ty' = (ty_co_subst lc' Nominal ty', ())
-- the callback must produce a nominal coercion
-liftCoSubstVarBndrCallback :: (LiftingContext -> Type -> (Coercion, a))
+liftCoSubstVarBndrUsing :: (LiftingContext -> Type -> (Coercion, a))
-> LiftingContext -> TyVar
-> (LiftingContext, TyVar, Coercion, a)
-liftCoSubstVarBndrCallback fun lc@(LC subst cenv) old_var
+liftCoSubstVarBndrUsing fun lc@(LC subst cenv) old_var
= ( LC (subst `extendTCvInScope` new_var) new_cenv
, new_var, eta, stuff )
where
diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs
index 64ea467b25..306e1b1034 100644
--- a/compiler/types/FamInstEnv.hs
+++ b/compiler/types/FamInstEnv.hs
@@ -1205,7 +1205,7 @@ Type) pairs.
We also benefit because we can piggyback on the liftCoSubstVarBndr function to
deal with binders. However, I had to modify that function to work with this
-application. Thus, we now have liftCoSubstVarBndrCallback, which takes
+application. Thus, we now have liftCoSubstVarBndrUsing, which takes
a function used to process the kind of the binder. We don't wish
to lift the kind, but instead normalise it. So, we pass in a callback function
that processes the kind of the binder.
@@ -1401,7 +1401,7 @@ normalise_tyvar_bndr tv
= do { lc1 <- getLC
; env <- getEnv
; let callback lc ki = runNormM (normalise_type ki) env lc Nominal
- ; return $ liftCoSubstVarBndrCallback callback lc1 tv }
+ ; return $ liftCoSubstVarBndrUsing callback lc1 tv }
-- | a monad for the normalisation functions, reading 'FamInstEnvs',
-- a 'LiftingContext', and a 'Role'.
diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs
index ccad41bc0c..db4bc8c668 100644
--- a/compiler/types/OptCoercion.hs
+++ b/compiler/types/OptCoercion.hs
@@ -1043,4 +1043,4 @@ and these two imply
optForAllCoBndr :: LiftingContext -> Bool
-> TyVar -> Coercion -> (LiftingContext, TyVar, Coercion)
optForAllCoBndr env sym
- = substForAllCoBndrCallbackLC sym (opt_co4_wrap env sym False Nominal) env
+ = substForAllCoBndrUsingLC sym (opt_co4_wrap env sym False Nominal) env
diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index 362be33c03..9a5bfdb2a0 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -112,12 +112,12 @@ module TyCoRep (
substCoUnchecked, substCoWithUnchecked,
substTyWithInScope,
substTys, substTheta,
- lookupTyVar, substTyVarBndr,
+ lookupTyVar, substTyVarBndr, substTyVarBndrs,
substCo, substCos, substCoVar, substCoVars, lookupCoVar,
substCoVarBndr, cloneTyVarBndr, cloneTyVarBndrs,
substTyVar, substTyVars,
substForAllCoBndr,
- substTyVarBndrCallback, substForAllCoBndrCallback,
+ substTyVarBndrUsing, substForAllCoBndrUsing,
checkValidSubst, isValidTCvSubst,
-- * Tidying type related things up for printing
@@ -2290,17 +2290,15 @@ isValidTCvSubst (TCvSubst in_scope tenv cenv) =
checkValidSubst :: HasCallStack => TCvSubst -> [Type] -> [Coercion] -> a -> a
checkValidSubst subst@(TCvSubst in_scope tenv cenv) tys cos a
-- TODO (RAE): Change back to ASSERT
- = WARN( not ({-#SCC "isValidTCvSubst" #-} isValidTCvSubst subst),
+ = WARN( not (isValidTCvSubst subst),
text "in_scope" <+> ppr in_scope $$
text "tenv" <+> ppr tenv $$
- text "tenvFVs"
- <+> ppr (tyCoVarsOfTypesSet tenv) $$
+ text "tenvFVs" <+> ppr (tyCoVarsOfTypesSet tenv) $$
text "cenv" <+> ppr cenv $$
- text "cenvFVs"
- <+> ppr (tyCoVarsOfCosSet cenv) $$
+ text "cenvFVs" <+> ppr (tyCoVarsOfCosSet cenv) $$
text "tys" <+> ppr tys $$
text "cos" <+> ppr cos )
- WARN( not ({-#SCC "tysCosFVsInScope" #-} tysCosFVsInScope),
+ WARN( not tysCosFVsInScope,
text "in_scope" <+> ppr in_scope $$
text "tenv" <+> ppr tenv $$
text "cenv" <+> ppr cenv $$
@@ -2481,7 +2479,7 @@ subst_co subst co
substForAllCoBndr :: TCvSubst -> TyVar -> Coercion -> (TCvSubst, TyVar, Coercion)
substForAllCoBndr subst
- = substForAllCoBndrCallback False (substCo subst) subst
+ = substForAllCoBndrUsing False (substCo subst) subst
-- | Like 'substForAllCoBndr', but disables sanity checks.
-- The problems that the sanity checks in substCo catch are described in
@@ -2490,14 +2488,14 @@ substForAllCoBndr subst
-- substCo and remove this function. Please don't use in new code.
substForAllCoBndrUnchecked :: TCvSubst -> TyVar -> Coercion -> (TCvSubst, TyVar, Coercion)
substForAllCoBndrUnchecked subst
- = substForAllCoBndrCallback False (substCoUnchecked subst) subst
+ = substForAllCoBndrUsing False (substCoUnchecked subst) subst
-- See Note [Sym and ForAllCo]
-substForAllCoBndrCallback :: Bool -- apply sym to binder?
+substForAllCoBndrUsing :: Bool -- apply sym to binder?
-> (Coercion -> Coercion) -- transformation to kind co
-> TCvSubst -> TyVar -> Coercion
-> (TCvSubst, TyVar, Coercion)
-substForAllCoBndrCallback sym sco (TCvSubst in_scope tenv cenv)
+substForAllCoBndrUsing sym sco (TCvSubst in_scope tenv cenv)
old_var old_kind_co
= ( TCvSubst (in_scope `extendInScopeSet` new_var) new_env cenv
, new_var, new_kind_co )
@@ -2530,7 +2528,10 @@ lookupCoVar :: TCvSubst -> Var -> Maybe Coercion
lookupCoVar (TCvSubst _ _ cenv) v = lookupVarEnv cenv v
substTyVarBndr :: HasCallStack => TCvSubst -> TyVar -> (TCvSubst, TyVar)
-substTyVarBndr = substTyVarBndrCallback substTy
+substTyVarBndr = substTyVarBndrUsing substTy
+
+substTyVarBndrs :: HasCallStack => TCvSubst -> [TyVar] -> (TCvSubst, [TyVar])
+substTyVarBndrs = mapAccumL substTyVarBndr
-- | Like 'substTyVarBndr' but disables sanity checks.
-- The problems that the sanity checks in substTy catch are described in
@@ -2538,13 +2539,15 @@ substTyVarBndr = substTyVarBndrCallback substTy
-- The goal of #11371 is to migrate all the calls of substTyUnchecked to
-- substTy and remove this function. Please don't use in new code.
substTyVarBndrUnchecked :: TCvSubst -> TyVar -> (TCvSubst, TyVar)
-substTyVarBndrUnchecked = substTyVarBndrCallback substTyUnchecked
+substTyVarBndrUnchecked = substTyVarBndrUsing substTyUnchecked
-- | Substitute a tyvar in a binding position, returning an
-- extended subst and a new tyvar.
-substTyVarBndrCallback :: (TCvSubst -> Type -> Type) -- ^ the subst function
- -> TCvSubst -> TyVar -> (TCvSubst, TyVar)
-substTyVarBndrCallback subst_fn subst@(TCvSubst in_scope tenv cenv) old_var
+-- Use the supplied function to substitute in the kind
+substTyVarBndrUsing
+ :: (TCvSubst -> Type -> Type) -- ^ Use this to substitute in the kind
+ -> TCvSubst -> TyVar -> (TCvSubst, TyVar)
+substTyVarBndrUsing subst_fn subst@(TCvSubst in_scope tenv cenv) old_var
= ASSERT2( _no_capture, pprTyVar old_var $$ pprTyVar new_var $$ ppr subst )
ASSERT( isTyVar old_var )
(TCvSubst (in_scope `extendInScopeSet` new_var) new_env cenv, new_var)
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 9c88c11bc4..f501930cc7 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -177,7 +177,7 @@ module Type (
substTyUnchecked, substTysUnchecked, substThetaUnchecked,
substTyWithUnchecked,
substCoUnchecked, substCoWithUnchecked,
- substTyVarBndr, substTyVar, substTyVars,
+ substTyVarBndr, substTyVarBndrs, substTyVar, substTyVars,
cloneTyVarBndr, cloneTyVarBndrs, lookupTyVar,
-- * Pretty-printing
@@ -398,7 +398,7 @@ expandTypeSynonyms ty
go subst (FunTy arg res)
= mkFunTy (go subst arg) (go subst res)
go subst (ForAllTy (TvBndr tv vis) t)
- = let (subst', tv') = substTyVarBndrCallback go subst tv in
+ = let (subst', tv') = substTyVarBndrUsing go subst tv in
ForAllTy (TvBndr tv' vis) (go subst' t)
go subst (CastTy ty co) = mkCastTy (go subst ty) (go_co subst co)
go subst (CoercionTy co) = mkCoercionTy (go_co subst co)
@@ -448,10 +448,10 @@ expandTypeSynonyms ty
go_prov _ p@(PluginProv _) = p
-- the "False" and "const" are to accommodate the type of
- -- substForAllCoBndrCallback, which is general enough to
+ -- substForAllCoBndrUsing, which is general enough to
-- handle coercion optimization (which sometimes swaps the
-- order of a coercion)
- go_cobndr subst = substForAllCoBndrCallback False (go_co subst) subst
+ go_cobndr subst = substForAllCoBndrUsing False (go_co subst) subst
{-
************************************************************************
View Lorry Controller Status