[Git][ghc/ghc][wip/soulomoon/suggest-UnliftedNewtypes-unlifted-data-family-25593] Only kcConDecls for (A) newtype or (B) H98 style

[Patrick (@soulomoon)]

Patrick pushed to branch wip/soulomoon/suggest-UnliftedNewtypes-unlifted-data-family-25593 at Glasgow Haskell Compiler / GHC


Commits:
3de22cc8 by Patrick at 2025-01-07T12:36:43+08:00
Only kcConDecls for (A) newtype or (B) H98 style

- - - - -


1 changed file:

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


Changes:

=====================================
compiler/GHC/Tc/TyCl/Instance.hs
=====================================
@@ -8,6 +8,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE LambdaCase #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 
@@ -947,11 +948,11 @@ tcDataFamInstHeader mb_clsinfo skol_info fam_tc hs_outer_bndrs fixity
 
                   -- Add constraints from the data constructors
                   -- Fix #25611
-                  -- But becareful about the GADT style case,
-                  -- do not unify LHS's kind with RHS's kind,
                   -- See Note [Kind inference for data family instances]
-                  ; kcConDecls new_or_data res_kind hs_cons
-
+                  ; case hs_cons of
+                      (NewTypeCon _) -> kcConDecls new_or_data res_kind hs_cons
+                      (DataTypeCons _ cons) | isH98 cons -> kcConDecls new_or_data res_kind hs_cons
+                      _ -> return ()
 
                   -- Check that the result kind of the TyCon applied to its args
                   -- is compatible with the explicit signature (or Type, if there
@@ -1008,6 +1009,9 @@ tcDataFamInstHeader mb_clsinfo skol_info fam_tc hs_outer_bndrs fixity
   where
     fam_name  = tyConName fam_tc
     data_ctxt = DataKindCtxt fam_name
+    isH98 cons = flip any (unLoc <$> cons) $ \case
+      ConDeclH98{} -> True
+      _ -> False
 
     -- See Note [Implementation of UnliftedNewtypes] in GHC.Tc.TyCl, families (2),
     -- and Note [Implementation of UnliftedDatatypes].



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3de22cc888fabe933007517be84c89de8a04cea2

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3de22cc888fabe933007517be84c89de8a04cea2
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/20250106/8de93143/attachment-0001.html>