[Git][ghc/ghc][wip/soulomoon/25647-allow-newtype-instance-in-gadt-syntax] format and remove getTyConResultKind

[Patrick (@soulomoon)]

Patrick pushed to branch wip/soulomoon/25647-allow-newtype-instance-in-gadt-syntax at Glasgow Haskell Compiler / GHC


Commits:
97e3a4d4 by Patrick at 2025-01-17T19:02:03+08:00
format and remove getTyConResultKind

- - - - -


3 changed files:

- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Instance.hs


Changes:

=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -75,8 +75,6 @@ module GHC.Tc.Gen.HsType (
 
         -- Utils
         tyLitFromLit, tyLitFromOverloadedLit,
-        getTyConResultKind
-
    ) where
 
 import GHC.Prelude hiding ( head, init, last, tail )
@@ -3948,12 +3946,6 @@ needsEtaExpansion DataTypeFlavour = True
 needsEtaExpansion ClassFlavour    = True
 needsEtaExpansion _               = False
 
-getTyConResultKind :: Kind -> TcKind
-getTyConResultKind kind
-  = case splitPiTy_maybe kind of
-      Just (_, kind') -> getTyConResultKind kind'
-      Nothing         -> kind
-
 splitTyConKind :: SkolemInfo
                -> InScopeSet
                -> [OccName]  -- Avoid these OccNames


=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -14,7 +14,7 @@
 
 -- | Typecheck type and class declarations
 module GHC.Tc.TyCl (
-        UserSuppliedResultKind(..),
+        LHSUserSuppliedResultKind(..),
         tcTyAndClassDecls,
         -- Functions used by GHC.Tc.TyCl.Instance to check
         -- data/type family instance declarations
@@ -1775,8 +1775,8 @@ kcTyClDecl (DataDecl { tcdLName    = (L _ _name)
     do { traceTc "kcTyClDecl" (ppr tycon $$ ppr (tyConTyVars tycon) $$ ppr (tyConResKind tycon))
        ; _ <- tcHsContext ctxt
        ; kcConDecls (tyConResKind tycon) (if (isJust kindSig)
-                                          then UserSuppliedResultKind
-                                          else NoUserSuppliedResultKind) cons
+                                          then LHSUserSuppliedResultKind
+                                          else NoLHSUserSuppliedResultKind) cons
        }
 
 kcTyClDecl (SynDecl { tcdLName = L _ _name, tcdRhs = rhs }) tycon
@@ -1836,11 +1836,11 @@ kcConGADTArgs exp_kind con_args = case con_args of
   RecConGADT _ (L _ flds) -> kcConArgTys exp_kind $
                              map (hsLinear . cd_fld_type . unLoc) flds
 
-data UserSuppliedResultKind = UserSuppliedResultKind | NoUserSuppliedResultKind deriving Eq
+data LHSUserSuppliedResultKind = LHSUserSuppliedResultKind | NoLHSUserSuppliedResultKind deriving Eq
 
 kcConDecls :: TcKind  -- Result kind of tycon
                       -- Used only in H98 case
-           -> UserSuppliedResultKind
+           -> LHSUserSuppliedResultKind
            -> DataDefnCons (LConDecl GhcRn) -> TcM ()
 -- See Note [kcConDecls: kind-checking data type decls]
 kcConDecls tc_res_kind usrk cons
@@ -1853,7 +1853,7 @@ kcConDecls tc_res_kind usrk 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 -> UserSuppliedResultKind -> TcKind -> ConDecl GhcRn -> TcM ()
+kcConDecl :: NewOrData -> LHSUserSuppliedResultKind -> 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 })
@@ -1884,8 +1884,8 @@ kcConDecl new_or_data usrk tc_res_kind
     do { _ <- tcHsContext cxt
     -- find the lhs signature
        ; traceTc "kcConDecl:GADT {" (ppr names $$ ppr res_ty $$ ppr tc_res_kind)
-       ; con_res_kind <-  if NewType == new_or_data && NoUserSuppliedResultKind == usrk
-                          then return $ getTyConResultKind tc_res_kind
+       ; con_res_kind <-  if NewType == new_or_data && NoLHSUserSuppliedResultKind == 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


=====================================
compiler/GHC/Tc/TyCl/Instance.hs
=====================================
@@ -947,8 +947,8 @@ tcDataFamInstHeader mb_clsinfo skol_info fam_tc hs_outer_bndrs fixity
                   -- Fix #25611
                   -- See DESIGN CHOICE in Note [Kind inference for data family instances]
                   ; when is_H98_or_newtype $ kcConDecls lhs_applied_kind  (if (isJust m_ksig)
-                                          then UserSuppliedResultKind
-                                          else NoUserSuppliedResultKind)
+                                          then LHSUserSuppliedResultKind
+                                          else NoLHSUserSuppliedResultKind)
                                           hs_cons
 
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/97e3a4d4977dc80897d84049c46260b36826061d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/97e3a4d4977dc80897d84049c46260b36826061d
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/20250117/e69f2e75/attachment-0001.html>