Stage 2 succeeds
authorRichard Eisenberg <eir@cis.upenn.edu>
Thu, 9 Jul 2015 17:40:56 +0000 (13:40 -0400)
committerRichard Eisenberg <eir@cis.upenn.edu>
Thu, 9 Jul 2015 17:40:56 +0000 (13:40 -0400)
compiler/typecheck/TcExpr.hs
compiler/typecheck/TcMType.hs
compiler/typecheck/TcMatches.hs
compiler/typecheck/TcRnDriver.hs
compiler/typecheck/TcSplice.hs
compiler/typecheck/TcType.hs
compiler/typecheck/TcUnify.hs

index 3f2cd2f..dd65965 100644 (file)
@@ -456,7 +456,7 @@ tcExpr (HsIf Nothing pred b1 b2) res_ty    -- Ordinary 'if'
   = do { pred' <- tcMonoExpr pred boolTy
             -- this forces the branches to be fully instantiated
             -- (See #10619)
-       ; tau_ty <- newFlexiMonoTyVarTy openTypeKind
+       ; tau_ty <- newFlexiTyVarTy openTypeKind
        ; wrap   <- tcSubTypeHR tau_ty res_ty
        ; tau_ty <- zonkTcType tau_ty
        ; b1' <- tcMonoExpr b1 tau_ty
index 01a3b5b..48d3312 100644 (file)
@@ -67,6 +67,7 @@ module TcMType (
 import TypeRep
 import TcType
 import Type
+import Kind   ( isOpenTypeKind )
 import Class
 import Var
 import VarEnv
@@ -452,7 +453,7 @@ tcInstTyVarX subst tyvar
         ; let info | isOpenTypeKind (tyVarKind tyvar) = ReturnTv
                          -- See Note [OpenTypeKind accepts foralls]
                    | otherwise                        = TauTv VanillaTau
-        ; details <- newMetaDetails (TauTv VanillaTau)
+        ; details <- newMetaDetails info
         ; let name   = mkSystemName uniq (getOccName tyvar)
                        -- See Note [Name of an instantiated type variable]
               kind   = substTy subst (tyVarKind tyvar)
index b744af7..a5410a9 100644 (file)
@@ -190,7 +190,8 @@ tcMatches ctxt pat_tys rhs_ty group@(MG { mg_alts = matches, mg_origin = origin
              if isSingletonMatchGroup group
                   -- no need to monomorphise the RHS if there's only one
              then return (idHsWrapper, rhs_ty)
-             else do { tau_ty <- newFlexiMonoTyVarTy openTypeKind
+                  -- TODO (RAE): Document this behavior.
+             else do { tau_ty <- newFlexiTyVarTy openTypeKind
                      ; wrap   <- tcSubTypeDS GenSigCtxt tau_ty rhs_ty
                      ; tau_ty <- zonkTcType tau_ty
                          -- seems more efficient to zonk just once
index b01d0a2..0e3ee2d 100644 (file)
@@ -39,7 +39,6 @@ import TidyPgm    ( globaliseAndTidyId )
 import TysWiredIn ( unitTy, mkListTy )
 import DynamicLoading ( loadPlugins )
 import Plugins ( tcPlugin )
-import Inst   ( topInstantiate )
 #endif
 
 import DynFlags
index 040bab9..831fe31 100644 (file)
@@ -65,6 +65,7 @@ import TypeRep
 import FamInst
 import FamInstEnv
 import InstEnv
+import Inst
 import NameEnv
 import PrelNames
 import OccName
index 87613ec..136295b 100644 (file)
@@ -1243,7 +1243,7 @@ occurCheckExpand dflags tv ty
   where
     details = ASSERT2( isTcTyVar tv, ppr tv ) tcTyVarDetails tv
 
-    impredicative = canUnifyWithPolyType dflags details (tyVarKind tv)
+    impredicative = canUnifyWithPolyType dflags details
 
     -- Check 'ty' is a tyvar, or can be expanded into one
     go_sig_tv ty@(TyVarTy {})            = OC_OK ty
@@ -1296,8 +1296,8 @@ occurCheckExpand dflags tv ty
               | otherwise             -> bad
                       -- Failing that, try to expand a synonym
 
-canUnifyWithPolyType :: DynFlags -> TcTyVarDetails -> TcKind -> Bool
-canUnifyWithPolyType dflags details kind
+canUnifyWithPolyType :: DynFlags -> TcTyVarDetails -> Bool
+canUnifyWithPolyType dflags details
   = case details of
       MetaTv { mtv_info = ReturnTv } -> True   -- See Note [ReturnTv]
       MetaTv { mtv_info = SigTv }    -> False
index 519bd43..e4a2456 100644 (file)
@@ -677,7 +677,7 @@ tc_sub_type_ds origin ctxt ty_actual ty_expected = go ty_actual ty_expected
                         (ppr tv_e <+> text "-->" <+> ppr ty_e')
                     ; tc_sub_type origin ctxt ty_a ty_e' }
                Unfilled details
-                 |  canUnifyWithPolyType dflags details (tyVarKind tv_e)
+                 |  canUnifyWithPolyType dflags details
                     && isTouchableMetaTyVar tclvl tv_e  -- don't want skolems here
                  -> coToHsWrapper <$> uType origin ty_a ty_e
 
@@ -1205,9 +1205,11 @@ uUnfilledVars origin swapped tv1 details1 tv2 details2
     ty2 = mkTyVarTy tv2
 
 nicer_to_update_tv1 :: TcTyVar -> MetaInfo -> MetaInfo -> Bool
-nicer_to_update_tv1 _   _                     SigTv                 = True
-nicer_to_update_tv1 _   SigTv                 _                     = False
-nicer_to_update_tv1 tv1 _                     _ = isSystemName (Var.varName tv1)
+nicer_to_update_tv1 _   ReturnTv _        = True
+nicer_to_update_tv1 _   _        ReturnTv = False
+nicer_to_update_tv1 _   _        SigTv    = True
+nicer_to_update_tv1 _   SigTv    _        = False
+nicer_to_update_tv1 tv1 _        _        = isSystemName (Var.varName tv1)
         -- Try not to update SigTvs or AlwaysMonoTaus; and try to update sys-y type
         -- variables in preference to ones gotten (say) by
         -- instantiating a polymorphic function with a user-written
@@ -1265,7 +1267,7 @@ checkTauTvUpdate dflags tv ty
     details = ASSERT2( isMetaTyVar tv, ppr tv ) tcTyVarDetails tv
     info         = mtv_info details
     is_return_tv = isReturnTyVar tv
-    impredicative = canUnifyWithPolyType dflags details (tyVarKind tv)
+    impredicative = canUnifyWithPolyType dflags details
 
     defer_me :: TcType -> Bool
     -- Checks for (a) occurrence of tv