[Git][ghc/ghc][wip/soulomoon/25647-allow-newtype-instance-in-gadt-syntax] 15 commits: hackage-doc-tarball: Allow ghc-boot-th to be uploaded to hackage
Patrick (@soulomoon)
gitlab at gitlab.haskell.org
Mon Feb 3 09:21:18 UTC 2025
Patrick pushed to branch wip/soulomoon/25647-allow-newtype-instance-in-gadt-syntax at Glasgow Haskell Compiler / GHC
Commits:
7bfc93a7 by Zubin Duggal at 2025-01-29T21:41:17-05:00
hackage-doc-tarball: Allow ghc-boot-th to be uploaded to hackage
It can't refer to files outside its source directory, so patch that part out.
This is OK because those files are only used while bootstrapping.
Also add ghci to the list of packages to be uploaded
Fixes #25687
- - - - -
704eeb02 by Roman S at 2025-01-29T21:42:05-05:00
Fix Control.Arrow (***) diagram (fixes #25698)
- - - - -
a68cbb60 by Patrick at 2025-02-03T09:21:12+00:00
update kcConDecl to also consider the result type
in newtype GADT instance
- - - - -
3ee2f304 by Patrick at 2025-02-03T09:21:12+00:00
peek at the result kind
- - - - -
c7f4518a by Patrick at 2025-02-03T09:21:12+00:00
test if gadt has UserSuppliedResultKind in lhs, we let tc_res_kind to unify with rhs result kind if not to gain more inference
- - - - -
a928958e by Patrick at 2025-02-03T09:21:12+00:00
format and remove getTyConResultKind
- - - - -
bd1ab0d8 by Patrick at 2025-02-03T09:21:12+00:00
format
- - - - -
265ed301 by Patrick at 2025-02-03T09:21:12+00:00
add comment
- - - - -
7ed2dfc2 by Patrick at 2025-02-03T09:21:12+00:00
cleanup
- - - - -
0ab6f659 by Patrick at 2025-02-03T09:21:12+00:00
cleanup
- - - - -
0f7588fe by Patrick at 2025-02-03T09:21:12+00:00
update T25611a
- - - - -
bb0a574c by Patrick at 2025-02-03T09:21:12+00:00
rename and add note
- - - - -
edbf2cef by Patrick at 2025-02-03T09:21:12+00:00
update note
- - - - -
04a684e9 by Patrick at 2025-02-03T09:21:12+00:00
update note
- - - - -
1e7a8743 by Patrick at 2025-02-03T09:21:12+00:00
format
- - - - -
5 changed files:
- .gitlab/rel_eng/upload_ghc_libs.py
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
- testsuite/tests/indexed-types/should_compile/T25611a.hs
Changes:
=====================================
.gitlab/rel_eng/upload_ghc_libs.py
=====================================
@@ -93,6 +93,11 @@ def prep_ghc():
build_copy_file(PACKAGES['ghc'], 'GHC/Platform/Constants.hs')
build_copy_file(PACKAGES['ghc'], 'GHC/Settings/Config.hs')
+def prep_ghc_boot_th():
+ # Drop ghc-internal from `hs-source-dirs` as Hackage rejects this
+ modify_file(PACKAGES['ghc-boot-th'], 'ghc-boot-th.cabal',
+ lambda s: s.replace('../ghc-internal/src', ''))
+
PACKAGES = {
pkg.name: pkg
for pkg in [
@@ -105,9 +110,10 @@ PACKAGES = {
Package('template-haskell', Path("libraries/template-haskell"), no_prep),
Package('ghc-heap', Path("libraries/ghc-heap"), no_prep),
Package('ghc-boot', Path("libraries/ghc-boot"), prep_ghc_boot),
- Package('ghc-boot-th', Path("libraries/ghc-boot-th"), no_prep),
+ Package('ghc-boot-th', Path("libraries/ghc-boot-th"), prep_ghc_boot_th),
Package('ghc-compact', Path("libraries/ghc-compact"), no_prep),
Package('ghc', Path("compiler"), prep_ghc),
+ Package('ghci', Path("libraries/ghci"), no_prep),
]
}
# Dict[str, Package]
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -12,8 +12,8 @@
-- | Typecheck type and class declarations
module GHC.Tc.TyCl (
+ HasHeaderKindSig(..),
tcTyAndClassDecls,
-
-- Functions used by GHC.Tc.TyCl.Instance to check
-- data/type family instance declarations
kcConDecls, tcConDecls, DataDeclInfo(..),
@@ -1763,7 +1763,7 @@ kcTyClDecl :: TyClDecl GhcRn -> MonoTcTyCon -> TcM ()
-- kind inference (see GHC.Tc.TyCl Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon])
kcTyClDecl (DataDecl { tcdLName = (L _ _name)
- , tcdDataDefn = HsDataDefn { dd_ctxt = ctxt, dd_cons = cons } })
+ , tcdDataDefn = HsDataDefn { dd_ctxt = ctxt, dd_cons = cons, dd_kindSig = kindSig } })
tycon
= tcExtendNameTyVarEnv (tcTyConScopedTyVars tycon) $
-- NB: binding these tyvars isn't necessary for GADTs, but it does no
@@ -1772,7 +1772,9 @@ kcTyClDecl (DataDecl { tcdLName = (L _ _name)
-- (conceivably) shadowed.
do { traceTc "kcTyClDecl" (ppr tycon $$ ppr (tyConTyVars tycon) $$ ppr (tyConResKind tycon))
; _ <- tcHsContext ctxt
- ; kcConDecls (tyConResKind tycon) cons
+ ; kcConDecls (tyConResKind tycon) (if (isJust kindSig)
+ then HasHeaderKindSig
+ else NoHeaderKindSig) cons
}
kcTyClDecl (SynDecl { tcdLName = L _ _name, tcdRhs = rhs }) tycon
@@ -1832,12 +1834,25 @@ kcConGADTArgs exp_kind con_args = case con_args of
RecConGADT _ (L _ flds) -> kcConArgTys exp_kind $
map (hsLinear . cd_fld_type . unLoc) flds
+
+{- Note [Header kind signatures for GADTs]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Specifically for GADT style declarations.
+User supplied header kind signature as in
+`data xxx :: HasHeaderKindSig where ...`
+See (KCD4) in Note [kcConDecls: kind-checking data type decls]
+for why we need to check this.
+-}
+-- see Note [Header kind signatures for GADTs]
+data HasHeaderKindSig = HasHeaderKindSig | NoHeaderKindSig deriving Eq
+
kcConDecls :: TcKind -- Result kind of tycon
-- Used only in H98 case
+ -> HasHeaderKindSig
-> DataDefnCons (LConDecl GhcRn) -> TcM ()
-- See Note [kcConDecls: kind-checking data type decls]
-kcConDecls tc_res_kind cons
- = traverse_ (wrapLocMA_ (kcConDecl new_or_data tc_res_kind)) cons
+kcConDecls tc_res_kind usrk cons
+ = traverse_ (wrapLocMA_ (kcConDecl new_or_data usrk tc_res_kind)) cons
where
new_or_data = dataDefnConsNewOrData cons
@@ -1846,8 +1861,8 @@ kcConDecls tc_res_kind cons
-- declared with data or newtype, and we need to know the result kind of
-- this type. See Note [Implementation of UnliftedNewtypes] for why
-- we need the first two arguments.
-kcConDecl :: NewOrData -> TcKind -> ConDecl GhcRn -> TcM ()
-kcConDecl new_or_data tc_res_kind
+kcConDecl :: NewOrData -> HasHeaderKindSig -> TcKind -> ConDecl GhcRn -> TcM ()
+kcConDecl new_or_data _usrk tc_res_kind
(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
, con_mb_cxt = ex_ctxt, con_args = args })
= addErrCtxt (DataConDefCtxt (NE.singleton name)) $
@@ -1863,8 +1878,11 @@ kcConDecl new_or_data tc_res_kind
-- because that's done in tcConDecl
}
-kcConDecl new_or_data _tc_res_kind
- -- NB: _tc_res_kind is unused. See (KCD3) in
+kcConDecl new_or_data usrk tc_res_kind
+ -- tc_res_kind usage is a bit tricky here,
+ -- only newtype with no user header kind signature
+ -- uses it.
+ -- See (KCD3), (KCD4) in
-- Note [kcConDecls: kind-checking data type decls]
(ConDeclGADT { con_names = names, con_bndrs = L _ outer_bndrs
, con_mb_cxt = cxt, con_g_args = args, con_res_ty = res_ty })
@@ -1875,10 +1893,13 @@ kcConDecl new_or_data _tc_res_kind
bindOuterSigTKBndrs_Tv outer_bndrs $
-- Why "_Tv"? See Note [Using TyVarTvs for kind-checking GADTs]
do { _ <- tcHsContext cxt
- ; traceTc "kcConDecl:GADT {" (ppr names $$ ppr res_ty)
- ; con_res_kind <- newOpenTypeKind
- ; _ <- tcCheckLHsTypeInContext res_ty (TheKind con_res_kind)
-
+ ; traceTc "kcConDecl:GADT {" (ppr names $$ ppr res_ty $$ ppr tc_res_kind)
+ -- We handle the case of newtypes without user header kind signatures specially
+ -- see (KCD4) in Note [kcConDecls: kind-checking data type decls]
+ ; con_res_kind <- if NewType == new_or_data && NoHeaderKindSig == usrk
+ then return tc_res_kind
+ else newOpenTypeKind
+ ; _ <- tcCheckLHsTypeInContext res_ty $ (TheKind con_res_kind)
; let arg_exp_kind = getArgExpKind new_or_data con_res_kind
-- getArgExpKind: for newtypes, check that the argument kind
-- is the same the kind of `res_ty`, the data con's return type
@@ -1891,8 +1912,11 @@ kcConDecl new_or_data _tc_res_kind
{- Note [kcConDecls: kind-checking data type decls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
kcConDecls is used when we are inferring the kind of the type
-constructor in a data type declaration. The basic plan is described in
+constructor. For two cases:
+* Data type declarations, The basic plan is described in
Note [Inferring kinds for type declarations]; here we are doing Step 2.
+* Data family instance declaration, see the DESIGN CHOICE
+in Note [Kind inference for data family instances].
We are kind-checking the data constructors /only/ to compute the kind of
the type construtor. For example
@@ -1950,8 +1974,20 @@ Again there are two cases to consider in `kcConDecl`:
`S g a`) and, for newtypes, ensure that the arugment has that same kind.
(KCD3) The tycon's result kind `tc_res_kind` is not used at all in the GADT
- case; rather it is accessed via looking up S's kind in the type environment
- when kind-checking the result type of the data constructor.
+ case except being newtype without user header kind signature; rather it is
+ accessed via looking up S's kind in the type environment when kind-checking the
+ result type of the data constructor.
+
+ data family Fix2 :: (k -> Type) -> k
+ newtype instance Fix2 f where In2 :: f (Fix2 f) -> Fix2 f
+
+ * When kind checking the newtype instance, Fix2's kind in the type environment is
+ already generalized. If using -XUnliftedNewtypes, since the instance does not have
+ a user header kind signature, the result kind is defaulted to (TYPE r), where r is
+ a unification variable. r could not be constrained through the type environment.
+
+ Solution (KCD4): For newtype instances, we have to use the `tc_res_kind` in
+ contrast to (KCD3) to constrain r properly.
Note [Using TyVarTvs for kind-checking GADTs]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Tc/TyCl/Instance.hs
=====================================
@@ -946,7 +946,11 @@ tcDataFamInstHeader mb_clsinfo skol_info fam_tc hs_outer_bndrs fixity
-- Add constraints from the data constructors
-- Fix #25611
-- See DESIGN CHOICE in Note [Kind inference for data family instances]
- ; when is_H98_or_newtype $ kcConDecls lhs_applied_kind hs_cons
+ ; when is_H98_or_newtype $
+ kcConDecls lhs_applied_kind (if (isJust m_ksig)
+ then HasHeaderKindSig
+ else NoHeaderKindSig) hs_cons
+
-- Check that the result kind of the TyCon applied to its args
-- is compatible with the explicit signature (or Type, if there
=====================================
libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
=====================================
@@ -131,10 +131,10 @@ class Category a => Arrow a where
-- The default definition may be overridden with a more efficient
-- version if desired.
--
- -- > b ╭─────╮ b'
+ -- > b ╭─────╮ c
-- > >───┼─ f ─┼───>
-- > >───┼─ g ─┼───>
- -- > c ╰─────╯ c'
+ -- > b'╰─────╯ c'
(***) :: a b c -> a b' c' -> a (b,b') (c,c')
f *** g = first f >>> arr swap >>> first g >>> arr swap
where swap ~(x,y) = (y,x)
=====================================
testsuite/tests/indexed-types/should_compile/T25611a.hs
=====================================
@@ -12,6 +12,6 @@ data family Fix0 :: (k -> Type) -> k
newtype instance Fix0 f = In0 { out0 :: f (Fix0 f) }
-- This is the GADT newtype instance case
--- currently not enabled since !9116 (closed) impose `A newtype must not be a GADT`
--- data family Fix2 :: (k -> Type) -> k
--- newtype instance Fix2 f where In2 :: f (Fix2 f) -> Fix2 f
+-- enabled since !13809
+data family Fix2 :: (k -> Type) -> k
+newtype instance Fix2 f where In2 :: f (Fix2 f) -> Fix2 f
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/19560b50b390175bf6f9173f639ee08fcec29ef2...1e7a8743293a2424c9dd63181228132668d6ce16
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/19560b50b390175bf6f9173f639ee08fcec29ef2...1e7a8743293a2424c9dd63181228132668d6ce16
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/20250203/91df023b/attachment-0001.html>
More information about the ghc-commits
mailing list