GitLab

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC

Commits:

7f15bd15

by Samuel Thibault at 2026-01-12T07:16:25-05:00

Fix the OS string encoding for GNU/Hurd

Following https://github.com/haskell/cabal/pull/9434/files , and as seen
in the various gnu_HOST_OS usages in the source code, it is expected that
GNU/Hurd is advertised as "gnu", like the autotools do.

1db2f240

by Andrew Lelechenko at 2026-01-12T07:17:06-05:00

Add since annotation for Data.Bifoldable1

Fixes #26432

e038a383

by Sven Tennie at 2026-01-12T07:17:49-05:00

Ignore Windows CI tool directories in Git

Otherwise, we see thousands of changes in `git status` which is very
confusing to work with.

be3829a4

by sheaf at 2026-01-12T12:56:25-05:00

Don't re-use stack slots for growing registers

This commit avoids re-using a stack slot for a register that has grown
but already had a stack slot.

For example, suppose we have stack slot assigments

  %v1 :: FF64 |-> StackSlot 0
  %v2 :: FF64 |-> StackSlot 1

Later, we start using %v1 at a larger format (e.g. F64x2) and we need
to spill it again. Then we **must not** use StackSlot 0, as a spill
at format F64x2 would clobber the data in StackSlot 1.

This can cause some fragmentation of the `StackMap`, but that's probably
OK.

Fixes #26668

9f61ac3b
by fendor at 2026-01-12T12:56:25-05:00
```
Remove `traceId` from ghc-pkg executable
```

6 changed files:

.gitignore
compiler/GHC/CmmToAsm/Reg/Linear.hs
compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
libraries/base/src/Data/Bifoldable1.hs
libraries/ghc-platform/src/GHC/Platform/ArchOS.hs
utils/ghc-pkg/Main.hs

Changes:

.gitignore

@@ -256,3 +256,12 @@ ghc.nix/
  # clangd
  .clangd
  dist-newstyle/
++
 +# -----------------------------------------------------------------------------
 +# CI
++
 +# Windows CI
 +toolchain/
 +ghc-*/
 +inplace/
 +tmp/

compiler/GHC/CmmToAsm/Reg/Linear.hs

@@ -406,7 +406,7 @@ linearRA block_live block_id = go [] []
  -- | Do allocation for a single instruction.
  raInsn
          :: OutputableRegConstraint freeRegs instr
 -        => BlockMap Regs                      -- ^ map of what vregs are love on entry to each block.
 +        => BlockMap Regs                         -- ^ map of what vregs are live on entry to each block.
          -> [instr]                              -- ^ accumulator for instructions already processed.
          -> BlockId                              -- ^ the id of the current block, for debugging
          -> LiveInstr instr                      -- ^ the instr to have its regs allocated, with liveness info.

compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs

@@ -37,7 +37,11 @@ data StackMap
            -- See Note [UniqFM and the register allocator]
            -- | Assignment of vregs to stack slots.
 -        , stackMapAssignment    :: UniqFM Unique StackSlot }
 +          --
 +          -- We record not just the slot, but also how many stack slots the vreg
 +          -- takes up, in order to avoid re-using a stack slot for a register
 +          -- that has grown but already had a stack slot (#26668).
 +        , stackMapAssignment    :: UniqFM Unique (StackSlot, Int) }
  -- | An empty stack map, with all slots available.
@@ -50,14 +54,19 @@ emptyStackMap = StackMap 0 emptyUFM
  --
  getStackSlotFor :: StackMap -> Format -> Unique -> (StackMap, Int)
 -getStackSlotFor fs@(StackMap _ reserved) _fmt regUnique
 -  | Just slot <- lookupUFM reserved regUnique  =  (fs, slot)
+-
 -getStackSlotFor (StackMap freeSlot reserved) fmt regUnique =
 -  let
 -    nbSlots = (formatInBytes fmt + 7) `div` 8
 -  in
 -    (StackMap (freeSlot+nbSlots) (addToUFM reserved regUnique freeSlot), freeSlot)
 +getStackSlotFor fs@(StackMap freeSlot reserved) fmt regUnique
 +  -- The register already has a stack slot; try to re-use it.
 +  | Just (slot, nbSlots) <- lookupUFM reserved regUnique
 +  -- Make sure the slot is big enough for this format, in case the register
 +  -- has grown (#26668).
 +  , nbNeededSlots <= nbSlots
 +  = (fs, slot)
 +  | otherwise
 +  = (StackMap (freeSlot+nbNeededSlots) (addToUFM reserved regUnique (freeSlot, nbNeededSlots)), freeSlot)
 +    -- NB: this can create fragmentation if a register keeps growing.
 +    -- That's probably OK, as this is only happens very rarely.
 +  where
 +    !nbNeededSlots = (formatInBytes fmt + 7) `div` 8
  -- | Return the number of stack slots that were allocated
  getStackUse :: StackMap -> Int

libraries/base/src/Data/Bifoldable1.hs

@@ -2,6 +2,7 @@
  -- Copyright: Edward Kmett, Oleg Grenrus
  -- License: BSD-3-Clause
  --
 +-- @since 4.18.0.0
  {-# LANGUAGE NoImplicitPrelude #-}
  {-# LANGUAGE Safe              #-}

libraries/ghc-platform/src/GHC/Platform/ArchOS.hs

@@ -156,7 +156,7 @@ stringEncodeOS = \case
    OSHaiku     -> "haiku"
    OSQNXNTO    -> "nto-qnx"
    OSAIX       -> "aix"
 -  OSHurd      -> "hurd"
 +  OSHurd      -> "gnu"
    OSWasi      -> "wasi"
    OSGhcjs     -> "ghcjs"

utils/ghc-pkg/Main.hs

@@ -23,7 +23,6 @@
  module Main (main) where
 -import Debug.Trace
  import qualified GHC.Unit.Database as GhcPkg
  import GHC.Unit.Database hiding (mkMungePathUrl)
  import GHC.HandleEncoding
@@ -1634,7 +1633,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do
  simplePackageList :: [Flag] -> [InstalledPackageInfo] -> IO ()
  simplePackageList my_flags pkgs = do
     let showPkg :: InstalledPackageInfo -> String
 -       showPkg | FlagShowUnitIds `elem` my_flags = traceId . display . installedUnitId
 +       showPkg | FlagShowUnitIds `elem` my_flags = display . installedUnitId
                 | FlagNamesOnly `elem` my_flags   = display . mungedName . mungedId
                 | otherwise                       = display . mungedId
         strs = map showPkg pkgs