Commit 120cc9f8 authored by Vladislav Zavialov's avatar Vladislav Zavialov Committed by Ben Gamari

Fix #15415 and simplify tcWildCardBinders

Test Plan: Validate

Reviewers: goldfire, simonpj, bgamari

Reviewed By: simonpj

Subscribers: RyanGlScott, rwbarton, thomie, carter

GHC Trac Issues: #15415

Differential Revision: https://phabricator.haskell.org/D5022
parent 7f3cb50d
......@@ -343,7 +343,7 @@ tcHsTypeApp wc_ty kind
= do { ty <- solveLocalEqualities $
-- We are looking at a user-written type, very like a
-- signature so we want to solve its equalities right now
tcWildCardBindersX newWildTyVar Nothing sig_wcs $ \ _ ->
tcWildCardBinders sig_wcs $ \ _ ->
tcCheckLHsType hs_ty kind
; ty <- zonkPromoteType ty
; checkValidType TypeAppCtxt ty
......@@ -1515,30 +1515,14 @@ in TcType.
-}
tcWildCardBinders :: SkolemInfo
-> [Name]
tcWildCardBinders :: [Name]
-> ([(Name, TcTyVar)] -> TcM a)
-> TcM a
tcWildCardBinders info = tcWildCardBindersX new_tv (Just info)
where
new_tv name = do { kind <- newMetaKindVar
; newSkolemTyVar name kind }
tcWildCardBindersX :: (Name -> TcM TcTyVar)
-> Maybe SkolemInfo -- Just <=> we're bringing fresh vars
-- into scope; use scopeTyVars
-> [Name]
-> ([(Name, TcTyVar)] -> TcM a)
-> TcM a
tcWildCardBindersX new_wc maybe_skol_info wc_names thing_inside
= do { wcs <- mapM new_wc wc_names
tcWildCardBinders wc_names thing_inside
= do { wcs <- mapM newWildTyVar wc_names
; let wc_prs = wc_names `zip` wcs
; scope_tvs wc_prs $
; tcExtendNameTyVarEnv wc_prs $
thing_inside wc_prs }
where
scope_tvs
| Just info <- maybe_skol_info = scopeTyVars2 info
| otherwise = tcExtendNameTyVarEnv
-- | Kind-check a 'LHsQTyVars'. If the decl under consideration has a complete,
-- user-supplied kind signature (CUSK), generalise the result.
......@@ -2289,7 +2273,7 @@ tcHsPartialSigType ctxt sig_ty
, (explicit_hs_tvs, L _ hs_ctxt, hs_tau) <- splitLHsSigmaTy hs_ty
= addSigCtxt ctxt hs_ty $
do { (implicit_tvs, (explicit_tvs, (wcs, wcx, theta, tau)))
<- tcWildCardBindersX newWildTyVar Nothing sig_wcs $ \ wcs ->
<- tcWildCardBinders sig_wcs $ \ wcs ->
tcImplicitTKBndrsSig skol_info implicit_hs_tvs $
tcExplicitTKBndrs skol_info explicit_hs_tvs $
do { -- Instantiate the type-class context; but if there
......@@ -2357,7 +2341,7 @@ Consider
the hswc_wcs field.
* Then, in tcHsPartialSigType, we make a new hole TcTyVar, in
tcWildCardBindersX.
tcWildCardBinders.
* TcBinds.chooseInferredQuantifiers fills in that hole TcTyVar
with the inferred constraints, e.g. (Eq a, Show a)
......@@ -2413,7 +2397,7 @@ tcHsPatSigType ctxt sig_ty
= addSigCtxt ctxt hs_ty $
do { sig_tkvs <- mapM new_implicit_tv sig_vars
; (wcs, sig_ty)
<- tcWildCardBindersX newWildTyVar Nothing sig_wcs $ \ wcs ->
<- tcWildCardBinders sig_wcs $ \ wcs ->
tcExtendTyVarEnv sig_tkvs $
do { sig_ty <- tcHsOpenType hs_ty
; return (wcs, sig_ty) }
......
......@@ -2368,9 +2368,12 @@ tcRnType hsc_env normalise rdr_type
-- It can have any rank or kind
-- First bring into scope any wildcards
; traceTc "tcRnType" (vcat [ppr wcs, ppr rn_type])
; (ty, kind) <- solveEqualities $
tcWildCardBinders (SigTypeSkol GhciCtxt) wcs $ \ _ ->
tcLHsTypeUnsaturated rn_type
; ((ty, kind), lie) <-
captureConstraints $
tcWildCardBinders wcs $ \ wcs' ->
do { emitWildCardHoleConstraints wcs'
; tcLHsTypeUnsaturated rn_type }
; _ <- checkNoErrs (simplifyInteractive lie)
-- Do kind generalisation; see Note [Kind-generalise in tcRnType]
; kind <- zonkTcType kind
......
:set -XPartialTypeSignatures -fno-warn-partial-type-signatures
:kind _
:kind Maybe _
import Data.Proxy
:set -XPolyKinds
data Dependent a (x :: a)
:k Proxy _
:k Proxy (Maybe :: _)
:k Dependent _
:set -XPartialTypeSignatures
:k Proxy _
:k Proxy (Maybe :: _)
:k Dependent _
:set -fno-warn-partial-type-signatures
:k Proxy _
:k Proxy (Maybe :: _)
:k Dependent _
<interactive>:1:7: error:
Found type wildcard ‘_’ standing for ‘w0 :: k0’
Where: ‘w0’ is an ambiguous type variable
‘k0’ is an ambiguous type variable
To use the inferred type, enable PartialTypeSignatures
<interactive>:1:17: error:
Found type wildcard ‘_’ standing for ‘* -> *’
To use the inferred type, enable PartialTypeSignatures
<interactive>:1:11: error:
Found type wildcard ‘_’ standing for ‘w0’
Where: ‘w0’ is an ambiguous type variable
To use the inferred type, enable PartialTypeSignatures
<interactive>:1:7: warning: [-Wpartial-type-signatures (in -Wdefault)]
Found type wildcard ‘_’ standing for ‘w0 :: k0’
Where: ‘w0’ is an ambiguous type variable
‘k0’ is an ambiguous type variable
<interactive>:1:17: warning: [-Wpartial-type-signatures (in -Wdefault)]
Found type wildcard ‘_’ standing for ‘* -> *’
<interactive>:1:11: warning: [-Wpartial-type-signatures (in -Wdefault)]
Found type wildcard ‘_’ standing for ‘w0’
Where: ‘w0’ is an ambiguous type variable
Proxy _ :: *
Proxy (Maybe :: _) :: *
Dependent _ :: w -> *
Proxy _ :: *
Proxy (Maybe :: _) :: *
Dependent _ :: w -> *
test('GHCiWildcardKind', normal, ghci_script, ['GHCiWildcardKind.script'])
test('T15415', normal, ghci_script, ['T15415.script'])
:set -XUnboxedSums
:set -XUnboxedSums -XPartialTypeSignatures -fno-warn-partial-type-signatures
:kind (# _ | _ #)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment