[Git][ghc/ghc][ghc-9.10] Fixes for built-in names (#25182, #25174)
Andreas Klebinger (@AndreasK)
gitlab at gitlab.haskell.org
Tue Jan 28 21:41:55 UTC 2025
Andreas Klebinger pushed to branch ghc-9.10 at Glasgow Haskell Compiler / GHC
Commits:
cc4470be by Vladislav Zavialov at 2025-01-28T18:32:38+03:00
Fixes for built-in names (#25182, #25174)
* In isBuiltInOcc_maybe, do not match on "FUN" (#25174)
* Classify MkSolo as UserSyntax (#25182)
Extracted from 51e3ec839c378f0da7052278a56482f0349e9bc7
- - - - -
15 changed files:
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Types/Name/Ppr.hs
- docs/users_guide/9.10.2-notes.rst
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- + testsuite/tests/rename/should_compile/ReExportTuples.hs
- + testsuite/tests/rename/should_compile/T25182.hs
- testsuite/tests/rename/should_compile/all.T
- + testsuite/tests/th/FunNameTH.hs
- testsuite/tests/th/T13776.hs
- testsuite/tests/th/T13776.stderr
- + testsuite/tests/th/T25174.hs
- testsuite/tests/th/all.T
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
Changes:
=====================================
compiler/GHC/Builtin/Types.hs
=====================================
@@ -78,6 +78,7 @@ module GHC.Builtin.Types (
promotedTupleDataCon,
unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,
soloTyCon,
+ soloDataConName,
pairTyCon, mkPromotedPairTy, isPromotedPairType,
unboxedUnitTy,
unboxedUnitTyCon, unboxedUnitDataCon,
@@ -896,7 +897,6 @@ isBuiltInOcc_maybe occ =
":" -> Just consDataConName
-- function tycon
- "FUN" -> Just fUNTyConName
"->" -> Just unrestrictedFunTyConName
-- tuple data/tycon
@@ -1055,40 +1055,36 @@ isPunOcc_maybe mod occ
isCTupleOcc_maybe mod occ <|>
isSumTyOcc_maybe mod occ
-mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
--- No need to cache these, the caching is done in mk_tuple
-mkTupleOcc ns Boxed ar = mkOccName ns (mkBoxedTupleStr ns ar)
-mkTupleOcc ns Unboxed ar = mkOccName ns (mkUnboxedTupleStr ns ar)
+mkTupleOcc :: NameSpace -> Boxity -> Arity -> (OccName, BuiltInSyntax)
+mkTupleOcc ns b ar = (mkOccName ns str, built_in)
+ where (str, built_in) = mkTupleStr' ns b ar
mkCTupleOcc :: NameSpace -> Arity -> OccName
mkCTupleOcc ns ar = mkOccName ns (mkConstraintTupleStr ar)
mkTupleStr :: Boxity -> NameSpace -> Arity -> String
-mkTupleStr Boxed = mkBoxedTupleStr
-mkTupleStr Unboxed = mkUnboxedTupleStr
-
-mkBoxedTupleStr :: NameSpace -> Arity -> String
-mkBoxedTupleStr ns 0
- | isDataConNameSpace ns = "()"
- | otherwise = "Unit"
-mkBoxedTupleStr ns 1
- | isDataConNameSpace ns = "MkSolo" -- See Note [One-tuples]
- | otherwise = "Solo"
-mkBoxedTupleStr ns ar
- | isDataConNameSpace ns = '(' : commas ar ++ ")"
- | otherwise = "Tuple" ++ showInt ar ""
-
-
-mkUnboxedTupleStr :: NameSpace -> Arity -> String
-mkUnboxedTupleStr ns 0
- | isDataConNameSpace ns = "(##)"
- | otherwise = "Unit#"
-mkUnboxedTupleStr ns 1
- | isDataConNameSpace ns = "(# #)" -- See Note [One-tuples]
- | otherwise = "Solo#"
-mkUnboxedTupleStr ns ar
- | isDataConNameSpace ns = "(#" ++ commas ar ++ "#)"
- | otherwise = "Tuple" ++ show ar ++ "#"
+mkTupleStr b ns ar = str
+ where (str, _) = mkTupleStr' ns b ar
+
+mkTupleStr' :: NameSpace -> Boxity -> Arity -> (String, BuiltInSyntax)
+mkTupleStr' ns Boxed 0
+ | isDataConNameSpace ns = ("()", BuiltInSyntax)
+ | otherwise = ("Unit", UserSyntax)
+mkTupleStr' ns Boxed 1
+ | isDataConNameSpace ns = ("MkSolo", UserSyntax) -- See Note [One-tuples]
+ | otherwise = ("Solo", UserSyntax)
+mkTupleStr' ns Boxed ar
+ | isDataConNameSpace ns = ('(' : commas ar ++ ")", BuiltInSyntax)
+ | otherwise = ("Tuple" ++ showInt ar "", UserSyntax)
+mkTupleStr' ns Unboxed 0
+ | isDataConNameSpace ns = ("(##)", BuiltInSyntax)
+ | otherwise = ("Unit#", UserSyntax)
+mkTupleStr' ns Unboxed 1
+ | isDataConNameSpace ns = ("(# #)", BuiltInSyntax) -- See Note [One-tuples]
+ | otherwise = ("Solo#", UserSyntax)
+mkTupleStr' ns Unboxed ar
+ | isDataConNameSpace ns = ("(#" ++ commas ar ++ "#)", BuiltInSyntax)
+ | otherwise = ("Tuple" ++ show ar ++ "#", UserSyntax)
mkConstraintTupleStr :: Arity -> String
mkConstraintTupleStr 0 = "CUnit"
@@ -1244,10 +1240,10 @@ mk_tuple Boxed arity = (tycon, tuple_con)
boxity = Boxed
modu = gHC_INTERNAL_TUPLE
- tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
- (ATyCon tycon) UserSyntax
- dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
- (AConLike (RealDataCon tuple_con)) BuiltInSyntax
+ tc_name = mkWiredInName modu occ tc_uniq (ATyCon tycon) built_in
+ where (occ, built_in) = mkTupleOcc tcName boxity arity
+ dc_name = mkWiredInName modu occ dc_uniq (AConLike (RealDataCon tuple_con)) built_in
+ where (occ, built_in) = mkTupleOcc dataName boxity arity
tc_uniq = mkTupleTyConUnique boxity arity
dc_uniq = mkTupleDataConUnique boxity arity
@@ -1278,10 +1274,10 @@ mk_tuple Unboxed arity = (tycon, tuple_con)
boxity = Unboxed
modu = gHC_TYPES
- tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
- (ATyCon tycon) UserSyntax
- dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
- (AConLike (RealDataCon tuple_con)) BuiltInSyntax
+ tc_name = mkWiredInName modu occ tc_uniq (ATyCon tycon) built_in
+ where (occ, built_in) = mkTupleOcc tcName boxity arity
+ dc_name = mkWiredInName modu occ dc_uniq (AConLike (RealDataCon tuple_con)) built_in
+ where (occ, built_in) = mkTupleOcc dataName boxity arity
tc_uniq = mkTupleTyConUnique boxity arity
dc_uniq = mkTupleDataConUnique boxity arity
@@ -1345,6 +1341,9 @@ soloTyCon = tupleTyCon Boxed 1
soloTyConName :: Name
soloTyConName = tyConName soloTyCon
+soloDataConName :: Name
+soloDataConName = tupleDataConName Boxed 1
+
pairTyCon :: TyCon
pairTyCon = tupleTyCon Boxed 2
=====================================
compiler/GHC/Types/Name/Ppr.hs
=====================================
@@ -123,7 +123,8 @@ mkQualName env = qual_name where
, fUNTyConName, unrestrictedFunTyConName
, oneDataConName
, listTyConName
- , manyDataConName ]
+ , manyDataConName
+ , soloDataConName ]
|| isJust (isTupleTyOcc_maybe mod occ)
|| isJust (isSumTyOcc_maybe mod occ)
=====================================
docs/users_guide/9.10.2-notes.rst
=====================================
@@ -68,6 +68,10 @@ Compiler
specialization rules was added. It was actually added ghc-9.10.1 already but
mistakenly not mentioned in the 9.10.1 changelog.
+- Fixed re-exports of ``MkSolo`` (:ghc-ticket:`25182`)
+
+- Fixed the behavior of ``Language.Haskell.TH.mkName "FUN"`` (:ghc-ticket:`25174`)
+
JavaScript backend
~~~~~~~~~~~~~~~~~~
=====================================
testsuite/tests/interface-stability/ghc-experimental-exports.stdout
=====================================
@@ -5481,7 +5481,7 @@ module Prelude.Experimental where
data List a = ...
pattern Solo :: forall a. a -> Solo a
type Solo :: * -> *
- data Solo a = ...
+ data Solo a = MkSolo a
type Solo# :: forall (k :: GHC.Types.RuntimeRep). TYPE k -> TYPE (GHC.Types.TupleRep '[k])
data Solo# a = ...
type Sum10# :: forall (k0 :: GHC.Types.RuntimeRep) (k1 :: GHC.Types.RuntimeRep) (k2 :: GHC.Types.RuntimeRep) (k3 :: GHC.Types.RuntimeRep) (k4 :: GHC.Types.RuntimeRep) (k5 :: GHC.Types.RuntimeRep) (k6 :: GHC.Types.RuntimeRep) (k7 :: GHC.Types.RuntimeRep) (k8 :: GHC.Types.RuntimeRep) (k9 :: GHC.Types.RuntimeRep). TYPE k0 -> TYPE k1 -> TYPE k2 -> TYPE k3 -> TYPE k4 -> TYPE k5 -> TYPE k6 -> TYPE k7 -> TYPE k8 -> TYPE k9 -> TYPE (GHC.Types.SumRep [k0, k1, k2, k3, k4, k5, k6, k7, k8, k9])
=====================================
testsuite/tests/rename/should_compile/ReExportTuples.hs
=====================================
@@ -0,0 +1,4 @@
+module ReExportTuples (module Data.Tuple) where
+-- Re-export the entire Data.Tuple module at once
+
+import Data.Tuple
=====================================
testsuite/tests/rename/should_compile/T25182.hs
=====================================
@@ -0,0 +1,6 @@
+module T25182 where
+
+import ReExportTuples
+
+s :: Solo String
+s = MkSolo "hello"
\ No newline at end of file
=====================================
testsuite/tests/rename/should_compile/all.T
=====================================
@@ -223,3 +223,4 @@ test('T22478a', req_th, compile, [''])
test('RecordWildCardDeprecation', normal, multimod_compile, ['RecordWildCardDeprecation', '-Wno-duplicate-exports'])
test('T14032b', normal, compile_and_run, [''])
test('T14032d', normal, compile, [''])
+test('T25182', [extra_files(['ReExportTuples.hs'])], multimod_compile, ['T25182', '-v0'])
=====================================
testsuite/tests/th/FunNameTH.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module FunNameTH where
+
+import Language.Haskell.TH
+
+f1 :: forall a. $(conT (mkName "->")) [a] Bool
+f1 = null
+
+f2 :: forall a. $(conT ''(->)) [a] Bool
+f2 = null
\ No newline at end of file
=====================================
testsuite/tests/th/T13776.hs
=====================================
@@ -10,6 +10,9 @@ spliceTy1 = (1,2)
spliceTy2 :: $(conT ''[] `appT` conT ''Int)
spliceTy2 = []
+spliceTy3 :: $(conT ''(->)) [Int] Int
+spliceTy3 = sum
+
spliceExp1 :: (Int, Int)
spliceExp1 = $(conE '(,) `appE` litE (integerL 1) `appE` litE (integerL 1))
=====================================
testsuite/tests/th/T13776.stderr
=====================================
@@ -1,12 +1,13 @@
+T13776.hs:13:15-27: Splicing type conT ''(->) ======> (->)
T13776.hs:10:15-43: Splicing type
conT ''[] `appT` conT ''Int ======> [] Int
T13776.hs:7:15-62: Splicing type
conT ''(,) `appT` conT ''Int `appT` conT ''Int ======> (,) Int Int
-T13776.hs:14:15-75: Splicing expression
+T13776.hs:17:15-75: Splicing expression
conE '(,) `appE` litE (integerL 1) `appE` litE (integerL 1)
======>
(,) 1 1
-T13776.hs:17:15-24: Splicing expression conE '[] ======> []
-T13776.hs:20:13-62: Splicing pattern
+T13776.hs:20:15-24: Splicing expression conE '[] ======> []
+T13776.hs:23:13-62: Splicing pattern
conP '(,) [litP (integerL 1), litP (integerL 1)] ======> (,) 1 1
-T13776.hs:23:13-25: Splicing pattern conP '[] [] ======> []
+T13776.hs:26:13-25: Splicing pattern conP '[] [] ======> []
=====================================
testsuite/tests/th/T25174.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T25174 where
+
+import Language.Haskell.TH
+
+data FUN a b = MkFUN (a -> b)
+
+evenFUN :: $(conT (mkName "FUN")) Int Bool
+evenFUN = MkFUN even
+
=====================================
testsuite/tests/th/all.T
=====================================
@@ -614,3 +614,5 @@ test('T24557e', normal, compile, [''])
test('T24702a', normal, compile, [''])
test('T24702b', normal, compile, [''])
test('T24837', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
+test('T25174', normal, compile, [''])
+test('FunNameTH', normal, compile, [''])
=====================================
testsuite/tests/typecheck/should_compile/holes.stderr
=====================================
@@ -88,7 +88,6 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
Nothing :: forall a. Maybe a
Just :: forall a. a -> Maybe a
[] :: forall a. [a]
- MkSolo :: forall a. a -> Solo a
asTypeOf :: forall a. a -> a -> a
id :: forall a. a -> a
until :: forall a. (a -> Bool) -> (a -> a) -> a -> a
=====================================
testsuite/tests/typecheck/should_compile/holes3.stderr
=====================================
@@ -91,7 +91,6 @@ holes3.hs:11:15: error: [GHC-88464]
Nothing :: forall a. Maybe a
Just :: forall a. a -> Maybe a
[] :: forall a. [a]
- MkSolo :: forall a. a -> Solo a
asTypeOf :: forall a. a -> a -> a
id :: forall a. a -> a
until :: forall a. (a -> Bool) -> (a -> a) -> a -> a
=====================================
testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
=====================================
@@ -1,6 +1,5 @@
[1 of 2] Compiling ValidHoleFits ( ValidHoleFits.hs, ValidHoleFits.o )
[2 of 2] Compiling Foo ( valid_hole_fits.hs, valid_hole_fits.o )
-
valid_hole_fits.hs:9:6: warning: [GHC-88464] [-Wdeferred-out-of-scope-variables (in -Wdefault)]
Variable not in scope: putStrLn :: String -> IO ()
Suggested fixes:
@@ -148,9 +147,6 @@ valid_hole_fits.hs:34:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with Just @Bool
(imported from ‘Data.Maybe’ at valid_hole_fits.hs:5:1-17
(and originally defined in ‘GHC.Internal.Maybe’))
- MkSolo :: forall a. a -> Solo a
- with MkSolo @Bool
- (bound at <wired into compiler>)
id :: forall a. a -> a
with id @Bool
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
@@ -259,3 +255,4 @@ valid_hole_fits.hs:41:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with mempty @(String -> IO ())
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Base’))
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cc4470be68fa11ce296cef0684a11c4641f85ffe
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cc4470be68fa11ce296cef0684a11c4641f85ffe
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/20250128/348723c2/attachment-0001.html>
More information about the ghc-commits
mailing list