[Git][ghc/ghc][wip/T25647] wibbles
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Tue Feb 4 23:48:39 UTC 2025
Simon Peyton Jones pushed to branch wip/T25647 at Glasgow Haskell Compiler / GHC
Commits:
81e27683 by Simon Peyton Jones at 2025-02-04T23:48:10+00:00
wibbles
Including fix for #25725
- - - - -
6 changed files:
- compiler/GHC/Rename/Module.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- testsuite/tests/typecheck/should_compile/T25647.hs
- + testsuite/tests/typecheck/should_compile/T25647_fail.hs
- + testsuite/tests/typecheck/should_compile/T25725.hs
- testsuite/tests/typecheck/should_compile/all.T
Changes:
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -659,6 +659,7 @@ rnClsInstDecl (ClsInstDecl { cid_ext = (inst_warn_ps, _, _)
rnFamEqn :: HsDocContext
-> AssocTyFamInfo
-> FamEqn GhcPs rhs
+ -> FreeKiTyVars -- Implicit binders of the rhs payload
-> (HsDocContext -> rhs -> RnM (rhs', FreeVars))
-> RnM (FamEqn GhcRn rhs', FreeVars)
rnFamEqn doc atfi
@@ -666,7 +667,7 @@ rnFamEqn doc atfi
, feqn_bndrs = outer_bndrs
, feqn_pats = pats
, feqn_fixity = fixity
- , feqn_rhs = payload }) rn_payload
+ , feqn_rhs = payload }) payload_kvs rn_payload
= do { tycon' <- lookupFamInstName mb_cls tycon
-- all_imp_vars represent the implicitly bound type variables. This is
@@ -697,7 +698,7 @@ rnFamEqn doc atfi
--
-- For associated type family instances, exclude the type variables
-- bound by the instance head with filterInScopeM (#19649).
- ; all_imp_vars <- filterInScopeM $ pat_kity_vars
+ ; all_imp_vars <- filterInScopeM $ (pat_kity_vars ++ payload_kvs)
; bindHsOuterTyVarBndrs doc mb_cls all_imp_vars outer_bndrs $ \rn_outer_bndrs ->
do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats
@@ -847,8 +848,9 @@ rnTyFamInstEqn :: AssocTyFamInfo
-> TyFamInstEqn GhcPs
-> RnM (TyFamInstEqn GhcRn, FreeVars)
rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon })
- = rnFamEqn (TySynCtx tycon) atfi eqn rnTySyn
-
+ = rnFamEqn (TySynCtx tycon) atfi eqn
+ [{- No implicit vars on RHS of a type instance -}]
+ rnTySyn
rnTyFamDefltDecl :: Name
-> TyFamDefltDecl GhcPs
@@ -859,8 +861,9 @@ rnDataFamInstDecl :: AssocTyFamInfo
-> DataFamInstDecl GhcPs
-> RnM (DataFamInstDecl GhcRn, FreeVars)
rnDataFamInstDecl atfi (DataFamInstDecl { dfid_eqn =
- eqn@(FamEqn { feqn_tycon = tycon })})
- = do { (eqn', fvs) <- rnFamEqn (TyDataCtx tycon) atfi eqn rnDataDefn
+ eqn@(FamEqn { feqn_tycon = tycon, feqn_rhs = defn })})
+ = do { let implicit_kvs = extractDataDefnKindVars defn
+ ; (eqn', fvs) <- rnFamEqn (TyDataCtx tycon) atfi eqn implicit_kvs rnDataDefn
; return (DataFamInstDecl { dfid_eqn = eqn' }, fvs) }
-- Renaming of the associated types in instances.
=====================================
compiler/Language/Haskell/Syntax/Decls.hs
=====================================
@@ -809,9 +809,11 @@ data HsDataDefn pass -- The payload of a data type defn
-- *and* for data family instances
= -- | Declares a data type or newtype, giving its constructors
-- @
- -- data/newtype T a = <constrs>
- -- data/newtype instance T [a] = <constrs>
+ -- data/newtype T a :: ksig = <constrs>
+ -- data/newtype instance T [a] :: ksig = <constrs>
-- @
+ -- The HsDataDefn describes the (optional) kind signature and the <constrs>
+ -- but not the `data T a` or `newtype T [a]` headers
HsDataDefn { dd_ext :: XCHsDataDefn pass,
dd_ctxt :: Maybe (LHsContext pass), -- ^ Context
dd_cType :: Maybe (XRec pass CType),
=====================================
testsuite/tests/typecheck/should_compile/T25647.hs
=====================================
@@ -16,21 +16,17 @@ newtype Fix1a f = In1a (f (Fix1a f))
newtype Fix1b f where
In1b :: forall ff. ff (Fix1b ff) -> Fix1b ff
--- A plain newtype, GADT syntax, with a return kind signature
+-- A plain newtype, GADT syntax, with a return kind signature,
+-- and runtime-rep quantification in the data constructor
-- Should infer Fix2 :: forall r k. (k -> TYPE r) -> TYPE r
--- Rejected because of deafulting; maybe that's OK
--- newtype Fix2 f :: TYPE r where
--- In2 :: forall ff. ff (Fix2 ff) -> Fix2 ff
+newtype Fix2 f :: TYPE r where
+ In2 :: forall r (ff :: TYPE r -> TYPE r). ff (Fix2 ff) -> Fix2 ff
-- Plain newtype, H98 syntax, standalone kind signature
-- Should get In3 :: forall r (f :: TYPE r -> TYPE r). Fix3 @r f -> Fix3 @r f
type Fix3 :: forall r. (TYPE r -> TYPE r) -> TYPE r
newtype Fix3 f = In3 (f (Fix3 f))
--- This variant produces a /terrible/ message
--- type Fix3a :: forall r k. (TYPE r -> TYPE r) -> TYPE r
--- newtype Fix3a f = In3a (f (Fix3 f))
-
-- Plain newtype, H98 syntax, standalone kind signature
-- Should get In4 :: forall r k (f :: k -> TYPE r). Fix4 @r @k f -> Fix4 @r @k f
type Fix4 :: forall r. (TYPE r -> TYPE r) -> TYPE r
@@ -38,11 +34,6 @@ newtype Fix4 f where
In4 :: forall rr (ff :: TYPE rr -> TYPE rr).
ff (Fix4 ff) -> Fix4 @rr ff
--- Rejected because of defulting; maybe that's OK
---type Fix4a :: forall r. (TYPE r -> TYPE r) -> TYPE r
---newtype Fix4a f where
--- In4a :: ff (Fix4a ff) -> Fix4a ff
-
-------------------- Data families with newtype instance -----------------
-- data instance in GADT sytntax
@@ -64,15 +55,11 @@ data family Dix3 :: (k -> Type) -> k
newtype instance Dix3 f = DIn3 (f (Dix3 f))
-- newtype instance in GADT syntax
--- Rejected because of defaulting
+-- The newtype instance defaults to LiftedRep
data family Dix4 :: (k -> TYPE r) -> k
newtype instance Dix4 f where
DIn4 :: forall ff. ff (Dix4 ff) -> Dix4 ff
---data family Dix4a :: (k -> TYPE r) -> k
---newtype instance forall r f. Dix4a f :: TYPE r where
--- DIn4a :: forall r (ff :: TYPE r -> TYPE r). ff (Dix4a ff) -> Dix4a ff
-
-- newtype instance in H98 syntax
data family Dix5 :: (k -> TYPE r) -> k
newtype instance Dix5 f = DIn5 (f (Dix5 f))
=====================================
testsuite/tests/typecheck/should_compile/T25647_fail.hs
=====================================
@@ -0,0 +1,58 @@
+{-# LANGUAGE DataKinds, UnliftedNewtypes, TypeFamilies, PolyKinds, MagicHash #-}
+
+module T25647 where
+
+import GHC.Exts
+import Data.Kind
+
+-------------------- Plain newtypes -----------------
+
+-- Rejected because in the type signature for In2 we default
+-- the runtime-rep variable to LiftedRep, and that makes In2
+-- into a GADT
+newtype Fix2 f :: TYPE r where
+ In2 :: forall ff. ff (Fix2 ff) -> Fix2 ff
+
+-- Rejected because of defulting; maybe that's OK
+type Fix4a :: forall r. (TYPE r -> TYPE r) -> TYPE r
+newtype Fix4a f where
+ In4a :: ff (Fix4a ff) -> Fix4a ff
+
+-- This variant produces a /terrible/ message
+-- type Fix3a :: forall r k. (TYPE r -> TYPE r) -> TYPE r
+-- newtype Fix3a f = In3a (f (Fix3 f))
+
+-------------------- Data families with newtype instance -----------------
+
+-- data instance in GADT sytntax
+data family Dix1 :: (k -> Type) -> k
+data instance Dix1 f where
+ DIn1 :: forall ff. ff (Dix1 ff) -> Dix1 ff
+
+-- newtype instance in GADT syntax
+data family Dix2 :: (k -> Type) -> k
+newtype instance Dix2 f where
+ DIn2 :: forall ff. ff (Dix2 ff) -> Dix2 ff
+
+data family Dix2a :: (k -> Type) -> k
+newtype instance Dix2a f :: Type where
+ DIn2a :: forall ff. ff (Dix2a ff) -> Dix2a ff
+
+-- newtype instance in H98 syntax
+data family Dix3 :: (k -> Type) -> k
+newtype instance Dix3 f = DIn3 (f (Dix3 f))
+
+-- newtype instance in GADT syntax
+-- Rejected because of defaulting
+data family Dix4 :: (k -> TYPE r) -> k
+newtype instance Dix4 f where
+ DIn4 :: forall ff. ff (Dix4 ff) -> Dix4 ff
+
+data family Dix4a :: (k -> TYPE r) -> k
+newtype instance forall r f. Dix4a f :: TYPE r where
+ DIn4a :: forall r (ff :: TYPE r -> TYPE r). ff (Dix4a ff) -> Dix4a ff
+
+-- newtype instance in H98 syntax
+data family Dix5 :: (k -> TYPE r) -> k
+newtype instance Dix5 f = DIn5 (f (Dix5 f))
+
=====================================
testsuite/tests/typecheck/should_compile/T25725.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE TypeFamilies, PolyKinds #-}
+
+module T25725 where
+
+import Data.Kind
+import GHC.Exts
+
+--This one was OK
+data D :: TYPE r -> Type where
+ MkD :: p -> D p
+
+-- But this was rejected
+data family Dix4 :: Type -> k
+data instance Dix4 Int :: TYPE r -> Type where
+ DIn4 :: p -> Dix4 Int p
+
+
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -933,3 +933,4 @@ test('T25266', normal, compile, [''])
test('T25266a', normal, compile_fail, [''])
test('T25266b', normal, compile, [''])
test('T25597', normal, compile, [''])
+test('T25725', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/81e27683750b15bb2f869109a355247fb7bf7dee
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/81e27683750b15bb2f869109a355247fb7bf7dee
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/20250204/2f7691ae/attachment-0001.html>
More information about the ghc-commits
mailing list