[Git][ghc/ghc][wip/sjakobi/T21176-integer-bits] Add explicit setBit/clearBit/complementBit for instance Bits Integer (#21176)
by Simon Jakobi (＠sjakobi2) 23 Jun '26
by Simon Jakobi (＠sjakobi2) 23 Jun '26
23 Jun '26
Simon Jakobi pushed to branch wip/sjakobi/T21176-integer-bits at Glasgow Haskell Compiler / GHC
Commits:
869b0a57 by Simon Jakobi at 2026-06-23T00:36:15+02:00
Add explicit setBit/clearBit/complementBit for instance Bits Integer (#21176)
The default setBit, clearBit, and complementBit methods allocate
intermediate Integers per call. Define them explicitly via the new
integerSetBit[#], integerClearBit[#] and integerComplementBit[#], built
on the BigNat# primitives, which avoid those allocations. Allocation is not
eliminated entirely -- the negative (IN) cases would need in-place mutation,
which is left as future work.
The default methods constant-folded on literal arguments via the
integerOr/integerAnd/integerXor rules, which fold literal Integers of any
size. The explicit functions have no such rule, so they (their Word-argument
wrappers, and the Bits Integer methods) are marked INLINE to expose the
underlying primops to the simplifier; see Note [INLINE for constant folding
of bit operations]. This restores folding only on the small-int (IS) path --
large literal Integers (IP/IN) are no longer constant-folded, a minor
regression for that case. T8832 covers the IS-path folding.
The new golden-output test T21176 checks all three operations against the
default implementations across the sign/size boundaries, recording each
result plus its integerCheck validity. The base and ghc-bignum interface-
stability export goldens gain the new functions.
The main changelog entry lives in changelog.d under a new ghc-internal
section (renamed from ghc-prim).
Co-Authored-By: Claude Opus 4.7 <noreply(a)anthropic.com>
- - - - -
12 changed files:
- + changelog.d/T21176
- changelog.d/config
- libraries/base/changelog.md
- libraries/ghc-bignum/changelog.md
- libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs
- libraries/ghc-internal/src/GHC/Internal/Bits.hs
- testsuite/tests/interface-stability/ghc-bignum-exports.stdout
- + testsuite/tests/numeric/should_run/T21176.hs
- + testsuite/tests/numeric/should_run/T21176.stdout
- testsuite/tests/numeric/should_run/all.T
- testsuite/tests/simplCore/should_compile/T8832.hs
- testsuite/tests/simplCore/should_compile/T8832.stdout
Changes:
=====================================
changelog.d/T21176
=====================================
@@ -0,0 +1,4 @@
+section: ghc-internal
+synopsis: Give ``setBit``, ``clearBit`` and ``complementBit`` explicit definitions in ``instance Bits Integer``, backed by new ``integerSetBit[#]``, ``integerClearBit[#]`` and ``integerComplementBit[#]`` functions. These avoid the intermediate ``Integer`` allocations of the previous default methods, although allocation is not eliminated entirely — notably the negative (``IN``) cases would require in-place mutation, which is left as future work. As a trade-off, constant folding of these operations now applies only to small (machine-word-sized) literal arguments; the previous default methods folded literal ``Integer`` arguments of any size via the ``integerOr``/``integerAnd``/``integerXor`` rules.
+issues: #21176
+mrs: !7772
=====================================
changelog.d/config
=====================================
@@ -27,7 +27,7 @@ sections: {
cmm Cmm
build-tools Build tools
base ``base`` library
- ghc-prim ``ghc-prim`` library
+ ghc-internal ``ghc-internal`` library
ghc-lib ``ghc`` library
ghc-heap ``ghc-heap`` library
ghc-experimental ``ghc-experimental`` library
=====================================
libraries/base/changelog.md
=====================================
@@ -1,6 +1,7 @@
# Changelog for [`base` package](http://hackage.haskell.org/package/base)
## 4.24.0.0 *TBA*
+ * Give `setBit`, `clearBit` and `complementBit` explicit definitions in `instance Bits Integer`, reducing intermediate allocations. ([GHC #21176](https://gitlab.haskell.org/ghc/ghc/-/issues/21176))
* Add `Bounded` instances for `Double`, `Float`, `CDouble` and `CFloat`. ([CLC proposal #402](https://github.com/haskell/core-libraries-committee/issues/402))
* Ensure that `Data.List.elem` and `notElem` can be specialized even when no list fusion happens. ([CLC proposal #412)(https://github.com/haskell/core-libraries-committee/issues/412))
=====================================
libraries/ghc-bignum/changelog.md
=====================================
@@ -1,5 +1,9 @@
# Changelog for `ghc-bignum` package
+## UNRELEASED
+
+- Add `integerSetBit[#]`, `integerClearBit[#]`, `integerComplementBit[#]` (#21176)
+
## 1.4
- `ghc-bignum`'s implementation has been merged into `ghc-internal`.
=====================================
libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs
=====================================
@@ -133,6 +133,12 @@ module GHC.Internal.Bignum.Integer
, integerBit
, integerTestBit#
, integerTestBit
+ , integerSetBit#
+ , integerSetBit
+ , integerClearBit#
+ , integerClearBit
+ , integerComplementBit#
+ , integerComplementBit
, integerShiftR#
, integerShiftR
, integerShiftL#
@@ -707,6 +713,113 @@ integerTestBit# (IN x) i
integerTestBit :: Integer -> Word -> Bool
integerTestBit !i (W# n) = isTrue# (integerTestBit# i n)
+{- Note [INLINE for constant folding of bit operations]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+While there are no dedicated constant-folding rules for
+integerSetBit#/integerClearBit#/integerComplementBit#, we do INLINE them (and
+their Word-argument wrappers and the corresponding Bits Integer methods) to make
+the underlying primops accessible for constant folding, e.g. so that
+`clearBit (bit 0) 0 :: Integer` folds to `IS 0#`. Test T8832 checks the folding
+for all three operations.
+-}
+
+-- | Set the /n/-th bit.
+--
+-- Fake 2's complement for negative values (might be slow)
+--
+-- @since 10.201.0
+integerSetBit# :: Integer -> Word# -> Integer
+{-# INLINE integerSetBit# #-} -- See Note [INLINE for constant folding of bit operations]
+integerSetBit# n@(IS x) i
+ | isTrue# (i `ltWord#` (WORD_SIZE_IN_BITS## `minusWord#` 1##))
+ = IS (x `orI#` uncheckedIShiftL# 1# (word2Int# i))
+ | isTrue# (x >=# 0#)
+ = IP (bigNatSetBit# (bigNatFromWord# (int2Word# x)) i)
+ | True
+ = n
+integerSetBit# (IP x) i = IP (bigNatSetBit# x i)
+integerSetBit# (IN x) i = integerFromBigNatNeg#
+ (bigNatAddWord#
+ (bigNatClearBit# (bigNatSubWordUnsafe# x 1##) i)
+ 1##)
+
+-- | Set the /n/-th bit.
+--
+-- Fake 2's complement for negative values (might be slow)
+--
+-- @since 10.201.0
+integerSetBit :: Integer -> Word -> Integer
+{-# INLINE integerSetBit #-} -- See Note [INLINE for constant folding of bit operations]
+integerSetBit !i (W# n) = integerSetBit# i n
+
+-- | Clear the /n/-th bit.
+--
+-- Fake 2's complement for negative values (might be slow)
+--
+-- @since 10.201.0
+integerClearBit# :: Integer -> Word# -> Integer
+{-# INLINE integerClearBit# #-} -- See Note [INLINE for constant folding of bit operations]
+integerClearBit# n@(IS x) i
+ | isTrue# (i `ltWord#` (WORD_SIZE_IN_BITS## `minusWord#` 1##))
+ = IS (x `andI#` notI# (uncheckedIShiftL# 1# (word2Int# i)))
+ | isTrue# (x >=# 0#)
+ = n
+ | True
+ = IN (bigNatAddWord#
+ (bigNatSetBit#
+ (bigNatFromWord#
+ (minusWord# (int2Word# (negateInt# x)) 1##))
+ i)
+ 1##)
+integerClearBit# (IP x) i = integerFromBigNat# (bigNatClearBit# x i)
+integerClearBit# (IN x) i = IN (bigNatAddWord#
+ (bigNatSetBit# (bigNatSubWordUnsafe# x 1##) i)
+ 1##)
+
+-- | Clear the /n/-th bit.
+--
+-- Fake 2's complement for negative values (might be slow)
+--
+-- @since 10.201.0
+integerClearBit :: Integer -> Word -> Integer
+{-# INLINE integerClearBit #-} -- See Note [INLINE for constant folding of bit operations]
+integerClearBit !i (W# n) = integerClearBit# i n
+
+-- | Reverse the /n/-th bit.
+--
+-- Fake 2's complement for negative values (might be slow)
+--
+-- @since 10.201.0
+integerComplementBit# :: Integer -> Word# -> Integer
+{-# INLINE integerComplementBit# #-} -- See Note [INLINE for constant folding of bit operations]
+integerComplementBit# (IS x) i
+ | isTrue# (i `ltWord#` (WORD_SIZE_IN_BITS## `minusWord#` 1##))
+ = IS (x `xorI#` uncheckedIShiftL# 1# (word2Int# i))
+ | isTrue# (x >=# 0#)
+ = IP (bigNatSetBit# (bigNatFromWord# (int2Word# x)) i)
+ | True
+ = IN (bigNatAddWord#
+ (bigNatSetBit#
+ (bigNatFromWord# (minusWord# (int2Word# (negateInt# x)) 1##))
+ i)
+ 1##)
+integerComplementBit# (IP x) i = integerFromBigNat# (bigNatComplementBit# x i)
+integerComplementBit# (IN x) i = integerFromBigNatNeg#
+ (bigNatAddWord#
+ (bigNatComplementBit#
+ (bigNatSubWordUnsafe# x 1##)
+ i)
+ 1##)
+
+-- | Reverse the /n/-th bit.
+--
+-- Fake 2's complement for negative values (might be slow)
+--
+-- @since 10.201.0
+integerComplementBit :: Integer -> Word -> Integer
+{-# INLINE integerComplementBit #-} -- See Note [INLINE for constant folding of bit operations]
+integerComplementBit !i (W# n) = integerComplementBit# i n
+
-- | Shift-right operation
--
-- Fake 2's complement for negative values (might be slow)
=====================================
libraries/ghc-internal/src/GHC/Internal/Bits.hs
=====================================
@@ -564,6 +564,15 @@ instance Bits Integer where
| otherwise = integerShiftR x (fromIntegral (negate i))
testBit x i = integerTestBit x (fromIntegral i)
zeroBits = integerZero
+ -- INLINE on setBit/clearBit/complementBit preserves constant folding;
+ -- see Note [INLINE for constant folding of bit operations] in
+ -- GHC.Internal.Bignum.Integer.
+ setBit x i = integerSetBit x (fromIntegral i)
+ {-# INLINE setBit #-}
+ clearBit x i = integerClearBit x (fromIntegral i)
+ {-# INLINE clearBit #-}
+ complementBit x i = integerComplementBit x (fromIntegral i)
+ {-# INLINE complementBit #-}
bit (I# i) = integerBit# (int2Word# i)
popCount x = I# (integerPopCount# x)
=====================================
testsuite/tests/interface-stability/ghc-bignum-exports.stdout
=====================================
@@ -201,8 +201,12 @@ module GHC.Num.Integer where
integerBit# :: GHC.Internal.Prim.Word# -> Integer
integerCheck :: Integer -> GHC.Internal.Types.Bool
integerCheck# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
+ integerClearBit :: Integer -> GHC.Internal.Types.Word -> Integer
+ integerClearBit# :: Integer -> GHC.Internal.Prim.Word# -> Integer
integerCompare :: Integer -> Integer -> GHC.Internal.Types.Ordering
integerComplement :: Integer -> Integer
+ integerComplementBit :: Integer -> GHC.Internal.Types.Word -> Integer
+ integerComplementBit# :: Integer -> GHC.Internal.Prim.Word# -> Integer
integerDecodeDouble# :: GHC.Internal.Prim.Double# -> (# Integer, GHC.Internal.Prim.Int# #)
integerDiv :: Integer -> Integer -> Integer
integerDivMod :: Integer -> Integer -> (Integer, Integer)
@@ -266,6 +270,8 @@ module GHC.Num.Integer where
integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #)
integerRecipMod# :: Integer -> GHC.Internal.Bignum.Natural.Natural -> (# GHC.Internal.Bignum.Natural.Natural | () #)
integerRem :: Integer -> Integer -> Integer
+ integerSetBit :: Integer -> GHC.Internal.Types.Word -> Integer
+ integerSetBit# :: Integer -> GHC.Internal.Prim.Word# -> Integer
integerShiftL :: Integer -> GHC.Internal.Types.Word -> Integer
integerShiftL# :: Integer -> GHC.Internal.Prim.Word# -> Integer
integerShiftR :: Integer -> GHC.Internal.Types.Word -> Integer
=====================================
testsuite/tests/numeric/should_run/T21176.hs
=====================================
@@ -0,0 +1,38 @@
+module Main where
+
+import Data.Bits
+import Data.Int (Int32, Int64)
+import Data.Foldable (for_)
+import GHC.Num.Integer (integerCheck)
+
+integers :: [Integer]
+integers = concatMap neighbours [minInt64, minInt32, 0, maxInt32, maxInt64]
+ where
+ neighbours i = [i - 2, i - 1, i, i + 1, i + 2]
+ minInt64 = toInteger (minBound :: Int64)
+ minInt32 = toInteger (minBound :: Int32)
+ maxInt32 = toInteger (maxBound :: Int32)
+ maxInt64 = toInteger (maxBound :: Int64)
+
+bits :: [Int]
+bits = [0, 1, x - 1, x, x + 1]
+ where x = finiteBitSize (0 :: Int) - 1
+
+testXBit :: String -> (Integer -> Int -> Integer) -> (Integer -> Int -> Integer) -> IO ()
+testXBit name f model = do
+ putStrLn name
+ for_ integers $ \i ->
+ for_ bits $ \b -> do
+ let actual = f i b
+ expected = model i b
+ valid = if integerCheck actual then "valid" else "invalid"
+ matches = if actual == expected then "matches" else "differs"
+ putStrLn $ " " ++ show i ++ " " ++ show b ++ " -> " ++ show actual
+ ++ " [" ++ valid ++ ", " ++ matches ++ "]"
+ putStrLn ""
+
+main :: IO ()
+main = do
+ testXBit "setBit" setBit (\i b -> i .|. bit b)
+ testXBit "clearBit" clearBit (\i b -> i .&. complement (bit b))
+ testXBit "complementBit" complementBit (\i b -> i `xor` bit b)
=====================================
testsuite/tests/numeric/should_run/T21176.stdout
=====================================
@@ -0,0 +1,381 @@
+setBit
+ -9223372036854775810 0 -> -9223372036854775809 [valid, matches]
+ -9223372036854775810 1 -> -9223372036854775810 [valid, matches]
+ -9223372036854775810 62 -> -9223372036854775810 [valid, matches]
+ -9223372036854775810 63 -> -2 [valid, matches]
+ -9223372036854775810 64 -> -9223372036854775810 [valid, matches]
+ -9223372036854775809 0 -> -9223372036854775809 [valid, matches]
+ -9223372036854775809 1 -> -9223372036854775809 [valid, matches]
+ -9223372036854775809 62 -> -9223372036854775809 [valid, matches]
+ -9223372036854775809 63 -> -1 [valid, matches]
+ -9223372036854775809 64 -> -9223372036854775809 [valid, matches]
+ -9223372036854775808 0 -> -9223372036854775807 [valid, matches]
+ -9223372036854775808 1 -> -9223372036854775806 [valid, matches]
+ -9223372036854775808 62 -> -4611686018427387904 [valid, matches]
+ -9223372036854775808 63 -> -9223372036854775808 [valid, matches]
+ -9223372036854775808 64 -> -9223372036854775808 [valid, matches]
+ -9223372036854775807 0 -> -9223372036854775807 [valid, matches]
+ -9223372036854775807 1 -> -9223372036854775805 [valid, matches]
+ -9223372036854775807 62 -> -4611686018427387903 [valid, matches]
+ -9223372036854775807 63 -> -9223372036854775807 [valid, matches]
+ -9223372036854775807 64 -> -9223372036854775807 [valid, matches]
+ -9223372036854775806 0 -> -9223372036854775805 [valid, matches]
+ -9223372036854775806 1 -> -9223372036854775806 [valid, matches]
+ -9223372036854775806 62 -> -4611686018427387902 [valid, matches]
+ -9223372036854775806 63 -> -9223372036854775806 [valid, matches]
+ -9223372036854775806 64 -> -9223372036854775806 [valid, matches]
+ -2147483650 0 -> -2147483649 [valid, matches]
+ -2147483650 1 -> -2147483650 [valid, matches]
+ -2147483650 62 -> -2147483650 [valid, matches]
+ -2147483650 63 -> -2147483650 [valid, matches]
+ -2147483650 64 -> -2147483650 [valid, matches]
+ -2147483649 0 -> -2147483649 [valid, matches]
+ -2147483649 1 -> -2147483649 [valid, matches]
+ -2147483649 62 -> -2147483649 [valid, matches]
+ -2147483649 63 -> -2147483649 [valid, matches]
+ -2147483649 64 -> -2147483649 [valid, matches]
+ -2147483648 0 -> -2147483647 [valid, matches]
+ -2147483648 1 -> -2147483646 [valid, matches]
+ -2147483648 62 -> -2147483648 [valid, matches]
+ -2147483648 63 -> -2147483648 [valid, matches]
+ -2147483648 64 -> -2147483648 [valid, matches]
+ -2147483647 0 -> -2147483647 [valid, matches]
+ -2147483647 1 -> -2147483645 [valid, matches]
+ -2147483647 62 -> -2147483647 [valid, matches]
+ -2147483647 63 -> -2147483647 [valid, matches]
+ -2147483647 64 -> -2147483647 [valid, matches]
+ -2147483646 0 -> -2147483645 [valid, matches]
+ -2147483646 1 -> -2147483646 [valid, matches]
+ -2147483646 62 -> -2147483646 [valid, matches]
+ -2147483646 63 -> -2147483646 [valid, matches]
+ -2147483646 64 -> -2147483646 [valid, matches]
+ -2 0 -> -1 [valid, matches]
+ -2 1 -> -2 [valid, matches]
+ -2 62 -> -2 [valid, matches]
+ -2 63 -> -2 [valid, matches]
+ -2 64 -> -2 [valid, matches]
+ -1 0 -> -1 [valid, matches]
+ -1 1 -> -1 [valid, matches]
+ -1 62 -> -1 [valid, matches]
+ -1 63 -> -1 [valid, matches]
+ -1 64 -> -1 [valid, matches]
+ 0 0 -> 1 [valid, matches]
+ 0 1 -> 2 [valid, matches]
+ 0 62 -> 4611686018427387904 [valid, matches]
+ 0 63 -> 9223372036854775808 [valid, matches]
+ 0 64 -> 18446744073709551616 [valid, matches]
+ 1 0 -> 1 [valid, matches]
+ 1 1 -> 3 [valid, matches]
+ 1 62 -> 4611686018427387905 [valid, matches]
+ 1 63 -> 9223372036854775809 [valid, matches]
+ 1 64 -> 18446744073709551617 [valid, matches]
+ 2 0 -> 3 [valid, matches]
+ 2 1 -> 2 [valid, matches]
+ 2 62 -> 4611686018427387906 [valid, matches]
+ 2 63 -> 9223372036854775810 [valid, matches]
+ 2 64 -> 18446744073709551618 [valid, matches]
+ 2147483645 0 -> 2147483645 [valid, matches]
+ 2147483645 1 -> 2147483647 [valid, matches]
+ 2147483645 62 -> 4611686020574871549 [valid, matches]
+ 2147483645 63 -> 9223372039002259453 [valid, matches]
+ 2147483645 64 -> 18446744075857035261 [valid, matches]
+ 2147483646 0 -> 2147483647 [valid, matches]
+ 2147483646 1 -> 2147483646 [valid, matches]
+ 2147483646 62 -> 4611686020574871550 [valid, matches]
+ 2147483646 63 -> 9223372039002259454 [valid, matches]
+ 2147483646 64 -> 18446744075857035262 [valid, matches]
+ 2147483647 0 -> 2147483647 [valid, matches]
+ 2147483647 1 -> 2147483647 [valid, matches]
+ 2147483647 62 -> 4611686020574871551 [valid, matches]
+ 2147483647 63 -> 9223372039002259455 [valid, matches]
+ 2147483647 64 -> 18446744075857035263 [valid, matches]
+ 2147483648 0 -> 2147483649 [valid, matches]
+ 2147483648 1 -> 2147483650 [valid, matches]
+ 2147483648 62 -> 4611686020574871552 [valid, matches]
+ 2147483648 63 -> 9223372039002259456 [valid, matches]
+ 2147483648 64 -> 18446744075857035264 [valid, matches]
+ 2147483649 0 -> 2147483649 [valid, matches]
+ 2147483649 1 -> 2147483651 [valid, matches]
+ 2147483649 62 -> 4611686020574871553 [valid, matches]
+ 2147483649 63 -> 9223372039002259457 [valid, matches]
+ 2147483649 64 -> 18446744075857035265 [valid, matches]
+ 9223372036854775805 0 -> 9223372036854775805 [valid, matches]
+ 9223372036854775805 1 -> 9223372036854775807 [valid, matches]
+ 9223372036854775805 62 -> 9223372036854775805 [valid, matches]
+ 9223372036854775805 63 -> 18446744073709551613 [valid, matches]
+ 9223372036854775805 64 -> 27670116110564327421 [valid, matches]
+ 9223372036854775806 0 -> 9223372036854775807 [valid, matches]
+ 9223372036854775806 1 -> 9223372036854775806 [valid, matches]
+ 9223372036854775806 62 -> 9223372036854775806 [valid, matches]
+ 9223372036854775806 63 -> 18446744073709551614 [valid, matches]
+ 9223372036854775806 64 -> 27670116110564327422 [valid, matches]
+ 9223372036854775807 0 -> 9223372036854775807 [valid, matches]
+ 9223372036854775807 1 -> 9223372036854775807 [valid, matches]
+ 9223372036854775807 62 -> 9223372036854775807 [valid, matches]
+ 9223372036854775807 63 -> 18446744073709551615 [valid, matches]
+ 9223372036854775807 64 -> 27670116110564327423 [valid, matches]
+ 9223372036854775808 0 -> 9223372036854775809 [valid, matches]
+ 9223372036854775808 1 -> 9223372036854775810 [valid, matches]
+ 9223372036854775808 62 -> 13835058055282163712 [valid, matches]
+ 9223372036854775808 63 -> 9223372036854775808 [valid, matches]
+ 9223372036854775808 64 -> 27670116110564327424 [valid, matches]
+ 9223372036854775809 0 -> 9223372036854775809 [valid, matches]
+ 9223372036854775809 1 -> 9223372036854775811 [valid, matches]
+ 9223372036854775809 62 -> 13835058055282163713 [valid, matches]
+ 9223372036854775809 63 -> 9223372036854775809 [valid, matches]
+ 9223372036854775809 64 -> 27670116110564327425 [valid, matches]
+
+clearBit
+ -9223372036854775810 0 -> -9223372036854775810 [valid, matches]
+ -9223372036854775810 1 -> -9223372036854775812 [valid, matches]
+ -9223372036854775810 62 -> -13835058055282163714 [valid, matches]
+ -9223372036854775810 63 -> -9223372036854775810 [valid, matches]
+ -9223372036854775810 64 -> -27670116110564327426 [valid, matches]
+ -9223372036854775809 0 -> -9223372036854775810 [valid, matches]
+ -9223372036854775809 1 -> -9223372036854775811 [valid, matches]
+ -9223372036854775809 62 -> -13835058055282163713 [valid, matches]
+ -9223372036854775809 63 -> -9223372036854775809 [valid, matches]
+ -9223372036854775809 64 -> -27670116110564327425 [valid, matches]
+ -9223372036854775808 0 -> -9223372036854775808 [valid, matches]
+ -9223372036854775808 1 -> -9223372036854775808 [valid, matches]
+ -9223372036854775808 62 -> -9223372036854775808 [valid, matches]
+ -9223372036854775808 63 -> -18446744073709551616 [valid, matches]
+ -9223372036854775808 64 -> -27670116110564327424 [valid, matches]
+ -9223372036854775807 0 -> -9223372036854775808 [valid, matches]
+ -9223372036854775807 1 -> -9223372036854775807 [valid, matches]
+ -9223372036854775807 62 -> -9223372036854775807 [valid, matches]
+ -9223372036854775807 63 -> -18446744073709551615 [valid, matches]
+ -9223372036854775807 64 -> -27670116110564327423 [valid, matches]
+ -9223372036854775806 0 -> -9223372036854775806 [valid, matches]
+ -9223372036854775806 1 -> -9223372036854775808 [valid, matches]
+ -9223372036854775806 62 -> -9223372036854775806 [valid, matches]
+ -9223372036854775806 63 -> -18446744073709551614 [valid, matches]
+ -9223372036854775806 64 -> -27670116110564327422 [valid, matches]
+ -2147483650 0 -> -2147483650 [valid, matches]
+ -2147483650 1 -> -2147483652 [valid, matches]
+ -2147483650 62 -> -4611686020574871554 [valid, matches]
+ -2147483650 63 -> -9223372039002259458 [valid, matches]
+ -2147483650 64 -> -18446744075857035266 [valid, matches]
+ -2147483649 0 -> -2147483650 [valid, matches]
+ -2147483649 1 -> -2147483651 [valid, matches]
+ -2147483649 62 -> -4611686020574871553 [valid, matches]
+ -2147483649 63 -> -9223372039002259457 [valid, matches]
+ -2147483649 64 -> -18446744075857035265 [valid, matches]
+ -2147483648 0 -> -2147483648 [valid, matches]
+ -2147483648 1 -> -2147483648 [valid, matches]
+ -2147483648 62 -> -4611686020574871552 [valid, matches]
+ -2147483648 63 -> -9223372039002259456 [valid, matches]
+ -2147483648 64 -> -18446744075857035264 [valid, matches]
+ -2147483647 0 -> -2147483648 [valid, matches]
+ -2147483647 1 -> -2147483647 [valid, matches]
+ -2147483647 62 -> -4611686020574871551 [valid, matches]
+ -2147483647 63 -> -9223372039002259455 [valid, matches]
+ -2147483647 64 -> -18446744075857035263 [valid, matches]
+ -2147483646 0 -> -2147483646 [valid, matches]
+ -2147483646 1 -> -2147483648 [valid, matches]
+ -2147483646 62 -> -4611686020574871550 [valid, matches]
+ -2147483646 63 -> -9223372039002259454 [valid, matches]
+ -2147483646 64 -> -18446744075857035262 [valid, matches]
+ -2 0 -> -2 [valid, matches]
+ -2 1 -> -4 [valid, matches]
+ -2 62 -> -4611686018427387906 [valid, matches]
+ -2 63 -> -9223372036854775810 [valid, matches]
+ -2 64 -> -18446744073709551618 [valid, matches]
+ -1 0 -> -2 [valid, matches]
+ -1 1 -> -3 [valid, matches]
+ -1 62 -> -4611686018427387905 [valid, matches]
+ -1 63 -> -9223372036854775809 [valid, matches]
+ -1 64 -> -18446744073709551617 [valid, matches]
+ 0 0 -> 0 [valid, matches]
+ 0 1 -> 0 [valid, matches]
+ 0 62 -> 0 [valid, matches]
+ 0 63 -> 0 [valid, matches]
+ 0 64 -> 0 [valid, matches]
+ 1 0 -> 0 [valid, matches]
+ 1 1 -> 1 [valid, matches]
+ 1 62 -> 1 [valid, matches]
+ 1 63 -> 1 [valid, matches]
+ 1 64 -> 1 [valid, matches]
+ 2 0 -> 2 [valid, matches]
+ 2 1 -> 0 [valid, matches]
+ 2 62 -> 2 [valid, matches]
+ 2 63 -> 2 [valid, matches]
+ 2 64 -> 2 [valid, matches]
+ 2147483645 0 -> 2147483644 [valid, matches]
+ 2147483645 1 -> 2147483645 [valid, matches]
+ 2147483645 62 -> 2147483645 [valid, matches]
+ 2147483645 63 -> 2147483645 [valid, matches]
+ 2147483645 64 -> 2147483645 [valid, matches]
+ 2147483646 0 -> 2147483646 [valid, matches]
+ 2147483646 1 -> 2147483644 [valid, matches]
+ 2147483646 62 -> 2147483646 [valid, matches]
+ 2147483646 63 -> 2147483646 [valid, matches]
+ 2147483646 64 -> 2147483646 [valid, matches]
+ 2147483647 0 -> 2147483646 [valid, matches]
+ 2147483647 1 -> 2147483645 [valid, matches]
+ 2147483647 62 -> 2147483647 [valid, matches]
+ 2147483647 63 -> 2147483647 [valid, matches]
+ 2147483647 64 -> 2147483647 [valid, matches]
+ 2147483648 0 -> 2147483648 [valid, matches]
+ 2147483648 1 -> 2147483648 [valid, matches]
+ 2147483648 62 -> 2147483648 [valid, matches]
+ 2147483648 63 -> 2147483648 [valid, matches]
+ 2147483648 64 -> 2147483648 [valid, matches]
+ 2147483649 0 -> 2147483648 [valid, matches]
+ 2147483649 1 -> 2147483649 [valid, matches]
+ 2147483649 62 -> 2147483649 [valid, matches]
+ 2147483649 63 -> 2147483649 [valid, matches]
+ 2147483649 64 -> 2147483649 [valid, matches]
+ 9223372036854775805 0 -> 9223372036854775804 [valid, matches]
+ 9223372036854775805 1 -> 9223372036854775805 [valid, matches]
+ 9223372036854775805 62 -> 4611686018427387901 [valid, matches]
+ 9223372036854775805 63 -> 9223372036854775805 [valid, matches]
+ 9223372036854775805 64 -> 9223372036854775805 [valid, matches]
+ 9223372036854775806 0 -> 9223372036854775806 [valid, matches]
+ 9223372036854775806 1 -> 9223372036854775804 [valid, matches]
+ 9223372036854775806 62 -> 4611686018427387902 [valid, matches]
+ 9223372036854775806 63 -> 9223372036854775806 [valid, matches]
+ 9223372036854775806 64 -> 9223372036854775806 [valid, matches]
+ 9223372036854775807 0 -> 9223372036854775806 [valid, matches]
+ 9223372036854775807 1 -> 9223372036854775805 [valid, matches]
+ 9223372036854775807 62 -> 4611686018427387903 [valid, matches]
+ 9223372036854775807 63 -> 9223372036854775807 [valid, matches]
+ 9223372036854775807 64 -> 9223372036854775807 [valid, matches]
+ 9223372036854775808 0 -> 9223372036854775808 [valid, matches]
+ 9223372036854775808 1 -> 9223372036854775808 [valid, matches]
+ 9223372036854775808 62 -> 9223372036854775808 [valid, matches]
+ 9223372036854775808 63 -> 0 [valid, matches]
+ 9223372036854775808 64 -> 9223372036854775808 [valid, matches]
+ 9223372036854775809 0 -> 9223372036854775808 [valid, matches]
+ 9223372036854775809 1 -> 9223372036854775809 [valid, matches]
+ 9223372036854775809 62 -> 9223372036854775809 [valid, matches]
+ 9223372036854775809 63 -> 1 [valid, matches]
+ 9223372036854775809 64 -> 9223372036854775809 [valid, matches]
+
+complementBit
+ -9223372036854775810 0 -> -9223372036854775809 [valid, matches]
+ -9223372036854775810 1 -> -9223372036854775812 [valid, matches]
+ -9223372036854775810 62 -> -13835058055282163714 [valid, matches]
+ -9223372036854775810 63 -> -2 [valid, matches]
+ -9223372036854775810 64 -> -27670116110564327426 [valid, matches]
+ -9223372036854775809 0 -> -9223372036854775810 [valid, matches]
+ -9223372036854775809 1 -> -9223372036854775811 [valid, matches]
+ -9223372036854775809 62 -> -13835058055282163713 [valid, matches]
+ -9223372036854775809 63 -> -1 [valid, matches]
+ -9223372036854775809 64 -> -27670116110564327425 [valid, matches]
+ -9223372036854775808 0 -> -9223372036854775807 [valid, matches]
+ -9223372036854775808 1 -> -9223372036854775806 [valid, matches]
+ -9223372036854775808 62 -> -4611686018427387904 [valid, matches]
+ -9223372036854775808 63 -> -18446744073709551616 [valid, matches]
+ -9223372036854775808 64 -> -27670116110564327424 [valid, matches]
+ -9223372036854775807 0 -> -9223372036854775808 [valid, matches]
+ -9223372036854775807 1 -> -9223372036854775805 [valid, matches]
+ -9223372036854775807 62 -> -4611686018427387903 [valid, matches]
+ -9223372036854775807 63 -> -18446744073709551615 [valid, matches]
+ -9223372036854775807 64 -> -27670116110564327423 [valid, matches]
+ -9223372036854775806 0 -> -9223372036854775805 [valid, matches]
+ -9223372036854775806 1 -> -9223372036854775808 [valid, matches]
+ -9223372036854775806 62 -> -4611686018427387902 [valid, matches]
+ -9223372036854775806 63 -> -18446744073709551614 [valid, matches]
+ -9223372036854775806 64 -> -27670116110564327422 [valid, matches]
+ -2147483650 0 -> -2147483649 [valid, matches]
+ -2147483650 1 -> -2147483652 [valid, matches]
+ -2147483650 62 -> -4611686020574871554 [valid, matches]
+ -2147483650 63 -> -9223372039002259458 [valid, matches]
+ -2147483650 64 -> -18446744075857035266 [valid, matches]
+ -2147483649 0 -> -2147483650 [valid, matches]
+ -2147483649 1 -> -2147483651 [valid, matches]
+ -2147483649 62 -> -4611686020574871553 [valid, matches]
+ -2147483649 63 -> -9223372039002259457 [valid, matches]
+ -2147483649 64 -> -18446744075857035265 [valid, matches]
+ -2147483648 0 -> -2147483647 [valid, matches]
+ -2147483648 1 -> -2147483646 [valid, matches]
+ -2147483648 62 -> -4611686020574871552 [valid, matches]
+ -2147483648 63 -> -9223372039002259456 [valid, matches]
+ -2147483648 64 -> -18446744075857035264 [valid, matches]
+ -2147483647 0 -> -2147483648 [valid, matches]
+ -2147483647 1 -> -2147483645 [valid, matches]
+ -2147483647 62 -> -4611686020574871551 [valid, matches]
+ -2147483647 63 -> -9223372039002259455 [valid, matches]
+ -2147483647 64 -> -18446744075857035263 [valid, matches]
+ -2147483646 0 -> -2147483645 [valid, matches]
+ -2147483646 1 -> -2147483648 [valid, matches]
+ -2147483646 62 -> -4611686020574871550 [valid, matches]
+ -2147483646 63 -> -9223372039002259454 [valid, matches]
+ -2147483646 64 -> -18446744075857035262 [valid, matches]
+ -2 0 -> -1 [valid, matches]
+ -2 1 -> -4 [valid, matches]
+ -2 62 -> -4611686018427387906 [valid, matches]
+ -2 63 -> -9223372036854775810 [valid, matches]
+ -2 64 -> -18446744073709551618 [valid, matches]
+ -1 0 -> -2 [valid, matches]
+ -1 1 -> -3 [valid, matches]
+ -1 62 -> -4611686018427387905 [valid, matches]
+ -1 63 -> -9223372036854775809 [valid, matches]
+ -1 64 -> -18446744073709551617 [valid, matches]
+ 0 0 -> 1 [valid, matches]
+ 0 1 -> 2 [valid, matches]
+ 0 62 -> 4611686018427387904 [valid, matches]
+ 0 63 -> 9223372036854775808 [valid, matches]
+ 0 64 -> 18446744073709551616 [valid, matches]
+ 1 0 -> 0 [valid, matches]
+ 1 1 -> 3 [valid, matches]
+ 1 62 -> 4611686018427387905 [valid, matches]
+ 1 63 -> 9223372036854775809 [valid, matches]
+ 1 64 -> 18446744073709551617 [valid, matches]
+ 2 0 -> 3 [valid, matches]
+ 2 1 -> 0 [valid, matches]
+ 2 62 -> 4611686018427387906 [valid, matches]
+ 2 63 -> 9223372036854775810 [valid, matches]
+ 2 64 -> 18446744073709551618 [valid, matches]
+ 2147483645 0 -> 2147483644 [valid, matches]
+ 2147483645 1 -> 2147483647 [valid, matches]
+ 2147483645 62 -> 4611686020574871549 [valid, matches]
+ 2147483645 63 -> 9223372039002259453 [valid, matches]
+ 2147483645 64 -> 18446744075857035261 [valid, matches]
+ 2147483646 0 -> 2147483647 [valid, matches]
+ 2147483646 1 -> 2147483644 [valid, matches]
+ 2147483646 62 -> 4611686020574871550 [valid, matches]
+ 2147483646 63 -> 9223372039002259454 [valid, matches]
+ 2147483646 64 -> 18446744075857035262 [valid, matches]
+ 2147483647 0 -> 2147483646 [valid, matches]
+ 2147483647 1 -> 2147483645 [valid, matches]
+ 2147483647 62 -> 4611686020574871551 [valid, matches]
+ 2147483647 63 -> 9223372039002259455 [valid, matches]
+ 2147483647 64 -> 18446744075857035263 [valid, matches]
+ 2147483648 0 -> 2147483649 [valid, matches]
+ 2147483648 1 -> 2147483650 [valid, matches]
+ 2147483648 62 -> 4611686020574871552 [valid, matches]
+ 2147483648 63 -> 9223372039002259456 [valid, matches]
+ 2147483648 64 -> 18446744075857035264 [valid, matches]
+ 2147483649 0 -> 2147483648 [valid, matches]
+ 2147483649 1 -> 2147483651 [valid, matches]
+ 2147483649 62 -> 4611686020574871553 [valid, matches]
+ 2147483649 63 -> 9223372039002259457 [valid, matches]
+ 2147483649 64 -> 18446744075857035265 [valid, matches]
+ 9223372036854775805 0 -> 9223372036854775804 [valid, matches]
+ 9223372036854775805 1 -> 9223372036854775807 [valid, matches]
+ 9223372036854775805 62 -> 4611686018427387901 [valid, matches]
+ 9223372036854775805 63 -> 18446744073709551613 [valid, matches]
+ 9223372036854775805 64 -> 27670116110564327421 [valid, matches]
+ 9223372036854775806 0 -> 9223372036854775807 [valid, matches]
+ 9223372036854775806 1 -> 9223372036854775804 [valid, matches]
+ 9223372036854775806 62 -> 4611686018427387902 [valid, matches]
+ 9223372036854775806 63 -> 18446744073709551614 [valid, matches]
+ 9223372036854775806 64 -> 27670116110564327422 [valid, matches]
+ 9223372036854775807 0 -> 9223372036854775806 [valid, matches]
+ 9223372036854775807 1 -> 9223372036854775805 [valid, matches]
+ 9223372036854775807 62 -> 4611686018427387903 [valid, matches]
+ 9223372036854775807 63 -> 18446744073709551615 [valid, matches]
+ 9223372036854775807 64 -> 27670116110564327423 [valid, matches]
+ 9223372036854775808 0 -> 9223372036854775809 [valid, matches]
+ 9223372036854775808 1 -> 9223372036854775810 [valid, matches]
+ 9223372036854775808 62 -> 13835058055282163712 [valid, matches]
+ 9223372036854775808 63 -> 0 [valid, matches]
+ 9223372036854775808 64 -> 27670116110564327424 [valid, matches]
+ 9223372036854775809 0 -> 9223372036854775808 [valid, matches]
+ 9223372036854775809 1 -> 9223372036854775811 [valid, matches]
+ 9223372036854775809 62 -> 13835058055282163713 [valid, matches]
+ 9223372036854775809 63 -> 1 [valid, matches]
+ 9223372036854775809 64 -> 27670116110564327425 [valid, matches]
+
=====================================
testsuite/tests/numeric/should_run/all.T
=====================================
@@ -101,3 +101,4 @@ test('T24245', normal, compile_and_run, [''])
test('T25653', normal, compile_and_run, [''])
test('T18619', exit_code(1), compile_and_run, [''])
test('T26230', normal, compile_and_run, [''])
+test('T21176', normal, compile_and_run, [''])
=====================================
testsuite/tests/simplCore/should_compile/T8832.hs
=====================================
@@ -23,3 +23,9 @@ T(w32,Word32)
T(w64,Word64)
T(z,Integer)
+
+zset :: Integer
+zset = setBit (bit 0) 0
+
+zcompl :: Integer
+zcompl = complementBit (bit 0) 0
=====================================
testsuite/tests/simplCore/should_compile/T8832.stdout
=====================================
@@ -8,4 +8,6 @@ w8 = GHC.Internal.Word.W8# 0#Word8
w16 = GHC.Internal.Word.W16# 0#Word16
w32 = GHC.Internal.Word.W32# 0#Word32
w64 = GHC.Internal.Word.W64# 0#Word64
-z = GHC.Internal.Bignum.Integer.IS 0#
+zcompl = GHC.Internal.Bignum.Integer.IS 0#
+zset = GHC.Internal.Bignum.Integer.IS 1#
+z = zcompl
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/869b0a579ee518f2bc57ceca487c3c1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/869b0a579ee518f2bc57ceca487c3c1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sg/first-class-strict] 6 commits: Strict: make demand analysis and CPR transparent to the box
by Sebastian Graf (＠sgraf812) 23 Jun '26
by Sebastian Graf (＠sgraf812) 23 Jun '26
23 Jun '26
Sebastian Graf pushed to branch wip/sg/first-class-strict at Glasgow Haskell Compiler / GHC
Commits:
b7361fae by I-Al-Istannen at 2026-06-22T19:03:18+02:00
Strict: make demand analysis and CPR transparent to the box
Demand and CPR analysis look through Strict/MkStrict so that a product
demand on Strict a is passed to the wrapped field and CPR information flows
likewise, and exprIsTrivial / unfolding sizing treat MkStrict on a value as
trivial. Accepts the resulting signature churn in the test suite.
Co-authored-by: Sebastian Graf <sgraf1337(a)gmail.com>
- - - - -
ab5fbda5 by I-Al-Istannen at 2026-06-22T19:03:18+02:00
Strict: unbox strict arguments through the box in worker/wrapper
Worker/wrapper marks each strictified worker argument with Strict, so the
wrapper passes an evaluated value and the worker need not re-force it, and
unboxes the wrapped type when profitable.
Co-authored-by: Sebastian Graf <sgraf1337(a)gmail.com>
- - - - -
8a69e8b1 by I-Al-Istannen at 2026-06-22T19:03:18+02:00
Desugar: only reconstruct constructor fields used by the body
Co-authored-by: Sebastian Graf <sgraf1337(a)gmail.com>
- - - - -
79a11a3a by I-Al-Istannen at 2026-06-22T23:31:28+02:00
CorePrep: erase MkStrict via a representational cast
MkStrict is erased in CorePrep: a producer becomes the field cast to
Strict a with a heterogeneous representational coercion, forcing the field
first when it is not already a value; a consumer match becomes the scrutinee
cast back. Core Lint tolerates the resulting out-of-scope type variables and
the Strict coercion. See Note [The Strict type].
Co-authored-by: Sebastian Graf <sgraf1337(a)gmail.com>
- - - - -
bdadc080 by I-Al-Istannen at 2026-06-22T23:31:28+02:00
Strict: STG representation and code generation
Treats Strict a as a single unlifted heap pointer through RepType,
unarisation, STG lint, tag inference and StgToCmm: an unlifted box is already
evaluated and properly tagged, so it is returned directly unless applied as a
function. An STG Lint check flags an evaluated binder lowered to an updatable
indirection.
Co-authored-by: Sebastian Graf <sgraf1337(a)gmail.com>
- - - - -
f47fb1b3 by Sebastian Graf at 2026-06-22T23:31:28+02:00
Strict: add a should_run test for the strict-field machinery
StrictBox exercises a strict value field built from a thunk (forced to an
evaluated, properly-tagged value), a strict field of function type that is
applied, worker/wrapper unboxing of a strict argument, and a strict field
holding another boxed value. Run with -dtag-inference-checks so that a strict
field that is not properly tagged aborts at runtime.
- - - - -
58 changed files:
- compiler/GHC/Builtin/PrimOps/Casts.hs
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/Unfold.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Driver/Config/Core/Lint/Interactive.hs
- compiler/GHC/Driver/Config/CoreToStg/Prep.hs
- compiler/GHC/Driver/Main/Interactive.hs
- compiler/GHC/Driver/Main/Passes.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/HsToCore/Utils.hs
- compiler/GHC/Stg/Lint.hs
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/StgToCmm/Closure.hs
- compiler/GHC/StgToCmm/Expr.hs
- compiler/GHC/StgToCmm/TagCheck.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/RepType.hs
- testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout
- testsuite/tests/codeGen/should_compile/T25166.stdout-ws-64
- + testsuite/tests/codeGen/should_run/StrictBox.hs
- + testsuite/tests/codeGen/should_run/StrictBox.stdout
- testsuite/tests/codeGen/should_run/all.T
- testsuite/tests/core-to-stg/T24124.stderr
- testsuite/tests/cpranal/should_compile/T18109.stderr
- testsuite/tests/cpranal/should_compile/T18174.stderr
- testsuite/tests/dmdanal/should_compile/T10482.stderr
- testsuite/tests/dmdanal/should_compile/T10482a.stderr
- testsuite/tests/dmdanal/sigs/T16197b.stderr
- testsuite/tests/dmdanal/sigs/T16859.stderr
- testsuite/tests/dmdanal/sigs/T17932.stderr
- testsuite/tests/dmdanal/sigs/T22241.stderr
- testsuite/tests/ghci.debugger/scripts/T13825-debugger.stdout
- testsuite/tests/ghci.debugger/scripts/print007.stdout
- testsuite/tests/ghci.debugger/scripts/print022.stdout
- + testsuite/tests/perf/should_run/StrictBuilderFusion.hs
- + testsuite/tests/perf/should_run/StrictBuilderFusion.stdout
- testsuite/tests/perf/should_run/all.T
- testsuite/tests/profiling/should_compile/prof-late-cc3.stderr
- testsuite/tests/simplCore/should_compile/T18013.stderr
- testsuite/tests/simplCore/should_compile/T22309.stderr
- testsuite/tests/simplCore/should_compile/T24359a.stderr
- testsuite/tests/simplCore/should_compile/T26615.stderr
- testsuite/tests/simplCore/should_compile/T4081.stderr
- testsuite/tests/simplStg/should_compile/T15226b.stderr
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1ca509da674c17d9f5aeee86bfdbed…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1ca509da674c17d9f5aeee86bfdbed…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sol/reexported-error-message] Reference correct package in error messages for reexported modules
by Simon Hengel (＠sol) 22 Jun '26
by Simon Hengel (＠sol) 22 Jun '26
22 Jun '26
Simon Hengel pushed to branch wip/sol/reexported-error-message at Glasgow Haskell Compiler / GHC
Commits:
b01ccf21 by Simon Hengel at 2026-06-23T00:42:00+07:00
Reference correct package in error messages for reexported modules
(fixes #27417)
- - - - -
11 changed files:
- + changelog.d/reexported-module-errors
- compiler/GHC/Iface/Errors.hs
- compiler/GHC/Iface/Errors/Ppr.hs
- compiler/GHC/Iface/Errors/Types.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Finder/Types.hs
- compiler/GHC/Unit/State.hs
- ghc/GHCi/UI/Exception.hs
- + testsuite/tests/package/ImportReexport.hs
- + testsuite/tests/package/ImportReexport.stderr
- testsuite/tests/package/all.T
Changes:
=====================================
changelog.d/reexported-module-errors
=====================================
@@ -0,0 +1,4 @@
+section: compiler
+synopsis: Reference the correct package in error messages when trying to import a reexported module from a hidden package.
+issues: #27417
+mrs: !16229
=====================================
compiler/GHC/Iface/Errors.hs
=====================================
@@ -128,7 +128,7 @@ cantFindErr unit_env profile mod_name find_result
| otherwise
-> GenericMissing
- (map ((\uid -> (uid, lookupUnit (ue_homeUnitState unit_env) uid))) pkg_hiddens)
+ pkg_hiddens
mod_hiddens unusables files
_ -> panic "cantFindErr"
=====================================
compiler/GHC/Iface/Errors/Ppr.hs
=====================================
@@ -261,13 +261,13 @@ cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInst
.ppr.mkUnit) res ++
if f then [text "a package flag"] else []
)
- pkg_hidden :: (Unit, Maybe UnitInfo) -> SDoc
- pkg_hidden (uid, uif) =
+ pkg_hidden :: UnitInfo -> SDoc
+ pkg_hidden unit =
text "It is a member of the hidden package"
- <+> quotes (ppr uid)
+ <+> quotes (ppr $ unitId unit)
--FIXME: we don't really want to show the unit id here we should
-- show the source package id or installed package id if it's ambiguous
- <> dot $$ maybe empty pkg_hidden_hint uif
+ <> dot $$ pkg_hidden_hint unit
mod_hidden pkg =
=====================================
compiler/GHC/Iface/Errors/Types.hs
=====================================
@@ -73,7 +73,7 @@ data CantFindInstalledReason
| NotAModule
| CouldntFindInFiles [FilePath]
| GenericMissing
- [(Unit, Maybe UnitInfo)] [Unit]
+ [UnitInfo] [Unit]
[UnusableUnit] [FilePath]
| MultiplePackages [(Module, ModuleOrigin)]
deriving Generic
=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -510,9 +510,9 @@ findLookupResult fc fopts r = case r of
, fr_suggestions = []})
LookupMultiple rs ->
return (FoundMultiple rs)
- LookupHidden pkg_hiddens mod_hiddens ->
+ LookupHidden fr_pkgs_hidden mod_hiddens ->
return (NotFound{ fr_paths = [], fr_pkg = Nothing
- , fr_pkgs_hidden = map (moduleUnit.fst) pkg_hiddens
+ , fr_pkgs_hidden
, fr_mods_hidden = map (moduleUnit.fst) mod_hiddens
, fr_unusables = []
, fr_suggestions = [] })
=====================================
compiler/GHC/Unit/Finder/Types.hs
=====================================
@@ -70,7 +70,7 @@ data FindResult
, fr_mods_hidden :: [Unit] -- ^ Module is in these units,
-- but the *module* is hidden
- , fr_pkgs_hidden :: [Unit] -- ^ Module is in these units,
+ , fr_pkgs_hidden :: [UnitInfo] -- ^ Module is in these units,
-- but the *unit* is hidden
-- | Module is in these units, but it is unusable
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -1905,7 +1905,7 @@ data LookupResult =
-- | No modules found, but there were some hidden ones with
-- an exact name match. First is due to package hidden, second
-- is due to module being hidden
- | LookupHidden [(Module, ModuleOrigin)] [(Module, ModuleOrigin)]
+ | LookupHidden [UnitInfo] [(Module, ModuleOrigin)]
-- | No modules found, but there were some unusable ones with
-- an exact name match
| LookupUnusable [(Module, ModuleOrigin)]
@@ -1954,8 +1954,8 @@ lookupModuleWithSuggestions' :: UnitState
-> ModuleName
-> PkgQual
-> LookupResult
-lookupModuleWithSuggestions' pkgs mod_map m mb_pn
- = case lookupUniqMap mod_map m of
+lookupModuleWithSuggestions' pkgs mod_map name mb_pn
+ = case lookupUniqMap mod_map name of
Nothing -> LookupNotFound suggestions
Just xs ->
case foldl' classify ([],[],[], []) (sortOn fst $ nonDetUniqMapToList xs) of
@@ -1974,14 +1974,21 @@ lookupModuleWithSuggestions' pkgs mod_map m mb_pn
-> (hidden_pkg, x:hidden_mod, unusable, exposed)
ModUnusable _
-> (hidden_pkg, hidden_mod, x:unusable, exposed)
- _ | originEmpty origin
+ ModOrigin { fromOrigUnit = origAvailableUnderSameName, fromHiddenReexport }
+ | originEmpty origin
-> (hidden_pkg, hidden_mod, unusable, exposed)
| originVisible origin
-> (hidden_pkg, hidden_mod, unusable, x:exposed)
| otherwise
- -> (x:hidden_pkg, hidden_mod, unusable, exposed)
+ -> (reexports ++ maybe id (:) origUnit hidden_pkg, hidden_mod, unusable, exposed)
+ where
+ reexports :: [UnitInfo]
+ reexports = sortOn unitId fromHiddenReexport
- unit_lookup p = lookupUnit pkgs p `orElse` pprPanic "lookupModuleWithSuggestions" (ppr p <+> ppr m)
+ origUnit :: Maybe UnitInfo
+ origUnit = origAvailableUnderSameName >> lookupUnit pkgs (moduleUnit m)
+
+ unit_lookup p = lookupUnit pkgs p `orElse` pprPanic "lookupModuleWithSuggestions" (ppr p <+> ppr name)
mod_unit = unit_lookup . moduleUnit
-- Filters out origins which are not associated with the given package
@@ -2011,7 +2018,7 @@ lookupModuleWithSuggestions' pkgs mod_map m mb_pn
, fromPackageFlag = False -- always excluded
}
- suggestions = fuzzyLookup (moduleNameString m) all_mods
+ suggestions = fuzzyLookup (moduleNameString name) all_mods
all_mods :: [(String, ModuleSuggestion)] -- All modules
all_mods = sortBy (comparing fst) $
=====================================
ghc/GHCi/UI/Exception.hs
=====================================
@@ -222,11 +222,13 @@ ghciDiagnosticMessage ghc_opts msg =
Just (pprWithUnitState us $ cantFindErrorX pkg_hidden_hint may_show_locations module_or_interface cfi)
_ -> Nothing
where
-
+ may_show_locations :: [String] -> SDoc
may_show_locations = mayShowLocations ":set -v" (ifaceShowTriedFiles opts)
+ pkg_hidden_hint :: UnitInfo -> SDoc
pkg_hidden_hint = pkgHiddenHint hidden_msg (ifaceBuildingCabalPackage opts)
where
+ hidden_msg :: UnitInfo -> SDoc
hidden_msg pkg =
text "You can run" <+>
quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
=====================================
testsuite/tests/package/ImportReexport.hs
=====================================
@@ -0,0 +1,3 @@
+module ImportReexport where
+import GHC.Types -- reexported and renamed by ghc-prim from ghc-internal
+import GHC.Platform.ArchOS -- reexported by by ghc and ghc-boot + provided by ghc-platform
=====================================
testsuite/tests/package/ImportReexport.stderr
=====================================
@@ -0,0 +1,12 @@
+ImportReexport.hs:2:1: error: [GHC-87110]
+ Could not load module ‘GHC.Types’.
+ It is a member of the hidden package ‘ghc-prim-0.14.0’.
+ Use -v to see a list of the files searched for.
+
+ImportReexport.hs:3:1: error: [GHC-87110]
+ Could not load module ‘GHC.Platform.ArchOS’.
+ It is a member of the hidden package ‘ghc-10.1’.
+ It is a member of the hidden package ‘ghc-boot-10.1’.
+ It is a member of the hidden package ‘ghc-platform-0.1.0.0’.
+ Use -v to see a list of the files searched for.
+
=====================================
testsuite/tests/package/all.T
=====================================
@@ -13,6 +13,7 @@ test('package04', normal, compile, [incr_containers])
test('package05', normal, compile, [incr_ghc + inc_ghc])
test('package06', normal, compile, [incr_ghc])
test('package06e', normalise_version('ghc'), compile_fail, [incr_ghc])
+test('ImportReexport', normalise_version('ghc'), compile_fail, ['-hide-all-packages -XNoImplicitPrelude'])
test('package07e', normalise_version('ghc'), compile_fail, [incr_ghc + inc_ghc + hide_ghc])
test('package08e', normalise_version('ghc'), compile_fail, [incr_ghc + hide_ghc])
test('package09e', normal, compile_fail, ['-package "containers (Data.Map as M, Data.Set as M)"'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b01ccf21c549fdc0fde38d0b56aa748…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b01ccf21c549fdc0fde38d0b56aa748…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sol/interactive-error-hints] Add a flag to control GHCi specific error hints (close #27409)
by Simon Hengel (＠sol) 22 Jun '26
by Simon Hengel (＠sol) 22 Jun '26
22 Jun '26
Simon Hengel pushed to branch wip/sol/interactive-error-hints at Glasgow Haskell Compiler / GHC
Commits:
4454366a by Simon Hengel at 2026-06-22T23:59:01+07:00
Add a flag to control GHCi specific error hints (close #27409)
- - - - -
12 changed files:
- + changelog.d/interactive-error-hints
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Utils/Outputable.hs
- docs/users_guide/ghci.rst
- ghc/GHCi/UI/Exception.hs
- ghc/Main.hs
- testsuite/tests/ghci/prog-mhu002/prog-mhu002c.stdout
- testsuite/tests/ghci/scripts/ghci024.stdout
- testsuite/tests/ghci/scripts/ghci024.stdout-mingw32
Changes:
=====================================
changelog.d/interactive-error-hints
=====================================
@@ -0,0 +1,6 @@
+section: compiler
+synopsis:
+ Add flags `-finteractive-error-hints` / `-fno-interactive-error-hints` that
+ control whether GHCi specific error hints are printed.
+issues: #27409
+mrs: !16225
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -1570,6 +1570,7 @@ initSDocContext dflags style = SDC
, sdocLineLength = pprCols dflags
, sdocCanUseUnicode = useUnicode dflags
, sdocPrintErrIndexLinks = overrideWith (canUseErrorLinks dflags) (useErrorLinks dflags)
+ , sdocInteractiveErrorHints = gopt Opt_InteractiveErrorHints dflags
, sdocHexWordLiterals = gopt Opt_HexWordLiterals dflags
, sdocPprDebug = dopt Opt_D_ppr_debug dflags
, sdocPrintUnicodeSyntax = gopt Opt_PrintUnicodeSyntax dflags
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -861,6 +861,7 @@ data GeneralFlag
-- Error message suppression
| Opt_ShowErrorContext
+ | Opt_InteractiveErrorHints
-- Object code determinism
| Opt_ObjectDeterminism
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2665,6 +2665,7 @@ fFlagsDeps = [
(addWarn "-compact-unwind is only implemented by the darwin platform. Ignoring.")
return dflags)),
flagSpec "show-error-context" Opt_ShowErrorContext,
+ flagSpec "interactive-error-hints" Opt_InteractiveErrorHints,
flagSpec "cmm-thread-sanitizer" Opt_CmmThreadSanitizer,
flagSpec "split-sections" Opt_SplitSections,
flagSpec "break-points" Opt_InsertBreakpoints,
=====================================
compiler/GHC/Types/Hint/Ppr.hs
=====================================
@@ -43,19 +43,44 @@ instance Outputable GhcHint where
-> case extHint of
SuggestSingleExtension extraUserInfo ext ->
("Perhaps you intended to use" <+> extension_with_implied ext)
- $$ extraUserInfo
+ $$ interactiveErrorHints [ext] extraUserInfo False
SuggestAnyExtension extraUserInfo exts ->
(enable "any" <+> unquotedListWith "or" (map implied exts))
- $$ extraUserInfo
+ $$ interactiveErrorHints exts extraUserInfo True
SuggestExtensions extraUserInfo exts ->
(enable "all" <+> unquotedListWith "and" (map implied exts))
- $$ extraUserInfo
+ $$ interactiveErrorHints exts extraUserInfo False
SuggestExtensionInOrderTo extraUserInfo ext ->
("Use" <+> extension_with_implied ext)
- $$ extraUserInfo
+ $$ interactiveErrorHints [ext] extraUserInfo False
where extension_with_implied ext = "the" <+> quotes (ppr ext) <+> "extension" <+> pprImpliedExtensions ext
implied ext = quotes (ppr ext) <+> pprImpliedExtensions ext
enable any_or_all = "Enable" <+> any_or_all <+> "of the following extensions" <> colon
+
+ interactiveErrorHints :: [LangExt.Extension] -> SDoc -> Bool -> SDoc
+ interactiveErrorHints exts doc enable_any = sdocOption sdocInteractiveErrorHints $ \ case
+ True -> suggestSetExt exts doc enable_any
+ False -> doc
+
+ -- Suggest enabling extension with :set -X<ext>
+ -- SuggestAnyExtension will be on multiple lines so the user can select which to enable without editing
+ suggestSetExt :: [LangExt.Extension] -> SDoc -> Bool -> SDoc
+ suggestSetExt exts doc enable_any = doc $$ hang header 2 exts_cmds
+ where
+ header = text "You may enable" <+> which <+> text "language extension" <> plural exts <+> text "in GHCi with:"
+ which
+ | [ _ext ] <- exts
+ = text "this"
+ | otherwise
+ = if enable_any
+ then text "these"
+ else text "all of these"
+ exts_cmds
+ | enable_any
+ = vcat $ map (\ext -> text ":set -X" <> ppr ext) exts
+ | otherwise
+ = text ":set" <> hcat (map (\ext -> text " -X" <> ppr ext) exts)
+
SuggestCorrectPragmaName suggestions
-> text "Perhaps you meant" <+> quotedListWithOr (map text suggestions)
SuggestMissingDo
=====================================
compiler/GHC/Utils/Outputable.hs
=====================================
@@ -398,6 +398,7 @@ data SDocContext = SDC
-- ^ True if Unicode encoding is supported
-- and not disabled by GHC_NO_UNICODE environment variable
, sdocPrintErrIndexLinks :: !Bool
+ , sdocInteractiveErrorHints :: !Bool
, sdocHexWordLiterals :: !Bool
, sdocPprDebug :: !Bool
, sdocPrintUnicodeSyntax :: !Bool
@@ -466,6 +467,7 @@ defaultSDocContext = SDC
, sdocLineLength = defaultSDocCols
, sdocCanUseUnicode = False
, sdocPrintErrIndexLinks = False
+ , sdocInteractiveErrorHints = False
, sdocHexWordLiterals = False
, sdocPprDebug = False
, sdocPrintUnicodeSyntax = False
=====================================
docs/users_guide/ghci.rst
=====================================
@@ -2114,6 +2114,27 @@ mostly obvious.
If disabled, only the target given last on the command line interface will be
added to interactive context of the GHCi session.
+.. ghc-flag:: -finteractive-error-hints
+ :shortdesc: Print GHCi specific error hints.
+ :type: dynamic
+ :reverse: -fno-interactive-error-hints
+ :category:
+
+ :default: on
+ :since: XXX
+
+ By default, GHCi extends error hints with GHCi specific instructions.
+
+ Example:
+
+ .. code-block:: none
+
+ Perhaps you intended to use the ‘BlockArguments’ extension
+ You may enable this language extension in GHCi with:
+ :set -XBlockArguments
+
+ This can be disabled with `-fno-interactive-error-hints`.
+
Packages
~~~~~~~~
=====================================
ghc/GHCi/UI/Exception.hs
=====================================
@@ -23,8 +23,6 @@ import GHC.Driver.Errors.Types
import GHC.Iface.Errors.Ppr
import GHC.Iface.Errors.Types
-import qualified GHC.LanguageExtensions as LangExt
-
import GHC.Tc.Errors.Ppr
import GHC.Tc.Errors.Types
@@ -137,7 +135,7 @@ instance Diagnostic GhciMessage where
GhciUnknownMessage m -> diagnosticReason m
diagnosticHints = \case
- GhciGhcMessage m -> map GhciGhcHint (ghciDiagnosticHints m)
+ GhciGhcMessage m -> map GhciGhcHint (diagnosticHints m)
GhciCommandMessage m -> map GhciCommandHint (diagnosticHints m)
GhciUnknownMessage m -> diagnosticHints m
@@ -146,40 +144,6 @@ instance Diagnostic GhciMessage where
GhciCommandMessage m -> diagnosticCode m
GhciUnknownMessage m -> diagnosticCode m
-
--- | Modifications to hint messages which we want to display in GHCi.
-ghciDiagnosticHints :: GhcMessage -> [GhcHint]
-ghciDiagnosticHints msg = map modifyHintForGHCi (diagnosticHints msg)
- where
- modifyHintForGHCi :: GhcHint -> GhcHint
- modifyHintForGHCi = \case
- SuggestExtension extHint -> SuggestExtension $ modifyExtHintForGHCi extHint
- hint -> hint
- modifyExtHintForGHCi :: LanguageExtensionHint -> LanguageExtensionHint
- modifyExtHintForGHCi = \case
- SuggestSingleExtension doc ext -> SuggestSingleExtension (suggestSetExt [ext] doc False) ext
- SuggestExtensionInOrderTo doc ext -> SuggestExtensionInOrderTo (suggestSetExt [ext] doc False) ext
- SuggestAnyExtension doc exts -> SuggestAnyExtension (suggestSetExt exts doc True ) exts
- SuggestExtensions doc exts -> SuggestExtensions (suggestSetExt exts doc False) exts
- -- Suggest enabling extension with :set -X<ext>
- -- SuggestAnyExtension will be on multiple lines so the user can select which to enable without editing
- suggestSetExt :: [LangExt.Extension] -> SDoc -> Bool -> SDoc
- suggestSetExt exts doc enable_any = doc $$ hang header 2 exts_cmds
- where
- header = text "You may enable" <+> which <+> text "language extension" <> plural exts <+> text "in GHCi with:"
- which
- | [ _ext ] <- exts
- = text "this"
- | otherwise
- = if enable_any
- then text "these"
- else text "all of these"
- exts_cmds
- | enable_any
- = vcat $ map (\ext -> text ":set -X" <> ppr ext) exts
- | otherwise
- = text ":set" <> hcat (map (\ext -> text " -X" <> ppr ext) exts)
-
-- | Modifications to error messages which we want to display in GHCi
ghciDiagnosticMessage :: GhcMessageOpts -> GhcMessage -> DecoratedSDoc
ghciDiagnosticMessage ghc_opts msg =
=====================================
ghc/Main.hs
=====================================
@@ -199,6 +199,7 @@ main' postLoadMode units dflags0 args flagWarnings = do
| DoRun <- postLoadMode = def_ghci_flags
| otherwise = dflags1
where def_ghci_flags = dflags1 `gopt_set` Opt_ImplicitImportQualified
+ `gopt_set` Opt_InteractiveErrorHints
`gopt_set` Opt_IgnoreOptimChanges
`gopt_set` Opt_IgnoreHpcChanges
-- Setting this by default has the nice effect that
=====================================
testsuite/tests/ghci/prog-mhu002/prog-mhu002c.stdout
=====================================
@@ -14,6 +14,7 @@ other dynamic, non-language, flag settings:
-fno-unoptimized-core-for-interpreter
-fshow-warning-groups
-fprefer-byte-code
+ -finteractive-error-hints
-fbreak-points
warning settings:
-Wpattern-namespace-specifier
@@ -33,6 +34,7 @@ other dynamic, non-language, flag settings:
-fno-unoptimized-core-for-interpreter
-fshow-warning-groups
-fprefer-byte-code
+ -finteractive-error-hints
-fbreak-points
warning settings:
-Wpattern-namespace-specifier
@@ -50,6 +52,7 @@ other dynamic, non-language, flag settings:
-fno-unoptimized-core-for-interpreter
-fshow-warning-groups
-fprefer-byte-code
+ -finteractive-error-hints
-fbreak-points
warning settings:
-Wpattern-namespace-specifier
@@ -67,6 +70,7 @@ other dynamic, non-language, flag settings:
-fno-unoptimized-core-for-interpreter
-fshow-warning-groups
-fprefer-byte-code
+ -finteractive-error-hints
-fbreak-points
warning settings:
-Wpattern-namespace-specifier
@@ -84,6 +88,7 @@ other dynamic, non-language, flag settings:
-fno-unoptimized-core-for-interpreter
-fshow-warning-groups
-fprefer-byte-code
+ -finteractive-error-hints
-fbreak-points
warning settings:
-Wpattern-namespace-specifier
=====================================
testsuite/tests/ghci/scripts/ghci024.stdout
=====================================
@@ -12,6 +12,7 @@ other dynamic, non-language, flag settings:
-fimplicit-import-qualified
-fshow-warning-groups
-fprefer-byte-code
+ -finteractive-error-hints
-fbreak-points
warning settings:
-Wpattern-namespace-specifier
=====================================
testsuite/tests/ghci/scripts/ghci024.stdout-mingw32
=====================================
@@ -12,6 +12,7 @@ other dynamic, non-language, flag settings:
-fimplicit-import-qualified
-fshow-warning-groups
-fprefer-byte-code
+ -finteractive-error-hints
-fbreak-points
warning settings:
-Wpattern-namespace-specifier
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4454366af0b630722ad0fa727e734fd…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4454366af0b630722ad0fa727e734fd…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Deleted branch wip/jeltsch/pipeline-interruption-doc-fixes
by Wolfgang Jeltsch (＠jeltsch) 22 Jun '26
by Wolfgang Jeltsch (＠jeltsch) 22 Jun '26
22 Jun '26
Wolfgang Jeltsch deleted branch wip/jeltsch/pipeline-interruption-doc-fixes at Glasgow Haskell Compiler / GHC
--
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Wolfgang Jeltsch deleted branch wip/sort-usages at Glasgow Haskell Compiler / GHC
--
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/mangoiv/unused-type] compiler: rename ZonkAny to UnusedType and add pretty printing logic
by Magnus (＠MangoIV) 22 Jun '26
by Magnus (＠MangoIV) 22 Jun '26
22 Jun '26
Magnus pushed to branch wip/mangoiv/unused-type at Glasgow Haskell Compiler / GHC
Commits:
51d623cd by mangoiv at 2026-06-22T17:12:51+02:00
compiler: rename ZonkAny to UnusedType and add pretty printing logic
ZonkAny is a hard to understand name for users who do not know how the
compiler works internally. Additionally, it is confusing that ZonkAny,
while being a concrete type *represents* a meta variable, espeically in
the compiler output.
This patch changes the name of ZonkAny to UnusedType which is closer to
its intended semantics and adds special pretty printing logic to display
this type in the same fashion the compiler displays meta variables in
other places, whenever they leak from the implementation to the user.
It also exports the type from ghc-internal:GHC.Internal.Types in order
to expose documentation.
Fixes #27390
Co-Authored-By: Sam Derbyshire <sam.derbyshire(a)gmail.com>
- - - - -
22 changed files:
- + changelog.d/unused-type
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Zonk/Type.hs
- libraries/ghc-internal/src/GHC/Internal/Types.hs
- testsuite/tests/perf/compiler/T11068.stdout
- testsuite/tests/pmcheck/should_compile/T12957.stderr
- testsuite/tests/profiling/should_run/staticcallstack002.stdout
- testsuite/tests/simplCore/should_compile/Makefile
- testsuite/tests/simplCore/should_compile/T13156.stdout
- testsuite/tests/simplCore/should_compile/T26615.stderr
- testsuite/tests/typecheck/should_fail/T13292.stderr
- + testsuite/tests/typecheck/should_fail/T27390-explicit-kinds.stderr
- + testsuite/tests/typecheck/should_fail/T27390.hs
- + testsuite/tests/typecheck/should_fail/T27390.stderr
- + testsuite/tests/typecheck/should_fail/T27390a.hs
- testsuite/tests/typecheck/should_fail/all.T
Changes:
=====================================
changelog.d/unused-type
=====================================
@@ -0,0 +1,12 @@
+section: compiler
+synopsis: Rename ZonkAny to UnusedType and add pretty printing logic for it.
+issues: #27390
+mrs: !16212
+
+description: {
+ After unification, GHC fills in unconstrained type variables such as ``alpha`` in
+ ``(length :: [alpha] -> Int) ([] :: List alpha) :: Int`` with a fixed type.
+ This type was, confusingly to the user, called ``ZonkAny``.
+ This type is now renamed ``UnusedType``, with special pretty-printing logic to make
+ it display like an ordinary metavariable.
+}
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -1904,8 +1904,8 @@ unsatisfiableClassNameKey = mkPreludeTyConUnique 170
anyTyConKey :: Unique
anyTyConKey = mkPreludeTyConUnique 171
-zonkAnyTyConKey :: Unique
-zonkAnyTyConKey = mkPreludeTyConUnique 172
+unusedTypeTyConKey :: Unique
+unusedTypeTyConKey = mkPreludeTyConUnique 172
-- Custom user type-errors
errorMessageTypeErrorFamKey :: Unique
=====================================
compiler/GHC/Builtin/Types.hs
=====================================
@@ -93,7 +93,7 @@ module GHC.Builtin.Types (
cTupleSelId, cTupleSelIdName,
-- * Any
- anyTyCon, anyTy, anyTypeOfKind, zonkAnyTyCon,
+ anyTyCon, anyTy, anyTypeOfKind, unusedTypeTyCon,
-- * Recovery TyCon
makeRecoveryTyCon,
@@ -300,7 +300,7 @@ wiredInTyCons :: [TyCon]
wiredInTyCons = map (dataConTyCon . snd) boxingDataCons
++ [ anyTyCon
- , zonkAnyTyCon
+ , unusedTypeTyCon
, boolTyCon
, charTyCon
, stringTyCon
@@ -410,58 +410,89 @@ doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#")
-- Any
{-
-Note [Any types]
-~~~~~~~~~~~~~~~~
-The type constructors `Any` and `ZonkAny` are closed type families declared thus:
+Note [The types Any and UnusedType]
+~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~
+The type constructors `Any` and `UnusedType` are closed type families declared as:
- type family Any :: forall k. k where { }
- type family ZonkAny :: forall k. Nat -> k where { }
+ type family Any :: forall k. k where { }
+ type family UnusedType :: forall k. Symbol -> k where { }
They are used when we want a type of a particular kind, but we don't really care
-what that type is. The leading example is this: `ZonkAny` is used to instantiate
-un-constrained type variables after type checking. For example, consider the
-term (length [] :: Int), where
+what that type is. The leading example that is relevant for GHC itself is this:
- length :: forall a. [a] -> Int
- [] :: forall a. [a]
+ `UnusedType` is used to instantiate unconstrained type variables after type
+ checking. For example, consider the term (length [] :: Int), where
-We must type-apply `length` and `[]`, but to what type? It doesn't matter!
-The typechecker will end up with
+ length :: forall a. [a] -> Int
+ [] :: forall a. [a]
- length @alpha ([] @alpha)
+ We must type-apply `length` and `[]`, but to what type? It doesn't matter!
+ The typechecker will end up with
-where `alpha` is an un-constrained unification variable. The "zonking" process zaps
-that unconstrained `alpha` to an arbitrary type (ZonkAny @Type 3), where the `3` is
-arbitrary (see wrinkle (Any5) below). This is done in `GHC.Tc.Zonk.Type.commitFlexi`.
-So we end up with
+ length @alpha ([] @alpha)
- length @(ZonkAny @Type 3) ([] @(ZonkAny @Type 3))
+ where `alpha` is an unconstrained unification variable. The "zonking" process
+ zaps that unconstrained `alpha` to an arbitrary type (UnusedType @Type "a_3"),
+ where the `3` is arbitrary (see wrinkle (Any3) below) and "a" is the name string
+ of the meta variable. This is done in `GHC.Tc.Zonk.Type.commitFlexi`.
+ So we end up with
-`Any` and `ZonkAny` differ only in the presence of the `Nat` argument; see
-wrinkle (Any4).
+ length @(UnusedType @Type "a_3") ([] @(UnusedType @Type "a_3"))
-Wrinkles:
+`Any` and `UnusedType` differ only in the presence of the `Symbol` argument; see (Any6).
-(Any1) `Any` and `ZonkAny` are kind polymorphic since in some program we may
- need to use `ZonkAny` to fill in a type variable of some kind other than *
- (see #959 for examples).
-
-(Any2) They are /closed/ type families, with no instances. For example, suppose that
+(Any1) They are /closed/ type families, with no instances. For example, suppose that
with alpha :: '(k1, k2) we add a given coercion
g :: alpha ~ (Fst alpha, Snd alpha)
- and we zonked alpha = ZonkAny @(k1,k2) n. Then, if `ZonkAny` was a /data/ type,
- we'd get inconsistency because we'd have a Given equality with `ZonkAny` on one
+ and we zonked alpha = UnusedType @(k1,k2) n. Then, if `UnusedType` was a /data/ type,
+ we'd get inconsistency because we'd have a Given equality with `UnusedType` on one
side and '(,) on the other. See also #9097 and #9636.
- See #25244 for a suggestion that we instead use an /open/ type family for which
- you cannot provide instances. Probably the difference is not very important.
+ They are not /data/ types, and that's important for the code generator,
+ because the code gen may enter a data value.
+
+ A closed type family with no equations behaves differently than an open type
+ family with no equations due to Note [Insoluble fundeps] IFD0 in
+ GHC.Tc.Solver.FunDeps, so it was argued in #25244 that perhaps 'Any' should
+ rather be an open type family for which new equations cannot be written.
+
+(Any2) `Any` and `UnusedType` are kind polymorphic since in some programs we may
+ need to use `UnusedType` to fill in a type variable of some kind other than Type
+ e.g. TYPE r for some r, or types of the form _ -> Type.
+
+(Any3) `Any` and `UnusedType` are wired-in so we can easily refer to them where we
+ don't have a name environment.
+
+(Any4) User facing aspects of the types Any and UnusedType:
+
+ `Any` is defined in ghc-internal:GHC.Internal.Types, and exported. `Any`
+ is available to users because it is a useful type in userspace and is thus
+ re-exported from base:GHC.Exts.
+
+ `UnusedType` is exported mainly for documentation in case a user stumbles over
+ it in debug output of GHC.
+
+ The key property of 'Any' is that it is safe to coerce a type to 'Any' as long
+ as the representation is unchanged. That is, it is OK to use 'unsafeCoerce#' to
+ go from 'ty :: TYPE r' to 'Any :: TYPE r' and back.
+ This can be useful when e.g. implementing dependent maps or similar typed
+ container types, storing values of type `Any`.
+
+(Any5) Warnings about unused bindings of type `Any` and `UnusedType` are suppressed,
+ following the same rationale of supressing warning about the unit type.
+
+ For example, consider (#25895):
+
+ do { forever (return ()); blah }
-(Any3) They do not claim to be /data/ types, and that's important for
- the code generator, because the code gen may /enter/ a data value
- but never enters a function value.
+ where forever :: forall a b. IO a -> IO b
+ Nothing constrains `b`, so it will be instantiated with `Any` or `UnusedType`.
+ But we certainly don't want to complain about a discarded do-binding.
-(Any4) `ZonkAny` takes a `Nat` argument so that we can readily make up /distinct/
- types (#24817). Consider
+(Any6) Wrinkle - Pattern match checking.
+
+ The first reason why `UnusedType` takes a `Symbol` argument is that
+ we can readily make up /distinct/ types (#24817) for the Pmc. Consider
data SBool a where { STrue :: SBool True; SFalse :: SBool False }
@@ -475,53 +506,33 @@ Wrinkles:
Now, what are `alpha` and `beta`? If we zonk both of them to the same type
`Any @Type`, the pattern-match checker will (wrongly) report that the first
branch is inaccessible. So we zonk them to two /different/ types:
- alpha := ZonkAny @Type 4 and beta := ZonkAny @Type k 5
+ alpha := UnusedType @Type "a_4" and beta := UnusedType @Type k "b_5"
(The actual numbers are arbitrary; they just need to differ.)
The unique-name generation comes from field `tcg_zany_n` of `TcGblEnv`; and
- `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newZonkAnyType` to
+ `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newUnusedTypeType` to
make up a fresh type.
If this example seems unconvincing (e.g. in this case foo must be bottom)
see #24817 for larger but more compelling examples.
-(Any5) `Any` and `ZonkAny` are wired-in so we can easily refer to it where we
- don't have a name environment (e.g. see Rules.matchRule for one example)
-
-(Any6) `Any` is defined in library module ghc-prim:GHC.Types, and exported so that
- it is available to users. For this reason it's treated like any other
- wired-in type:
- - has a fixed unique, anyTyConKey,
- - lives in the global name cache
- Currently `ZonkAny` is not available to users; but it could easily be.
+(Any7) Wrinkle - Error reporting.
-(Any7) Properties of `Any`:
- * When `Any` is instantiated at a lifted type it is inhabited by at least one value,
- namely bottom.
+ There's a second reason why `UnusedType` takes a `Symbol` argument, which is that
+ we use it to neatly display zonked unfilled metavariables without leaking
+ implementation details of code generation.
- * You can safely coerce any /lifted/ type to `Any` and back with `unsafeCoerce`.
+ `UnusedType` is handled specially in the pretty-printer to avoid confusing
+ compiler output. For example, `UnusedType "foo_3" :: Type` is displayed as `foo_3`.
- * You can safely coerce any /unlifted/ type to `Any` and back with `unsafeCoerceUnlifted`.
+ That special handling is implemented in GHC.Iface.Type.pprTyTcApp and more
+ specifically ppr_iface_unused_ty_tycon.
- * You can coerce /any/ type to `Any` and back with `unsafeCoerce#`, but it's only safe when
- the kinds of both the type and `Any` match.
+ See testcase T27390 for an example of the pretty-printing in action.
- * For lifted/unlifted types `unsafeCoerce[Unlifted]` should be preferred over
- `unsafeCoerce#` as they prevent accidentally coercing between types with kinds
- that don't match.
-
- See examples in ghc-prim:GHC.Types
-
-(Any8) Warning about unused bindings of type `Any` and `ZonkAny` are suppressed,
- following the same rationale of supressing warning about the unit type.
-
- For example, consider (#25895):
-
- do { forever (return ()); blah }
-
- where forever :: forall a b. IO a -> IO b
- Nothing constrains `b`, so it will be instantiates with `Any` or `ZonkAny`.
- But we certainly don't want to complain about a discarded do-binding.
+ Historical note: in the past, `UnusedType` was called `ZonkAny` (or `Any` before that).
+ We renamed it to `UnusedType` and added this special treatment in the pretty-printer to avoid
+ confusing mentions of zonking.
The Any tycon used to be quite magic, but we have since been able to
implement it merely with an empty kind polymorphic type family. See #10886 for a
@@ -534,7 +545,7 @@ anyTyConName =
mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Any") anyTyConKey anyTyCon
anyTyCon :: TyCon
--- See Note [Any types]
+-- See Note [The types Any and UnusedType]
anyTyCon = mkFamilyTyCon anyTyConName kind binders 0 res_kind Nothing
(ClosedSynFamilyTyCon Nothing)
Nothing
@@ -550,22 +561,22 @@ anyTy = mkTyConTy anyTyCon
anyTypeOfKind :: Kind -> Type
anyTypeOfKind kind = mkTyConApp anyTyCon [kind]
-zonkAnyTyConName :: Name
-zonkAnyTyConName =
- mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "ZonkAny") zonkAnyTyConKey zonkAnyTyCon
+unusedTypeTyConName :: Name
+unusedTypeTyConName =
+ mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "UnusedType") unusedTypeTyConKey unusedTypeTyCon
-zonkAnyTyCon :: TyCon
--- ZonkAnyTyCon :: forall k. Nat -> k
--- See Note [Any types]
-zonkAnyTyCon = mkFamilyTyCon zonkAnyTyConName kind bndrs 0 res_kind
+unusedTypeTyCon :: TyCon
+-- unusedTypeTyCon :: forall k. Symbol -> k
+-- See Note [The types Any and UnusedType]
+unusedTypeTyCon = mkFamilyTyCon unusedTypeTyConName kind bndrs 0 res_kind
Nothing
(ClosedSynFamilyTyCon Nothing)
Nothing
NotInjective
where
- [kv,nat_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy]
+ [kv,sym_kv] = mkTemplateKindVars [liftedTypeKind, typeSymbolKind]
bndrs = [ mkNamedTyConBinder Specified kv
- , mkAnonTyConBinder nat_kv ]
+ , mkAnonTyConBinder sym_kv ]
res_kind = mkTyVarTy kv
kind = mkTyConKind bndrs res_kind
=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -1281,11 +1281,11 @@ warnDiscardedDoBindings rhs@(L rhs_loc _) m_ty elt_ty
do { fam_inst_envs <- dsGetFamInstEnvs
; let norm_elt_ty = topNormaliseType fam_inst_envs elt_ty
supressible_ty =
- isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isZonkAnyTy norm_elt_ty
+ isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isUnusedTypeTy norm_elt_ty
-- Warn about discarding things in 'monadic' binding,
-- however few types are excluded:
-- * Unit type `()`
- -- * `ZonkAny` or `Any` type see (Any8) of Note [Any types]
+ -- * `UnusedType` or `Any` type see (Any5) of Note [The types Any and UnusedType]
; if warn_unused && not supressible_ty
then diagnosticDs (DsUnusedDoBind rhs elt_ty)
else
=====================================
compiler/GHC/Iface/Type.hs
=====================================
@@ -7,7 +7,7 @@ This module defines interface types and binders
-}
-{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE MultiWayIf, OverloadedRecordDot #-}
module GHC.Iface.Type (
IfExtName,
IfLclName(..), mkIfLclName, ifLclNameFS,
@@ -1740,6 +1740,7 @@ pprTyTcApp ctxt_prec tc tys =
sdocOption sdocPrintExplicitKinds $ \print_kinds ->
sdocOption sdocPrintTypeAbbreviations $ \print_type_abbreviations ->
getPprDebug $ \debug ->
+ getPprStyle $ \style ->
if | ifaceTyConName tc `hasKey` ipClassKey
, IA_Arg (IfaceLitTy (IfaceStrTyLit n))
@@ -1791,6 +1792,14 @@ pprTyTcApp ctxt_prec tc tys =
| Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys)
-> doc
+ -- See Note [The types Any and UnusedType], specifically (Any6) and (Any7)
+ | ifaceTyConName tc `hasKey` unusedTypeTyConKey
+ , ((arg_k, _) : (IfaceLitTy (IfaceStrTyLit arg_nm), _) : args_usr)
+ <- appArgsIfaceTypesForAllTyFlags tys
+ -- if arg_k is a kind with more than 0 arguments, then _ might not be [] here
+ , userStyle style
+ -> ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_nm args_usr
+
| otherwise
-> ppr_iface_tc_app ppr_app_arg ctxt_prec tc $
appArgsIfaceTypesForAllTyFlags $ stripInvisArgs (PrintExplicitKinds print_kinds) tys
@@ -1802,6 +1811,23 @@ ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case
False -> pprPrefixOcc liftedTypeKindTyConName
True -> maybeParen ctxt_prec starPrec starLit
+-- | user-style printer that pretty-prints an 'UnusedType @k "foo_3" to foo_3.
+-- If -fprint-explicit-kinds or -fprint-explicit-runtime-reps are set, instead
+-- prints them to (foo3 :: k).
+-- See Note [The types Any and UnusedType], specifically (Any6) and (Any7) for why this is useful.
+ppr_iface_unused_ty_tycon :: PprPrec -> IfaceType -> LexicalFastString -> [(IfaceType, ForAllTyFlag)] -> SDoc
+ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_nm args_usr
+ = sdocOption sdocPrintExplicitKinds $ \print_kinds ->
+ sdocOption sdocPrintExplicitRuntimeReps $ \print_reps ->
+ if print_kinds || print_reps
+ then prettyMeta $ \nm ->
+ maybeParen sig_prec sigPrec $ nm <+> text "::" <+> pprIfaceType arg_k
+ else prettyMeta id
+ where sig_prec = if null args_usr then ctxt_prec else appPrec
+ prettyMeta add_ty
+ = pprIfacePrefixApp ctxt_prec (add_ty $ ppr arg_nm)
+ $ map (ppr_app_arg appPrec) args_usr
+
-- | Pretty-print a type-level equality.
-- Returns (Just doc) if the argument is a /saturated/ application
-- of eqTyCon (~)
@@ -2190,7 +2216,8 @@ instance Binary IfaceTyConSort where
0 -> return IfaceNormalTyCon
1 -> IfaceTupleTyCon <$> get bh <*> get bh
2 -> IfaceSumTyCon <$> get bh
- _ -> return IfaceEqualityTyCon
+ 3 -> return IfaceEqualityTyCon
+ _ -> panic "get IfaceTyConSort"
instance Binary IfaceTyConInfo where
put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s
=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -582,8 +582,8 @@ data TcGblEnv
-- ^ Allows us to choose unique DFun names.
tcg_zany_n :: TcRef Integer,
- -- ^ A source of unique identities for ZonkAny instances
- -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4)
+ -- ^ A source of unique identities for UnusedType instances
+ -- See Note [The types Any and UnusedType] in GHC.Builtin.Types, wrinkle (Any6)
tcg_merged :: [(Module, Fingerprint)],
-- ^ The requirements we merged with; we always have to recompile
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -154,7 +154,7 @@ module GHC.Tc.Utils.Monad(
getCCIndexM, getCCIndexTcM,
-- * Zonking
- liftZonkM, newZonkAnyType,
+ liftZonkM, newUnusedType,
-- * Complete matches
localAndImportedCompleteMatches, getCompleteMatchesTcM,
@@ -168,7 +168,7 @@ import GHC.Prelude
import GHC.Builtin.Names
-import GHC.Builtin.Types( zonkAnyTyCon )
+import GHC.Builtin.Types( unusedTypeTyCon )
import GHC.Tc.Errors.Types
import GHC.Tc.Errors.Hole.Plugin ( HoleFitPlugin, HoleFitPluginR (..) )
@@ -197,7 +197,7 @@ import GHC.Core.Coercion ( isReflCo )
import GHC.Core.Multiplicity
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
-import GHC.Core.Type( mkNumLitTy )
+import GHC.Core.Type( mkStrLitTy )
import GHC.Core.TyCo.Rep( CoercionHole(..) )
import GHC.Core.TyCo.FVs( coVarsOfCo )
import GHC.Core.TyCon ( TyCon )
@@ -2258,17 +2258,24 @@ chooseUniqueOccTc fn =
; writeTcRef dfun_n_var (extendOccSet set occ)
; return occ }
-newZonkAnyType :: Kind -> TcM Type
--- Return a type (ZonkAny @k n), where n is fresh
--- Recall ZonkAny :: forall k. Natural -> k
--- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4)
-newZonkAnyType kind
+newUnusedType :: Name -> Kind -> TcM Type
+-- Return a type (UnusedType @k sym_n), where sym
+-- is a name and n is a fresh Integer.
+-- Recall UnusedType :: forall k. Symbol -> k
+-- See Note [The types Any and UnusedType] in GHC.Builtin.Types, wrinkle (Any6)
+newUnusedType name kind
= do { env <- getGblEnv
; let zany_n_var = tcg_zany_n env
; i <- readTcRef zany_n_var
; let !i2 = i+1
; writeTcRef zany_n_var i2
- ; return (mkTyConApp zonkAnyTyCon [kind, mkNumLitTy i]) }
+ -- Mind that the "_" here is load-bearing:
+ -- name foo1 with zany_n_var = 1 musn't be equal to
+ -- name foo with zany_n_var = 11 b/c that way the Pmc
+ -- would consider them equal. Using "_" suffices because
+ -- numbers never start with _ and so (legal) identfiers like
+ -- foo_ would become foo__1 which is distinct from e.g. foo_1
+ ; return (mkTyConApp unusedTypeTyCon [kind, mkStrLitTy $ getOccFS name `appendFS` fsLit "_" `appendFS` fsLit (show i) ]) }
getConstraintVar :: TcM (TcRef WantedConstraints)
getConstraintVar = do { env <- getLclEnv; return (tcl_lie env) }
=====================================
compiler/GHC/Tc/Utils/TcType.hs
=====================================
@@ -85,7 +85,7 @@ module GHC.Tc.Utils.TcType (
isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy,
isFloatingPrimTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy,
isIntegerTy, isNaturalTy,
- isBoolTy, isUnitTy, isAnyTy, isZonkAnyTy, isCharTy,
+ isBoolTy, isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy,
isTauTy, isTauTyCon, tcIsTyVarTy,
isPredTy, isSimplePredTy, isTyVarClassPred,
checkValidClsArgs, hasTyVarHead,
@@ -2057,7 +2057,7 @@ isFloatTy, isDoubleTy,
isFloatPrimTy, isDoublePrimTy,
isIntegerTy, isNaturalTy,
isIntTy, isWordTy, isBoolTy,
- isUnitTy, isAnyTy, isZonkAnyTy, isCharTy :: Type -> Bool
+ isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy :: Type -> Bool
isFloatTy = is_tc floatTyConKey
isDoubleTy = is_tc doubleTyConKey
isFloatPrimTy = is_tc floatPrimTyConKey
@@ -2069,7 +2069,7 @@ isWordTy = is_tc wordTyConKey
isBoolTy = is_tc boolTyConKey
isUnitTy = is_tc unitTyConKey
isAnyTy = is_tc anyTyConKey
-isZonkAnyTy = is_tc zonkAnyTyConKey
+isUnusedTypeTy = is_tc unusedTypeTyConKey
isCharTy = is_tc charTyConKey
-- | Check whether the type is of the form @Any :: k@,
=====================================
compiler/GHC/Tc/Zonk/Type.hs
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedRecordDot #-}
{-
(c) The University of Glasgow 2006
(c) The AQUA Project, Glasgow University, 1996-1998
@@ -43,7 +44,7 @@ import GHC.Tc.Types.TcRef
import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo )
import GHC.Tc.Utils.Env ( tcLookupGlobalOnly )
import GHC.Tc.Utils.TcType
-import GHC.Tc.Utils.Monad ( newZonkAnyType, setSrcSpanA, liftZonkM, traceTc, addErr )
+import GHC.Tc.Utils.Monad ( newUnusedType, setSrcSpanA, liftZonkM, traceTc, addErr )
import GHC.Tc.Types.Evidence
import GHC.Tc.Errors.Types
import GHC.Tc.Zonk.Env
@@ -470,11 +471,11 @@ commitFlexi DefaultFlexi tv zonked_kind
; return manyDataConTy }
| Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv
= do { addErr $ TcRnZonkerMessage (ZonkerCannotDefaultConcrete origin)
- ; newZonkAnyType zonked_kind }
+ ; newUnusedType tv.varName zonked_kind }
| otherwise
- = do { traceTc "Defaulting flexi tyvar to ZonkAny:" (pprTyVar tv)
- -- See Note [Any types] in GHC.Builtin.Types, esp wrinkle (Any4)
- ; newZonkAnyType zonked_kind }
+ = do { traceTc "Defaulting flexi tyvar to UnusedType:" (pprTyVar tv)
+ -- See Note [The types Any and UnusedType] in GHC.Builtin.Types, esp wrinkle (Any6)
+ ; newUnusedType tv.varName zonked_kind }
zonkCoVarOcc :: CoVar -> ZonkTcM Coercion
zonkCoVarOcc cv
=====================================
libraries/ghc-internal/src/GHC/Internal/Types.hs
=====================================
@@ -35,6 +35,7 @@ module GHC.Internal.Types (
SPEC(..),
Symbol,
Any,
+ UnusedType,
-- * Type equality
type (~), type (~~), Coercible,
@@ -284,48 +285,53 @@ data Symbol
* *
********************************************************************* -}
--- | The type constructor @Any :: forall k. k@ is a type to which you can unsafely coerce any type, and back.
+-- | The type constructor @Any :: forall k. k@ allows creating an arbitrary type
+-- of the given kind.
--
--- For @unsafeCoerce@ this means for all lifted types @t@ that
--- @unsafeCoerce (unsafeCoerce x :: Any) :: t@ is equivalent to @x@ and safe.
+-- It can be used to create a placeholder type when you only have a kind in hand.
--
--- The same is true for *all* types when using
--- @
--- unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
--- (a :: TYPE r1) (b :: TYPE r2).
--- a -> b
--- @
--- but /only/ if you instantiate @r1@ and @r2@ to the /same/ runtime representation.
--- For example using @(unsafeCoerce# :: forall (a :: TYPE IntRep) (b :: TYPE IntRep). a -> b) x@
--- is fine, but @(unsafeCoerce# :: forall (a :: TYPE IntRep) (b :: TYPE FloatRep). a -> b)@
--- will likely cause seg-faults or worse.
--- For this resason, users should always prefer unsafeCoerce over unsafeCoerce# when possible.
+-- You can use 'unsafeCoerce#' to unsafely coerce a value from @ty :: k@ to @Any \@k@
+-- and back. As per the documentation of 'unsafeCoerce#', this is only sound if both
+-- sides have the __exact same__runtime representation. Some examples:
--
--- Here are some more examples:
-- @
--- bad_a1 :: Any @(TYPE 'IntRep)
--- bad_a1 = unsafeCoerce# True
---
--- bad_a2 :: Any @(TYPE ('BoxedRep 'UnliftedRep))
--- bad_a2 = unsafeCoerce# True
+-- unsafeCoerce# True :: (Any :: Type) -- OK
+-- unsafeCoerce# (1# :: Int#) :: (Any :: TYPE IntRep) -- OK
+-- unsafeCoerce# True :: (Any :: Type IntRep) -- INVALID
+-- unsafeCoerce True :: (Any :: UnliftedType) -- INVALID
+-- unsafeCoerce (ba :: ByteArray#) :: (Any :: Type) -- INVALID
-- @
--- Here @bad_a1@ is bad because we started with @True :: (Bool :: Type)@, represented by a boxed heap pointer,
--- and coerced it to @a1 :: Any @(TYPE 'IntRep)@, whose representation is a non-pointer integer.
--- That's why we had to use `unsafeCoerce#`; it is really unsafe because it can change representations.
--- Similarly @bad_a2@ is bad because although both @True@ and @bad_a2@ are represented by a heap pointer,
--- @True@ is lifted but @bad_a2@ is not; bugs here may be rather subtle.
--
--- If you must use unsafeCoerce# to cast to `Any`, type annotations are recommended
--- to make sure that @Any@ has the correct kind. As casting between different runtimereps is
--- unsound. For example to cast a @ByteArray#@ to @Any@ you might use:
--- @
--- unsafeCoerce# b :: (Any :: TYPE ('BoxedRep 'Unlifted))
--- @
+-- To avoid accidentally unsafe-coercing between different representations,
+-- it is recommended to:
+-- - use explicit type annotations or type applications at every use-site
+-- of 'unsafeCoerce#'
+-- - use representation-monomorphic variants such as 'unsafeCoerce' or
+-- 'unsafeCoerceUnlifted'.
+--
+-- In particular, this also implies it is safe to round-trip unsafe-coercion via 'Any',
+-- as long as the kinds line up e.g. @unsafeCoerce (unsafeCoerce (val :: a) :: 'Any') :: a@
+-- is safe in that way.
type family Any :: k where { }
--- See Note [Any types] in GHC.Builtin.Types. Also, for a bit of history on Any see
+-- See Note [The types Any and UnusedType] in GHC.Builtin.Types. Also, for a bit of history on Any see
-- #10886. Note that this must be a *closed* type family: we need to ensure
-- that this can't reduce to a `data` type for the results discussed in
--- Note [Any types].
+-- Note [The types Any and UnusedType].
+--
+
+-- | @UnusedType \@k "foo"@ denotes an arbitrary type of kind
+-- @k@ and is pretty-printed as @foo@ .
+--
+-- This type is used internally by GHC to fill in otherwise
+-- unconstrained type variables, such as @a@ in @length \@a []@.
+-- It is exported purely for documentation purposes.
+--
+-- You shouldn't ever see this type in the compiler's output if
+-- you don't specifically ask for it, for instance when viewing
+-- core, since the compiler will try hard to output a given
+-- @'UnusedType' "m_0"@ simply as @m_0@.
+type family UnusedType :: Symbol -> k where { }
+-- See Note [The types Any and UnusedType] in GHC.Builtin.Types.
{- *********************************************************************
* *
=====================================
testsuite/tests/perf/compiler/T11068.stdout
=====================================
@@ -23,137 +23,137 @@
`cast` (GHC.Internal.Generics.N:M1
`cast` (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.R1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.R1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.R1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.R1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.L1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
- ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0))
+ ((GHC.Internal.Generics.U1
`cast` (Sym (GHC.Internal.Generics.N:M1
= GHC.Internal.Generics.R1
= GHC.Internal.Generics.R1
=====================================
testsuite/tests/pmcheck/should_compile/T12957.stderr
=====================================
@@ -1,7 +1,6 @@
T12957.hs:4:5: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
- In a case alternative:
- Patterns of type ‘[GHC.Internal.Types.ZonkAny 0]’ not matched: []
+ In a case alternative: Patterns of type ‘[a_0]’ not matched: []
T12957.hs:4:16: warning: [GHC-53633] [-Woverlapping-patterns (in -Wdefault)]
Pattern match is redundant
=====================================
testsuite/tests/profiling/should_run/staticcallstack002.stdout
=====================================
@@ -1,4 +1,4 @@
-Just (InfoProv {ipName = "sat_s1Rh_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 0", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"})
-Just (InfoProv {ipName = "sat_s1RB_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 1", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"})
-Just (InfoProv {ipName = "sat_s1RV_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 2", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"})
-Just (InfoProv {ipName = "sat_s1Sf_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 3", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"})
+Just (InfoProv {ipName = "main_sat_t2fs_info", ipDesc = THUNK, ipTyDesc = "UnusedType \"a_0\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"})
+Just (InfoProv {ipName = "main_sat_t2fJ_info", ipDesc = THUNK, ipTyDesc = "UnusedType \"a_1\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"})
+Just (InfoProv {ipName = "main_sat_t2g0_info", ipDesc = THUNK, ipTyDesc = "UnusedType \"a_2\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"})
+Just (InfoProv {ipName = "main_sat_t2gh_info", ipDesc = THUNK, ipTyDesc = "UnusedType \"a_3\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"})
=====================================
testsuite/tests/simplCore/should_compile/Makefile
=====================================
@@ -188,7 +188,7 @@ T13155:
T13156:
$(RM) -f T13156.hi T13156.o
- '$(TEST_HC)' $(TEST_HC_OPTS) -c T13156.hs -O -ddump-prep -dsuppress-uniques | grep "case.*Any"
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c T13156.hs -O -ddump-prep -dsuppress-uniques | grep "case.*UnusedType"
# There should be a single 'case r @ GHC.Types.Any'
.PHONY: T4138
=====================================
testsuite/tests/simplCore/should_compile/T13156.stdout
=====================================
@@ -1,2 +1,2 @@
- case r @(GHC.Internal.Types.ZonkAny 0) of { __DEFAULT ->
- case r @(GHC.Internal.Types.ZonkAny 1) of { __DEFAULT -> r @a }
+ case r @(GHC.Internal.Types.UnusedType "a_0") of { __DEFAULT ->
+ case r @(GHC.Internal.Types.UnusedType "a_1") of { __DEFAULT ->
=====================================
testsuite/tests/simplCore/should_compile/T26615.stderr
=====================================
@@ -2,7 +2,7 @@
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 1,209, types: 1,139, coercions: 18, joins: 17/29}
+ = {terms: 1,209, types: 1,155, coercions: 18, joins: 17/29}
-- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0}
unArray :: forall a. Array a -> SmallArray# a
@@ -15,45 +15,29 @@ unArray :: forall a. Array a -> SmallArray# a
unArray = \ (@a) (ds :: Array a) -> case ds of { Array ds1 -> ds1 }
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T26615a.$trModule4 :: Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 20 0}]
-T26615a.$trModule4 = "main"#
+$trModule1 :: Addr#
+[GblId, Unf=OtherCon []]
+$trModule1 = "main"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T26615a.$trModule3 :: GHC.Internal.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615a.$trModule3 = GHC.Internal.Types.TrNameS T26615a.$trModule4
+$trModule2 :: GHC.Internal.Types.TrName
+[GblId, Unf=OtherCon []]
+$trModule2 = GHC.Internal.Types.TrNameS $trModule1
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T26615a.$trModule2 :: Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 30 0}]
-T26615a.$trModule2 = "T26615a"#
+$trModule3 :: Addr#
+[GblId, Unf=OtherCon []]
+$trModule3 = "T26615a"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T26615a.$trModule1 :: GHC.Internal.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615a.$trModule1 = GHC.Internal.Types.TrNameS T26615a.$trModule2
+$trModule4 :: GHC.Internal.Types.TrName
+[GblId, Unf=OtherCon []]
+$trModule4 = GHC.Internal.Types.TrNameS $trModule3
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-T26615a.$trModule :: GHC.Internal.Types.Module
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615a.$trModule
- = GHC.Internal.Types.Module T26615a.$trModule3 T26615a.$trModule1
+T26615a.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module
+[GblId, Unf=OtherCon []]
+T26615a.$trModule = GHC.Internal.Types.Module $trModule2 $trModule4
-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
$krep :: GHC.Internal.Types.KindRep
@@ -104,33 +88,24 @@ $krep6
GHC.Internal.Types.$tcSmallArray# $krep5
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tcLeaf2 :: Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 20 0}]
-T26615a.$tcLeaf2 = "Leaf"#
+$tcLeaf1 :: Addr#
+[GblId, Unf=OtherCon []]
+$tcLeaf1 = "Leaf"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tcLeaf1 :: GHC.Internal.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615a.$tcLeaf1 = GHC.Internal.Types.TrNameS T26615a.$tcLeaf2
+$tcLeaf2 :: GHC.Internal.Types.TrName
+[GblId, Unf=OtherCon []]
+$tcLeaf2 = GHC.Internal.Types.TrNameS $tcLeaf1
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tcLeaf :: GHC.Internal.Types.TyCon
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
+T26615a.$tcLeaf [InlPrag=[~]] :: GHC.Internal.Types.TyCon
+[GblId, Unf=OtherCon []]
T26615a.$tcLeaf
= GHC.Internal.Types.TyCon
13798714324392902582#Word64
3237499036029031497#Word64
T26615a.$trModule
- T26615a.$tcLeaf1
+ $tcLeaf2
0#
GHC.Internal.Types.krep$*->*->*
@@ -160,372 +135,284 @@ $krep10 :: GHC.Internal.Types.KindRep
$krep10 = GHC.Internal.Types.KindRepFun $krep2 $krep9
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'L1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep
+$krep11 :: GHC.Internal.Types.KindRep
[GblId, Unf=OtherCon []]
-T26615a.$tc'L1 = GHC.Internal.Types.KindRepFun $krep3 $krep10
+$krep11 = GHC.Internal.Types.KindRepFun $krep3 $krep10
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'L3 :: Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 20 0}]
-T26615a.$tc'L3 = "'L"#
+$tc'L1 :: Addr#
+[GblId, Unf=OtherCon []]
+$tc'L1 = "'L"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'L2 :: GHC.Internal.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615a.$tc'L2 = GHC.Internal.Types.TrNameS T26615a.$tc'L3
+$tc'L2 :: GHC.Internal.Types.TrName
+[GblId, Unf=OtherCon []]
+$tc'L2 = GHC.Internal.Types.TrNameS $tc'L1
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'L :: GHC.Internal.Types.TyCon
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'L [InlPrag=[~]] :: GHC.Internal.Types.TyCon
+[GblId, Unf=OtherCon []]
T26615a.$tc'L
= GHC.Internal.Types.TyCon
8570419491837374712#Word64
2090006989092642392#Word64
T26615a.$trModule
- T26615a.$tc'L2
+ $tc'L2
2#
- T26615a.$tc'L1
+ $krep11
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tcArray2 :: Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 30 0}]
-T26615a.$tcArray2 = "Array"#
+$tcArray1 :: Addr#
+[GblId, Unf=OtherCon []]
+$tcArray1 = "Array"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tcArray1 :: GHC.Internal.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615a.$tcArray1 = GHC.Internal.Types.TrNameS T26615a.$tcArray2
+$tcArray2 :: GHC.Internal.Types.TrName
+[GblId, Unf=OtherCon []]
+$tcArray2 = GHC.Internal.Types.TrNameS $tcArray1
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tcArray :: GHC.Internal.Types.TyCon
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
+T26615a.$tcArray [InlPrag=[~]] :: GHC.Internal.Types.TyCon
+[GblId, Unf=OtherCon []]
T26615a.$tcArray
= GHC.Internal.Types.TyCon
10495761415291712389#Word64
7580086293698619153#Word64
T26615a.$trModule
- T26615a.$tcArray1
+ $tcArray2
0#
GHC.Internal.Types.krep$*Arr*
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-$krep11 :: GHC.Internal.Types.KindRep
+$krep12 :: GHC.Internal.Types.KindRep
[GblId, Unf=OtherCon []]
-$krep11
+$krep12
= GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep4
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Array1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep
+$krep13 :: GHC.Internal.Types.KindRep
[GblId, Unf=OtherCon []]
-T26615a.$tc'Array1 = GHC.Internal.Types.KindRepFun $krep6 $krep11
+$krep13 = GHC.Internal.Types.KindRepFun $krep6 $krep12
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Array3 :: Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 30 0}]
-T26615a.$tc'Array3 = "'Array"#
+$tc'Array1 :: Addr#
+[GblId, Unf=OtherCon []]
+$tc'Array1 = "'Array"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Array2 :: GHC.Internal.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615a.$tc'Array2 = GHC.Internal.Types.TrNameS T26615a.$tc'Array3
+$tc'Array2 :: GHC.Internal.Types.TrName
+[GblId, Unf=OtherCon []]
+$tc'Array2 = GHC.Internal.Types.TrNameS $tc'Array1
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Array :: GHC.Internal.Types.TyCon
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'Array [InlPrag=[~]] :: GHC.Internal.Types.TyCon
+[GblId, Unf=OtherCon []]
T26615a.$tc'Array
= GHC.Internal.Types.TyCon
12424115309881832159#Word64
15542868641947707803#Word64
T26615a.$trModule
- T26615a.$tc'Array2
+ $tc'Array2
1#
- T26615a.$tc'Array1
+ $krep13
-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
-$krep12 :: [GHC.Internal.Types.KindRep]
+$krep14 :: [GHC.Internal.Types.KindRep]
[GblId, Unf=OtherCon []]
-$krep12
+$krep14
= GHC.Internal.Types.:
@GHC.Internal.Types.KindRep
$krep9
(GHC.Internal.Types.[] @GHC.Internal.Types.KindRep)
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-$krep13 :: GHC.Internal.Types.KindRep
+$krep15 :: GHC.Internal.Types.KindRep
[GblId, Unf=OtherCon []]
-$krep13
- = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep12
+$krep15
+ = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep14
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tcHashMap2 :: Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 30 0}]
-T26615a.$tcHashMap2 = "HashMap"#
+$tcHashMap1 :: Addr#
+[GblId, Unf=OtherCon []]
+$tcHashMap1 = "HashMap"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tcHashMap1 :: GHC.Internal.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615a.$tcHashMap1
- = GHC.Internal.Types.TrNameS T26615a.$tcHashMap2
+$tcHashMap2 :: GHC.Internal.Types.TrName
+[GblId, Unf=OtherCon []]
+$tcHashMap2 = GHC.Internal.Types.TrNameS $tcHashMap1
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tcHashMap :: GHC.Internal.Types.TyCon
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
+T26615a.$tcHashMap [InlPrag=[~]] :: GHC.Internal.Types.TyCon
+[GblId, Unf=OtherCon []]
T26615a.$tcHashMap
= GHC.Internal.Types.TyCon
2021755758654901686#Word64
8209241086311595496#Word64
T26615a.$trModule
- T26615a.$tcHashMap1
+ $tcHashMap2
0#
GHC.Internal.Types.krep$*->*->*
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Empty1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep
+$krep16 :: GHC.Internal.Types.KindRep
[GblId, Unf=OtherCon []]
-T26615a.$tc'Empty1
+$krep16
= GHC.Internal.Types.KindRepTyConApp T26615a.$tcHashMap $krep8
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Empty3 :: Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 30 0}]
-T26615a.$tc'Empty3 = "'Empty"#
+$tc'Empty1 :: Addr#
+[GblId, Unf=OtherCon []]
+$tc'Empty1 = "'Empty"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Empty2 :: GHC.Internal.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615a.$tc'Empty2 = GHC.Internal.Types.TrNameS T26615a.$tc'Empty3
+$tc'Empty2 :: GHC.Internal.Types.TrName
+[GblId, Unf=OtherCon []]
+$tc'Empty2 = GHC.Internal.Types.TrNameS $tc'Empty1
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Empty :: GHC.Internal.Types.TyCon
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'Empty [InlPrag=[~]] :: GHC.Internal.Types.TyCon
+[GblId, Unf=OtherCon []]
T26615a.$tc'Empty
= GHC.Internal.Types.TyCon
2520556399233147460#Word64
17224648764450205443#Word64
T26615a.$trModule
- T26615a.$tc'Empty2
+ $tc'Empty2
2#
- T26615a.$tc'Empty1
+ $krep16
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-$krep14 :: GHC.Internal.Types.KindRep
+$krep17 :: GHC.Internal.Types.KindRep
[GblId, Unf=OtherCon []]
-$krep14 = GHC.Internal.Types.KindRepFun $krep9 T26615a.$tc'Empty1
+$krep17 = GHC.Internal.Types.KindRepFun $krep9 $krep16
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Leaf1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep
+$krep18 :: GHC.Internal.Types.KindRep
[GblId, Unf=OtherCon []]
-T26615a.$tc'Leaf1 = GHC.Internal.Types.KindRepFun $krep1 $krep14
+$krep18 = GHC.Internal.Types.KindRepFun $krep1 $krep17
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Leaf3 :: Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 30 0}]
-T26615a.$tc'Leaf3 = "'Leaf"#
+$tc'Leaf1 :: Addr#
+[GblId, Unf=OtherCon []]
+$tc'Leaf1 = "'Leaf"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Leaf2 :: GHC.Internal.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615a.$tc'Leaf2 = GHC.Internal.Types.TrNameS T26615a.$tc'Leaf3
+$tc'Leaf2 :: GHC.Internal.Types.TrName
+[GblId, Unf=OtherCon []]
+$tc'Leaf2 = GHC.Internal.Types.TrNameS $tc'Leaf1
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Leaf :: GHC.Internal.Types.TyCon
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'Leaf [InlPrag=[~]] :: GHC.Internal.Types.TyCon
+[GblId, Unf=OtherCon []]
T26615a.$tc'Leaf
= GHC.Internal.Types.TyCon
5773656560257991946#Word64
17028074687139582545#Word64
T26615a.$trModule
- T26615a.$tc'Leaf2
+ $tc'Leaf2
2#
- T26615a.$tc'Leaf1
+ $krep18
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-$krep15 :: GHC.Internal.Types.KindRep
+$krep19 :: GHC.Internal.Types.KindRep
[GblId, Unf=OtherCon []]
-$krep15 = GHC.Internal.Types.KindRepFun $krep13 T26615a.$tc'Empty1
+$krep19 = GHC.Internal.Types.KindRepFun $krep15 $krep16
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Collision1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep
+$krep20 :: GHC.Internal.Types.KindRep
[GblId, Unf=OtherCon []]
-T26615a.$tc'Collision1
- = GHC.Internal.Types.KindRepFun $krep1 $krep15
+$krep20 = GHC.Internal.Types.KindRepFun $krep1 $krep19
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Collision3 :: Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 40 0}]
-T26615a.$tc'Collision3 = "'Collision"#
+$tc'Collision1 :: Addr#
+[GblId, Unf=OtherCon []]
+$tc'Collision1 = "'Collision"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Collision2 :: GHC.Internal.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615a.$tc'Collision2
- = GHC.Internal.Types.TrNameS T26615a.$tc'Collision3
+$tc'Collision2 :: GHC.Internal.Types.TrName
+[GblId, Unf=OtherCon []]
+$tc'Collision2 = GHC.Internal.Types.TrNameS $tc'Collision1
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Collision :: GHC.Internal.Types.TyCon
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'Collision [InlPrag=[~]] :: GHC.Internal.Types.TyCon
+[GblId, Unf=OtherCon []]
T26615a.$tc'Collision
= GHC.Internal.Types.TyCon
18175105753528304021#Word64
13986842878006680511#Word64
T26615a.$trModule
- T26615a.$tc'Collision2
+ $tc'Collision2
2#
- T26615a.$tc'Collision1
+ $krep20
-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
-$krep16 :: [GHC.Internal.Types.KindRep]
+$krep21 :: [GHC.Internal.Types.KindRep]
[GblId, Unf=OtherCon []]
-$krep16
+$krep21
= GHC.Internal.Types.:
@GHC.Internal.Types.KindRep
- T26615a.$tc'Empty1
+ $krep16
(GHC.Internal.Types.[] @GHC.Internal.Types.KindRep)
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-$krep17 :: GHC.Internal.Types.KindRep
+$krep22 :: GHC.Internal.Types.KindRep
[GblId, Unf=OtherCon []]
-$krep17
- = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep16
+$krep22
+ = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep21
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Full1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep
+$krep23 :: GHC.Internal.Types.KindRep
[GblId, Unf=OtherCon []]
-T26615a.$tc'Full1
- = GHC.Internal.Types.KindRepFun $krep17 T26615a.$tc'Empty1
+$krep23 = GHC.Internal.Types.KindRepFun $krep22 $krep16
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Full3 :: Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 30 0}]
-T26615a.$tc'Full3 = "'Full"#
+$tc'Full1 :: Addr#
+[GblId, Unf=OtherCon []]
+$tc'Full1 = "'Full"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Full2 :: GHC.Internal.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615a.$tc'Full2 = GHC.Internal.Types.TrNameS T26615a.$tc'Full3
+$tc'Full2 :: GHC.Internal.Types.TrName
+[GblId, Unf=OtherCon []]
+$tc'Full2 = GHC.Internal.Types.TrNameS $tc'Full1
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'Full :: GHC.Internal.Types.TyCon
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'Full [InlPrag=[~]] :: GHC.Internal.Types.TyCon
+[GblId, Unf=OtherCon []]
T26615a.$tc'Full
= GHC.Internal.Types.TyCon
12008762105994325570#Word64
13514145886440831186#Word64
T26615a.$trModule
- T26615a.$tc'Full2
+ $tc'Full2
2#
- T26615a.$tc'Full1
+ $krep23
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'BitmapIndexed1 [InlPrag=[~]]
- :: GHC.Internal.Types.KindRep
+$krep24 :: GHC.Internal.Types.KindRep
[GblId, Unf=OtherCon []]
-T26615a.$tc'BitmapIndexed1
- = GHC.Internal.Types.KindRepFun $krep1 T26615a.$tc'Full1
+$krep24 = GHC.Internal.Types.KindRepFun $krep1 $krep23
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'BitmapIndexed3 :: Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 50 0}]
-T26615a.$tc'BitmapIndexed3 = "'BitmapIndexed"#
+$tc'BitmapIndexed1 :: Addr#
+[GblId, Unf=OtherCon []]
+$tc'BitmapIndexed1 = "'BitmapIndexed"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'BitmapIndexed2 :: GHC.Internal.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615a.$tc'BitmapIndexed2
- = GHC.Internal.Types.TrNameS T26615a.$tc'BitmapIndexed3
+$tc'BitmapIndexed2 :: GHC.Internal.Types.TrName
+[GblId, Unf=OtherCon []]
+$tc'BitmapIndexed2 = GHC.Internal.Types.TrNameS $tc'BitmapIndexed1
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
-T26615a.$tc'BitmapIndexed :: GHC.Internal.Types.TyCon
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'BitmapIndexed [InlPrag=[~]] :: GHC.Internal.Types.TyCon
+[GblId, Unf=OtherCon []]
T26615a.$tc'BitmapIndexed
= GHC.Internal.Types.TyCon
15226751910432948177#Word64
957331387129868915#Word64
T26615a.$trModule
- T26615a.$tc'BitmapIndexed2
+ $tc'BitmapIndexed2
2#
- T26615a.$tc'BitmapIndexed1
+ $krep24
-- RHS size: {terms: 98, types: 109, coercions: 0, joins: 3/4}
T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]]
@@ -538,7 +425,7 @@ T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]]
Str=<LP(SC(S,C(1,L)),A)><L><1L><L><L>,
Unf=Unf{Src=StableUser, TopLvl=True,
Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [30 0 20 0 0] 406 10
+ Guidance=IF_ARGS [90 0 20 0 0] 406 10
Tmpl= \ (@k)
(@a)
(@b)
@@ -586,7 +473,7 @@ T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]]
Arity=5,
Str=<L><L><L><L><L>,
Unf=OtherCon []]
- lookupInArrayCont_ _ [Occ=Dead]
+ lookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k)
(k1 [Occ=Once1] :: k)
(ary1 [Occ=Once1!] :: Array (Leaf k b))
(i1 [Occ=Once1!] :: Int)
@@ -654,24 +541,23 @@ T26615a.$wdisjointCollisions
$s$wfoldr_ [InlPrag=[2],
Occ=LoopBreaker,
Dmd=SC(S,C(1,C(1,C(1,L))))]
- :: Bool -> Int# -> Int# -> SmallArray# (Leaf k a) -> Bool
+ :: SmallArray# (Leaf k a) -> Int# -> Int# -> Bool -> Bool
[LclId[JoinId(4)(Nothing)],
Arity=4,
Str=<L><L><L><L>,
Unf=OtherCon []]
- $s$wfoldr_ (sc :: Bool)
+ $s$wfoldr_ (sc :: SmallArray# (Leaf k a))
(sc1 :: Int#)
(sc2 :: Int#)
- (sc3 :: SmallArray# (Leaf k a))
- = case >=# sc1 sc2 of {
+ (sc3 :: Bool)
+ = case >=# sc2 sc1 of {
__DEFAULT ->
- case indexSmallArray# @Lifted @(Leaf k a) sc3 sc1 of
- { (# ipv1 #) ->
+ case indexSmallArray# @Lifted @(Leaf k a) sc sc2 of { (# ipv1 #) ->
case ipv1 of { L kA ds1 ->
join {
$j :: Bool
[LclId[JoinId(0)(Nothing)]]
- $j = jump $s$wfoldr_ sc (+# sc1 1#) sc2 sc3 } in
+ $j = jump $s$wfoldr_ sc sc1 (+# sc2 1#) sc3 } in
joinrec {
$wlookupInArrayCont_ [InlPrag=[2],
Occ=LoopBreaker,
@@ -703,13 +589,13 @@ T26615a.$wdisjointCollisions
jump $wlookupInArrayCont_ kA ww2 0# lvl2
}
};
- 1# -> sc
+ 1# -> sc3
}; } in
jump $s$wfoldr_
- GHC.Internal.Types.True
- 0#
- (sizeofSmallArray# @Lifted @(Leaf k a) ipv)
ipv
+ (sizeofSmallArray# @Lifted @(Leaf k a) ipv)
+ 0#
+ GHC.Internal.Types.True
}
}
@@ -728,28 +614,28 @@ Rec {
-- RHS size: {terms: 133, types: 126, coercions: 0, joins: 1/2}
T26615a.disjointSubtrees_$s$wdisjointSubtrees [InlPrag=INLINABLE[2],
Occ=LoopBreaker]
- :: forall b a k.
- Word#
- -> SmallArray# (Leaf k a) -> Int# -> Eq k => HashMap k b -> Bool
+ :: forall k a b.
+ Eq k =>
+ Int# -> Word# -> SmallArray# (Leaf k a) -> HashMap k b -> Bool
[GblId[StrictWorker([~, ~, ~, ~, !])],
Arity=5,
- Str=<L><L><L><LP(SC(S,C(1,L)),A)><1L>,
+ Str=<LP(SC(S,C(1,L)),A)><L><L><L><1L>,
Unf=OtherCon []]
T26615a.disjointSubtrees_$s$wdisjointSubtrees
- = \ (@b)
+ = \ (@k)
(@a)
- (@k)
- (sc :: Word#)
- (sc1 :: SmallArray# (Leaf k a))
- (sc2 :: Int#)
- (sc3 :: Eq k)
+ (@b)
+ (sc :: Eq k)
+ (sc1 :: Int#)
+ (sc2 :: Word#)
+ (sc3 :: SmallArray# (Leaf k a))
(_b :: HashMap k b) ->
case _b of {
Empty -> GHC.Internal.Types.True;
Leaf bx ds ->
case ds of { L kB ds1 ->
case kB of k0 { __DEFAULT ->
- case eqWord# bx sc of {
+ case eqWord# bx sc2 of {
__DEFAULT -> GHC.Internal.Types.True;
1# ->
joinrec {
@@ -770,7 +656,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees
__DEFAULT ->
case indexSmallArray# @Lifted @(Leaf k a) ww ww1 of { (# ipv #) ->
case ipv of { L kx v ->
- case == @k sc3 k2 kx of {
+ case == @k sc k2 kx of {
False -> jump $wlookupInArrayCont_ k2 ww (+# ww1 1#) ww2;
True -> GHC.Internal.Types.False
}
@@ -780,19 +666,19 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees
}
}; } in
jump $wlookupInArrayCont_
- k0 sc1 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc1)
+ k0 sc3 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc3)
}
}
};
Collision bx bx1 ->
T26615a.$wdisjointCollisions
- @k @a @b sc3 sc (T26615a.Array @(Leaf k a) sc1) bx bx1;
+ @k @a @b sc sc2 (T26615a.Array @(Leaf k a) sc3) bx bx1;
BitmapIndexed bx bx1 ->
let {
m :: Word#
[LclId]
m = uncheckedShiftL#
- 1## (word2Int# (and# (uncheckedShiftRL# sc sc2) 31##)) } in
+ 1## (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##)) } in
case and# m bx of {
__DEFAULT ->
case indexSmallArray#
@@ -803,7 +689,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees
of
{ (# ipv #) ->
T26615a.disjointSubtrees_$s$wdisjointSubtrees
- @b @a @k sc sc1 (+# sc2 5#) sc3 ipv
+ @k @a @b sc (+# sc1 5#) sc2 sc3 ipv
};
0## -> GHC.Internal.Types.True
};
@@ -812,17 +698,17 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees
@Lifted
@(HashMap k b)
bx
- (word2Int# (and# (uncheckedShiftRL# sc sc2) 31##))
+ (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##))
of
{ (# ipv #) ->
T26615a.disjointSubtrees_$s$wdisjointSubtrees
- @b @a @k sc sc1 (+# sc2 5#) sc3 ipv
+ @k @a @b sc (+# sc1 5#) sc2 sc3 ipv
}
}
end Rec }
Rec {
--- RHS size: {terms: 705, types: 732, coercions: 18, joins: 13/23}
+-- RHS size: {terms: 705, types: 748, coercions: 18, joins: 13/23}
T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker]
:: forall k a b. Eq k => Int# -> HashMap k a -> HashMap k b -> Bool
[GblId[StrictWorker([~, ~, !])],
@@ -841,7 +727,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker]
join {
fail [Occ=Once3!T[1]] :: (# #) -> Bool
[LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []]
- fail _ [Occ=Dead, OS=OneShot]
+ fail (ds1 [Occ=Dead, OS=OneShot] :: (# #))
= case _b of wild [Occ=Once1] {
__DEFAULT ->
case GHC.Internal.Control.Exception.Base.patError
@@ -860,7 +746,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker]
Arity=5,
Str=<L><L><L><L><L>,
Unf=OtherCon []]
- lookupCont_ _ [Occ=Dead]
+ lookupCont_ ($dEq1 [Occ=Dead] :: Eq k)
(ds4 [Occ=Once1!] :: Word)
(ds5 [Occ=Once1] :: k)
(ds6 [Occ=Once1!] :: Int)
@@ -896,7 +782,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker]
Arity=5,
Str=<L><L><L><L><L>,
Unf=OtherCon []]
- lookupInArrayCont_ _ [Occ=Dead]
+ lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k)
(k1 [Occ=Once1] :: k)
(ary [Occ=Once1!] :: Array (Leaf k a))
(i [Occ=Once1!] :: Int)
@@ -1000,7 +886,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker]
Arity=5,
Str=<L><L><L><L><L>,
Unf=OtherCon []]
- lookupCont_ _ [Occ=Dead]
+ lookupCont_ ($dEq1 [Occ=Dead] :: Eq k)
(ds3 [Occ=Once1!] :: Word)
(ds4 [Occ=Once1] :: k)
(ds5 [Occ=Once1!] :: Int)
@@ -1034,7 +920,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker]
Arity=5,
Str=<L><L><L><L><L>,
Unf=OtherCon []]
- lookupInArrayCont_ _ [Occ=Dead]
+ lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k)
(k1 [Occ=Once1] :: k)
(ary [Occ=Once1!] :: Array (Leaf k b))
(i [Occ=Once1!] :: Int)
@@ -1179,23 +1065,23 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker]
@(*)
@(SmallArray# (HashMap k a)
-> SmallArray# (HashMap k b) -> Int#)
- @(GHC.Internal.Types.ZonkAny 0
- -> GHC.Internal.Types.ZonkAny 1 -> Int#)
+ @(GHC.Internal.Types.UnusedType 0 "a"
+ -> GHC.Internal.Types.UnusedType 1 "b" -> Int#)
of
{ GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 ->
case reallyUnsafePtrEquality#
@Lifted
@Lifted
- @(GHC.Internal.Types.ZonkAny 0)
- @(GHC.Internal.Types.ZonkAny 1)
+ @(GHC.Internal.Types.UnusedType 0 "a")
+ @(GHC.Internal.Types.UnusedType 1 "b")
(bx1
`cast` (SelCo:Fun(arg) (Sub (Sym v2))
:: SmallArray# (HashMap k a)
- ~R# GHC.Internal.Types.ZonkAny 0))
+ ~R# GHC.Internal.Types.UnusedType 0 "a"))
(bx3
`cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2)))
:: SmallArray# (HashMap k b)
- ~R# GHC.Internal.Types.ZonkAny 1))
+ ~R# GHC.Internal.Types.UnusedType 1 "b"))
of {
__DEFAULT ->
joinrec {
@@ -1324,51 +1210,49 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker]
}; } in
jump go (GHC.Internal.Types.W# (and# 4294967295## bx1));
Full bx1 ->
+ joinrec {
+ go [Occ=LoopBreakerT[1]] :: Int -> Bool
+ [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []]
+ go (i :: Int)
+ = case GHC.Internal.Classes.ltInt i (GHC.Internal.Types.I# 0#) of {
+ False ->
+ case i of { I# i# ->
+ case indexSmallArray# @Lifted @(HashMap k a) bx i# of
+ { (# ipv [Occ=Once1] #) ->
+ case indexSmallArray# @Lifted @(HashMap k b) bx1 i# of
+ { (# ipv1 [Occ=Once1] #) ->
+ case T26615a.$wdisjointSubtrees @k @a @b $dEq (+# ww 5#) ipv ipv1
+ of {
+ False -> GHC.Internal.Types.False;
+ True -> jump go (GHC.Internal.Types.I# (-# i# 1#))
+ }
+ }
+ }
+ };
+ True -> GHC.Internal.Types.True
+ }; } in
case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof
@(*)
@(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#)
- @(GHC.Internal.Types.ZonkAny 0
- -> GHC.Internal.Types.ZonkAny 1 -> Int#)
+ @(GHC.Internal.Types.UnusedType 0 "a"
+ -> GHC.Internal.Types.UnusedType 1 "b" -> Int#)
of
{ GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 ->
case reallyUnsafePtrEquality#
@Lifted
@Lifted
- @(GHC.Internal.Types.ZonkAny 0)
- @(GHC.Internal.Types.ZonkAny 1)
+ @(GHC.Internal.Types.UnusedType 0 "a")
+ @(GHC.Internal.Types.UnusedType 1 "b")
(bx
`cast` (SelCo:Fun(arg) (Sub (Sym v2))
:: SmallArray# (HashMap k a)
- ~R# GHC.Internal.Types.ZonkAny 0))
+ ~R# GHC.Internal.Types.UnusedType 0 "a"))
(bx1
`cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2)))
:: SmallArray# (HashMap k b)
- ~R# GHC.Internal.Types.ZonkAny 1))
+ ~R# GHC.Internal.Types.UnusedType 1 "b"))
of {
- __DEFAULT ->
- joinrec {
- go [Occ=LoopBreakerT[1]] :: Int -> Bool
- [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []]
- go (i :: Int)
- = case GHC.Internal.Classes.ltInt i (GHC.Internal.Types.I# 0#) of {
- False ->
- case i of { I# i# ->
- case indexSmallArray# @Lifted @(HashMap k a) bx i# of
- { (# ipv [Occ=Once1] #) ->
- case indexSmallArray# @Lifted @(HashMap k b) bx1 i# of
- { (# ipv1 [Occ=Once1] #) ->
- case T26615a.$wdisjointSubtrees
- @k @a @b $dEq (+# ww 5#) ipv ipv1
- of {
- False -> GHC.Internal.Types.False;
- True -> jump go (GHC.Internal.Types.I# (-# i# 1#))
- }
- }
- }
- };
- True -> GHC.Internal.Types.True
- }; } in
- jump go (GHC.Internal.Types.I# 31#);
+ __DEFAULT -> jump go (GHC.Internal.Types.I# 31#);
1# -> GHC.Internal.Types.False
}
}
@@ -1385,7 +1269,7 @@ T26615a.$wdisjointSubtrees
join {
fail [Dmd=MC(1,L)] :: (# #) -> Bool
[LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []]
- fail _ [Occ=Dead, OS=OneShot]
+ fail (ds1 [Occ=Dead, OS=OneShot] :: (# #))
= case _b of {
__DEFAULT -> case lvl1 of {};
Empty -> GHC.Internal.Types.True;
@@ -1508,7 +1392,7 @@ T26615a.$wdisjointSubtrees
};
Collision bx bx1 ->
T26615a.disjointSubtrees_$s$wdisjointSubtrees
- @a @b @k bx bx1 ww $dEq ds
+ @k @b @a $dEq ww bx bx1 ds
} } in
case ds of {
Empty -> GHC.Internal.Types.True;
@@ -1661,7 +1545,7 @@ T26615a.$wdisjointSubtrees
of
{ (# ipv #) ->
T26615a.disjointSubtrees_$s$wdisjointSubtrees
- @b @a @k bx bx1 (+# ww 5#) $dEq ipv
+ @k @a @b $dEq (+# ww 5#) bx bx1 ipv
};
0## -> GHC.Internal.Types.True
};
@@ -1674,7 +1558,7 @@ T26615a.$wdisjointSubtrees
of
{ (# ipv #) ->
T26615a.disjointSubtrees_$s$wdisjointSubtrees
- @b @a @k bx bx1 (+# ww 5#) $dEq ipv
+ @k @a @b $dEq (+# ww 5#) bx bx1 ipv
}
};
BitmapIndexed bx bx1 ->
@@ -1686,21 +1570,23 @@ T26615a.$wdisjointSubtrees
case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof
@(*)
@(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#)
- @(GHC.Internal.Types.ZonkAny 0
- -> GHC.Internal.Types.ZonkAny 1 -> Int#)
+ @(GHC.Internal.Types.UnusedType 0 "a"
+ -> GHC.Internal.Types.UnusedType 1 "b" -> Int#)
of
{ GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 ->
case reallyUnsafePtrEquality#
@Lifted
@Lifted
- @(GHC.Internal.Types.ZonkAny 0)
- @(GHC.Internal.Types.ZonkAny 1)
+ @(GHC.Internal.Types.UnusedType 0 "a")
+ @(GHC.Internal.Types.UnusedType 1 "b")
(bx1
`cast` (SelCo:Fun(arg) (Sub (Sym v2))
- :: SmallArray# (HashMap k a) ~R# GHC.Internal.Types.ZonkAny 0))
+ :: SmallArray# (HashMap k a)
+ ~R# GHC.Internal.Types.UnusedType 0 "a"))
(bx3
`cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2)))
- :: SmallArray# (HashMap k b) ~R# GHC.Internal.Types.ZonkAny 1))
+ :: SmallArray# (HashMap k b)
+ ~R# GHC.Internal.Types.UnusedType 1 "b"))
of {
__DEFAULT ->
let {
@@ -1829,21 +1715,23 @@ T26615a.$wdisjointSubtrees
case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof
@(*)
@(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#)
- @(GHC.Internal.Types.ZonkAny 0
- -> GHC.Internal.Types.ZonkAny 1 -> Int#)
+ @(GHC.Internal.Types.UnusedType 0 "a"
+ -> GHC.Internal.Types.UnusedType 1 "b" -> Int#)
of
{ GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 ->
case reallyUnsafePtrEquality#
@Lifted
@Lifted
- @(GHC.Internal.Types.ZonkAny 0)
- @(GHC.Internal.Types.ZonkAny 1)
+ @(GHC.Internal.Types.UnusedType 0 "a")
+ @(GHC.Internal.Types.UnusedType 1 "b")
(bx
`cast` (SelCo:Fun(arg) (Sub (Sym v2))
- :: SmallArray# (HashMap k a) ~R# GHC.Internal.Types.ZonkAny 0))
+ :: SmallArray# (HashMap k a)
+ ~R# GHC.Internal.Types.UnusedType 0 "a"))
(bx1
`cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2)))
- :: SmallArray# (HashMap k b) ~R# GHC.Internal.Types.ZonkAny 1))
+ :: SmallArray# (HashMap k b)
+ ~R# GHC.Internal.Types.UnusedType 1 "b"))
of {
__DEFAULT ->
let {
@@ -1910,88 +1798,72 @@ disjointSubtrees
------ Local rules for imported ids --------
"SC:$wdisjointSubtrees1" [1]
- forall (@a)
+ forall (@k)
(@b)
- (@k)
- (sc :: Word#)
- (sc1 :: SmallArray# (Leaf k a))
+ (@a)
+ (sc :: Eq k)
+ (sc1 :: Int#)
(sc2 :: Word#)
(sc3 :: SmallArray# (Leaf k b))
- (sc4 :: Int#)
- (sc5 :: Eq k).
+ (sc4 :: Word#)
+ (sc5 :: SmallArray# (Leaf k a)).
T26615a.$wdisjointSubtrees @k
@b
@a
- sc5
- sc4
+ sc
+ sc1
(T26615a.Collision @k @b sc2 sc3)
- (T26615a.Collision @k @a sc sc1)
+ (T26615a.Collision @k @a sc4 sc5)
= T26615a.$wdisjointCollisions
- @k @b @a sc5 sc2 (T26615a.Array @(Leaf k b) sc3) sc sc1
+ @k @b @a sc sc2 (T26615a.Array @(Leaf k b) sc3) sc4 sc5
"SC:$wdisjointSubtrees0" [1]
- forall (@b)
+ forall (@k)
(@a)
- (@k)
- (sc :: Word#)
- (sc1 :: SmallArray# (Leaf k a))
- (sc2 :: Int#)
- (sc3 :: Eq k).
+ (@b)
+ (sc :: Eq k)
+ (sc1 :: Int#)
+ (sc2 :: Word#)
+ (sc3 :: SmallArray# (Leaf k a)).
T26615a.$wdisjointSubtrees @k
@a
@b
- sc3
- sc2
- (T26615a.Collision @k @a sc sc1)
+ sc
+ sc1
+ (T26615a.Collision @k @a sc2 sc3)
= T26615a.disjointSubtrees_$s$wdisjointSubtrees
- @b @a @k sc sc1 sc2 sc3
+ @k @a @b sc sc1 sc2 sc3
[2 of 2] Compiling T26615 ( T26615.hs, T26615.o )
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 614, types: 666, coercions: 18, joins: 8/14}
+ = {terms: 614, types: 682, coercions: 18, joins: 8/14}
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T26615.$trModule2 :: GHC.Internal.Prim.Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 30 0}]
-T26615.$trModule2 = "T26615"#
+$trModule1 :: GHC.Internal.Prim.Addr#
+[GblId, Unf=OtherCon []]
+$trModule1 = "T26615"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T26615.$trModule1 :: GHC.Internal.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615.$trModule1 = GHC.Internal.Types.TrNameS T26615.$trModule2
+$trModule2 :: GHC.Internal.Types.TrName
+[GblId, Unf=OtherCon []]
+$trModule2 = GHC.Internal.Types.TrNameS $trModule1
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T26615.$trModule4 :: GHC.Internal.Prim.Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 20 0}]
-T26615.$trModule4 = "main"#
+$trModule3 :: GHC.Internal.Prim.Addr#
+[GblId, Unf=OtherCon []]
+$trModule3 = "main"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T26615.$trModule3 :: GHC.Internal.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615.$trModule3 = GHC.Internal.Types.TrNameS T26615.$trModule4
+$trModule4 :: GHC.Internal.Types.TrName
+[GblId, Unf=OtherCon []]
+$trModule4 = GHC.Internal.Types.TrNameS $trModule3
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-T26615.$trModule :: GHC.Internal.Types.Module
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T26615.$trModule
- = GHC.Internal.Types.Module T26615.$trModule3 T26615.$trModule1
+T26615.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module
+[GblId, Unf=OtherCon []]
+T26615.$trModule = GHC.Internal.Types.Module $trModule4 $trModule2
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
lvl :: GHC.Internal.Prim.Addr#
@@ -2128,7 +2000,7 @@ $wpoly_lookupCont_
end Rec }
Rec {
--- RHS size: {terms: 448, types: 507, coercions: 18, joins: 8/13}
+-- RHS size: {terms: 448, types: 523, coercions: 18, joins: 8/13}
T26615.$s$wdisjointSubtrees [InlPrag=[~], Occ=LoopBreaker]
:: forall a b.
GHC.Internal.Prim.Int#
@@ -2143,7 +2015,7 @@ T26615.$s$wdisjointSubtrees
join {
fail [Dmd=MC(1,L)] :: (# #) -> Bool
[LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []]
- fail _ [Occ=Dead, OS=OneShot]
+ fail (ds1 [Occ=Dead, OS=OneShot] :: (# #))
= case _b of wild {
__DEFAULT -> case lvl1 of {};
T26615a.Empty -> GHC.Internal.Types.True;
@@ -2190,30 +2062,28 @@ T26615.$s$wdisjointSubtrees
$s$wfoldr_ [InlPrag=[2],
Occ=LoopBreaker,
Dmd=SC(S,C(1,C(1,C(1,L))))]
- :: Bool
- -> GHC.Internal.Prim.Int#
- -> GHC.Internal.Prim.Int#
- -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)
- -> Bool
+ :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)
+ -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> Bool -> Bool
[LclId[JoinId(4)(Nothing)],
Arity=4,
Str=<L><L><L><L>,
Unf=OtherCon []]
- $s$wfoldr_ (sc :: Bool)
+ $s$wfoldr_ (sc
+ :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a))
(sc1 :: GHC.Internal.Prim.Int#)
(sc2 :: GHC.Internal.Prim.Int#)
- (sc3 :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a))
- = case GHC.Internal.Prim.>=# sc1 sc2 of {
+ (sc3 :: Bool)
+ = case GHC.Internal.Prim.>=# sc2 sc1 of {
__DEFAULT ->
case GHC.Internal.Prim.indexSmallArray#
- @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) sc3 sc1
+ @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) sc sc2
of
{ (# ipv1 #) ->
case ipv1 of { T26615a.L kA ds2 ->
join {
$j :: Bool
[LclId[JoinId(0)(Nothing)]]
- $j = jump $s$wfoldr_ sc (GHC.Internal.Prim.+# sc1 1#) sc2 sc3 } in
+ $j = jump $s$wfoldr_ sc sc1 (GHC.Internal.Prim.+# sc2 1#) sc3 } in
joinrec {
$wlookupInArrayCont_ [InlPrag=[2],
Occ=LoopBreaker,
@@ -2258,14 +2128,14 @@ T26615.$s$wdisjointSubtrees
jump $wlookupInArrayCont_ kA bx3 0# lvl2
}
};
- 1# -> sc
+ 1# -> sc3
}; } in
jump $s$wfoldr_
- GHC.Internal.Types.True
- 0#
+ bx1
(GHC.Internal.Prim.sizeofSmallArray#
@GHC.Internal.Types.Lifted @(T26615a.Leaf String a) bx1)
- bx1
+ 0#
+ GHC.Internal.Types.True
};
T26615a.BitmapIndexed bx2 bx3 ->
let {
@@ -2317,23 +2187,23 @@ T26615.$s$wdisjointSubtrees
@(GHC.Internal.Prim.SmallArray# (HashMap String a)
-> GHC.Internal.Prim.SmallArray# (HashMap String b)
-> GHC.Internal.Prim.Int#)
- @(GHC.Internal.Types.ZonkAny 0
- -> GHC.Internal.Types.ZonkAny 1 -> GHC.Internal.Prim.Int#)
+ @(GHC.Internal.Types.UnusedType 0 "a"
+ -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#)
of
{ GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 ->
case GHC.Internal.Prim.reallyUnsafePtrEquality#
@GHC.Internal.Types.Lifted
@GHC.Internal.Types.Lifted
- @(GHC.Internal.Types.ZonkAny 0)
- @(GHC.Internal.Types.ZonkAny 1)
+ @(GHC.Internal.Types.UnusedType 0 "a")
+ @(GHC.Internal.Types.UnusedType 1 "b")
(bx1
`cast` (SelCo:Fun(arg) (Sub (Sym v2))
:: GHC.Internal.Prim.SmallArray# (HashMap String a)
- ~R# GHC.Internal.Types.ZonkAny 0))
+ ~R# GHC.Internal.Types.UnusedType 0 "a"))
(bx3
`cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2)))
:: GHC.Internal.Prim.SmallArray# (HashMap String b)
- ~R# GHC.Internal.Types.ZonkAny 1))
+ ~R# GHC.Internal.Types.UnusedType 1 "b"))
of {
__DEFAULT ->
joinrec {
@@ -2495,23 +2365,23 @@ T26615.$s$wdisjointSubtrees
@(GHC.Internal.Prim.SmallArray# (HashMap String a)
-> GHC.Internal.Prim.SmallArray# (HashMap String b)
-> GHC.Internal.Prim.Int#)
- @(GHC.Internal.Types.ZonkAny 0
- -> GHC.Internal.Types.ZonkAny 1 -> GHC.Internal.Prim.Int#)
+ @(GHC.Internal.Types.UnusedType 0 "a"
+ -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#)
of
{ GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 ->
case GHC.Internal.Prim.reallyUnsafePtrEquality#
@GHC.Internal.Types.Lifted
@GHC.Internal.Types.Lifted
- @(GHC.Internal.Types.ZonkAny 0)
- @(GHC.Internal.Types.ZonkAny 1)
+ @(GHC.Internal.Types.UnusedType 0 "a")
+ @(GHC.Internal.Types.UnusedType 1 "b")
(bx
`cast` (SelCo:Fun(arg) (Sub (Sym v2))
:: GHC.Internal.Prim.SmallArray# (HashMap String a)
- ~R# GHC.Internal.Types.ZonkAny 0))
+ ~R# GHC.Internal.Types.UnusedType 0 "a"))
(bx1
`cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2)))
:: GHC.Internal.Prim.SmallArray# (HashMap String b)
- ~R# GHC.Internal.Types.ZonkAny 1))
+ ~R# GHC.Internal.Types.UnusedType 1 "b"))
of {
__DEFAULT ->
joinrec {
@@ -2564,7 +2434,7 @@ f = \ (@a)
------ Local rules for imported ids --------
"SPEC/T26615 $wdisjointSubtrees @String @_ @_" [2]
- forall (@a) (@b) ($dEq :: Eq String).
+ forall (@a) (@b) ($dEq [Occ=Dead] :: Eq String).
T26615a.$wdisjointSubtrees @String @a @b $dEq
= T26615.$s$wdisjointSubtrees @a @b
=====================================
testsuite/tests/typecheck/should_fail/T13292.stderr
=====================================
@@ -14,15 +14,15 @@ T13292a.hs:4:12: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)]
In an equation for ‘someFunc’: someFunc = return ()
T13292.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
- • Couldn't match type ‘GHC.Internal.Types.ZonkAny 0’ with ‘IO’
+ • Couldn't match type ‘m0_0’ with ‘IO’
Expected: IO ()
- Actual: GHC.Internal.Types.ZonkAny 0 ()
+ Actual: m0_0 ()
• When checking the type of the IO action ‘main’
T13292.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
- • Couldn't match type ‘GHC.Internal.Types.ZonkAny 0’ with ‘IO’
+ • Couldn't match type ‘m0_0’ with ‘IO’
Expected: IO ()
- Actual: GHC.Internal.Types.ZonkAny 0 ()
+ Actual: m0_0 ()
• In the expression: main
When checking the type of the IO action ‘main’
=====================================
testsuite/tests/typecheck/should_fail/T27390-explicit-kinds.stderr
=====================================
@@ -0,0 +1,28 @@
+T27390a.hs:4:12: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)]
+ • Ambiguous type variable ‘m0’ arising from a use of ‘return’
+ prevents the constraint ‘(Monad m0)’ from being solved.
+ Relevant bindings include
+ someFunc :: m0 () (bound at T27390a.hs:4:1)
+ Probable fix: use a type annotation to specify what ‘m0’ should be.
+ Potentially matching instances:
+ instance Monad IO -- Defined in ‘GHC.Internal.Base’
+ instance Monad Maybe -- Defined in ‘GHC.Internal.Base’
+ ...plus six others
+ ...plus one instance involving out-of-scope types
+ (use -fprint-potential-instances to see them all)
+ • In the expression: return ()
+ In an equation for ‘someFunc’: someFunc = return ()
+
+T27390.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+ • Couldn't match type ‘m0_0 :: Type -> Type’ with ‘IO’
+ Expected: IO ()
+ Actual: (m0_0 :: Type -> Type) ()
+ • When checking the type of the IO action ‘main’
+
+T27390.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+ • Couldn't match type ‘m0_0 :: Type -> Type’ with ‘IO’
+ Expected: IO ()
+ Actual: (m0_0 :: Type -> Type) ()
+ • In the expression: main
+ When checking the type of the IO action ‘main’
+
=====================================
testsuite/tests/typecheck/should_fail/T27390.hs
=====================================
@@ -0,0 +1,6 @@
+{-# language NoStarIsType #-}
+module Main where
+
+import T27390a
+
+main = someFunc
=====================================
testsuite/tests/typecheck/should_fail/T27390.stderr
=====================================
@@ -0,0 +1,28 @@
+T27390a.hs:4:12: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)]
+ • Ambiguous type variable ‘m0’ arising from a use of ‘return’
+ prevents the constraint ‘(Monad m0)’ from being solved.
+ Relevant bindings include
+ someFunc :: m0 () (bound at T27390a.hs:4:1)
+ Probable fix: use a type annotation to specify what ‘m0’ should be.
+ Potentially matching instances:
+ instance Monad IO -- Defined in ‘GHC.Internal.Base’
+ instance Monad Maybe -- Defined in ‘GHC.Internal.Base’
+ ...plus six others
+ ...plus one instance involving out-of-scope types
+ (use -fprint-potential-instances to see them all)
+ • In the expression: return ()
+ In an equation for ‘someFunc’: someFunc = return ()
+
+T27390.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+ • Couldn't match type ‘m0_0’ with ‘IO’
+ Expected: IO ()
+ Actual: m0_0 ()
+ • When checking the type of the IO action ‘main’
+
+T27390.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+ • Couldn't match type ‘m0_0’ with ‘IO’
+ Expected: IO ()
+ Actual: m0_0 ()
+ • In the expression: main
+ When checking the type of the IO action ‘main’
+
=====================================
testsuite/tests/typecheck/should_fail/T27390a.hs
=====================================
@@ -0,0 +1,4 @@
+module T27390a where
+
+
+someFunc = return ()
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -448,6 +448,8 @@ test('T13075', normal, compile_fail, [''])
test('LevPolyBounded', normal, compile_fail, [''])
test('T13487', normal, compile, [''])
test('T13292', normal, multimod_compile, ['T13292', '-v0 -fdefer-type-errors'])
+test('T27390', normal, multimod_compile, ['T27390', '-v0 -fdefer-type-errors'])
+test('T27390-explicit-kinds', [extra_files(['T27390.hs', 'T27390a.hs'])], multimod_compile, ['T27390', '-v0 -fdefer-type-errors -fprint-explicit-kinds'])
test('T13300', normal, compile_fail, [''])
test('T13311', normal, compile_fail, [''])
test('T13446', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51d623cd25dccf6926cd88f7849316c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51d623cd25dccf6926cd88f7849316c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: Add missing req_interp modifier to T18441fail3 and T18441fail19
by Marge Bot (＠marge-bot) 22 Jun '26
by Marge Bot (＠marge-bot) 22 Jun '26
22 Jun '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
09326ca6 by Matthew Pickering at 2026-06-20T23:41:12+02:00
Add missing req_interp modifier to T18441fail3 and T18441fail19
These tests require the interpreter but they were failing in a different
way with the javascript backend because the interpreter was disabled and
stderr is ignored by the test.
- - - - -
521e55bf by Matthew Pickering at 2026-06-20T23:41:13+02:00
hadrian: Fill in more of the default.host toolchain file
When you are building a cross compiler this file will be used to build
stage1 and it's libraries, so we need enough information here to work
accurately. There is still more work to be done (see for example, word
size is still fixed).
- - - - -
23c9b6c3 by Matthew Pickering at 2026-06-20T23:42:52+02:00
hadrian: Build stage 2 cross compilers
* Most of hadrian is abstracted over the stage in order to remove the
assumption that the target of all stages is the same platform. This
allows the RTS to be built for two different targets for example.
* Abstracts the bindist creation logic to allow building either normal
or cross bindists. Normal bindists use stage 1 libraries and a stage 2
compiler. Cross bindists use stage 2 libararies and a stage 2
compiler.
* hadrian: Make binary-dist-dir the default build target. This allows us
to have the logic in one place about which libraries/stages to build
with cross compilers. Fixes #24192
New hadrian target:
* `binary-dist-dir-cross`: Build a cross compiler bindist (compiler =
stage 1, libraries = stage 2)
This commit also contains various changes to make stage2 compilers
feasible.
-------------------------
Metric Decrease:
LinkableUsage02
ManyAlternatives
ManyConstructors
MultiComponentModulesRecomp
MultiLayerModulesRecomp
RecordUpdPerf
T10421
T12150
T12227
T12425
T12707
T13035
T13379
T13820
T15703
T16577
T18140
T18282
T18698a
T18698b
T18923
T1969
T20049
T21839c
T3294
T4801
T5030
T5321FD
T5321Fun
T5631
T5642
T6048
T783
T9020
T9198
T9233
T9630
T9872d
T9961
parsing001
T3064
Metric Increase:
T26989
hard_hole_fits
-------------------------
Co-authored-by: Sven Tennie <sven.tennie(a)gmail.com>
- - - - -
26fed8ab by Matthew Pickering at 2026-06-20T23:42:52+02:00
ci: Test cross bindists
We remove the special logic for testing in-tree cross
compilers and instead test cross compiler bindists, like we do for all
other platforms.
- - - - -
80c8910e by Matthew Pickering at 2026-06-20T23:42:52+02:00
ci: Introduce CROSS_STAGE variable
In preparation for building and testing stage3 bindists we introduce the
CROSS_STAGE variable which is used by a CI job to determine what kind of
bindist the CI job should produce.
At the moment we are only using CROSS_STAGE=2 but in the future we will
have some jobs which set CROSS_STAGE=3 to produce native bindists for a
target, but produced by a cross compiler, which can be tested on by
another CI job on the native platform.
CROSS_STAGE=2: Build a normal cross compiler bindist
CROSS_STAGE=3: Build a stage 3 bindist, one which is a native compiler and library for the target
- - - - -
8215573d by Sven Tennie at 2026-06-20T23:42:52+02:00
ci: Increase timeout for emulators
Test runs with emulators naturally take longer than on native machines.
Generate jobs.yml
- - - - -
5acb7dbc by Matthew Pickering at 2026-06-20T23:42:52+02:00
ci: Javascript don't set CROSS_EMULATOR
There is no CROSS_EMULATOR needed to run javascript binaries, so we
don't set the CROSS_EMULATOR to some dummy value.
- - - - -
48345343 by Sven Tennie at 2026-06-20T23:42:52+02:00
Javascript skip T23697
See #22355 about how HSC2HS and the Javascript target don't play well
together.
- - - - -
5e44fd05 by Sven Tennie at 2026-06-20T23:42:52+02:00
Mark T24602 as fragile
It was skipped before (due to CROSS_EMULATOR being set, which changed
for JS), so we don't make things worse by marking it as fragile.
- - - - -
ab349ec2 by Sven Tennie at 2026-06-20T23:42:52+02:00
Fix T22744 for GHCJS
In fact, this test needs Template Haskell, not necessarily an
interpreter.
- - - - -
c73352d8 by Sven Tennie at 2026-06-20T23:42:52+02:00
haddock-test: fix GHCJS haddock test failures
Add --ghc-pkg-path flag support so haddock test runner can find
cross-prefixed ghc-pkg (e.g. javascript-unknown-ghcjs-ghc-pkg) which
is not on $PATH in cross install directories.
Skip haddockHtmlTest on GHCJS: Threaded.hs uses forkOS in a TH splice,
which GHCJS RTS doesn't support. Mark with js_skip in all.T.
- - - - -
36a143ab by Andreas Klebinger at 2026-06-22T10:08:42-04:00
compiler: Deduplicate hscTidy
This function was accidentally duplicated during a refactor.
Fixes #27351
- - - - -
47ad52e1 by sheaf at 2026-06-22T10:08:49-04:00
Avoid mkTick in Core Prep breaking ANF (part II)
Hotfix for 2f9579765f55b3920ceb2e04995ff41a9d0e2d4e fixing a small
oversight in the call to tickTickedExpr from mkTick, in which we
improperly recursively called mkTick without passing on the preserve_anf
flag.
Fixes #27386
- - - - -
76 changed files:
- .gitlab/ci.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- + changelog.d/T27386
- + changelog.d/stage2-cross-compilers
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Driver/Main/Interactive.hs
- compiler/GHC/Driver/Main/Passes.hs
- compiler/GHC/Driver/Main/Passes.hs-boot
- configure.ac
- distrib/configure.ac.in
- hadrian/README.md
- hadrian/bindist/config.mk.in
- hadrian/cfg/default.host.target.in
- + hadrian/cfg/system.config.host.in
- hadrian/cfg/system.config.in
- + hadrian/cfg/system.config.target.in
- hadrian/hadrian.cabal
- hadrian/src/Base.hs
- + hadrian/src/BindistConfig.hs
- hadrian/src/Builder.hs
- hadrian/src/Context.hs
- hadrian/src/Expression.hs
- hadrian/src/Flavour.hs
- hadrian/src/Flavour/Type.hs
- hadrian/src/Hadrian/Builder.hs
- hadrian/src/Hadrian/Haskell/Hash.hs
- hadrian/src/Hadrian/Oracles/TextFile.hs
- hadrian/src/Main.hs
- hadrian/src/Oracles/Flag.hs
- hadrian/src/Oracles/Flavour.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Oracles/TestSettings.hs
- hadrian/src/Packages.hs
- hadrian/src/Rules.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/CabalReinstall.hs
- hadrian/src/Rules/Changelog.hs
- hadrian/src/Rules/Compile.hs
- hadrian/src/Rules/Documentation.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Rules/Gmp.hs
- hadrian/src/Rules/Library.hs
- hadrian/src/Rules/Program.hs
- hadrian/src/Rules/Register.hs
- hadrian/src/Rules/Rts.hs
- hadrian/src/Rules/Test.hs
- hadrian/src/Settings.hs
- hadrian/src/Settings/Builders/Cabal.hs
- hadrian/src/Settings/Builders/Common.hs
- hadrian/src/Settings/Builders/Configure.hs
- hadrian/src/Settings/Builders/DeriveConstants.hs
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Builders/Hsc2Hs.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/src/Settings/Builders/SplitSections.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Flavours/GhcInGhci.hs
- hadrian/src/Settings/Flavours/Performance.hs
- hadrian/src/Settings/Flavours/QuickCross.hs
- hadrian/src/Settings/Packages.hs
- hadrian/src/Settings/Program.hs
- hadrian/src/Settings/Warnings.hs
- libraries/base/tests/all.T
- m4/fp_find_nm.m4
- m4/prep_target_file.m4
- testsuite/ghc-config/ghc-config.hs
- testsuite/tests/ghc-e/should_fail/all.T
- testsuite/tests/haddock/haddock_testsuite/Makefile
- testsuite/tests/haddock/haddock_testsuite/all.T
- testsuite/tests/javascript/closure/all.T
- testsuite/tests/perf/compiler/all.T
- + testsuite/tests/profiling/should_compile/T27386.hs
- testsuite/tests/profiling/should_compile/all.T
- utils/haddock/haddock-test/src/Test/Haddock/Config.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f5db814896f67946b469f49c98c778…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f5db814896f67946b469f49c98c778…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sol/reexported-error-message-refactor] Apply 1 suggestion(s) to 1 file(s)
by Simon Hengel (＠sol) 22 Jun '26
by Simon Hengel (＠sol) 22 Jun '26
22 Jun '26
Simon Hengel pushed to branch wip/sol/reexported-error-message-refactor at Glasgow Haskell Compiler / GHC
Commits:
c605dab8 by Simon Hengel at 2026-06-22T14:05:44+00:00
Apply 1 suggestion(s) to 1 file(s)
Co-authored-by: Jaro Reinders <i5c9aasq(a)anonaddy.me>
- - - - -
1 changed file:
- compiler/GHC/Unit/State.hs
Changes:
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -1987,7 +1987,7 @@ lookupModuleWithSuggestions' pkgs mod_map name mb_pn
| originVisible origin
-> (hidden_pkg, hidden_mod, unusable, x:exposed)
| otherwise
- -> (fromHiddenReexport ++ maybe id (:) origUnit hidden_pkg, hidden_mod, unusable, exposed)
+ -> (fromHiddenReexport ++ maybe id (:) hiddenOrigUnit hidden_pkg, hidden_mod, unusable, exposed)
where
hiddenOrigUnit :: Maybe UnitInfo
hiddenOrigUnit = case fromOrigUnit of
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c605dab8b5649f92c750952952b81e9…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c605dab8b5649f92c750952952b81e9…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/dcoutts/io-manager-tidy] Only use FdWakeup for Poll I/O manager when HAVE_PREEMPTION
by Duncan Coutts (＠dcoutts) 22 Jun '26
by Duncan Coutts (＠dcoutts) 22 Jun '26
22 Jun '26
Duncan Coutts pushed to branch wip/dcoutts/io-manager-tidy at Glasgow Haskell Compiler / GHC
Commits:
213060ce by Duncan Coutts at 2026-06-22T14:53:38+01:00
Only use FdWakeup for Poll I/O manager when HAVE_PREEMPTION
This is to allow it to build and work on wasm, but without support for
interruptIOManager.
- - - - -
3 changed files:
- rts/IOManagerInternals.h
- rts/posix/FdWakeup.h
- rts/posix/Poll.c
Changes:
=====================================
rts/IOManagerInternals.h
=====================================
@@ -47,9 +47,11 @@ struct _CapIOManager {
#endif
#if defined(IOMGR_ENABLED_SELECT) || defined(IOMGR_ENABLED_POLL)
+#if defined(HAVE_PREEMPTION)
/* FDs for waking up the I/O manager when it is blocked waiting */
int interrupt_fd_r, interrupt_fd_w;
#endif
+#endif
#if defined(IOMGR_ENABLED_POLL)
/* AIOP and timeout collections shared by several I/O manager impls */
=====================================
rts/posix/FdWakeup.h
=====================================
@@ -29,12 +29,14 @@
#include "BeginPrivate.h"
+#if defined(HAVE_PREEMPTION)
void newFdWakeup(int *fd_r, int *fd_w);
void closeFdWakeup(int fd_r, int fd_w);
/* This is safe to use from a signal handler */
void sendFdWakeup(int fd_w);
void collectFdWakeup(int fd_r);
+#endif
#include "EndPrivate.h"
=====================================
rts/posix/Poll.c
=====================================
@@ -142,13 +142,20 @@ void initCapabilityIOManagerPoll(CapIOManager *iomgr)
initClosureTable(&iomgr->aiop_table, ClosureTableCompact);
iomgr->timeout_queue = emptyTimeoutQueue();
+#if defined(HAVE_PREEMPTION)
newFdWakeup(&iomgr->interrupt_fd_r, &iomgr->interrupt_fd_w);
+#endif
iomgr->full_poll_table = stgMallocBytes(sizeof(struct pollfd) /* size 1 */,
"initCapabilityIOManagerPoll");
iomgr->full_poll_table[0] = (struct pollfd) {
+#if defined(HAVE_PREEMPTION)
.fd = iomgr->interrupt_fd_r,
.events = POLLIN,
+#else
+ .fd = -1, // unused
+ .events = 0, // unused
+#endif
.revents = 0
};
iomgr->aiop_poll_table = iomgr->full_poll_table+1; /* hence empty */
@@ -158,7 +165,9 @@ void initCapabilityIOManagerPoll(CapIOManager *iomgr)
void freeCapabilityIOManagerPoll(CapIOManager *iomgr)
{
stgFree(iomgr->full_poll_table);
+#if defined(HAVE_PREEMPTION)
closeFdWakeup(iomgr->interrupt_fd_r, iomgr->interrupt_fd_w);
+#endif
}
@@ -326,7 +335,8 @@ static bool processIOCompletions(CapIOManager *iomgr, int ncompletions)
debugTrace(DEBUG_iomanager, "processIOCompletions(ncompletions = %d)",
ncompletions);
- bool interrupt;
+ bool interrupt = false;
+#if defined(HAVE_PREEMPTION)
/* If the interrupt_fd_r is ready, collect it */
if (iomgr->full_poll_table[0].revents) {
ASSERT(iomgr->full_poll_table[0].fd == iomgr->interrupt_fd_r);
@@ -334,9 +344,8 @@ static bool processIOCompletions(CapIOManager *iomgr, int ncompletions)
ncompletions--;
interrupt = true;
debugTrace(DEBUG_iomanager, "Received interrupt in poll I/O manager");
- } else {
- interrupt = false;
}
+#endif
struct pollfd *aiop_poll_table = iomgr->aiop_poll_table;
int n = ncompletions;
@@ -407,18 +416,26 @@ void pollCompletedTimeoutsOrIOPoll(CapIOManager *iomgr)
nfds_t nfds = sizeClosureTable(&iomgr->aiop_table) + 1;
+#if defined(HAVE_PREEMPTION)
+ /* the full_poll_table includes interrupt_fd_r */
+ struct pollfd *poll_table = iomgr->full_poll_table;
+#else
+ /* the aiop_poll_table does not include interrupt_fd_r */
+ struct pollfd *poll_table = iomgr->aiop_poll_table;
+#endif
+
/* Poll for I/O readiness, without waiting. */
#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1
/* We could use poll here, since we use no timeout, but for
consistency we use the same syscall as at the other call site. */
struct timespec tv = (struct timespec) { .tv_sec = 0, .tv_nsec = 0 };
- int res = ppoll(iomgr->full_poll_table, nfds, &tv, NULL);
+ int res = ppoll(poll_table, nfds, &tv, NULL);
debugTrace(DEBUG_iomanager,
"ppoll(nfds = %d, timeout.sec = 0, timeout.nsec = 0) = %d",
nfds, res);
#else
- int res = poll(iomgr->full_poll_table, nfds, 0);
+ int res = poll(poll_table, nfds, 0);
debugTrace(DEBUG_iomanager,
"poll(nfds = %d, timeout_ms = 0) = %d",
@@ -471,6 +488,14 @@ bool awaitCompletedTimeoutsOrIOPoll(CapIOManager *iomgr)
*/
bool wait = emptyRunQueue(iomgr->cap);
+#if defined(HAVE_PREEMPTION)
+ /* the full_poll_table includes interrupt_fd_r */
+ struct pollfd *poll_table = iomgr->full_poll_table;
+#else
+ /* the aiop_poll_table does not include interrupt_fd_r */
+ struct pollfd *poll_table = iomgr->aiop_poll_table;
+#endif
+
/* Decide if we are going to wait if no I/O is ready, either:
* poll only, wait indefinitely, or wait until a timeout.
*/
@@ -484,7 +509,7 @@ bool awaitCompletedTimeoutsOrIOPoll(CapIOManager *iomgr)
/* Check for I/O readiness, possibly waiting. */
nfds_t nfds = sizeClosureTable(&iomgr->aiop_table) + 1;
#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1
- int res = ppoll(iomgr->full_poll_table, nfds, timeout_ns, NULL);
+ int res = ppoll(poll_table, nfds, timeout_ns, NULL);
debugTrace(DEBUG_iomanager,
"ppoll(nfds = %d, timeout.sec = %d, timeout.nsec = %d) = %d",
@@ -492,7 +517,7 @@ bool awaitCompletedTimeoutsOrIOPoll(CapIOManager *iomgr)
timeout_ns == NULL ? 0 : timeout_ns->tv_nsec,
res);
#else
- int res = poll(iomgr->full_poll_table, nfds, timeout_ms);
+ int res = poll(poll_table, nfds, timeout_ms);
debugTrace(DEBUG_iomanager,
"poll(nfds = %d, timeout_ms = %d) = %d",
@@ -565,7 +590,9 @@ static void reportPollError(int res, nfds_t nfds)
void interruptIOManagerPoll(CapIOManager *iomgr)
{
+#if defined(HAVE_PREEMPTION)
sendFdWakeup(iomgr->interrupt_fd_w);
+#endif
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/213060cec8eda703147e07fa46764d6…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/213060cec8eda703147e07fa46764d6…
You're receiving this email because of your account on gitlab.haskell.org.
1
0