[commit: ghc] ghc-8.0: substTy to substTyUnchecked to fix Travis build (1018345)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/10183451279b97183addfea0382748fbb2e59e48/ghc

>---------------------------------------------------------------

commit 10183451279b97183addfea0382748fbb2e59e48
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
    
    (cherry picked from commit 48d4bc53c517d5e2ac3ff734a7d7a0e2d9454717)


>---------------------------------------------------------------

10183451279b97183addfea0382748fbb2e59e48
 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 1922717..bf6ad1e 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -1530,7 +1530,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 5768448..bf8c260 100644
--- a/compiler/typecheck/FunDeps.hs
+++ b/compiler/typecheck/FunDeps.hs
@@ -292,7 +292,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!
@@ -300,7 +300,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