diff options
author | Bartosz Nitka <niteria@gmail.com> | 2016-01-20 08:58:52 -0800 |
---|---|---|
committer | Bartosz Nitka <niteria@gmail.com> | 2016-01-20 12:30:58 -0800 |
commit | 48d4bc53c517d5e2ac3ff734a7d7a0e2d9454717 (patch) | |
tree | c93e3365c537e01b6918cc8533bb9ee0431c5de1 /compiler | |
parent | 6ddc99116d0107d7781dff1b93d3e8b6f42a99ed (diff) | |
download | haskell-48d4bc53c517d5e2ac3ff734a7d7a0e2d9454717.tar.gz |
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
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/main/HscTypes.hs | 2 | ||||
-rw-r--r-- | compiler/main/InteractiveEval.hs | 5 | ||||
-rw-r--r-- | compiler/typecheck/FunDeps.hs | 4 | ||||
-rw-r--r-- | 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 9b4cd65016..16a1ebd98c 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -1529,7 +1529,7 @@ substInteractiveContext ictxt@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 6356928c21..b7ed44fa7e 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 edf178182b..1a0c3107b7 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 8e7a08d6d9..b867259636 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 |