[commit: ghc] wip/type-app: Stage 2 succeeds (ebac2cb)
git at git.haskell.org
git at git.haskell.org
Fri Aug 7 12:05:04 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/type-app
Link : http://ghc.haskell.org/trac/ghc/changeset/ebac2cb34ea21c95a141fbdfc39b211033c61604/ghc
>---------------------------------------------------------------
commit ebac2cb34ea21c95a141fbdfc39b211033c61604
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date: Thu Jul 9 13:40:56 2015 -0400
Stage 2 succeeds
>---------------------------------------------------------------
ebac2cb34ea21c95a141fbdfc39b211033c61604
compiler/typecheck/TcExpr.hs | 2 +-
compiler/typecheck/TcMType.hs | 3 ++-
compiler/typecheck/TcMatches.hs | 3 ++-
compiler/typecheck/TcRnDriver.hs | 1 -
compiler/typecheck/TcSplice.hs | 1 +
compiler/typecheck/TcType.hs | 6 +++---
compiler/typecheck/TcUnify.hs | 12 +++++++-----
7 files changed, 16 insertions(+), 12 deletions(-)
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 3f2cd2f..dd65965 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -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
diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index 01a3b5b..48d3312 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -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)
diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs
index b744af7..a5410a9 100644
--- a/compiler/typecheck/TcMatches.hs
+++ b/compiler/typecheck/TcMatches.hs
@@ -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
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index b01d0a2..0e3ee2d 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -39,7 +39,6 @@ import TidyPgm ( globaliseAndTidyId )
import TysWiredIn ( unitTy, mkListTy )
import DynamicLoading ( loadPlugins )
import Plugins ( tcPlugin )
-import Inst ( topInstantiate )
#endif
import DynFlags
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index 040bab9..831fe31 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -65,6 +65,7 @@ import TypeRep
import FamInst
import FamInstEnv
import InstEnv
+import Inst
import NameEnv
import PrelNames
import OccName
diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index 87613ec..136295b 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -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
diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs
index 519bd43..e4a2456 100644
--- a/compiler/typecheck/TcUnify.hs
+++ b/compiler/typecheck/TcUnify.hs
@@ -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
More information about the ghc-commits
mailing list