[Git][ghc/ghc][wip/sand-witch/lazy-skol] More
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Sun Jan 7 13:37:47 UTC 2024
Simon Peyton Jones pushed to branch wip/sand-witch/lazy-skol at Glasgow Haskell Compiler / GHC
Commits:
5b48e79c by Simon Peyton Jones at 2024-01-07T13:35:13+00:00
More
- - - - -
12 changed files:
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/BasicTypes.hs
- compiler/GHC/Tc/Utils/Unify.hs
- testsuite/tests/typecheck/should_fail/FD1.stderr
- testsuite/tests/typecheck/should_fail/T10709b.stderr
- testsuite/tests/typecheck/should_fail/T12947.stderr
- testsuite/tests/typecheck/should_fail/tcfail175.stderr
Changes:
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -1040,7 +1040,7 @@ data TcRnMessage where
Test cases: typecheck/should_compile/T11339
-}
- TcRnOverloadedSig :: TcIdSigInfo -> TcRnMessage
+ TcRnOverloadedSig :: TcIdSig -> TcRnMessage
{-| TcRnTupleConstraintInst is an error that occurs whenever an instance
for a tuple constraint is specified.
=====================================
compiler/GHC/Tc/Gen/Bind.hs
=====================================
@@ -824,7 +824,6 @@ checkMonomorphismRestriction mbis lbinds
no_mr_name (MBI { mbi_sig = Just sig })
| TISI { sig_inst_sig = info, sig_inst_theta = theta, sig_inst_wcx = wcx } <- sig
= case info of
- TcPatSynSig {} -> Nothing -- Never happens
TcCompleteSig (CSig { sig_bndr = bndr }) -> Just (idName bndr)
TcPartialSig (PSig { psig_name = nm })
| null theta, isNothing wcx -> Nothing -- f :: _ -> _
@@ -1541,7 +1540,7 @@ tcLhs :: TcSigFun -> LetBndrSpec -> HsBind GhcRn -> TcM TcMonoBind
tcLhs sig_fn no_gen (FunBind { fun_id = L nm_loc name
, fun_matches = matches })
- | Just sig <- sig_fn name
+ | Just (TcIdSig sig) <- sig_fn name
= -- There is a type signature.
-- It must be partial; if complete we'd be in tcPolyCheck!
-- e.g. f :: _ -> _
@@ -1591,10 +1590,10 @@ tcLhs sig_fn no_gen (PatBind { pat_lhs = pat, pat_rhs = grhss, pat_mult = mult_a
bndr_names = collectPatBinders CollNoDictBinders pat
(nosig_names, sig_names) = partitionWith find_sig bndr_names
- find_sig :: Name -> Either Name (Name, TcIdSigInfo)
+ find_sig :: Name -> Either Name (Name, TcIdSig)
find_sig name = case sig_fn name of
- Just sig -> Right (name, sig)
- _ -> Left name
+ Just (TcIdSig sig) -> Right (name, sig)
+ _ -> Left name
tcLhs _ _ b@(PatSynBind {}) = pprPanic "tcLhs: PatSynBind" (ppr b)
-- pattern synonyms are handled separately; see tc_single
@@ -1613,7 +1612,7 @@ lookupMBI name
, mbi_mono_mult = idMult mono_id }) }
-------------------
-tcLhsSigId :: LetBndrSpec -> (Name, TcIdSigInfo) -> TcM MonoBindInfo
+tcLhsSigId :: LetBndrSpec -> (Name, TcIdSig) -> TcM MonoBindInfo
tcLhsSigId no_gen (name, sig)
= do { inst_sig <- tcInstSig sig
; mono_id <- newSigLetBndr no_gen name inst_sig
@@ -1878,7 +1877,7 @@ decideGeneralisationPlan dflags top_lvl closed sig_fn lbinds
-- except a single function binding with a complete signature
one_funbind_with_sig
| [lbind@(L _ (FunBind { fun_id = v }))] <- lbinds
- , Just (TcCompleteSig sig) <- sig_fn (unLoc v)
+ , Just (TcIdSig (TcCompleteSig sig)) <- sig_fn (unLoc v)
= Just (lbind, sig)
| otherwise
= Nothing
@@ -1886,8 +1885,8 @@ decideGeneralisationPlan dflags top_lvl closed sig_fn lbinds
binders = collectHsBindListBinders CollNoDictBinders lbinds
has_partial_sigs = any has_partial_sig binders
has_partial_sig nm = case sig_fn nm of
- Just (TcPartialSig {}) -> True
- _ -> False
+ Just (TcIdSig (TcPartialSig {})) -> True
+ _ -> False
has_mult_anns_and_pats = any has_mult_ann_and_pat lbinds
has_mult_ann_and_pat (L _ (PatBind{pat_mult=HsNoMultAnn{}})) = False
has_mult_ann_and_pat (L _ (PatBind{pat_lhs=(L _ (VarPat{}))})) = False
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -113,12 +113,13 @@ tcCheckPolyExpr, tcCheckPolyExprNC
tcCheckPolyExpr expr res_ty = tcPolyLExpr expr (mkCheckExpType res_ty)
tcCheckPolyExprNC expr res_ty = tcPolyLExprNC expr (mkCheckExpType res_ty)
+-----------------
-- These versions take an ExpType
tcPolyLExpr, tcPolyLExprNC :: LHsExpr GhcRn -> ExpSigmaType
-> TcM (LHsExpr GhcTc)
tcPolyLExpr (L loc expr) res_ty
- = setSrcSpanA loc $ -- Set location /first/; see GHC.Tc.Utils.Monad
+ = setSrcSpanA loc $ -- Set location /first/; see GHC.Tc.Utils.Monad
addExprCtxt expr $ -- Note [Error contexts in generated code]
do { expr' <- tcPolyExpr expr res_ty
; return (L loc expr') }
@@ -128,14 +129,20 @@ tcPolyLExprNC (L loc expr) res_ty
do { expr' <- tcPolyExpr expr res_ty
; return (L loc expr') }
-
+-----------------
tcPolyExpr :: HsExpr GhcRn -> ExpSigmaType -> TcM (HsExpr GhcTc)
tcPolyExpr e (Infer inf) = tcExpr e (Infer inf)
tcPolyExpr e (Check ty) = tcPolyExprCheck e (Left ty)
+-----------------
tcPolyLExprSig :: LHsExpr GhcRn -> TcCompleteSig -> TcM (LHsExpr GhcTc)
tcPolyLExprSig (L loc expr) sig
- = setSrcSpanA loc $ addExprCtxt expr $
+ = setSrcSpanA loc $
+ -- No addExprCtxt. For (e :: ty) we don't want generate
+ -- In the expression e
+ -- In the expression e :: ty
+ -- We have already got an error-context for (e::ty), so when we
+ -- get to `e`, just add the location
do { expr' <- tcPolyExprCheck expr (Right sig)
; return (L loc expr') }
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -978,8 +978,7 @@ tcExprWithSig expr hs_ty
where
loc = getLocA (dropWildCards hs_ty)
-tcExprSig :: LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcSigmaType)
-tcExprSig _ (TcPatSynSig sig) = pprPanic "tcExprSig" (ppr sig)
+tcExprSig :: LHsExpr GhcRn -> TcIdSig -> TcM (LHsExpr GhcTc, TcSigmaType)
tcExprSig expr (TcCompleteSig sig)
= do { expr' <- tcPolyLExprSig expr sig
; return (expr', idType (sig_bndr sig)) }
=====================================
compiler/GHC/Tc/Gen/Sig.hs
=====================================
@@ -8,7 +8,7 @@
{-# LANGUAGE TypeFamilies #-}
module GHC.Tc.Gen.Sig(
- TcSigInfo(..), TcIdSigInfo, TcSigFun,
+ TcSigInfo(..), TcIdSig(..), TcSigFun,
isPartialSig, hasCompleteSig, tcSigInfoName, tcSigInfoLoc,
completeSigPolyId_maybe, isCompleteHsSig,
@@ -171,21 +171,24 @@ tcTySig (L _ (XSig (IdSig id)))
-- NoRRC: do not report redundant constraints
-- The user has no control over the signature!
sig = completeSigFromId ctxt id
- ; return [TcCompleteSig sig] }
+ ; return [TcIdSig (TcCompleteSig sig)] }
tcTySig (L loc (TypeSig _ names sig_ty))
= setSrcSpanA loc $
- sequence [ tcUserTypeSig (locA loc) sig_ty (Just name) | L _ name <- names ]
+ do { sigs <- sequence [ tcUserTypeSig (locA loc) sig_ty (Just name)
+ | L _ name <- names ]
+ ; return (map TcIdSig sigs) }
tcTySig (L loc (PatSynSig _ names sig_ty))
= setSrcSpanA loc $
- sequence [ tcPatSynSig name sig_ty | L _ name <- names ]
+ do { tpsigs <- sequence [ tcPatSynSig name sig_ty
+ | L _ name <- names ]
+ ; return (map TcPatSynSig tpsigs) }
tcTySig _ = return []
-tcUserTypeSig :: SrcSpan -> LHsSigWcType GhcRn -> Maybe Name
- -> TcM TcIdSigInfo -- Never returns PatSynSig
+tcUserTypeSig :: SrcSpan -> LHsSigWcType GhcRn -> Maybe Name -> TcM TcIdSig
-- A function or expression type signature
-- Returns a fully quantified type signature; even the wildcards
-- are quantified with ordinary skolems that should be instantiated
@@ -372,7 +375,7 @@ later. Pattern synonyms are top-level, so there's no problem with
completely solving them.
-}
-tcPatSynSig :: Name -> LHsSigType GhcRn -> TcM TcSigInfo
+tcPatSynSig :: Name -> LHsSigType GhcRn -> TcM TcPatSynSig
-- See Note [Pattern synonym signatures]
-- See Note [Recipe for checking a signature] in GHC.Tc.Gen.HsType
tcPatSynSig name sig_ty@(L _ (HsSig{sig_bndrs = hs_outer_bndrs, sig_body = hs_ty}))
@@ -447,7 +450,7 @@ tcPatSynSig name sig_ty@(L _ (HsSig{sig_bndrs = hs_outer_bndrs, sig_body = hs_ty
, text "ex_tvs" <+> ppr_tvs (binderVars ex_bndrs)
, text "prov" <+> ppr prov
, text "body_ty" <+> ppr body_ty ]
- ; return $ TcPatSynSig $
+ ; return $
PatSig { patsig_name = name
, patsig_implicit_bndrs = kv_bndrs ++ implicit_bndrs
, patsig_univ_bndrs = univ_bndrs
@@ -486,7 +489,7 @@ ppr_tvs tvs = braces (vcat [ ppr tv <+> dcolon <+> ppr (tyVarKind tv)
********************************************************************* -}
-tcInstSig :: TcIdSigInfo -> TcM TcIdSigInst
+tcInstSig :: TcIdSig -> TcM TcIdSigInst
-- Instantiate a type signature; only used with plan InferGen
tcInstSig hs_sig@(TcCompleteSig (CSig { sig_bndr = poly_id, sig_loc = loc }))
= setSrcSpan loc $ -- Set the binding site of the tyvars
@@ -517,9 +520,6 @@ tcInstSig hs_sig@(TcPartialSig (PSig { psig_hs_ty = hs_ty
; traceTc "End partial sig }" (ppr inst_sig)
; return inst_sig }
-tcInstSig hs_sig@(TcPatSynSig {})
- = pprPanic "tcInstSig" (ppr hs_sig)
-
{- Note [Pattern bindings and complete signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -68,7 +68,7 @@ module GHC.Tc.Types(
-- TcSigInfo
TcSigFun,
- TcSigInfo(..), TcIdSigInfo,
+ TcSigInfo(..), TcIdSig(..),
TcCompleteSig(..), TcPartialSig(..), TcPatSynSig(..),
TcIdSigInst(..),
isPartialSig, hasCompleteSig, tcSigInfoName, tcSigInfoLoc,
=====================================
compiler/GHC/Tc/Types/BasicTypes.hs
=====================================
@@ -5,10 +5,8 @@ module GHC.Tc.Types.BasicTypes (
, TcBinder(..)
-- * Signatures
- , TcSigFun, TcSigInfo(..), TcIdSigInfo
- , TcCompleteSig(..)
- , TcPartialSig(..)
- , TcPatSynSig(..)
+ , TcSigFun, TcSigInfo(..), TcIdSig(..)
+ , TcCompleteSig(..), TcPartialSig(..), TcPatSynSig(..)
, TcIdSigInst(..)
, isPartialSig, hasCompleteSig
, tcSigInfoName, tcSigInfoLoc, completeSigPolyId_maybe
@@ -46,7 +44,6 @@ import GHC.Tc.Errors.Types.PromotionErr (PromotionErr, peCategory)
import GHC.Core.TyCon ( TyCon, tyConKind )
import GHC.Utils.Outputable
import GHC.Utils.Misc
-import GHC.Utils.Panic
---------------------------
@@ -102,12 +99,14 @@ instance HasOccName TcBinder where
type TcSigFun = Name -> Maybe TcSigInfo
--- See Note [Complete and partial type signatures]
-data TcSigInfo = TcCompleteSig TcCompleteSig -- For an Id
- | TcPartialSig TcPartialSig -- For an Id
- | TcPatSynSig TcPatSynSig -- For a pattern synonym
+-- TcSigInfo is simply the domain of TcSigFun
+data TcSigInfo = TcPatSynSig TcPatSynSig -- For a pattern synonym
+ | TcIdSig TcIdSig
-type TcIdSigInfo = TcSigInfo -- Always TcIdCompleteSig or TcIdPartialSig
+-- See Note [Complete and partial type signatures]
+data TcIdSig -- For an Id
+ = TcCompleteSig TcCompleteSig
+ | TcPartialSig TcPartialSig
data TcCompleteSig -- A complete signature with no wildcards,
-- so the complete polymorphic type is known.
@@ -162,7 +161,7 @@ sig_extra_cts is Nothing.
-}
data TcIdSigInst
- = TISI { sig_inst_sig :: TcIdSigInfo
+ = TISI { sig_inst_sig :: TcIdSig
, sig_inst_skols :: [(Name, InvisTVBinder)]
-- Instantiated type and kind variables, TyVarTvs
@@ -248,9 +247,12 @@ Here we get
-}
instance Outputable TcSigInfo where
+ ppr (TcIdSig sig) = ppr sig
+ ppr (TcPatSynSig sig) = ppr sig
+
+instance Outputable TcIdSig where
ppr (TcCompleteSig sig) = ppr sig
ppr (TcPartialSig sig) = ppr sig
- ppr (TcPatSynSig sig) = ppr sig
instance Outputable TcCompleteSig where
ppr (CSig { sig_bndr = bndr })
@@ -276,23 +278,22 @@ isPartialSig _ = False
hasCompleteSig :: TcSigFun -> Name -> Bool
hasCompleteSig sig_fn name
= case sig_fn name of
- Just (TcCompleteSig {}) -> True
- _ -> False
+ Just (TcIdSig (TcCompleteSig {})) -> True
+ _ -> False
tcSigInfoName :: TcSigInfo -> Name
-tcSigInfoName (TcCompleteSig sig) = idName (sig_bndr sig)
-tcSigInfoName (TcPartialSig sig) = psig_name sig
-tcSigInfoName (TcPatSynSig sig) = patsig_name sig
+tcSigInfoName (TcIdSig (TcCompleteSig sig)) = idName (sig_bndr sig)
+tcSigInfoName (TcIdSig (TcPartialSig sig)) = psig_name sig
+tcSigInfoName (TcPatSynSig sig) = patsig_name sig
-tcSigInfoLoc :: TcIdSigInfo -> SrcSpan
+tcSigInfoLoc :: TcIdSig -> SrcSpan
-- Only works for Id signatures, not PatSyn sigs
tcSigInfoLoc (TcCompleteSig sig) = sig_loc sig
tcSigInfoLoc (TcPartialSig sig) = psig_loc sig
-tcSigInfoLoc (TcPatSynSig sig) = pprPanic "tcSigInfoLoc" (ppr sig)
completeSigPolyId_maybe :: TcSigInfo -> Maybe TcId
-completeSigPolyId_maybe (TcCompleteSig sig) = Just (sig_bndr sig)
-completeSigPolyId_maybe _ = Nothing
+completeSigPolyId_maybe (TcIdSig (TcCompleteSig sig)) = Just (sig_bndr sig)
+completeSigPolyId_maybe _ = Nothing
{- *********************************************************************
* *
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -1471,8 +1471,13 @@ tcDeepSplitSigmaTyBndr_maybe = tcDeepSplit_maybe tcSplitSigmaTyBndrs
* *
********************************************************************* -}
-{- Note [Skolemisation]
-~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Skolemisation overview]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose f :: (forall a. a->a) -> blah, and we have the application (f e)
+Then we want to typecheck `e` pushing in the type `forall a. a->a`. So
+in general,
+* In (tcPolyExpr e poly_ty), we
+
tcTopSkolemise takes "expected type" and strip off quantifiers to expose the
type underneath, binding the new skolems for the 'thing_inside'
The returned 'HsWrapper' has type (specific_ty -> expected_ty).
=====================================
testsuite/tests/typecheck/should_fail/FD1.stderr
=====================================
@@ -7,4 +7,3 @@ FD1.hs:16:1: error: [GHC-25897]
at FD1.hs:15:1-38
• The equation for ‘plus’ has two value arguments,
but its type ‘Int -> a’ has only one
- • Relevant bindings include plus :: Int -> a (bound at FD1.hs:16:1)
=====================================
testsuite/tests/typecheck/should_fail/T10709b.stderr
=====================================
@@ -1,9 +1,9 @@
T10709b.hs:6:22: error: [GHC-91028]
- • Couldn't match type ‘p1’ with ‘forall a. IO a -> IO a’
- Expected: (p1 -> IO ()) -> IO ()
+ • Couldn't match type ‘t2’ with ‘forall a. IO a -> IO a’
+ Expected: (t2 -> IO ()) -> IO ()
Actual: ((forall a. IO a -> IO a) -> IO ()) -> IO ()
- Cannot instantiate unification variable ‘p1’
+ Cannot instantiate unification variable ‘t2’
with a type involving polytypes: forall a. IO a -> IO a
• In the second argument of ‘(.)’, namely ‘mask’
In the expression: (replicateM 2 . mask) (\ _ -> return ())
@@ -11,10 +11,10 @@ T10709b.hs:6:22: error: [GHC-91028]
x4 = (replicateM 2 . mask) (\ _ -> return ())
T10709b.hs:7:22: error: [GHC-91028]
- • Couldn't match type ‘t0’ with ‘forall a1. IO a1 -> IO a1’
- Expected: (t0 -> IO a) -> IO a
+ • Couldn't match type ‘t1’ with ‘forall a1. IO a1 -> IO a1’
+ Expected: (t1 -> IO a) -> IO a
Actual: ((forall a1. IO a1 -> IO a1) -> IO a) -> IO a
- Cannot instantiate unification variable ‘t0’
+ Cannot instantiate unification variable ‘t1’
with a type involving polytypes: forall a1. IO a1 -> IO a1
• In the second argument of ‘(.)’, namely ‘mask’
In the expression: (replicateM 2 . mask) (\ x -> undefined x)
@@ -22,10 +22,10 @@ T10709b.hs:7:22: error: [GHC-91028]
x5 = (replicateM 2 . mask) (\ x -> undefined x)
T10709b.hs:8:22: error: [GHC-91028]
- • Couldn't match type ‘p0’ with ‘forall a1. IO a1 -> IO a1’
- Expected: (p0 -> IO a) -> IO a
+ • Couldn't match type ‘t0’ with ‘forall a1. IO a1 -> IO a1’
+ Expected: (t0 -> IO a) -> IO a
Actual: ((forall a1. IO a1 -> IO a1) -> IO a) -> IO a
- Cannot instantiate unification variable ‘p0’
+ Cannot instantiate unification variable ‘t0’
with a type involving polytypes: forall a1. IO a1 -> IO a1
• In the second argument of ‘(.)’, namely ‘mask’
In the expression: (replicateM 2 . mask) (id (\ _ -> undefined))
=====================================
testsuite/tests/typecheck/should_fail/T12947.stderr
=====================================
@@ -1,3 +1,3 @@
T12947.hs:15:14: error: [GHC-88464]
- Data constructor not in scope: ContT :: (p0 -> m0 a0) -> P m a
+ Data constructor not in scope: ContT :: (t0 -> m0 a0) -> P m a
=====================================
testsuite/tests/typecheck/should_fail/tcfail175.stderr
=====================================
@@ -8,5 +8,3 @@ tcfail175.hs:11:1: error: [GHC-25897]
at tcfail175.hs:10:1-19
• The equation for ‘evalRHS’ has three value arguments,
but its type ‘Int -> a’ has only one
- • Relevant bindings include
- evalRHS :: Int -> a (bound at tcfail175.hs:11:1)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b48e79c91724b01207f5fad21c481e653eb481f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b48e79c91724b01207f5fad21c481e653eb481f
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240107/06017c03/attachment-0001.html>
More information about the ghc-commits
mailing list