[commit: ghc] master: substTy to substTyUnchecked to fix Travis build (48d4bc5)
git at git.haskell.org
git at git.haskell.org
Wed Jan 20 20:30:05 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/48d4bc53c517d5e2ac3ff734a7d7a0e2d9454717/ghc
>---------------------------------------------------------------
commit 48d4bc53c517d5e2ac3ff734a7d7a0e2d9454717
Author: Bartosz Nitka <niteria at gmail.com>
Date: Wed Jan 20 08:58:52 2016 -0800
substTy to substTyUnchecked to fix Travis build
This fixes the immediate problem from
https://s3.amazonaws.com/archive.travis-ci.org/jobs/103319396/log.txt
Test Plan: ./validate
Reviewers: bgamari, austin, thomie
Differential Revision: https://phabricator.haskell.org/D1802
GHC Trac Issues: #11371
>---------------------------------------------------------------
48d4bc53c517d5e2ac3ff734a7d7a0e2d9454717
compiler/main/HscTypes.hs | 2 +-
compiler/main/InteractiveEval.hs | 5 +++--
compiler/typecheck/FunDeps.hs | 4 ++--
compiler/types/OptCoercion.hs | 8 ++++----
4 files changed, 10 insertions(+), 9 deletions(-)
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 9b4cd65..16a1ebd 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -1529,7 +1529,7 @@ substInteractiveContext ictxt at InteractiveContext{ ic_tythings = tts } subst
| isEmptyTCvSubst subst = ictxt
| otherwise = ictxt { ic_tythings = map subst_ty tts }
where
- subst_ty (AnId id) = AnId $ id `setIdType` substTy subst (idType id)
+ subst_ty (AnId id) = AnId $ id `setIdType` substTyUnchecked subst (idType id)
subst_ty tt = tt
instance Outputable InteractiveImport where
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 6356928..b7ed44f 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -533,12 +533,13 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
let tv_subst = newTyVars us free_tvs
filtered_ids = [ id | (id, Just _hv) <- zip ids mb_hValues ]
(_,tidy_tys) = tidyOpenTypes emptyTidyEnv $
- map (substTy tv_subst . idType) filtered_ids
+ map (substTyUnchecked tv_subst . idType) filtered_ids
new_ids <- zipWith3M mkNewId occs tidy_tys filtered_ids
result_name <- newInteractiveBinder hsc_env (mkVarOccFS result_fs) span
- let result_id = Id.mkVanillaGlobal result_name (substTy tv_subst result_ty)
+ let result_id = Id.mkVanillaGlobal result_name
+ (substTyUnchecked tv_subst result_ty)
result_ok = isPointer result_id
final_ids | result_ok = result_id : new_ids
diff --git a/compiler/typecheck/FunDeps.hs b/compiler/typecheck/FunDeps.hs
index edf1781..1a0c310 100644
--- a/compiler/typecheck/FunDeps.hs
+++ b/compiler/typecheck/FunDeps.hs
@@ -286,7 +286,7 @@ improveClsFD clas_tvs fd
-- executed. What we're doing instead is recording the partial
-- work of the ls1/ls2 unification leaving a smaller unification problem
where
- rtys1' = map (substTy subst) rtys1
+ rtys1' = map (substTyUnchecked subst) rtys1
fdeqs = zipAndComputeFDEqs (\_ _ -> False) rtys1' rtys2
-- Don't discard anything!
@@ -294,7 +294,7 @@ improveClsFD clas_tvs fd
-- eqType again, since we know for sure that /at least one/
-- equation in there is useful)
- meta_tvs = [ setVarType tv (substTy subst (varType tv))
+ meta_tvs = [ setVarType tv (substTyUnchecked subst (varType tv))
| tv <- qtvs, tv `notElemTCvSubst` subst ]
-- meta_tvs are the quantified type variables
-- that have not been substituted out
diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs
index 8e7a08d..b867259 100644
--- a/compiler/types/OptCoercion.hs
+++ b/compiler/types/OptCoercion.hs
@@ -91,8 +91,8 @@ optCoercion env co
(Pair in_ty1 in_ty2, in_role) = coercionKindRole co
(Pair out_ty1 out_ty2, out_role) = coercionKindRole out_co
in
- ASSERT2( substTy env in_ty1 `eqType` out_ty1 &&
- substTy env in_ty2 `eqType` out_ty2 &&
+ ASSERT2( substTyUnchecked env in_ty1 `eqType` out_ty1 &&
+ substTyUnchecked env in_ty2 `eqType` out_ty2 &&
in_role == out_role
, text "optCoercion changed types!"
$$ hang (text "in_co:") 2 (ppr co)
@@ -371,8 +371,8 @@ opt_univ env sym prov role oty1 oty2
mkForAllCo tv1' eta' (opt_univ env' sym prov role ty1 ty2')
| otherwise
- = let ty1 = substTy (lcSubstLeft env) oty1
- ty2 = substTy (lcSubstRight env) oty2
+ = let ty1 = substTyUnchecked (lcSubstLeft env) oty1
+ ty2 = substTyUnchecked (lcSubstRight env) oty2
(a, b) | sym = (ty2, ty1)
| otherwise = (ty1, ty2)
in
More information about the ghc-commits
mailing list