- ghc-commits - Haskell.org

[Git][ghc/ghc][ghc-9.12] Fixes for built-in names (#25182, #25174)
by Ben Gamari (＠bgamari) 18 Apr '25

18 Apr '25

Ben Gamari pushed to branch ghc-9.12 at Glasgow Haskell Compiler / GHC Commits: b30f2559 by Vladislav Zavialov at 2025-04-18T17:19:43-04:00 Fixes for built-in names (#25182, #25174) * In isBuiltInOcc_maybe, do not match on "FUN" (#25174) * Classify MkSolo and MkSolo# as UserSyntax (#25182) Extracted from 51e3ec839c378f0da7052278a56482f0349e9bc7 - - - - - 21 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Types/Name/Ppr.hs - + docs/users_guide/9.12.3-notes.rst - docs/users_guide/release-notes.rst - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/Exts.hs - testsuite/tests/core-to-stg/T24124.stderr - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - + testsuite/tests/rename/should_compile/ReExportTuples.hs - + testsuite/tests/rename/should_compile/T25182.hs - testsuite/tests/rename/should_compile/all.T - testsuite/tests/simplStg/should_compile/T15226b.stderr - + 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, @@ -895,7 +896,6 @@ isBuiltInOcc_maybe occ = ":" -> Just consDataConName -- function tycon - "FUN" -> Just fUNTyConName "->" -> Just unrestrictedFunTyConName -- tuple data/tycon @@ -1054,40 +1054,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 = "MkSolo#" -- 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 = ("MkSolo#", UserSyntax) -- 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" @@ -1243,10 +1239,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 @@ -1277,10 +1273,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 @@ -1344,6 +1340,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.12.3-notes.rst ===================================== @@ -0,0 +1,69 @@ +.. _release-9-12-3: + +Version 9.12.3 +============== + +The significant changes to the various parts of the compiler are listed in the +following sections. See the `migration guide +<https://gitlab.haskell.org/ghc/ghc/-/wikis/migration/9.12>`_ on the GHC Wiki +for specific guidance on migrating programs to this release. + +Compiler +~~~~~~~~ + +- Fixed re-exports of ``MkSolo`` and ``MkSolo#`` (:ghc-ticket:`25182`) +- Fixed the behavior of ``Language.Haskell.TH.mkName "FUN"`` (:ghc-ticket:`25174`) + +Included libraries +~~~~~~~~~~~~~~~~~~ + +The package database provided with this distribution also contains a number of +packages other than GHC itself. See the changelogs provided with these packages +for further change information. + +.. ghc-package-list:: + + compiler/ghc.cabal: The compiler itself + libraries/array/array.cabal: Dependency of ``ghc`` library + libraries/base/base.cabal: Core library + libraries/binary/binary.cabal: Dependency of ``ghc`` library + libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library + libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility + libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility + libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library + libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library + libraries/directory/directory.cabal: Dependency of ``ghc`` library + libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library + libraries/file-io/file-io.cabal: Dependency of ``directory`` library + libraries/filepath/filepath.cabal: Dependency of ``ghc`` library + libraries/ghc-boot/ghc-boot.cabal: Internal compiler library + libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library + libraries/ghc-compact/ghc-compact.cabal: Core library + libraries/ghc-experimental/ghc-experimental.cabal: Core library + libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library + libraries/ghci/ghci.cabal: The REPL interface + libraries/ghc-internal/ghc-internal.cabal: Core library + libraries/ghc-platform/ghc-platform.cabal: Internal library + libraries/ghc-prim/ghc-prim.cabal: Core library + libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable + libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable + libraries/integer-gmp/integer-gmp.cabal: Core library + libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library + libraries/os-string/os-string.cabal: Dependency of ``filepath`` library + libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library + libraries/pretty/pretty.cabal: Dependency of ``ghc`` library + libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/semaphore-compat/semaphore-compat.cabal: Dependency of ``ghc`` library + libraries/stm/stm.cabal: Dependency of ``haskeline`` library + libraries/template-haskell/template-haskell.cabal: Core library + libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library + libraries/text/text.cabal: Dependency of ``Cabal`` library + libraries/time/time.cabal: Dependency of ``ghc`` library + libraries/transformers/transformers.cabal: Dependency of ``ghc`` library + libraries/unix/unix.cabal: Dependency of ``ghc`` library + libraries/Win32/Win32.cabal: Dependency of ``ghc`` library + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable + utils/haddock/haddock-api/haddock-api.cabal: Dependency of ``haddock`` executable + utils/haddock/haddock-library/haddock-library.cabal: Dependency of ``haddock`` executable + + ===================================== docs/users_guide/release-notes.rst ===================================== @@ -6,3 +6,4 @@ Release notes 9.12.1-notes 9.12.2-notes + 9.12.3-notes ===================================== libraries/base/src/GHC/Base.hs ===================================== @@ -278,7 +278,7 @@ import GHC.Internal.IO (seq#) import GHC.Internal.Maybe import GHC.Types hiding ( Unit#, - Solo#, + Solo#(..), Tuple0#, Tuple1#, Tuple2#, ===================================== libraries/base/src/GHC/Exts.hs ===================================== @@ -267,7 +267,7 @@ import GHC.Types hiding ( -- GHC's internal representation of 'TyCon's, for 'Typeable' Module, TrName, TyCon, TypeLitSort, KindRep, KindBndr, Unit#, - Solo#, + Solo#(..), Tuple0#, Tuple1#, Tuple2#, ===================================== testsuite/tests/core-to-stg/T24124.stderr ===================================== @@ -24,7 +24,7 @@ T15226b.testFun1 case y of conrep { __DEFAULT -> case T15226b.MkStrictPair [sat conrep] of sat { - __DEFAULT -> MkSolo# [sat]; + __DEFAULT -> GHC.Types.MkSolo# [sat]; }; }; }; ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout ===================================== @@ -4474,6 +4474,7 @@ module GHC.PrimOps where type role MVar# nominal representational type MVar# :: forall {l :: Levity}. * -> TYPE (BoxedRep l) -> UnliftedType data MVar# a b + MkSolo# :: forall (k :: RuntimeRep) (a :: TYPE k). a -> (# a #) type MultMul :: Multiplicity -> Multiplicity -> Multiplicity type family MultMul a b where forall (x :: Multiplicity). MultMul One x = x @@ -7331,9 +7332,9 @@ 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 = ... + data Solo# a = MkSolo# 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]) data Sum10# a b c d e f g h i j = ... type Sum11# :: 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) (k10 :: GHC.Types.RuntimeRep). TYPE k0 -> TYPE k1 -> TYPE k2 -> TYPE k3 -> TYPE k4 -> TYPE k5 -> TYPE k6 -> TYPE k7 -> TYPE k8 -> TYPE k9 -> TYPE k10 -> TYPE (GHC.Types.SumRep [k0, k1, k2, k3, k4, k5, k6, k7, k8, k9, k10]) ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 ===================================== @@ -4474,6 +4474,7 @@ module GHC.PrimOps where type role MVar# nominal representational type MVar# :: forall {l :: Levity}. * -> TYPE (BoxedRep l) -> UnliftedType data MVar# a b + MkSolo# :: forall (k :: RuntimeRep) (a :: TYPE k). a -> (# a #) type MultMul :: Multiplicity -> Multiplicity -> Multiplicity type family MultMul a b where forall (x :: Multiplicity). MultMul One x = x @@ -7334,9 +7335,9 @@ 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 = ... + data Solo# a = MkSolo# 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]) data Sum10# a b c d e f g h i j = ... type Sum11# :: 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) (k10 :: GHC.Types.RuntimeRep). TYPE k0 -> TYPE k1 -> TYPE k2 -> TYPE k3 -> TYPE k4 -> TYPE k5 -> TYPE k6 -> TYPE k7 -> TYPE k8 -> TYPE k9 -> TYPE k10 -> TYPE (GHC.Types.SumRep [k0, k1, k2, k3, k4, k5, k6, k7, k8, k9, k10]) ===================================== 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 ===================================== @@ -225,3 +225,4 @@ test('T14032d', normal, compile, ['']) test('T24621_normal', normal, compile, ['']) test('T24621_th', req_th, compile, ['']) test('T24732', normal, compile_and_run, ['-package "base(Prelude, Text.Printf as P\')"']) +test('T25182', [extra_files(['ReExportTuples.hs'])], multimod_compile, ['T25182', '-v0']) ===================================== testsuite/tests/simplStg/should_compile/T15226b.stderr ===================================== @@ -20,7 +20,7 @@ T15226b.bar1 sat [Occ=Once1] :: T15226b.Str (GHC.Internal.Maybe.Maybe a) [LclId] = T15226b.Str! [sat]; - } in MkSolo# [sat]; + } in GHC.Types.MkSolo# [sat]; }; T15226b.bar ===================================== 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 ===================================== @@ -631,3 +631,5 @@ test('T25252', req_c], compile_and_run, ['-fPIC T25252_c.c']) test('T25083', [extra_files(['T25083_A.hs', 'T25083_B.hs'])], multimod_compile_and_run, ['T25083', '-v0 -j']) +test('T25174', normal, compile, ['']) +test('FunNameTH', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/holes.stderr ===================================== @@ -87,7 +87,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 ===================================== @@ -90,7 +90,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/b30f25591e78d42837eff475bbe25fe… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b30f25591e78d42837eff475bbe25fe… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/int-index/ghc-9.12-backport-25182-25174] 13 commits: binary: Bump to 0.8.9.3
by Ben Gamari (＠bgamari) 18 Apr '25

18 Apr '25

Ben Gamari pushed to branch wip/int-index/ghc-9.12-backport-25182-25174 at Glasgow Haskell Compiler / GHC Commits: 05559400 by Ben Gamari at 2025-01-28T11:35:01-05:00 binary: Bump to 0.8.9.3 Only trivial changes present. - - - - - 4b57fd7e by Ben Gamari at 2025-01-28T13:24:51-05:00 Bump parsec to 3.1.18.0 - - - - - 2d0ea607 by Ben Gamari at 2025-01-28T13:36:57-05:00 Bump terminfo to 0.4.1.7 - - - - - d3633636 by Ben Gamari at 2025-01-28T15:52:00-05:00 Bump hpc to 0.7.0.2 - - - - - 49f934d3 by Zubin Duggal at 2025-01-29T08:59:12-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 (cherry picked from commit fd297671f81fc262b700471cfc6cd05d34254b6e) - - - - - c3657b33 by Ben Gamari at 2025-01-30T14:07:53-05:00 upload-ghc-libs: Drop more references to ghc-internal from ghc-boot-th Fixes #25687 - - - - - ac3aa16b by Luite Stegeman at 2025-02-19T11:31:21+01:00 Add flags for switching off speculative evaluation. We found that speculative evaluation can increase the amount of allocations in some circumstances. This patch adds new flags for selectively disabling speculative evaluation, allowing us to test the effect of the optimization. The new flags are: -fspec-eval globally enable speculative evaluation -fspec-eval-dictfun enable speculative evaluation for dictionary functions (no effect if speculative evaluation is globally disabled) The new flags are on by default for all optimisation levels. See #25284 (cherry picked from commit 2309975247543a4f77009ea5c3c7a8ebe06dc60b) - - - - - 619dbc01 by Ben Gamari at 2025-02-19T15:50:38-05:00 gitlab-ci: Bump docker images Closes #25693. (cherry picked from commit a566da926e6929d7c7f0f77b0fe519e5fe8250a7) - - - - - 1078f402 by Ben Gamari at 2025-02-19T15:50:38-05:00 hadrian: Drop uses of head/tail To silence warnings with GHC 9.10 (cherry picked from commit a7e23f01226fb690e0951edfe3c26d0cd96a3843) - - - - - a73d6c7f by Ben Gamari at 2025-02-19T15:50:38-05:00 hadrian: Disable x-data-list-nonempty-unzip warning (cherry picked from commit 12752f0cfd8072cd6235f011bb22a5d3d6bc7dc6) - - - - - 383be28f by Ben Gamari at 2025-03-12T09:37:18-04:00 configure: Bump version to 9.12.2 - - - - - 711ccfa1 by Ben Gamari at 2025-03-17T10:18:42-04:00 ghcup-metadata: Use Rocky 8 for RHEL < 9 - - - - - b30f2559 by Vladislav Zavialov at 2025-04-18T17:19:43-04:00 Fixes for built-in names (#25182, #25174) * In isBuiltInOcc_maybe, do not match on "FUN" (#25174) * Classify MkSolo and MkSolo# as UserSyntax (#25182) Extracted from 51e3ec839c378f0da7052278a56482f0349e9bc7 - - - - - 45 changed files: - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Builtin/Types.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Types/Name/Ppr.hs - configure.ac - + docs/users_guide/9.12.3-notes.rst - docs/users_guide/release-notes.rst - docs/users_guide/using-optimisation.rst - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Oracles/ModuleFiles.hs - hadrian/src/Rules/Dependencies.hs - hadrian/src/Settings/Parser.hs - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/Exts.hs - libraries/binary - libraries/hpc - libraries/parsec - libraries/terminfo - testsuite/tests/core-to-stg/T24124.stderr - + testsuite/tests/core-to-stg/T25284/A.hs - + testsuite/tests/core-to-stg/T25284/B.hs - + testsuite/tests/core-to-stg/T25284/Cls.hs - + testsuite/tests/core-to-stg/T25284/Main.hs - + testsuite/tests/core-to-stg/T25284/T25284.stdout - + testsuite/tests/core-to-stg/T25284/all.T - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - + testsuite/tests/rename/should_compile/ReExportTuples.hs - + testsuite/tests/rename/should_compile/T25182.hs - testsuite/tests/rename/should_compile/all.T - testsuite/tests/simplStg/should_compile/T15226b.stderr - + 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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/559af49bb40d43ae71f45ca86af19b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/559af49bb40d43ae71f45ca86af19b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new tag ghc-9.10.2-rc1
by Ben Gamari (＠bgamari) 18 Apr '25

18 Apr '25

Ben Gamari pushed new tag ghc-9.10.2-rc1 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.10.2-rc1 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][ghc-9.10] 2 commits: rel-eng: Fix mktemp usage in recompress-all
by Ben Gamari (＠bgamari) 18 Apr '25

18 Apr '25

Ben Gamari pushed to branch ghc-9.10 at Glasgow Haskell Compiler / GHC Commits: 429b1e0d by Ben Gamari at 2025-04-18T12:38:01-04:00 rel-eng: Fix mktemp usage in recompress-all We need a temporary directory, not a file. (cherry picked from commit 914eb49a0637ef12c3f7db71c9da93c05389497b) - - - - - 88d3b9e6 by Ben Gamari at 2025-04-18T17:02:33-04:00 Finalize release notes - - - - - 3 changed files: - .gitlab/rel_eng/recompress-all - docs/users_guide/9.10.2-notes.rst - docs/users_guide/release-notes.rst Changes: ===================================== .gitlab/rel_eng/recompress-all ===================================== @@ -21,7 +21,7 @@ usage : %.zip : %.tar.xz echo "[tarxz->zip] $< to $@..." - tmp="$$(mktemp tmp.XXX)" && \ + tmp="$$(mktemp -d tmp.XXX)" && \ tar -C "$$tmp" -xf $< && \ cd "$$tmp" && \ zip -9 -r ../$@ * && \ ===================================== docs/users_guide/9.10.2-notes.rst ===================================== @@ -1,4 +1,4 @@ -.. _release-9-10-1: +.. _release-9-10-2: Version 9.10.2 ============== @@ -7,10 +7,6 @@ following sections. See the `migration guide <https://gitlab.haskell.org/ghc/ghc/-/wikis/migration/9.10>`_ on the GHC Wiki for specific guidance on migrating programs to this release. -Language -~~~~~~~~ - - Compiler ~~~~~~~~ @@ -183,16 +179,6 @@ Build system and packaging - Fixed a bug where building ghc from source using ghc-9.8.4 failed with an error mentioning ``ghc_unique_counter64``. (:ghc-ticket:`25576`) -``base`` library -~~~~~~~~~~~~~~~~ - - - - -``ghc-prim`` library -~~~~~~~~~~~~~~~~~~~~ - - ``ghc`` library ~~~~~~~~~~~~~~~ @@ -210,10 +196,6 @@ Build system and packaging * The library is now versioned according to the ghc version it shipped with. -``template-haskell`` library -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - Included libraries ~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/release-notes.rst ===================================== @@ -5,3 +5,4 @@ Release notes :maxdepth: 1 9.10.1-notes + 9.10.2-notes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0cdf476d3878ede6f5cf26a2226e87… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0cdf476d3878ede6f5cf26a2226e87… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Refactor Handling of Multiple Default Declarations
by Marge Bot (＠marge-bot) 18 Apr '25

18 Apr '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e0f3ff11 by Patrick at 2025-04-17T04:31:12-04:00 Refactor Handling of Multiple Default Declarations Fixes: #25912, #25914, #25934 Previously, GHC discarded all loaded defaults (tcg_default) when local defaults were encountered during typechecking. According to the exportable-named-default proposal (sections 2.4.2 and 2.4.3), local defaults should be merged into tcg_default, retaining any defaults already present while overriding where necessary. Key Changes: * Introduce DefaultProvenance to track the origin of default declarations (local, imported, or built-in), replacing the original cd_module in ClassDefaults with cd_provenance :: DefaultProvenance. * Rename tcDefaults to tcDefaultDecls, limiting its responsibility to only converting renamed class defaults into ClassDefaults. * Add extendDefaultEnvWithLocalDefaults to merge local defaults into the environment, with proper duplication checks: - Duplicate local defaults for a class trigger an error. - Local defaults override imported or built-in defaults. * Update and add related notes: Note [Builtin class defaults], Note [DefaultProvenance]. * Add regression tests: T25912, T25914, T25934. Thanks sam and simon for the help on this patch. Co-authored-by: sheaf <sam.derbyshire(a)gmail.com> - - - - - 386f1854 by Teo Camarasu at 2025-04-17T04:31:55-04:00 template-haskell: Remove `addrToByteArrayName` and `addrToByteArray` These were part of the implementation of the `Lift ByteArray` instance and were errornously exported because this module lacked an explicit export list. They have no usages on Hackage. Resolves #24782 - - - - - df16b34f by Sylvain Henry at 2025-04-18T15:46:00-04:00 RTS: remove target info and fix host info (#24058) The RTS isn't a compiler, hence it doesn't have a target and we remove the reported target info displayed by "+RTS --info". We also fix the host info displayed by "+RTS --info": the host of the RTS is the RTS-building compiler's target, not the compiler's host (wrong when doing cross-compilation). - - - - - 6227d6aa by Sylvain Henry at 2025-04-18T15:46:00-04:00 RTS: remove build info As per the discussion in !13967, there is no reason to tag the RTS with information about the build platform. - - - - - 9c42eba1 by Vladislav Zavialov at 2025-04-18T15:46:01-04:00 Diagnostics: remove the KindMismatch constructor (#25957) The KindMismatch constructor was only used as an intermediate representation in pretty-printing. Its removal addresses a problem detected by the "codes" test case: [GHC-89223] is untested (constructor = KindMismatch) In a concious deviation from the usual procedure, the error code GHC-89223 is removed entirely rather than marked as Outdated. The reason is that it never was user-facing in the first place. - - - - - 27 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Default.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Types/DefaultEnv.hs - compiler/GHC/Types/Error/Codes.hs - configure.ac - hadrian/src/Settings/Packages.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md - rts/RtsUtils.c - testsuite/ghc-config/ghc-config.hs - + testsuite/tests/default/T25912.hs - + testsuite/tests/default/T25912.stdout - + testsuite/tests/default/T25912_helper.hs - + testsuite/tests/default/T25914.hs - + testsuite/tests/default/T25934.hs - testsuite/tests/default/all.T - testsuite/tests/default/default-fail03.stderr - testsuite/tests/diagnostic-codes/codes.stdout - testsuite/tests/interface-stability/template-haskell-exports.stdout - testsuite/tests/linters/notes.stdout - testsuite/tests/module/mod58.stderr Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -236,6 +236,7 @@ import GHC.Prelude import GHC.Platform import GHC.Platform.Ways import GHC.Platform.Profile +import GHC.Platform.ArchOS import GHC.Unit.Types import GHC.Unit.Parser @@ -3455,6 +3456,9 @@ compilerInfo dflags ("Build platform", cBuildPlatformString), ("Host platform", cHostPlatformString), ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags), + ("target os string", stringEncodeOS (platformOS (targetPlatform dflags))), + ("target arch string", stringEncodeArch (platformArch (targetPlatform dflags))), + ("target word size in bits", show (platformWordSizeInBits (targetPlatform dflags))), ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), ("Have native code generator", showBool $ platformNcgSupported platform), ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -118,7 +118,7 @@ import GHC.Types.Var.Set import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Env -import GHC.Types.DefaultEnv ( ClassDefaults(..), DefaultEnv, mkDefaultEnv ) +import GHC.Types.DefaultEnv ( ClassDefaults(..), DefaultEnv, mkDefaultEnv, DefaultProvenance(..) ) import GHC.Types.Id import GHC.Types.Id.Make import GHC.Types.Id.Info @@ -1333,7 +1333,7 @@ tcIfaceDefault this_mod IfaceDefault { ifDefaultCls = cls_name ; let warn = fmap fromIfaceWarningTxt iface_warn ; return ClassDefaults { cd_class = cls , cd_types = tys' - , cd_module = Just this_mod + , cd_provenance = DP_Imported this_mod , cd_warn = warn } } where tyThingConClass :: TyThing -> Class ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -85,7 +85,7 @@ import GHC.Tc.Types.Rank (Rank(..)) import GHC.Tc.Types.TH import GHC.Tc.Utils.TcType -import GHC.Types.DefaultEnv (ClassDefaults(ClassDefaults, cd_types, cd_module)) +import GHC.Types.DefaultEnv (ClassDefaults(ClassDefaults, cd_types, cd_provenance), DefaultProvenance (..)) import GHC.Types.Error import GHC.Types.Error.Codes import GHC.Types.Hint @@ -582,11 +582,19 @@ instance Diagnostic TcRnMessage where TcRnMultipleDefaultDeclarations cls dup_things -> mkSimpleDecorated $ hang (text "Multiple default declarations for class" <+> quotes (ppr cls)) - 2 (vcat (map pp dup_things)) + 2 (pp dup_things) where - pp :: LDefaultDecl GhcRn -> SDoc - pp (L locn DefaultDecl {}) - = text "here was another default declaration" <+> ppr (locA locn) + pp :: ClassDefaults -> SDoc + pp (ClassDefaults { cd_provenance = prov }) + = case prov of + DP_Local { defaultDeclLoc = loc, defaultDeclH98 = isH98 } + -> let + what = + if isH98 + then text "default declaration" + else text "named default declaration" + in text "conflicting" <+> what <+> text "at:" <+> ppr loc + _ -> empty -- doesn't happen, as local defaults override imported and built-in defaults TcRnBadDefaultType ty deflt_clss -> mkSimpleDecorated $ hang (text "The default type" <+> quotes (ppr ty) <+> text "is not an instance of") @@ -4388,21 +4396,6 @@ pprMismatchMsg ctxt conc :: [String] -> String conc = unwords . filter (not . null) -pprMismatchMsg _ - (KindMismatch { kmismatch_what = thing - , kmismatch_expected = exp - , kmismatch_actual = act }) - = hang (text "Expected" <+> kind_desc <> comma) - 2 (text "but" <+> quotes (ppr thing) <+> text "has kind" <+> - quotes (ppr act)) - where - kind_desc | isConstraintLikeKind exp = text "a constraint" - | Just arg <- kindRep_maybe exp -- TYPE t0 - , tcIsTyVarTy arg = sdocOption sdocPrintExplicitRuntimeReps $ \case - True -> text "kind" <+> quotes (ppr exp) - False -> text "a type" - | otherwise = text "kind" <+> quotes (ppr exp) - pprMismatchMsg ctxt (TypeEqMismatch { teq_mismatch_item = item , teq_mismatch_ty1 = ty1 -- These types are the actual types @@ -4421,11 +4414,11 @@ pprMismatchMsg ctxt | Just nargs_msg <- num_args_msg , Right ea_msg <- mk_ea_msg ctxt (Just item) level orig - = nargs_msg $$ pprMismatchMsg ctxt ea_msg + = nargs_msg $$ ea_msg | ea_looks_same ty1 ty2 exp act , Right ea_msg <- mk_ea_msg ctxt (Just item) level orig - = pprMismatchMsg ctxt ea_msg + = ea_msg | otherwise = bale_out_msg @@ -4437,7 +4430,7 @@ pprMismatchMsg ctxt Left ea_info -> pprMismatchMsg ctxt mismatch_err : map (pprExpectedActualInfo ctxt) ea_info Right ea_err -> [ pprMismatchMsg ctxt mismatch_err - , pprMismatchMsg ctxt ea_err ] + , ea_err ] mismatch_err = mkBasicMismatchMsg NoEA item ty1 ty2 -- 'expected' is (TYPE rep) or (CONSTRAINT rep) @@ -4534,7 +4527,7 @@ pprMismatchMsg ctxt (CouldNotDeduce useful_givens (item :| others) mb_extra) Left infos -> vcat (map (pprExpectedActualInfo ctxt) infos) Right other_msg - -> pprMismatchMsg ctxt other_msg + -> other_msg where main_msg | null useful_givens @@ -4569,6 +4562,18 @@ pprMismatchMsg ctxt (CouldNotDeduce useful_givens (item :| others) mb_extra) [wanted] -> quotes (ppr wanted) _ -> pprTheta wanteds +pprKindMismatchMsg :: TypedThing -> Type -> Type -> SDoc +pprKindMismatchMsg thing exp act + = hang (text "Expected" <+> kind_desc <> comma) + 2 (text "but" <+> quotes (ppr thing) <+> text "has kind" <+> + quotes (ppr act)) + where + kind_desc | isConstraintLikeKind exp = text "a constraint" + | Just arg <- kindRep_maybe exp -- TYPE t0 + , tcIsTyVarTy arg = sdocOption sdocPrintExplicitRuntimeReps $ \case + True -> text "kind" <+> quotes (ppr exp) + False -> text "a type" + | otherwise = text "kind" <+> quotes (ppr exp) -- | Whether to print explicit kinds (with @-fprint-explicit-kinds@) -- in an 'SDoc' when a type mismatch occurs to due invisible parts of the types. @@ -4863,7 +4868,7 @@ pprWhenMatching ctxt (WhenMatching cty1 cty2 sub_o mb_sub_t_or_k) = supplementary = case mk_supplementary_ea_msg ctxt sub_t_or_k cty1 cty2 sub_o of Left infos -> vcat $ map (pprExpectedActualInfo ctxt) infos - Right msg -> pprMismatchMsg ctxt msg + Right msg -> msg pprTyVarInfo :: SolverReportErrCtxt -> TyVarInfo -> SDoc pprTyVarInfo ctxt (TyVarInfo { thisTyVar = tv1, otherTy = mb_tv2, thisTyVarIsUntouchable = mb_implic }) @@ -5094,8 +5099,6 @@ mismatchMsg_ExpectedActuals :: MismatchMsg -> Maybe (Type, Type) mismatchMsg_ExpectedActuals = \case BasicMismatch { mismatch_ty1 = exp, mismatch_ty2 = act } -> Just (exp, act) - KindMismatch { kmismatch_expected = exp, kmismatch_actual = act } -> - Just (exp, act) TypeEqMismatch { teq_mismatch_expected = exp, teq_mismatch_actual = act } -> Just (exp,act) CouldNotDeduce { cnd_extra = cnd_extra } @@ -5421,7 +5424,7 @@ skolsSpan skol_tvs = foldr1WithDefault noSrcSpan combineSrcSpans (map getSrcSpan **********************************************************************-} mk_supplementary_ea_msg :: SolverReportErrCtxt -> TypeOrKind - -> Type -> Type -> CtOrigin -> Either [ExpectedActualInfo] MismatchMsg + -> Type -> Type -> CtOrigin -> Either [ExpectedActualInfo] SDoc mk_supplementary_ea_msg ctxt level ty1 ty2 orig | TypeEqOrigin { uo_expected = exp, uo_actual = act } <- orig , not (ea_looks_same ty1 ty2 exp act) @@ -5444,7 +5447,7 @@ ea_looks_same ty1 ty2 exp act -- (TYPE 'LiftedRep) and Type both print the same way. mk_ea_msg :: SolverReportErrCtxt -> Maybe ErrorItem -> TypeOrKind - -> CtOrigin -> Either [ExpectedActualInfo] MismatchMsg + -> CtOrigin -> Either [ExpectedActualInfo] SDoc -- Constructs a "Couldn't match" message -- The (Maybe ErrorItem) says whether this is the main top-level message (Just) -- or a supplementary message (Nothing) @@ -5452,13 +5455,11 @@ mk_ea_msg ctxt at_top level (TypeEqOrigin { uo_actual = act, uo_expected = exp, uo_thing = mb_thing }) | Just thing <- mb_thing , KindLevel <- level - = Right $ KindMismatch { kmismatch_what = thing - , kmismatch_expected = exp - , kmismatch_actual = act } + = Right $ pprKindMismatchMsg thing exp act | Just item <- at_top , let ea = EA $ if expanded_syns then Just ea_expanded else Nothing mismatch = mkBasicMismatchMsg ea item exp act - = Right mismatch + = Right (pprMismatchMsg ctxt mismatch) | otherwise = Left $ if expanded_syns @@ -7139,7 +7140,7 @@ pprPatersonCondFailure (PCF_TyFam tc) InTyFamEquation _lhs rhs = -------------------------------------------------------------------------------- defaultTypesAndImport :: ClassDefaults -> SDoc -defaultTypesAndImport ClassDefaults{cd_types, cd_module = Just cdm} = +defaultTypesAndImport ClassDefaults{cd_types, cd_provenance = DP_Imported cdm} = hang (parens $ pprWithCommas ppr cd_types) 2 (text "imported from" <+> ppr cdm) defaultTypesAndImport ClassDefaults{cd_types} = parens (pprWithCommas ppr cd_types) ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -1504,7 +1504,7 @@ data TcRnMessage where Text cases: module/mod58 -} - TcRnMultipleDefaultDeclarations :: Class -> [LDefaultDecl GhcRn] -> TcRnMessage + TcRnMultipleDefaultDeclarations :: Class -> ClassDefaults -> TcRnMessage {-| TcRnWarnClashingDefaultImports is a warning that occurs when a module imports more than one default declaration for the same class, and they are not all @@ -5690,19 +5690,9 @@ data MismatchMsg , mismatch_mb_same_occ :: Maybe SameOccInfo } - -- | A type has an unexpected kind. - -- - -- Test cases: T2994, T7609, ... - | KindMismatch - { kmismatch_what :: TypedThing -- ^ What thing is 'kmismatch_actual' the kind of? - , kmismatch_expected :: Type - , kmismatch_actual :: Type - } - -- TODO: combine with 'BasicMismatch'. - -- | A mismatch between two types, which arose from a type equality. -- - -- Test cases: T1470, tcfail212. + -- Test cases: T1470, tcfail212, T2994, T7609. | TypeEqMismatch { teq_mismatch_item :: ErrorItem , teq_mismatch_ty1 :: Type ===================================== compiler/GHC/Tc/Gen/Default.hs ===================================== @@ -5,9 +5,10 @@ -} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE LambdaCase #-} -- | Typechecking @default@ declarations -module GHC.Tc.Gen.Default ( tcDefaults ) where +module GHC.Tc.Gen.Default ( tcDefaultDecls, extendDefaultEnvWithLocalDefaults ) where import GHC.Prelude import GHC.Hs @@ -16,7 +17,7 @@ import GHC.Builtin.Names import GHC.Core.Class import GHC.Core.Predicate ( Pred (..), classifyPredType ) -import GHC.Data.Maybe ( firstJusts ) +import GHC.Data.Maybe ( firstJusts, maybeToList ) import GHC.Tc.Errors.Types import GHC.Tc.Gen.HsType @@ -30,20 +31,17 @@ import GHC.Tc.Utils.TcMType ( newWanted ) import GHC.Tc.Utils.TcType import GHC.Types.Basic ( TypeOrKind(..) ) -import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults (..), defaultEnv ) +import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults (..), lookupDefaultEnv, insertDefaultEnv, DefaultProvenance (..) ) import GHC.Types.SrcLoc -import GHC.Unit.Types (Module, ghcInternalUnit, moduleUnit) +import GHC.Unit.Types (ghcInternalUnit, moduleUnit) -import GHC.Utils.Misc (fstOf3, sndOf3) import GHC.Utils.Outputable import qualified GHC.LanguageExtensions as LangExt -import Data.Function (on) -import Data.List.NonEmpty ( NonEmpty (..), groupBy ) +import Data.List.NonEmpty ( NonEmpty (..) ) import qualified Data.List.NonEmpty as NE -import Data.Maybe (fromMaybe) import Data.Traversable ( for ) {- Note [Named default declarations] @@ -86,7 +84,7 @@ The moving parts are as follows: * The `DefaultEnv` of all defaults in scope in a module is kept in the `tcg_default` field of `TcGblEnv`. -* This field is populated by `GHC.Tc.Gen.Default.tcDefaults` which typechecks +* This field is populated by `GHC.Tc.Gen.Default.tcDefaultDecls` which typechecks any local or imported `default` declarations. * Only a single default declaration can be in effect in any single module for @@ -103,7 +101,7 @@ The moving parts are as follows: in effect be `default Num (Integer, Double)` as specified by Haskell Language Report. - See Note [Default class defaults] in GHC.Tc.Utils.Env + See Note [Builtin class defaults] in GHC.Tc.Utils.Env * Beside the defaults, the `ExtendedDefaultRules` and `OverloadedStrings` extensions also affect the traditional `default` declarations that don't name @@ -120,61 +118,54 @@ The moving parts are as follows: tracked separately from `ImportAvails`, and returned separately from them by `GHC.Rename.Names.rnImports`. -* Class defaults are exported explicitly, as the example above shows. A module's - exported defaults are tracked in `tcg_default_exports`, which are then - transferred to `mg_defaults`, `md_defaults`, and `mi_defaults_`. +* Class defaults are exported explicitly. + For example, + module M( ..., default C, ... ) + exports the defaults for class C. + + A module's exported defaults are computed by exports_from_avail, + tracked in tcg_default_exports, which are then transferred to mg_defaults, + md_defaults, and mi_defaults_. + + Only defaults explicitly exported are actually exported. + (i.e. No defaults are exported in a module header like: + module M where ...) + See Note [Default exports] in GHC.Tc.Gen.Export * Since the class defaults merely help the solver infer the correct types, they leave no trace in Haskell Core. -} --- See Note [Named default declarations] -tcDefaults :: [LDefaultDecl GhcRn] - -> TcM DefaultEnv -- Defaulting types to heave - -- into Tc monad for later use - -- in Disambig. - -tcDefaults [] - = getDeclaredDefaultTys -- No default declaration, so get the - -- default types from the envt; - -- i.e. use the current ones - -- (the caller will put them back there) - -- It's important not to return defaultDefaultTys here (which - -- we used to do) because in a TH program, tcDefaults [] is called - -- repeatedly, once for each group of declarations between top-level - -- splices. We don't want to carefully set the default types in - -- one group, only for the next group to ignore them and install - -- defaultDefaultTys - -tcDefaults decls - = do { tcg_env <- getGblEnv - ; let - here = tcg_mod tcg_env - is_internal_unit = moduleUnit here == ghcInternalUnit - ; case (is_internal_unit, decls) of - -- Some internal GHC modules contain @default ()@ to declare that no defaults can take place - -- in the module. - -- We shortcut the treatment of such a default declaration with no class nor types: we won't - -- try to point 'cd_class' to 'Num' since it may not even exist yet. - { (True, [L _ (DefaultDecl _ Nothing [])]) - -> return $ defaultEnv [] - -- Otherwise we take apart the declaration into the class constructor and its default types. - ; _ -> - do { h2010_dflt_clss <- getH2010DefaultClasses - ; decls' <- mapMaybeM (declarationParts h2010_dflt_clss) decls - ; let - -- Find duplicate default declarations - decl_tag (mb_cls, _, _) = - case mb_cls of - Nothing -> Nothing - Just cls -> if cls `elem` h2010_dflt_clss - then Nothing - else Just cls - decl_groups = groupBy ((==) `on` decl_tag) decls' - ; decls_without_dups <- mapM (reportDuplicates here h2010_dflt_clss) decl_groups - ; return $ defaultEnv (concat decls_without_dups) - } } } +-- | Typecheck a collection of default declarations. These can be either: +-- +-- - Haskell 98 default declarations, of the form @default (Float, Double)@ +-- - Named default declarations, of the form @default Cls(Int, Char)@. +-- See Note [Named default declarations] +tcDefaultDecls :: [LDefaultDecl GhcRn] -> TcM [LocatedA ClassDefaults] +tcDefaultDecls decls = + do + tcg_env <- getGblEnv + let here = tcg_mod tcg_env + is_internal_unit = moduleUnit here == ghcInternalUnit + case (is_internal_unit, decls) of + -- No default declarations + (_, []) -> return [] + -- As per Remark [default () in ghc-internal] in Note [Builtin class defaults], + -- some modules in ghc-internal include an empty `default ()` declaration, in order + -- to disable built-in defaults. This is no longer necessary (see `GHC.Tc.Utils.Env.tcGetDefaultTys`), + -- but we must still make sure not to error if we fail to look up e.g. the 'Num' + -- typeclass when typechecking such a default declaration. To do this, we wrap + -- calls of 'tcLookupClass' in 'tryTc'. + (True, [L _ (DefaultDecl _ Nothing [])]) -> do + h2010_dflt_clss <- foldMapM (fmap maybeToList . fmap fst . tryTc . tcLookupClass) =<< getH2010DefaultNames + case NE.nonEmpty h2010_dflt_clss of + Nothing -> return [] + Just h2010_dflt_clss' -> toClassDefaults h2010_dflt_clss' decls + -- Otherwise we take apart the declaration into the class constructor and its default types. + _ -> do + h2010_dflt_clss <- getH2010DefaultClasses + toClassDefaults h2010_dflt_clss decls where getH2010DefaultClasses :: TcM (NonEmpty Class) -- All the classes subject to defaulting with a Haskell 2010 default @@ -186,18 +177,18 @@ tcDefaults decls -- No extensions: Num -- OverloadedStrings: add IsString -- ExtendedDefaults: add Show, Eq, Ord, Foldable, Traversable - getH2010DefaultClasses - = do { num_cls <- tcLookupClass numClassName - ; ovl_str <- xoptM LangExt.OverloadedStrings + getH2010DefaultClasses = mapM tcLookupClass =<< getH2010DefaultNames + getH2010DefaultNames + = do { ovl_str <- xoptM LangExt.OverloadedStrings ; ext_deflt <- xoptM LangExt.ExtendedDefaultRules - ; deflt_str <- if ovl_str - then mapM tcLookupClass [isStringClassName] - else return [] - ; deflt_interactive <- if ext_deflt - then mapM tcLookupClass interactiveClassNames - else return [] - ; let extra_clss = deflt_str ++ deflt_interactive - ; return $ num_cls :| extra_clss + ; let deflt_str = if ovl_str + then [isStringClassName] + else [] + ; let deflt_interactive = if ext_deflt + then interactiveClassNames + else [] + ; let extra_clss_names = deflt_str ++ deflt_interactive + ; return $ numClassName :| extra_clss_names } declarationParts :: NonEmpty Class -> LDefaultDecl GhcRn -> TcM (Maybe (Maybe Class, LDefaultDecl GhcRn, [Type])) declarationParts h2010_dflt_clss decl@(L locn (DefaultDecl _ mb_cls_name dflt_hs_tys)) @@ -220,20 +211,49 @@ tcDefaults decls ; return (Just cls, decl, tau_tys) } } - reportDuplicates :: Module -> NonEmpty Class -> NonEmpty (Maybe Class, LDefaultDecl GhcRn, [Type]) -> TcM [ClassDefaults] - reportDuplicates here h2010_dflt_clss ((mb_cls, _, tys) :| []) - = pure [ ClassDefaults{cd_class = c, cd_types = tys, cd_module = Just here, cd_warn = Nothing } - | c <- case mb_cls of - Nothing -> NE.toList h2010_dflt_clss - Just cls -> [cls] - ] - -- Report an error on multiple default declarations for the same class in the same module. - -- See Note [Disambiguation of multiple default declarations] in GHC.Tc.Module - reportDuplicates _ (num_cls :| _) decls@((_, L locn _, _) :| _) - = setSrcSpan (locA locn) (addErrTc $ dupDefaultDeclErr cls (sndOf3 <$> decls)) - >> pure [] + toClassDefaults :: NonEmpty Class -> [LDefaultDecl GhcRn] -> TcM [LocatedA ClassDefaults] + toClassDefaults h2010_dflt_clss dfs = do + dfs <- mapMaybeM (declarationParts h2010_dflt_clss) dfs + return $ concatMap (go False) dfs where - cls = fromMaybe num_cls $ firstJusts (fmap fstOf3 decls) + go h98 = \case + (Nothing, rn_decl, tys) -> concatMap (go True) [(Just cls, rn_decl, tys) | cls <- NE.toList h2010_dflt_clss] + (Just cls, (L locn _), tys) -> [(L locn $ ClassDefaults cls tys (DP_Local (locA locn) h98) Nothing)] + +-- | Extend the default environment with the local default declarations +-- and do the action in the extended environment. +extendDefaultEnvWithLocalDefaults :: [LocatedA ClassDefaults] -> TcM a -> TcM a +extendDefaultEnvWithLocalDefaults decls action = do + tcg_env <- getGblEnv + let default_env = tcg_default tcg_env + new_default_env <- insertDefaultDecls default_env decls + updGblEnv (\gbl -> gbl { tcg_default = new_default_env } ) $ action + +-- | Insert local default declarations into the default environment. +-- +-- See 'insertDefaultDecl'. +insertDefaultDecls :: DefaultEnv -> [LocatedA ClassDefaults] -> TcM DefaultEnv +insertDefaultDecls = foldrM insertDefaultDecl +-- | Insert a local default declaration into the default environment. +-- +-- If the class already has a local default declaration in the DefaultEnv, +-- report an error and return the original DefaultEnv. Otherwise, override +-- any existing default declarations (e.g. imported default declarations). +-- +-- See Note [Disambiguation of multiple default declarations] in GHC.Tc.Module +insertDefaultDecl :: LocatedA ClassDefaults -> DefaultEnv -> TcM DefaultEnv +insertDefaultDecl (L decl_loc new_cls_defaults ) default_env = + case lookupDefaultEnv default_env (className cls) of + Just cls_defaults + | DP_Local {} <- cd_provenance cls_defaults + -> do { setSrcSpan (locA decl_loc) (addErrTc $ TcRnMultipleDefaultDeclarations cls cls_defaults) + ; return default_env } + _ -> return $ insertDefaultEnv new_cls_defaults default_env + -- NB: this overrides imported and built-in default declarations + -- for this class, if there were any. + where + cls = cd_class new_cls_defaults + -- | Check that the type is an instance of at least one of the default classes. -- @@ -289,10 +309,6 @@ simplifyDefault cls dflt_ty@(L l _) -> Nothing } -dupDefaultDeclErr :: Class -> NonEmpty (LDefaultDecl GhcRn) -> TcRnMessage -dupDefaultDeclErr cls (L _ DefaultDecl {} :| dup_things) - = TcRnMultipleDefaultDeclarations cls dup_things - {- Note [Instance check for default declarations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we see a named default declaration, such as: @@ -327,4 +343,4 @@ whether each type is an instance of: - ... or the IsString class, with -XOverloadedStrings - ... or any of the Show, Eq, Ord, Foldable, and Traversable classes, with -XExtendedDefaultRules --} \ No newline at end of file +-} ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -282,7 +282,7 @@ example, would import the above `default IsString (Text, String)` declaration into the importing module. -The `cd_module` field of `ClassDefaults` tracks the module whence the default was +The `cd_provenance` field of `ClassDefaults` tracks the module whence the default was imported from, for the purpose of warning reports. The said warning report may be triggered by `-Wtype-defaults` or by a user-defined `WARNING` pragma attached to the default export. In the latter case the warning text is stored in the ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -383,6 +383,7 @@ the actual contents of the module are wired in to GHC. -} {- Note [Disambiguation of multiple default declarations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ See Note [Named default declarations] in GHC.Tc.Gen.Default @@ -1811,9 +1812,8 @@ tcTyClsInstDecls tycl_decls deriv_decls default_decls binds -- -- But only after we've typechecked 'default' declarations. -- See Note [Typechecking default declarations] - defaults <- tcDefaults default_decls ; - updGblEnv (\gbl -> gbl { tcg_default = defaults }) $ do { - + defaults <- tcDefaultDecls default_decls + ; extendDefaultEnvWithLocalDefaults defaults $ do { -- Careful to quit now in case there were instance errors, so that -- the deriving errors don't pile up as well. ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -128,8 +128,7 @@ import GHC.Types.SourceFile import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Env -import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults(..), - defaultEnv, emptyDefaultEnv, lookupDefaultEnv, unitDefaultEnv ) +import GHC.Types.DefaultEnv import GHC.Types.Error import GHC.Types.Id import GHC.Types.Id.Info ( RecSelParent(..) ) @@ -971,21 +970,28 @@ isBrackStage _other = False ************************************************************************ -} -{- Note [Default class defaults] +{- Note [Builtin class defaults] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In absence of user-defined `default` declarations, the set of class defaults in -effect (i.e. `DefaultEnv`) is determined by the absence or -presence of the `ExtendedDefaultRules` and `OverloadedStrings` extensions. In their -absence, the only rule in effect is `default Num (Integer, Double)` as specified by -Haskell Language Report. - -In GHC's internal packages `DefaultEnv` is empty to minimize cross-module dependencies: -the `Num` class or `Integer` type may not even be available in low-level modules. If -you don't do this, attempted defaulting in package ghc-prim causes an actual crash -(attempting to look up the `Integer` type). - -A user-defined `default` declaration overrides the defaults for the specified class, -and only for that class. +In the absence of user-defined `default` declarations, the set of class defaults in +effect (i.e. the `DefaultEnv`) depends on whether the `ExtendedDefaultRules` and +`OverloadedStrings` extensions are enabled. In their absence, the only rule in effect +is `default Num (Integer, Double)`, as specified by the Haskell 2010 report. + +Remark [No built-in defaults in ghc-internal] + + When typechecking the ghc-internal package, we **do not** include any built-in + defaults. This is because, in ghc-internal, types such as 'Num' or 'Integer' may + not even be available (they haven't been typechecked yet). + +Remark [default () in ghc-internal] + + Historically, modules inside ghc-internal have used a single default declaration, + of the form `default ()`, to work around the problem described in + Remark [No built-in defaults in ghc-internal]. + + When we typecheck such a default declaration, we must also make sure not to fail + if e.g. 'Num' is not in scope. We thus have special treatment for this case, + in 'GHC.Tc.Gen.Default.tcDefaultDecls'. -} tcGetDefaultTys :: TcM (DefaultEnv, -- Default classes and types @@ -997,7 +1003,7 @@ tcGetDefaultTys -- See also #1974 builtinDefaults cls tys = ClassDefaults{ cd_class = cls , cd_types = tys - , cd_module = Nothing + , cd_provenance = DP_Builtin , cd_warn = Nothing } -- see Note [Named default declarations] in GHC.Tc.Gen.Default @@ -1005,7 +1011,8 @@ tcGetDefaultTys ; this_module <- tcg_mod <$> getGblEnv ; let this_unit = moduleUnit this_module ; if this_unit == ghcInternalUnit - -- see Note [Default class defaults] + -- see Remark [No built-in defaults in ghc-internal] + -- in Note [Builtin class defaults] in GHC.Tc.Utils.Env then return (defaults, extended_defaults) else do -- not one of the built-in units @@ -1037,6 +1044,8 @@ tcGetDefaultTys } -- The Num class is already user-defaulted, no need to construct the builtin default _ -> pure emptyDefaultEnv + -- Supply the built-in defaults, but make the user-supplied defaults + -- override them. ; let deflt_tys = mconcat [ extDef, numDef, ovlStr, defaults ] ; return (deflt_tys, extended_defaults) } } ===================================== compiler/GHC/Types/DefaultEnv.hs ===================================== @@ -1,7 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE LambdaCase #-} module GHC.Types.DefaultEnv ( ClassDefaults (..) + , DefaultProvenance (..) , DefaultEnv , emptyDefaultEnv , isEmptyDefaultEnv @@ -12,6 +14,8 @@ module GHC.Types.DefaultEnv , defaultList , plusDefaultEnv , mkDefaultEnv + , insertDefaultEnv + , isHaskell2010Default ) where @@ -22,6 +26,7 @@ import GHC.Tc.Utils.TcType (Type) import GHC.Types.Name (Name, nameUnique, stableNameCmp) import GHC.Types.Name.Env import GHC.Types.Unique.FM (lookupUFM_Directly) +import GHC.Types.SrcLoc (SrcSpan) import GHC.Unit.Module.Warnings (WarningTxt) import GHC.Unit.Types (Module) import GHC.Utils.Outputable @@ -37,13 +42,73 @@ import Data.Function (on) -- NB: this includes Haskell98 default declarations, at the 'Num' key. type DefaultEnv = NameEnv ClassDefaults +{- Note [DefaultProvenance] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Each `ClassDefault` is annotated with its `DefaultProvenance`, which +says where the default came from. Specifically +* `DP_Local loc h98`: the default came from an explicit `default` declaration in the module + being compiled, at location `loc`, and the boolean `h98` indicates whether + it was from a Haskell 98 default declaration (e.g. `default (Int, Double)`). +* `DP_Imported M`: the default was imported, it is explicitly exported by module `M`. +* `DP_Builtin`: the default was automatically provided by GHC. + see Note [Builtin class defaults] in GHC.Tc.Utils.Env + +These annotations are used to disambiguate multiple defaults for the same class. +For example, consider the following modules: + + module M( default C ) where { default C( ... ) } + module M2( default C) where { import M } + module N( default C () where { default C(... ) } + + module A where { import M2 } + module B where { import M2; import N } + module A1 where { import N; default C ( ... ) } + module B2 where { default C ( ... ); default C ( ... ) } + +When compiling N, the default for C is annotated with DP_Local loc. +When compiling M2, the default for C is annotated with DP_Local M. +When compiling A, the default for C is annotated with DP_Imported M2. + +Cases we needed to disambiguate: + * Compiling B, two defaults for C: DP_Imported M2, DP_Imported N. + * Compiling A1, two defaults for C: DP_Imported N, DP_Local loc. + * Compiling B2, two defaults for C: DP_Local loc1, DP_Local loc2. + +For how we disambiguate these cases, +See Note [Disambiguation of multiple default declarations] in GHC.Tc.Module. +-} + +-- | The provenance of a collection of default types for a class. +-- see Note [DefaultProvenance] for more details +data DefaultProvenance + -- | A locally defined default declaration. + = DP_Local + { defaultDeclLoc :: SrcSpan -- ^ The 'SrcSpan' of the default declaration + , defaultDeclH98 :: Bool -- ^ Is this a Haskell 98 default declaration? + } + -- | Built-in class defaults. + | DP_Builtin + -- | Imported class defaults. + | DP_Imported Module -- ^ The module from which the defaults were imported + deriving (Eq, Data) + +instance Outputable DefaultProvenance where + ppr (DP_Local loc h98) = ppr loc <> (if h98 then text " (H98)" else empty) + ppr DP_Builtin = text "built-in" + ppr (DP_Imported mod) = ppr mod + +isHaskell2010Default :: DefaultProvenance -> Bool +isHaskell2010Default = \case + DP_Local { defaultDeclH98 = isH98 } -> isH98 + DP_Builtin -> True + DP_Imported {} -> False + -- | Defaulting type assignments for the given class. data ClassDefaults = ClassDefaults { cd_class :: Class -- ^ The class whose defaults are being defined , cd_types :: [Type] - , cd_module :: Maybe Module - -- ^ @Nothing@ for built-in, - -- @Just@ the current module or the module whence the default was imported + , cd_provenance :: DefaultProvenance + -- ^ Where the defaults came from -- see Note [Default exports] in GHC.Tc.Gen.Export , cd_warn :: Maybe (WarningTxt GhcRn) -- ^ Warning emitted when the default is used @@ -70,6 +135,9 @@ defaultList :: DefaultEnv -> [ClassDefaults] defaultList = sortBy (stableNameCmp `on` className . cd_class) . nonDetNameEnvElts -- sortBy recovers determinism +insertDefaultEnv :: ClassDefaults -> DefaultEnv -> DefaultEnv +insertDefaultEnv d env = extendNameEnv env (className $ cd_class d) d + lookupDefaultEnv :: DefaultEnv -> Name -> Maybe ClassDefaults lookupDefaultEnv env = lookupUFM_Directly env . nameUnique ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -420,7 +420,6 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "MultiplicityCoercionsNotSupported" = 59840 -- Type mismatch errors GhcDiagnosticCode "BasicMismatch" = 18872 - GhcDiagnosticCode "KindMismatch" = 89223 GhcDiagnosticCode "TypeEqMismatch" = 83865 GhcDiagnosticCode "CouldNotDeduce" = 05617 ===================================== configure.ac ===================================== @@ -265,8 +265,8 @@ dnl we ask the bootstrapping compiler what platform it is for if test "${WithGhc}" != "" then - bootstrap_host=`"${WithGhc}" +RTS --info | grep '^ ,("Host platform"' | sed -e 's/.*, "//' -e 's/")//' | tr -d '\r'` - bootstrap_target=`"${WithGhc}" +RTS --info | grep '^ ,("Target platform"' | sed -e 's/.*, "//' -e 's/")//' | tr -d '\r'` + bootstrap_host=`"${WithGhc}" --info | grep '^ ,("Host platform"' | sed -e 's/.*,"//' -e 's/")//' | tr -d '\r'` + bootstrap_target=`"${WithGhc}" --info | grep '^ ,("Target platform"' | sed -e 's/.*,"//' -e 's/")//' | tr -d '\r'` if test "$bootstrap_host" != "$bootstrap_target" then echo "Bootstrapping GHC is a cross compiler. This probably isn't going to work" ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -286,10 +286,6 @@ ghcInternalArgs = package ghcInternal ? do rtsPackageArgs :: Args rtsPackageArgs = package rts ? do projectVersion <- getSetting ProjectVersion - hostPlatform <- queryHost targetPlatformTriple - hostArch <- queryHost queryArch - hostOs <- queryHost queryOS - hostVendor <- queryHost queryVendor buildPlatform <- queryBuild targetPlatformTriple buildArch <- queryBuild queryArch buildOs <- queryBuild queryOS @@ -371,18 +367,16 @@ rtsPackageArgs = package rts ? do , input "**/RtsUtils.c" ? pure [ "-DProjectVersion=" ++ show projectVersion - , "-DHostPlatform=" ++ show hostPlatform - , "-DHostArch=" ++ show hostArch - , "-DHostOS=" ++ show hostOs - , "-DHostVendor=" ++ show hostVendor + -- the RTS' host is the compiler's target (the target should be + -- per stage ideally...) + , "-DHostPlatform=" ++ show targetPlatform + , "-DHostArch=" ++ show targetArch + , "-DHostOS=" ++ show targetOs + , "-DHostVendor=" ++ show targetVendor , "-DBuildPlatform=" ++ show buildPlatform , "-DBuildArch=" ++ show buildArch , "-DBuildOS=" ++ show buildOs , "-DBuildVendor=" ++ show buildVendor - , "-DTargetPlatform=" ++ show targetPlatform - , "-DTargetArch=" ++ show targetArch - , "-DTargetOS=" ++ show targetOs - , "-DTargetVendor=" ++ show targetVendor , "-DGhcUnregisterised=" ++ show (yesNo ghcUnreg) , "-DTablesNextToCode=" ++ show (yesNo ghcEnableTNC) , "-DRtsWay=\"rts_" ++ show way ++ "\"" ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -1,6 +1,6 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskellQuotes #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE UnboxedTuples #-} module Language.Haskell.TH.Syntax ( @@ -190,16 +190,11 @@ module Language.Haskell.TH.Syntax ( nothingName, rightName, trueName, - addrToByteArrayName, - addrToByteArray, ) where -import Data.Array.Byte import GHC.Boot.TH.Lift import GHC.Boot.TH.Syntax -import GHC.Exts -import GHC.ST import System.FilePath -- This module completely re-exports 'GHC.Boot.TH.Syntax', @@ -211,17 +206,3 @@ makeRelativeToProject fp | isRelative fp = do root <- getPackageRoot return (root </> fp) makeRelativeToProject fp = return fp - --- The following two defintions are copied from 'Data.Byte.Array' --- in order to preserve the old export list of 'TH.Syntax'. --- They will soon be removed as part of #24782. - -addrToByteArrayName :: Name -addrToByteArrayName = 'addrToByteArray - -addrToByteArray :: Int -> Addr# -> ByteArray -addrToByteArray (I# len) addr = runST $ ST $ - \s -> case newByteArray# len s of - (# s', mb #) -> case copyAddrToByteArray# addr mb 0# len s' of - s'' -> case unsafeFreezeByteArray# mb s'' of - (# s''', ret #) -> (# s''', ByteArray ret #) ===================================== libraries/template-haskell/changelog.md ===================================== @@ -13,6 +13,8 @@ * Remove the `Language.Haskell.TH.Lib.Internal` module. This module has long been deprecated, and exposes compiler internals. Users should use `Language.Haskell.TH.Lib` instead, which exposes a stable version of this API. + + * Remove `addrToByteArrayName` and `addrToByteArray` from `Language.Haskell.TH.Syntax`. These were part of the implementation of the `Lift ByteArray` instance and were errornously exported because this module lacked an explicit export list. They have no usages on Hackage. ## 2.23.0.0 ===================================== rts/RtsUtils.c ===================================== @@ -364,18 +364,10 @@ void printRtsInfo(const RtsConfig rts_config) { printf(" [(\"GHC RTS\", \"YES\")\n"); mkRtsInfoPair("GHC version", ProjectVersion); mkRtsInfoPair("RTS way", RtsWay); - mkRtsInfoPair("Build platform", BuildPlatform); - mkRtsInfoPair("Build architecture", BuildArch); - mkRtsInfoPair("Build OS", BuildOS); - mkRtsInfoPair("Build vendor", BuildVendor); mkRtsInfoPair("Host platform", HostPlatform); mkRtsInfoPair("Host architecture", HostArch); mkRtsInfoPair("Host OS", HostOS); mkRtsInfoPair("Host vendor", HostVendor); - mkRtsInfoPair("Target platform", TargetPlatform); - mkRtsInfoPair("Target architecture", TargetArch); - mkRtsInfoPair("Target OS", TargetOS); - mkRtsInfoPair("Target vendor", TargetVendor); mkRtsInfoPair("Word size", TOSTRING(WORD_SIZE_IN_BITS)); // TODO(@Ericson2314) This is a joint property of the RTS and generated // code. The compiler will soon be multi-target so it doesn't make sense to ===================================== testsuite/ghc-config/ghc-config.hs ===================================== @@ -1,6 +1,7 @@ import System.Environment import System.Process import Data.Maybe +import Control.Monad main :: IO () main = do @@ -9,15 +10,25 @@ main = do info <- readProcess ghc ["+RTS", "--info"] "" let fields = read info :: [(String,String)] getGhcFieldOrFail fields "HostOS" "Host OS" - getGhcFieldOrFail fields "WORDSIZE" "Word size" - getGhcFieldOrFail fields "TARGETPLATFORM" "Target platform" - getGhcFieldOrFail fields "TargetOS_CPP" "Target OS" - getGhcFieldOrFail fields "TargetARCH_CPP" "Target architecture" getGhcFieldOrFail fields "RTSWay" "RTS way" + -- support for old GHCs (pre 9.13): infer target platform by querying the rts... + let query_rts = isJust (lookup "Target platform" fields) + when query_rts $ do + getGhcFieldOrFail fields "WORDSIZE" "Word size" + getGhcFieldOrFail fields "TARGETPLATFORM" "Target platform" + getGhcFieldOrFail fields "TargetOS_CPP" "Target OS" + getGhcFieldOrFail fields "TargetARCH_CPP" "Target architecture" + info <- readProcess ghc ["--info"] "" let fields = read info :: [(String,String)] + unless query_rts $ do + getGhcFieldOrFail fields "WORDSIZE" "target word size in bits" + getGhcFieldOrFail fields "TARGETPLATFORM" "target platform string" + getGhcFieldOrFail fields "TargetOS_CPP" "target os string" + getGhcFieldOrFail fields "TargetARCH_CPP" "target arch string" + getGhcFieldOrFail fields "GhcStage" "Stage" getGhcFieldOrFail fields "GhcDebugAssertions" "Debug on" getGhcFieldOrFail fields "GhcWithNativeCodeGen" "Have native code generator" ===================================== testsuite/tests/default/T25912.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE NamedDefaults #-} + +module Main where + +import T25912_helper + +-- now we declare the default instances +-- for the classes C again to check that +-- it won't hide the default instances for class B +default C (String) + +main :: IO () +main = do + print b ===================================== testsuite/tests/default/T25912.stdout ===================================== @@ -0,0 +1 @@ +"String" ===================================== testsuite/tests/default/T25912_helper.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE NamedDefaults #-} + +module T25912_helper ( default C, C(c), default B, b ) where + +class C a where + c :: a +instance C Int where + c = 1 +instance C String where + c = "String" +default C (String) + +class B a where + b :: a +instance B String where + b = "String" +default B (String) ===================================== testsuite/tests/default/T25914.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE NamedDefaults, OverloadedStrings #-} +module NamedDefaultsNum where +import Data.String +default Num () +foo = "abc" ===================================== testsuite/tests/default/T25934.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE NamedDefaults #-} +module T25934 where +default Num (Int) +default Show (Int) ===================================== testsuite/tests/default/all.T ===================================== @@ -39,3 +39,6 @@ test('T25858v2', [extra_files(['T25858v2_helper.hs'])], multimod_compile_and_run test('T25858v3', [extra_files(['T25858v3_helper.hs'])], multimod_compile_and_run, ['T25858v3', '']) test('T25858v4', normal, compile_and_run, ['']) test('T25882', normal, compile, ['']) +test('T25912', [extra_files(['T25912_helper.hs'])], multimod_compile_and_run, ['T25912', '']) +test('T25914', normal, compile, ['']) +test('T25934', normal, compile, ['']) ===================================== testsuite/tests/default/default-fail03.stderr ===================================== @@ -1,3 +1,4 @@ -default-fail03.hs:4:1: [GHC-99565] +default-fail03.hs:4:1: error: [GHC-99565] Multiple default declarations for class ‘Num’ - here was another default declaration default-fail03.hs:3:1-29 + conflicting named default declaration at: default-fail03.hs:3:1-29 + ===================================== testsuite/tests/diagnostic-codes/codes.stdout ===================================== @@ -46,7 +46,6 @@ [GHC-06200] is untested (constructor = BlockedEquality) [GHC-81325] is untested (constructor = ExpectingMoreArguments) [GHC-78125] is untested (constructor = AmbiguityPreventsSolvingCt) -[GHC-89223] is untested (constructor = KindMismatch) [GHC-84170] is untested (constructor = TcRnModMissingRealSrcSpan) [GHC-95822] is untested (constructor = TcRnSimplifierTooManyIterations) [GHC-17268] is untested (constructor = TcRnCharLiteralOutOfRange) ===================================== testsuite/tests/interface-stability/template-haskell-exports.stdout ===================================== @@ -1369,7 +1369,7 @@ module Language.Haskell.TH.Quote where quoteFile :: QuasiQuoter -> QuasiQuoter module Language.Haskell.TH.Syntax where - -- Safety: Trustworthy + -- Safety: Safe type AnnLookup :: * data AnnLookup = AnnLookupModule Module | AnnLookupName Name type AnnTarget :: * @@ -1780,8 +1780,6 @@ module Language.Haskell.TH.Syntax where addModFinalizer :: Q () -> Q () addTempFile :: GHC.Internal.Base.String -> Q GHC.Internal.IO.FilePath addTopDecls :: [Dec] -> Q () - addrToByteArray :: GHC.Internal.Types.Int -> GHC.Internal.Prim.Addr# -> Data.Array.Byte.ByteArray - addrToByteArrayName :: Name badIO :: forall a. GHC.Internal.Base.String -> GHC.Internal.Types.IO a bindCode :: forall (m :: * -> *) a (r :: GHC.Internal.Types.RuntimeRep) (b :: TYPE r). GHC.Internal.Base.Monad m => m a -> (a -> Code m b) -> Code m b bindCode_ :: forall (m :: * -> *) a (r :: GHC.Internal.Types.RuntimeRep) (b :: TYPE r). GHC.Internal.Base.Monad m => m a -> Code m b -> Code m b ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -8,7 +8,7 @@ ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4345:8: Note [Lambda-boun ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1387:37: Note [Gentle mode] ref compiler/GHC/Core/Opt/Specialise.hs:1761:29: Note [Arity decrease] ref compiler/GHC/Core/TyCo/Rep.hs:1783:31: Note [What prevents a constraint from floating] -ref compiler/GHC/Driver/DynFlags.hs:1216:52: Note [Eta-reduction in -O0] +ref compiler/GHC/Driver/DynFlags.hs:1218:52: Note [Eta-reduction in -O0] ref compiler/GHC/Driver/Main.hs:1901:34: Note [simpleTidyPgm - mkBootModDetailsTc] ref compiler/GHC/Hs/Expr.hs:189:63: Note [Pending Splices] ref compiler/GHC/Hs/Expr.hs:2194:87: Note [Lifecycle of a splice] @@ -18,10 +18,8 @@ ref compiler/GHC/Hs/Pat.hs:151:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Pmc/Solver.hs:860:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1533:7: Note [How brackets and nested splices are handled] ref compiler/GHC/Stg/Unarise.hs:457:32: Note [Renaming during unarisation] -ref compiler/GHC/Tc/Gen/Default.hs:87:6: Note [Disambiguation of multiple default declarations] -ref compiler/GHC/Tc/Gen/Default.hs:193:11: Note [Disambiguation of multiple default declarations] ref compiler/GHC/Tc/Gen/HsType.hs:563:56: Note [Skolem escape prevention] -ref compiler/GHC/Tc/Gen/HsType.hs:2693:7: Note [Matching a kind signature with a declaration] +ref compiler/GHC/Tc/Gen/HsType.hs:2717:7: Note [Matching a kind signature with a declaration] ref compiler/GHC/Tc/Gen/Pat.hs:284:20: Note [Typing patterns in pattern bindings] ref compiler/GHC/Tc/Gen/Pat.hs:1378:7: Note [Matching polytyped patterns] ref compiler/GHC/Tc/Gen/Sig.hs:91:10: Note [Overview of type signatures] @@ -30,8 +28,6 @@ ref compiler/GHC/Tc/Gen/Splice.hs:543:35: Note [PendingRnSplice] ref compiler/GHC/Tc/Gen/Splice.hs:670:7: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Gen/Splice.hs:909:11: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Instance/Family.hs:458:35: Note [Constrained family instances] -ref compiler/GHC/Tc/Module.hs:385:3: Note [Disambiguation of multiple default declarations] -ref compiler/GHC/Tc/Module.hs:420:7: Note [Disambiguation of multiple default declarations] ref compiler/GHC/Tc/Solver/Rewrite.hs:1015:7: Note [Stability of rewriting] ref compiler/GHC/Tc/TyCl.hs:1322:6: Note [Unification variables need fresh Names] ref compiler/GHC/Tc/Types/Constraint.hs:209:9: Note [NonCanonical Semantics] ===================================== testsuite/tests/module/mod58.stderr ===================================== @@ -1,4 +1,4 @@ - mod58.hs:4:1: error: [GHC-99565] Multiple default declarations for class ‘Num’ - here was another default declaration mod58.hs:3:1-21 + conflicting default declaration at: mod58.hs:3:1-21 + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e7df7747c0359264c63a282112cb5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e7df7747c0359264c63a282112cb5… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/int-index/no-kind-mismatch] Diagnostics: remove the KindMismatch constructor (#25957)
by Vladislav Zavialov (＠int-index) 18 Apr '25

18 Apr '25

Vladislav Zavialov pushed to branch wip/int-index/no-kind-mismatch at Glasgow Haskell Compiler / GHC Commits: 926464f1 by Vladislav Zavialov at 2025-04-18T19:56:44+03:00 Diagnostics: remove the KindMismatch constructor (#25957) The KindMismatch constructor was only used as an intermediate representation in pretty-printing. Its removal addresses a problem detected by the "codes" test case: [GHC-89223] is untested (constructor = KindMismatch) In a concious deviation from the usual procedure, the error code GHC-89223 is removed entirely rather than marked as Outdated. The reason is that it never was user-facing in the first place. - - - - - 4 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/diagnostic-codes/codes.stdout Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -4396,21 +4396,6 @@ pprMismatchMsg ctxt conc :: [String] -> String conc = unwords . filter (not . null) -pprMismatchMsg _ - (KindMismatch { kmismatch_what = thing - , kmismatch_expected = exp - , kmismatch_actual = act }) - = hang (text "Expected" <+> kind_desc <> comma) - 2 (text "but" <+> quotes (ppr thing) <+> text "has kind" <+> - quotes (ppr act)) - where - kind_desc | isConstraintLikeKind exp = text "a constraint" - | Just arg <- kindRep_maybe exp -- TYPE t0 - , tcIsTyVarTy arg = sdocOption sdocPrintExplicitRuntimeReps $ \case - True -> text "kind" <+> quotes (ppr exp) - False -> text "a type" - | otherwise = text "kind" <+> quotes (ppr exp) - pprMismatchMsg ctxt (TypeEqMismatch { teq_mismatch_item = item , teq_mismatch_ty1 = ty1 -- These types are the actual types @@ -4429,11 +4414,11 @@ pprMismatchMsg ctxt | Just nargs_msg <- num_args_msg , Right ea_msg <- mk_ea_msg ctxt (Just item) level orig - = nargs_msg $$ pprMismatchMsg ctxt ea_msg + = nargs_msg $$ ea_msg | ea_looks_same ty1 ty2 exp act , Right ea_msg <- mk_ea_msg ctxt (Just item) level orig - = pprMismatchMsg ctxt ea_msg + = ea_msg | otherwise = bale_out_msg @@ -4445,7 +4430,7 @@ pprMismatchMsg ctxt Left ea_info -> pprMismatchMsg ctxt mismatch_err : map (pprExpectedActualInfo ctxt) ea_info Right ea_err -> [ pprMismatchMsg ctxt mismatch_err - , pprMismatchMsg ctxt ea_err ] + , ea_err ] mismatch_err = mkBasicMismatchMsg NoEA item ty1 ty2 -- 'expected' is (TYPE rep) or (CONSTRAINT rep) @@ -4542,7 +4527,7 @@ pprMismatchMsg ctxt (CouldNotDeduce useful_givens (item :| others) mb_extra) Left infos -> vcat (map (pprExpectedActualInfo ctxt) infos) Right other_msg - -> pprMismatchMsg ctxt other_msg + -> other_msg where main_msg | null useful_givens @@ -4577,6 +4562,18 @@ pprMismatchMsg ctxt (CouldNotDeduce useful_givens (item :| others) mb_extra) [wanted] -> quotes (ppr wanted) _ -> pprTheta wanteds +pprKindMismatchMsg :: TypedThing -> Type -> Type -> SDoc +pprKindMismatchMsg thing exp act + = hang (text "Expected" <+> kind_desc <> comma) + 2 (text "but" <+> quotes (ppr thing) <+> text "has kind" <+> + quotes (ppr act)) + where + kind_desc | isConstraintLikeKind exp = text "a constraint" + | Just arg <- kindRep_maybe exp -- TYPE t0 + , tcIsTyVarTy arg = sdocOption sdocPrintExplicitRuntimeReps $ \case + True -> text "kind" <+> quotes (ppr exp) + False -> text "a type" + | otherwise = text "kind" <+> quotes (ppr exp) -- | Whether to print explicit kinds (with @-fprint-explicit-kinds@) -- in an 'SDoc' when a type mismatch occurs to due invisible parts of the types. @@ -4871,7 +4868,7 @@ pprWhenMatching ctxt (WhenMatching cty1 cty2 sub_o mb_sub_t_or_k) = supplementary = case mk_supplementary_ea_msg ctxt sub_t_or_k cty1 cty2 sub_o of Left infos -> vcat $ map (pprExpectedActualInfo ctxt) infos - Right msg -> pprMismatchMsg ctxt msg + Right msg -> msg pprTyVarInfo :: SolverReportErrCtxt -> TyVarInfo -> SDoc pprTyVarInfo ctxt (TyVarInfo { thisTyVar = tv1, otherTy = mb_tv2, thisTyVarIsUntouchable = mb_implic }) @@ -5102,8 +5099,6 @@ mismatchMsg_ExpectedActuals :: MismatchMsg -> Maybe (Type, Type) mismatchMsg_ExpectedActuals = \case BasicMismatch { mismatch_ty1 = exp, mismatch_ty2 = act } -> Just (exp, act) - KindMismatch { kmismatch_expected = exp, kmismatch_actual = act } -> - Just (exp, act) TypeEqMismatch { teq_mismatch_expected = exp, teq_mismatch_actual = act } -> Just (exp,act) CouldNotDeduce { cnd_extra = cnd_extra } @@ -5429,7 +5424,7 @@ skolsSpan skol_tvs = foldr1WithDefault noSrcSpan combineSrcSpans (map getSrcSpan **********************************************************************-} mk_supplementary_ea_msg :: SolverReportErrCtxt -> TypeOrKind - -> Type -> Type -> CtOrigin -> Either [ExpectedActualInfo] MismatchMsg + -> Type -> Type -> CtOrigin -> Either [ExpectedActualInfo] SDoc mk_supplementary_ea_msg ctxt level ty1 ty2 orig | TypeEqOrigin { uo_expected = exp, uo_actual = act } <- orig , not (ea_looks_same ty1 ty2 exp act) @@ -5452,7 +5447,7 @@ ea_looks_same ty1 ty2 exp act -- (TYPE 'LiftedRep) and Type both print the same way. mk_ea_msg :: SolverReportErrCtxt -> Maybe ErrorItem -> TypeOrKind - -> CtOrigin -> Either [ExpectedActualInfo] MismatchMsg + -> CtOrigin -> Either [ExpectedActualInfo] SDoc -- Constructs a "Couldn't match" message -- The (Maybe ErrorItem) says whether this is the main top-level message (Just) -- or a supplementary message (Nothing) @@ -5460,13 +5455,11 @@ mk_ea_msg ctxt at_top level (TypeEqOrigin { uo_actual = act, uo_expected = exp, uo_thing = mb_thing }) | Just thing <- mb_thing , KindLevel <- level - = Right $ KindMismatch { kmismatch_what = thing - , kmismatch_expected = exp - , kmismatch_actual = act } + = Right $ pprKindMismatchMsg thing exp act | Just item <- at_top , let ea = EA $ if expanded_syns then Just ea_expanded else Nothing mismatch = mkBasicMismatchMsg ea item exp act - = Right mismatch + = Right (pprMismatchMsg ctxt mismatch) | otherwise = Left $ if expanded_syns ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -5690,19 +5690,9 @@ data MismatchMsg , mismatch_mb_same_occ :: Maybe SameOccInfo } - -- | A type has an unexpected kind. - -- - -- Test cases: T2994, T7609, ... - | KindMismatch - { kmismatch_what :: TypedThing -- ^ What thing is 'kmismatch_actual' the kind of? - , kmismatch_expected :: Type - , kmismatch_actual :: Type - } - -- TODO: combine with 'BasicMismatch'. - -- | A mismatch between two types, which arose from a type equality. -- - -- Test cases: T1470, tcfail212. + -- Test cases: T1470, tcfail212, T2994, T7609. | TypeEqMismatch { teq_mismatch_item :: ErrorItem , teq_mismatch_ty1 :: Type ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -420,7 +420,6 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "MultiplicityCoercionsNotSupported" = 59840 -- Type mismatch errors GhcDiagnosticCode "BasicMismatch" = 18872 - GhcDiagnosticCode "KindMismatch" = 89223 GhcDiagnosticCode "TypeEqMismatch" = 83865 GhcDiagnosticCode "CouldNotDeduce" = 05617 ===================================== testsuite/tests/diagnostic-codes/codes.stdout ===================================== @@ -46,7 +46,6 @@ [GHC-06200] is untested (constructor = BlockedEquality) [GHC-81325] is untested (constructor = ExpectingMoreArguments) [GHC-78125] is untested (constructor = AmbiguityPreventsSolvingCt) -[GHC-89223] is untested (constructor = KindMismatch) [GHC-84170] is untested (constructor = TcRnModMissingRealSrcSpan) [GHC-95822] is untested (constructor = TcRnSimplifierTooManyIterations) [GHC-17268] is untested (constructor = TcRnCharLiteralOutOfRange) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/926464f1e7d9371840c41605888996f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/926464f1e7d9371840c41605888996f… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T25440] 3 commits: Refactor Handling of Multiple Default Declarations
by Simon Peyton Jones (＠simonpj) 18 Apr '25

18 Apr '25

Simon Peyton Jones pushed to branch wip/T25440 at Glasgow Haskell Compiler / GHC Commits: e0f3ff11 by Patrick at 2025-04-17T04:31:12-04:00 Refactor Handling of Multiple Default Declarations Fixes: #25912, #25914, #25934 Previously, GHC discarded all loaded defaults (tcg_default) when local defaults were encountered during typechecking. According to the exportable-named-default proposal (sections 2.4.2 and 2.4.3), local defaults should be merged into tcg_default, retaining any defaults already present while overriding where necessary. Key Changes: * Introduce DefaultProvenance to track the origin of default declarations (local, imported, or built-in), replacing the original cd_module in ClassDefaults with cd_provenance :: DefaultProvenance. * Rename tcDefaults to tcDefaultDecls, limiting its responsibility to only converting renamed class defaults into ClassDefaults. * Add extendDefaultEnvWithLocalDefaults to merge local defaults into the environment, with proper duplication checks: - Duplicate local defaults for a class trigger an error. - Local defaults override imported or built-in defaults. * Update and add related notes: Note [Builtin class defaults], Note [DefaultProvenance]. * Add regression tests: T25912, T25914, T25934. Thanks sam and simon for the help on this patch. Co-authored-by: sheaf <sam.derbyshire(a)gmail.com> - - - - - 386f1854 by Teo Camarasu at 2025-04-17T04:31:55-04:00 template-haskell: Remove `addrToByteArrayName` and `addrToByteArray` These were part of the implementation of the `Lift ByteArray` instance and were errornously exported because this module lacked an explicit export list. They have no usages on Hackage. Resolves #24782 - - - - - 1a6a4b1e by Simon Peyton Jones at 2025-04-18T17:42:14+01:00 Track rewriter sets more accurately in constraint solving The key change, which fixed #25440, is to call `recordRewriter` in GHC.Tc.Solver.Rewrite.rewrite_exact_fam_app. This missing call meant that we were secretly rewriting a Wanted with a Wanted, but not really noticing; and that led to a very bad error message, as you can see in the ticket. But of course that led me into rabbit hole of other refactoring around the RewriteSet code: * Improve Notes [Wanteds rewrite Wanteds] * Zonk the RewriterSet in `zonkCtEvidence` rather than only in GHC.Tc.Errors. This is tidier anyway (e.g. de-clutters debug output), and helps with the next point. * In GHC.Tc.Solver.Equality.inertsCanDischarge, don't replace a constraint with no rewriters with an equal constraint that has many. See See (CE4) in Note [Combining equalities] * Move zonkRewriterSet and friends from GHC.Tc.Zonk.Type into GHC.Tc.Zonk.TcType, where they properly belong. A handful of tests get better error messages. For some reason T24984 gets 12% less compiler allocation -- good Metric Decrease: T24984 - - - - - 33 changed files: - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Default.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/DefaultEnv.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md - + testsuite/tests/default/T25912.hs - + testsuite/tests/default/T25912.stdout - + testsuite/tests/default/T25912_helper.hs - + testsuite/tests/default/T25914.hs - + testsuite/tests/default/T25934.hs - testsuite/tests/default/all.T - testsuite/tests/default/default-fail03.stderr - testsuite/tests/indexed-types/should_fail/T3330c.stderr - testsuite/tests/indexed-types/should_fail/T4174.stderr - testsuite/tests/indexed-types/should_fail/T8227.stderr - testsuite/tests/interface-stability/template-haskell-exports.stdout - testsuite/tests/linters/notes.stdout - testsuite/tests/module/mod58.stderr - testsuite/tests/typecheck/should_fail/T18851.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be011dacff5ef7a07d59ecd52ef5c6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be011dacff5ef7a07d59ecd52ef5c6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T23109a] 3 commits: Comments only
by Simon Peyton Jones (＠simonpj) 18 Apr '25

18 Apr '25

Simon Peyton Jones pushed to branch wip/T23109a at Glasgow Haskell Compiler / GHC Commits: b10529e9 by Simon Peyton Jones at 2025-04-18T15:27:53+01:00 Comments only - - - - - e805aa2e by Simon Peyton Jones at 2025-04-18T15:35:54+01:00 Refator GHC.Core.Opt.SetLevels.notWorthFloating I refactored `notWorthFloating` while I was doing something else. I don't think there's a change in behaviour, but if so it's very much a corner case. - - - - - d6c13d5d by Simon Peyton Jones at 2025-04-18T17:16:13+01:00 Always float bottoming expressions to the top ...regardless of floatConsts - - - - - 2 changed files: - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs Changes: ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -482,14 +482,14 @@ Consider this: f :: T Int -> blah f x vs = case x of { MkT y -> let f vs = ...(case y of I# w -> e)...f.. - in f vs + in f vs } Here we can float the (case y ...) out, because y is sure to be evaluated, to give f x vs = case x of { MkT y -> - case y of I# w -> + case y of { I# w -> let f vs = ...(e)...f.. - in f vs + in f vs }} That saves unboxing it every time round the loop. It's important in some DPH stuff where we really want to avoid that repeated unboxing in @@ -614,7 +614,8 @@ lvlMFE env strict_ctxt e@(_, AnnCase {}) = lvlExpr env e -- See Note [Case MFEs] lvlMFE env strict_ctxt ann_expr - | not float_me + | notWorthFloating expr abs_vars + || not float_me || floatTopLvlOnly env && not (isTopLvl dest_lvl) -- Only floating to the top level is allowed. || hasFreeJoin env fvs -- If there is a free join, don't float @@ -623,9 +624,6 @@ lvlMFE env strict_ctxt ann_expr -- We can't let-bind an expression if we don't know -- how it will be represented at runtime. -- See Note [Representation polymorphism invariants] in GHC.Core - || notWorthFloating expr abs_vars - -- Test notWorhtFloating last; - -- See Note [Large free-variable sets] = -- Don't float it out lvlExpr env ann_expr @@ -676,12 +674,11 @@ lvlMFE env strict_ctxt ann_expr is_function = isFunction ann_expr mb_bot_str = exprBotStrictness_maybe expr -- See Note [Bottoming floats] - -- esp Bottoming floats (2) + -- esp Bottoming floats (BF2) expr_ok_for_spec = exprOkForSpeculation expr abs_vars = abstractVars dest_lvl env fvs dest_lvl = destLevel env fvs fvs_ty is_function is_bot_lam - -- NB: is_bot_lam not is_bot; see (3) in - -- Note [Bottoming floats] + -- NB: is_bot_lam not is_bot; see (BF2) in Note [Bottoming floats] -- float_is_new_lam: the floated thing will be a new value lambda -- replacing, say (g (x+4)) by (lvl x). No work is saved, nor is @@ -698,20 +695,22 @@ lvlMFE env strict_ctxt ann_expr -- A decision to float entails let-binding this thing, and we only do -- that if we'll escape a value lambda, or will go to the top level. + -- Never float trivial expressions; + -- notably, save_work might be true of a lone evaluated variable. float_me = saves_work || saves_alloc || is_mk_static -- See Note [Saving work] + is_hnf = exprIsHNF expr saves_work = escapes_value_lam -- (a) - && not (exprIsHNF expr) -- (b) + && not is_hnf -- (b) && not float_is_new_lam -- (c) escapes_value_lam = dest_lvl `ltMajLvl` (le_ctxt_lvl env) - -- See Note [Saving allocation] and Note [Floating to the top] - saves_alloc = isTopLvl dest_lvl - && floatConsts env - && ( not strict_ctxt -- (a) - || exprIsHNF expr -- (b) - || (is_bot_lam && escapes_value_lam)) -- (c) + -- See Note [Floating to the top] + saves_alloc = isTopLvl dest_lvl + && ( (floatConsts env && + (not strict_ctxt || is_hnf)) -- (FT1) and (FT2) + || (is_bot_lam && escapes_value_lam)) -- (FT3) hasFreeJoin :: LevelEnv -> DVarSet -> Bool -- Has a free join point which is not being floated to top level. @@ -726,7 +725,7 @@ hasFreeJoin env fvs The key idea in let-floating is to * float a redex out of a (value) lambda Doing so can save an unbounded amount of work. -But see also Note [Saving allocation]. +But see also Note [Floating to the top]. So we definitely float an expression out if (a) It will escape a value lambda (escapes_value_lam) @@ -771,10 +770,12 @@ Wrinkles: we have saved nothing: one pair will still be allocated for each call of `f`. Hence the (not float_is_new_lam) in saves_work. -Note [Saving allocation] -~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Floating to the top] +~~~~~~~~~~~~~~~~~~~~~~~~~~ Even if `saves_work` is false, we we may want to float even cheap/HNF -expressions out of value lambdas, for several reasons: +expressions out of value lambdas. Data suggests, however, that it is better +/only/ to do so, /if/ they can go to top level. If the expression goes to top +level we don't pay the cost of allocating cold-path thunks described in (SW2). * Doing so may save allocation. Consider f = \x. .. (\y.e) ... @@ -782,6 +783,11 @@ expressions out of value lambdas, for several reasons: (assuming e does not mention x). An example where this really makes a difference is simplrun009. +* In principle this would be true even if the (\y.e) didn't go to top level; but + in practice we only float a HNF if it goes all way to the top. We don't pay + /any/ allocation cost for a top-level floated expression; it just becomes + static data. + * It may allow SpecContr to fire on functions. Consider f = \x. ....(f (\y.e)).... After floating we get @@ -793,21 +799,7 @@ expressions out of value lambdas, for several reasons: a big difference for string literals and bottoming expressions: see Note [Floating to the top] -Data suggests, however, that it is better /only/ to float HNFS, /if/ they can go -to top level. See (SW2) of Note [Saving work]. If the expression goes to top -level we don't pay the cost of allocating cold-path thunks described in (SW2). - -Hence `isTopLvl dest_lvl` in `saves_alloc`. - -Note [Floating to the top] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -Even though Note [Saving allocation] suggests that we should not, in -general, float HNFs, the balance change if it goes to the top: - -* We don't pay an allocation cost for the floated expression; it - just becomes static data. - -* Floating string literal is valuable -- no point in duplicating the +* Floating string literals is valuable -- no point in duplicating the at each call site! * Floating bottoming expressions is valuable: they are always cold @@ -815,32 +807,32 @@ general, float HNFs, the balance change if it goes to the top: can be quite big, inhibiting inlining. See Note [Bottoming floats] So we float an expression to the top if: - (a) the context is lazy (so we get allocation), or - (b) the expression is a HNF (so we get allocation), or - (c) the expression is bottoming and floating would escape a - value lambda (NB: if the expression itself is a lambda, (b) - will apply; so this case only catches bottoming thunks) + (FT1) the context is lazy (so we get allocation), or + (FT2) the expression is a HNF (so we get allocation), or + (FT3) the expression is bottoming and floating would escape a + value lambda (NB: if the expression itself is a lambda, (b) + will apply; so this case only catches bottoming thunks) Examples: -* (a) Strict. Case scrutinee +* (FT1) Strict. Case scrutinee f = case g True of .... Don't float (g True) to top level; then we have the admin of a top-level thunk to worry about, with zero gain. -* (a) Strict. Case alternative +* (FT1) Strict. Case alternative h = case y of True -> g True False -> False Don't float (g True) to the top level -* (b) HNF +* (FT2) HNF f = case y of True -> p:q False -> blah We may as well float the (p:q) so it becomes a static data structure. -* (c) Bottoming expressions; see also Note [Bottoming floats] +* (FT3) Bottoming expressions; see also Note [Bottoming floats] f x = case x of 0 -> error <big thing> _ -> x+1 @@ -853,7 +845,7 @@ Examples: 'foo' anyway. So float bottoming things only if they escape a lambda. -* Arguments +* (FT4) Arguments t = f (g True) Prior to Apr 22 we didn't float (g True) to the top if f was strict. But (a) this only affected CAFs, because if it escapes a value lambda @@ -868,28 +860,6 @@ early loses opportunities for RULES which (needless to say) are important in some nofib programs (gcd is an example). [SPJ note: I think this is obsolete; the flag seems always on.] -Note [Large free-variable sets] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In #24471 we had something like - x1 = I# 1 - ... - x1000 = I# 1000 - foo = f x1 (f x2 (f x3 ....)) -So every sub-expression in `foo` has lots and lots of free variables. But -none of these sub-expressions float anywhere; the entire float-out pass is a -no-op. - -In lvlMFE, we want to find out quickly if the MFE is not-floatable; that is -the common case. In #24471 it turned out that we were testing `abs_vars` (a -relatively complicated calculation that takes at least O(n-free-vars) time to -compute) for every sub-expression. - -Better instead to test `float_me` early. That still involves looking at -dest_lvl, which means looking at every free variable, but the constant factor -is a lot better. - -ToDo: find a way to fix the bad asymptotic complexity. - Note [Floating join point bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Mostly we don't float join points at all -- we want them to /stay/ join points. @@ -1053,30 +1023,36 @@ we'd like to float the call to error, to get But, as ever, we need to be careful: -(1) We want to float a bottoming +(BF1) We want to float a bottoming expression even if it has free variables: f = \x. g (let v = h x in error ("urk" ++ v)) Then we'd like to abstract over 'x', and float the whole arg of g: lvl = \x. let v = h x in error ("urk" ++ v) f = \x. g (lvl x) - To achieve this we pass is_bot to destLevel - -(2) We do not do this for lambdas that return - bottom. Instead we treat the /body/ of such a function specially, - via point (1). For example: + To achieve this we pass `is_bot` to destLevel + +(BF2) We do the same for /lambdas/ that return bottom. + Suppose the original lambda had /no/ free vars: + f = \x. ....(\y z. error (y++z))... + then we'd like to float that whole lambda + lvl = \y z. error (y++z) + f = \x. ....lvl.... + If we just floated its bottom-valued body, we might abstract the arguments in + the "wrong" order and end up with this bad result + lvl = \z y. error (y++z) + f = \x. ....(\y z. lvl z y).... + + If the lambda does have free vars, this will happen: f = \x. ....(\y z. if x then error y else error z).... - If we float the whole lambda thus + We float the whole lambda thus lvl = \x. \y z. if x then error y else error z f = \x. ...(lvl x)... - we may well end up eta-expanding that PAP to + And we may well end up eta-expanding that PAP to + lvl = \x. \y z. if b then error y else error z f = \x. ...(\y z. lvl x y z)... + so we get a (small) closure. So be it. - ===> - lvl = \x z y. if b then error y else error z - f = \x. ...(\y z. lvl x z y)... - (There is no guarantee that we'll choose the perfect argument order.) - -(3) If we have a /binding/ that returns bottom, we want to float it to top +(BF3) If we have a /binding/ that returns bottom, we want to float it to top level, even if it has free vars (point (1)), and even it has lambdas. Example: ... let { v = \y. error (show x ++ show y) } in ... @@ -1092,7 +1068,6 @@ But, as ever, we need to be careful: join points (#24768), and floating to the top would abstract over those join points, which we should never do. - See Maessen's paper 1999 "Bottom extraction: factoring error handling out of functional programs" (unpublished I think). @@ -1135,7 +1110,6 @@ float the case (as advocated here) we won't float the (build ...y..) either, so fusion will happen. It can be a big effect, esp in some artificial benchmarks (e.g. integer, queens), but there is no perfect answer. - -} annotateBotStr :: Id -> Arity -> Maybe (Arity, DmdSig, CprSig) -> Id @@ -1152,69 +1126,124 @@ annotateBotStr id n_extra mb_bot_str = id notWorthFloating :: CoreExpr -> [Var] -> Bool --- Returns True if the expression would be replaced by --- something bigger than it is now. For example: --- abs_vars = tvars only: return True if e is trivial, --- but False for anything bigger --- abs_vars = [x] (an Id): return True for trivial, or an application (f x) --- but False for (f x x) --- --- One big goal is that floating should be idempotent. Eg if --- we replace e with (lvl79 x y) and then run FloatOut again, don't want --- to replace (lvl79 x y) with (lvl83 x y)! - +-- See Note [notWorthFloating] notWorthFloating e abs_vars - = go e (count isId abs_vars) + = go e 0 where - go (Var {}) n = n >= 0 - go (Lit lit) n = assert (n==0) $ - litIsTrivial lit -- Note [Floating literals] - go (Type {}) _ = True - go (Coercion {}) _ = True + n_abs_vars = count isId abs_vars -- See (NWF5) + + go :: CoreExpr -> Int -> Bool + -- (go e n) return True if (e x1 .. xn) is not worth floating + -- where `e` has n trivial value arguments x1..xn + -- See (NWF4) + go (Lit lit) n = assert (n==0) $ + litIsTrivial lit -- See (NWF1) + go (Type {}) _ = True + go (Tick t e) n = not (tickishIsCode t) && go e n + go (Cast e _) n = n==0 || go e n -- See (NWF3) + go (Coercion {}) _ = True go (App e arg) n - -- See Note [Floating applications to coercions] - | not (isRuntimeArg arg) = go e n - | n==0 = False - | exprIsTrivial arg = go e (n-1) -- NB: exprIsTrivial arg = go arg 0 - | otherwise = False - go (Tick t e) n = not (tickishIsCode t) && go e n - go (Cast e _) n = go e n - go (Case e b _ as) n + | Type {} <- arg = go e n -- Just types, not coercions (NWF2) + | exprIsTrivial arg = go e (n+1) + | otherwise = False -- (f non-triv) is worth floating + + go (Case e b _ as) _ + -- Do not float the `case` part of trivial cases (NWF3) + -- We'll have a look at the RHS when we get there | null as - = go e n -- See Note [Empty case is trivial] - | Just rhs <- isUnsafeEqualityCase e b as - = go rhs n -- See (U2) of Note [Implementing unsafeCoerce] in base:Unsafe.Coerce - go _ _ = False + = True -- See Note [Empty case is trivial] + | Just {} <- isUnsafeEqualityCase e b as + = True -- See (U2) of Note [Implementing unsafeCoerce] in base:Unsafe.Coerce + | otherwise + = False -{- -Note [Floating literals] -~~~~~~~~~~~~~~~~~~~~~~~~ -It's important to float Integer literals, so that they get shared, -rather than being allocated every time round the loop. -Hence the litIsTrivial. + go (Var _) n + | n==0 = True -- Naked variable + | n <= n_abs_vars = True -- (f a b c) is not worth floating if + | otherwise = False -- a,b,c are all abstracted; see (NWF5) -Ditto literal strings (LitString), which we'd like to float to top -level, which is now possible. + go _ _ = False -- Let etc is worth floating -Note [Floating applications to coercions] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We don’t float out variables applied only to type arguments, since the -extra binding would be pointless: type arguments are completely erased. -But *coercion* arguments aren’t (see Note [Coercion tokens] in -"GHC.CoreToStg" and Note [inlineBoringOk] in"GHC.Core.Unfold"), -so we still want to float out variables applied only to -coercion arguments. +{- Note [notWorthFloating] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +`notWorthFloating` returns True if the expression would be replaced by something +bigger than it is now. One big goal is that floating should be idempotent. Eg +if we replace e with (lvl79 x y) and then run FloatOut again, don't want to +replace (lvl79 x y) with (lvl83 x y)! +For example: + abs_vars = tvars only: return True if e is trivial, + but False for anything bigger + abs_vars = [x] (an Id): return True for trivial, or an application (f x) + but False for (f x x) + +(NWF1) It's important to float Integer literals, so that they get shared, rather + than being allocated every time round the loop. Hence the litIsTrivial. + + Ditto literal strings (LitString), which we'd like to float to top + level, which is now possible. + +(NWF2) We don’t float out variables applied only to type arguments, since the + extra binding would be pointless: type arguments are completely erased. + But *coercion* arguments aren’t (see Note [Coercion tokens] in + "GHC.CoreToStg" and Note [inlineBoringOk] in"GHC.Core.Unfold"), + so we still want to float out variables applied only to + coercion arguments. + +(NWF3) Some expressions have trivial wrappers: + - Casts (e |> co) + - Unary-class applications: + - Dictionary applications (MkC meth) + - Class-op applictions (op dict) + - Case of empty alts + - Unsafe-equality case + In all these cases we say "not worth floating", and we do so /regardless/ + of the wrapped expression. The SetLevels stuff may subsequently float the + components of the expression. + + Example: is it worth floating (f x |> co)? No! If we did we'd get + lvl = f x |> co + ...lvl.... + Then we'd do cast worker/wrapper and end up with. + lvl' = f x + ...(lvl' |> co)... + Silly! Better not to float it in the first place. If we say "no" here, + we'll subsequently say "yes" for (f x) and get + lvl = f x + ....(lvl |> co)... + which is what we want. In short: don't float trivial wrappers. + +(NWF4) The only non-trivial expression that we say "not worth floating" for + is an application + f x y z + where the number of value arguments is <= the number of abstracted Ids. + This is what makes floating idempotent. Hence counting the number of + value arguments in `go` + +(NWF5) In #24471 we had something like + x1 = I# 1 + ... + x1000 = I# 1000 + foo = f x1 (f x2 (f x3 ....)) + So every sub-expression in `foo` has lots and lots of free variables. But + none of these sub-expressions float anywhere; the entire float-out pass is a + no-op. -************************************************************************ -* * -\subsection{Bindings} -* * -************************************************************************ + So `notWorthFloating` tries to avoid evaluating `n_abs_vars`, in cases where + it obviously /is/ worth floating. (In #24471 it turned out that we were + testing `abs_vars` (a relatively complicated calculation that takes at least + O(n-free-vars) time to compute) for every sub-expression.) -The binding stuff works for top level too. + Hence testing `n_abs_vars only` at the very end. -} +{- ********************************************************************* +* * + Bindings + This binding stuff works for top level too. +* * +********************************************************************* -} + lvlBind :: LevelEnv -> CoreBindWithFVs -> LvlM (LevelledBind, LevelEnv) @@ -1261,7 +1290,7 @@ lvlBind env (AnnNonRec bndr rhs) -- is_bot_lam: looks like (\xy. bot), maybe zero lams -- NB: not isBottomThunk! -- NB: not is_join: don't send bottoming join points to the top. - -- See Note [Bottoming floats] point (3) + -- See Note [Bottoming floats] (BF3) is_top_bindable = exprIsTopLevelBindable deann_rhs bndr_ty n_extra = count isId abs_vars @@ -1552,9 +1581,8 @@ destLevel env fvs fvs_ty is_function is_bot -- See Note [Floating join point bindings] = tOP_LEVEL - | is_bot -- Send bottoming bindings to the top - = as_far_as_poss -- regardless; see Note [Bottoming floats] - -- Esp Bottoming floats (1) and (3) + | is_bot -- Send bottoming bindings to the top regardless; + = as_far_as_poss -- see (BF1) and (BF2) in Note [Bottoming floats] | Just n_args <- floatLams env , n_args > 0 -- n=0 case handled uniformly by the 'otherwise' case @@ -1568,8 +1596,13 @@ destLevel env fvs fvs_ty is_function is_bot max_fv_id_level = maxFvLevel isId env fvs -- Max over Ids only; the -- tyvars will be abstracted + -- as_far_as_poss: destination level depends only on the free Ids (more + -- precisely, free CoVars) of the /type/, not the free Ids of the /term/. + -- Why worry about the free CoVars? See Note [Floating and kind casts] + -- + -- There may be free Ids in the term, but then we'll just + -- lambda-abstract over them as_far_as_poss = maxFvLevel' isId env fvs_ty - -- See Note [Floating and kind casts] {- Note [Floating and kind casts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1732,10 +1765,9 @@ maxFvLevel max_me env var_set -- It's OK to use a non-deterministic fold here because maxIn commutes. maxFvLevel' :: (Var -> Bool) -> LevelEnv -> TyCoVarSet -> Level --- Same but for TyCoVarSet +-- Precisely the same as `maxFvLevel` but for TyCoVarSet rather than DVarSet maxFvLevel' max_me env var_set = nonDetStrictFoldUniqSet (maxIn max_me env) tOP_LEVEL var_set - -- It's OK to use a non-deterministic fold here because maxIn commutes. maxIn :: (Var -> Bool) -> LevelEnv -> InVar -> Level -> Level maxIn max_me (LE { le_lvl_env = lvl_env, le_env = id_env }) in_var lvl ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -801,9 +801,9 @@ makeTrivial env top_lvl dmd occ_fs expr = return (emptyLetFloats, expr) | not (bindingOk top_lvl expr expr_ty) -- Cannot trivialise - = return (emptyLetFloats, expr) -- See Note [Cannot trivialise] + = return (emptyLetFloats, expr) -- See Note [Cannot trivialise] - | otherwise -- 'expr' is not of form (Cast e co) + | otherwise = do { (floats, expr1) <- prepareRhs env top_lvl occ_fs expr ; uniq <- getUniqueM ; let name = mkSystemVarName uniq occ_fs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc27b6c9b536a8200cd2b8750e4744… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc27b6c9b536a8200cd2b8750e4744… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T25975] Fix bytecode generation for `tagToEnum# <LITERAL>`
by Matthew Craven (＠clyring) 18 Apr '25

18 Apr '25

Matthew Craven pushed to branch wip/T25975 at Glasgow Haskell Compiler / GHC Commits: 6cb3e990 by Matthew Craven at 2025-04-18T08:31:11-04:00 Fix bytecode generation for `tagToEnum# <LITERAL>` Fixes #25975. - - - - - 4 changed files: - compiler/GHC/StgToByteCode.hs - + testsuite/tests/bytecode/T25975.hs - + testsuite/tests/bytecode/T25975.stdout - testsuite/tests/bytecode/all.T Changes: ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1801,10 +1801,14 @@ maybe_getCCallReturnRep fn_ty _ -> pprPanic "maybe_getCCallReturn: can't handle:" (pprType fn_ty) -maybe_is_tagToEnum_call :: CgStgExpr -> Maybe (Id, [Name]) +maybe_is_tagToEnum_call :: CgStgExpr -> Maybe (StgArg, [Name]) -- Detect and extract relevant info for the tagToEnum kludge. -maybe_is_tagToEnum_call (StgOpApp (StgPrimOp TagToEnumOp) [StgVarArg v] t) +maybe_is_tagToEnum_call (StgOpApp (StgPrimOp TagToEnumOp) args t) + | [v] <- args = Just (v, extract_constr_Names t) + | otherwise + = pprPanic "StgToByteCode: tagToEnum#" + $ text "Expected exactly one arg, but actual args are:" <+> ppr args where extract_constr_Names ty | rep_ty <- unwrapType ty @@ -1851,13 +1855,13 @@ implement_tagToId :: StackDepth -> Sequel -> BCEnv - -> Id + -> StgArg -> [Name] -> BcM BCInstrList -- See Note [Implementing tagToEnum#] implement_tagToId d s p arg names = assert (notNull names) $ - do (push_arg, arg_bytes) <- pushAtom d p (StgVarArg arg) + do (push_arg, arg_bytes) <- pushAtom d p arg labels <- getLabelsBc (strictGenericLength names) label_fail <- getLabelBc label_exit <- getLabelBc ===================================== testsuite/tests/bytecode/T25975.hs ===================================== @@ -0,0 +1,27 @@ +-- Tests bytecode generation for tagToEnum# applied to literals +{-# LANGUAGE MagicHash #-} +module Main (main) where + +import GHC.Exts + +f1 :: Int# -> Bool +{-# OPAQUE f1 #-} +f1 v = case v of + 4# -> tagToEnum# v + _ -> False + +f2 :: Int# -> Bool +{-# OPAQUE f2 #-} +f2 v = case v of + 5# -> tagToEnum# 6# + _ -> True + +f3 :: Ordering +f3 = tagToEnum# (noinline runRW# (\_ -> 1#)) + + +main :: IO () +main = do + print $ f1 2# + print $ f2 3# + print f3 ===================================== testsuite/tests/bytecode/T25975.stdout ===================================== @@ -0,0 +1,3 @@ +False +True +EQ ===================================== testsuite/tests/bytecode/all.T ===================================== @@ -1,3 +1,7 @@ ghci_dump_bcos = [only_ways(['ghci']), extra_run_opts('-dno-typeable-binds -dsuppress-uniques -ddump-bcos')] test('T23068', ghci_dump_bcos + [filter_stdout_lines(r'.*bitmap: .*')], ghci_script, ['T23068.script']) + +test('T25975', extra_ways(ghci_ways), compile_and_run, + # Some of the examples work more robustly with these flags + ['-fno-break-points -fno-full-laziness']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6cb3e990906148813038a3158076746… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6cb3e990906148813038a3158076746… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/T25975
by Matthew Craven (＠clyring) 18 Apr '25

18 Apr '25

Matthew Craven pushed new branch wip/T25975 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T25975 You're receiving this email because of your account on gitlab.haskell.org.

1 0