May 2025 - ghc-commits

[Git][ghc/ghc][wip/ghc-9.12] 3 commits: Fixes for built-in names (#25182, #25174)
by Ben Gamari (＠bgamari) 07 May '25

07 May '25

Ben Gamari pushed to branch wip/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 - - - - - 7ac61ea6 by Ben Gamari at 2025-05-07T15:13:10+00:00 Bump index-state Allowing splitmix-0.1.1 which is necessary for bootstrapping with GHC 9.12. - - - - - e5301bb6 by Ben Gamari at 2025-05-07T15:13:10+00:00 hadrian: Bump QuickCheck upper bound - - - - - 23 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 - hadrian/cabal.project - hadrian/hadrian.cabal - 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 ===================================== hadrian/cabal.project ===================================== @@ -4,7 +4,7 @@ packages: ./ -- This essentially freezes the build plan for hadrian -- It would be wise to keep this up to date with the state set in .gitlab/ci.sh. -index-state: 2024-10-30T22:56:00Z +index-state: 2025-03-18T00:00:00Z -- unordered-containers-0.2.20-r1 requires template-haskell < 2.22 -- ghc-9.10 has template-haskell-2.22.0.0 ===================================== hadrian/hadrian.cabal ===================================== @@ -191,4 +191,4 @@ executable hadrian if flag(selftest) other-modules: Rules.Selftest cpp-options: -DHADRIAN_ENABLE_SELFTEST - build-depends: QuickCheck >= 2.6 && < 2.15 + build-depends: QuickCheck >= 2.6 && < 2.16 ===================================== 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/-/compare/e24ac496d08762fbcf309b64cdb827… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e24ac496d08762fbcf309b64cdb827… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/T25992
by Simon Peyton Jones (＠simonpj) 07 May '25

07 May '25

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

1 0

[Git][ghc/ghc][wip/fendor/ghci-multiple-home-units] 2 commits: Make GHCi commands compatible with multiple home units
by Hannes Siebenhandl (＠fendor) 07 May '25

07 May '25

Hannes Siebenhandl pushed to branch wip/fendor/ghci-multiple-home-units at Glasgow Haskell Compiler / GHC Commits: 6be2bb45 by fendor at 2025-05-07T13:08:47+02:00 Make GHCi commands compatible with multiple home units FIXME: proper commit message There is one metric increase in this commit: ------------------------- Metric Increase: T4029 ------------------------- It is an increase from 14.4 MB to 16.1 MB (+11.8%) which sounds like a pretty big regression at first. However, we argue this increase is solely caused by using more data structures for managing multiple home units in the GHCi session. In particular, due to the design decision of using three home units, the base memory usage increases... but by how much? A big contributor is the `UnitState`, of which we have three now, which on its own 260 KB per instance. That makes an additional memory usage of 520 KB, already explaining a third of the overall memory usage increase. FIXME: re-investigate what the remaining 1 MB is. - - - - - ad457f02 by fendor at 2025-05-07T13:08:47+02:00 FIXME: this test case can be fixed by exploiting internals - - - - - 47 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Runtime/Context.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Types/Name/Ppr.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Home/Graph.hs - compiler/GHC/Unit/Types.hs - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - ghc/GHCi/UI/Monad.hs - ghc/Main.hs - testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout - testsuite/tests/driver/T8526/T8526.stdout - testsuite/tests/driver/fat-iface/fat014.stdout - testsuite/tests/driver/multipleHomeUnits/multiGHCi.stderr - testsuite/tests/ghc-api/T6145.hs - testsuite/tests/ghc-api/annotations-literals/literals.hs - testsuite/tests/ghc-api/annotations-literals/parsed.hs - testsuite/tests/ghc-api/apirecomp001/myghc.hs - testsuite/tests/ghc-api/fixed-nodes/T1.hs - testsuite/tests/ghci.debugger/scripts/break031/all.T - testsuite/tests/ghci/linking/dyn/T3372.hs - testsuite/tests/ghci/prog010/ghci.prog010.script - testsuite/tests/ghci/prog018/prog018.stdout - testsuite/tests/ghci/scripts/T13869.stdout - testsuite/tests/ghci/scripts/T13997.stdout - testsuite/tests/ghci/scripts/T17669.stdout - testsuite/tests/ghci/scripts/T18330.stdout - testsuite/tests/ghci/scripts/T1914.stdout - testsuite/tests/ghci/scripts/T20217.stdout - testsuite/tests/ghci/scripts/T20587.stdout - testsuite/tests/ghci/scripts/T21110.stderr - testsuite/tests/ghci/scripts/T6105.stdout - testsuite/tests/ghci/scripts/T8042.stdout - testsuite/tests/ghci/scripts/T8042recomp.stdout - testsuite/tests/ghci/scripts/ghci024.stdout - testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 - testsuite/tests/ghci/scripts/ghci058.script - testsuite/tests/ghci/should_run/TopEnvIface.stdout - testsuite/tests/quasiquotation/T7918.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d092d80b1306f6ede52b9e56d067b7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d092d80b1306f6ede52b9e56d067b7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T25974] 4 commits: Refactor mkTopLevImportedEnv out of mkTopLevEnv
by Serge S. Gulin (＠gulin.serge) 07 May '25

07 May '25

Serge S. Gulin pushed to branch wip/T25974 at Glasgow Haskell Compiler / GHC Commits: e46c6b18 by Rodrigo Mesquita at 2025-05-06T09:01:57-04:00 Refactor mkTopLevImportedEnv out of mkTopLevEnv This makes the code clearer and allows the top-level import context to be fetched directly from the HomeModInfo through the API (e.g. useful for the debugger). - - - - - 0ce0d263 by Rodrigo Mesquita at 2025-05-06T09:01:57-04:00 Export sizeOccEnv from GHC.Types.Name.Occurrence Counts the number of OccNames in an OccEnv - - - - - 165f98d8 by Simon Peyton Jones at 2025-05-06T09:02:39-04:00 Fix a bad untouchability bug im simplifyInfer This patch addresses #26004. The root cause was that simplifyInfer was willing to unify variables "far out". The fix, in runTcSWithEvBinds', is to initialise the inert set given-eq level with the current level. See (TGE6) in Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet Two loosely related refactors: * Refactored approximateWCX to return just the free type variables of the un-quantified constraints. That avoids duplication of work (these free vars are needed in simplifyInfer) and makes it clearer that the constraints themselves are irrelevant. * A little local refactor of TcSMode, which reduces the number of parameters to runTcSWithEvBinds - - - - - eea552e1 by Serge S. Gulin at 2025-05-07T10:14:07+03:00 Add Wine support - - - - - 21 changed files: - .gitignore - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - boot - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Types/Name/Occurrence.hs - configure.ac - hadrian/src/Builder.hs - hadrian/src/Rules/BinaryDist.hs - libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc - m4/find_merge_objects.m4 - m4/fp_setup_windows_toolchain.m4 - + testsuite/tests/typecheck/should_fail/T26004.hs - + testsuite/tests/typecheck/should_fail/T26004.stderr - testsuite/tests/typecheck/should_fail/T7453.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== .gitignore ===================================== @@ -256,3 +256,6 @@ ghc.nix/ # clangd .clangd dist-newstyle/ + +# .gitlab/ci.sh for HERMETIC=1 +cabal/* ===================================== .gitlab/ci.sh ===================================== @@ -75,6 +75,15 @@ Environment variables affecting both build systems: NIX_SYSTEM On Darwin, the target platform of the desired toolchain (either "x86-64-darwin" or "aarch-darwin") NO_BOOT Whether to run ./boot or not, used when testing the source dist + TOOLCHAIN_SOURCE Select a source of toolchain. Possible values: + - "env": Toolchains are included in the Docker image via environment + variables. Default for Linux. + - "nix": Toolchains are provided via .gitlab/darwin/toolchain.nix. + Default for Darwin. + - "extracted": + Toolchains will be downloaded and extracted through the + CI process. Default for other systems. Windows and FreeBSD + are included. Environment variables determining build configuration of Hadrian system: @@ -83,14 +92,14 @@ Environment variables determining build configuration of Hadrian system: This tests the "reinstall" configuration CROSS_EMULATOR The emulator to use for testing of cross-compilers. -Environment variables determining bootstrap toolchain (Linux): +Environment variables determining bootstrap toolchain (TOOLCHAIN_SOURCE=env): GHC Path of GHC executable to use for bootstrapping. CABAL Path of cabal-install executable to use for bootstrapping. ALEX Path of alex executable to use for bootstrapping. HAPPY Path of alex executable to use for bootstrapping. -Environment variables determining bootstrap toolchain (non-Linux): +Environment variables determining bootstrap toolchain (TOOLCHAIN_SOURCE=extracted): GHC_VERSION Which GHC version to fetch for bootstrapping. CABAL_INSTALL_VERSION @@ -135,7 +144,9 @@ function mingw_init() { case "$MSYSTEM" in CLANG64) target_triple="x86_64-unknown-mingw32" - boot_triple="x86_64-unknown-mingw32" # triple of bootstrap GHC + ;; + CLANGARM64) + target_triple="aarch64-unknown-mingw32" ;; *) fail "win32-init: Unknown MSYSTEM $MSYSTEM" @@ -150,10 +161,19 @@ function mingw_init() { MINGW_MOUNT_POINT="${MINGW_PREFIX}" PATH="$MINGW_MOUNT_POINT/bin:$PATH" - # We always use mingw64 Python to avoid path length issues like #17483. - export PYTHON="/mingw64/bin/python3" - # And need to use sphinx-build from the environment - export SPHINXBUILD="/mingw64/bin/sphinx-build.exe" + case "$MSYSTEM" in + CLANGARM64) + # At MSYS for ARM64 we force to use their special versions to speedup the compiler step + export PYTHON="/clangarm64/bin/python3" + export SPHINXBUILD="/clangarm64/bin/sphinx-build.exe" + ;; + *) + # We always use mingw64 Python to avoid path length issues like #17483. + export PYTHON="/mingw64/bin/python3" + # And need to use sphinx-build from the environment + export SPHINXBUILD="/mingw64/bin/sphinx-build.exe" + ;; + esac } # This will contain GHC's local native toolchain @@ -178,15 +198,21 @@ function show_tool() { } function set_toolchain_paths() { - case "$(uname -m)-$(uname)" in - # Linux toolchains are included in the Docker image - *-Linux) toolchain_source="env" ;; - # Darwin toolchains are provided via .gitlab/darwin/toolchain.nix - *-Darwin) toolchain_source="nix" ;; - *) toolchain_source="extracted" ;; - esac + if [ -z "${TOOLCHAIN_SOURCE:-}" ] + then + # Fallback to automatic detection which could not work for cases + # when cross compiler will be build at Windows environment + # and requires a special mingw compiler (not bundled) + case "$(uname -m)-$(uname)" in + # Linux toolchains are included in the Docker image + *-Linux) TOOLCHAIN_SOURCE="env" ;; + # Darwin toolchains are provided via .gitlab/darwin/toolchain.nix + *-Darwin) TOOLCHAIN_SOURCE="nix" ;; + *) TOOLCHAIN_SOURCE="extracted" ;; + esac + fi - case "$toolchain_source" in + case "$TOOLCHAIN_SOURCE" in extracted) # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" @@ -217,7 +243,7 @@ function set_toolchain_paths() { : ${HAPPY:=$(which happy)} : ${ALEX:=$(which alex)} ;; - *) fail "bad toolchain_source" + *) fail "bad TOOLCHAIN_SOURCE" esac export GHC @@ -247,7 +273,7 @@ function setup() { cp -Rf "$CABAL_CACHE"/* "$CABAL_DIR" fi - case $toolchain_source in + case $TOOLCHAIN_SOURCE in extracted) time_it "setup" setup_toolchain ;; *) ;; esac @@ -273,14 +299,37 @@ function setup() { } function fetch_ghc() { - if [ ! -e "$GHC" ]; then - local v="$GHC_VERSION" + local boot_triple_to_fetch + case "$(uname)" in + MSYS_*|MINGW*) + case "$MSYSTEM" in + CLANG64) + boot_triple_to_fetch="x86_64-unknown-mingw32" # triple of bootstrap GHC + ;; + *) + fail "win32-init: Unknown MSYSTEM $MSYSTEM" + ;; + esac + ;; + Darwin) + boot_triple_to_fetch="x86_64-apple-darwin" + ;; + FreeBSD) + boot_triple_to_fetch="x86_64-portbld-freebsd" + ;; + Linux) + ;; + *) fail "uname $(uname) is not supported by ghc boot fetch" ;; + esac + readonly boot_triple_to_fetch + + local -r v="$GHC_VERSION" if [[ -z "$v" ]]; then fail "neither GHC nor GHC_VERSION are not set" fi start_section "fetch GHC" - url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot…" + url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot…" info "Fetching GHC binary distribution from $url..." curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution" $TAR -xJf ghc.tar.xz || fail "failed to extract GHC binary distribution" @@ -297,8 +346,6 @@ function fetch_ghc() { esac rm -Rf "ghc-${GHC_VERSION}" ghc.tar.xz end_section "fetch GHC" - fi - } function fetch_cabal() { @@ -349,7 +396,10 @@ function fetch_cabal() { # here. For Docker platforms this is done in the Docker image # build. function setup_toolchain() { + if [ ! -e "$GHC" ]; then fetch_ghc + fi + fetch_cabal cabal_update @@ -405,6 +455,17 @@ function configure() { if [[ -n "${target_triple:-}" ]]; then args+=("--target=$target_triple") fi + if [[ "${TOOLCHAIN_SOURCE:-}" =~ "extracted" ]]; then + # To extract something need download something first. + args+=("--enable-tarballs-autodownload") + else + # For Windows we should explicitly --enable-distro-toolchain + # if i.e. we decided to use TOOLCHAIN_SOURCE = env + case "$(uname)" in + MSYS_*|MINGW*) args+=("--enable-distro-toolchain") ;; + *) ;; + esac + fi if [[ -n "${ENABLE_NUMA:-}" ]]; then args+=("--enable-numa") else @@ -421,7 +482,6 @@ function configure() { # See https://stackoverflow.com/questions/7577052 for a rationale for the # args[@] symbol-soup below. run ${CONFIGURE_WRAPPER:-} ./configure \ - --enable-tarballs-autodownload \ "${args[@]+"${args[@]}"}" \ GHC="$GHC" \ || ( cat config.log; fail "configure failed" ) @@ -562,12 +622,35 @@ function install_bindist() { read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" if [[ "${CROSS_TARGET:-no_cross_target}" =~ "mingw" ]]; then - # We suppose that host target = build target. + # We assume that BUILD=HOST. # By the fact above it is clearly turning out which host value is # for currently built compiler. # The fix for #21970 will probably remove this if-branch. - local -r CROSS_HOST_GUESS=$($SHELL ./config.guess) - args+=( "--target=$CROSS_TARGET" "--host=$CROSS_HOST_GUESS" ) + # Modifications are needed due of reasons like See Note [Wide Triple Windows]. + + local -r cross_host_triple_guess_origin=$($SHELL ./config.guess) + + # We expect here to have (x86_64|aarch64) + local -r cross_host_triple_guess_arch=$(echo "${cross_host_triple_guess_origin}" | cut -d'-' -f1) + + # Expect to have (apple|unknown) + local -r cross_host_triple_guess_vendor=$(echo "${cross_host_triple_guess_origin}" \ + `# "pc" should be converted to unknown for all supported platforms by GHC` \ + | sed -e "s/-pc-/-unknown-/" | cut -d'-' -f2) + + # 3,4 because it might contain a dash, expect to have (linux-gnu|mingw32|darwin) + local -r cross_host_triple_guess_os=$(echo "${cross_host_triple_guess_origin}" | cut -d'-' -f3,4 \ + `# GHC treats mingw64 as mingw32, so, we need hide this difference` \ + | sed -e "s/mingw.*/mingw32/" \ + `# config.guess may return triple with a release number, i.e. for darwin: aarch64-apple-darwin24.4.0` \ + | sed -e "s/darwin.*/darwin/" \ + | sed -e "s/freebsd.*/freebsd/" \ + ) + + local -r cross_host_triple_guess="$cross_host_triple_guess_arch-$cross_host_triple_guess_vendor-$cross_host_triple_guess_os" + echo "Convert guessed triple ${cross_host_triple_guess_origin} to GHC-compatible: ${cross_host_triple_guess}" + + args+=( "--target=$CROSS_TARGET" "--host=$cross_host_triple_guess" ) # FIXME: The bindist configure script shouldn't need to be reminded of # the target platform. See #21970. @@ -946,10 +1029,12 @@ esac MAKE="make" TAR="tar" case "$(uname)" in - MSYS_*|MINGW*) mingw_init ;; - Darwin) boot_triple="x86_64-apple-darwin" ;; + MSYS_*|MINGW*) + mingw_init + ;; + Darwin) + ;; FreeBSD) - boot_triple="x86_64-portbld-freebsd" MAKE="gmake" TAR="gtar" ;; ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -1302,17 +1302,21 @@ cross_jobs = [ . setVariable "WindresCmd" (llvm_prefix ++ "windres") . setVariable "LLVMAS" (llvm_prefix ++ "clang") . setVariable "LD" (llvm_prefix ++ "ld") + -- See Note [Empty MergeObjsCmd] -- Windows target require to make linker merge feature check disabled. . setVariable "MergeObjsCmd" "" + -- Note [Wide Triple Windows] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- LLVM MinGW Linux Toolchain expects to recieve "aarch64-w64-mingw32" -- as a triple but we use more common "aarch64-unknown-mingw32". - -- Due of this we need configure ld manually for clang beacause + -- Due of this we need configure ld manually for clang because -- it will use system's ld otherwise when --target will be specified to -- unexpected triple. . setVariable "CFLAGS" cflags . setVariable "CONF_CC_OPTS_STAGE2" cflags ) where llvm_prefix = "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-" + -- See Note [Windows Toolchain Standard Library Options] cflags = "-fuse-ld=" ++ llvm_prefix ++ "ld --rtlib=compiler-rt" winAarch64Config = (crossConfig "aarch64-unknown-mingw32" (Emulator "/opt/wine-arm64ec-msys2-deb12/bin/wine") Nothing) ===================================== boot ===================================== @@ -52,6 +52,8 @@ def autoreconf(): # Run autoreconf on everything that needs it. processes = {} if os.name == 'nt': + # Note [ACLOCAL_PATH for Windows] + # ~~~~~~~~~~~~~~~~~~~~~~~~~ # Get the normalized ACLOCAL_PATH for Windows # This is necessary since on Windows this will be a Windows # path, which autoreconf doesn't know doesn't know how to handle. ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -64,7 +64,7 @@ import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim import GHC.Tc.Solver.InertSet (InertSet, emptyInert) -import GHC.Tc.Utils.TcType (isStringTy) +import GHC.Tc.Utils.TcType (isStringTy, topTcLevel) import GHC.Types.CompleteMatch import GHC.Types.SourceText (SourceText(..), mkFractionalLit, FractionalLit , fractionalLitFromRational @@ -129,7 +129,7 @@ instance Outputable TyState where ppr (TySt n inert) = ppr n <+> ppr inert initTyState :: TyState -initTyState = TySt 0 emptyInert +initTyState = TySt 0 (emptyInert topTcLevel) -- | The term oracle state. Stores 'VarInfo' for encountered 'Id's. These -- entries are possibly shared when we figure out that two variables must be ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -23,7 +23,7 @@ module GHC.Runtime.Eval ( setupBreakpoint, back, forward, setContext, getContext, - mkTopLevEnv, + mkTopLevEnv, mkTopLevImportedEnv, getNamesInScope, getRdrNamesInScope, moduleIsInterpreted, @@ -836,29 +836,36 @@ mkTopLevEnv hsc_env modl Nothing -> pure $ Left "not a home module" Just details -> case mi_top_env (hm_iface details) of - (IfaceTopEnv exports imports) -> do - imports_env <- - runInteractiveHsc hsc_env - $ ioMsgMaybe $ hoistTcRnMessage $ runTcInteractive hsc_env - $ fmap (foldr plusGlobalRdrEnv emptyGlobalRdrEnv) - $ forM imports $ \iface_import -> do - let ImpUserSpec spec details = tcIfaceImport iface_import - iface <- loadInterfaceForModule (text "imported by GHCi") (is_mod spec) - pure $ case details of - ImpUserAll -> importsFromIface hsc_env iface spec Nothing - ImpUserEverythingBut ns -> importsFromIface hsc_env iface spec (Just ns) - ImpUserExplicit x _parents_of_implicits -> - -- TODO: Not quite right, is_explicit should refer to whether the user wrote A(..) or A(x,y). - -- It is only used for error messages. It seems dubious even to add an import context to these GREs as - -- they are not "imported" into the top-level scope of the REPL. I changed this for now so that - -- the test case produce the same output as before. - let spec' = ImpSpec { is_decl = spec, is_item = ImpSome { is_explicit = True, is_iloc = noSrcSpan } } - in mkGlobalRdrEnv $ gresFromAvails hsc_env (Just spec') x + (IfaceTopEnv exports _imports) -> do + imports_env <- mkTopLevImportedEnv hsc_env details let exports_env = mkGlobalRdrEnv $ gresFromAvails hsc_env Nothing (getDetOrdAvails exports) pure $ Right $ plusGlobalRdrEnv imports_env exports_env where hpt = hsc_HPT hsc_env +-- | Make the top-level environment with all bindings imported by this module. +-- Exported bindings from this module are not included in the result. +mkTopLevImportedEnv :: HscEnv -> HomeModInfo -> IO GlobalRdrEnv +mkTopLevImportedEnv hsc_env details = do + runInteractiveHsc hsc_env + $ ioMsgMaybe $ hoistTcRnMessage $ runTcInteractive hsc_env + $ fmap (foldr plusGlobalRdrEnv emptyGlobalRdrEnv) + $ forM imports $ \iface_import -> do + let ImpUserSpec spec details = tcIfaceImport iface_import + iface <- loadInterfaceForModule (text "imported by GHCi") (is_mod spec) + pure $ case details of + ImpUserAll -> importsFromIface hsc_env iface spec Nothing + ImpUserEverythingBut ns -> importsFromIface hsc_env iface spec (Just ns) + ImpUserExplicit x _parents_of_implicits -> + -- TODO: Not quite right, is_explicit should refer to whether the user wrote A(..) or A(x,y). + -- It is only used for error messages. It seems dubious even to add an import context to these GREs as + -- they are not "imported" into the top-level scope of the REPL. I changed this for now so that + -- the test case produce the same output as before. + let spec' = ImpSpec { is_decl = spec, is_item = ImpSome { is_explicit = True, is_iloc = noSrcSpan } } + in mkGlobalRdrEnv $ gresFromAvails hsc_env (Just spec') x + where + IfaceTopEnv _ imports = mi_top_env (hm_iface details) + -- | Get the interactive evaluation context, consisting of a pair of the -- set of modules from which we take the full top-level scope, and the set -- of modules from which we take just the exports respectively. ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -915,21 +915,22 @@ simplifyInfer top_lvl rhs_tclvl infer_mode sigs name_taus wanteds ; let psig_theta = concatMap sig_inst_theta partial_sigs -- First do full-blown solving - -- NB: we must gather up all the bindings from doing - -- this solving; hence (runTcSWithEvBinds ev_binds_var). - -- And note that since there are nested implications, - -- calling solveWanteds will side-effect their evidence - -- bindings, so we can't just revert to the input - -- constraint. - + -- NB: we must gather up all the bindings from doing this solving; hence + -- (runTcSWithEvBinds ev_binds_var). And note that since there are + -- nested implications, calling solveWanteds will side-effect their + -- evidence bindings, so we can't just revert to the input constraint. + -- + -- See also Note [Inferring principal types] ; ev_binds_var <- TcM.newTcEvBinds ; psig_evs <- newWanteds AnnOrigin psig_theta ; wanted_transformed - <- setTcLevel rhs_tclvl $ - runTcSWithEvBinds ev_binds_var $ + <- runTcSWithEvBinds ev_binds_var $ + setTcLevelTcS rhs_tclvl $ solveWanteds (mkSimpleWC psig_evs `andWC` wanteds) + -- setLevelTcS: we do setLevel /inside/ the runTcS, so that + -- we initialise the InertSet inert_given_eq_lvl as far + -- out as possible, maximising oppportunities to unify -- psig_evs : see Note [Add signature contexts as wanteds] - -- See Note [Inferring principal types] -- Find quant_pred_candidates, the predicates that -- we'll consider quantifying over @@ -1430,13 +1431,15 @@ decideAndPromoteTyVars top_lvl rhs_tclvl infer_mode name_taus psigs wanted -- Step 1 of Note [decideAndPromoteTyVars] -- Get candidate constraints, decide which we can potentially quantify - (can_quant_cts, no_quant_cts) = approximateWCX wanted + -- The `no_quant_tvs` are free in constraints we can't quantify. + (can_quant_cts, no_quant_tvs) = approximateWCX False wanted can_quant = ctsPreds can_quant_cts - no_quant = ctsPreds no_quant_cts + can_quant_tvs = tyCoVarsOfTypes can_quant -- Step 2 of Note [decideAndPromoteTyVars] -- Apply the monomorphism restriction (post_mr_quant, mr_no_quant) = applyMR dflags infer_mode can_quant + mr_no_quant_tvs = tyCoVarsOfTypes mr_no_quant -- The co_var_tvs are tvs mentioned in the types of covars or -- coercion holes. We can't quantify over these covars, so we @@ -1448,30 +1451,33 @@ decideAndPromoteTyVars top_lvl rhs_tclvl infer_mode name_taus psigs wanted ++ tau_tys ++ post_mr_quant) co_var_tvs = closeOverKinds co_vars - -- outer_tvs are mentioned in `wanted, and belong to some outer level. + -- outer_tvs are mentioned in `wanted`, and belong to some outer level. -- We definitely can't quantify over them outer_tvs = outerLevelTyVars rhs_tclvl $ - tyCoVarsOfTypes can_quant `unionVarSet` tyCoVarsOfTypes no_quant + can_quant_tvs `unionVarSet` no_quant_tvs - -- Step 3 of Note [decideAndPromoteTyVars] + -- Step 3 of Note [decideAndPromoteTyVars], (a-c) -- Identify mono_tvs: the type variables that we must not quantify over + -- At top level we are much less keen to create mono tyvars, to avoid + -- spooky action at a distance. mono_tvs_without_mr - | is_top_level = outer_tvs - | otherwise = outer_tvs -- (a) - `unionVarSet` tyCoVarsOfTypes no_quant -- (b) - `unionVarSet` co_var_tvs -- (c) + | is_top_level = outer_tvs -- See (DP2) + | otherwise = outer_tvs -- (a) + `unionVarSet` no_quant_tvs -- (b) + `unionVarSet` co_var_tvs -- (c) + -- Step 3 of Note [decideAndPromoteTyVars], (d) mono_tvs_with_mr = -- Even at top level, we don't quantify over type variables -- mentioned in constraints that the MR tells us not to quantify -- See Note [decideAndPromoteTyVars] (DP2) - mono_tvs_without_mr `unionVarSet` tyCoVarsOfTypes mr_no_quant + mono_tvs_without_mr `unionVarSet` mr_no_quant_tvs -------------------------------------------------------------------- -- Step 4 of Note [decideAndPromoteTyVars] -- Use closeWrtFunDeps to find any other variables that are determined by mono_tvs - add_determined tvs = closeWrtFunDeps post_mr_quant tvs - `delVarSetList` psig_qtvs + add_determined tvs preds = closeWrtFunDeps preds tvs + `delVarSetList` psig_qtvs -- Why delVarSetList psig_qtvs? -- If the user has explicitly asked for quantification, then that -- request "wins" over the MR. @@ -1480,8 +1486,8 @@ decideAndPromoteTyVars top_lvl rhs_tclvl infer_mode name_taus psigs wanted -- (i.e. says "no" to isQuantifiableTv)? That's OK: explanation -- in Step 2 of Note [Deciding quantification]. - mono_tvs_with_mr_det = add_determined mono_tvs_with_mr - mono_tvs_without_mr_det = add_determined mono_tvs_without_mr + mono_tvs_with_mr_det = add_determined mono_tvs_with_mr post_mr_quant + mono_tvs_without_mr_det = add_determined mono_tvs_without_mr can_quant -------------------------------------------------------------------- -- Step 5 of Note [decideAndPromoteTyVars] @@ -1518,7 +1524,7 @@ decideAndPromoteTyVars top_lvl rhs_tclvl infer_mode name_taus psigs wanted , text "newly_mono_tvs =" <+> ppr newly_mono_tvs , text "can_quant =" <+> ppr can_quant , text "post_mr_quant =" <+> ppr post_mr_quant - , text "no_quant =" <+> ppr no_quant + , text "no_quant_tvs =" <+> ppr no_quant_tvs , text "mr_no_quant =" <+> ppr mr_no_quant , text "final_quant =" <+> ppr final_quant , text "co_vars =" <+> ppr co_vars ] @@ -1605,8 +1611,8 @@ The plan The body of z tries to unify the type of x (call it alpha[1]) with (beta[2] -> gamma[2]). This unification fails because alpha is untouchable, leaving [W] alpha[1] ~ (beta[2] -> gamma[2]) - We need to know not to quantify over beta or gamma, because they are in the - equality constraint with alpha. Actual test case: typecheck/should_compile/tc213 + We don't want to quantify over beta or gamma because they are fixed by alpha, + which is monomorphic. Actual test case: typecheck/should_compile/tc213 Another example. Suppose we have class C a b | a -> b @@ -1643,9 +1649,22 @@ Wrinkles promote type variables. But for bindings affected by the MR we have no choice but to promote. + An example is in #26004. + f w e = case e of + T1 -> let y = not w in False + T2 -> True + When generalising `f` we have a constraint + forall. (a ~ Bool) => alpha ~ Bool + where our provisional type for `f` is `f :: T alpha -> blah`. + In a /nested/ setting, we might simply not-generalise `f`, hoping to learn + about `alpha` from f's call sites (test T5266b is an example). But at top + level, to avoid spooky action at a distance. + Note [The top-level Any principle] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Key principle: we never want to show the programmer a type with `Any` in it. +Key principles: + * we never want to show the programmer a type with `Any` in it. + * avoid "spooky action at a distance" and silent defaulting Most /top level/ bindings have a type signature, so none of this arises. But where a top-level binding lacks a signature, we don't want to infer a type like @@ -1654,11 +1673,18 @@ and then subsequently default alpha[0]:=Any. Exposing `Any` to the user is bad bad bad. Better to report an error, which is what may well happen if we quantify over alpha instead. +Moreover, + * If (elsewhere in this module) we add a call to `f`, say (f True), then + `f` will get the type `Bool -> Int` + * If we add /another/ call, say (f 'x'), we will then get a type error. + * If we have no calls, the final exported type of `f` may get set by + defaulting, and might not be principal (#26004). + For /nested/ bindings, a monomorphic type like `f :: alpha[0] -> Int` is fine, because we can see all the call sites of `f`, and they will probably fix `alpha`. In contrast, we can't see all of (or perhaps any of) the calls of top-level (exported) functions, reducing the worries about "spooky action at a -distance". +distance". This also moves in the direction of `MonoLocalBinds`, which we like. Note [Do not quantify over constraints that determine a variable] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -374,20 +374,20 @@ instance Outputable InertSet where where dicts = bagToList (dictsToBag solved_dicts) -emptyInertCans :: InertCans -emptyInertCans +emptyInertCans :: TcLevel -> InertCans +emptyInertCans given_eq_lvl = IC { inert_eqs = emptyTyEqs , inert_funeqs = emptyFunEqs - , inert_given_eq_lvl = topTcLevel + , inert_given_eq_lvl = given_eq_lvl , inert_given_eqs = False , inert_dicts = emptyDictMap , inert_safehask = emptyDictMap , inert_insts = [] , inert_irreds = emptyBag } -emptyInert :: InertSet -emptyInert - = IS { inert_cans = emptyInertCans +emptyInert :: TcLevel -> InertSet +emptyInert given_eq_lvl + = IS { inert_cans = emptyInertCans given_eq_lvl , inert_cycle_breakers = emptyBag :| [] , inert_famapp_cache = emptyFunEqs , inert_solved_dicts = emptyDictMap } @@ -678,6 +678,23 @@ should update inert_given_eq_lvl? imply nominal ones. For example, if (G a ~R G b) and G's argument's role is nominal, then we can deduce a ~N b. +(TGE6) A subtle point is this: when initialising the solver, giving it + an empty InertSet, we must conservatively initialise `inert_given_lvl` + to the /current/ TcLevel. This matters when doing let-generalisation. + Consider #26004: + f w e = case e of + T1 -> let y = not w in False -- T1 is a GADT + T2 -> True + When let-generalising `y`, we will have (w :: alpha[1]) in the type + envt; and we are under GADT pattern match. So when we solve the + constraints from y's RHS, in simplifyInfer, we must NOT unify + alpha[1] := Bool + Since we don't know what enclosing equalities there are, we just + conservatively assume that there are some. + + This initialisation in done in `runTcSWithEvBinds`, which passes + the current TcLevl to `emptyInert`. + Historical note: prior to #24938 we also ignored Given equalities that did not mention an "outer" type variable. But that is wrong, as #24938 showed. Another example is immortalised in test LocalGivenEqs2 ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Tc.Solver.Monad ( runTcSSpecPrag, failTcS, warnTcS, addErrTcS, wrapTcS, ctLocWarnTcS, runTcSEqualities, - nestTcS, nestImplicTcS, setEvBindsTcS, + nestTcS, nestImplicTcS, setEvBindsTcS, setTcLevelTcS, emitImplicationTcS, emitTvImplicationTcS, emitImplication, emitFunDepWanteds, @@ -947,8 +947,9 @@ added. This is initialised from the innermost implication constraint. -- | See Note [TcSMode] data TcSMode = TcSVanilla -- ^ Normal constraint solving + | TcSPMCheck -- ^ Used when doing patterm match overlap checks | TcSEarlyAbort -- ^ Abort early on insoluble constraints - | TcSSpecPrag -- ^ Fully solve all constraints + | TcSSpecPrag -- ^ Fully solve all constraints deriving (Eq) {- Note [TcSMode] @@ -957,6 +958,11 @@ The constraint solver can operate in different modes: * TcSVanilla: Normal constraint solving mode. This is the default. +* TcSPMCheck: Used by the pattern match overlap checker. + Like TcSVanilla, but the idea is that the returned InertSet will + later be resumed, so we do not want to restore type-equality cycles + See also Note [Type equality cycles] in GHC.Tc.Solver.Equality + * TcSEarlyAbort: Abort (fail in the monad) as soon as we come across an insoluble constraint. This is used to fail-fast when checking for hole-fits. See Note [Speeding up valid hole-fits]. @@ -1135,7 +1141,7 @@ runTcS tcs runTcSEarlyAbort :: TcS a -> TcM a runTcSEarlyAbort tcs = do { ev_binds_var <- TcM.newTcEvBinds - ; runTcSWithEvBinds' True TcSEarlyAbort ev_binds_var tcs } + ; runTcSWithEvBinds' TcSEarlyAbort ev_binds_var tcs } -- | Run the 'TcS' monad in 'TcSSpecPrag' mode, which either fully solves -- individual Wanted quantified constraints or leaves them alone. @@ -1143,7 +1149,7 @@ runTcSEarlyAbort tcs -- See Note [TcSSpecPrag]. runTcSSpecPrag :: EvBindsVar -> TcS a -> TcM a runTcSSpecPrag ev_binds_var tcs - = runTcSWithEvBinds' True TcSSpecPrag ev_binds_var tcs + = runTcSWithEvBinds' TcSSpecPrag ev_binds_var tcs {- Note [TcSSpecPrag] ~~~~~~~~~~~~~~~~~~~~~ @@ -1200,7 +1206,7 @@ runTcSEqualities thing_inside runTcSInerts :: InertSet -> TcS a -> TcM (a, InertSet) runTcSInerts inerts tcs = do ev_binds_var <- TcM.newTcEvBinds - runTcSWithEvBinds' False TcSVanilla ev_binds_var $ do + runTcSWithEvBinds' TcSPMCheck ev_binds_var $ do setInertSet inerts a <- tcs new_inerts <- getInertSet @@ -1209,21 +1215,23 @@ runTcSInerts inerts tcs = do runTcSWithEvBinds :: EvBindsVar -> TcS a -> TcM a -runTcSWithEvBinds = runTcSWithEvBinds' True TcSVanilla +runTcSWithEvBinds = runTcSWithEvBinds' TcSVanilla -runTcSWithEvBinds' :: Bool -- True <=> restore type equality cycles - -- Don't if you want to reuse the InertSet. - -- See also Note [Type equality cycles] - -- in GHC.Tc.Solver.Equality - -> TcSMode +runTcSWithEvBinds' :: TcSMode -> EvBindsVar -> TcS a -> TcM a -runTcSWithEvBinds' restore_cycles mode ev_binds_var tcs +runTcSWithEvBinds' mode ev_binds_var tcs = do { unified_var <- TcM.newTcRef 0 - ; step_count <- TcM.newTcRef 0 - ; inert_var <- TcM.newTcRef emptyInert - ; wl_var <- TcM.newTcRef emptyWorkList + ; step_count <- TcM.newTcRef 0 + + -- Make a fresh, empty inert set + -- Subtle point: see (TGE6) in Note [Tracking Given equalities] + -- in GHC.Tc.Solver.InertSet + ; tc_lvl <- TcM.getTcLevel + ; inert_var <- TcM.newTcRef (emptyInert tc_lvl) + + ; wl_var <- TcM.newTcRef emptyWorkList ; unif_lvl_var <- TcM.newTcRef Nothing ; let env = TcSEnv { tcs_ev_binds = ev_binds_var , tcs_unified = unified_var @@ -1240,9 +1248,13 @@ runTcSWithEvBinds' restore_cycles mode ev_binds_var tcs ; when (count > 0) $ csTraceTcM $ return (text "Constraint solver steps =" <+> int count) - ; when restore_cycles $ - do { inert_set <- TcM.readTcRef inert_var - ; restoreTyVarCycles inert_set } + -- Restore tyvar cycles: see Note [Type equality cycles] in + -- GHC.Tc.Solver.Equality + -- But /not/ in TCsPMCheck mode: see Note [TcSMode] + ; case mode of + TcSPMCheck -> return () + _ -> do { inert_set <- TcM.readTcRef inert_var + ; restoreTyVarCycles inert_set } #if defined(DEBUG) ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var @@ -1284,6 +1296,10 @@ setEvBindsTcS :: EvBindsVar -> TcS a -> TcS a setEvBindsTcS ref (TcS thing_inside) = TcS $ \ env -> thing_inside (env { tcs_ev_binds = ref }) +setTcLevelTcS :: TcLevel -> TcS a -> TcS a +setTcLevelTcS lvl (TcS thing_inside) + = TcS $ \ env -> TcM.setTcLevel lvl (thing_inside env) + nestImplicTcS :: EvBindsVar -> TcLevel -> TcS a -> TcS a ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -1743,24 +1743,21 @@ will be able to report a more informative error: ************************************************************************ -} -type ApproxWC = ( Bag Ct -- Free quantifiable constraints - , Bag Ct ) -- Free non-quantifiable constraints - -- due to shape, or enclosing equality +type ApproxWC = ( Bag Ct -- Free quantifiable constraints + , TcTyCoVarSet ) -- Free vars of non-quantifiable constraints + -- due to shape, or enclosing equality approximateWC :: Bool -> WantedConstraints -> Bag Ct approximateWC include_non_quantifiable cts - | include_non_quantifiable = quant `unionBags` no_quant - | otherwise = quant - where - (quant, no_quant) = approximateWCX cts + = fst (approximateWCX include_non_quantifiable cts) -approximateWCX :: WantedConstraints -> ApproxWC +approximateWCX :: Bool -> WantedConstraints -> ApproxWC -- The "X" means "extended"; -- we return both quantifiable and non-quantifiable constraints -- See Note [ApproximateWC] -- See Note [floatKindEqualities vs approximateWC] -approximateWCX wc - = float_wc False emptyVarSet wc (emptyBag, emptyBag) +approximateWCX include_non_quantifiable wc + = float_wc False emptyVarSet wc (emptyBag, emptyVarSet) where float_wc :: Bool -- True <=> there are enclosing equalities -> TcTyCoVarSet -- Enclosing skolem binders @@ -1786,17 +1783,23 @@ approximateWCX wc -- There can be (insoluble) Given constraints in wc_simple, -- there so that we get error reports for unreachable code -- See `given_insols` in GHC.Tc.Solver.Solve.solveImplication - | insolubleCt ct = acc - | tyCoVarsOfCt ct `intersectsVarSet` skol_tvs = acc - | otherwise - = case classifyPredType (ctPred ct) of + | insolubleCt ct = acc + | pred_tvs `intersectsVarSet` skol_tvs = acc + | include_non_quantifiable = add_to_quant + | is_quantifiable encl_eqs (ctPred ct) = add_to_quant + | otherwise = add_to_no_quant + where + pred = ctPred ct + pred_tvs = tyCoVarsOfType pred + add_to_quant = (ct `consBag` quant, no_quant) + add_to_no_quant = (quant, no_quant `unionVarSet` pred_tvs) + + is_quantifiable encl_eqs pred + = case classifyPredType pred of -- See the classification in Note [ApproximateWC] EqPred eq_rel ty1 ty2 - | not encl_eqs -- See Wrinkle (W1) - , quantify_equality eq_rel ty1 ty2 - -> add_to_quant - | otherwise - -> add_to_no_quant + | encl_eqs -> False -- encl_eqs: See Wrinkle (W1) + | otherwise -> quantify_equality eq_rel ty1 ty2 ClassPred cls tys | Just {} <- isCallStackPred cls tys @@ -1804,17 +1807,14 @@ approximateWCX wc -- the constraints bubble up to be solved from the outer -- context, or be defaulted when we reach the top-level. -- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence - -> add_to_no_quant + -> False | otherwise - -> add_to_quant -- See Wrinkle (W2) + -> True -- See Wrinkle (W2) - IrredPred {} -> add_to_quant -- See Wrinkle (W2) + IrredPred {} -> True -- See Wrinkle (W2) - ForAllPred {} -> add_to_no_quant -- Never quantify these - where - add_to_quant = (ct `consBag` quant, no_quant) - add_to_no_quant = (quant, ct `consBag` no_quant) + ForAllPred {} -> False -- Never quantify these -- See Note [Quantifying over equality constraints] quantify_equality NomEq ty1 ty2 = quant_fun ty1 || quant_fun ty2 @@ -1852,7 +1852,7 @@ We proceed by classifying the constraint: Wrinkle (W1) When inferring most-general types (in simplifyInfer), we - do *not* float an equality constraint if the implication binds + do *not* quantify over equality constraint if the implication binds equality constraints, because that defeats the OutsideIn story. Consider data T a where { TInt :: T Int; MkT :: T a } f TInt = 3::Int ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -92,6 +92,7 @@ module GHC.Types.Name.Occurrence ( plusOccEnv, plusOccEnv_C, extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv, alterOccEnv, minusOccEnv, minusOccEnv_C, minusOccEnv_C_Ns, + sizeOccEnv, pprOccEnv, forceOccEnv, intersectOccEnv_C, @@ -803,6 +804,10 @@ minusOccEnv_C_Ns f (MkOccEnv as) (MkOccEnv bs) = then Nothing else Just m +sizeOccEnv :: OccEnv a -> Int +sizeOccEnv (MkOccEnv as) = + nonDetStrictFoldUFM (\ m !acc -> acc + sizeUFM m) 0 as + instance Outputable a => Outputable (OccEnv a) where ppr x = pprOccEnv ppr x ===================================== configure.ac ===================================== @@ -658,12 +658,13 @@ GHC_LLVM_TARGET_SET_VAR AC_SUBST(LlvmTarget) dnl ** See whether cc supports --target=<triple> and set -dnl CONF_CC_OPTS_STAGE[012] accordingly. -FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0]) +dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2]) -FP_PROG_CC_LINKER_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_GCC_LINKER_OPTS_STAGE0]) +# CONF_CC_OPTS_STAGE0 should be left as is because it is already configured +# by bootstrap compiler settings + FP_PROG_CC_LINKER_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_PROG_CC_LINKER_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) ===================================== hadrian/src/Builder.hs ===================================== @@ -26,7 +26,7 @@ import Hadrian.Builder.Tar import Hadrian.Oracles.Path import Hadrian.Oracles.TextFile import Hadrian.Utilities -import Oracles.Setting (bashPath, targetStage) +import Oracles.Setting (bashPath, targetStage, isWinHost) import System.Exit import System.IO (stderr) @@ -327,8 +327,14 @@ instance H.Builder Builder where Ar Unpack _ -> cmd' [Cwd output] [path] buildArgs buildOptions Autoreconf dir -> do + isWin <- isWinHost + let aclocal_env = + -- It is generally assumed that you would use MinGW's compilers from within an MSYS shell. + -- See Note [ACLOCAL_PATH for Windows] + if isWin then [AddEnv "ACLOCAL_PATH" "/c/msys64/usr/share/aclocal/"] + else [] bash <- bashPath - cmd' [Cwd dir] [bash, path] buildArgs buildOptions + cmd' (Cwd dir `cons` aclocal_env) [bash, path] buildArgs buildOptions Configure dir -> do -- Inject /bin/bash into `libtool`, instead of /bin/sh, ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -115,7 +115,12 @@ installTo relocatable prefix = do targetPlatform <- setting TargetPlatformFull let ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty - runBuilder (Configure bindistFilesDir) ["--prefix="++prefix] [] [] + win <- isWinTarget + -- See Note [Empty MergeObjsCmd] + let disabledMerge = + if win then ["MergeObjsCmd="] + else [] + runBuilder (Configure bindistFilesDir) (["--prefix="++prefix] ++ disabledMerge) [] [] let env = case relocatable of Relocatable -> [AddEnv "RelocatableBuild" "YES"] NotRelocatable -> [] @@ -232,7 +237,7 @@ bindistRules = do -- N.B. the ghc-pkg executable may be prefixed with a target triple -- (c.f. #20267). ghcPkgName <- programName (vanillaContext Stage1 ghcPkg) - cmd_ (bindistFilesDir -/- "bin" -/- ghcPkgName) ["recache"] + cmd_ (bindistFilesDir -/- "bin" -/- ghcPkgName <.> exe) ["recache"] ===================================== libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc ===================================== @@ -861,7 +861,9 @@ expirationTime mgr us = do -- The 'TimeoutCallback' will not be called more than once. -- -- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only --- 2147483647 μs, less than 36 minutes. +-- 2147483647 microseconds, less than 36 minutes. +-- We can not use here utf/greek symbol due of: +-- _build/stage1/libraries/ghc-internal/build/GHC/Internal/Event/Windows.hs: commitBuffer: invalid argument (cannot encode character '\206') -- {-# NOINLINE registerTimeout #-} registerTimeout :: Manager -> Int -> TimeoutCallback -> IO TimeoutKey @@ -878,7 +880,9 @@ registerTimeout mgr@Manager{..} uSrelTime cb = do -- This has no effect if the timeout has already fired. -- -- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only --- 2147483647 μs, less than 36 minutes. +-- 2147483647 microseconds, less than 36 minutes. +-- We can not use here utf/greek symbol due of: +-- _build/stage1/libraries/ghc-internal/build/GHC/Internal/Event/Windows.hs: commitBuffer: invalid argument (cannot encode character '\206') -- updateTimeout :: Manager -> TimeoutKey -> Seconds -> IO () updateTimeout mgr (TK key) relTime = do @@ -980,7 +984,7 @@ step maxDelay mgr@Manager{..} = do -- There are some unusual edge cases you need to deal with. The -- GetQueuedCompletionStatus function blocks a thread until there's -- work for it to do. Based on the return value, the number of bytes - -- and the overlapped structure, there’s a lot of possible "reasons" + -- and the overlapped structure, there's a lot of possible "reasons" -- for the function to have returned. Deciphering all the possible -- cases: -- ===================================== m4/find_merge_objects.m4 ===================================== @@ -33,6 +33,8 @@ AC_DEFUN([FIND_MERGE_OBJECTS],[ fi + # Note [Empty MergeObjsCmd] + # ~~~~~~~~~~~~~~~~~~~~~~~~~ # If MergeObjsCmd="" then we assume that the user is explicitly telling us that # they do not want to configure the MergeObjsCmd, this is particularly important for # the bundled windows toolchain. ===================================== m4/fp_setup_windows_toolchain.m4 ===================================== @@ -85,6 +85,8 @@ AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[ mingw_prefix="$1" mingw_install_prefix="$2" + # Note [Windows Toolchain Standard Library Options] + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Our Windows toolchain is based around Clang and LLD. We use compiler-rt # for the runtime, libc++ and libc++abi for the C++ standard library # implementation, and libunwind for C++ unwinding. ===================================== testsuite/tests/typecheck/should_fail/T26004.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NoMonoLocalBinds #-} + +module T26004 where + +data T a where + T1 :: T Bool + T2 :: T a + +-- This funcion should be rejected: +-- we should not infer a non-principal type for `f` +f w e = case e of + T1 -> let y = not w in False + T2 -> True ===================================== testsuite/tests/typecheck/should_fail/T26004.stderr ===================================== @@ -0,0 +1,17 @@ + +T26004.hs:13:21: error: [GHC-25897] + • Could not deduce ‘p ~ Bool’ + from the context: a ~ Bool + bound by a pattern with constructor: T1 :: T Bool, + in a case alternative + at T26004.hs:13:3-4 + ‘p’ is a rigid type variable bound by + the inferred type of f :: p -> T a -> Bool + at T26004.hs:(12,1)-(14,12) + • In the first argument of ‘not’, namely ‘w’ + In the expression: not w + In an equation for ‘y’: y = not w + • Relevant bindings include + w :: p (bound at T26004.hs:12:3) + f :: p -> T a -> Bool (bound at T26004.hs:12:1) + Suggested fix: Consider giving ‘f’ a type signature ===================================== testsuite/tests/typecheck/should_fail/T7453.stderr ===================================== @@ -1,8 +1,5 @@ - -T7453.hs:9:15: error: [GHC-25897] - • Couldn't match type ‘t’ with ‘p’ - Expected: Id t - Actual: Id p +T7453.hs:10:30: error: [GHC-25897] + • Couldn't match expected type ‘t’ with actual type ‘p’ ‘t’ is a rigid type variable bound by the type signature for: z :: forall t. Id t @@ -10,29 +7,17 @@ T7453.hs:9:15: error: [GHC-25897] ‘p’ is a rigid type variable bound by the inferred type of cast1 :: p -> a at T7453.hs:(7,1)-(10,30) - • In the expression: aux - In an equation for ‘z’: - z = aux - where - aux = Id v - In an equation for ‘cast1’: - cast1 v - = runId z - where - z :: Id t - z = aux - where - aux = Id v + • In the first argument of ‘Id’, namely ‘v’ + In the expression: Id v + In an equation for ‘aux’: aux = Id v • Relevant bindings include - aux :: Id p (bound at T7453.hs:10:21) + aux :: Id t (bound at T7453.hs:10:21) z :: Id t (bound at T7453.hs:9:11) v :: p (bound at T7453.hs:7:7) cast1 :: p -> a (bound at T7453.hs:7:1) -T7453.hs:15:15: error: [GHC-25897] - • Couldn't match type ‘t1’ with ‘p’ - Expected: () -> t1 - Actual: () -> p +T7453.hs:16:33: error: [GHC-25897] + • Couldn't match expected type ‘t1’ with actual type ‘p’ ‘t1’ is a rigid type variable bound by the type signature for: z :: forall t1. () -> t1 @@ -40,21 +25,11 @@ T7453.hs:15:15: error: [GHC-25897] ‘p’ is a rigid type variable bound by the inferred type of cast2 :: p -> t at T7453.hs:(13,1)-(16,33) - • In the expression: aux - In an equation for ‘z’: - z = aux - where - aux = const v - In an equation for ‘cast2’: - cast2 v - = z () - where - z :: () -> t - z = aux - where - aux = const v + • In the first argument of ‘const’, namely ‘v’ + In the expression: const v + In an equation for ‘aux’: aux = const v • Relevant bindings include - aux :: forall {b}. b -> p (bound at T7453.hs:16:21) + aux :: b -> t1 (bound at T7453.hs:16:21) z :: () -> t1 (bound at T7453.hs:15:11) v :: p (bound at T7453.hs:13:7) cast2 :: p -> t (bound at T7453.hs:13:1) @@ -86,3 +61,4 @@ T7453.hs:21:15: error: [GHC-25897] z :: t1 (bound at T7453.hs:21:11) v :: p (bound at T7453.hs:19:7) cast3 :: p -> t (bound at T7453.hs:19:1) + ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -735,3 +735,4 @@ test('T24938', normal, compile_fail, ['']) test('T25325', normal, compile_fail, ['']) test('T25004', normal, compile_fail, ['']) test('T25004k', normal, compile_fail, ['']) +test('T26004', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4631de44afcc6e9ee839623a61c105… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4631de44afcc6e9ee839623a61c105… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/az/ghc-cpp] Process comments in CPP directives
by Alan Zimmerman (＠alanz) 06 May '25

06 May '25

Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC Commits: 4acbeff0 by Alan Zimmerman at 2025-05-06T22:42:27+01:00 Process comments in CPP directives - - - - - 9 changed files: - compiler/GHC/Parser/PreProcess/Lexer.x - compiler/GHC/Parser/PreProcess/ParsePP.hs - compiler/GHC/Parser/PreProcess/ParserM.hs - testsuite/tests/ghc-cpp/GhcCpp01.hs - testsuite/tests/ghc-cpp/GhcCpp01.stderr - utils/check-cpp/Lexer.x - utils/check-cpp/Main.hs - utils/check-cpp/ParsePP.hs - utils/check-cpp/ParserM.hs Changes: ===================================== compiler/GHC/Parser/PreProcess/Lexer.x ===================================== @@ -22,6 +22,8 @@ words :- <0> $white+ ; --------------------------------------- + <0> "//" .* { mkTv TComment } + <0> "/*" .* "*/" { mkTv TComment } <0> "{" { mkTv TOpenBrace } <0> "}" { mkTv TCloseBrace } <0> "[" { mkTv TOpenBracket } ===================================== compiler/GHC/Parser/PreProcess/ParsePP.hs ===================================== @@ -27,7 +27,7 @@ parseDirective s = case cppLex True s of Left e -> Left e Right toks -> - case toks of + case map deComment toks of (THash "#" : TIdentifier "define" : ts) -> cppDefine ts (THash "#" : TIdentifier "undef" : ts) -> Right $ cppUndef (map t_str ts) (THash "#" : TIdentifier "include" : ts) -> Right $ cppInclude (map t_str ts) @@ -112,6 +112,13 @@ cppLex sd s = case lexCppTokenStream s (init_state {scanning_directive = sd}) of Left err -> Left err Right (_inp, _st, toks) -> Right toks +-- Each comment is replaced with a space +-- https://timsong-cpp.github.io/cppwp/n4140/lex#phases-1.3 +deComment :: Token -> Token +deComment (TComment _) = TComment " " +deComment t = t + + -- --------------------------------------------------------------------- doATest :: String -> Either String CppDirective ===================================== compiler/GHC/Parser/PreProcess/ParserM.hs ===================================== @@ -91,6 +91,8 @@ init_state = data Token = TEOF {t_str :: String} + | -- https://timsong-cpp.github.io/cppwp/n4140/lex.comment + TComment {t_str :: String} | TIdentifier {t_str :: String} | TIdentifierLParen {t_str :: String} | TInteger {t_str :: String} ===================================== testsuite/tests/ghc-cpp/GhcCpp01.hs ===================================== @@ -18,13 +18,13 @@ y = 1 #endif #undef FOO -#ifdef FOO +#ifdef FOO /* Check for FOO */ complete junk! #endif -- nested undef #define AA -#if 0 +#if /* hard code for now */ 0 #undef AA #endif ===================================== testsuite/tests/ghc-cpp/GhcCpp01.stderr ===================================== @@ -217,13 +217,13 @@ - |#endif - |#undef FOO -- |#ifdef FOO +- |#ifdef FOO /* Check for FOO */ - |complete junk! - |#endif - |-- nested undef - |#define AA -- |#if 0 +- |#if /* hard code for now */ 0 - |#undef AA - |#endif ===================================== utils/check-cpp/Lexer.x ===================================== @@ -21,6 +21,8 @@ words :- <0> $white+ ; --------------------------------------- + <0> "//" .* { mkTv TComment } + <0> "/*" .* "*/" { mkTv TComment } <0> "{" { mkTv TOpenBrace } <0> "}" { mkTv TCloseBrace } <0> "[" { mkTv TOpenBracket } ===================================== utils/check-cpp/Main.hs ===================================== @@ -838,3 +838,18 @@ t36 = do , "#endif" , "" ] + +t37 :: IO () +t37 = do + dump + [ "{-# LANGUAGE GHC_CPP #-}" + , "module Example14 where" + , "" + , "foo =" + , "#if 1 /* and a comment */" + , " 'a'" + , "#else" + , " 'b'" + , "#endif" + , "" + ] ===================================== utils/check-cpp/ParsePP.hs ===================================== @@ -27,7 +27,7 @@ parseDirective s = case cppLex True s of Left e -> Left e Right toks -> - case toks of + case map deComment toks of (THash "#" : TIdentifier "define" : ts) -> cppDefine ts (THash "#" : TIdentifier "undef" : ts) -> Right $ cppUndef (map t_str ts) (THash "#" : TIdentifier "include" : ts) -> Right $ cppInclude (map t_str ts) @@ -112,6 +112,13 @@ cppLex sd s = case lexCppTokenStream s (init_state {scanning_directive = sd}) of Left err -> Left err Right (_inp, _st, toks) -> Right toks +-- Each comment is replaced with a space +-- https://timsong-cpp.github.io/cppwp/n4140/lex#phases-1.3 +deComment :: Token -> Token +deComment (TComment _) = TComment " " +deComment t = t + + -- --------------------------------------------------------------------- doATest :: String -> Either String CppDirective ===================================== utils/check-cpp/ParserM.hs ===================================== @@ -91,6 +91,8 @@ init_state = data Token = TEOF {t_str :: String} + | -- https://timsong-cpp.github.io/cppwp/n4140/lex.comment + TComment {t_str :: String} | TIdentifier {t_str :: String} | TIdentifierLParen {t_str :: String} | TInteger {t_str :: String} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4acbeff0a067efe77bbb040baca3c1d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4acbeff0a067efe77bbb040baca3c1d… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26003] Import wibble
by Simon Peyton Jones (＠simonpj) 06 May '25

06 May '25

Simon Peyton Jones pushed to branch wip/T26003 at Glasgow Haskell Compiler / GHC Commits: 8c87cacf by Simon Peyton Jones at 2025-05-06T22:01:41+01:00 Import wibble - - - - - 1 changed file: - compiler/GHC/Tc/Utils/TcMType.hs Changes: ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -110,7 +110,7 @@ import {-# SOURCE #-} GHC.Tc.Utils.Unify( unifyInvisibleType, tcSubMult ) import GHC.Tc.Types.Origin import GHC.Tc.Types.Constraint import GHC.Tc.Types.Evidence -import GHC.Tc.Types.CtLoc( CtLoc, ctLocOrigin ) +import GHC.Tc.Types.CtLoc( CtLoc ) import GHC.Tc.Utils.Monad -- TcType, amongst others import GHC.Tc.Utils.TcType import GHC.Tc.Errors.Types View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8c87cacff716efeaf6dba82fc749c37… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8c87cacff716efeaf6dba82fc749c37… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/az/ghc-cpp] 119 commits: Support for ARM64 Windows (LLVM-enabled) (fixes #24603)
by Alan Zimmerman (＠alanz) 06 May '25

06 May '25

Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC Commits: 9995c2b7 by Serge S. Gulin at 2025-05-04T17:13:36+03:00 Support for ARM64 Windows (LLVM-enabled) (fixes #24603) 1. Add Windows AArch64 cross-compilation support via CI jobs Introduce new CI configurations for cross-compiling to Windows ARM64 using Debian12Wine, FEX, and MSYS2. Configure toolchain variables for LLVM MinGW and Wine emulation in CI pipelines. 2. Adjust compiler and RTS for AArch64 Windows compatibility Reserve register `x18` on Windows and Darwin platforms in AArch64 codegen. Handle Windows-specific relocations and data sections in AArch64 assembler. Update PEi386 linker to recognize ARM64 binaries and support exception handling. Adjust LLVM target definitions and data layouts for new architectures. Update `ghc-toolchain` and build scripts to handle `TablesNextToCode` on Windows ARM64. 3. Enhance CI scripts and stability Modify `ci.sh` to handle mingw cross-targets, fixing GHC executable paths and test execution. Use `diff -w` in tests to ignore whitespace differences, improving cross-platform consistency. 4. Refactor and clean up code Remove redundant imports in hello.hs test. Improve error messages and checks for unsupported configurations in the driver. Add `EXDEV` error code to `errno.js`. Add async/sync flags to IO logs at `base.js`. Improve POSIX compatibility for file close at `base.js`: decrease indeterminism for mixed cases of async and sync code. 5. Update dependencies: `Cabal`, `Win32`, `directory`, `process`, `haskeline`, and `unix`. submodule Co-authored-by: Cheng Shao <terrorjack(a)type.dance> Co-authored-by: Dmitrii Egorov <egorov.d.i(a)icloud.com> Co-authored-by: Andrei Borzenkov <root(a)sandwitch.dev> - - - - - 50fa8165 by Javran Cheng at 2025-05-05T05:55:39-04:00 Suppress unused do-binding if discarded variable is Any or ZonkAny. Consider example (#25895): > do { forever (return ()); blah } where `forever :: forall a b. IO a -> IO b`. Nothing constrains `b`, so it will be instantiates with `Any` or `ZonkAny`. But we certainly don't want to complain about a discarded do-binding. Fixes #25895 - - - - - e46c6b18 by Rodrigo Mesquita at 2025-05-06T09:01:57-04:00 Refactor mkTopLevImportedEnv out of mkTopLevEnv This makes the code clearer and allows the top-level import context to be fetched directly from the HomeModInfo through the API (e.g. useful for the debugger). - - - - - 0ce0d263 by Rodrigo Mesquita at 2025-05-06T09:01:57-04:00 Export sizeOccEnv from GHC.Types.Name.Occurrence Counts the number of OccNames in an OccEnv - - - - - 165f98d8 by Simon Peyton Jones at 2025-05-06T09:02:39-04:00 Fix a bad untouchability bug im simplifyInfer This patch addresses #26004. The root cause was that simplifyInfer was willing to unify variables "far out". The fix, in runTcSWithEvBinds', is to initialise the inert set given-eq level with the current level. See (TGE6) in Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet Two loosely related refactors: * Refactored approximateWCX to return just the free type variables of the un-quantified constraints. That avoids duplication of work (these free vars are needed in simplifyInfer) and makes it clearer that the constraints themselves are irrelevant. * A little local refactor of TcSMode, which reduces the number of parameters to runTcSWithEvBinds - - - - - 4bedc089 by Alan Zimmerman at 2025-05-06T18:07:57+01:00 GHC-CPP: first rough proof of concept Processes #define FOO #ifdef FOO x = 1 #endif Into [ITcppIgnored [L loc ITcppDefine] ,ITcppIgnored [L loc ITcppIfdef] ,ITvarid "x" ,ITequal ,ITinteger (IL {il_text = SourceText "1", il_neg = False, il_value = 1}) ,ITcppIgnored [L loc ITcppEndif] ,ITeof] In time, ITcppIgnored will be pushed into a comment - - - - - 58ef415b by Alan Zimmerman at 2025-05-06T18:07:57+01:00 Tidy up before re-visiting the continuation mechanic - - - - - 638a6fc3 by Alan Zimmerman at 2025-05-06T18:07:57+01:00 Switch preprocessor to continuation passing style Proof of concept, needs tidying up - - - - - cd688d33 by Alan Zimmerman at 2025-05-06T18:07:57+01:00 Small cleanup - - - - - 6a924b61 by Alan Zimmerman at 2025-05-06T18:07:57+01:00 Get rid of some cruft - - - - - 0ae29cce by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Starting to integrate. Need to get the pragma recognised and set - - - - - 40767a46 by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Make cppTokens extend to end of line, and process CPP comments - - - - - e5c0365b by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Remove unused ITcppDefined - - - - - aa1b2743 by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Allow spaces between # and keyword for preprocessor directive - - - - - 4116edcd by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Process CPP continuation lines They are emited as separate ITcppContinue tokens. Perhaps the processing should be more like a comment, and keep on going to the end. BUT, the last line needs to be slurped as a whole. - - - - - 1927c7fb by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Accumulate CPP continuations, process when ready Can be simplified further, we only need one CPP token - - - - - 163c0f61 by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Simplify Lexer interface. Only ITcpp We transfer directive lines through it, then parse them from scratch in the preprocessor. - - - - - 38c83ad6 by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Deal with directive on last line, with no trailing \n - - - - - 37b0f683 by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Start parsing and processing the directives - - - - - da250161 by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Prepare for processing include files - - - - - cae69ced by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Move PpState into PreProcess And initParserState, initPragState too - - - - - d84e8056 by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Process nested include files Also move PpState out of Lexer.x, so it is easy to evolve it in a ghci session, loading utils/check-cpp/Main.hs - - - - - 6c92a7f9 by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Split into separate files - - - - - 7cd10d14 by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Starting on expression parser. But it hangs. Time for Text.Parsec.Expr - - - - - bbd04cae by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Start integrating the ghc-cpp work From https://github.com/alanz/ghc-cpp - - - - - 0eb187a4 by Alan Zimmerman at 2025-05-06T18:07:58+01:00 WIP - - - - - 940f5b55 by Alan Zimmerman at 2025-05-06T18:07:58+01:00 Fixup after rebase - - - - - d0a3d584 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 WIP - - - - - efa9fe0a by Alan Zimmerman at 2025-05-06T18:07:59+01:00 Fixup after rebase, including all tests pass - - - - - fdb1ea18 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 Change pragma usage to GHC_CPP from GhcCPP - - - - - 934145eb by Alan Zimmerman at 2025-05-06T18:07:59+01:00 Some comments - - - - - 540fade6 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 Reformat - - - - - 12c8fab6 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 Delete unused file - - - - - 27061919 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 Rename module Parse to ParsePP - - - - - caf7e9bf by Alan Zimmerman at 2025-05-06T18:07:59+01:00 Clarify naming in the parser - - - - - fde7bd48 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 WIP. Switching to alex/happy to be able to work in-tree Since Parsec is not available - - - - - 56fa02d5 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 Layering is now correct - GHC lexer, emits CPP tokens - accumulated in Preprocessor state - Lexed by CPP lexer, CPP command extracted, tokens concated with spaces (to get rid of token pasting via comments) - if directive lexed and parsed by CPP lexer/parser, and evaluated - - - - - 69dac201 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 First example working Loading Example1.hs into ghci, getting the right results ``` {-# LANGUAGE GHC_CPP #-} module Example1 where y = 3 x = "hello" "bye now" foo = putStrLn x ``` - - - - - 7a654916 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 Rebase, and all tests pass except whitespace for generated parser - - - - - 0dcd84c5 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 More plumbing. Ready for testing tomorrow. - - - - - f358cb54 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 Proress. Renamed module State from Types And at first blush it seems to handle preprocessor scopes properly. - - - - - d0d5c285 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 Insert basic GHC version macros into parser __GLASGOW_HASKELL__ __GLASGOW_HASKELL_FULL_VERSION__ __GLASGOW_HASKELL_PATCHLEVEL1__ __GLASGOW_HASKELL_PATCHLEVEL2__ - - - - - b7925c05 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 Re-sync check-cpp for easy ghci work - - - - - 9d514f90 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 Get rid of warnings - - - - - 0b5f458f by Alan Zimmerman at 2025-05-06T18:07:59+01:00 Rework macro processing, in check-cpp Macros kept at the top level, looked up via name, multiple arity versions per name can be stored - - - - - 009563f2 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 WIP. Can crack arguments for #define Next step it to crack out args in an expansion - - - - - 143cf978 by Alan Zimmerman at 2025-05-06T18:07:59+01:00 WIP on arg parsing. - - - - - ab01dc26 by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Progress. Still screwing up nested parens. - - - - - 23ff567d by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Seems to work, but has redundant code - - - - - 8f91f5c3 by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Remove redundant code - - - - - b2d68f7d by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Reformat - - - - - b96ece80 by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Expand args, single pass Still need to repeat until fixpoint - - - - - 28b5caeb by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Fixed point expansion - - - - - 48e98b88 by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Sync the playground to compiler - - - - - 7bd8b7dc by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Working on dumping the GHC_CPP result But We need to keep the BufSpan in a comment - - - - - 9e9bb4d1 by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Keep BufSpan in queued comments in GHC.Parser.Lexer - - - - - 1c269760 by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Getting close to being able to print the combined tokens showing what is in and what is out - - - - - 4d8a2f36 by Alan Zimmerman at 2025-05-06T18:08:00+01:00 First implementation of dumpGhcCpp. Example output First dumps all macros in the state, then the source, showing which lines are in and which are out ------------------------------ - |#define FOO(A,B) A + B - |#define FOO(A,B,C) A + B + C - |#if FOO(1,FOO(3,4)) == 8 - |-- a comment |x = 1 - |#else - |x = 5 - |#endif - - - - - 18eb7796 by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Clean up a bit - - - - - fc20f4ba by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Add -ddump-ghc-cpp option and a test based on it - - - - - a82da455 by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Restore Lexer.x rules, we need them for continuation lines - - - - - 912eaf11 by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Lexer.x: trying to sort out the span for continuations - We need to match on \n at the end of the line - We cannot simply back up for it - - - - - c7000536 by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Inserts predefined macros. But does not dump properly Because the cpp tokens have a trailing newline - - - - - ad1e7f9e by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Remove unnecessary LExer rules We *need* the ones that explicitly match to the end of the line. - - - - - f4ea076a by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Generate correct span for ITcpp Dump now works, except we do not render trailing `\` for continuation lines. This is good enough for use in test output. - - - - - 8afb04b8 by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Reduce duplication in lexer - - - - - 63398f1f by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Tweaks - - - - - 1ece4cbe by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Insert min_version predefined macros into state The mechanism now works. Still need to flesh out the full set. - - - - - 6df6abba by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Trying my alternative pragma syntax. It works, but dumpGhcCpp is broken, I suspect from the ITcpp token span update. - - - - - d7b5d614 by Alan Zimmerman at 2025-05-06T18:08:00+01:00 Pragma extraction now works, with both CPP and GHC_CPP For the following {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 913 {-# LANGUAGE GHC_CPP #-} #endif We will enable GHC_CPP only - - - - - 043b4500 by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Remove some tracing - - - - - 1166580a by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Fix test exes for changes - - - - - fec971d7 by Alan Zimmerman at 2025-05-06T18:08:01+01:00 For GHC_CPP tests, normalise config-time-based macros - - - - - cbcf2a7f by Alan Zimmerman at 2025-05-06T18:08:01+01:00 WIP - - - - - bd7584c6 by Alan Zimmerman at 2025-05-06T18:08:01+01:00 WIP again. What is wrong? - - - - - c504b628 by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Revert to dynflags for normal not pragma lexing - - - - - 0b66a723 by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Working on getting check-exact to work properly - - - - - 7305118a by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Passes CppCommentPlacement test - - - - - 4659e186 by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Starting on exact printing with GHC_CPP While overriding normal CPP - - - - - 546a4023 by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Correctly store CPP ignored tokens as comments By populating the lexeme string in it, based on the bufpos - - - - - 4bf8249b by Alan Zimmerman at 2025-05-06T18:08:01+01:00 WIP - - - - - 1fd04489 by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Simplifying - - - - - ebaea51c by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Update the active state logic - - - - - 55af33ef by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Work the new logic into the mainline code - - - - - 761dfa38 by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Process `defined` operator - - - - - c4930905 by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Manage lexer state while skipping tokens There is very intricate layout-related state used when lexing. If a CPP directive blanks out some tokens, store this state when the blanking starts, and restore it when they are no longer being blanked. - - - - - 2cc75317 by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Track the last token buffer index, for ITCppIgnored We need to attach the source being skipped in an ITCppIgnored token. We cannot simply use its BufSpan as an index into the underlying StringBuffer as it counts unicode chars, not bytes. So we update the lexer state to store the starting StringBuffer location for the last token, and use the already-stored length to extract the correct portion of the StringBuffer being parsed. - - - - - 567d16ec by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Process the ! operator in GHC_CPP expressions - - - - - ff29b658 by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Predefine a constant when GHC_CPP is being used. - - - - - 0d9b19fc by Alan Zimmerman at 2025-05-06T18:08:01+01:00 WIP - - - - - 79cfff97 by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Skip lines directly in the lexer when required - - - - - 2509eea9 by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Properly manage location when accepting tokens again - - - - - bbb1b32d by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Seems to be working now, for Example9 - - - - - dab0aec6 by Alan Zimmerman at 2025-05-06T18:08:01+01:00 Remove tracing - - - - - d979e506 by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Fix parsing '*' in block comments Instead of replacing them with '-' - - - - - 14a22493 by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Keep the trailing backslash in a ITcpp token - - - - - 716c4ba1 by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Deal with only enabling one section of a group. A group is an instance of a conditional introduced by #if/#ifdef/#ifndef, and ending at the final #endif, including intermediate #elsif sections - - - - - c6201bdd by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Replace remaining identifiers with 0 when evaluating As per the spec - - - - - 3015e79a by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Snapshot before rebase - - - - - 4f215d1d by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Skip non-processed lines starting with # - - - - - 32888d20 by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Export generateMacros so we can use it in ghc-exactprint - - - - - f047e6ca by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Fix rebase - - - - - 0632f64b by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Expose initParserStateWithMacrosString - - - - - f57786ae by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Fix buggy lexer cppSkip It was skipping all lines, not just ones prefixed by # - - - - - b010c868 by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Fix evaluation of && to use the correct operator - - - - - d31d438d by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Deal with closing #-} at the start of a line - - - - - 56a08b1c by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Add the MIN_VERSION_GLASGOW_HASKELL predefined macro - - - - - d9562b7a by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Include MIN_VERSION_GLASGOW_HASKELL in GhcCpp01.stderr - - - - - a215a5ce by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Use a strict map for macro defines - - - - - d645f573 by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Process TIdentifierLParen Which only matters at the start of #define - - - - - 7da6441a by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Do not provide TIdentifierLParen paren twice - - - - - 2042c1b0 by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Handle whitespace between identifier and '(' for directive only - - - - - 33fec4ca by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Expose some Lexer bitmap manipulation helpers - - - - - d9b4cf25 by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Deal with line pragmas as tokens Blows up for dumpGhcCpp though - - - - - 079265e4 by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Allow strings delimited by a single quote too - - - - - 0f7bad13 by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Allow leading whitespace on cpp directives As per https://timsong-cpp.github.io/cppwp/n4140/cpp#1 - - - - - d8af2caf by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Implement GHC_CPP undef - - - - - 9156970c by Alan Zimmerman at 2025-05-06T18:08:02+01:00 Sort out expansion of no-arg macros, in a context with args And make the expansion bottom out, in the case of recursion - - - - - 855c1461 by Alan Zimmerman at 2025-05-06T21:52:14+01:00 Fix GhcCpp01 test The LINE pragma stuff works in ghc-exactprint when specifically setting flag to emit ITline_pragma tokens - - - - - 129 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/hello.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Linear/AArch64.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Config/Parser.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Parser.hs-boot - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Header.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - + compiler/GHC/Parser/PreProcess.hs - + compiler/GHC/Parser/PreProcess/Eval.hs - + compiler/GHC/Parser/PreProcess/Lexer.x - + compiler/GHC/Parser/PreProcess/Macro.hs - + compiler/GHC/Parser/PreProcess/ParsePP.hs - + compiler/GHC/Parser/PreProcess/Parser.y - + compiler/GHC/Parser/PreProcess/ParserM.hs - + compiler/GHC/Parser/PreProcess/State.hs - compiler/GHC/Parser/Utils.hs - compiler/GHC/Platform/Regs.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/ghc.cabal.in - docs/users_guide/debugging.rst - ghc/GHCi/UI.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/SourceDist.hs - hadrian/stack.yaml.lock - libraries/Cabal - libraries/Win32 - libraries/base/src/System/CPUTime/Windows.hsc - libraries/base/tests/perf/encodingAllocations.hs - libraries/directory - libraries/ghc-internal/jsbits/base.js - libraries/ghc-internal/jsbits/errno.js - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs - libraries/haskeline - libraries/process - libraries/unix - llvm-targets - m4/fp_cc_supports_target.m4 - m4/fptools_set_platform_vars.m4 - m4/ghc_tables_next_to_code.m4 - rts/StgCRun.c - rts/linker/PEi386.c - rts/win32/veh_excn.c - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/driver/T4437.hs - testsuite/tests/ghc-api/T11579.hs - testsuite/tests/ghc-api/fixed-nodes/all.T - + testsuite/tests/ghc-cpp/GhcCpp01.hs - + testsuite/tests/ghc-cpp/GhcCpp01.stderr - + testsuite/tests/ghc-cpp/all.T - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/template-haskell-exports.stdout - + testsuite/tests/printer/CppCommentPlacement.hs - testsuite/tests/printer/T17697.stderr - + testsuite/tests/typecheck/should_fail/T26004.hs - + testsuite/tests/typecheck/should_fail/T26004.stderr - testsuite/tests/typecheck/should_fail/T7453.stderr - testsuite/tests/typecheck/should_fail/all.T - + utils/check-cpp/.ghci - + utils/check-cpp/.gitignore - + utils/check-cpp/Eval.hs - + utils/check-cpp/Example1.hs - + utils/check-cpp/Example10.hs - + utils/check-cpp/Example11.hs - + utils/check-cpp/Example12.hs - + utils/check-cpp/Example13.hs - + utils/check-cpp/Example2.hs - + utils/check-cpp/Example3.hs - + utils/check-cpp/Example4.hs - + utils/check-cpp/Example5.hs - + utils/check-cpp/Example6.hs - + utils/check-cpp/Example7.hs - + utils/check-cpp/Example8.hs - + utils/check-cpp/Example9.hs - + utils/check-cpp/Lexer.x - + utils/check-cpp/Macro.hs - + utils/check-cpp/Main.hs - + utils/check-cpp/ParsePP.hs - + utils/check-cpp/ParseSimulate.hs - + utils/check-cpp/Parser.y - + utils/check-cpp/ParserM.hs - + utils/check-cpp/PreProcess.hs - + utils/check-cpp/README.md - + utils/check-cpp/State.hs - + utils/check-cpp/run.sh - utils/check-exact/Main.hs - utils/check-exact/Parsers.hs - utils/check-exact/Preprocess.hs - utils/check-exact/Utils.hs - utils/ghc-toolchain/exe/Main.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs - utils/haddock/haddock-api/src/Haddock/Parser.hs - utils/haddock/haddock-api/src/Haddock/Types.hs - utils/hsc2hs - utils/llvm-targets/gen-data-layout.sh The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/da4937727ddded7261f0796b175140… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/da4937727ddded7261f0796b175140… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26003] 7 commits: Refactor mkTopLevImportedEnv out of mkTopLevEnv
by Simon Peyton Jones (＠simonpj) 06 May '25

06 May '25

Simon Peyton Jones pushed to branch wip/T26003 at Glasgow Haskell Compiler / GHC Commits: e46c6b18 by Rodrigo Mesquita at 2025-05-06T09:01:57-04:00 Refactor mkTopLevImportedEnv out of mkTopLevEnv This makes the code clearer and allows the top-level import context to be fetched directly from the HomeModInfo through the API (e.g. useful for the debugger). - - - - - 0ce0d263 by Rodrigo Mesquita at 2025-05-06T09:01:57-04:00 Export sizeOccEnv from GHC.Types.Name.Occurrence Counts the number of OccNames in an OccEnv - - - - - 165f98d8 by Simon Peyton Jones at 2025-05-06T09:02:39-04:00 Fix a bad untouchability bug im simplifyInfer This patch addresses #26004. The root cause was that simplifyInfer was willing to unify variables "far out". The fix, in runTcSWithEvBinds', is to initialise the inert set given-eq level with the current level. See (TGE6) in Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet Two loosely related refactors: * Refactored approximateWCX to return just the free type variables of the un-quantified constraints. That avoids duplication of work (these free vars are needed in simplifyInfer) and makes it clearer that the constraints themselves are irrelevant. * A little local refactor of TcSMode, which reduces the number of parameters to runTcSWithEvBinds - - - - - 60da9ceb by Simon Peyton Jones at 2025-05-06T15:50:37+01:00 Wip on #26003 - - - - - a6eb78f7 by Simon Peyton Jones at 2025-05-06T15:50:37+01:00 Wibbles - - - - - e1cdf726 by Simon Peyton Jones at 2025-05-06T15:50:37+01:00 Further wibbles - - - - - 6cdf6491 by Simon Peyton Jones at 2025-05-06T15:50:37+01:00 Lots of tidying up - - - - - 41 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Plugin.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Types/Name/Occurrence.hs - testsuite/tests/dependent/should_fail/T11471.stderr - testsuite/tests/indexed-types/should_fail/T8227.stderr - testsuite/tests/indexed-types/should_fail/T9662.stderr - testsuite/tests/partial-sigs/should_fail/T14040a.stderr - testsuite/tests/partial-sigs/should_fail/T14584.stderr - testsuite/tests/polykinds/T14172.stderr - testsuite/tests/polykinds/T14846.stderr - testsuite/tests/rep-poly/RepPolyNPlusK.stderr - testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr - testsuite/tests/rep-poly/RepPolyTuple.stderr - testsuite/tests/rep-poly/T13929.stderr - testsuite/tests/rep-poly/T14561b.stderr - testsuite/tests/rep-poly/T21906.stderr - testsuite/tests/rep-poly/UnliftedNewtypesCoerceFail.stderr - testsuite/tests/typecheck/no_skolem_info/T14040.stderr - testsuite/tests/typecheck/should_compile/T25266a.stderr - testsuite/tests/typecheck/should_fail/T16204c.stderr - + testsuite/tests/typecheck/should_fail/T26004.hs - + testsuite/tests/typecheck/should_fail/T26004.stderr - testsuite/tests/typecheck/should_fail/T7453.stderr - testsuite/tests/typecheck/should_fail/T7696.stderr - testsuite/tests/typecheck/should_fail/T8603.stderr - testsuite/tests/typecheck/should_fail/all.T - utils/hsc2hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c763d3a8dd1b069f1d8533a07649e8… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c763d3a8dd1b069f1d8533a07649e8… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Fix a bad untouchability bug im simplifyInfer
by Marge Bot (＠marge-bot) 06 May '25

06 May '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 165f98d8 by Simon Peyton Jones at 2025-05-06T09:02:39-04:00 Fix a bad untouchability bug im simplifyInfer This patch addresses #26004. The root cause was that simplifyInfer was willing to unify variables "far out". The fix, in runTcSWithEvBinds', is to initialise the inert set given-eq level with the current level. See (TGE6) in Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet Two loosely related refactors: * Refactored approximateWCX to return just the free type variables of the un-quantified constraints. That avoids duplication of work (these free vars are needed in simplifyInfer) and makes it clearer that the constraints themselves are irrelevant. * A little local refactor of TcSMode, which reduces the number of parameters to runTcSWithEvBinds - - - - - 9 changed files: - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - + testsuite/tests/typecheck/should_fail/T26004.hs - + testsuite/tests/typecheck/should_fail/T26004.stderr - testsuite/tests/typecheck/should_fail/T7453.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -64,7 +64,7 @@ import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim import GHC.Tc.Solver.InertSet (InertSet, emptyInert) -import GHC.Tc.Utils.TcType (isStringTy) +import GHC.Tc.Utils.TcType (isStringTy, topTcLevel) import GHC.Types.CompleteMatch import GHC.Types.SourceText (SourceText(..), mkFractionalLit, FractionalLit , fractionalLitFromRational @@ -129,7 +129,7 @@ instance Outputable TyState where ppr (TySt n inert) = ppr n <+> ppr inert initTyState :: TyState -initTyState = TySt 0 emptyInert +initTyState = TySt 0 (emptyInert topTcLevel) -- | The term oracle state. Stores 'VarInfo' for encountered 'Id's. These -- entries are possibly shared when we figure out that two variables must be ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -915,21 +915,22 @@ simplifyInfer top_lvl rhs_tclvl infer_mode sigs name_taus wanteds ; let psig_theta = concatMap sig_inst_theta partial_sigs -- First do full-blown solving - -- NB: we must gather up all the bindings from doing - -- this solving; hence (runTcSWithEvBinds ev_binds_var). - -- And note that since there are nested implications, - -- calling solveWanteds will side-effect their evidence - -- bindings, so we can't just revert to the input - -- constraint. - + -- NB: we must gather up all the bindings from doing this solving; hence + -- (runTcSWithEvBinds ev_binds_var). And note that since there are + -- nested implications, calling solveWanteds will side-effect their + -- evidence bindings, so we can't just revert to the input constraint. + -- + -- See also Note [Inferring principal types] ; ev_binds_var <- TcM.newTcEvBinds ; psig_evs <- newWanteds AnnOrigin psig_theta ; wanted_transformed - <- setTcLevel rhs_tclvl $ - runTcSWithEvBinds ev_binds_var $ + <- runTcSWithEvBinds ev_binds_var $ + setTcLevelTcS rhs_tclvl $ solveWanteds (mkSimpleWC psig_evs `andWC` wanteds) + -- setLevelTcS: we do setLevel /inside/ the runTcS, so that + -- we initialise the InertSet inert_given_eq_lvl as far + -- out as possible, maximising oppportunities to unify -- psig_evs : see Note [Add signature contexts as wanteds] - -- See Note [Inferring principal types] -- Find quant_pred_candidates, the predicates that -- we'll consider quantifying over @@ -1430,13 +1431,15 @@ decideAndPromoteTyVars top_lvl rhs_tclvl infer_mode name_taus psigs wanted -- Step 1 of Note [decideAndPromoteTyVars] -- Get candidate constraints, decide which we can potentially quantify - (can_quant_cts, no_quant_cts) = approximateWCX wanted + -- The `no_quant_tvs` are free in constraints we can't quantify. + (can_quant_cts, no_quant_tvs) = approximateWCX False wanted can_quant = ctsPreds can_quant_cts - no_quant = ctsPreds no_quant_cts + can_quant_tvs = tyCoVarsOfTypes can_quant -- Step 2 of Note [decideAndPromoteTyVars] -- Apply the monomorphism restriction (post_mr_quant, mr_no_quant) = applyMR dflags infer_mode can_quant + mr_no_quant_tvs = tyCoVarsOfTypes mr_no_quant -- The co_var_tvs are tvs mentioned in the types of covars or -- coercion holes. We can't quantify over these covars, so we @@ -1448,30 +1451,33 @@ decideAndPromoteTyVars top_lvl rhs_tclvl infer_mode name_taus psigs wanted ++ tau_tys ++ post_mr_quant) co_var_tvs = closeOverKinds co_vars - -- outer_tvs are mentioned in `wanted, and belong to some outer level. + -- outer_tvs are mentioned in `wanted`, and belong to some outer level. -- We definitely can't quantify over them outer_tvs = outerLevelTyVars rhs_tclvl $ - tyCoVarsOfTypes can_quant `unionVarSet` tyCoVarsOfTypes no_quant + can_quant_tvs `unionVarSet` no_quant_tvs - -- Step 3 of Note [decideAndPromoteTyVars] + -- Step 3 of Note [decideAndPromoteTyVars], (a-c) -- Identify mono_tvs: the type variables that we must not quantify over + -- At top level we are much less keen to create mono tyvars, to avoid + -- spooky action at a distance. mono_tvs_without_mr - | is_top_level = outer_tvs - | otherwise = outer_tvs -- (a) - `unionVarSet` tyCoVarsOfTypes no_quant -- (b) - `unionVarSet` co_var_tvs -- (c) + | is_top_level = outer_tvs -- See (DP2) + | otherwise = outer_tvs -- (a) + `unionVarSet` no_quant_tvs -- (b) + `unionVarSet` co_var_tvs -- (c) + -- Step 3 of Note [decideAndPromoteTyVars], (d) mono_tvs_with_mr = -- Even at top level, we don't quantify over type variables -- mentioned in constraints that the MR tells us not to quantify -- See Note [decideAndPromoteTyVars] (DP2) - mono_tvs_without_mr `unionVarSet` tyCoVarsOfTypes mr_no_quant + mono_tvs_without_mr `unionVarSet` mr_no_quant_tvs -------------------------------------------------------------------- -- Step 4 of Note [decideAndPromoteTyVars] -- Use closeWrtFunDeps to find any other variables that are determined by mono_tvs - add_determined tvs = closeWrtFunDeps post_mr_quant tvs - `delVarSetList` psig_qtvs + add_determined tvs preds = closeWrtFunDeps preds tvs + `delVarSetList` psig_qtvs -- Why delVarSetList psig_qtvs? -- If the user has explicitly asked for quantification, then that -- request "wins" over the MR. @@ -1480,8 +1486,8 @@ decideAndPromoteTyVars top_lvl rhs_tclvl infer_mode name_taus psigs wanted -- (i.e. says "no" to isQuantifiableTv)? That's OK: explanation -- in Step 2 of Note [Deciding quantification]. - mono_tvs_with_mr_det = add_determined mono_tvs_with_mr - mono_tvs_without_mr_det = add_determined mono_tvs_without_mr + mono_tvs_with_mr_det = add_determined mono_tvs_with_mr post_mr_quant + mono_tvs_without_mr_det = add_determined mono_tvs_without_mr can_quant -------------------------------------------------------------------- -- Step 5 of Note [decideAndPromoteTyVars] @@ -1518,7 +1524,7 @@ decideAndPromoteTyVars top_lvl rhs_tclvl infer_mode name_taus psigs wanted , text "newly_mono_tvs =" <+> ppr newly_mono_tvs , text "can_quant =" <+> ppr can_quant , text "post_mr_quant =" <+> ppr post_mr_quant - , text "no_quant =" <+> ppr no_quant + , text "no_quant_tvs =" <+> ppr no_quant_tvs , text "mr_no_quant =" <+> ppr mr_no_quant , text "final_quant =" <+> ppr final_quant , text "co_vars =" <+> ppr co_vars ] @@ -1605,8 +1611,8 @@ The plan The body of z tries to unify the type of x (call it alpha[1]) with (beta[2] -> gamma[2]). This unification fails because alpha is untouchable, leaving [W] alpha[1] ~ (beta[2] -> gamma[2]) - We need to know not to quantify over beta or gamma, because they are in the - equality constraint with alpha. Actual test case: typecheck/should_compile/tc213 + We don't want to quantify over beta or gamma because they are fixed by alpha, + which is monomorphic. Actual test case: typecheck/should_compile/tc213 Another example. Suppose we have class C a b | a -> b @@ -1643,9 +1649,22 @@ Wrinkles promote type variables. But for bindings affected by the MR we have no choice but to promote. + An example is in #26004. + f w e = case e of + T1 -> let y = not w in False + T2 -> True + When generalising `f` we have a constraint + forall. (a ~ Bool) => alpha ~ Bool + where our provisional type for `f` is `f :: T alpha -> blah`. + In a /nested/ setting, we might simply not-generalise `f`, hoping to learn + about `alpha` from f's call sites (test T5266b is an example). But at top + level, to avoid spooky action at a distance. + Note [The top-level Any principle] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Key principle: we never want to show the programmer a type with `Any` in it. +Key principles: + * we never want to show the programmer a type with `Any` in it. + * avoid "spooky action at a distance" and silent defaulting Most /top level/ bindings have a type signature, so none of this arises. But where a top-level binding lacks a signature, we don't want to infer a type like @@ -1654,11 +1673,18 @@ and then subsequently default alpha[0]:=Any. Exposing `Any` to the user is bad bad bad. Better to report an error, which is what may well happen if we quantify over alpha instead. +Moreover, + * If (elsewhere in this module) we add a call to `f`, say (f True), then + `f` will get the type `Bool -> Int` + * If we add /another/ call, say (f 'x'), we will then get a type error. + * If we have no calls, the final exported type of `f` may get set by + defaulting, and might not be principal (#26004). + For /nested/ bindings, a monomorphic type like `f :: alpha[0] -> Int` is fine, because we can see all the call sites of `f`, and they will probably fix `alpha`. In contrast, we can't see all of (or perhaps any of) the calls of top-level (exported) functions, reducing the worries about "spooky action at a -distance". +distance". This also moves in the direction of `MonoLocalBinds`, which we like. Note [Do not quantify over constraints that determine a variable] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -374,20 +374,20 @@ instance Outputable InertSet where where dicts = bagToList (dictsToBag solved_dicts) -emptyInertCans :: InertCans -emptyInertCans +emptyInertCans :: TcLevel -> InertCans +emptyInertCans given_eq_lvl = IC { inert_eqs = emptyTyEqs , inert_funeqs = emptyFunEqs - , inert_given_eq_lvl = topTcLevel + , inert_given_eq_lvl = given_eq_lvl , inert_given_eqs = False , inert_dicts = emptyDictMap , inert_safehask = emptyDictMap , inert_insts = [] , inert_irreds = emptyBag } -emptyInert :: InertSet -emptyInert - = IS { inert_cans = emptyInertCans +emptyInert :: TcLevel -> InertSet +emptyInert given_eq_lvl + = IS { inert_cans = emptyInertCans given_eq_lvl , inert_cycle_breakers = emptyBag :| [] , inert_famapp_cache = emptyFunEqs , inert_solved_dicts = emptyDictMap } @@ -678,6 +678,23 @@ should update inert_given_eq_lvl? imply nominal ones. For example, if (G a ~R G b) and G's argument's role is nominal, then we can deduce a ~N b. +(TGE6) A subtle point is this: when initialising the solver, giving it + an empty InertSet, we must conservatively initialise `inert_given_lvl` + to the /current/ TcLevel. This matters when doing let-generalisation. + Consider #26004: + f w e = case e of + T1 -> let y = not w in False -- T1 is a GADT + T2 -> True + When let-generalising `y`, we will have (w :: alpha[1]) in the type + envt; and we are under GADT pattern match. So when we solve the + constraints from y's RHS, in simplifyInfer, we must NOT unify + alpha[1] := Bool + Since we don't know what enclosing equalities there are, we just + conservatively assume that there are some. + + This initialisation in done in `runTcSWithEvBinds`, which passes + the current TcLevl to `emptyInert`. + Historical note: prior to #24938 we also ignored Given equalities that did not mention an "outer" type variable. But that is wrong, as #24938 showed. Another example is immortalised in test LocalGivenEqs2 ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Tc.Solver.Monad ( runTcSSpecPrag, failTcS, warnTcS, addErrTcS, wrapTcS, ctLocWarnTcS, runTcSEqualities, - nestTcS, nestImplicTcS, setEvBindsTcS, + nestTcS, nestImplicTcS, setEvBindsTcS, setTcLevelTcS, emitImplicationTcS, emitTvImplicationTcS, emitImplication, emitFunDepWanteds, @@ -947,8 +947,9 @@ added. This is initialised from the innermost implication constraint. -- | See Note [TcSMode] data TcSMode = TcSVanilla -- ^ Normal constraint solving + | TcSPMCheck -- ^ Used when doing patterm match overlap checks | TcSEarlyAbort -- ^ Abort early on insoluble constraints - | TcSSpecPrag -- ^ Fully solve all constraints + | TcSSpecPrag -- ^ Fully solve all constraints deriving (Eq) {- Note [TcSMode] @@ -957,6 +958,11 @@ The constraint solver can operate in different modes: * TcSVanilla: Normal constraint solving mode. This is the default. +* TcSPMCheck: Used by the pattern match overlap checker. + Like TcSVanilla, but the idea is that the returned InertSet will + later be resumed, so we do not want to restore type-equality cycles + See also Note [Type equality cycles] in GHC.Tc.Solver.Equality + * TcSEarlyAbort: Abort (fail in the monad) as soon as we come across an insoluble constraint. This is used to fail-fast when checking for hole-fits. See Note [Speeding up valid hole-fits]. @@ -1135,7 +1141,7 @@ runTcS tcs runTcSEarlyAbort :: TcS a -> TcM a runTcSEarlyAbort tcs = do { ev_binds_var <- TcM.newTcEvBinds - ; runTcSWithEvBinds' True TcSEarlyAbort ev_binds_var tcs } + ; runTcSWithEvBinds' TcSEarlyAbort ev_binds_var tcs } -- | Run the 'TcS' monad in 'TcSSpecPrag' mode, which either fully solves -- individual Wanted quantified constraints or leaves them alone. @@ -1143,7 +1149,7 @@ runTcSEarlyAbort tcs -- See Note [TcSSpecPrag]. runTcSSpecPrag :: EvBindsVar -> TcS a -> TcM a runTcSSpecPrag ev_binds_var tcs - = runTcSWithEvBinds' True TcSSpecPrag ev_binds_var tcs + = runTcSWithEvBinds' TcSSpecPrag ev_binds_var tcs {- Note [TcSSpecPrag] ~~~~~~~~~~~~~~~~~~~~~ @@ -1200,7 +1206,7 @@ runTcSEqualities thing_inside runTcSInerts :: InertSet -> TcS a -> TcM (a, InertSet) runTcSInerts inerts tcs = do ev_binds_var <- TcM.newTcEvBinds - runTcSWithEvBinds' False TcSVanilla ev_binds_var $ do + runTcSWithEvBinds' TcSPMCheck ev_binds_var $ do setInertSet inerts a <- tcs new_inerts <- getInertSet @@ -1209,21 +1215,23 @@ runTcSInerts inerts tcs = do runTcSWithEvBinds :: EvBindsVar -> TcS a -> TcM a -runTcSWithEvBinds = runTcSWithEvBinds' True TcSVanilla +runTcSWithEvBinds = runTcSWithEvBinds' TcSVanilla -runTcSWithEvBinds' :: Bool -- True <=> restore type equality cycles - -- Don't if you want to reuse the InertSet. - -- See also Note [Type equality cycles] - -- in GHC.Tc.Solver.Equality - -> TcSMode +runTcSWithEvBinds' :: TcSMode -> EvBindsVar -> TcS a -> TcM a -runTcSWithEvBinds' restore_cycles mode ev_binds_var tcs +runTcSWithEvBinds' mode ev_binds_var tcs = do { unified_var <- TcM.newTcRef 0 - ; step_count <- TcM.newTcRef 0 - ; inert_var <- TcM.newTcRef emptyInert - ; wl_var <- TcM.newTcRef emptyWorkList + ; step_count <- TcM.newTcRef 0 + + -- Make a fresh, empty inert set + -- Subtle point: see (TGE6) in Note [Tracking Given equalities] + -- in GHC.Tc.Solver.InertSet + ; tc_lvl <- TcM.getTcLevel + ; inert_var <- TcM.newTcRef (emptyInert tc_lvl) + + ; wl_var <- TcM.newTcRef emptyWorkList ; unif_lvl_var <- TcM.newTcRef Nothing ; let env = TcSEnv { tcs_ev_binds = ev_binds_var , tcs_unified = unified_var @@ -1240,9 +1248,13 @@ runTcSWithEvBinds' restore_cycles mode ev_binds_var tcs ; when (count > 0) $ csTraceTcM $ return (text "Constraint solver steps =" <+> int count) - ; when restore_cycles $ - do { inert_set <- TcM.readTcRef inert_var - ; restoreTyVarCycles inert_set } + -- Restore tyvar cycles: see Note [Type equality cycles] in + -- GHC.Tc.Solver.Equality + -- But /not/ in TCsPMCheck mode: see Note [TcSMode] + ; case mode of + TcSPMCheck -> return () + _ -> do { inert_set <- TcM.readTcRef inert_var + ; restoreTyVarCycles inert_set } #if defined(DEBUG) ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var @@ -1284,6 +1296,10 @@ setEvBindsTcS :: EvBindsVar -> TcS a -> TcS a setEvBindsTcS ref (TcS thing_inside) = TcS $ \ env -> thing_inside (env { tcs_ev_binds = ref }) +setTcLevelTcS :: TcLevel -> TcS a -> TcS a +setTcLevelTcS lvl (TcS thing_inside) + = TcS $ \ env -> TcM.setTcLevel lvl (thing_inside env) + nestImplicTcS :: EvBindsVar -> TcLevel -> TcS a -> TcS a ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -1743,24 +1743,21 @@ will be able to report a more informative error: ************************************************************************ -} -type ApproxWC = ( Bag Ct -- Free quantifiable constraints - , Bag Ct ) -- Free non-quantifiable constraints - -- due to shape, or enclosing equality +type ApproxWC = ( Bag Ct -- Free quantifiable constraints + , TcTyCoVarSet ) -- Free vars of non-quantifiable constraints + -- due to shape, or enclosing equality approximateWC :: Bool -> WantedConstraints -> Bag Ct approximateWC include_non_quantifiable cts - | include_non_quantifiable = quant `unionBags` no_quant - | otherwise = quant - where - (quant, no_quant) = approximateWCX cts + = fst (approximateWCX include_non_quantifiable cts) -approximateWCX :: WantedConstraints -> ApproxWC +approximateWCX :: Bool -> WantedConstraints -> ApproxWC -- The "X" means "extended"; -- we return both quantifiable and non-quantifiable constraints -- See Note [ApproximateWC] -- See Note [floatKindEqualities vs approximateWC] -approximateWCX wc - = float_wc False emptyVarSet wc (emptyBag, emptyBag) +approximateWCX include_non_quantifiable wc + = float_wc False emptyVarSet wc (emptyBag, emptyVarSet) where float_wc :: Bool -- True <=> there are enclosing equalities -> TcTyCoVarSet -- Enclosing skolem binders @@ -1786,17 +1783,23 @@ approximateWCX wc -- There can be (insoluble) Given constraints in wc_simple, -- there so that we get error reports for unreachable code -- See `given_insols` in GHC.Tc.Solver.Solve.solveImplication - | insolubleCt ct = acc - | tyCoVarsOfCt ct `intersectsVarSet` skol_tvs = acc - | otherwise - = case classifyPredType (ctPred ct) of + | insolubleCt ct = acc + | pred_tvs `intersectsVarSet` skol_tvs = acc + | include_non_quantifiable = add_to_quant + | is_quantifiable encl_eqs (ctPred ct) = add_to_quant + | otherwise = add_to_no_quant + where + pred = ctPred ct + pred_tvs = tyCoVarsOfType pred + add_to_quant = (ct `consBag` quant, no_quant) + add_to_no_quant = (quant, no_quant `unionVarSet` pred_tvs) + + is_quantifiable encl_eqs pred + = case classifyPredType pred of -- See the classification in Note [ApproximateWC] EqPred eq_rel ty1 ty2 - | not encl_eqs -- See Wrinkle (W1) - , quantify_equality eq_rel ty1 ty2 - -> add_to_quant - | otherwise - -> add_to_no_quant + | encl_eqs -> False -- encl_eqs: See Wrinkle (W1) + | otherwise -> quantify_equality eq_rel ty1 ty2 ClassPred cls tys | Just {} <- isCallStackPred cls tys @@ -1804,17 +1807,14 @@ approximateWCX wc -- the constraints bubble up to be solved from the outer -- context, or be defaulted when we reach the top-level. -- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence - -> add_to_no_quant + -> False | otherwise - -> add_to_quant -- See Wrinkle (W2) + -> True -- See Wrinkle (W2) - IrredPred {} -> add_to_quant -- See Wrinkle (W2) + IrredPred {} -> True -- See Wrinkle (W2) - ForAllPred {} -> add_to_no_quant -- Never quantify these - where - add_to_quant = (ct `consBag` quant, no_quant) - add_to_no_quant = (quant, ct `consBag` no_quant) + ForAllPred {} -> False -- Never quantify these -- See Note [Quantifying over equality constraints] quantify_equality NomEq ty1 ty2 = quant_fun ty1 || quant_fun ty2 @@ -1852,7 +1852,7 @@ We proceed by classifying the constraint: Wrinkle (W1) When inferring most-general types (in simplifyInfer), we - do *not* float an equality constraint if the implication binds + do *not* quantify over equality constraint if the implication binds equality constraints, because that defeats the OutsideIn story. Consider data T a where { TInt :: T Int; MkT :: T a } f TInt = 3::Int ===================================== testsuite/tests/typecheck/should_fail/T26004.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NoMonoLocalBinds #-} + +module T26004 where + +data T a where + T1 :: T Bool + T2 :: T a + +-- This funcion should be rejected: +-- we should not infer a non-principal type for `f` +f w e = case e of + T1 -> let y = not w in False + T2 -> True ===================================== testsuite/tests/typecheck/should_fail/T26004.stderr ===================================== @@ -0,0 +1,17 @@ + +T26004.hs:13:21: error: [GHC-25897] + • Could not deduce ‘p ~ Bool’ + from the context: a ~ Bool + bound by a pattern with constructor: T1 :: T Bool, + in a case alternative + at T26004.hs:13:3-4 + ‘p’ is a rigid type variable bound by + the inferred type of f :: p -> T a -> Bool + at T26004.hs:(12,1)-(14,12) + • In the first argument of ‘not’, namely ‘w’ + In the expression: not w + In an equation for ‘y’: y = not w + • Relevant bindings include + w :: p (bound at T26004.hs:12:3) + f :: p -> T a -> Bool (bound at T26004.hs:12:1) + Suggested fix: Consider giving ‘f’ a type signature ===================================== testsuite/tests/typecheck/should_fail/T7453.stderr ===================================== @@ -1,8 +1,5 @@ - -T7453.hs:9:15: error: [GHC-25897] - • Couldn't match type ‘t’ with ‘p’ - Expected: Id t - Actual: Id p +T7453.hs:10:30: error: [GHC-25897] + • Couldn't match expected type ‘t’ with actual type ‘p’ ‘t’ is a rigid type variable bound by the type signature for: z :: forall t. Id t @@ -10,29 +7,17 @@ T7453.hs:9:15: error: [GHC-25897] ‘p’ is a rigid type variable bound by the inferred type of cast1 :: p -> a at T7453.hs:(7,1)-(10,30) - • In the expression: aux - In an equation for ‘z’: - z = aux - where - aux = Id v - In an equation for ‘cast1’: - cast1 v - = runId z - where - z :: Id t - z = aux - where - aux = Id v + • In the first argument of ‘Id’, namely ‘v’ + In the expression: Id v + In an equation for ‘aux’: aux = Id v • Relevant bindings include - aux :: Id p (bound at T7453.hs:10:21) + aux :: Id t (bound at T7453.hs:10:21) z :: Id t (bound at T7453.hs:9:11) v :: p (bound at T7453.hs:7:7) cast1 :: p -> a (bound at T7453.hs:7:1) -T7453.hs:15:15: error: [GHC-25897] - • Couldn't match type ‘t1’ with ‘p’ - Expected: () -> t1 - Actual: () -> p +T7453.hs:16:33: error: [GHC-25897] + • Couldn't match expected type ‘t1’ with actual type ‘p’ ‘t1’ is a rigid type variable bound by the type signature for: z :: forall t1. () -> t1 @@ -40,21 +25,11 @@ T7453.hs:15:15: error: [GHC-25897] ‘p’ is a rigid type variable bound by the inferred type of cast2 :: p -> t at T7453.hs:(13,1)-(16,33) - • In the expression: aux - In an equation for ‘z’: - z = aux - where - aux = const v - In an equation for ‘cast2’: - cast2 v - = z () - where - z :: () -> t - z = aux - where - aux = const v + • In the first argument of ‘const’, namely ‘v’ + In the expression: const v + In an equation for ‘aux’: aux = const v • Relevant bindings include - aux :: forall {b}. b -> p (bound at T7453.hs:16:21) + aux :: b -> t1 (bound at T7453.hs:16:21) z :: () -> t1 (bound at T7453.hs:15:11) v :: p (bound at T7453.hs:13:7) cast2 :: p -> t (bound at T7453.hs:13:1) @@ -86,3 +61,4 @@ T7453.hs:21:15: error: [GHC-25897] z :: t1 (bound at T7453.hs:21:11) v :: p (bound at T7453.hs:19:7) cast3 :: p -> t (bound at T7453.hs:19:1) + ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -735,3 +735,4 @@ test('T24938', normal, compile_fail, ['']) test('T25325', normal, compile_fail, ['']) test('T25004', normal, compile_fail, ['']) test('T25004k', normal, compile_fail, ['']) +test('T26004', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/165f98d86f59b783511f8015dc1e547… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/165f98d86f59b783511f8015dc1e547… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 2 commits: Refactor mkTopLevImportedEnv out of mkTopLevEnv
by Marge Bot (＠marge-bot) 06 May '25

06 May '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e46c6b18 by Rodrigo Mesquita at 2025-05-06T09:01:57-04:00 Refactor mkTopLevImportedEnv out of mkTopLevEnv This makes the code clearer and allows the top-level import context to be fetched directly from the HomeModInfo through the API (e.g. useful for the debugger). - - - - - 0ce0d263 by Rodrigo Mesquita at 2025-05-06T09:01:57-04:00 Export sizeOccEnv from GHC.Types.Name.Occurrence Counts the number of OccNames in an OccEnv - - - - - 2 changed files: - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Types/Name/Occurrence.hs Changes: ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -23,7 +23,7 @@ module GHC.Runtime.Eval ( setupBreakpoint, back, forward, setContext, getContext, - mkTopLevEnv, + mkTopLevEnv, mkTopLevImportedEnv, getNamesInScope, getRdrNamesInScope, moduleIsInterpreted, @@ -836,29 +836,36 @@ mkTopLevEnv hsc_env modl Nothing -> pure $ Left "not a home module" Just details -> case mi_top_env (hm_iface details) of - (IfaceTopEnv exports imports) -> do - imports_env <- - runInteractiveHsc hsc_env - $ ioMsgMaybe $ hoistTcRnMessage $ runTcInteractive hsc_env - $ fmap (foldr plusGlobalRdrEnv emptyGlobalRdrEnv) - $ forM imports $ \iface_import -> do - let ImpUserSpec spec details = tcIfaceImport iface_import - iface <- loadInterfaceForModule (text "imported by GHCi") (is_mod spec) - pure $ case details of - ImpUserAll -> importsFromIface hsc_env iface spec Nothing - ImpUserEverythingBut ns -> importsFromIface hsc_env iface spec (Just ns) - ImpUserExplicit x _parents_of_implicits -> - -- TODO: Not quite right, is_explicit should refer to whether the user wrote A(..) or A(x,y). - -- It is only used for error messages. It seems dubious even to add an import context to these GREs as - -- they are not "imported" into the top-level scope of the REPL. I changed this for now so that - -- the test case produce the same output as before. - let spec' = ImpSpec { is_decl = spec, is_item = ImpSome { is_explicit = True, is_iloc = noSrcSpan } } - in mkGlobalRdrEnv $ gresFromAvails hsc_env (Just spec') x + (IfaceTopEnv exports _imports) -> do + imports_env <- mkTopLevImportedEnv hsc_env details let exports_env = mkGlobalRdrEnv $ gresFromAvails hsc_env Nothing (getDetOrdAvails exports) pure $ Right $ plusGlobalRdrEnv imports_env exports_env where hpt = hsc_HPT hsc_env +-- | Make the top-level environment with all bindings imported by this module. +-- Exported bindings from this module are not included in the result. +mkTopLevImportedEnv :: HscEnv -> HomeModInfo -> IO GlobalRdrEnv +mkTopLevImportedEnv hsc_env details = do + runInteractiveHsc hsc_env + $ ioMsgMaybe $ hoistTcRnMessage $ runTcInteractive hsc_env + $ fmap (foldr plusGlobalRdrEnv emptyGlobalRdrEnv) + $ forM imports $ \iface_import -> do + let ImpUserSpec spec details = tcIfaceImport iface_import + iface <- loadInterfaceForModule (text "imported by GHCi") (is_mod spec) + pure $ case details of + ImpUserAll -> importsFromIface hsc_env iface spec Nothing + ImpUserEverythingBut ns -> importsFromIface hsc_env iface spec (Just ns) + ImpUserExplicit x _parents_of_implicits -> + -- TODO: Not quite right, is_explicit should refer to whether the user wrote A(..) or A(x,y). + -- It is only used for error messages. It seems dubious even to add an import context to these GREs as + -- they are not "imported" into the top-level scope of the REPL. I changed this for now so that + -- the test case produce the same output as before. + let spec' = ImpSpec { is_decl = spec, is_item = ImpSome { is_explicit = True, is_iloc = noSrcSpan } } + in mkGlobalRdrEnv $ gresFromAvails hsc_env (Just spec') x + where + IfaceTopEnv _ imports = mi_top_env (hm_iface details) + -- | Get the interactive evaluation context, consisting of a pair of the -- set of modules from which we take the full top-level scope, and the set -- of modules from which we take just the exports respectively. ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -92,6 +92,7 @@ module GHC.Types.Name.Occurrence ( plusOccEnv, plusOccEnv_C, extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv, alterOccEnv, minusOccEnv, minusOccEnv_C, minusOccEnv_C_Ns, + sizeOccEnv, pprOccEnv, forceOccEnv, intersectOccEnv_C, @@ -803,6 +804,10 @@ minusOccEnv_C_Ns f (MkOccEnv as) (MkOccEnv bs) = then Nothing else Just m +sizeOccEnv :: OccEnv a -> Int +sizeOccEnv (MkOccEnv as) = + nonDetStrictFoldUFM (\ m !acc -> acc + sizeUFM m) 0 as + instance Outputable a => Outputable (OccEnv a) where ppr x = pprOccEnv ppr x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/50fa8165155cea820ec45e1bd77eb4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/50fa8165155cea820ec45e1bd77eb4… You're receiving this email because of your account on gitlab.haskell.org.

1 0