- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/T26746] 6 commits: testsuite: remove obsolete --ci option from the testsuite driver
by Simon Peyton Jones (＠simonpj) 15 Jan '26

15 Jan '26

Simon Peyton Jones pushed to branch wip/T26746 at Glasgow Haskell Compiler / GHC Commits: f25e2b12 by Cheng Shao at 2026-01-14T11:10:39-05:00 testsuite: remove obsolete --ci option from the testsuite driver This patch removes the obsolete `--ci` option from the testsuite driver: neither the CI scripts nor hadrian ever invokes the testsuite driver with `--ci`, and the perf notes are always fetched to the `refs/notes/perf` local reference anyway. - - - - - 7964763b by Julian Ospald at 2026-01-14T11:11:31-05:00 Fix fetch_cabal * download cabal if the existing one is of an older version * fix FreeBSD download url * fix unpacking on FreeBSD - - - - - 6b0129c1 by Julian Ospald at 2026-01-14T11:11:31-05:00 Bump toolchain in CI - - - - - 0f53ccc6 by Julian Ospald at 2026-01-14T11:11:31-05:00 Use libffi-clib Previously, we would build libffi via hadrian and bundle it manually with the GHC bindist. This now moves all that logic out of hadrian and allows us to have a clean Haskell package to build and link against and ship it without extra logic. This patch still retains the ability to link against a system libffi. The main reason of bundling libffi was that on some platforms (e.g. FreeBSD and Mac), system libffi is not visible to the C toolchain by default, so users would require settings in e.g. cabal to be able to compile anything. This adds the submodule libffi-clib to the repository. - - - - - 5e1cd595 by Peng Fan at 2026-01-14T11:12:26-05:00 NCG/LA64: add support for la664 micro architecture Add '-mla664' flag to LA664, which has some new features: atomic instructions, dbar hints, etc. 'LA464' is the default so that unrecognized instructions are not generated. - - - - - 2091ee71 by Simon Peyton Jones at 2026-01-15T14:07:36+00:00 Improve newtype unwrapping Ticket #26746 describes several relatively-minor shortcomings of newtype unwrapping. This MR addresses them, while also (arguably) simplifying the code a bit. See new Note [Solving newtype equalities: overview] and Note [Decomposing newtype equalities] and Note [Eager newtype decomposition] and Note [Even more eager newtype decomposition] For some reason, on Windows only, runtime allocations decrease for test T5205 (from 52k to 48k). I have not idea why. No change at all on Linux. I'm just going to accept the change. (I saw this same effect in another MR so I think it's a fault in the baseline.) Metric Decrease: T5205 - - - - - 48 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Unit.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Unit/State.hs - docs/users_guide/using.rst - hadrian/hadrian.cabal - hadrian/src/Builder.hs - hadrian/src/Packages.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - − hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Rules/SourceDist.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - − libffi-tarballs - + libraries/libffi-clib - packages - rts/include/rts/ghc_ffi.h - rts/rts.buildinfo.in - rts/rts.cabal - testsuite/driver/perf_notes.py - testsuite/tests/deriving/should_fail/T8984.stderr - testsuite/tests/deriving/should_fail/deriving-via-fail.stderr - testsuite/tests/deriving/should_fail/deriving-via-fail4.stderr - testsuite/tests/deriving/should_fail/deriving-via-fail5.stderr - + testsuite/tests/typecheck/should_compile/T26746.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T15801.stderr - testsuite/tests/typecheck/should_fail/T22924b.stderr - testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs - testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr - testsuite/tests/typecheck/should_fail/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a01ec3040139b7ad4666e96f8d593… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a01ec3040139b7ad4666e96f8d593… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/26737] Make the implicit-parameter class have representational role
by Simon Peyton Jones (＠simonpj) 15 Jan '26

15 Jan '26

Simon Peyton Jones pushed to branch wip/26737 at Glasgow Haskell Compiler / GHC Commits: eae63c44 by Simon Peyton Jones at 2026-01-15T14:00:56+00:00 Make the implicit-parameter class have representational role This MR addresses #26737, by making the built-in class IP have a representational role for its second parameter. See Note [IP: implicit parameter class] in ghc-internal:GHC.Internal.Classes.IP In fact, IP is (unfortunately, currently) exposed by base:GHC.Base, so we ran a quick CLC proposal to agree the change: https://github.com/haskell/core-libraries-committee/issues/385 For some reason, on Windows only, runtime allocations decrease for test T5205 (from 52k to 48k). I have not idea why. No change at all on Linux. I'm just going to accept the change. Metric Decrease: T5205 - - - - - 10 changed files: - compiler/GHC/Builtin/Names.hs - docs/users_guide/9.16.1-notes.rst - libraries/ghc-internal/ghc-internal.cabal.in - libraries/ghc-internal/src/GHC/Internal/Classes.hs - + libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/th/TH_implicitParams.stdout - + testsuite/tests/typecheck/should_compile/T26737.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -526,7 +526,7 @@ genericTyConNames = [ gHC_PRIM, gHC_PRIM_PANIC, gHC_TYPES, gHC_INTERNAL_DATA_DATA, gHC_MAGIC, gHC_MAGIC_DICT, - gHC_CLASSES, gHC_PRIMOPWRAPPERS :: Module + gHC_CLASSES, gHC_CLASSES_IP, gHC_PRIMOPWRAPPERS :: Module gHC_PRIM = mkGhcInternalModule (fsLit "GHC.Internal.Prim") -- Primitive types and values gHC_PRIM_PANIC = mkGhcInternalModule (fsLit "GHC.Internal.Prim.Panic") gHC_TYPES = mkGhcInternalModule (fsLit "GHC.Internal.Types") @@ -534,6 +534,7 @@ gHC_MAGIC = mkGhcInternalModule (fsLit "GHC.Internal.Magic") gHC_MAGIC_DICT = mkGhcInternalModule (fsLit "GHC.Internal.Magic.Dict") gHC_CSTRING = mkGhcInternalModule (fsLit "GHC.Internal.CString") gHC_CLASSES = mkGhcInternalModule (fsLit "GHC.Internal.Classes") +gHC_CLASSES_IP = mkGhcInternalModule (fsLit "GHC.Internal.Classes.IP") gHC_PRIMOPWRAPPERS = mkGhcInternalModule (fsLit "GHC.Internal.PrimopWrappers") gHC_INTERNAL_TUPLE = mkGhcInternalModule (fsLit "GHC.Internal.Tuple") @@ -1521,7 +1522,7 @@ fromLabelClassOpName -- Implicit Parameters ipClassName :: Name ipClassName - = clsQual gHC_CLASSES (fsLit "IP") ipClassKey + = clsQual gHC_CLASSES_IP (fsLit "IP") ipClassKey -- Overloaded record fields hasFieldClassName :: Name ===================================== docs/users_guide/9.16.1-notes.rst ===================================== @@ -30,6 +30,18 @@ Language - The extension :extension:`ExplicitNamespaces` now allows namespace-specified wildcards ``type ..`` and ``data ..`` in import and export lists. +- Implicit parameters and ``ImpredicativeTypes``. GHC now knows + that if ``?foo::S`` is coecible to ``?foo::T`` only if ``S`` is coercible to ``T``. + Example (from :ghc-ticket:`#26737`):: + + {-# LANGUAGE ImplicitParams, ImpredicativeTypes #-} + newtype N = MkN Int + test :: ((?foo::N) => Bool) -> ((?foo::Int) => Bool) + test = coerce + + This is achieved by arranging that ``?foo :: T`` has a representational + role for ``T``. + Compiler ~~~~~~~~ ===================================== libraries/ghc-internal/ghc-internal.cabal.in ===================================== @@ -343,6 +343,7 @@ Library GHC.Internal.CString GHC.Internal.Classes + GHC.Internal.Classes.IP GHC.Internal.Debug GHC.Internal.Magic GHC.Internal.Magic.Dict ===================================== libraries/ghc-internal/src/GHC/Internal/Classes.hs ===================================== @@ -1,10 +1,9 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns, KindSignatures, DataKinds, ConstraintKinds, - MultiParamTypeClasses, FunctionalDependencies #-} -{-# LANGUAGE UnboxedTuples #-} -{-# LANGUAGE AllowAmbiguousTypes #-} - -- ip :: IP x a => a is strictly speaking ambiguous, but IP is magic + MultiParamTypeClasses, FunctionalDependencies, + UnboxedTuples #-} + {-# LANGUAGE UndecidableSuperClasses #-} -- Because of the type-variable superclasses for tuples @@ -142,6 +141,7 @@ import GHC.Internal.Prim import GHC.Internal.Tuple import GHC.Internal.CString (unpackCString#) import GHC.Internal.Types +import GHC.Internal.Classes.IP infix 4 ==, /=, <, <=, >=, > infixr 3 && @@ -149,12 +149,6 @@ infixr 2 || default () -- Double isn't available yet --- | The syntax @?x :: a@ is desugared into @IP "x" a@ --- IP is declared very early, so that libraries can take --- advantage of the implicit-call-stack feature -class IP (x :: Symbol) a | x -> a where - ip :: a - {- $matching_overloaded_methods_in_rules Matching on class methods (e.g. @(==)@) in rewrite rules tends to be a bit ===================================== libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs ===================================== @@ -0,0 +1,87 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns, + KindSignatures, DataKinds, ConstraintKinds, + MultiParamTypeClasses, FunctionalDependencies #-} + +{-# LANGUAGE AllowAmbiguousTypes, RoleAnnotations, IncoherentInstances #-} + -- LANGUAGE pragmas: see Note [IP: implicit parameter class] + +{-# OPTIONS_HADDOCK not-home #-} +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Internal.Classes.IP +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : ghc-devs(a)haskell.org +-- Stability : internal +-- Portability : non-portable (GHC extensions) +-- +-- Basic classes. +-- Do not import this module directly. It is an GHC internal only +-- module. Some of its contents are instead available from @Prelude@ +-- and @GHC.Int@. +-- +----------------------------------------------------------------------------- + +module GHC.Internal.Classes.IP( IP(..)) where + +import GHC.Internal.Types + + +default () -- Double isn't available yet + +-- | The syntax @?x :: a@ is desugared into @IP "x" a@ +-- IP is declared very early, so that libraries can take +-- advantage of the implicit-call-stack feature +type role IP nominal representational -- See (IPRoles) +class IP (x :: Symbol) a | x -> a where + ip :: a + +{- Note [IP: implicit parameter class] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +An implicit parameter constraint (?foo::ty) is just short for + + IP "foo" ty + +where ghc-internal:GHC.Internal.Classes.IP is a special class that +GHC knows about, defined in this module. + +* It is a unary type class, with one method `ip`, so it has no cost. + For example, (?foo::Int) is represented just by an Int. + +* Criticially, it has a functional dependency: + class IP (x :: Symbol) a | x -> a where ... + So if we have + [G] IP "foo" Int + [W] IP "foo" alpha + the fundep wil lgive us alpha ~ Int, as desired. + +* The solver has a number of special cases for implicit parameters, + mainly because a binding (let ?foo::Int = rhs in body) + is like a local instance declaration for IP. Search for uses + of `isIPClass`. + +Wrinkles + +(IPAmbiguity) The single method of IP has an ambiguous type + ip :: forall a. IP s a => a + Hence the LANGUAGE pragama AllowAmbiguousTypes. + The method `ip` is never called by the user, so ambiguity doesn't matter. + +(IPRoles) IP has a role annotation. Why? See #26737. We want + [W] IP "foo" t1 ~R# IP "foo" t2 + to decompose to give [W] IP t1 ~R# t2, using /representational/ + equality for (t1 ~R# t2) not nominal. + + This usually gives a complaint about incoherence, because in general + (t1 ~R# t2) does NOT imply (C t1) ~R# (C t2) for any normal class. + But it does for IP, because instance selection is controlled by the Symbol, + not the type of the payload. Hence LANGUAGE pragma IncoherentInstances. + (It is unfortunate that we need a module-wide IncoherentInstances here; + see #17167.) + + Side note: arguably this treatment could be applied to any class + with a functional dependency; but for now we restrict it to IP. +-} + ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -3293,6 +3293,7 @@ module GHC.Base where {-# MINIMAL fmap #-} type IO :: * -> * newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #)) + type role IP nominal representational type IP :: Symbol -> * -> Constraint class IP x a | x -> a where ip :: a ===================================== testsuite/tests/interface-stability/ghc-prim-exports.stdout ===================================== @@ -1171,6 +1171,7 @@ module GHC.Classes where (==) :: a -> a -> GHC.Internal.Types.Bool (/=) :: a -> a -> GHC.Internal.Types.Bool {-# MINIMAL (==) | (/=) #-} + type role IP nominal representational type IP :: GHC.Internal.Types.Symbol -> * -> Constraint class IP x a | x -> a where ip :: a ===================================== testsuite/tests/th/TH_implicitParams.stdout ===================================== @@ -1,5 +1,5 @@ -Main.funcToReify :: GHC.Internal.Classes.IP "z" - GHC.Internal.Types.Int => +Main.funcToReify :: GHC.Internal.Classes.IP.IP "z" + GHC.Internal.Types.Int => GHC.Internal.Types.Int 5 1 ===================================== testsuite/tests/typecheck/should_compile/T26737.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE ImpredicativeTypes, ImplicitParams #-} + +module T26737 where + +import Data.Coerce + +newtype Foo = MkFoo Int + +b :: ((?foo :: Foo) => Int) -> ((?foo :: Int) => Int) +b = coerce @(((?foo :: Foo) => Int)) @(((?foo :: Int) => Int)) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -957,3 +957,4 @@ test('T17705', normal, compile, ['']) test('T14745', normal, compile, ['']) test('T26451', normal, compile, ['']) test('T26582', normal, compile, ['']) +test('T26737', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eae63c442710b0d0e0521fab72acdb4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eae63c442710b0d0e0521fab72acdb4… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/26737] 10 commits: PPC NCG: Fix shift right MO code
by Simon Peyton Jones (＠simonpj) 15 Jan '26

15 Jan '26

Simon Peyton Jones pushed to branch wip/26737 at Glasgow Haskell Compiler / GHC Commits: c1fe0097 by Peter Trommler at 2026-01-14T03:54:49-05:00 PPC NCG: Fix shift right MO code The shift amount in shift right [arithmetic] MOs is machine word width. Therefore remove unnecessary zero- or sign-extending of shift amount. It looks harmless to extend the shift amount argument because the shift right instruction uses only the seven lowest bits (i. e. mod 128). But now we have a conversion operation from a smaller type to word width around a memory load at word width. The types are not matching up but there is no check done in CodeGen. The necessary conversion from word width down to the smaller width would be translated into a no-op on PowerPC anyway. So all seems harmless if it was not for a small optimisation in getRegister'. In getRegister' a load instruction with the smaller width of the conversion operation was generated. This loaded the most significant bits of the word in memory on a big-endian platform. These bits were zero and hence shift right was used with shift amount zero and not one as required in test Sized. Fixes #26519 - - - - - 2dafc65a by Cheng Shao at 2026-01-14T03:55:31-05:00 Tree-wide cleanup of cygwin logic GHC has not supported cygwin for quite a few years already, and will not resume support in the forseeable future. The only supported windows toolchain is clang64/clangarm64 of the msys2 project. This patch cleans up the unused cygwin logic in the tree. Co-authored-by: Codex <codex(a)openai.com> - - - - - 66b96e2a by Teo Camarasu at 2026-01-14T03:56:13-05:00 Set default eventlog-flush-interval to 5s Resolves #26707 - - - - - d0254579 by Andrew Lelechenko at 2026-01-14T03:56:53-05:00 Document when -maxN RTS option was added - - - - - f25e2b12 by Cheng Shao at 2026-01-14T11:10:39-05:00 testsuite: remove obsolete --ci option from the testsuite driver This patch removes the obsolete `--ci` option from the testsuite driver: neither the CI scripts nor hadrian ever invokes the testsuite driver with `--ci`, and the perf notes are always fetched to the `refs/notes/perf` local reference anyway. - - - - - 7964763b by Julian Ospald at 2026-01-14T11:11:31-05:00 Fix fetch_cabal * download cabal if the existing one is of an older version * fix FreeBSD download url * fix unpacking on FreeBSD - - - - - 6b0129c1 by Julian Ospald at 2026-01-14T11:11:31-05:00 Bump toolchain in CI - - - - - 0f53ccc6 by Julian Ospald at 2026-01-14T11:11:31-05:00 Use libffi-clib Previously, we would build libffi via hadrian and bundle it manually with the GHC bindist. This now moves all that logic out of hadrian and allows us to have a clean Haskell package to build and link against and ship it without extra logic. This patch still retains the ability to link against a system libffi. The main reason of bundling libffi was that on some platforms (e.g. FreeBSD and Mac), system libffi is not visible to the C toolchain by default, so users would require settings in e.g. cabal to be able to compile anything. This adds the submodule libffi-clib to the repository. - - - - - 5e1cd595 by Peng Fan at 2026-01-14T11:12:26-05:00 NCG/LA64: add support for la664 micro architecture Add '-mla664' flag to LA664, which has some new features: atomic instructions, dbar hints, etc. 'LA464' is the default so that unrecognized instructions are not generated. - - - - - c85d41bd by Simon Peyton Jones at 2026-01-15T13:43:57+00:00 Make the implicit-parameter class have representational role This MR addresses #26737, by making the built-in class IP have a representational role for its second parameter. See Note [IP: implicit parameter class] in ghc-internal:GHC.Internal.Classes.IP In fact, IP is (unfortunately, currently) exposed by base:GHC.Base, so we ran a quick CLC proposal to agree the change: https://github.com/haskell/core-libraries-committee/issues/385 - - - - - 67 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC/Builtin/Names.hs - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Unit.hs - compiler/GHC/SysTools/Terminal.hs - compiler/GHC/Unit/State.hs - configure.ac - docs/users_guide/9.16.1-notes.rst - docs/users_guide/packages.rst - docs/users_guide/using-concurrent.rst - docs/users_guide/using.rst - docs/users_guide/win32-dlls.rst - driver/ghci/ghci.c - driver/utils/cwrapper.c - driver/utils/isMinTTY.c - hadrian/bindist/cwrappers/cwrapper.c - hadrian/hadrian.cabal - hadrian/src/Builder.hs - hadrian/src/Packages.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - − hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Rules/SourceDist.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - hadrian/src/Settings/Program.hs - − libffi-tarballs - libraries/base/tests/IO/T12010/cbits/initWinSock.c - libraries/ghc-internal/cbits/consUtils.c - libraries/ghc-internal/configure.ac - libraries/ghc-internal/ghc-internal.cabal.in - libraries/ghc-internal/src/GHC/Internal/Classes.hs - + libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs - libraries/ghc-internal/src/GHC/Internal/ConsoleHandler.hsc - libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs - + libraries/libffi-clib - m4/ghc_select_file_extensions.m4 - packages - rts/RtsFlags.c - rts/include/rts/ghc_ffi.h - rts/rts.buildinfo.in - rts/rts.cabal - testsuite/driver/perf_notes.py - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/mk/test.mk - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/rts/linker/rdynamic.hs - testsuite/tests/th/TH_implicitParams.stdout - + testsuite/tests/typecheck/should_compile/T26737.hs - testsuite/tests/typecheck/should_compile/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ecc0f11c7f0dd24d1399004cfad592… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ecc0f11c7f0dd24d1399004cfad592… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-try-opt-coercion] 3 commits: Update Notes about core binding invariants
by Simon Peyton Jones (＠simonpj) 15 Jan '26

15 Jan '26

Simon Peyton Jones pushed to branch wip/spj-try-opt-coercion at Glasgow Haskell Compiler / GHC Commits: 88d60e1d by Simon Peyton Jones at 2026-01-15T12:56:19+00:00 Update Notes about core binding invariants - - - - - 8624f459 by Simon Peyton Jones at 2026-01-15T12:56:36+00:00 T26332 really should fail with -dlinear-core-lint - - - - - 6e78fe41 by Simon Peyton Jones at 2026-01-15T12:57:16+00:00 Try switching off the big optCoercion except in O2 - - - - - 18 changed files: - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/DynFlags.hs - testsuite/tests/linear/should_compile/T26332.hs - testsuite/tests/linear/should_compile/all.T Changes: ===================================== compiler/GHC/Builtin/PrimOps.hs ===================================== @@ -438,7 +438,7 @@ follows, in decreasing order of permissiveness: In particular, we cannot safely rewrite such an invalid call to a runtime error; we must emit code that produces a valid Word32#. (If we're lucky, Core Lint may complain that the result of such a rewrite violates - Note [Core binding invariants: nested non-rec] (#16742), but the rewrite + Note [Nested non-rec binding invariants] (#16742), but the rewrite is always wrong!) See also Note [Guarding against silly shifts] in GHC.Core.Opt.ConstantFold. @@ -581,7 +581,7 @@ Several predicates on primops test this flag: * The "no-float-out" thing is achieved by ensuring that we never let-bind a saturated primop application unless it has NoEffect. The RHS of a let-binding (which can float in and out freely) satisfies - exprOkForSpeculation; this is Note [Core binding invariants: nested non-rec]. + exprOkForSpeculation; this is Note [Nested non-rec binding invariants]. And exprOkForSpeculation is false of a saturated primop application unless it has NoEffect. ===================================== compiler/GHC/Core.hs ===================================== @@ -397,27 +397,27 @@ Note [Core binding invariants] A core binding, `CoreBind`, obeys these invariants: * For /top level/ or /recursive/ bindings, - see Note [Top-level binding invariants] + see Note [Top/rec binding invariants] * For /nested/ (not top-level) /non-recursive/ bindings, - see Note [Nested binding invariants] + see Note [Nested non-rec binding invariants] -Note [Top-level binding invariants] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Top/rec binding invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A /top-level/ or /recursive/ binding must - * be of lifted type -OR + * be of lifted type, OR + * have a RHS that is a primitive string literal - (see Note [Core top-level string literals], or -OR - * have a rhs that is (Coercion co) -OR - * be a worker or wrapper for an unlifted non-newtype data constructor; see (TL1). + (see Note [Core top-level string literals], OR + + * have a rhs that is (Coercion co), OR + + * be a worker or wrapper for an unlifted non-newtype + data constructor; see (TL1). -For the non-top-level, non-recursive case see Note [Nested binding invariants]. -(NB: this Note applies to recursive as well as top-level bindings, but I wanted -a short title!) +For the non-top-level, non-recursive case +see Note [Nested non-rec binding invariants]. See "Type#type_classification" in GHC.Core.Type for the meaning of "lifted" vs. "unlifted". @@ -439,8 +439,8 @@ constructor worker or wrapper S1 = S1 We allow this top-level unlifted binding to exist. -Note [Nested binding invariants] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Nested non-rec binding invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A /non-top-level/, /non-recursive/ binding must * Be a join point; see Note [Invariants on join points] OR @@ -471,7 +471,7 @@ The Core binding invariants are initially enforced by mkCoreLet in GHC.Core.Make Historical Note [The let/app invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Before 2022 GHC used the "let/app invariant", which applied -Note [Nested binding invariants] to the argument of an application, +Note [Nested non-rec binding invariants] to the argument of an application, as well as to the RHS of a let. This made some kind of sense, because 'let' can always be encoded as application: let x=rhs in b = (\x.b) rhs @@ -641,8 +641,8 @@ checked by Core Lint. multiplicity of the corresponding field /scaled by the multiplicity of the case binder/. Checked in lintCoreAlt. -Note [Core type and coercion invariant] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Core type and coercion invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We allow `let` to bind type and coercion variables. * A type or coercion binding is always /non-recursive/ @@ -887,7 +887,7 @@ Join points must follow these invariants: However, join points have simpler invariants in other ways 5. A join point can have an unboxed type without the RHS being - ok-for-speculation; see + ok-for-speculation; see e.g. let j :: Int# = factorial x in ... 6. The RHS of join point is not required to have a fixed runtime representation, @@ -2095,8 +2095,8 @@ mkDoubleLit d = Lit (mkLitDouble d) mkDoubleLitDouble d = Lit (mkLitDouble (toRational d)) -- | Bind all supplied binding groups over an expression in a nested let expression. --- Assumes that the rhs satisfies Note [Nested binding invariants]. Prefer to use --- 'GHC.Core.Make.mkCoreLets' if possible, which does guarantee the invariant +-- Assumes that the rhs satisfies Note [Nested non-rec binding invariants]. +-- Prefer to use 'GHC.Core.Make.mkCoreLets' if possible, which does guarantee the invariant mkLets :: [Bind b] -> Expr b -> Expr b -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to -- use 'GHC.Core.Make.mkCoreLams' if possible ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -270,10 +270,12 @@ optCoRefl subst in_co = let out_co = opt_co_refl subst in_co (Pair in_l in_r) = coercionKind in_co (Pair out_l out_r) = coercionKind out_co - in if (in_l `eqType` out_l) && (in_r `eqType` out_r) + in_l' = substTy subst in_l + in_r' = substTy subst in_r + in if (in_l' `eqType` out_l) && (in_r' `eqType` out_r) then out_co - else pprTrace "optReflCo" (vcat [ text "in_l:" <+> ppr in_l - , text "in_r:" <+> ppr in_r + else pprTrace "optReflCo" (vcat [ text "in_l':" <+> ppr in_l' + , text "in_r':" <+> ppr in_r' , text "out_l:" <+> ppr out_l , text "out_r:" <+> ppr out_r , text "in_co:" <+> ppr in_co ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -113,7 +113,7 @@ sortQuantVars vs = sorted_tcvs ++ ids -- appropriate (see "GHC.Core#let_can_float_invariant") mkCoreLet :: HasDebugCallStack => CoreBind -> CoreExpr -> CoreExpr mkCoreLet (NonRec bndr rhs) body - = -- See Note [Core binding invariants: nested non-rec] + = -- See Note [Nested non-rec binding invariants] bindNonRec bndr rhs body mkCoreLet bind body = Let bind body ===================================== compiler/GHC/Core/Opt/CSE.hs ===================================== @@ -287,8 +287,8 @@ Here is another reason that we do not use SUBSTITUTE for all trivial expressions. Consider case x |> co of (y::Array# Int) { ... } -We do not want to extend the substitution with (y -> x |> co); since y -is of unlifted type, this would destroy Note [Nested binding invariants] +We do not want to extend the substitution with (y -> x |> co); since y is of +unlifted type, this would destroy Note [Nested non-rec binding invariants] if (x |> co) was not ok-for-speculation. But surely (x |> co) is ok-for-speculation, because it's a trivial ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -1607,7 +1607,7 @@ as follows: in ... This was originally done in the fix to #16449 but this breaks -Note [Nested binding invariants] in GHC.Core, as noted in #16742. For the +Note [Nested non-rec binding invariants] in GHC.Core, as noted in #16742. For the reasons discussed under "NoEffect" in Note [Classifying primop effects] (in GHC.Builtin.PrimOps) there is no safe way to rewrite the argument of I# such that it bottoms. @@ -2177,7 +2177,7 @@ BigNat). These rules implement the same kind of constant folding as we have for Int#/Word#/etc. primops. See builtinBignumRules. These rules are built-in because they can't be expressed as regular rules for -now. The reason is that due to Note [Nested binding invariants] in GHC.Core, +now. The reason is that due to Note [Nested non-rec binding invariants] in GHC.Core, GHC is too conservative with some bignum operations and they don't match rules. For example: @@ -2185,8 +2185,8 @@ For example: doesn't constant-fold into `integerAdd 2 x` with a regular rule. That's because GHC never floats in `integerAdd 1 x` to form `integerAdd 1 (integerAdd 1 x)` -because of Note [Nested binding invariants] (it doesn't know if `integerAdd` -terminates). +because of Note [Nested non-rec binding invariants] (it doesn't know if +`integerAdd` terminates). In the built-in rule for `integerAdd` we can access the unfolding of `r` and we can perform the appropriate substitution. ===================================== compiler/GHC/Core/Opt/FloatIn.hs ===================================== @@ -665,7 +665,7 @@ noFloatIntoRhs is_rec bndr rhs = isRec is_rec -- Joins are one-shot iff non-recursive | definitelyUnliftedType (idType bndr) - = True -- Preserve Note [Nested binding invariants], + = True -- Preserve Note [Nested non-rec binding invariants], -- see Note [noFloatInto considerations] | otherwise @@ -691,7 +691,7 @@ When do we want to float bindings into - noFloatIntoArg: the argument of a function application Definitely don't float into RHS if it has unlifted type; -that would destroy Note [Nested binding invariants]. +that would destroy Note [Nested non-rec binding invariants]. * Wrinkle 1: do not float in if (a) any non-one-shot value lambdas ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -1003,11 +1003,11 @@ Why? Because it's important /not/ to transform let x = a /# 3 to let x = case bx of I# a -> a /# 3 -because the let binding no longer obeys Note [Nested binding invariants]. +because the let binding no longer obeys Note [Nested non-rec binding invariants]. But (a /# 3) is ok-for-spec due to a special hack that says division operators can't fail when the denominator is definitely non-zero. And yet that same expression says False to exprIsCheap. Simplest way to guarantee -Note [Nested binding invariants] is to use the same function! +Note [Nested non-rec binding invariants] is to use the same function! If an expression is okay for speculation, we could also float it out *without* boxing and unboxing, since evaluating it early is okay. ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -749,8 +749,10 @@ Examples NonRec x# (y +# 3) FltOkSpec -- Unboxed, but ok-for-spec'n NonRec x* (f y) FltCareful -- Strict binding; might fail or diverge - NonRec x# (a /# b) FltCareful -- Might fail; does not satisfy Note [Nested binding invariants] - NonRec x# (f y) FltCareful -- Might diverge; does not satisfy Note [Nested binding invariants] + NonRec x# (a /# b) FltCareful -- Might fail; does not satisfy + -- Note [Nested non-rec binding invariants] + NonRec x# (f y) FltCareful -- Might diverge; does not satisfy + -- Note [Nested non-rec binding invariants] -} data LetFloats = LetFloats (OrdList OutBind) FloatFlag @@ -763,7 +765,8 @@ data FloatFlag = FltLifted -- All bindings are lifted and lazy *or* -- consist of a single primitive string literal -- Hence ok to float to top level, or recursive - -- NB: consequence: all bindings satisfy Note [Nested binding invariants] + -- NB: consequence: all bindings satisfy + -- Note [Nested non-rec binding invariants] | FltOkSpec -- All bindings are FltLifted *or* -- strict (perhaps because unlifted, @@ -772,12 +775,14 @@ data FloatFlag -- Hence ok to float out of the RHS -- of a lazy non-recursive let binding -- (but not to top level, or into a rec group) - -- NB: consequence: all bindings satisfy Note [Nested binding invariants] + -- NB: consequence: all bindings satisfy + -- Note [Nested non-rec binding invariants] | FltCareful -- At least one binding is strict (or unlifted) -- and not guaranteed cheap -- Do not float these bindings out of a lazy let! - -- NB: some bindings may not satisfy Note [Nested binding invariants] + -- NB: some bindings may not satisfy + -- Note [Nested non-rec binding invariants] instance Outputable LetFloats where ppr (LetFloats binds ff) = ppr ff $$ ppr (fromOL binds) @@ -962,8 +967,10 @@ wrapFloats (SimplFloats { sfLetFloats = LetFloats bs flag -- Note: Always safe to put the joins on the inside -- since the values can't refer to them where - mk_let | FltCareful <- flag = mkCoreLet -- Need to enforce Note [Nested binding invariants] - | otherwise = Let -- Note [Nested binding invariants] holds + mk_let | FltCareful <- flag + = mkCoreLet -- Need to enforce Note [Nested non-rec binding invariants] + | otherwise + = Let -- Note [Nested non-rec binding invariants] holds wrapJoinFloatsX :: SimplFloats -> OutExpr -> (SimplFloats, OutExpr) -- Wrap the sfJoinFloats of the env around the expression, ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -315,7 +315,7 @@ simplLazyBind :: TopLevelFlag -> RecFlag -> (InExpr, SimplEnv) -- The RHS and its static environment -> SimplM (SimplFloats, SimplEnv) -- Precondition: Ids only, no TyVars; not a JoinId --- Precondition: rhs obeys Note [Nested binding invariants] +-- Precondition: rhs obeys Note [Nested non-rec binding invariants] simplLazyBind top_lvl is_rec (bndr,unf_se) (bndr1,env) (rhs,rhs_se) = assert (isId bndr ) assertPpr (not (isJoinId bndr)) (ppr bndr) $ @@ -397,7 +397,7 @@ simplAuxBind :: String -- The binder comes from a case expression (case binder or alternative) -- and so does not have rules, unfolding, inline pragmas etc. -- --- Precondition: rhs satisfies Note [Nested binding invariants] +-- Precondition: rhs satisfies Note [Nested non-rec binding invariants] simplAuxBind _str env bndr new_rhs | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $ @@ -950,7 +950,7 @@ completeBind :: BindContext -- * or by adding to the floats in the envt -- -- Binder /can/ be a JoinId --- Precondition: rhs obeys Note [Nested binding invariants] +-- Precondition: rhs obeys Note [Nested non-rec binding invariants] completeBind bind_cxt (old_bndr, unf_se) (new_bndr, new_rhs, env) | isCoVar old_bndr = case new_rhs of @@ -1290,7 +1290,7 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont ; simplExprF (extendTvSubst env bndr ty') body cont } | Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs env - -- Because of Note [Nested binding invariants], it's ok to + -- Because of Note [Nested non-rec binding invariants], it's ok to -- inline freely, or to drop the binding if it is dead. = do { simplTrace "SimplBindr:inline-uncond2" (ppr bndr <+> ppr rhs) $ tick (PreInlineUnconditionally bndr) @@ -1594,13 +1594,13 @@ rebuild_go env expr cont completeBindX :: SimplEnv -> FromWhat -> InId -> OutExpr -- Non-recursively bind this Id to this (simplified) expression - -- (Note [Nested binding invariants] may not be satisfied) + -- (Note [Nested non-rec binding invariants] may not be satisfied) -> InExpr -- In this body -> SimplCont -- Consumed by this continuation -> SimplM (SimplFloats, OutExpr) completeBindX env from_what bndr rhs body cont | FromBeta arg_levity <- from_what - , needsCaseBindingL arg_levity rhs -- Enforcing Note [Nested binding invariants] + , needsCaseBindingL arg_levity rhs -- Enforcing Note [Nested non-rec binding invariants] = do { (env1, bndr1) <- simplNonRecBndr env bndr -- Lambda binders don't have rules ; (floats, expr') <- simplNonRecBody env1 from_what body cont -- Do not float floats past the Case binder below @@ -1887,7 +1887,7 @@ simplNonRecE :: HasDebugCallStack -- It deals with strict bindings, via the StrictBind continuation, -- which may abort the whole process. -- --- from_what=FromLet => the RHS satisfies Note [Nested binding invariants] +-- from_what=FromLet => the RHS satisfies Note [Nested non-rec binding invariants] -- Otherwise it may or may not satisfy it. simplNonRecE env from_what bndr (rhs, rhs_se) body cont @@ -1909,8 +1909,8 @@ simplNonRecE env from_what bndr (rhs, rhs_se) body cont where is_strict_bind = case from_what of FromBeta Unlifted -> True - -- If we are coming from a beta-reduction (FromBeta) we must - -- establish Note [Nested binding invariants], so go via StrictBind + -- If we are coming from a beta-reduction (FromBeta) we must establish + -- Note [Nested non-rec binding invariants], so go via StrictBind -- If not, the invariant holds already, and it's optional. -- (FromBeta Lifted) or FromLet: look at the demand info @@ -2857,7 +2857,7 @@ this transformation: We treat the unlifted and lifted cases separately: * Unlifted case: 'e' satisfies exprOkForSpeculation - (ok-for-spec is needed to satisfy Note [Nested binding invariants]. + (ok-for-spec is needed to satisfy Note [Nested non-rec binding invariants]. This turns case a +# b of r -> ...r... into let r = a +# b in ...r... and thence .....(a +# b).... @@ -3112,7 +3112,7 @@ rebuildCase env scrut case_bndr alts cont assert (null bs) $ do { (floats1, env') <- simplAuxBind "rebuildCase" env case_bndr case_bndr_rhs -- scrut is a constructor application, - -- hence satisfies Note [Nested binding invariants] + -- hence satisfies Note [Nested non-rec binding invariants] ; (floats2, expr') <- simplExprF env' rhs cont ; case wfloats of [] -> return (floats1 `addFloats` floats2, expr') @@ -3624,13 +3624,14 @@ We pin on a (OtherCon []) unfolding to the case-binder of a Case, even though it'll be over-ridden in every case alternative with a more informative unfolding. Why? Because suppose a later, less clever, pass simply replaces all occurrences of the case binder with the binder itself; -then Lint may complain about failing Note [Nested binding invariants]. Example +then Lint may complain about failing Note [Nested non-rec binding invariants]. +Example: case e of b { DEFAULT -> let v = reallyUnsafePtrEquality# b y in .... ; K -> blah } -Note [Nested binding invariants] requires that y is evaluated in the call to -reallyUnsafePtrEquality#, which it is. But we still want that to be true if we -propagate binders to occurrences. +Note [Nested non-rec binding invariants] requires that y is evaluated in the +call to reallyUnsafePtrEquality#, which it is. But we still want that to be +true if we propagate binders to occurrences. This showed up in #13027. @@ -3732,7 +3733,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont -- occur in the RHS; and simplAuxBind may therefore discard it. -- Nevertheless we must keep it if the case-binder is alive, -- because it may be used in the con_app. See Note [knownCon occ info] - -- NB: arg satisfies Note [Nested binding invariants] + -- NB: arg satisfies Note [Nested non-rec binding invariants] ; (floats1, env2) <- simplAuxBind "knownCon" env' b' arg ; (floats2, env3) <- bind_args env2 bs' args ; return (floats1 `addFloats` floats2, env3) } ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1491,8 +1491,8 @@ preInlineUnconditionally :: SimplEnv -> TopLevelFlag -> InId -> InExpr -> StaticEnv -- These two go together -> Maybe SimplEnv -- Returned env has extended substitution --- Precondition: rhs satisfies Note [Nested binding invariants] --- See Note [Nested binding invariants] in GHC.Core +-- Precondition: rhs satisfies Note [Nested non-rec binding invariants] +-- See Note [Nested non-rec binding invariants] in GHC.Core -- Reason: we don't want to inline single uses, or discard dead bindings, -- for unlifted, side-effect-ful bindings preInlineUnconditionally env top_lvl bndr rhs rhs_env @@ -1638,7 +1638,7 @@ postInlineUnconditionally -> InId -> OutId -- The binder (*not* a CoVar), including its unfolding -> OutExpr -> Bool --- Precondition: rhs satisfies Note [Nested binding invariants] in GHC.Core +-- Precondition: rhs satisfies Note [Nested non-rec binding invariants] in GHC.Core -- Reason: we don't want to inline single uses, or discard dead bindings, -- for unlifted, side-effect-ful bindings postInlineUnconditionally env bind_cxt old_bndr bndr rhs ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -1937,14 +1937,14 @@ where Left to itself, the specialiser would float the bindings for `x` and `n` to top level, so we can specialise `wombat`. But we can't have a top-level ByteArray# -(see Note [Core letrec invariant] in GHC.Core). Boo. +(see Note [Top/rec binding invariants] in GHC.Core). Boo. This is pretty exotic, so we take a simple way out: in specBind (the NonRec case) do not float the binding itself unless it satisfies exprIsTopLevelBindable. This is conservative: maybe the RHS of `x` has a free var that would stop it floating to top level anyway; but that is hard to spot (since we don't know what the non-top-level in-scope binders are) and rare (since the binding must satisfy -Note [Nested binding invariants] in GHC.Core). +Note [Nested non-rec binding invariants] in GHC.Core). Note [Specialising Calls] ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -381,7 +381,8 @@ simple_app env e0@(Lam {}) as0@(_:_) -- See Note [Dark corner with representation polymorphism] needsCaseBinding (idType b') (snd a) -- This arg must not be inlined (side-effects) and cannot be let-bound, - -- due to Note [Nested binding invariants]. So simply case-bind it here. + -- due to Note [Nested non-rec binding invariants]. + -- So simply case-bind it here. , let a' = simple_opt_clo (soeInScope env) a = mkDefaultCase a' b' $ do_beta env' body as ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2042,15 +2042,15 @@ But we restrict it sharply: ; False -> e2 } in ...) ... - Does the RHS of v satisfy Note [Nested binding invariants]? + Does the RHS of v satisfy Note [Nested non-rec binding invariants]? Previously we said yes, on the grounds that y is evaluated. But the binder-swap done by GHC.Core.Opt.SetLevels would transform the inner alternative to DEFAULT -> ... (let v::Int# = case x of { ... } in ...) .... - which does /not/ satisfy Note [Nested bindings invariants], because x is - not evaluated. See Note [Binder-swap during float-out] + which does /not/ satisfy Note [Nested non-rec bindings invariants], + because x is not evaluated. See Note [Binder-swap during float-out] in GHC.Core.Opt.SetLevels. To avoid this awkwardness it seems simpler to stick to unlifted scrutinees where the issue does not arise. @@ -2134,7 +2134,7 @@ extremely useful for float-out, changes these expressions to And now the expression does not obey the let-can-float invariant! Yikes! Moreover we really might float (dataToTagLarge# x) outside the case, -and then it really, really doesn't obey Note [Nested binding invariants]. +and then it really, really doesn't obey Note [Nested non-rec binding invariants]. The solution is simple: exprOkForSpeculation does not try to take advantage of the evaluated-ness of (lifted) variables. And it returns @@ -2144,7 +2144,7 @@ by marking the relevant primops as "ThrowsException" or GHC.Builtin.PrimOps. Note that exprIsHNF /can/ and does take advantage of evaluated-ness; -it doesn't have the trickiness of Note [Nested binding invariants] +it doesn't have the trickiness of Note [Nested non-rec binding invariants] to worry about. ************************************************************************ ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -302,7 +302,7 @@ expose the values: see Note [wantFloatLocal].) If `v` is bound at the top-level, we might even float `sat` to top-level; see Note [Floating out of top level bindings]. -For nested let bindings, we have to keep in mind Note [Core letrec invariant] +For nested let bindings, we have to keep in mind Note [Core binding invariants], and may exploit strict contexts; see Note [wantFloatLocal]. There are 3 main categories of floats, encoded in the `FloatingBind` type: @@ -1509,7 +1509,7 @@ Wrinkles: (FS1) We detect string literals in `cpeBind Rec{}` and float them out anyway; otherwise we'd try to bind a string literal in a letrec, violating - Note [Core letrec invariant]. Since we know that literals don't have + Note [Top/rec binding invariants]. Since we know that literals don't have free variables, we float further. Arguably, we could just as well relax the letrec invariant for string literals, or anthing that is a value (lifted or not). @@ -2363,7 +2363,7 @@ Wrinkles: x = f y r y = [x] in e - and now we have violated Note [Core letrec invariant]. + and now we have violated Note [Top/rec binding invariants]. So we preempt this case in `wantFloatLocal`, responding `FloatNone` unless all floats are `TopLvlFloatable`. -} ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1233,7 +1233,7 @@ optLevelFlags -- see Note [Documenting optimisation flags] , ([1,2], Opt_DoCleverArgEtaExpansion) -- See Note [Eta expansion of arguments in CorePrep] , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0] , ([0,1,2], Opt_ProfManualCcs ) - , ([0,1,2], Opt_OptCoercion ) -- See Note [Coercion optimisation] in GHC.Core.Coercion.Opt + , ([2], Opt_OptCoercion ) -- See Note [Coercion optimisation] in GHC.Core.Coercion.Opt , ([2], Opt_DictsStrict) , ([0], Opt_IgnoreInterfacePragmas) ===================================== testsuite/tests/linear/should_compile/T26332.hs ===================================== @@ -5,6 +5,12 @@ module T26332 where import Unsafe.Coerce +-- This function should be accepted by the typechecker, and should be +-- linear-correct in the output of the desugarer, but will fail +-- -dlinear-core-lint (which does a linear-lint check after every simplifier +-- pass. Because the optimiser discards a cast on `f` that only affects +-- linearity + toLinear :: forall a b p q. (a %p-> b) %1-> (a %q-> b) ===================================== testsuite/tests/linear/should_compile/all.T ===================================== @@ -42,7 +42,7 @@ test('T19400', unless(compiler_debugged(), skip), compile, ['']) test('T20023', normal, compile, ['']) test('T22546', normal, compile, ['']) test('T23025', normal, compile, ['-dlinear-core-lint']) -test('T26332', normal, compile, ['-O -dlinear-core-lint']) +test('T26332', normal, compile_fail, ['-O']) test('LinearRecUpd', normal, compile, ['']) test('T23814', normal, compile, ['']) test('LinearLet', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/088f51ccfcd62799e1fa195f3e3740… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/088f51ccfcd62799e1fa195f3e3740… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/fix-rts-stubs
by Cheng Shao (＠TerrorJack) 15 Jan '26

15 Jan '26

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

1 0

[Git][ghc/ghc][wip/spj-try-opt-coercion] Wibble
by Simon Peyton Jones (＠simonpj) 14 Jan '26

14 Jan '26

Simon Peyton Jones pushed to branch wip/spj-try-opt-coercion at Glasgow Haskell Compiler / GHC Commits: 088f51cc by Simon Peyton Jones at 2026-01-14T23:07:36+00:00 Wibble - - - - - 1 changed file: - compiler/GHC/Core/Coercion/Opt.hs Changes: ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -11,7 +11,7 @@ import GHC.Tc.Utils.TcType ( exactTyCoVarsOfType ) import GHC.Core import GHC.Core.TyCo.Rep import GHC.Core.TyCo.Subst -import GHC.Core.TyCo.Compare( eqForAllVis, eqTypeIgnoringMultiplicity, eqType ) +import GHC.Core.TyCo.Compare import GHC.Core.Coercion import GHC.Core.Type as Type hiding( substTyVarBndr, substTy ) import GHC.Core.TyCon @@ -297,20 +297,22 @@ opt_co_refl subst co = go co = h { ch_co_var = updateVarType go_ty cv } go (Refl ty) = Refl (substTy subst ty) - go (GRefl r ty mco) = GRefl r (go_ty ty) (go_m mco) + go (GRefl r ty mco) = GRefl r $!! go_ty ty $!! go_m mco go (CoVarCo cv) = substCoVar subst cv go (HoleCo h) = HoleCo $!! go_hole h - go (SymCo co) = mkSymCo (go co) - go (KindCo co) = mkKindCo (go co) - go (SubCo co) = mkSubCo (go co) - go (SelCo n co) = mkSelCo n (go co) - go (LRCo n co) = mkLRCo n (go co) - go (AppCo co1 co2) = mkAppCo (go co1) (go co2) - go (InstCo co1 co2) = mkInstCo (go co1) (go co2) - go (FunCo r afl afr com coa cor) = mkFunCo2 r afl afr (go com) (go coa) (go cor) - go (TyConAppCo r tc cos) = mkTyConAppCo r tc (go_s cos) - go (UnivCo p r lt rt cos) = mkUnivCo p (go_s cos) r lt rt - go (AxiomCo ax cos) = mkAxiomCo ax (go_s cos) + go (SymCo co) = mkSymCo $!! go co + go (KindCo co) = mkKindCo $!! go co + go (SubCo co) = mkSubCo $!! go co + go (SelCo n co) = mkSelCo n $!! go co + go (LRCo n co) = mkLRCo n $!! go co + go (AppCo co1 co2) = mkAppCo $!! go co1 $!! go co2 + go (InstCo co1 co2) = mkInstCo $!! go co1 $!! go co2 + go (FunCo r afl afr com coa cor) = mkFunCo2 r afl afr + $!! go com $!! go coa $!! go cor + go (TyConAppCo r tc cos) = mkTyConAppCo r tc $!! go_s cos + go (UnivCo p r lt rt cos) = mkUnivCo p $!! (go_s cos) $!! r + $!! (go_ty lt) $!! (go_ty rt) + go (AxiomCo ax cos) = mkAxiomCo ax $!! (go_s cos) go (ForAllCo v vl vr mco co) = mkForAllCo v' vl vr $!! go_m mco View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/088f51ccfcd62799e1fa195f3e3740e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/088f51ccfcd62799e1fa195f3e3740e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-try-opt-coercion] fix Opt [skip ci]
by Simon Peyton Jones (＠simonpj) 14 Jan '26

14 Jan '26

Simon Peyton Jones pushed to branch wip/spj-try-opt-coercion at Glasgow Haskell Compiler / GHC Commits: 79c76d92 by Simon Peyton Jones at 2026-01-14T17:38:09+00:00 fix Opt [skip ci] - - - - - 1 changed file: - compiler/GHC/Core/Coercion/Opt.hs Changes: ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -282,18 +282,24 @@ optCoRefl subst in_co #endif -opt_co_refl :: Subst -> Coercion -> Coercion +opt_co_refl :: Subst -> InCoercion -> OutCoercion opt_co_refl subst co = go co where go_m MRefl = MRefl go_m (MCo co) = MCo (go co) + go_ty ty = substTy subst ty + go_s cos = map go cos - go co@(Refl {}) = co - go co@(GRefl {}) = co - go co@(CoVarCo {}) = co - go co@(HoleCo {}) = co + -- See Note [Substituting in a coercion hole] + go_hole h@(CoercionHole { ch_co_var = cv }) + = h { ch_co_var = updateVarType go_ty cv } + + go (Refl ty) = Refl (substTy subst ty) + go (GRefl r ty mco) = GRefl r (go_ty ty) (go_m mco) + go (CoVarCo cv) = substCoVar subst cv + go (HoleCo h) = HoleCo $!! go_hole h go (SymCo co) = mkSymCo (go co) go (KindCo co) = mkKindCo (go co) go (SubCo co) = mkSubCo (go co) @@ -315,28 +321,30 @@ opt_co_refl subst co = go co -- This is the main payload go (TransCo co1 co2) = gobble gs0 co1 [co2] where - lk = coercionLKind co1 + lk' = substTy subst (coercionLKind co1) role = coercionRole co1 gs0 :: GobbleState - gs0 = GS (mkReflCo role lk) (insertTM lk gs0 emptyTM) + gs0 = GS (mkReflCo role lk') (insertTM lk' gs0 emptyTM) - gobble :: GobbleState -> Coercion -> [Coercion] -> Coercion + gobble :: GobbleState -> InCoercion -> [InCoercion] -> OutCoercion -- gobble (GS co1 tm) co2 cos returns a coercion equivalent to (co1;co2;cos) gobble gs (TransCo co2 co3) cos = gobble gs co2 (co3 : cos) - gobble (GS co1 tm) co2 cos - = case lookupTM rk tm of + gobble (GS co1' tm) co2 cos + = case lookupTM rk' tm of Just gs -> gobble0 gs cos Nothing -> gobble0 gs' cos where - rk = coercionRKind co2 - gs' = GS (co1 `mkTransCo` co2) (insertTM rk gs' tm) + co2' = go co2 + rk' = coercionRKind co2' + gs' = GS (co1' `mkTransCo` co2') (insertTM rk' gs' tm) gobble0 (GS co _) [] = co gobble0 gs (co:cos) = gobble gs co cos -data GobbleState = GS Coercion (TypeMap GobbleState) +data GobbleState = GS OutCoercion (TypeMap GobbleState) + -- The map is keyed by OutType {- ********************************************************************** %* * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/79c76d929e015f4f8fb8901525b301b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/79c76d929e015f4f8fb8901525b301b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] NCG/LA64: add support for la664 micro architecture
by Marge Bot (＠marge-bot) 14 Jan '26

14 Jan '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5e1cd595 by Peng Fan at 2026-01-14T11:12:26-05:00 NCG/LA64: add support for la664 micro architecture Add '-mla664' flag to LA664, which has some new features: atomic instructions, dbar hints, etc. 'LA464' is the default so that unrecognized instructions are not generated. - - - - - 5 changed files: - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - docs/users_guide/using.rst Changes: ===================================== compiler/GHC/CmmToAsm/Config.hs ===================================== @@ -48,6 +48,7 @@ data NCGConfig = NCGConfig , ncgEnableInterModuleFarJumps:: !Bool -- ^ Use far-jumps for cross-module jumps. , ncgComputeUnwinding :: !Bool -- ^ Compute block unwinding tables , ncgEnableDeadCodeElimination :: !Bool -- ^ Whether to enable the dead-code elimination + , ncgLa664Enabled :: !Bool -- ^ la664 is equal to isav1.1 } -- | Return Word size ===================================== compiler/GHC/Driver/Config/CmmToAsm.hs ===================================== @@ -66,6 +66,8 @@ initNCGConfig dflags this_mod = NCGConfig _ -> Nothing , ncgAvx512fEnabled = isAvx512fEnabled dflags + , ncgLa664Enabled = isLa664Enabled dflags + , ncgDwarfEnabled = osElfTarget (platformOS (targetPlatform dflags)) && debugLevel dflags > 0 && platformArch (targetPlatform dflags) /= ArchAArch64 , ncgDwarfUnwindings = osElfTarget (platformOS (targetPlatform dflags)) && debugLevel dflags > 0 , ncgDwarfStripBlockInfo = osElfTarget (platformOS (targetPlatform dflags)) && debugLevel dflags < 2 -- We strip out block information when running with -g0 or -g1. ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -89,7 +89,9 @@ module GHC.Driver.DynFlags ( isAvx512pfEnabled, isFmaEnabled, isBmiEnabled, - isBmi2Enabled + isBmi2Enabled, + -- For LoongArch platform + isLa664Enabled ) where import GHC.Prelude @@ -457,6 +459,7 @@ data DynFlags = DynFlags { avx512f :: Bool, -- Enable AVX-512 instructions. avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. fma :: Bool, -- ^ Enable FMA instructions. + la664 :: Bool, -- Enable LA664 instructions -- Constants used to control the amount of optimization done. @@ -740,6 +743,8 @@ defaultDynFlags mySettings = avx512pf = False, -- Use FMA by default on AArch64 fma = (platformArch . sTargetPlatform $ mySettings) == ArchAArch64, + -- For LoongArch, la464 is used by default. + la664 = False, maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, @@ -1662,6 +1667,11 @@ We handle this as follows: to `AVX2`. -} +-- ----------------------------------------------------------------------------- +-- LA664 +isLa664Enabled :: DynFlags -> Bool +isLa664Enabled dflags = la664 dflags + -- ----------------------------------------------------------------------------- -- BMI2 ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -218,6 +218,9 @@ module GHC.Driver.Session ( isAvx512pfEnabled, isFmaEnabled, + -- LoongArch: ISA version: la664, la464(default) + isLa664Enabled, + -- * Linker/compiler information useXLinkerRPath, @@ -1729,6 +1732,9 @@ dynamic_flags_deps = [ d { avx512pf = True })) , make_ord_flag defGhcFlag "mfma" (noArg (\d -> d { fma = True })) + + , make_ord_flag defGhcFlag "mla664" (noArg (\d -> d { la664 = True })) + ------ Plugin flags ------------------------------------------------ , make_ord_flag defGhcFlag "fplugin-opt" (hasArg addPluginModuleNameOption) , make_ord_flag defGhcFlag "fplugin-trustworthy" ===================================== docs/users_guide/using.rst ===================================== @@ -1781,6 +1781,17 @@ Some flags only make sense for particular target platforms. multiply-add, which might perform non-IEEE-compliant software emulation on some platforms (depending on the implementation of the C standard library). +.. ghc-flag:: -mla664 + :shortdesc: (LoongArch only) Used for new instructions for la664 uarch + :type: dynamic + :category: platform-options + + :default: off by default, avoid to generate invalid instructions for non-la664 uarchs. + + GHC currently does not use LA664 specific instructions, + so this flag has no effect when used with the :ref:`native code generator <native-code-gen>` + or the :ref:`LLVM backend <llvm-code-gen>`. + Haddock ------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e1cd595b98fc153beaea795ee079f3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e1cd595b98fc153beaea795ee079f3… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 3 commits: Fix fetch_cabal
by Marge Bot (＠marge-bot) 14 Jan '26

14 Jan '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7964763b by Julian Ospald at 2026-01-14T11:11:31-05:00 Fix fetch_cabal * download cabal if the existing one is of an older version * fix FreeBSD download url * fix unpacking on FreeBSD - - - - - 6b0129c1 by Julian Ospald at 2026-01-14T11:11:31-05:00 Bump toolchain in CI - - - - - 0f53ccc6 by Julian Ospald at 2026-01-14T11:11:31-05:00 Use libffi-clib Previously, we would build libffi via hadrian and bundle it manually with the GHC bindist. This now moves all that logic out of hadrian and allows us to have a clean Haskell package to build and link against and ship it without extra logic. This patch still retains the ability to link against a system libffi. The main reason of bundling libffi was that on some platforms (e.g. FreeBSD and Mac), system libffi is not visible to the C toolchain by default, so users would require settings in e.g. cabal to be able to compile anything. This adds the submodule libffi-clib to the repository. - - - - - 27 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Unit.hs - compiler/GHC/Unit/State.hs - hadrian/hadrian.cabal - hadrian/src/Builder.hs - hadrian/src/Packages.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - − hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Rules/SourceDist.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - − libffi-tarballs - + libraries/libffi-clib - packages - rts/include/rts/ghc_ffi.h - rts/rts.buildinfo.in - rts/rts.cabal Changes: ===================================== .gitlab/ci.sh ===================================== @@ -341,11 +341,27 @@ function fetch_ghc() { } function fetch_cabal() { + local should_fetch=false + if [ ! -e "$CABAL" ]; then - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + if [ -z "${CABAL_INSTALL_VERSION:-}" ]; then + fail "cabal not found at '$CABAL' and CABAL_INSTALL_VERSION is not set" + fi + should_fetch=true + fi + + if [ -e "$CABAL" ] && [ -n "${CABAL_INSTALL_VERSION:-}" ]; then + local current_version + if current_version=$($CABAL --numeric-version 2>/dev/null); then + if [ "$current_version" != "$CABAL_INSTALL_VERSION" ]; then + info "cabal version mismatch: found $current_version, expected $CABAL_INSTALL_VERSION" + should_fetch=true fi + fi + fi + + if [ "$should_fetch" = true ]; then + local v="$CABAL_INSTALL_VERSION" start_section fetch-cabal "Fetch Cabal" case "$(uname)" in @@ -355,7 +371,7 @@ function fetch_cabal() { CLANG64) cabal_arch="x86_64" ;; *) fail "unknown MSYSTEM $MSYSTEM" ;; esac - url="https://downloads.haskell.org/~cabal/cabal-install-$v/cabal-install-$v-$cab…" + local url="https://downloads.haskell.org/~cabal/cabal-install-$v/cabal-install-$v-$cab…" info "Fetching cabal binary distribution from $url..." curl "$url" > "$TMP/cabal.zip" unzip "$TMP/cabal.zip" @@ -365,19 +381,21 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd14.tar.xz" ;; + FreeBSD) cabal_url="https://downloads.haskell.org/ghcup/unofficial-bindists/cabal/$v/cabal-inst…" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" curl "$cabal_url" > cabal.tar.xz - tmp="$(tar -tJf cabal.tar.xz | head -n1)" - $TAR -xJf cabal.tar.xz + local path="$(tar -tJf cabal.tar.xz | head -n1)" + local tmp_dir=$(mktemp -d XXXX-cabal) + $TAR -xJf cabal.tar.xz -C "${tmp_dir}" # Check if the bindist has directory structure - if [[ "$tmp" = "cabal" ]]; then - mv cabal "$toolchain/bin" + if [[ "$path" = "cabal" ]]; then + mv "${tmp_dir}"/cabal "$toolchain/bin" else - mv "$tmp/cabal" "$toolchain/bin" + mv "${tmp_dir}/$path/cabal" "$toolchain/bin" fi + rmdir "${tmp_dir}" ;; esac end_section fetch-cabal ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -451,7 +451,7 @@ opsysVariables _ FreeBSD14 = mconcat , "CC" =: "cc" , "CXX" =: "c++" , "FETCH_GHC_VERSION" =: "9.10.1" - , "CABAL_INSTALL_VERSION" =: "3.10.3.0" + , "CABAL_INSTALL_VERSION" =: "3.14.2.0" ] opsysVariables arch (Linux distro) = distroVariables arch distro opsysVariables AArch64 (Darwin {}) = mconcat @@ -480,9 +480,9 @@ opsysVariables Amd64 (Darwin {}) = mconcat opsysVariables _ (Windows {}) = mconcat [ "MSYSTEM" =: "CLANG64" , "LANG" =: "en_US.UTF-8" - , "CABAL_INSTALL_VERSION" =: "3.10.2.0" + , "CABAL_INSTALL_VERSION" =: "3.14.2.0" , "HADRIAN_ARGS" =: "--docs=no-sphinx-pdfs" - , "FETCH_GHC_VERSION" =: "9.10.1" + , "FETCH_GHC_VERSION" =: "9.10.3" ] opsysVariables _ _ = mempty ===================================== .gitlab/jobs.yaml ===================================== @@ -1463,7 +1463,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-freebsd14-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.10.3.0", + "CABAL_INSTALL_VERSION": "3.14.2.0", "CC": "cc", "CONFIGURE_ARGS": "--with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --with-system-libffi --with-ffi-includes=/usr/local/include --with-ffi-libraries=/usr/local/lib --with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check", "CXX": "c++", @@ -3691,9 +3691,9 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.10.2.0", + "CABAL_INSTALL_VERSION": "3.14.2.0", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "FETCH_GHC_VERSION": "9.10.1", + "FETCH_GHC_VERSION": "9.10.3", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LANG": "en_US.UTF-8", @@ -3754,9 +3754,9 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-windows-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.10.2.0", + "CABAL_INSTALL_VERSION": "3.14.2.0", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "FETCH_GHC_VERSION": "9.10.1", + "FETCH_GHC_VERSION": "9.10.3", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LANG": "en_US.UTF-8", @@ -4346,7 +4346,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-freebsd14-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CABAL_INSTALL_VERSION": "3.10.3.0", + "CABAL_INSTALL_VERSION": "3.14.2.0", "CC": "cc", "CONFIGURE_ARGS": "--with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --with-system-libffi --with-ffi-includes=/usr/local/include --with-ffi-libraries=/usr/local/lib --with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check", "CXX": "c++", @@ -5437,9 +5437,9 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.10.2.0", + "CABAL_INSTALL_VERSION": "3.14.2.0", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "FETCH_GHC_VERSION": "9.10.1", + "FETCH_GHC_VERSION": "9.10.3", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", @@ -5501,9 +5501,9 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-windows-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.10.2.0", + "CABAL_INSTALL_VERSION": "3.14.2.0", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "FETCH_GHC_VERSION": "9.10.1", + "FETCH_GHC_VERSION": "9.10.3", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", @@ -5638,7 +5638,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-freebsd14-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.10.3.0", + "CABAL_INSTALL_VERSION": "3.14.2.0", "CC": "cc", "CONFIGURE_ARGS": "--with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --with-system-libffi --with-ffi-includes=/usr/local/include --with-ffi-libraries=/usr/local/lib --with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check", "CXX": "c++", @@ -7835,9 +7835,9 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.10.2.0", + "CABAL_INSTALL_VERSION": "3.14.2.0", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "FETCH_GHC_VERSION": "9.10.1", + "FETCH_GHC_VERSION": "9.10.3", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LANG": "en_US.UTF-8", @@ -7897,9 +7897,9 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-windows-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.10.2.0", + "CABAL_INSTALL_VERSION": "3.14.2.0", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "FETCH_GHC_VERSION": "9.10.1", + "FETCH_GHC_VERSION": "9.10.3", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LANG": "en_US.UTF-8", ===================================== .gitmodules ===================================== @@ -99,10 +99,6 @@ path = utils/hsc2hs url = https://gitlab.haskell.org/ghc/hsc2hs.git ignore = untracked -[submodule "libffi-tarballs"] - path = libffi-tarballs - url = https://gitlab.haskell.org/ghc/libffi-tarballs.git - ignore = untracked [submodule "gmp-tarballs"] path = libraries/ghc-internal/gmp/gmp-tarballs url = https://gitlab.haskell.org/ghc/gmp-tarballs.git @@ -124,3 +120,6 @@ [submodule "libraries/template-haskell-quasiquoter"] path = libraries/template-haskell-quasiquoter url = https://gitlab.haskell.org/ghc/template-haskell-quasiquoter.git +[submodule "libraries/libffi-clib"] + path = libraries/libffi-clib + url = https://github.com/stable-haskell/libffi-clib.git ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ViewPatterns #-} -- @@ -67,6 +68,8 @@ import GHC.ByteCode.Linker import GHC.ByteCode.Asm import GHC.ByteCode.Types +import GHC.Linker.Unit (getUnitDepends) + import GHC.Stack.CCS import GHC.SysTools @@ -179,10 +182,10 @@ getLoaderState :: Interp -> IO (Maybe LoaderState) getLoaderState interp = readMVar (loader_state (interpLoader interp)) -emptyLoaderState :: LoaderState -emptyLoaderState = LoaderState +emptyLoaderState :: UnitEnv -> LoaderState +emptyLoaderState unit_env = LoaderState { bco_loader_state = emptyBytecodeLoaderState - , pkgs_loaded = init_pkgs + , pkgs_loaded = init_pkgs deps , bcos_loaded = emptyModuleEnv , objs_loaded = emptyModuleEnv , temp_sos = [] @@ -192,7 +195,13 @@ emptyLoaderState = LoaderState -- -- The linker's symbol table is populated with RTS symbols using an -- explicit list. See rts/Linker.c for details. - where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] [] emptyUniqDSet) + where + deps = getUnitDepends unit_env rtsUnitId + pkg_to_dfm unit_id = (unit_id, (LoadedPkgInfo unit_id [] [] [] emptyUniqDSet)) + init_pkgs deps = let addToUDFM' (k, v) m = addToUDFM m k v + in foldr addToUDFM' emptyUDFM $ [ + pkg_to_dfm rtsUnitId + ] ++ fmap pkg_to_dfm deps extendLoadedEnv :: Interp -> BytecodeLoaderStateModifier -> [(Name,ForeignHValue)] -> IO () extendLoadedEnv interp modify_bytecode_loader_state new_bindings = @@ -341,7 +350,7 @@ initLoaderState interp hsc_env = do reallyInitLoaderState :: Interp -> HscEnv -> IO LoaderState reallyInitLoaderState interp hsc_env = do -- Initialise the linker state - let pls0 = emptyLoaderState + let pls0 = emptyLoaderState (hsc_unit_env hsc_env) case platformArch (targetPlatform (hsc_dflags hsc_env)) of -- FIXME: we don't initialize anything with the JS interpreter. @@ -1226,12 +1235,6 @@ loadPackage interp hsc_env pkgs pls bc_dirs = [map ST.unpack $ Packages.unitLibraryBytecodeDirs pkg | pkg <- pkgs] let hs_libs = [map ST.unpack $ Packages.unitLibraries pkg | pkg <- pkgs] - -- The FFI GHCi import lib isn't needed as - -- GHC.Linker.Loader + rts/Linker.c link the - -- interpreted references to FFI to the compiled FFI. - -- We therefore filter it out so that we don't get - -- duplicate symbol errors. - hs_libs' = filter ("HSffi" /=) <$> hs_libs -- Because of slight differences between the GHC dynamic linker and -- the native system linker some packages have to link with a @@ -1251,7 +1254,7 @@ loadPackage interp hsc_env pkgs pls dirs_env <- traverse (addEnvPaths "LIBRARY_PATH") dirs hs_classifieds - <- sequenceA [mapM (locateLib interp hsc_env True bc_dir_ dirs_env_ gcc_paths) hs_libs'_ | (bc_dir_, dirs_env_, hs_libs'_) <- zip3 bc_dirs dirs_env hs_libs' ] + <- sequenceA [mapM (locateLib interp hsc_env True bc_dir_ dirs_env_ gcc_paths) hs_libs'_ | (bc_dir_, dirs_env_, hs_libs'_) <- zip3 bc_dirs dirs_env hs_libs ] extra_classifieds <- sequenceA [mapM (locateLib interp hsc_env False [] dirs_env_ gcc_paths) extra_libs_ | (dirs_env_, extra_libs_) <- zip dirs_env extra_libs] let classifieds = zipWith (++) hs_classifieds extra_classifieds ===================================== compiler/GHC/Linker/Unit.hs ===================================== @@ -6,6 +6,7 @@ module GHC.Linker.Unit , collectArchives , getUnitLinkOpts , getLibs + , getUnitDepends ) where @@ -105,3 +106,9 @@ getLibs namever ways unit_env pkgs = do , f <- (\n -> "lib" ++ n ++ ".a") <$> unitHsLibs namever ways p ] filterM (doesFileExist . fst) candidates +getUnitDepends :: HasDebugCallStack => UnitEnv -> UnitId -> [UnitId] +getUnitDepends unit_env pkg = + let unit_state = ue_homeUnitState unit_env + unit_info = unsafeLookupUnitId unit_state pkg + in (unitDepends unit_info) + ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -372,7 +372,7 @@ initUnitConfig dflags cached_dbs home_units = -- Since "base" is not wired in, then the unit-id is discovered -- from the settings file by default, but can be overriden by power-users -- by specifying `-base-unit-id` flag. - | otherwise = filter (hu_id /=) [baseUnitId dflags, ghcInternalUnitId, rtsUnitId] + | otherwise = filter (hu_id /=) (baseUnitId dflags:wiredInUnitIds) -- if the home unit is indefinite, it means we are type-checking it only -- (not producing any code). Hence we can use virtual units instantiated ===================================== hadrian/hadrian.cabal ===================================== @@ -86,7 +86,6 @@ executable hadrian , Rules.Documentation , Rules.Generate , Rules.Gmp - , Rules.Libffi , Rules.Library , Rules.Lint , Rules.Nofib ===================================== hadrian/src/Builder.hs ===================================== @@ -229,25 +229,16 @@ instance H.Builder Builder where -- changes (#18001). _bootGhcVersion <- setting GhcVersion pure [] - Ghc _ st -> do + Ghc _ _ -> do root <- buildRoot unlitPath <- builderPath Unlit distro_mingw <- lookupSystemConfig "settings-use-distro-mingw" - libffi_adjustors <- useLibffiForAdjustors - use_system_ffi <- flag UseSystemFfi return $ [ unlitPath ] ++ [ root -/- mingwStamp | windowsHost, distro_mingw == "NO" ] -- proxy for the entire mingw toolchain that -- we have in inplace/mingw initially, and then at -- root -/- mingw. - -- ffi.h needed by the compiler when using libffi_adjustors (#24864) - -- It would be nicer to not duplicate this logic between here - -- and needRtsLibffiTargets and libffiHeaderFiles but this doesn't change - -- very often. - ++ [ root -/- buildDir (rtsContext st) -/- "include" -/- header - | header <- ["ffi.h", "ffitarget.h"] - , libffi_adjustors && not use_system_ffi ] Hsc2Hs stage -> (\p -> [p]) <$> templateHscPath stage Make dir -> return [dir -/- "Makefile"] ===================================== hadrian/src/Packages.hs ===================================== @@ -110,7 +110,7 @@ hpc = lib "hpc" hpcBin = util "hpc-bin" `setPath` "utils/hpc" integerGmp = lib "integer-gmp" iservProxy = util "iserv-proxy" -libffi = top "libffi" +libffi = lib "libffi-clib" mtl = lib "mtl" osString = lib "os-string" parsec = lib "parsec" ===================================== hadrian/src/Rules.hs ===================================== @@ -21,7 +21,6 @@ import qualified Rules.Dependencies import qualified Rules.Documentation import qualified Rules.Generate import qualified Rules.Gmp -import qualified Rules.Libffi import qualified Rules.Library import qualified Rules.Program import qualified Rules.Register @@ -80,7 +79,7 @@ packageTargets stage pkg = do then return [] -- Skip inactive packages. else if isLibrary pkg then do -- Collect all targets of a library package. - let pkgWays = if pkg == rts then getRtsWays else getLibraryWays + let pkgWays = if pkg `elem` [rts, libffi] then getRtsWays else getLibraryWays ways <- interpretInContext context pkgWays libs <- mapM (\w -> pkgLibraryFile (Context stage pkg w (error "unused"))) (Set.toList ways) more <- Rules.Library.libraryTargets context @@ -126,7 +125,6 @@ buildRules = do Rules.Generate.generateRules Rules.Generate.templateRules Rules.Gmp.gmpRules - Rules.Libffi.libffiRules Rules.Library.libraryRules Rules.Rts.rtsRules packageRules ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -232,6 +232,9 @@ buildSphinxHtml path = do ------------------------------------ Haddock ----------------------------------- +haddockExclude :: [FilePath] +haddockExclude = ["rts", "libffi-clib"] + -- | Build the haddocks for GHC's libraries. buildLibraryDocumentation :: Rules () buildLibraryDocumentation = do @@ -241,11 +244,11 @@ buildLibraryDocumentation = do root -/- htmlRoot -/- "libraries/index.html" %> \file -> do need [ "libraries/prologue.txt" ] - -- We want Haddocks for everything except `rts` to be built, but we + -- We want Haddocks for everything except `rts` and `libffi-clib` to be built, but we -- don't want the index to be polluted by stuff from `ghc`-the-library -- (there will be a separate top-level link to those Haddocks). haddocks <- allHaddocks - let neededDocs = filter (\x -> takeFileName x /= "rts.haddock") haddocks + let neededDocs = filter (\x -> takeFileName x `notElem` ((<.> "haddock") <$> haddockExclude)) haddocks libDocs = filter (\x -> takeFileName x /= "ghc.haddock") neededDocs need neededDocs @@ -255,7 +258,7 @@ allHaddocks :: Action [FilePath] allHaddocks = do pkgs <- stagePackages Stage1 sequence [ pkgHaddockFile $ vanillaContext Stage1 pkg - | pkg <- pkgs, isLibrary pkg, pkgName pkg /= "rts" ] + | pkg <- pkgs, isLibrary pkg, pkgName pkg `notElem` haddockExclude ] -- Note: this build rule creates plenty of files, not just the .haddock one. -- All of them go into the 'docRoot' subdirectory. Pedantically tracking all @@ -427,4 +430,4 @@ haddockDependencies :: Context -> Action [(Package, FilePath)] haddockDependencies context = do depNames <- interpretInContext context (getContextData depNames) sequence [ (,) <$> pure depPkg <*> (pkgHaddockFile $ vanillaContext Stage1 depPkg) - | Just depPkg <- map findPackageByName depNames, depPkg /= rts ] + | Just depPkg <- map findPackageByName depNames, (pkgName depPkg) `notElem` haddockExclude ] ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -18,7 +18,6 @@ import Hadrian.Haskell.Cabal.Type (PackageData(version)) import Hadrian.Haskell.Cabal import Hadrian.Oracles.Cabal (readPackageData) import Packages -import Rules.Libffi import Settings import Target import Utilities @@ -57,7 +56,6 @@ rtsDependencies = do stage <- getStage rtsPath <- expr (rtsBuildPath stage) jsTarget <- expr isJsTarget - useSystemFfi <- expr (flag UseSystemFfi) let -- headers common to native and JS RTS common_headers = @@ -69,7 +67,6 @@ rtsDependencies = do [ "rts" -/- "EventTypes.h" , "rts" -/- "EventLogConstants.h" ] - ++ (if useSystemFfi then [] else libffiHeaderFiles) headers | jsTarget = common_headers | otherwise = common_headers ++ native_headers ===================================== hadrian/src/Rules/Libffi.hs deleted ===================================== @@ -1,243 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Rules.Libffi ( - LibffiDynLibs(..), - needLibffi, askLibffilDynLibs, libffiRules, libffiLibrary, libffiHeaderFiles, - libffiHeaderDir, libffiSystemHeaderDir, libffiName - ) where - -import Hadrian.Utilities - -import Packages -import Settings.Builders.Common -import Target -import Utilities -import GHC.Toolchain (targetPlatformTriple) - -{- Note [Libffi indicating inputs] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -First see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian for an -explanation of "indicating input". Part of the definition is copied here for -your convenience: - - change in the vital output -> change in the indicating inputs - -In the case of building libffi `vital output = built libffi library files` and -we can consider the libffi archive file (i.e. the "libffi-tarballs/libffi*.tar.gz" -file) to be the only indicating input besides the build tools (e.g. make). -Note building libffi is split into a few rules, but we also expect that: - - no change in the archive file -> no change in the intermediate build artifacts - -and so the archive file is still a valid choice of indicating input for -all libffi rules. Hence we can get away with `need`ing only the archive file and -don't have to `need` intermediate build artifacts (besides those to trigger -dependant libffi rules i.e. to generate vital inputs as is noted on the wiki). -It is then safe to `trackAllow` the libffi build directory as is done in -`needLibfffiArchive`. - -A disadvantage to this approach is that changing the archive file forces a clean -build of libffi i.e. we cannot incrementally build libffi. This seems like a -performance issue, but is justified as building libffi is fast and the archive -file is rarely changed. - --} - --- | Oracle question type. The oracle returns the list of dynamic --- libffi library file paths (all but one of which should be symlinks). -newtype LibffiDynLibs = LibffiDynLibs Stage - deriving (Eq, Show, Hashable, Binary, NFData) -type instance RuleResult LibffiDynLibs = [FilePath] - -askLibffilDynLibs :: Stage -> Action [FilePath] -askLibffilDynLibs stage = askOracle (LibffiDynLibs stage) - --- | The path to the dynamic library manifest file. The file contains all file --- paths to libffi dynamic library file paths. --- The path is calculated but not `need`ed. -dynLibManifest' :: Monad m => m FilePath -> Stage -> m FilePath -dynLibManifest' getRoot stage = do - root <- getRoot - return $ root -/- stageString stage -/- pkgName libffi -/- ".dynamiclibs" - -dynLibManifestRules :: Stage -> Rules FilePath -dynLibManifestRules = dynLibManifest' buildRootRules - -dynLibManifest :: Stage -> Action FilePath -dynLibManifest = dynLibManifest' buildRoot - --- | Need the (locally built) libffi library. -needLibffi :: Stage -> Action () -needLibffi stage = do - jsTarget <- isJsTarget - unless jsTarget $ do - manifest <- dynLibManifest stage - need [manifest] - --- | Context for @libffi@. -libffiContext :: Stage -> Action Context -libffiContext stage = do - ways <- interpretInContext - (Context stage libffi (error "libffiContext: way not set") (error "libffiContext: iplace not set")) - getLibraryWays - return $ (\w -> Context stage libffi w Final) (if any (wayUnit Dynamic) ways - then dynamic - else vanilla) - --- | The name of the library -libffiName :: Expr String -libffiName = do - useSystemFfi <- expr (flag UseSystemFfi) - if useSystemFfi - then pure "ffi" - else libffiLocalName Nothing - --- | The name of the (locally built) library -libffiLocalName :: Maybe Bool -> Expr String -libffiLocalName force_dynamic = do - way <- getWay - winTarget <- expr isWinTarget - let dynamic = fromMaybe (Dynamic `wayUnit` way) force_dynamic - pure $ mconcat - [ if dynamic then "" else "C" - , if winTarget then "ffi-6" else "ffi" - ] - -libffiLibrary :: FilePath -libffiLibrary = "inst/lib/libffi.a" - --- | These are the headers that we must package with GHC since foreign export --- adjustor code produced by GHC depends upon them. --- See Note [Packaging libffi headers] in GHC.Driver.CodeOutput. -libffiHeaderFiles :: [FilePath] -libffiHeaderFiles = ["ffi.h", "ffitarget.h"] - -libffiHeaderDir :: Stage -> Action FilePath -libffiHeaderDir stage = do - path <- libffiBuildPath stage - return $ path -/- "inst/include" - -libffiSystemHeaderDir :: Action FilePath -libffiSystemHeaderDir = setting FfiIncludeDir - -fixLibffiMakefile :: FilePath -> String -> String -fixLibffiMakefile top = - replace "-MD" "-MMD" - . replace "@toolexeclibdir@" "$(libdir)" - . replace "@INSTALL@" ("$(subst ../install-sh," ++ top ++ "/install-sh,@INSTALL@)") - --- TODO: check code duplication w.r.t. ConfCcArgs -configureEnvironment :: Stage -> Action [CmdOption] -configureEnvironment stage = do - context <- libffiContext stage - cFlags <- interpretInContext context getStagedCCFlags - sequence [ builderEnvironment "CC" $ Cc CompileC stage - , builderEnvironment "CXX" $ Cc CompileC stage - , builderEnvironment "AR" $ Ar Unpack stage - , builderEnvironment "NM" Nm - , builderEnvironment "RANLIB" Ranlib - , return . AddEnv "CFLAGS" $ unwords cFlags ++ " -w" - , return . AddEnv "LDFLAGS" $ "-w" ] - --- Need the libffi archive and `trackAllow` all files in the build directory. --- See [Libffi indicating inputs]. -needLibfffiArchive :: FilePath -> Action FilePath -needLibfffiArchive buildPath = do - top <- topDirectory - tarball <- unifyPath - . fromSingleton "Exactly one LibFFI tarball is expected" - <$> getDirectoryFiles top ["libffi-tarballs/libffi*.tar.gz"] - need [top -/- tarball] - trackAllow [buildPath -/- "**"] - return tarball - -libffiRules :: Rules () -libffiRules = do - _ <- addOracleCache $ \ (LibffiDynLibs stage) - -> do - jsTarget <- isJsTarget - if jsTarget - then return [] - else readFileLines =<< dynLibManifest stage - forM_ [Stage1, Stage2, Stage3] $ \stage -> do - root <- buildRootRules - let path = root -/- stageString stage - libffiPath = path -/- pkgName libffi -/- "build" - - -- We set a higher priority because this rule overlaps with the build rule - -- for static libraries 'Rules.Library.libraryRules'. - dynLibMan <- dynLibManifestRules stage - let topLevelTargets = [ libffiPath -/- libffiLibrary - , dynLibMan - ] - priority 2 $ topLevelTargets &%> \_ -> do - _ <- needLibfffiArchive libffiPath - context <- libffiContext stage - - -- Note this build needs the Makefile, triggering the rules bellow. - build $ target context (Make libffiPath) [] [] - libffiName' <- interpretInContext context (libffiLocalName (Just True)) - - -- Produces all install files. - produces =<< (\\ topLevelTargets) - <$> liftIO (getDirectoryFilesIO "." [libffiPath -/- "inst//*"]) - - -- Find dynamic libraries. - osxTarget <- isOsxTarget - winTarget <- isWinTarget - - dynLibFiles <- do - let libfilesDir = libffiPath -/- - (if winTarget then "inst" -/- "bin" else "inst" -/- "lib") - dynlibext - | winTarget = "dll" - | osxTarget = "dylib" - | otherwise = "so" - filepat = "lib" ++ libffiName' ++ "." ++ dynlibext ++ "*" - liftIO $ getDirectoryFilesIO "." [libfilesDir -/- filepat] - - writeFileLines dynLibMan dynLibFiles - putSuccess "| Successfully build libffi." - - fmap (libffiPath -/-) ( "Makefile.in" :& "configure" :& Nil ) &%> - \ ( mkIn :& _ ) -> do - -- Extract libffi tar file - context <- libffiContext stage - removeDirectory libffiPath - tarball <- needLibfffiArchive libffiPath - -- Go from 'libffi-3.99999+git20171002+77e130c.tar.gz' to 'libffi-3.99999' - let libname = takeWhile (/= '+') $ fromJust $ stripExtension "tar.gz" $ takeFileName tarball - - -- Move extracted directory to libffiPath. - root <- buildRoot - removeDirectory (root -/- libname) - actionFinally (do - build $ target context (Tar Extract) [tarball] [path] - moveDirectory (path -/- libname) libffiPath) $ - -- And finally: - removeFiles (path) [libname -/- "**"] - - top <- topDirectory - fixFile mkIn (fixLibffiMakefile top) - - files <- liftIO $ getDirectoryFilesIO "." [libffiPath -/- "**"] - produces files - - fmap (libffiPath -/-) ("Makefile" :& "config.guess" :& "config.sub" :& Nil) - &%> \( mk :& _ ) -> do - _ <- needLibfffiArchive libffiPath - context <- libffiContext stage - - -- This need rule extracts the libffi tar file to libffiPath. - need [mk <.> "in"] - - -- Configure. - forM_ ["config.guess", "config.sub"] $ \file -> do - copyFile file (libffiPath -/- file) - env <- configureEnvironment stage - buildWithCmdOptions env $ - target context (Configure libffiPath) [mk <.> "in"] [mk] - - dir <- queryBuildTarget targetPlatformTriple - files <- liftIO $ getDirectoryFilesIO "." [libffiPath -/- dir -/- "**"] - produces files ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -147,7 +147,7 @@ buildConfFinal :: [(Resource, Int)] -> Context -> FilePath -> Action () buildConfFinal rs context@Context {..} _conf = do depPkgIds <- cabalDependencies context ensureConfigured context - ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty) + ways <- interpretInContext context (getLibraryWays <> if package `elem` [rts, libffi] then getRtsWays else mempty) stamps <- mapM pkgStampFile [ context { way = w } | w <- Set.toList ways ] confs <- mapM (\pkgId -> packageDbPath (PackageDbLoc stage Final) <&> (-/- pkgId <.> "conf")) depPkgIds -- Important to need these together to avoid introducing a linearisation. This is not the most critical place @@ -295,20 +295,10 @@ parseCabalName s = bimap show id (Cabal.runParsecParser parser "<parseCabalName> where component = CabalCharParsing.munch1 (\c -> Char.isAlphaNum c || c == '.') - - --- | Return extra library targets. -extraTargets :: Context -> Action [FilePath] -extraTargets context - | package context == rts = needRtsLibffiTargets (Context.stage context) - | otherwise = return [] - -- | Given a library 'Package' this action computes all of its targets. Needing -- all the targets should build the library such that it is ready to be -- registered into the package database. libraryTargets :: Context -> Action [FilePath] libraryTargets context = do libFile <- pkgLibraryFile context - extra <- extraTargets context - return $ [ libFile ] - ++ extra + return [ libFile ] ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -1,14 +1,12 @@ {-# LANGUAGE MultiWayIf #-} -module Rules.Rts (rtsRules, needRtsLibffiTargets, needRtsSymLinks) where +module Rules.Rts (rtsRules, needRtsSymLinks) where import qualified Data.Set as Set import Packages (rts) -import Rules.Libffi import Hadrian.Utilities import Settings.Builders.Common -import Context.Type -- | This rule has priority 3 to override the general rule for generating shared -- library files (see Rules.Library.libraryRules). @@ -26,134 +24,6 @@ rtsRules = priority 3 $ do (addRtsDummyVersion $ takeFileName rtsLibFilePath') rtsLibFilePath' - -- Libffi - forM_ [Stage1, Stage2, Stage3 ] $ \ stage -> do - let buildPath = root -/- buildDir (rtsContext stage) - - -- Header files - -- See Note [Packaging libffi headers] in GHC.Driver.CodeOutput. - forM_ libffiHeaderFiles $ \header -> - buildPath -/- "include" -/- header %> copyLibffiHeader stage - - -- Static libraries. - buildPath -/- "libCffi*.a" %> copyLibffiStatic stage - - -- Dynamic libraries - buildPath -/- "libffi*.dylib*" %> copyLibffiDynamicUnix stage ".dylib" - buildPath -/- "libffi*.so*" %> copyLibffiDynamicUnix stage ".so" - buildPath -/- "libffi*.dll*" %> copyLibffiDynamicWin stage - -withLibffi :: Stage -> (FilePath -> FilePath -> Action a) -> Action a -withLibffi stage action = needLibffi stage - >> (join $ action <$> libffiBuildPath stage - <*> rtsBuildPath stage) - --- | Copy a header files wither from the system libffi or from the libffi --- build dir to the rts build dir. --- --- See Note [Packaging libffi headers] in GHC.Driver.CodeOutput. -copyLibffiHeader :: Stage -> FilePath -> Action () -copyLibffiHeader stage header = do - useSystemFfi <- flag UseSystemFfi - (fromStr, headerDir) <- if useSystemFfi - then ("system",) <$> libffiSystemHeaderDir - else needLibffi stage - >> ("custom",) <$> libffiHeaderDir stage - copyFile - (headerDir -/- takeFileName header) - header - putSuccess $ "| Successfully copied " ++ fromStr ++ " FFI library header " - ++ "files to RTS build directory." - --- | Copy a static library file from the libffi build dir to the rts build dir. -copyLibffiStatic :: Stage -> FilePath -> Action () -copyLibffiStatic stage target = withLibffi stage $ \ libffiPath _ -> do - -- Copy the vanilla library, and symlink the rest to it. - vanillaLibFile <- rtsLibffiLibrary stage vanilla - if target == vanillaLibFile - then copyFile' (libffiPath -/- libffiLibrary) target - else createFileLink (takeFileName vanillaLibFile) target - - --- | Copy a dynamic library file from the libffi build dir to the rts build dir. -copyLibffiDynamicUnix :: Stage -> String -> FilePath -> Action () -copyLibffiDynamicUnix stage libSuf target = do - needLibffi stage - dynLibs <- askLibffilDynLibs stage - - -- If no version number suffix, then copy else just symlink. - let versionlessSourceFilePath = fromMaybe - (error $ "Needed " ++ show target ++ " which is not any of " ++ - "libffi's built shared libraries: " ++ show dynLibs) - (find (libSuf `isSuffixOf`) dynLibs) - let versionlessSourceFileName = takeFileName versionlessSourceFilePath - if versionlessSourceFileName == takeFileName target - then do - copyFile' versionlessSourceFilePath target - - -- On OSX the dylib's id must be updated to a relative path. - when osxHost $ cmd - [ "install_name_tool" - , "-id", "@rpath/" ++ takeFileName target - , target - ] - else createFileLink versionlessSourceFileName target - --- | Copy a dynamic library file from the libffi build dir to the rts build dir. -copyLibffiDynamicWin :: Stage -> FilePath -> Action () -copyLibffiDynamicWin stage target = do - needLibffi stage - dynLibs <- askLibffilDynLibs stage - let source = fromMaybe - (error $ "Needed " ++ show target ++ " which is not any of " ++ - "libffi's built shared libraries: " ++ show dynLibs) - (find (\ lib -> takeFileName target == takeFileName lib) dynLibs) - copyFile' source target - -rtsLibffiLibrary :: Stage -> Way -> Action FilePath -rtsLibffiLibrary stage way = do - name <- interpretInContext ((rtsContext stage) { way = way }) libffiName - suf <- if wayUnit Dynamic way - then do - extension <- setting DynamicExtension -- e.g., .dll or .so - let suffix = waySuffix (removeWayUnit Dynamic way) - return (suffix ++ extension) - -- Static suffix - else return (waySuffix way ++ ".a") -- e.g., _p.a - rtsPath <- rtsBuildPath stage - return $ rtsPath -/- "lib" ++ name ++ suf - --- | Get the libffi files bundled with the rts (header and library files). --- Unless using the system libffi, this needs the libffi library. It must be --- built before the targets can be calculated. -needRtsLibffiTargets :: Stage -> Action [FilePath] -needRtsLibffiTargets stage = do - rtsPath <- rtsBuildPath stage - useSystemFfi <- flag UseSystemFfi - jsTarget <- isJsTarget - - -- Header files (in the rts build dir). - let headers = fmap ((rtsPath -/- "include") -/-) libffiHeaderFiles - - if | jsTarget -> return [] - | useSystemFfi -> return [] - | otherwise -> do - -- Need Libffi - -- This returns the dynamic library files (in the Libffi build dir). - needLibffi stage - dynLibffSource <- askLibffilDynLibs stage - - -- Dynamic library files (in the rts build dir). - let dynLibffis = fmap (\ lib -> rtsPath -/- takeFileName lib) - dynLibffSource - - -- Libffi files (in the rts build dir). - libffis_libs <- do - ways <- interpretInContext (stageContext stage) - (getLibraryWays <> getRtsWays) - mapM (rtsLibffiLibrary stage) (Set.toList ways) - return $ concat [ headers, dynLibffis, libffis_libs ] - -- Need symlinks generated by rtsRules. needRtsSymLinks :: Stage -> Set.Set Way -> Action () needRtsSymLinks stage rtsWays ===================================== hadrian/src/Rules/SourceDist.hs ===================================== @@ -155,6 +155,9 @@ prepareTree dest = do , pkgPath time -/- "lib" -/- "include" -/- "HsTimeConfig.h.in" , pkgPath unix -/- "configure" , pkgPath unix -/- "include" -/- "HsUnixConfig.h.in" + , pkgPath libffi -/- "configure" + , pkgPath libffi -/- "fficonfig.h.in" + , pkgPath libffi -/- "include" -/- "ffi.h.in" , pkgPath terminfo -/- "configure" , "configure" , "aclocal.m4" ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -184,7 +184,8 @@ configureArgs cFlags' ldFlags' = do , arg $ top -/- pkgPath pkg , cFlags' ] - mconcat + useSystemFfi <- getFlag UseSystemFfi + mconcat $ [ conf "CFLAGS" cFlags , conf "LDFLAGS" ldFlags' , conf "--with-iconv-includes" $ arg =<< getSetting IconvIncludeDir @@ -198,7 +199,7 @@ configureArgs cFlags' ldFlags' = do , conf "--host" $ arg =<< getSetting TargetPlatformFull , conf "--with-cc" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage , ghcVersionH - ] + ] ++ if useSystemFfi then [arg "--configure-option=--with-system-libffi"] else [] bootPackageConstraints :: Args bootPackageConstraints = (stage0InTree ==) <$> getStage ? do ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -10,7 +10,6 @@ import Packages import Settings.Builders.Common import Settings.Warnings import qualified Context as Context -import Rules.Libffi (libffiName) import qualified Data.Set as Set import Data.Version.Extra @@ -106,9 +105,6 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do context <- getContext distPath <- expr (Context.distDynDir context) - useSystemFfi <- expr (flag UseSystemFfi) - buildPath <- getBuildPath - libffiName' <- libffiName debugged <- buildingCompilerStage' . ghcDebugged =<< expr flavour osxTarget <- expr isOsxTarget @@ -127,17 +123,6 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do metaOrigin | osxTarget = "@loader_path" | otherwise = "$ORIGIN" - -- TODO: an alternative would be to generalize by linking with extra - -- bundled libraries, but currently the rts is the only use case. It is - -- a special case when `useSystemFfi == True`: the ffi library files - -- are not actually bundled with the rts. Perhaps ffi should be part of - -- rts's extra libraries instead of extra bundled libraries in that - -- case. Care should be take as to not break the make build. - rtsFfiArg = package rts ? not useSystemFfi ? mconcat - [ arg ("-L" ++ buildPath) - , arg ("-l" ++ libffiName') - ] - -- This is the -rpath argument that is required for the bindist scenario -- to work. Indeed, when you install a bindist, the actual executables -- end up nested somewhere under $libdir, with the wrapper scripts @@ -166,7 +151,6 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do , (not (nonHsMainPackage pkg) && not (isLibrary pkg)) ? arg "-rtsopts" , pure [ "-l" ++ lib | lib <- libs ] , pure [ "-L" ++ libDir | libDir <- libDirs ] - , rtsFfiArg , osxTarget ? pure (concat [ ["-framework", fmwk] | fmwk <- fmwks ]) , debugged ? packageOneOf [ghc, iservProxy, remoteIserv] ? arg "-debug" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -141,7 +141,9 @@ stage1Packages = do libraries0 <- filter good_stage0_package <$> stage0Packages cross <- flag CrossCompiling winTarget <- isWinTarget + jsTarget <- isJsTarget haveCurses <- any (/= "") <$> traverse setting [ CursesIncludeDir, CursesLibDir ] + useSystemFfi <- flag UseSystemFfi let when c xs = if c then xs else mempty @@ -194,6 +196,10 @@ stage1Packages = do [ terminfo ] + , when (not jsTarget && not useSystemFfi) + [ + libffi + ] ] -- | Packages built in 'Stage2' by default. You can change this in "UserSettings". ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -215,6 +215,7 @@ packageArgs = do ---------------------------------- rts --------------------------------- , package rts ? rtsPackageArgs -- RTS deserves a separate function + , package libffi ? libffiPackageArgs -------------------------------- runGhc -------------------------------- , package runGhc ? @@ -275,6 +276,19 @@ ghcInternalArgs = package ghcInternal ? do ] +-- libffi and rts have to have the same flavour configuration +libffiPackageArgs :: Args +libffiPackageArgs = package libffi ? do + rtsWays <- getRtsWays + mconcat + [ builder (Cabal Flags) ? mconcat + [ any (wayUnit Profiling) rtsWays `cabalFlag` "profiling" + , any (wayUnit Debug) rtsWays `cabalFlag` "debug" + , any (wayUnit Dynamic) rtsWays `cabalFlag` "dynamic" + , any (wayUnit Threaded) rtsWays `cabalFlag` "threaded" + ] + ] + -- | RTS-specific command line arguments. rtsPackageArgs :: Args rtsPackageArgs = package rts ? do @@ -285,8 +299,6 @@ rtsPackageArgs = package rts ? do path <- getBuildPath top <- expr topDirectory useSystemFfi <- getFlag UseSystemFfi - ffiIncludeDir <- getSetting FfiIncludeDir - ffiLibraryDir <- getSetting FfiLibDir libdwIncludeDir <- queryTarget (Lib.includePath <=< tgtRTSWithLibdw) libdwLibraryDir <- queryTarget (Lib.libraryPath <=< tgtRTSWithLibdw) libnumaIncludeDir <- getSetting LibnumaIncludeDir @@ -428,7 +440,6 @@ rtsPackageArgs = package rts ? do [ useLibdw ? cabalExtraDirs (fromMaybe "" libdwIncludeDir) (fromMaybe "" libdwLibraryDir) , cabalExtraDirs libnumaIncludeDir libnumaLibraryDir , cabalExtraDirs libzstdIncludeDir libzstdLibraryDir - , useSystemFfi ? cabalExtraDirs ffiIncludeDir ffiLibraryDir ] , builder (Cc (FindCDependencies CDep)) ? cArgs , builder (Cc (FindCDependencies CxxDep)) ? cArgs ===================================== libffi-tarballs deleted ===================================== @@ -1 +0,0 @@ -Subproject commit 7c51059557b68d29820a0a87cebfa6fe73c8adf5 ===================================== libraries/libffi-clib ===================================== @@ -0,0 +1 @@ +Subproject commit 5323bdcc5229191884edb186709b7b91fe5117ee ===================================== packages ===================================== @@ -37,7 +37,6 @@ # localpath tag remotepath upstreamurl # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ghc-tarballs windows ghc-tarballs.git - -libffi-tarballs - - - utils/hsc2hs - - ssh://git@github.com/haskell/hsc2hs.git libraries/array - - - libraries/binary - - https://github.com/kolmodin/binary.git ===================================== rts/include/rts/ghc_ffi.h ===================================== @@ -25,4 +25,4 @@ #endif #endif -#include "ffi.h" +#include <ffi.h> ===================================== rts/rts.buildinfo.in ===================================== @@ -1,6 +1,5 @@ extra-libraries: @EXTRA_LIBS@ extra-libraries-static: @EXTRA_LIBS@ include-dirs: @FFIIncludeDir@ -library-dirs: @FFILibDir@ -library-dirs-static: @FFILibDir@ -dynamic-library-dirs: @FFILibDir@ +extra-lib-dirs: @FFILibDir@ +extra-lib-dirs-static: @FFILibDir@ ===================================== rts/rts.cabal ===================================== @@ -163,18 +163,6 @@ library stg/Types.h else - -- If we are using an in-tree libffi then we must declare it as a bundled - -- library to ensure that Cabal installs it. - if !flag(use-system-libffi) - if os(windows) - extra-bundled-libraries: Cffi-6 - else - extra-bundled-libraries: Cffi - - install-includes: ffi.h ffitarget.h - -- ^ see Note [Packaging libffi headers] in - -- GHC.Driver.CodeOutput. - -- Here we declare several flavours to be available when passing the -- suitable (combination of) flag(s) when configuring the RTS from hadrian, -- using Cabal. @@ -232,6 +220,8 @@ library if flag(use-system-libffi) extra-libraries: ffi extra-libraries-static: ffi + else + build-depends: libffi-clib if os(windows) extra-libraries: -- for the linker View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f25e2b12c98290d3136d43e549ac26… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f25e2b12c98290d3136d43e549ac26… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] testsuite: remove obsolete --ci option from the testsuite driver
by Marge Bot (＠marge-bot) 14 Jan '26

14 Jan '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f25e2b12 by Cheng Shao at 2026-01-14T11:10:39-05:00 testsuite: remove obsolete --ci option from the testsuite driver This patch removes the obsolete `--ci` option from the testsuite driver: neither the CI scripts nor hadrian ever invokes the testsuite driver with `--ci`, and the perf notes are always fetched to the `refs/notes/perf` local reference anyway. - - - - - 1 changed file: - testsuite/driver/perf_notes.py Changes: ===================================== testsuite/driver/perf_notes.py ===================================== @@ -685,13 +685,10 @@ def main() -> None: parser.add_argument("--add-note", nargs=3, help="Development only. --add-note N commit seed \ Adds N fake metrics to the given commit using the random seed.") - parser.add_argument("--ci", action='store_true', - help="Use ci results. You must fetch these with:\n " \ - + "$ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf") group = parser.add_argument_group(title='Filtering', description="Select which subset of performance metrics to dump") group.add_argument("--test-env", - help="The given test environment to be compared. Use 'local' for locally run results. If using --ci, see .gitlab-ci file for TEST_ENV settings.") + help="The given test environment to be compared. Use 'local' for locally run results.") group.add_argument("--test-name", help="Filters for tests matching the given regular expression.") group.add_argument("--metric", @@ -721,8 +718,6 @@ def main() -> None: # ref = NoteNamespace('perf') - if args.ci: - ref = NoteNamespace('ci/perf') commits = args.commits if args.commits: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f25e2b12c98290d3136d43e549ac268… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f25e2b12c98290d3136d43e549ac268… You're receiving this email because of your account on gitlab.haskell.org.

1 0