- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/andreask/arm-ffi] 4 commits: arm64 ncg: The big subword truncation fix.
by Andreas Klebinger (＠AndreasK) 24 Aug '26

24 Aug '26

Andreas Klebinger pushed to branch wip/andreask/arm-ffi at Glasgow Haskell Compiler / GHC Commits: 69d5ca17 by Andreas Klebinger at 2026-08-24T13:21:00+00:00 arm64 ncg: The big subword truncation fix. A set of slightly related fixes to arm subword handling: Bitmask immediates: Don't produce overflowing assembly literals. There is still another bug here that causes us to miss some valid literals but we will fix that later. Improve subword truncation handling: We now use a small set of helpers to truncate `Register` values rather than truncating immediate `Reg` values which greatly simplifies the code structure. This fixes a great many bugs to do with sign/zero extending subwords or the lack thereof. We now establish the invariant that subword values are zero-extended at every site at which they come into "scope" of the ncg, and rely on the invariant throughout rather than pessimistically inserting redundant extensions in a hodgepodge manner at the use sites of these values. This fixes at least the bugs described in issues #27533, #27430 #27537, #27538, #27539, and #27550. But likely more bugs yet not found. Subword ffi results: Apply truncations when calling functions returning subword values. genCondJump: Don't sign extend signed values in the input register as it might map to a local variable, corrupting the value stored within. Fix subword store/load instructions.: We used to read those at 32bit width even for smaller values possibly resulting in invalid memory access. Now we construct the suffix for subword variants based on the instruction format for these. - - - - - e996a6de by Andreas Klebinger at 2026-08-24T13:21:03+00:00 arm64 ncg: Fix MO_V_Broadcast for non-literals. We now use OpReg instead of OpScalarAsVec as required since we broadcast a gp register. Also adds a test. Fixes #27565. - - - - - 4dd69a45 by Andreas Klebinger at 2026-08-24T13:21:03+00:00 Add some test cases covering bugs in the arm ncg. * Test for #27430 (subword ffi results) * #27537 - subword conversions * #27538 - subwords used in conditional * #27533 - single byte read - - - - - 746a43e3 by Andreas Klebinger at 2026-08-24T13:21:03+00:00 cmmLint: Lint against MO_FS_Truncate subword use. - - - - - 26 changed files: - + changelog.d/arm_ncg_fixes_T27430 - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - testsuite/tests/cmm/should_compile/Makefile - + testsuite/tests/cmm/should_compile/T27368-ppr-debug.stderr - − testsuite/tests/cmm/should_compile/T27368-ppr-debug.stdout - testsuite/tests/cmm/should_compile/all.T - + testsuite/tests/codeGen/should_run/T27430.hs - + testsuite/tests/codeGen/should_run/T27430.stdout - + testsuite/tests/codeGen/should_run/T27430_c.c - + testsuite/tests/codeGen/should_run/T27533.hs - + testsuite/tests/codeGen/should_run/T27533.stdout - + testsuite/tests/codeGen/should_run/T27533_cmm.cmm - + testsuite/tests/codeGen/should_run/T27537.hs - + testsuite/tests/codeGen/should_run/T27537.stdout - + testsuite/tests/codeGen/should_run/T27538.hs - + testsuite/tests/codeGen/should_run/T27538.stdout - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/simd/should_run/T27565.hs - + testsuite/tests/simd/should_run/T27565.stdout - testsuite/tests/simd/should_run/all.T Changes: ===================================== changelog.d/arm_ncg_fixes_T27430 ===================================== @@ -0,0 +1,18 @@ +section: compiler +issues: #27430 #27539 #27538 #27537 #27550 #27565 #27533 +mrs: !16255 +synopsis: + A series of fixes to the ARM64 ncg, related to handling of primitive + 8/16bit types and simd. +description: + A series of related fixes to the ncg fixing: + + Fixed sign extension for subword values returned from unsafe ffi calls. + Clarify and lint for invalid conversions of int8/int16 -> float/double conversions. + Fix incorrect clobbering of local variables when comparing signed subword values. + Fix incorrect use of 32bit reads/stores for 8/16bit wide reads/stores. + Fix zero extension on function entry if arguments are passed at word-width + but used at subword-widths. + Fix broadcast# for non-literal arguments (arm64 only). + Fix rare assembler errors caused by overflowing literals, by properly checking + whether a constant is a viable immediate argument. ===================================== compiler/GHC/Cmm/Expr.hs ===================================== @@ -445,8 +445,8 @@ pprExpr platform e -- | `op` usually, but `(op[width])` with -dppr-debug withDebugWidth :: Width -> SDoc -> SDoc -withDebugWidth w exp = - ifPprDebug (parens (exp <> brackets (ppr w))) exp +withDebugWidth w doc = + ifPprDebug (parens (doc <> brackets (ppr w))) doc -- Here's the precedence table from GHC.Cmm.Parser: -- %nonassoc '>=' '>' '<=' '<' '!=' '==' ===================================== compiler/GHC/Cmm/Lint.hs ===================================== @@ -113,7 +113,7 @@ lintCmmExpr expr = do platform <- getPlatform return (cmmExprType platform expr) --- We require every address to refer to be word-width since we don't support 32 +-- We require every address value to be word-sized since we don't support 32 -- bit pointers on 64bit platforms. lintAddrTy :: CmmExpr -> CmmType -> CmmLint () lintAddrTy e addr_ty = do ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -142,8 +142,8 @@ data MachOp -- Conversions. Some of these will be NOPs. -- Floating-point conversions use the signed variant. - | MO_SF_Round Width Width -- Signed int -> Float - | MO_FS_Truncate Width Width -- Float -> Signed int + | MO_SF_Round Width Width -- Signed int -> Float, but only W32/W64 inputs + | MO_FS_Truncate Width Width -- Float -> Signed int, only W32/W64 on the int side. | MO_SS_Conv Width Width -- Signed int -> Signed int | MO_UU_Conv Width Width -- unsigned int -> unsigned int | MO_XX_Conv Width Width -- int -> int; puts no requirements on the @@ -623,7 +623,9 @@ machOpArgReps platform op = MO_XX_Conv from _ -> Just [from] -- Only supports W32/W64 MO_SF_Round from _w -> onlyW32W64 from - MO_FS_Truncate from _ -> onlyW32W64 from + MO_FS_Truncate from to + | to `notElem` [W32, W64] -> Nothing + | otherwise -> onlyW32W64 from MO_FF_Conv from _ -> onlyW32W64 from MO_WF_Bitcast w -> onlyW32W64 w MO_FW_Bitcast w -> onlyW32W64 w ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -746,7 +746,7 @@ stmt :: { CmmParse () } | '(' formals ')' '=' 'call' expr '(' exprs0 ')' ';' { doCall $6 $2 $8 } -- NB: bool_expr most be a *boolean* expression: A comparison machOp or 1/0 word literals. - -- We don't allow arbitrary expressions as conditions (See checkCond, #27543). + -- We don't allow arbitrary expressions as conditions (See GHC.Cmm.Lint.checkCond:checkCond, #27543). | 'if' bool_expr cond_likely 'goto' NAME { do l <- lookupLabel $5; cmmRawIf $2 l $3 } | 'if' bool_expr cond_likely '{' body '}' else ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -356,13 +356,10 @@ type InstrBlock -- data Register = Fixed Format Reg InstrBlock + -- ^ It can be unsafe to clobber the result reg, as it might map to a + -- local variable. | Any Format (Reg -> InstrBlock) - --- | Sometimes we need to change the Format of a register. Primarily during --- conversion. -swizzleRegisterRep :: Format -> Register -> Register -swizzleRegisterRep format (Fixed _ reg code) = Fixed format reg code -swizzleRegisterRep format (Any _ codefn) = Any format codefn + -- ^ A destination the caller decides, prevents redundant moves -- | Grab the Reg for a CmmReg getRegisterReg :: Platform -> CmmReg -> Reg @@ -370,8 +367,9 @@ getRegisterReg :: Platform -> CmmReg -> Reg getRegisterReg _ (CmmLocal (LocalReg u pk)) = RegVirtual $ mkVirtualReg u (cmmTypeFormat pk) -getRegisterReg platform (CmmGlobal reg@(GlobalRegUse mid _)) - = case globalRegMaybe platform mid of +getRegisterReg platform (CmmGlobal reg@(GlobalRegUse mid ty)) + = assert (formatInBytes (cmmTypeFormat ty) >= 4) $ + case globalRegMaybe platform mid of Just reg -> RegReal reg Nothing -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal reg) -- By this stage, the only MagicIds remaining should be the @@ -382,11 +380,17 @@ getRegisterReg platform (CmmGlobal reg@(GlobalRegUse mid _)) -- ----------------------------------------------------------------------------- -- General things for putting together code sequences --- | The dual to getAnyReg: compute an expression into a register, but --- we don't mind which one it is. +-- | Computes the `Register` value into a concrete register, but we can't pick which one. +-- This means the register might be mapped to a global or local variable and +-- we can only mutate the result reg in place if we know the Cmm expression can't +-- refer to local or global variables. getSomeReg :: CmmExpr -> NatM (Reg, Format, InstrBlock) getSomeReg expr = do r <- getRegister expr + someReg r + +someReg :: Register -> NatM (Reg, Format, InstrBlock) +someReg r = case r of Any rep code -> do tmp <- getNewRegNat rep @@ -647,28 +651,38 @@ opRegWidth W16 = W32 -- w opRegWidth W8 = W32 -- w opRegWidth w = pprPanic "opRegWidth" (text "Unsupported width" <+> ppr w) --- Note [Signed arithmetic on AArch64] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Handling signed arithmetic on sub-word-size values on AArch64 is a bit --- tricky as Cmm's type system does not capture signedness. While 32-bit values --- are fairly easy to handle due to AArch64's 32-bit instruction variants --- (denoted by use of %wN registers), 16- and 8-bit values require quite some --- care. +-- Note [Subword operations on AArch64] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Handling subword operations on AArch64 is a bit tricky. 32-bit values are fairly +-- easy to handle due to AArch64's 32-bit instruction variants. 16- and 8-bit +-- values require quite some care. The platform doesn't provide operations at +-- widths below 32bit. Which means we have to simulate them using wider operations. +-- Signed arithmetic on sub-word-size values on AArch64 is a bit tricky as Cmm's +-- type system does not capture signedness. If we have a 8 bit value the high +-- bits could be sign or zero extended with no easy way to tell. -- --- We handle 16-and 8-bit values by using the 32-bit operations and +-- To work around this handle 16-and 8-bit values by using the 32-bit operations and -- sign-/zero-extending operands and truncate results as necessary. For -- simplicity we maintain the invariant that a register containing a -- sub-word-size value always contains the zero-extended form of that value -- in between operations. -- --- IMPORTANT: this invariant only holds within a single expression tree as --- generated by the NCG (via truncateReg after each sub-word operation). It --- does NOT hold at function entry points or across basic block boundaries, --- because the GHC calling convention does not guarantee that callers --- zero-extend sub-word arguments. Therefore, any operation that is sensitive --- to the upper bits of its input (e.g. unsigned right shift, unsigned --- division) must explicitly zero- or sign-extend its operands rather than --- assuming they are already extended. +-- Concretely we establish this invariant on every input into the function for which +-- we generate code for in the NCG. This means: +-- * Global STG register access +-- * memory reads +-- * function arguments +-- * ffi results +-- * function call results +-- * results from any subexpression +-- +-- This means we can assume the invariant when generated code for expression trees +-- or machops reading local variables, avoiding (some) redundant extensions. But +-- we have to take great care to uphold the invariant when computing new values. +-- +-- We used to do the inverse. Re-establish the invariant for any operation that +-- is sensitive to values in the high bits. But that turned out to produce worse +-- code and wasn't any less likely to result in new bugs in practice. -- -- For instance, consider the program, -- @@ -688,7 +702,10 @@ opRegWidth w = pprPanic "opRegWidth" (text "Unsupported width" <+> ppr w) -- Next we compute `c`: The `%not` requires no extension of its operands, but -- we must still truncate the result back down to 8-bits. Finally the `%shrl` -- requires no extension and no truncate since we can assume that --- `c` is zero-extended (it was produced by a truncateReg in the same block). +-- `c` is zero-extended. +-- +-- Down the line I think the right way to approach this is to operate more over +-- the `Register` type and store sign extension information inside it. -- -- TODO: -- Don't use Width in Operands @@ -925,20 +942,36 @@ getRegister' config plat expr getRegister (CmmLoad e (cmmBits w) NaturallyAligned) CmmMachOp op [e] -> do - (reg, _format, code) <- getSomeReg e + register <- getRegister e + (reg, _format, code) <- someReg register case op of - MO_Not w -> return $ Any (intFormat w) $ \dst -> + -- XX Conversion + -- truncateSubwordRegister: See Note [Subword operations on AArch64]. + MO_XX_Conv from to + | to >= from -> pure $ swizzleRegisterRep register (intFormat to) + | otherwise -> pure $ truncateSubwordRegister to register + + -- truncateSubwordRegister: See Note [Subword operations on AArch64]. + MO_Not w -> return $ truncateSubwordRegister w $ Any (intFormat w) $ \dst -> let w' = opRegWidth w in code `snocOL` - MVN (OpReg w' dst) (OpReg w' reg) `appOL` - truncateReg w' w dst -- See Note [Signed arithmetic on AArch64] + MVN (OpReg w' dst) (OpReg w' reg) + + -- truncateSubwordRegister: See Note [Subword operations on AArch64]. + MO_S_Neg w -> truncateSubwordRegister w <$> do + let op_w = opRegWidth w + (src, _fmt, reg_code) <- someReg $ signExtendRegister w op_w register + pure $ Any (intFormat w) $ \dst -> reg_code `snocOL` (NEG (intFormat w) (OpReg op_w dst) (OpReg op_w src)) - MO_S_Neg w -> negate code w reg MO_F_Neg w -> return $ Any fmt (\dst -> code `snocOL` NEG fmt (OpReg w dst) (OpReg w reg)) where fmt = floatFormat w - MO_SF_Round from to -> return $ Any (floatFormat to) (\dst -> code `snocOL` SCVTF (OpReg to dst) (OpReg from reg)) -- (Signed ConVerT Float) - MO_FS_Truncate from to -> return $ Any (intFormat to) (\dst -> code `snocOL` FCVTZS (OpReg to dst) (OpReg from reg)) -- (float convert (-> zero) signed) + MO_SF_Round from to -> + massert (from >= W32) >> + return $ Any (floatFormat to) (\dst -> code `snocOL` SCVTF (OpReg to dst) (OpReg from reg)) -- (Signed ConVerT Float) + MO_FS_Truncate from to -> + massert (to >= W32) >> + return $ Any (intFormat to) (\dst -> code `snocOL` FCVTZS (OpReg to dst) (OpReg from reg)) -- (float convert (-> zero) signed) -- TODO this is very hacky -- Note, UBFM and SBFM expect source and target register to be of the same size, so we'll use @max from to@ @@ -951,11 +984,8 @@ getRegister' config plat expr MO_FW_Bitcast w -> return $ Any fmt (\dst -> code `snocOL` FMOV fmt (OpReg w dst) (OpReg w reg)) where fmt = intFormat w - -- Conversions - MO_XX_Conv _from to -> swizzleRegisterRep (intFormat to) <$> getRegister e - -- Vector - MO_V_Broadcast l w -> return $ Any fmt (\dst -> code `snocOL` DUP fmt (OpReg vw dst) (OpScalarAsVec w reg)) + MO_V_Broadcast l w -> return $ Any fmt (\dst -> code `snocOL` DUP fmt (OpReg vw dst) (OpReg w reg)) where fmt = VecFormat l (intScalarFormat w) vw = formatToWidth fmt MO_VF_Broadcast l w -> return $ Any fmt (\dst -> code `snocOL` DUP fmt (OpReg vw dst) (OpScalarAsVec w reg)) @@ -1054,26 +1084,13 @@ getRegister' config plat expr toImm W256 = (OpImm (ImmInt 255)) toImm W512 = (OpImm (ImmInt 511)) - -- In the case of 16- or 8-bit values we need to sign-extend to 32-bits - -- See Note [Signed arithmetic on AArch64]. - negate code w reg = do - let w' = opRegWidth w - fmt = intFormat w - (reg', code_sx) <- signExtendReg w w' reg - return $ Any fmt $ \dst -> - code `appOL` - code_sx `snocOL` - NEG fmt (OpReg w' dst) (OpReg w' reg') `appOL` - truncateReg w' w dst - ss_conv from to reg code = let w' = opRegWidth (max from to) - in return $ Any (intFormat to) $ \dst -> - code `snocOL` - SBFM (OpReg w' dst) (OpReg w' reg) (OpImm (ImmInt 0)) (toImm (min from to)) `appOL` - -- At this point an 8- or 16-bit value would be sign-extended + in return $ truncateSubwordRegister to $ Any (intFormat to) $ \dst -> + code `snocOL` + SBFM (OpReg w' dst) (OpReg w' reg) (OpImm (ImmInt 0)) (toImm (min from to)) + -- At this point an 8- or 16-bit value is sign-extended -- to 32-bits. Truncate back down the final width. - truncateReg w' to dst -- Dyadic machops: -- @@ -1090,26 +1107,14 @@ getRegister' config plat expr CmmMachOp (MO_Sub _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr' -- Immediates are handled via `getArithImm` in the generic code path. - CmmMachOp (MO_U_Quot w) [x, y] | w == W8 -> do + CmmMachOp (MO_U_Quot w) [x, y] | w == W8 || w == W16-> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - tmp_x <- getNewRegNat (intFormat w) - tmp_y <- getNewRegNat (intFormat w) - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w tmp_x) (OpReg w reg_x)) `snocOL` - (UXTB (OpReg w tmp_y) (OpReg w reg_y)) `snocOL` - (UDIV (OpReg w dst) (OpReg w tmp_x) (OpReg w tmp_y))) - CmmMachOp (MO_U_Quot w) [x, y] | w == W16 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - tmp_x <- getNewRegNat (intFormat w) - tmp_y <- getNewRegNat (intFormat w) - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w tmp_x) (OpReg w reg_x)) `snocOL` - (UXTH (OpReg w tmp_y) (OpReg w reg_y)) `snocOL` - (UDIV (OpReg w dst) (OpReg w tmp_x) (OpReg w tmp_y))) + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) -- 2. Shifts. x << n, x >> n. -- Sub-word left shifts by a constant: use UBFM (UBFIZ alias) to shift - -- and mask in a single instruction. See Note [Signed arithmetic on AArch64]. + -- and mask in a single instruction. See Note [Subword operations on AArch64]. CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (UBFM (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger ((32 - n) `mod` 32))) (OpImm (ImmInteger (7 - n))))) @@ -1126,7 +1131,7 @@ getRegister' config plat expr CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (8-n)))) - `snocOL` (UXTB (OpReg w dst) (OpReg w dst))) -- See Note [Signed arithmetic on AArch64] + `snocOL` (UXTB (OpReg w dst) (OpReg w dst))) -- See Note [Subword operations on AArch64] CmmMachOp (MO_S_Shr w) [x, y] | w == W8 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y @@ -1135,12 +1140,12 @@ getRegister' config plat expr tmp <- getNewRegNat (intFormat w) return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTB (OpReg w tmp) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w tmp) (OpReg w reg_y)) `snocOL` - (UXTB (OpReg w dst) (OpReg w dst))) -- See Note [Signed arithmetic on AArch64] + (UXTB (OpReg w dst) (OpReg w dst))) -- See Note [Subword operations on AArch64] CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (16-n)))) - `snocOL` (UXTH (OpReg w dst) (OpReg w dst))) -- See Note [Signed arithmetic on AArch64] + `snocOL` (UXTH (OpReg w dst) (OpReg w dst))) -- See Note [Subword operations on AArch64] CmmMachOp (MO_S_Shr w) [x, y] | w == W16 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y @@ -1149,7 +1154,7 @@ getRegister' config plat expr tmp <- getNewRegNat (intFormat w) return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTH (OpReg w tmp) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w tmp) (OpReg w reg_y)) `snocOL` - (UXTH (OpReg w dst) (OpReg w dst))) -- See Note [Signed arithmetic on AArch64] + (UXTH (OpReg w dst) (OpReg w dst))) -- See Note [Subword operations on AArch64] CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W32 || w == W64 @@ -1182,14 +1187,14 @@ getRegister' config plat expr return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) -- 3. Logic &&, || - CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (opRegWidth w') (fromIntegral n) -> - return $ Any fmt (\d -> unitOL $ annExpr expr (AND fmt (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) + CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | Just op_bitmask <- getBitmaskImm n w -> + return $ Any fmt (\d -> unitOL $ annExpr expr (AND fmt (OpReg w d) (OpReg w' r') op_bitmask)) where fmt = intFormat w w' = formatToWidth (cmmTypeFormat (cmmRegType reg)) r' = getRegisterReg plat reg - CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (opRegWidth w') (fromIntegral n) -> - return $ Any fmt (\d -> unitOL $ annExpr expr (ORR fmt (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) + CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | Just op_bitmask <- getBitmaskImm n w -> + return $ Any fmt (\d -> unitOL $ annExpr expr (ORR fmt (OpReg w d) (OpReg w' r') op_bitmask)) where fmt = intFormat w w' = formatToWidth (cmmTypeFormat (cmmRegType reg)) r' = getRegisterReg plat reg @@ -1220,16 +1225,17 @@ getRegister' config plat expr code_y `appOL` op (OpReg w dst) (OpReg w reg_x) op_y) - -- A (potentially signed) integer operation. + -- A (potentially signed) integer operation that can have immediate arguments. -- In the case of 8- and 16-bit signed arithmetic we must first -- sign-extend both arguments to 32-bits. - -- See Note [Signed arithmetic on AArch64]. - intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Width -> Maybe Operand) -> NatM (Register) - intOpImm {- is signed -} True w op _encode_imm = intOp True w op - intOpImm False w op encode_imm = do + -- See Note [Subword operations on AArch64]. + intOpImm :: Bool -> SetsHighBits -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Width -> Maybe Operand) -> NatM (Register) + intOpImm {- is signed -} True trunc w op _encode_imm = intOp True trunc w op + intOpImm False trunc w op encode_imm = maintainHighBits trunc w <$> do -- compute x<m> <- x -- compute x<o> <- y -- <OP> x<n>, x<m>, x<o> + let w' = opRegWidth w (reg_x, format_x, code_x) <- getSomeReg x (op_y, format_y, code_y) <- case y of CmmLit (CmmInt n w) @@ -1241,40 +1247,29 @@ getRegister' config plat expr massertPpr (isIntFormat format_x && isIntFormat format_y) $ text "intOp: non-int" -- This is the width of the registers on which the operation -- should be performed. - let w' = opRegWidth w return $ Any (intFormat w) $ \dst -> code_x `appOL` code_y `appOL` - op (OpReg w' dst) (OpReg w' reg_x) (op_y) `appOL` - truncateReg w' w dst -- truncate back to the operand's original width + op (OpReg w' dst) (OpReg w' reg_x) (op_y) -- A (potentially signed) integer operation. -- In the case of 8- and 16-bit signed arithmetic we must first -- sign-extend both arguments to 32-bits. - -- See Note [Signed arithmetic on AArch64]. - intOp is_signed w op = do + -- See Note [Subword operations on AArch64]. + intOp is_signed clean_highbits w op = maintainHighBits clean_highbits w <$> do -- compute x<m> <- x -- compute x<o> <- y -- <OP> x<n>, x<m>, x<o> - (reg_x, format_x, code_x) <- getSomeReg x - (reg_y, format_y, code_y) <- getSomeReg y + let op_w = opRegWidth w + let setHighBits = if is_signed then signExtendRegister w (opRegWidth w) else id + (reg_x_sx, format_x, code_x) <- someReg =<< setHighBits <$> getRegister x + (reg_y_sx, format_y, code_y) <- someReg =<< setHighBits <$> getRegister y massertPpr (isIntFormat format_x && isIntFormat format_y) $ text "intOp: non-int" - -- This is the width of the registers on which the operation - -- should be performed. - let w' = opRegWidth w - signExt r - | not is_signed = return (r, nilOL) - | otherwise = signExtendReg w w' r - (reg_x_sx, code_x_sx) <- signExt reg_x - (reg_y_sx, code_y_sx) <- signExt reg_y + return $ Any (intFormat w) $ \dst -> code_x `appOL` code_y `appOL` - -- sign-extend both operands - code_x_sx `appOL` - code_y_sx `appOL` - op (OpReg w' dst) (OpReg w' reg_x_sx) (OpReg w' reg_y_sx) `appOL` - truncateReg w' w dst -- truncate back to the operand's original width + op (OpReg op_w dst) (OpReg op_w reg_x_sx) (OpReg op_w reg_y_sx) floatOp w op = do (reg_fx, format_x, code_fx) <- getFloatReg x @@ -1465,9 +1460,9 @@ getRegister' config plat expr case op of -- Integer operations -- Add/Sub should only be Integer Options. - MO_Add w -> intOpImm False w (\d x y -> unitOL $ annExpr expr (ADD (intFormat w) d x y)) getArithImm + MO_Add w -> intOpImm False UnknownHighBits w (\d x y -> unitOL $ annExpr expr (ADD (intFormat w) d x y)) getArithImm -- TODO: Handle sub-word case - MO_Sub w -> intOpImm False w (\d x y -> unitOL $ annExpr expr (SUB (intFormat w) d x y)) getArithImm + MO_Sub w -> intOpImm False UnknownHighBits w (\d x y -> unitOL $ annExpr expr (SUB (intFormat w) d x y)) getArithImm -- Note [CSET] -- ~~~~~~~~~~~ @@ -1513,9 +1508,9 @@ getRegister' config plat expr MO_Ne w -> bitOpImm w (\d x y -> toOL [ CMP x y, CSET d NE ]) getArithImm -- Signed multiply/divide - MO_Mul w -> intOp True w (\d x y -> unitOL $ MUL (intFormat w) d x y) + MO_Mul w -> intOp True UnknownHighBits w (\d x y -> unitOL $ MUL (intFormat w) d x y) MO_S_MulMayOflo w -> do_mul_may_oflo w x y - MO_S_Quot w -> intOp True w (\d x y -> unitOL $ SDIV (intFormat w) d x y) + MO_S_Quot w -> intOp True UnknownHighBits w (\d x y -> unitOL $ SDIV (intFormat w) d x y) -- No native rem instruction. So we'll compute the following -- Rd <- Rx / Ry | 2 <- 7 / 3 -- SDIV Rd Rx Ry @@ -1525,24 +1520,24 @@ getRegister' config plat expr -- '--------------------------' -- Note the swap in Rx and Ry. MO_S_Rem w -> withTempIntReg w $ \t -> - intOp True w (\d x y -> toOL [ SDIV (intFormat w) t x y, MSUB d t y x ]) + intOp True UnknownHighBits w (\d x y -> toOL [ SDIV (intFormat w) t x y, MSUB d t y x ]) -- Unsigned multiply/divide - MO_U_Quot w -> intOp False w (\d x y -> unitOL $ UDIV d x y) + MO_U_Quot w -> intOp False CleanHighBits w (\d x y -> unitOL $ UDIV d x y) MO_U_Rem w -> withTempIntReg w $ \t -> - intOp False w (\d x y -> toOL [ UDIV t x y, MSUB d t y x ]) + intOp False CleanHighBits w (\d x y -> toOL [ UDIV t x y, MSUB d t y x ]) -- Signed comparisons -- see Note [CSET] - MO_S_Ge w -> intOp True w (\d x y -> toOL [ CMP x y, CSET d SGE ]) - MO_S_Le w -> intOp True w (\d x y -> toOL [ CMP x y, CSET d SLE ]) - MO_S_Gt w -> intOp True w (\d x y -> toOL [ CMP x y, CSET d SGT ]) - MO_S_Lt w -> intOp True w (\d x y -> toOL [ CMP x y, CSET d SLT ]) + MO_S_Ge w -> intOp True CleanHighBits w (\d x y -> toOL [ CMP x y, CSET d SGE ]) + MO_S_Le w -> intOp True CleanHighBits w (\d x y -> toOL [ CMP x y, CSET d SLE ]) + MO_S_Gt w -> intOp True CleanHighBits w (\d x y -> toOL [ CMP x y, CSET d SGT ]) + MO_S_Lt w -> intOp True CleanHighBits w (\d x y -> toOL [ CMP x y, CSET d SLT ]) -- Unsigned comparisons - MO_U_Ge w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d UGE ]) getArithImm - MO_U_Le w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d ULE ]) getArithImm - MO_U_Gt w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d UGT ]) getArithImm - MO_U_Lt w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d ULT ]) getArithImm + MO_U_Ge w -> intOpImm False CleanHighBits w (\d x y -> toOL [ CMP x y, CSET d UGE ]) getArithImm + MO_U_Le w -> intOpImm False CleanHighBits w (\d x y -> toOL [ CMP x y, CSET d ULE ]) getArithImm + MO_U_Gt w -> intOpImm False CleanHighBits w (\d x y -> toOL [ CMP x y, CSET d UGT ]) getArithImm + MO_U_Lt w -> intOpImm False CleanHighBits w (\d x y -> toOL [ CMP x y, CSET d ULT ]) getArithImm -- Floating point arithmetic MO_F_Add w -> floatOp w (\d x y -> unitOL $ ADD (floatFormat w) d x y) @@ -1570,9 +1565,9 @@ getRegister' config plat expr MO_And w -> bitOpImm w (\d x y -> unitOL $ AND (intFormat w) d x y) getBitmaskImm MO_Or w -> bitOpImm w (\d x y -> unitOL $ ORR (intFormat w) d x y) getBitmaskImm MO_Xor w -> bitOpImm w (\d x y -> unitOL $ EOR (intFormat w) d x y) getBitmaskImm - MO_Shl w -> intOp False w (\d x y -> unitOL $ LSL d x y) - MO_U_Shr w -> intOp False w (\d x y -> unitOL $ LSR d x y) - MO_S_Shr w -> intOp True w (\d x y -> unitOL $ ASR d x y) + MO_Shl w -> intOp False UnknownHighBits w (\d x y -> unitOL $ LSL d x y) + MO_U_Shr w -> intOp False CleanHighBits w (\d x y -> unitOL $ LSR d x y) + MO_S_Shr w -> intOp True UnknownHighBits w (\d x y -> unitOL $ ASR d x y) -- Vector operations MO_V_Add l w -> intVecOp l w (\fmt d x y -> unitOL $ ADD fmt d x y) @@ -1630,7 +1625,7 @@ getRegister' config plat expr _ -> pprPanic "Unsupported offset" (pdoc platform y) (reg_x, format_x, code_x) <- getSomeReg x massertPpr (isVecFormat format_x) $ text "MO_V_Extract: non-vector" - -- Always use UMOV. See Note [Signed arithmetic on AArch64] + -- Always use UMOV. See Note [Subword operations on AArch64] return $ Any format (\dst -> code_x `snocOL` UMOV (OpReg w dst) (OpVecLane w reg_x index)) MO_VF_Extract l w -> do @@ -1759,7 +1754,7 @@ getRegister' config plat expr tmp <- getNewRegNat format return $ Any format $ \dst -> code_x `appOL` code_y `appOL` - if dst == reg_y + if dst == reg_y --unlike MO_V_Insert here y/dst can overlap. then toOL [ MOV (OpReg W128 tmp) (OpReg W128 reg_x) , INS format (OpVecLane w tmp index) (OpScalarAsVec w reg_y) , MOV (OpReg W128 dst) (OpReg W128 tmp) @@ -1886,36 +1881,87 @@ isAArch64Bitmask width n = hasOneRun m = 64 == popCount m + countLeadingZeros m + countTrailingZeros m +-------------------------------------------------------------------------------- +-- Helpers to help enforcing Note [Subword operations on AArch64] +-------------------------------------------------------------------------------- + -- | Instructions to sign-extend the value in the given register from width @w@ -- up to width @w'@. -signExtendReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr) -signExtendReg w w' r = - case w of - W64 -> noop - W32 - | w' == W32 -> noop - | otherwise -> extend SXTW - W16 -> extend SXTH - W8 -> extend SXTB - _ -> panic "intOp" +signExtendInstr :: Width -> Width -> Reg -> Maybe (Reg -> Instr) +signExtendInstr w w' r = + case (w,w') of + (W64,_) -> Nothing + (W32,W32) -> Nothing + (W32,_) -> extend SXTW + (W16,_) -> extend SXTH + (W8 ,_) -> extend SXTB + _ -> panic "signExtendInstr:unexpectedWidth" + where + extend instr = Just $ \r' -> instr (OpReg w' r') (OpReg w r) + +-- | Sign extend the register if needed, otherwise use register as-is +signExtendRegister :: Width -> Width -> Register -> Register +signExtendRegister w w' register = case register of + Fixed _fmt reg code -> + maybe register + (\instr_ext -> Any (intFormat w') (\dst -> code `snocOL` instr_ext dst) ) + (signExtendInstr w w' reg) + Any _fmt code -> + Any (intFormat w') $ \dst -> + maybe (code dst) + (\instr_ext -> code dst `snocOL` instr_ext dst) + (signExtendInstr w w' dst) + +truncSubwordRegInstr :: Width -> Reg -> Maybe (Reg -> Instr) +truncSubwordRegInstr w_to r = + case w_to of + -- Asserted false, but be defensive for non-debug builds. + W64 -> Nothing + W32 -> Nothing + + -- Actual truncation + W16 -> trunc W32 UXTH + W8 -> trunc W32 UXTB + _ -> panic "truncateSubwordReg:unexpectedWidth" where - noop = return (r, nilOL) - extend instr = do - r' <- getNewRegNat (intFormat w') - return (r', unitOL $ instr (OpReg w' r') (OpReg w r)) - --- | Instructions to truncate the value in the given register from width @w@ --- down to width @w'@. -truncateReg :: Width -> Width -> Reg -> OrdList Instr -truncateReg w w' r = - case w of + trunc w instr = do + Just $ \r' -> instr (OpReg w r') (OpReg w r) + +-- | Like @truncateSubwordRegister@, but modifes the given argument register in place if we +-- need to truncate. +truncateSubwordRegInplace :: Width -> Reg -> OrdList Instr +truncateSubwordRegInplace w_to r = do + case w_to of W64 -> nilOL - W32 - | w' == W32 -> nilOL - _ -> unitOL $ UBFM (OpReg w r) - (OpReg w r) - (OpImm (ImmInt 0)) - (OpImm $ ImmInt $ widthInBits w' - 1) + W32 -> nilOL + W16 -> trunc UXTH + W8 -> trunc UXTB + _ -> panic "truncateSubwordRegInplace:unexpectedWidth" + where + trunc instr = do + unitOL $ instr (OpReg W32 r) (OpReg W32 r) + +-- | Zeros the high words of the value represented by Register if needed according to +-- Note [Subword operations on AArch64] +truncateSubwordRegister :: Width -> Register -> Register +truncateSubwordRegister w register = case register of + Fixed _fmt reg code -> + maybe (swizzleRegisterRep register (intFormat w)) + (\r_instr -> Any (intFormat w) (\dst -> code `snocOL` r_instr dst)) + (truncSubwordRegInstr w reg) + Any _fmt code -> Any (intFormat w) $ \dst -> + maybe (code dst) (\r_inst -> code dst `snocOL` r_inst dst) (truncSubwordRegInstr w dst) + +data SetsHighBits = UnknownHighBits | CleanHighBits + +maintainHighBits :: SetsHighBits -> Width -> Register -> Register +maintainHighBits CleanHighBits _w x = x +maintainHighBits UnknownHighBits w x = truncateSubwordRegister w x + +-- Reinterpret the value in the register as different format. +swizzleRegisterRep :: Register -> Format -> Register +swizzleRegisterRep (Fixed _ reg code) format = Fixed format reg code +swizzleRegisterRep (Any _ codefn) format = Any format codefn -- ----------------------------------------------------------------------------- -- The 'Amode' type: Memory addressing modes passed up the tree. @@ -2038,27 +2084,24 @@ genCondJump bid expr = do -- Generic case. CmmMachOp mop [x, y] -> do - let ubcond w cmp = do - -- compute both sides. - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - let x' = OpReg w reg_x - y' = OpReg w reg_y - return $ case w of - W8 -> code_x `appOL` code_y `appOL` toOL [ UXTB x' x', UXTB y' y', CMP x' y', (annExpr expr (BCOND cmp (TBlock bid))) ] - W16 -> code_x `appOL` code_y `appOL` toOL [ UXTH x' x', UXTH y' y', CMP x' y', (annExpr expr (BCOND cmp (TBlock bid))) ] - _ -> code_x `appOL` code_y `appOL` toOL [ CMP x' y', (annExpr expr (BCOND cmp (TBlock bid))) ] - - sbcond w cmp = do - -- compute both sides. - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y + let icond is_signed w cmp = do + -- zero or sign extend the argument register(s) + let extend reg = + if is_signed + then someReg $ signExtendRegister w (opRegWidth w) reg + else someReg reg + + (reg_x, _format_x, code_x) <- extend =<< getRegister x + (reg_y, _format_y, code_y) <- extend =<< getRegister y + let x' = OpReg w reg_x y' = OpReg w reg_y - return $ case w of - W8 -> code_x `appOL` code_y `appOL` toOL [ SXTB x' x', SXTB y' y', CMP x' y', (annExpr expr (BCOND cmp (TBlock bid))) ] - W16 -> code_x `appOL` code_y `appOL` toOL [ SXTH x' x', SXTH y' y', CMP x' y', (annExpr expr (BCOND cmp (TBlock bid))) ] - _ -> code_x `appOL` code_y `appOL` toOL [ CMP x' y', (annExpr expr (BCOND cmp (TBlock bid))) ] + + return $ concatOL [code_x, code_y, + toOL [CMP x' y', (annExpr expr (BCOND cmp (TBlock bid)))]] + + let ubcond w cmp = icond False w cmp + sbcond w cmp = icond True w cmp fbcond w cmp = do -- ensure we get float regs @@ -2327,32 +2370,27 @@ genCCall target dest_regs arg_regs = do , [src_a, src_b] <- arg_regs , [dst_needed, dst_hi, dst_lo] <- dest_regs -> do - (reg_a', _format_x, code_a) <- getSomeReg src_a - (reg_b', _format_y, code_b) <- getSomeReg src_b + -- Sign-extend inputs to W32 for SMULL (Xd = Wn * Wm). + -- sign extension always allocates a fresh temp for w < W32, + -- and is a noop for W32 (safe: SMULL reads both sources + -- atomically before writing the destination). + (reg_a, _format_x, code_a) <- someReg =<< signExtendRegister w W32 <$> getRegister src_a + (reg_b, _format_y, code_b) <- someReg =<< signExtendRegister w W32 <$> getRegister src_b let lo = getRegisterReg platform (CmmLocal dst_lo) hi = getRegisterReg platform (CmmLocal dst_hi) nd = getRegisterReg platform (CmmLocal dst_needed) w' = platformWordWidth platform - -- Sign-extend inputs to W32 for SMULL (Xd = Wn * Wm). - -- signExtendReg always allocates a fresh temp for w < W32, - -- and is a noop for W32 (safe: SMULL reads both sources - -- atomically before writing the destination). - (reg_a, code_a') <- signExtendReg w W32 reg_a' - (reg_b, code_b') <- signExtendReg w W32 reg_b' - return $ code_a `appOL` - code_b `appOL` - code_a' `appOL` - code_b' `snocOL` + code_b `snocOL` -- SMULL Xd, Wn, Wm: multiply two W32 values producing a -- 64-bit result. The low w bits of lo contain the truncated -- product, and hi gets the overflow (sign extension bits). SMULL (OpReg w' lo) (OpReg W32 reg_a) (OpReg W32 reg_b) `snocOL` ASR (OpReg w' hi) (OpReg w' lo) (OpImm (ImmInt $ widthInBits w)) `appOL` - truncateReg w' w lo `snocOL` + truncateSubwordRegInplace w lo `snocOL` -- CMN (compare negative) tests hi + lo' == 0, i.e. hi == -lo'. -- lo' = LSR(lo, w-1) gives 1 if lo is negative, 0 if positive. -- No overflow iff hi is the sign extension of lo: @@ -2362,7 +2400,7 @@ genCCall target dest_regs arg_regs = do -- NE to set nd = 1 when overflow occurred. CMN (OpReg w' hi) (OpRegShift w' lo SLSR (widthInBits w - 1)) `snocOL` CSET (OpReg w' nd) NE `appOL` - truncateReg w' w hi + truncateSubwordRegInplace w hi -- Can't handle > 64 bit operands | otherwise -> unsupported (MO_S_Mul2 w) PrimTarget (MO_U_Mul2 w) @@ -2385,7 +2423,7 @@ genCCall target dest_regs arg_regs = do ) -- For sizes < platform width, we can just perform a multiply and shift -- Need to be careful to truncate the low half, but the upper half should be - -- be ok if the invariant in [Signed arithmetic on AArch64] is maintained. + -- be ok if the invariant in Note [Subword operations on AArch64] is maintained. -- Currently this case can't be produced by the compiler since -- timesWord2# :: Word# -> Word# -> (# Word#, Word# #) -- TODO: Remove? Or would the extra primop be useful for avoiding the extra @@ -2412,7 +2450,7 @@ genCCall target dest_regs arg_regs = do (OpImm (ImmInt $ widthInBits w)) -- lsb (OpImm (ImmInt $ widthInBits w)) -- width to extract `appOL` - truncateReg W64 w lo + truncateSubwordRegInplace w lo ) | otherwise -> unsupported (MO_U_Mul2 w) PrimTarget (MO_Clz w) @@ -2730,6 +2768,7 @@ genCCall target dest_regs arg_regs = do | [p_reg, val_reg] <- arg_regs -> do (p, _fmt_p, code_p) <- getSomeReg p_reg (val, fmt_val, code_val) <- getSomeReg val_reg + massert (fmt_val == intFormat w) let instr = case ord of MemOrderRelaxed -> STR _ -> STLR @@ -2845,6 +2884,7 @@ genCCall target dest_regs arg_regs = do W16 -> SXTH (OpReg W64 gpReg) (OpReg w r) _ -> panic "impossible" | otherwise + -- Relies on Note [Subword operations on AArch64] = MOV (OpReg w gpReg) (OpReg w r) accumCode' = accumCode `appOL` code_r `snocOL` @@ -2898,6 +2938,7 @@ genCCall target dest_regs arg_regs = do passArguments _ _ _ _ _ _ _ = pprPanic "passArguments" (text "invalid state") + -- readResults gpArgs fpArgs dest_regs reg_acc code_acc readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg]-> InstrBlock -> NatM (InstrBlock) readResults _ _ [] _ accumCode = return accumCode readResults [] _ _ _ _ = do @@ -2915,7 +2956,14 @@ genCCall target dest_regs arg_regs = do r_dst = getRegisterReg platform (CmmLocal dst) if isFloatFormat format || isVecFormat format then readResults (gpReg:gpRegs) fpRegs dsts (fpReg:accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w fpReg)) - else readResults gpRegs (fpReg:fpRegs) dsts (gpReg:accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w gpReg)) + else do + -- Needed, ffi calls can return garbage in high bits. + -- See Note [Subword operations on AArch64] + let !mov_instr = case w of + W8 -> UXTB + W16 -> UXTH + _ -> MOV + readResults gpRegs (fpReg:fpRegs) dsts (gpReg:accumRegs) (accumCode `snocOL` mov_instr (OpReg w r_dst) (OpReg w gpReg)) unaryFloatOp w op arg_reg dest_reg = do platform <- getPlatform ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -771,7 +771,8 @@ data Instr | MOVZ Operand Operand | MVN Operand Operand -- rd = ~rn | ORR Format Operand Operand Operand -- rd = rn | op2 - -- Load and stores. + -- Load and stores, we support subwords by picking the subword variant + -- based on the format. -- TODO STR/LDR might want to change to STP/LDP with XZR for the second register. | STR Format Operand Operand -- str Xn, address-mode // Xn -> *addr | STLR Format Operand Operand -- stlr Xn, address-mode // Xn -> *addr ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -569,12 +569,8 @@ pprInstr platform instr = case instr of -- NOTE: GHC may do whacky things where it only load the lower part of an -- address. Not observing the correct size when loading will lead -- inevitably to crashes. - STR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 -> - op2 (text "\tstrb") o1 o2 - STR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 -> - op2 (text "\tstrh") o1 o2 - STR _f o1 o2 -> op2 (text "\tstr") o1 o2 - STLR _f o1 o2 -> op2 (text "\tstlr") o1 o2 + STR f o1 o2 -> op2 (subword_suffix f $ text "\tstr") o1 o2 + STLR f o1 o2 -> op2 (subword_suffix f $ text "\tstlr") o1 o2 LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> let (adrp', ldr') = op_adrp_reloc_dynamic $ pprAsmLabel platform lbl in @@ -622,12 +618,8 @@ pprInstr platform instr = case instr of op_adrp o1 adrp' $$ op_add o1 ldr' - LDR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 -> - op2 (text "\tldrb") o1 o2 - LDR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 -> - op2 (text "\tldrh") o1 o2 - LDR _f o1 o2 -> op2 (text "\tldr") o1 o2 - LDAR _f o1 o2 -> op2 (text "\tldar") o1 o2 + LDR f o1 o2 -> op2 (subword_suffix f $ text "\tldr") o1 o2 + LDAR f o1 o2 -> op2 (subword_suffix f $ text "\tldar") o1 o2 -- 8. Synchronization Instructions ------------------------------------------- DMBISH DmbLoadStore -> line $ text "\tdmb ish" @@ -698,6 +690,12 @@ pprInstr platform instr = case instr of check_off off = if off >= 0 && off <= 4095 then char '#' <> int off else pgmError $ "GHC.CmmToAsm.AArch64.Ppr.check_off : " ++ show off ++ " is out of 12 bit" + -- Some instructions encode subword ops via b/h suffix on the instruction. + -- We handle this here relying on the format rather than the operands. + subword_suffix II8 t = t <> char 'b' + subword_suffix II16 t = t <> char 'h' + subword_suffix _ t = t + pprBcond :: IsLine doc => Cond -> doc pprBcond c = text "b." <> pprCond c ===================================== testsuite/tests/cmm/should_compile/Makefile ===================================== @@ -16,16 +16,3 @@ T16930: T23610: '$(TEST_HC)' $(TEST_HC_OPTS) T23610.cmm -S - -# The three seds below, in order: -# 1. Keep only the "Parsed Cmm" dump, since that is the one stage where the -# unreachable block still exists. -# 2. Rewrite goto targets: their label uniques survive -dsuppress-uniques -# (#21310). -# 3. Drop the "// CmmAssign"-style node annotations, which pprNode emits -# only on DEBUG compilers. -T27368-ppr-debug: - '$(TEST_HC)' $(TEST_HC_OPTS) -c -no-hs-main -ddump-cmm-verbose-by-proc -dppr-debug -dsuppress-uniques -dsuppress-ticks T27368-ppr-debug.cmm 2>&1 \ - | sed -n '/^==* Parsed Cmm/,/^ \}\]/p' \ - | sed 's/goto c[0-9A-Za-z]*/goto _lbl_/g' \ - | sed 's| *// Cmm[A-Za-z]*$$||' ===================================== testsuite/tests/cmm/should_compile/T27368-ppr-debug.stderr ===================================== @@ -0,0 +1,191 @@ + +==================== Parsed Cmm ==================== +[testUnreachable() { // [R1] + { info_tbls: [] + stack_info: arg_space: 8 + } + {offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + goto c6; + c6: // global + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; + c4: // global + goto c3; + c3: // global + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; + // unreachable blocks: + c5: // global + //tick src<T27368-ppr-debug.cmm:13:5-13> + _c1::I64 = _c1::I64 (+[W64]) 42; + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; + } + }] + + + +==================== Post control-flow optimisations (1) ==================== +testUnreachable +{offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; + c4: // global + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; +} + + + +==================== Post switch plan ==================== +testUnreachable +{offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; + c4: // global + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; +} + + + +==================== ThreadSanitizer instrumentation ==================== +testUnreachable +{offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; + c4: // global + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; +} + + + +==================== Layout Stack ==================== +testUnreachable +{offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + c4: // global + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; +} + + + +==================== CAFEnv ==================== +[(c2, {}), (c4, {}), (c7, {})] + + + +==================== after setInfoTableStackMap ==================== +testUnreachable() { // [R1] + { info_tbls: [] + stack_info: arg_space: 8 + } + {offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + c4: // global + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + } +} + + + +==================== Post control-flow optimisations (2) ==================== +testUnreachable() { // [R1] + { info_tbls: [] + stack_info: arg_space: 8 + } + {offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + c4: // global + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + } +} + + + +==================== Post CPS Cmm ==================== +[testUnreachable() { // [R1] + { info_tbls: [] + stack_info: arg_space: 8 + } + {offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + c4: // global + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + } + }] + + ===================================== testsuite/tests/cmm/should_compile/T27368-ppr-debug.stdout deleted ===================================== @@ -1,27 +0,0 @@ -==================== Parsed Cmm ==================== -[testUnreachable() { // [R1] - { info_tbls: [] - stack_info: arg_space: 8 - } - {offset - _lbl_: - __locVar_::I64 = R1; - if (__locVar_::I64 (>[W64]) 0) goto _lbl_; else goto _lbl_; - _lbl_: - goto _lbl_; - _lbl_: - __locVar_::I64 = __locVar_::I64 (-[W64]) 1; - R1 = __locVar_::I64; - call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; - _lbl_: - goto _lbl_; - _lbl_: - R1 = __locVar_::I64; - call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; - // unreachable blocks: - _lbl_: - __locVar_::I64 = __locVar_::I64 (+[W64]) 42; - R1 = __locVar_::I64; - call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; - } - }] ===================================== testsuite/tests/cmm/should_compile/all.T ===================================== @@ -13,11 +13,9 @@ test('T20725', normal, compile, ['-package ghc']) test('T23610', normal, makefile_test, ['T23610']) test('T24224', [cmm_src, grep_errmsg(r'(F64.*);', [1]), only_ways(['normal'])], compile, ['-no-hs-main -ddump-cmm -dsuppress-all -dsuppress-uniques']) test('T24474', cmm_src, compile, ['-optc-g3']) -# -dppr-debug makes stored-but-unreachable blocks visible in Cmm dumps (#27368). -# Skipped on wordsize(32) targets, where the dump would say I32/P32, and on -# unregisterised builds, which print call targets with an extra load. -test('T27368-ppr-debug', [when(wordsize(32), skip), when(unregisterised(), skip)], - makefile_test, ['T27368-ppr-debug']) +# Grep for a `... = + .. 42 ..;` occurence from within the dead code block in the cmm dump output. +test('T27368-ppr-debug', [cmm_src, only_ways(['normal']), grep_errmsg(r'\=.*\+.*(42;)', [1])], + compile, ['-no-hs-main -ddump-cmm-verbose-by-proc -dppr-debug']) test('T24474-cmm-gets-c-opts', cmm_src, compile, ['-optc-DFOO']) test('T24474-cmm-opt-order', cmm_src, compile, ['-optc-DFOO ' '-optCmmP-UFOO ' ===================================== testsuite/tests/codeGen/should_run/T27430.hs ===================================== @@ -0,0 +1,44 @@ +{-# LANGUAGE MagicHash #-} + +import GHC.Exts +import Data.Bits +import GHC.Word + +foreign import ccall unsafe "u64_to_u8" u64_to_u8 :: Word64 -> Word8 +foreign import ccall unsafe "u64_to_u16" u64_to_u16 :: Word64 -> Word16 +foreign import ccall unsafe "u64_to_u32" u64_to_u32 :: Word64 -> Word32 + +x :: Word64 +x = 5 + +-- Those should give just x when truncated. +y8,y16,y32 :: Word64 +y8 = setBit x 8 +y16 = setBit x 16 +y32 = setBit x 32 + +eq8 :: Word8 -> Word8 -> Int +eq8 (W8# a) (W8# b) = I# (eqWord8# a b) + +eq16 :: Word16 -> Word16 -> Int +eq16 (W16# a) (W16# b) = I# (eqWord16# a b) + +eq32 :: Word32 -> Word32 -> Int +eq32 (W32# a) (W32# b) = I# (eqWord32# a b) + +{-# NOINLINE outline_eq8 #-} +outline_eq8 = eq8 +{-# NOINLINE outline_eq16 #-} +outline_eq16 = eq16 +{-# NOINLINE outline_eq32 #-} +outline_eq32 = eq32 + +main :: IO () +main = do + print (eq8 (u64_to_u8 x) (u64_to_u8 y8)) + print (eq16 (u64_to_u16 x) (u64_to_u16 y16)) + print (eq32 (u64_to_u32 x) (u64_to_u32 y32)) + + print (outline_eq8 (u64_to_u8 x) (u64_to_u8 y8)) + print (outline_eq16 (u64_to_u16 x) (u64_to_u16 y16)) + print (outline_eq32 (u64_to_u32 x) (u64_to_u32 y32)) ===================================== testsuite/tests/codeGen/should_run/T27430.stdout ===================================== @@ -0,0 +1,6 @@ +1 +1 +1 +1 +1 +1 ===================================== testsuite/tests/codeGen/should_run/T27430_c.c ===================================== @@ -0,0 +1,5 @@ +#include <stdint.h> + +uint8_t u64_to_u8(uint64_t v) { return (uint8_t)v; } +uint16_t u64_to_u16(uint64_t v) { return (uint16_t)v; } +uint32_t u64_to_u32(uint64_t v) { return (uint32_t)v; } ===================================== testsuite/tests/codeGen/should_run/T27533.hs ===================================== @@ -0,0 +1,41 @@ +{-# LANGUAGE MagicHash, UnboxedTuples, GHCForeignImportPrim, UnliftedFFITypes #-} + +import GHC.Exts +import GHC.IO (IO(..)) +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Marshal.Utils (fillBytes) +import Foreign.Ptr (Ptr(..)) +import Data.Word (Word8) +import Numeric (showHex) +import System.IO + +foreign import prim "store8" store8# :: Addr# -> Word# +foreign import prim "load8" load8# :: Addr# -> Word# + +-- Read one byte at a given byte offset. Working a byte at a time keeps the +-- test independent of both endianness and word size: the buffer contents are +-- a fixed sequence of bytes in address order, whereas a word-sized read of +-- the same buffer would give 0x..43 on little-endian and 0x43.. on big-endian. +readByte :: Addr# -> Int -> IO Word +readByte a (I# i) = + IO (\s -> case readWord8OffAddr# a i s of + (# s', v #) -> (# s', W# (word8ToWord# v) #)) + +main :: IO () +main = do + hSetBuffering stdout NoBuffering + allocaBytes 8 $ \p@(Ptr a) -> do + -- 1. Silent corruption: release-store of 1 byte into an all-ones buffer. + -- The store must touch byte 0 and leave bytes 1..7 alone; a buggy NCG + -- widens it to a 4-byte store and zeroes bytes 1..3. + fillBytes p (0xFF :: Word8) 8 + case store8# a of _ -> return () -- case on unlifted Word# forces the call + bs <- mapM (readByte a) [0 .. 7] + putStrLn ("after 1-byte release-store: " ++ unwords (map (\b -> showHex b "") bs)) + -- expected 43 ff ff ff ff ff ff ff + -- buggy NCG gives 43 0 0 0 ff ff ff ff + + -- 2. SIGBUS: acquire-load of 1 byte at an odd address (well-defined). + r <- IO (\s -> (# s, W# (load8# (a `plusAddr#` 1#)) #)) + putStrLn ("acquire byte load at p+1: 0x" ++ showHex r "") + -- expected 0xff; buggy NCG dies with SIGBUS before printing ===================================== testsuite/tests/codeGen/should_run/T27533.stdout ===================================== @@ -0,0 +1,2 @@ +after 1-byte release-store: 43 ff ff ff ff ff ff ff +acquire byte load at p+1: 0xff ===================================== testsuite/tests/codeGen/should_run/T27533_cmm.cmm ===================================== @@ -0,0 +1,14 @@ +#include "Cmm.h" + +// Release-store one byte at p. Must touch exactly 1 byte. +store8 (W_ p) { + %release I8[p] = 67 :: I8; + return (0); +} + +// Acquire-load one byte from p. +load8 (W_ p) { + I8 v; + v = %acquire I8[p]; + return (%zx64(v)); +} ===================================== testsuite/tests/codeGen/should_run/T27537.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE MagicHash #-} + +import GHC.Exts + +{-# NOINLINE lt8 #-} +lt8 :: Int -> Word -> Int -- ltWord8# 254 255: must be 1 +lt8 (I# m) (W# n) = I# (ltWord8# (int8ToWord8# (intToInt8# m)) (wordToWord8# n)) + +{-# NOINLINE eq8 #-} +eq8 :: Int -> Word -> Int -- eqWord8# 254 254: must be 1 +eq8 (I# m) (W# n) = I# (eqWord8# (int8ToWord8# (intToInt8# m)) (wordToWord8# n)) + +{-# NOINLINE eqi16 #-} +eqi16 :: Int -> Int -> Int -- eqInt16# (-2) (-2): must be 1 +eqi16 (I# m) (I# n) = I# (eqInt16# (intToInt16# m) (word16ToInt16# (wordToWord16# (int2Word# n)))) + +{-# NOINLINE rem8 #-} +rem8 :: Int -> Word -> Word -- remWord8# 254 100: must be 54 +rem8 (I# m) (W# n) = W# (word8ToWord# (remWord8# (int8ToWord8# (intToInt8# m)) (wordToWord8# n))) + +main :: IO () +main = do + print (lt8 (-2) 255) + print (eq8 (-2) 254) + print (eqi16 (-2) 65534) + print (rem8 (-2) 100) ===================================== testsuite/tests/codeGen/should_run/T27537.stdout ===================================== @@ -0,0 +1,4 @@ +1 +1 +1 +54 ===================================== testsuite/tests/codeGen/should_run/T27538.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE MagicHash #-} + +import GHC.Exts + +{-# NOINLINE ix #-} +ix :: Int +ix = 0 + +{-# NOINLINE f #-} +f :: Int8# -> Int# +f x = if isTrue# (x `ltInt8#` intToInt8# 0#) + then (int8ToWord8# x) `gtWord8#` wordToWord8# 200## + else 1# + +main :: IO () +main = do + -- Test for use of byte-width read. + let !(I# i) = ix + x = indexInt8OffAddr# "\x80"# i + putStrLn ("f(0x80) = " ++ show (I# (f x))) ===================================== testsuite/tests/codeGen/should_run/T27538.stdout ===================================== @@ -0,0 +1 @@ +f(0x80) = 0 ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -295,3 +295,12 @@ test('aarch64-sxtw-run', when(unregisterised(), skip)], multi_compile_and_run, ['aarch64-sxtw-run', [('aarch64-sxtw-cmm.cmm', '')], '-O']) + +test('T27430', [req_c, extra_ways(['optasm'])], compile_and_run, ['T27430_c.c']) + +test('T27533', [req_cmm, extra_ways(['optasm'])], multi_compile_and_run, + ['T27533', [('T27533_cmm.cmm', '')], '-O']) + +test('T27537', normal, compile_and_run, ['-O']) + +test('T27538', normal, compile_and_run, ['-O']) ===================================== testsuite/tests/simd/should_run/T27565.hs ===================================== @@ -0,0 +1,36 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +module Main (main) where +import GHC.Exts +import GHC.Int (Int8(..), Int16(..), Int32(..), Int64(..)) + +{-# OPAQUE broadcast_i8 #-} +broadcast_i8 :: Int8# -> Int8X16# +broadcast_i8 x = broadcastInt8X16# x + +{-# OPAQUE broadcast_i16 #-} +broadcast_i16 :: Int16# -> Int16X8# +broadcast_i16 x = broadcastInt16X8# x + +{-# OPAQUE broadcast_i32 #-} +broadcast_i32 :: Int32# -> Int32X4# +broadcast_i32 x = broadcastInt32X4# x + +{-# OPAQUE broadcast_i64 #-} +broadcast_i64 :: Int64# -> Int64X2# +broadcast_i64 x = broadcastInt64X2# x + +main :: IO () +main = do + case unpackInt8X16# (broadcast_i8 (intToInt8# 32#)) of + (# a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15 #) -> + print [ I8# a0, I8# a1, I8# a2, I8# a3, I8# a4, I8# a5, I8# a6, I8# a7 + , I8# a8, I8# a9, I8# a10, I8# a11, I8# a12, I8# a13, I8# a14, I8# a15 ] + case unpackInt16X8# (broadcast_i16 (intToInt16# 32#)) of + (# b0,b1,b2,b3,b4,b5,b6,b7 #) -> + print [ I16# b0, I16# b1, I16# b2, I16# b3, I16# b4, I16# b5, I16# b6, I16# b7 ] + case unpackInt32X4# (broadcast_i32 (intToInt32# 32#)) of + (# c0,c1,c2,c3 #) -> + print [ I32# c0, I32# c1, I32# c2, I32# c3 ] + case unpackInt64X2# (broadcast_i64 (intToInt64# 32#)) of + (# d0,d1 #) -> + print [ I64# d0, I64# d1 ] ===================================== testsuite/tests/simd/should_run/T27565.stdout ===================================== @@ -0,0 +1,4 @@ +[32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32] +[32,32,32,32,32,32,32,32] +[32,32,32,32] +[32,32] ===================================== testsuite/tests/simd/should_run/all.T ===================================== @@ -217,3 +217,5 @@ test('StackAlignment64' , compile_and_run if have_cpu_feature('avx512f') else compile , ['StackAlignment64_main.c'] ) + +test('T27565', [], compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92a88f55d52a4e729b32d9c355fb45… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92a88f55d52a4e729b32d9c355fb45… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/io-manager-deadlock-detection] 94 commits: ci: Use shallow submodule clones by default
by Duncan Coutts (＠dcoutts) 24 Aug '26

24 Aug '26

Duncan Coutts pushed to branch wip/io-manager-deadlock-detection at Glasgow Haskell Compiler / GHC Commits: f586c885 by Simon Jakobi at 2026-07-24T18:05:00-04:00 ci: Use shallow submodule clones by default Limit submodule clones to depth one to reduce CI checkout costs. Keep fetching full submodule history for the submodule lint jobs, which inspect commits across a range. Assisted-by: gpt-5.6-sol via Codex CLI - - - - - 306120d2 by Duncan Coutts at 2026-07-24T18:05:43-04:00 Fix flaky test T3994 on FreeBSD On current FreeBSD versions, calling getpgid on a zombie process fails. In T3994, if we're really unlucky with delays and scheduling then we can end up in exactly that situation. Just catch that specific exception and ignore it. It's rare, and not our fault. - - - - - 7b116a0b by Cheng Shao at 2026-07-24T18:06:24-04:00 ci: add missing workaround for docker permissions in lint jobs Some lint jobs use ci-images with default user `ghc`, and the gitlab ci docker executor requires the `sudo chown` workaround to fix workspace directory permission issue. This patch adds the missing workarounds for the lint jobs. Fixes #27554. Co-authored-by: Codex <codex(a)openai.com> - - - - - 815149f3 by Andrzej Rybczak at 2026-07-25T15:06:43+00:00 Add -Wdefaulted-callstack Adds a new warning, -Wdefaulted-callstack, which warns when an implicit CallStack parameter is defaulted to the empty stack. In particular, this includes call sites where a function with a HasCallStack constraint is called from a definition that does *not* provide one. At such call sites the call stack is cut off and does not include the enclosing definition's callers, which can be a source of surprise if the user wants complete call stacks. Closes #27077. - - - - - f6f2343f by Zubin Duggal at 2026-07-25T17:40:51-04:00 UniqueDFM: alter should preserve insertion order Before it always inserting new elements at the end. This is problematic because instances get inserted into the map with `alterF`, which can change ordering of how instances are printed with `:info` depending on the order in which we consult interfaces I expect `alter id k = id` and `alter (fmap f) k = adjust f k`. Moving keys to the end breaks that (`adjust` already preserves position). Fixes #27532 - - - - - 5d0ab71a by fendor at 2026-07-27T17:31:05-04:00 Introduce global unit database cache As a first step for better sharing of `UnitInfo` across `UnitEnv`, we introduce a new datatype called `ExternalUnitDatabases`. It primarily serves as an in-memory representation of *all* `UnitDatabase`s across `UnitEnv`. This means, if multiple `HomeUnitEnv`s depend on the same database, one way or another, we make sure that we don't parse from disk every time. Instead, we store the in-memory representation in `ExternalUnitDatabases`. `ExternalUnitDatabaseCache` is the equivalent of `ExternalUnitState` in the `UnitEnv`. It is a mutable variable wrapping `ExternalUnitDatabases`. The mutable `ExternalUnitDatabaseCache` is used in `initUnits` to make sure we don't parse the same unit database multiple times. Almost by accident, we change the semantics of `initUnits` to honour modifications to `packageDBFlags`. The inability to change `packageDBFlags` while also reusing the already parsed `UnitDatabase`s was reported in #26423 as a bug. Hence, we think this behaviour change is warranted and acceptable, especially since it comes with a breaking change to the `initUnits` API. Add regression test for #26423 Closes #26423 - - - - - 6cce494a by fendor at 2026-07-27T17:31:05-04:00 Introduce UnitIndex for global external unit caching `UnitInfo`s have been observed to cause a lot of memory usage in #27500. Especially with multiple home units, as the same (external) units are processed from scratch, even though most of the time we end up with exactly the same `UnitInfo`. We introduce a `UnitEnv` global cache that allows us to store external unit information that is used across all `HomeUnitEnv`s. The most important change in this commit is the introduction of the `UnitIndex`. It stores a global mapping of `UnitId` -> `UnitInfo`, and `initUnits` always uses the cached `UnitInfo` entry to populate each `HomeUnitEnv`'s `UnitState`. This allows us to ensure the following property: > Each `UnitInfo` should be alive exactly once in GHC. All `UnitState`s should reference 'UnitInfo's stored in the 'UnitIndex'. This ensured by calling 'initUnits' with the 'UnitIndex'. In addition, the `ExternalUnitDatabases` may also hold a reference to each on-disk representation of `UnitInfo`. This means, we impose an hard upper bound on the number of `UnitInfo`s alive in the GHC session: > The number of alive `UnitInfo`s closure objects must be the > sum of all loaded unit database times two. We add performance regression tests that make sure the number of live `UnitInfo` cannot exceed this threshold. Closes #27500 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiComponentModulesRecomp100 mhu-perf LinkableUsage02 ------------------------- These metrics increases are especially notable, as we are not even sharing anything big but merely the global package database with 50 entries. It shows how careful sharing of `UnitInfo` can improve memory usage. We expect this to be much more notable when the whole cabal package database is shared across multiple home units. `LinkableUsage02` metric decreases on unreg and i386 platform, only. --- Technical details To share the `UnitInfo`s correctly, it is important that we extract the `WireMap` into the `UnitIndex`. At the moment of writing, `WireMap` must be globally the same for all `HomeUnitEnv`s. This is important, as we could otherwise not cache the "fully-resolved" `UnitInfo`, as we don't change the `UnitId` or `unitAbiHash` when resolving wired-in units. Thus, there could be ambiguities, when the `WireMap` is not the same for all `UnitState`s across the `UnitEnv`. We consider a `UnitInfo` fully-resolved, if wired-in units have been updated, the `UnitInfo` has been validated and variables in the unit config, such as `${pkgroot}` have been resolved. Updating the wired-in units requires the `WireMap` to be globally the same. - - - - - f8e3bee9 by Zubin Duggal at 2026-07-27T17:31:49-04:00 testsuite: skip runtime stats tests on debugged compilers Debugged flavours build the boot libraries without optimisation, so the runtime numbers do not match the baselines. - - - - - 1e326770 by Zubin Duggal at 2026-07-27T17:31:50-04:00 testsuite: mark #20706 tests fragile rather than broken Whether the static linux linker issues manifest depends on the host toolchain. - - - - - c0b13cbe by Zubin Duggal at 2026-07-27T17:31:50-04:00 testsuite: exclude libnuma from mostly-static It needs static system libraries (libnuma.a) that many platforms do not ship. Fixes #26914 - - - - - bee1913d by Alan Zimmerman at 2026-07-28T16:42:29-04:00 EPA: ClsInstDecl with decls as [LHsDecl GhcPs] in GhcPs Similar to 4fdfe75731e01dad7d7fa474c2703d0d3965afb1, this commit changes the as-parsed representation of class instance declarations to [LHsDecl GhcPs], and only separates them by type from the renamer onward. This also allows us to remove all the AnnSortKey machinery for exact printing, as it is now no longer needed. - - - - - 72c55eee by Cheng Shao at 2026-07-28T16:43:11-04:00 hadrian: implement and use writeFileAtomic to fix race condition This patch implements `writeFileAtomic` in hadrian and change all invocations of shake non-atomic `writeFile'` to use `writeFileAtomic`, to avoid multiple hadrian concurrent invocations overwriting the same in-tree generated file not in the build root directory. Fixes #27536. Additional notes: - `writeFileChanged`/`writeFileChangedBS` cannot be made atomic since it involves reading the file's older version, so their uses are left alone. It doesn't affect #27536 given their outputs are contained in the build root directory. - It's possible to shrink this patch by only making writes outside the build root directory atomic. But I think it's not worth the effort for fine grained distinction here, and atomic writes within the build root directory should also improve robustness of a hadrian build. - In the longer term we do want to make a ghc build only generate files within the build root directory, though that's a lot of work and outside the scope of this particular bugfix. Co-authored-by: Codex <codex(a)openai.com> - - - - - 46d4f963 by Sylvain Henry at 2026-07-29T06:38:40-04:00 RTS: correctly mark slop bytes when shrinking large arrays (#19048) Correctly mark slop bytes even when profiling is off so that heap census doesn't traverse garbage-collected closures. - - - - - 4762a8bf by Simon Jakobi at 2026-07-29T06:39:23-04:00 Add -XLazyFieldAnnotations (GHC proposal 752) Unbundle the prefix `~` lazy field annotation syntax from StrictData. The new LazyFieldAnnotations extension controls whether `~` is accepted on constructor fields. StrictData (and Strict, transitively) imply the new extension. See https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0752-l…. Closes #24455. Assisted-by: Claude Opus 4.8 - - - - - 0b6dcc84 by Simon Jakobi at 2026-07-29T06:40:04-04:00 testsuite: Relax T24471 residency tolerance T24471 peak residency fluctuates enough on i386 to cause spurious failures. Use the standard residency tolerance while retaining the existing allocation threshold. See https://gitlab.haskell.org/ghc/ghc/-/work_items/24471#note_682303. Assisted-by: gpt-5.6-sol via Codex CLI - - - - - 90e95b34 by Cheng Shao at 2026-07-29T06:40:45-04:00 compiler: fix missing top-level procedure labels in cmm dumps This patch fixes missing top-level procedure labels in some intermediate Cmm pass dumps. Fixes #27553. Co-authored-by: Codex <codex(a)openai.com> - - - - - 360a5946 by sheaf at 2026-07-29T06:41:35-04:00 Add some type-family-heavy performance tests FamAppCachePerf stress-tests the performance of lookups in the type family application cache. T27336 is a minimisation extracted from the reported reproducer. SimplCastPerf is a measure of coercion growth due to the simplifier calling mkTransCo without re-optimising the result. - - - - - 3ec9e2b9 by Mike Pilgrem at 2026-07-31T08:21:33-04:00 GHC Guide: Improve docs on response files - - - - - e5b2a1f7 by sheaf at 2026-07-31T08:22:23-04:00 Disable Core Lint for TcPlugin_RewritePerf This is a compiler performance test, but the test source hard-coded -dcore-lint, defeating the measurement. ------------------------- Metric Decrease: TcPlugin_RewritePerf ------------------------- - - - - - 85b10c00 by Alan Zimmerman at 2026-07-31T22:09:47+01:00 EPA: Remove LocatedP from OverlapMode We have type LocatedP = GenLocated SrcSpanAnnP type SrcSpanAnnP = EpAnn AnnPragma As the first step in removing this in favour of LocatedA which only captures location, comments and trailing annotations, we remove it from OverlapMode We do this by moving the AnnPragma into the TTG extension point instead. - - - - - c9a34a00 by Viktor Dukhovni at 2026-08-02T04:34:17-04:00 Fix note typo - - - - - 4f2a21f7 by Andreas Klebinger at 2026-08-02T22:46:46-04:00 Apply oneShot Monad trick to STG LintM - - - - - 21e4b89d by Andreas Klebinger at 2026-08-02T22:46:46-04:00 stgLint: Use a single reader env for read only arguments. - - - - - d415f38a by Alan Zimmerman at 2026-08-02T22:47:27-04:00 EPA: Remove LocatedP from CType The next step of removing use of LocatedP by moving the AnnPragma for CType into its TTG extension point instead. - - - - - 8fc6f882 by Simon Jakobi at 2026-08-05T14:53:41-04:00 testsuite: Don't crash on non-UTF-8 test output read_stdout, read_stderr_for, read_comp_stderr and read_diff decoded strictly (the first three with UTF-8, read_diff with the locale encoding), so a test emitting invalid UTF-8 (binary output, or a crash truncating a multi-byte character) raised UnicodeDecodeError and was reported as a framework failure instead of its actual result. Decode with errors='replace', like read_no_crs and safe_print. Assisted-by: Claude Fable 5 - - - - - 56534866 by Simon Jakobi at 2026-08-05T14:53:41-04:00 testsuite: Colorize the test summary, also in CI The summary headings were plain, and SUMMARY was colored unconditionally, so the escapes also ended up in the file written by --summary-file. Color is now decided per output sink via term_color.colored_if; see the comments in term_color. CI logs are not a tty, but GitLab's log viewer renders ANSI colors, so add --force-colors and pass it in .gitlab/ci.sh. Assisted-by: Claude Opus 5 - - - - - bceb541a by Simon Jakobi at 2026-08-05T14:53:42-04:00 testsuite: Repeat unexpected failure output in the summary Finding out why a test failed meant scrolling back through a possibly very long log to the point where the test ran. The summary now repeats the captured output of unexpected failures, before the statistics, so the most interesting part is at the end of the log (#16720). Output mismatches report their diff instead of the mismatching stream (see Note [Redundant output in test results]). The repeated output is bounded per stream, and skipped altogether beyond MAX_SUMMARY_OUTPUT_TESTS failure blocks. Tests failing identically in several ways share one block. Test results now report a source-relative directory, stable regardless of where the run was started from. Assisted-by: Claude Fable 5 - - - - - 2ab02c57 by Ben Gamari at 2026-08-05T14:54:24-04:00 base: Don't drop exception context in SomeException(toException) For reasons that are lost to time, the implementation of [CLC #200] that was merged inappropriately dropped `ExceptionContext` in the `toException` implementation given to `SomeException`. Fix this infelicity. [CLC #200]: https://github.com/haskell/core-libraries-committee/issues/200 - - - - - 126ce574 by Vladislav Zavialov at 2026-08-05T14:55:05-04:00 Test case for #20902 Starting with GHC 9.14.1 (the first major release to include 51e3ec83), and from point releases GHC 9.10.2 and GHC 9.12.3 (backports cc4470be68 and b30f25591e), all examples in this ticket are handled as expected. - - - - - b14d8d59 by Alan Zimmerman at 2026-08-05T14:55:46-04:00 EPA: Remove LocatedP, last use in WarningTxt The last step of removing LocatedP, by moving the AnnPragma for WarningTxt into its TTG extension point instead. This also allows us to remove LocatedP and SrcSpanAnnP - - - - - 70b58c8f by Vladislav Zavialov at 2026-08-05T14:56:27-04:00 Test cases for #18725 Starting with GHC 9.4 (the first release to include 268efcc9a4), the program in this ticket no longer panics. A standalone kind signature breaks the recursive loop, so the type constructor can be used in a kind within its own group. T18725a checks that this is accepted with the signature present, while T18725b confirms it is still rejected without it. - - - - - b18c8dd5 by Zubin Duggal at 2026-08-06T15:51:01-04:00 hie files: Dump the type table when dumping with -ddump-hie - - - - - f839d0fb by Zubin Duggal at 2026-08-06T15:51:01-04:00 hie files: Take evidence for quantified constraints into account when saving evidence terms to the hie ast Fixes #25709 - - - - - 5753ebaa by Simon Jakobi at 2026-08-06T15:51:43-04:00 testsuite: fix stale paths for the ghc-config build artifacts ghc-config.hs moved from testsuite/mk/ to testsuite/ghc-config/ in 6c7a49139c, but the .gitignore entry and the clean rule still referred to the old location. As a result the compiled ghc-config binary, which boilerplate.mk rebuilds on every make-driven test run, showed up as an untracked file and was never cleaned. Assisted-by: Claude Opus 5 - - - - - 246d4d72 by Simon Peyton Jones at 2026-08-06T15:52:25-04:00 Documentation only ...driven by my investigation of #27591 - - - - - be69e9df by Alan Zimmerman at 2026-08-06T15:53:05-04:00 EPA: Replace AnnPragma with individual types We introduced AnnPragma as a common type for all pragma usages wrapped in LocatedP / SrcSpanAnnP. Now that those are gone, and the AnnPragma moved into the TTG points for the given items, we can ensure that each carries only the annotations it needs. So we remove AnnPragma, and in its place bring in AnnCType AnnWarningTxt AnnOverlap AnnAnnDecl AnnPragSCC - - - - - 0779e12c by Simon Jakobi at 2026-08-07T12:36:11-04:00 Cmm: print unreachable blocks under -dppr-debug (#27368) Unreachable blocks linger in a CmmGraph's block map for most of the Cmm pipeline, but pprCmmGraph only ever printed the blocks reachable from the entry, so dumps looked consistent while the graph was not. Issues like #27368 were hard to debug due to this. pprCmmGraph now appends the stored-but-unreachable blocks under a "// unreachable blocks:" heading when -dppr-debug is on. See Note [unreachable blocks] in GHC.Cmm.Pipeline. Assisted-by: Claude Opus 5 - - - - - 3a0f9a51 by Simon Peyton Jones at 2026-08-07T12:36:54-04:00 Fix three bugs related to required type args and INLINE pragmas * `GHC.Core.Opt.Arity.mkEtaForAllMCo` got the visibility flags back to front, leading to a Lint error (#27557) * The arity in an InlineSaturation is the VisArity not the Arity; the two can differ when we have "required" type arguments. This made the INLINE pragma argument counting go wrong in `makeCorePair` (#27590). * When a simple binding has a type signature, we take special path in `tcPolyCheck`, leading to an outer `AbsBinds` that has no dictionaries, even when the binding is in fact overloaded. That confused the inline-arity computation in `makeCorePair` (#27589). The latter two are fixed using the new function `GHC.HsToCore.Binds.findSatArity`. That actually simplifies the API of `makeCorePair`, which is nice. The first bug is fixed by swapping the visiblity flags in `GHC.Core.Opt.Arity.mkEtaForAllMCo` Getting the INLINE behaviour right led to some perf changes: * Runtime /halved/ on T7954 due to better specialisation * Compile time increased by 6% in T21839c because a bit more inlining happened, as it always should have done. * For some reason compile-time max-bytes-used dropped by 30% on T27336, but only on one build configuration; and it increased on LinkableUsage02 by 6% on another configuration Geometric mean effect on our compile time benchmarks is +0.1%. Metric Decrease: T27336 T7954 Metric Increase: LinkableUsage02 T21839c - - - - - 4f985108 by Vladislav Zavialov at 2026-08-07T17:49:50-04:00 Discard type arguments in tcPatToExpr (#27440, #27583) The builder expression of an implicitly bidirectional pattern synonym must not mention types written in the RHS: * Invisible type arguments led to a panic (#27440) * Required type arguments failed with out-of-scope variables (#27583) Both are now discarded, following the precedent established by pattern signatures (#9867). Discarding type arguments takes some care: a type pattern cannot be told from a value pattern by syntax alone, as the `type` keyword may be omitted. Consider: data T a b c where MkT :: forall a. forall b c -> a -> T a b c pattern P :: x -> T x y z pattern P x = MkT @a (type b) c x In P's right-hand side, `@a` and `type b` are clearly type arguments, but what about `c` and `x`? We can only tell by matching the patterns against MkT's type. So tcPatToExpr now runs in TcM and matches the arguments against the constructor's TyVarBinders using zipPatsBndrs, which is made public for this purpose. The resulting builder is $bP x = MkT _ _ x. See Note [Discarding types in the builder expression]. Test cases: T27440a T27440b T27440c T27440d T27440e T27583a T27583b T27583c T27583d T27583e T27583f T27583g Metric Increase: LinkableUsage02 Metric Decrease: T27336 Assisted-by: Claude Opus 5 - - - - - eb1dcd4d by sheaf at 2026-08-07T17:50:40-04:00 mkWpFun_FRR: fix ordering of coercion composition When the subsumption machinery generates an eta-expansion, we must perform a representation polymorphism check to ensure the lambda binder it introduces has a fixed runtime representation. This is done in GHC.Tc.Utils.mkWpFun_FRR. This check involves composing quite a few coercions, arising from representation-polymorphism checks on both the actual and expected argument types. These coercions are then chained using HsWrapper composition, <.>. The ordering of composition was incorrect, leading to the Core Lint failure reported in #27639. This commit fixes that. Fixes #27639 - - - - - 3a552476 by Simon Jakobi at 2026-08-09T15:20:06-04:00 Word64Map: add compareSize compareSize m c compares the size of a map to an Int, but unlike compare (size m) c it stops traversing the map once the outcome is determined. Based on https://github.com/haskell/containers/pull/1139 Assisted-by: Claude Opus 5 - - - - - 6e2c99d8 by Simon Jakobi at 2026-08-09T15:20:06-04:00 Use a pigeonhole sort for deterministic UniqDFM iteration Deterministic UniqDFM iteration used a list mergesort, allocating O(n log n) cons cells and contributing significantly to compiler allocations (#27459). Use a pigeonhole sort where appropriate, while retaining the mergesort fallback. See Note [Sorting a UDFM] and Note [Cost of deterministic iteration]. The peak_megabytes_allocated increase for LinkableUsage02 is probably due to GC timing noise. See #27613. ------------------------- Metric Decrease: InstanceMatching InstanceMatching1 ManyAlternatives T12707 T13379 T13719 T24471 T27336 T5321FD T5321Fun T783 Metric Increase 'peak_megabytes_allocated': LinkableUsage02 ------------------------- Assisted-by: gpt-5.6-sol via Codex CLI - - - - - a938ab12 by sheaf at 2026-08-09T15:20:48-04:00 Testsuite: don't measure max residency for T27336 We really care more about total allocations for this test, so this commit removes the maximum residency measurement. - - - - - 7d94bb78 by Alan Zimmerman at 2026-08-09T15:21:29-04:00 EPA: Remove LocatedE, replace with LocatedA This gets rid of one more LocatedXXX occurrence - - - - - 9df24b7e by sheaf at 2026-08-10T14:28:30-04:00 hie.yaml: use a polyglot shell/batch script This commit merges hie-bios and hie-bios.bat into a single polyglot script. This avoids Windows users having to manually update hie.yaml in order to be able to use HLS. - - - - - 7f75c588 by Alan Zimmerman at 2026-08-10T14:29:11-04:00 EPA: Remove type parameter from AnnList This is a step towards cutting AnnList down to its core for formatting lists only - - - - - e8d1a0d6 by Bernhard M. Wiedemann at 2026-08-10T21:31:23-04:00 driver: Link object files in a deterministic order The object files handed to the linker come from the HomePackageTable, which is ordered by the order in which modules finished compiling. With -j1 that is the build plan order, with -jN it is whatever the scheduler produced, so the same sources can link to different (but equivalent) binaries. The order reaches the output: .text and .rodata contributions are concatenated in link order, so e.g. building the hdav executable of the DAV package twice, once with -j1 and once with -j4, yields two binaries that differ in ~100kB of section contents. Sort the home modules by module before collecting their linkables, guarded under `Opt_ObjectDeterminism` . Fixes #27612 Signed-off-by: Bernhard M. Wiedemann <bwiedemann(a)suse.de> - - - - - 556db2f3 by sheaf at 2026-08-10T21:32:06-04:00 Reduce SpecConstr threshold in GHC.Tc.Solver.Rewrite As remarked in #27628, this module currently sits on a knife's edge: if the body of 'simplifyArgsWorker' is made even a tiny bit smaller, then SpecConstr suddenly kicks in and causes disastrous reboxing of the LiftingContext argument. To make this less likely to happen, this commit lowers the SpecConstr threshold. - - - - - c77d88fc by sheaf at 2026-08-13T10:15:22-04:00 Allow rewriting in RuntimeReps for newtype ConPats This commit implements PHASE 2 of the FixedRuntimeRep plan described in Note [The Concrete mechanism] in GHC.Tc.Utils.Concrete for newtype constructor patterns. In short, GHC now accepts programs of the form f (MkN x) = ... in which the argument 'x' of the newtype constructor pattern 'MkN x' has a representation that is not syntactically concrete, e.g. it can be 'Id IntRep' reducing to 'IntRep'. See T20363{,b,c} for examples. There are two main parts to the implementation: 1. Typechecking, in GHC.Tc.Gen.Pat.tcDataConPat. See Note [Typechecking newtype constructor patterns] in GHC.Tc.Gen.Pat. 2. Desugaring. We restructure the code for desugaring pattern matches by allowing the scrutinised match variable to be casted. This allows us to accumulate coercions and avoids creating binders at intermediate types tha don't have a fixed RuntimeRep. See the revamped Note [Match Ids] in GHC.HsToCore.Monad. Fixes #20363 ------------------------- Metric Increase: InstanceMatching ------------------------- - - - - - 6ba9dd41 by Wolfgang Jeltsch at 2026-08-13T10:16:07-04:00 Improve the documentation of `--show-iface` This change in particular gets rid of the claim that `--show-iface` writes *the* contents of the interface file in question. It doesn’t do that; it only writes those parts that are likely of interest to a human reader. - - - - - 4bd193fa by Sylvain Henry at 2026-08-13T10:17:00-04:00 RTS: fix LDV profiler's slop skipping (#27585) processHeapForDead was the one heap scanner not updated for the slop marker encoding introduced in #19048. It still assumed slop is zeroed: while (p < bd->free && !*p) p++; // skip slop so it stopped at the (StgWord)(-1) sentinel and passed it to processHeapClosureForDead. IS_FORWARDING_PTR(-1) holds, hence a garbage size was read out of LDVW and the scan ran off the block, tripping ASSERT(p == bd->free) on a debug RTS and silently corrupting the census otherwise. The loop was hand-copied in four places, so factor it out into skipSlop in ClosureMacros.h and use it in ProfHeap.c, Sanity.c, Printer.c and LdvProfile.c. Co-Authored-By: Claude Opus 5 (1M context) <noreply(a)anthropic.com> - - - - - 1446bb03 by Zubin Duggal at 2026-08-13T10:17:48-04:00 hadrian: Fix links to remaining doc sites to not use the package hash for haddock links In 07267f79d91169f474cacc8bcd38d76a6e97887d we changed hadrian to not include the package hash in the haddock directory. This patch takes care of a few remaining links that were missed in that patch Fixes #27671 - - - - - 257c3ed7 by Simon Jakobi at 2026-08-13T10:18:29-04:00 Testsuite: widen InstanceMatching acceptance window to 5% (#27673) ...in order to unblock CI. Assisted-by: Claude Fable 5 - - - - - e4cfaaa0 by Simon Peyton Jones at 2026-08-14T01:09:32+02:00 Major patch to re-engineer known-key names This big patch implements the New Plan for known-key names, described in #27013. Read the big Note [Overview of known-key names] in GHC.Types.Name Some things had to be reworked slightly to accomodate the new known-keys design. A significant one was the generation of auxiliary KindRep bindings, which was greatly simplified. Note [Grand plan for Typeable] was updated accordingly. Another example: GHC.Internal.CString was merged into GHC.Internal.Types. Co-authored-by: Rodrigo Mesquita <rodrigo.m.mesquita(a)gmail.com> The couple hundreds of hours spent here by Rodrigo were sponsored by Well-Typed Metrics: compile_time/bytes allocated ------------------------------------- Baseline Test Metric value New value Change ------------------------------------------------------------------------------------------ MultiComponentModules100(normal) ghc/alloc 24,312,779,672 24,990,470,432 +2.8% BAD MultiComponentModulesRecomp(normal) ghc/alloc 601,924,960 621,884,888 +3.3% BAD MultiComponentModulesRecomp100(normal) ghc/alloc 11,884,065,432 12,531,373,704 +5.4% BAD MultiLayerModules(normal) ghc/alloc 3,861,537,072 3,706,919,512 -4.0% GOOD T13701(normal) ghc/alloc 3,517,246,392 3,237,179,616 -8.0% GOOD T13820(normal) ghc/alloc 28,961,056 29,663,208 +2.4% BAD T14697(normal) ghc/alloc 472,044,184 443,550,048 -6.0% GOOD T18140(normal) ghc/alloc 47,905,664 49,115,808 +2.5% BAD T4801(normal) ghc/alloc 269,339,096 263,432,040 -2.2% GOOD T783(normal) ghc/alloc 341,112,672 333,339,952 -2.3% GOOD hard_hole_fits(normal) ghc/alloc 222,164,728 213,433,808 -3.9% GOOD mhu-perf(normal) ghc/alloc 49,011,440 46,706,280 -4.7% GOOD geo. mean +0.1% minimum -8.0% maximum +5.4% All performance regressions were investigated in depth. The surviving ones: - MultiComponentModules100, MultiComponentModulesRecomp100, MultiComponentModulesRecomp regresses because existing bugs that make an additional implicit edge do too much redundant work: #27053 and #27461 - T13820, T18140, T10547, T13035 regress because we load an additional interface and associated Names for GHC.Essentials. ------------------------- Metric Decrease: MultiLayerModules T13379 T13701 T14697 T26989 T4801 T783 T9961 hard_hole_fits mhu-perf size_hello_artifact size_hello_obj size_hello_unicode Metric Increase: LinkableUsage01 LinkableUsage02 MultiComponentModules100 MultiComponentModulesRecomp MultiComponentModulesRecomp100 T10547 T13035 T13820 T18140 T18698a T18698b T20049 ------------------------- Bumps submodule binary Closes #27013 - - - - - 61665e79 by sheaf at 2026-08-14T01:09:33+02:00 Allow GHC.Essentials to be hidden This commit overhauls several aspects of the known entity handling, in order to allow GHC.Essentials to be hidden without a proliferation of special cases in the compiler. The main contribution is to introduce the 'UnresolvedImport' datatype which cleans up a lot of ad-hoc handling relating to 'ModSummary', fixing #27603. This allows us to reduce duplication, e.g. by having Backpack reuse 'mkUnresolvedImports' instead of replicating the "add implicit imports" logic. It also makes it easier to avoid undesirable edge cases (such as making sure that the Template Haskell 'reifyModule' function does not leak the implicit GHC.Essentials import). In particular, the infamous 'findImportedModuleWithIsBoot' is now simply 'resolveImport', taking a single 'UnresolvedImport' and resolving it to a 'FindResult' (usually a 'Module'). Other changes: - Cache the result of looking up GHC.Essentials (in TcM and DsM environments) to avoid redundant work. This reduces allocations on LinkableUsage01 and hard_hole_fits. - Properly look up known entities for StaticPointers like we do for other known entities everywhere else. This allows e.g. modules in ghc-internal to use -XStaticPointers. - When using multiple home units, we are now careful to handle the situation in which we may have multiple GHC.Essentials modules around. See the new tests under 'driver/multipleHomeUnits'. - - - - - b19fcc1c by Vladislav Zavialov at 2026-08-14T06:26:11-04:00 Increase test coverage of diagnostics, batch 2 Add test cases for the previously untested diagnostics: [GHC-26133] TcRnForeignImportPrimSafeAnn [GHC-68444] SumAltArityExceeded [GHC-63966] IllegalSumAlt [GHC-23882] IllegalDeclaration [GHC-60220] InvalidCCallImpent [GHC-18816] RecGadtNoCons [GHC-38140] GadtNoCons [GHC-37056] InvalidTypeInstanceHeader [GHC-78486] InvalidTyFamInstLHS [GHC-39639] DefaultDataInstDecl [GHC-78822] AssocDefaultNotAssoc [GHC-43510] NotSimpleUnliftedType [GHC-41843] IOResultExpected [GHC-07641] AtLeastOneArgExpected [GHC-52886] InvalidTopDecl Remove unused error constructors: [GHC-92057] ImportLookupAmbiguous - - - - - 7b27f25a by Simon Jakobi at 2026-08-14T06:26:54-04:00 testsuite: Drop peak_megabytes_allocated from LinkableUsage tests LinkableUsage01/02 collected all metrics with a 2% tolerance. For peak_megabytes_allocated, whose granularity is 1 MB, that window is under 0.7 MB at this test's ~34 MB peak, so any 1 MB step failed the test (#27613, #27489). Drop that metric: max_bytes_used guards the Linkable-retention property with byte granularity, at a tolerance that still comfortably exceeds the noise observed in CI. Assisted-by: Claude Fable 5 - - - - - e5de423b by Simon Jakobi at 2026-08-14T06:26:54-04:00 testsuite: Don't truncate fractional baselines when computing bounds RelativeMetricAcceptanceWindow.get_bounds truncated the baseline with int() before applying the tolerance. Baselines can be fractional (they are averaged over several measurements), so this skewed the acceptance window downwards: in #27613, a baseline of 33.67 at 2% tolerance yielded bounds (32, 34) instead of (32, 35), rejecting a measurement that was within tolerance. Assisted-by: Claude Fable 5 - - - - - db959f83 by Simon Jakobi at 2026-08-14T15:16:44-04:00 testsuite: Expect length001 failure in nonmoving_thr_sanity length001 relies on an optimization rule to avoid excessive stack use. The nonmoving_thr_sanity way does not enable optimization, so classify its stack overflow as an expected failure, as is already done for the other unoptimized nonmoving ways. Assisted-by: gpt-5.6-sol via Codex CLI - - - - - 4f2b7d90 by Simon Jakobi at 2026-08-14T15:16:44-04:00 testsuite: Omit T22859 in nonmoving threaded ways T22859 checks allocation-limit handlers with output that depends on precise allocation behaviour. The nonmoving threaded ways change where these limits are reached, just as the already-omitted LLVM ways do. Omit these ways instead of treating their incidental output differences as test failures. Assisted-by: gpt-5.6-sol via Codex CLI - - - - - c4abddcb by Simon Jakobi at 2026-08-14T15:16:44-04:00 rts/js: Implement eq_thread, and test Eq/Ord ThreadId (#16761) Since d1f3c63701, Eq ThreadId is implemented via the RTS function eq_thread, but the JS RTS never provided it, so comparing ThreadIds for equality on the JS backend crashed with ReferenceError: h$eq_thread is not defined Like the C implementation, h$eq_thread uses pointer equality: The JS RTS has exactly one thread object per thread. Since previously no test exercised eq_thread directly, this commit adds a test covering equality, its stability across GC, and agreement with Ord. Assisted-by: Claude Fable 5 - - - - - 4a7defa1 by Simon Jakobi at 2026-08-14T15:16:44-04:00 testsuite: Make listThreads1 insensitive to the RTS's own threads listThreads1 expected `listThreads` to return exactly [ThreadId 1]. That holds only under a non-threaded RTS. Under a threaded RTS however there are more threads present, so we change the test to simply check that `myThreadId` is present in the list. Assisted-by: Claude Opus 5 - - - - - b757727a by Vladislav Zavialov at 2026-08-14T15:17:27-04:00 Fix tcLookupId panic with RequiredTypeArguments and PatternSynonyms (#27586) The arguments declared on the left-hand side of a pattern synonym are looked up as term variables bound by its right-hand side. Prior to this patch, that lookup panicked with RequiredTypeArguments: data T a where MkT :: forall a -> T a pattern P :: Int -> T Int pattern P x = MkT x On the RHS, `x` looks like a term argument, so the renamer binds it in the term namespace. Only during type checking does it turn out to be a type variable, so the lookup on the LHS finds an ATyVar rather than an ATcId. As the lookup was done with tcLookupId, it resulted in a panic. Now the arguments are looked up with tcLookupPatSynArg, which reports an illegal term-level use of `x`, just as an ordinary function definition `f (MkT x) = x` does. Test cases: T27586a T27586b T27586c Assisted-by: Claude Opus 5 - - - - - c130188d by Rodrigo Mesquita at 2026-08-15T06:29:53-04:00 loopImports: Don't dup ms_uid in summary imports We were writing the ms_unitid of the mod summary with every single import of that module That complicated the code (as though the UnitId in that list could ever be something else) and also allocates unnecessarily per every mod import. Very slight allocation decrease measured locally in a few tests: (MultiComponentModulesRecomp: -0.06%; MultiComponentModulesRecomp100: -0.05%) Purely a clean up. - - - - - c71166a8 by Rodrigo Mesquita at 2026-08-15T06:29:53-04:00 downsweep: make control flow simpler and cache correct This refactor extracts the control flow of downsweep into a single function `dfsBuild`, which takes care of iteratively expanding and traversing all nodes of the in-construction module graph necessary to build a full `ModuleGraph`. There are three levels of caching going on, all of which are necessary to make sure we don't do repeated work (notably, NEVER summarise the same module twice). 1. `dfsBuild` accumulates the final module graph and never revisits the same node of the module graph. Cache is keyed by the final `ModuleGraph`s `NodeKey`s. 2. For Module A in home-unit u1, each import in the list of imports needs to be *found* (call to `findImportedModuleWithIsBoot`): at this point, we only have the `ModuleName` of the import, not the `Module`. This *finding* is somewhat expensive, so we cache it as well (`ImportsCache`). The cache key is the home-unit to which the module belongs~[1], the import package qualifier, and the ModuleName. [1] Different home-units will have different package flags, which means potentially different `Module` resolution for the same `ModuleName`. 3. The most expensive operation we want to avoid is summarising a `Module` into a `ModSummary`, which notably involves parsing the module header from scratch. The third cache, in essence, maps a `Module` to its `ModSummary` (named `ModSummaryCache`). This cache upholds the invariant: we NEVER summarise the same module twice. In practice, the cache key is the Module's UnitId and the Source path; the reason is we need to distinguish between `.hs` and `.hs-boot` files, as their summaries will differ. Note that (2) can't guarantee this alone: Two ModuleName imports in separate units can (and likely do) map to the same `Module`. Note that the previous implementation failed to achieve the no-duplicate-work summarisation invariant, and we ended up doing a quadratic amount of processing in scenarios like test `MultiComponentModules100`. See also Note [Downsweep Control Flow and Caching] Fixes #27461 Perf changes: MultiComponentModules(normal) ghc/alloc 2,097,389,264 1,992,186,736 -5.0% GOOD MultiComponentModules100(normal) ghc/alloc 24,310,173,770 21,293,867,360 -12.4% GOOD MultiComponentModulesRecomp(normal) ghc/alloc 602,761,394 498,543,984 -17.3% GOOD MultiComponentModulesRecomp100(normal) ghc/alloc 11,885,968,240 8,895,404,864 -25.2% GOOD ------------------------- Metric Decrease: MultiComponentModules MultiComponentModules100 MultiComponentModulesRecomp MultiComponentModulesRecomp100 ------------------------- - - - - - ebc4047b by Rodrigo Mesquita at 2026-08-15T06:29:53-04:00 implicitRequirementsShallow can never reach HoleUnit findImportedModule will never return `HoleUnit` for a `ModuleName` (a `HoleUnit` can only be found as a signature instantiation, never as a directly *imported* thing) Therefore, we can drop `[ModuleName]` returned by `implicitRequirementsShallow`, which makes many things dead code. Namely, the call to `implicitRequirementsShallow` from GHC.Driver.Downsweep which was a performance bottleneck (for doing lots of duplicate work in findImportedModule) is now entirely gone. Fixes #27053 In an MR with this patch and the downsweep refactor (previous commit), CI says: MultiComponentModules(normal) ghc/alloc 2,097,396,728 1,943,662,304 -7.3% GOOD MultiComponentModules100(normal) ghc/alloc 24,310,182,136 17,227,574,440 -29.1% GOOD MultiComponentModulesRecomp(normal) ghc/alloc 602,769,518 449,973,656 -25.3% GOOD MultiComponentModulesRecomp100(normal) ghc/alloc 11,885,976,408 4,828,894,160 -59.4% GOOD ------------------------- Metric Decrease: MultiComponentModules MultiComponentModules100 MultiComponentModulesRecomp MultiComponentModulesRecomp100 ------------------------- - - - - - 85a6ab01 by Rodrigo Mesquita at 2026-08-15T06:29:53-04:00 downsweep: Cache negative results When traversing a module graph structure, a uniquely identified node should always expand to the same thing. I don't see how visiting the same node which failed to be expanded a first time would ever successfully expand the second time we try to expand it (eg. when coming from a different edge to it -- it is still the same node!). The node expansion is local, based just based on the node itself, not on the path to get there. Therefore, this patch removes the weird behavior and commentary of `dfsBuild` wrt to `Nothing` not being cached and being potentially expanded a second time around to something different, which was misleading and, ultimately, incorrect. Now, we have a `MGRes`, which is more explicit about a node being Skipped just being a node that is ignored whenever it is found (and that skip is cached) -- and we may want to do this due to failures or due to just trying nodes which might not work on purpose, like hs-boots. We uniformly cache positive and negative results and remove the assumption that there might be an ordering in which the same node visited at a later time might be expanded differently. This makes it possible to traverse the module nodes in parallel without a change in behavior, since there's no longer a hidden ordering requirement. - - - - - 56747c3f by Rodrigo Mesquita at 2026-08-15T06:29:53-04:00 Organize and clean-up GHC.Driver.Downsweep Simply some cosmetic changes, moving definitions around to structure the module better into its relevant sections (In go (ns ++ ss), it's not a problem to use ++ because it's a good producer and we won't have to append fully before processing the next item in go) - - - - - 12f64118 by Wolfgang Jeltsch at 2026-08-15T06:31:12-04:00 Add support for textual output of bytecode file content - - - - - a737df91 by Brandon Chinn at 2026-08-15T12:40:25-04:00 Add law in qualified strings doc - - - - - e3188581 by Zubin Duggal at 2026-08-15T12:41:06-04:00 DmdAnal: Fix maxDmdType We need to eta expand the smaller DmdType using defaultArgDmd, like in lubDmdType. Introduce zipDmdType as a common combinator to implement both maxDmdType and lubDmdType uniformly. fixes #27626 - - - - - ca9b0b22 by mangoiv at 2026-08-15T12:41:47-04:00 hadrian: set the executable bit for hie-bios.bat - - - - - 1aac7095 by sheaf at 2026-08-16T04:37:16-04:00 Avoid wasteful allocations in mkTyConAppCo The idiom "traverse isReflCo_maybe" followed by "map fst" used in 'GHC.Core.Coercion.mkTyConAppCo' was allocating a lot of waste. This commit uses 'GHC.Data.Unboxed.traverseMaybeUB' to avoid all these unnecessary intermediate allocations. In a quick microbenchmark for 'mkTyConAppCo', this change resulted in: - refl case (all argument coercions are reflexive): - -60% runtime - -80% allocations - non-refl case: - from 0% to -12% runtime (depending on which argument is non-refl) - from 0% to -70% allocations ( -- '' -- ) Fixes #27648 ------------------------- Metric Decrease: FamAppCachePerf SimplCastPerf T12425 T15703 T26426 T3064 T9872a T9872b T9872b_defer T9872c T9872d T5321Fun T9020 T9630 TcPlugin_RewritePerf Metric Increase: LinkableUsage02 ------------------------- - - - - - 3915e982 by Alan Zimmerman at 2026-08-16T04:37:58-04:00 EPA: Remove al_trailing from AnnList It was not being used - - - - - fed942ac by Andreas Klebinger at 2026-08-17T12:11:57-04:00 testsuite: Use sigkill in process009. SIGHUB might have been blocked by a (grand)*parent of the test. In such cases the test would fail as the python process would simply exist gracefully instead of committing to a premature end. By using SIGKILL we can rely on the signal not being blocked, fixing #27578 in the process. - - - - - 574c875f by Andreas Klebinger at 2026-08-17T12:12:39-04:00 Simplify comparison in DFM.hs Fixes #27669 - - - - - d8f1a2a3 by Alan Zimmerman at 2026-08-17T12:13:18-04:00 TTG: Add extension points to BooleanFormula They are currently unused, but will be used for exact print annotations next, allowing us to get rid of LocatedBF / SrcSpanAnnBF - - - - - 93a2b20f by Andreas Klebinger at 2026-08-18T04:31:04-04:00 Fix a number of incorrect module references: Fix module reference in Note [DataCon wrappers are conlike]. Fix module reference in Note [Detailed InertCans Invariants]. Fix module reference in Note [GHC's data format representations]. Fix module reference in Note [Grand plan for static forms]. Fix module reference in Note [How tuples work]. Fix module reference in Note [Solved dictionaries]. Fix module reference in Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]. Fix module reference in Note [The VarBndr type and its uses]. Found the incorrect references with a llm. - - - - - eb0dfb01 by Simon Jakobi at 2026-08-18T04:31:44-04:00 ci: Run stack-hadrian-build only in full-ci pipelines The job exists to catch changes that break hadrian/build-stack (#18726), but nothing in the pipeline depends on it, and it can only break when hadrian's dependencies change. Restricting it to full-ci (like hadrian-multi) still covers marge-bot merge batches, so such breakage cannot reach master unnoticed, while ordinary validate pipelines skip the job. Assisted-by: Claude Fable 5 - - - - - 9600f8d3 by Duncan Coutts at 2026-08-19T14:03:55+01:00 Make signal handling be a responsibility of the I/O manager(s) Previously it was scattered between I/O managers and the scheduler, and especially the scheduler's deadlock detection. Previously the scheduler would poll for pending signals each iteration of the scheduler loop. The scheduler also had some hairy signal functionality in the deadlock detection: in the non-threaded RTS (only) if there were still no threads running after deadlock detection then it would block waiting for signals. But signals can and (in my opinion) should be thought of as just a funny kind of I/O, and thus should be a responsibility of the I/O manager. So now we have the I/O managers poll for signals when they are polling for I/O completion (and removing the separate poll in the scheduler). And when I/O managers block waiting for I/O then they now also start signal handlers if they get interrupted by a signal. Crucially, if there is no pending I/O or timers, the awaitCompletedTimeoutsOrIO will still block waiting for signals. This patch puts us into an intermediate state: it temporarily breaks deadlock detection in the non-threaded RTS. The waiting on I/O currently happens before deadlock detection. This means we'll now wait forever on signals before doing deadlock detection. We need to move waiting after deadlock detection. We'll do that in a later patch. - - - - - 7196ddad by Duncan Coutts at 2026-08-19T14:04:23+01:00 Clean up the RTS internal signal handling API Now that the I/O manager is responsible for signals, we can simplify the API we present for signal handling. We now just need startPendingSignalHandlers, which is called from the I/O managers. We can get rid of awaitUserSignals. We also don't need RtsSignals.h to re-export the platform-specific posix/Signals.h or win32/ConsoleHandler.h We can also hide more of the implementation of signals. Less has to be exposed in posix/Signals.h or win32/ConsoleHandler.h. Indeed, posix/Signals.h becomes empty and we remove it. Partly this is because we don't need inline functions (or macros) in the interface. Also remove signal_handlers from RTS ABI exported symbols list. It does not appear to have any users in the core libs, and its really an internal implementation detail. It should not be exposed unless it's really necessary. - - - - - 58d80cfa by Duncan Coutts at 2026-08-19T14:04:23+01:00 In the scheduler, move I/O blocking after deadlock detection To make deadlock detection effective in the non-threaded RTS when there are deadlocked threads and other unrelated threads waiting on I/O, we need to arrange to do deadlock detection before we block in scheduler to wait on I/O. The solution is to: 1. adjust scheduleFindWork, which runs before deadlock detection, to only poll for I/O and not block; and 2. add a step after deadlock detection to wait on I/O if there are still no threads to run (and there's any I/O or timeouts outstanding) The scheduleCheckBlockedThreads is now so simple that it made more sense to inline it into scheduleFindWork. - - - - - 95bbbb65 by Duncan Coutts at 2026-08-19T14:04:23+01:00 Remove bogus anyPendingTimeoutsOrIO guard from scheduleDetectDeadlock The deadlock detection was only invoked if both of these conditions hold: 1. the run queue is empty 2. there is no pending I/O or timeouts The second condition is unnecessary. The deadlock detection mechanism can find deadlocks even if there are other threads waiting on I/O or timers. Having this extra condition means that we fail to detect blocked threads if there are any threads waiting on I/O or timers. Part of fixing issue #26408 - - - - - a67f5cff by Duncan Coutts at 2026-08-19T14:04:23+01:00 Don't consider pending I/O for early context switch optimisation Context switches are normally initiated by the timer signal. If however the user specifies "context switch as often as possible", with +RTS -C0 then the scheduler arranges for an early context switch (when it's just about to run a Haskell thread). Context switching very often is expensive, so as an optimisation there cases where we do not arrange an early context switch: 1. if there's no other threads to run 2. if there is no pending I/O or timers This patch eliminates case 2, leaving only case 1. The rationale is as follows. The use of this was inconsistent across platforms and threaded/non-threaded RTS ways. It only worked on the non-threaded RTS and on Windows only worked for the win32-legacy I/O manager. On all other combinations anyPendingTimeoutsOrIO would always return false. The fact that nobody noticed and complained about this inconsistency suggests that the feature is not relied upon. If however it turns out that applications do rely on this, then the proper thing to do is not to restore this check, but to add a new I/O manager hint function that returns if there is any pending events that are likely to happen *soon*: for example timeouts expiring within one timeslice, or I/O waits on things likely to complete soon like disk I/O, but not for example socket/pipe I/O. The motivation to avoid this use of anyPendingTimeoutsOrIO is to allow us to eliminate anyPendingTimeoutsOrIO entirely. All other uses of this are just guards on {await,poll}CompletedTimeoutsOrIO and the guards can safely be folded into those functions. This will better cope with some I/O managers having no proper implementation of anyPendingTimeoutsOrIO. Ultimately this will let us simplify the scheduler which currently has to have special #ifdef mingw32_HOST_OS cases to cope with the lack of a working anyPendingTimeoutsOrIO for some Windows I/O managers - - - - - 4a99323e by Duncan Coutts at 2026-08-19T14:04:41+01:00 Remove anyPendingTimeoutsOrIO guarding {poll,await}CompletedTimeoutsOrIO Previously the API of the I/O manager used a two step process: check anyPendingTimeoutsOrIO and then call {poll,await}CompletedTimeoutsOrIO. This was primarily there as a performance thing, to cheaply check if we need to do anything. And then because anyPendingTimeoutsOrIO existed, it was used for other things too. We have now eliminated the other uses, and are just left with the performance pattern. But this was problematic because not all I/O managers correctly implement anyPendingTimeoutsOrIO (specifically the win32 ones), and now that we also make I/O managers responsible for signals then we need to poll/await even if there is no pending I/O or timeouts. If there is no pending I/O or timeouts then await needs to degenerate to just waiting forever for any signals. - - - - - 9d70dda4 by Duncan Coutts at 2026-08-19T14:05:30+01:00 Remove anyPendingTimeoutsOrIO, it is no longer used And this avoids the problems arising from the win32 I/O managers having had a bogus implementation. - - - - - 48abbb0d by Duncan Coutts at 2026-08-19T14:05:30+01:00 Remove second scheduler call to awaitCompletedTimeoutsOrIO Previously awaitCompletedTimeoutsOrIO was called both before and after deadlock detection in the scheduler. The reason for that was that the win32 I/O managers had a bogus implementation of anyPendingTimeoutsOrIO and this was used to guard the call of awaitCompletedTimeoutsOrIO prior to deadlock detection. This meant the first call site was never actually called when using the win32 I/O managers. This was the reason for the second call: the first one was never used. What a mess. So now we have a simple design in the scheduler: 1. poll for completed I/O, timers or signals 2. if no runnable threads: do deadlock detection 3. if still no runnable threads: block waiting for I/O, timers or signals. - - - - - 3eea9e16 by Duncan Coutts at 2026-08-19T14:05:30+01:00 Lift emptyRunQueue guard out of scheduleDetectDeadlock this improved the clarity of the logic when reading the scheduler code. - - - - - c4bcae50 by Duncan Coutts at 2026-08-24T14:22:57+01:00 Make non-threaded deadlock detection also rely on idle GC Only do deadlock detection GC when idle GC kicks in. This also relies on using wakeUpRts, so now do this unconditionally. Previously wakeUpRts was for the threaded rts only. - - - - - 0371d297 by Duncan Coutts at 2026-08-24T14:22:57+01:00 Enable idle GC by default on non-threaded RTS The behaviour is now uniform between the threaded and non-threaded RTS ways. The deadlock detection now relies on idle GC for both threaded and non-threaded ways. Previously deadlock detection did not rely on idle GC for the non-threaded way. Also tweak test T7275 to account for idle GC. This test's output is sensitive to the number of major GCs run. Since this commit enables idle GC for the non-threaded RTS, for this test that increases the number of major GCs, since the test program is frequently idle for more than 300ms. - - - - - 2d1fc539 by Duncan Coutts at 2026-08-24T14:22:57+01:00 Fix state of idle GC control vars with +RTS -V0 Currently when the user uses +RTS -I0, then doIdleGC is set to false. But if the master tick interval -V is set to 0 then the idleGCDelayTime was being set to 0 but doIdleGC was not being set to false, which is inconsistent, and almost certainly buggy. - - - - - d6019101 by Duncan Coutts at 2026-08-24T14:22:57+01:00 Add a long Note [Deadlock detection] It describes the historical and modern designs and their trade-offs. The point is we've now unified the code for deadlock detection between the threaded and non-threaded ways, by changing the non-threaded to follow the same design as the threaded. - - - - - 92fb03e1 by Duncan Coutts at 2026-08-24T14:22:57+01:00 Add a test for deadlock detection, issue #26408 - - - - - 01c20622 by Duncan Coutts at 2026-08-24T14:22:57+01:00 Update the user guide with the revised idle GC behaviour i.e. it's now not just for the threaded RTS, but general. Also document the fact that disabling idle GC also disables deadlock detection. And add a changelog entry. - - - - - 1148 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + changelog.d/27532 - + changelog.d/27626 - + changelog.d/T20363 - + changelog.d/T26423 - + changelog.d/T27368-ppr-unreachable-cmm-blocks.md - + changelog.d/T27440 - + changelog.d/T27455 - + changelog.d/T27557 - + changelog.d/T27583 - + changelog.d/T27586 - + changelog.d/T27589 - + changelog.d/T27639 - + changelog.d/downsweep-refactor - + changelog.d/fix-cmm-dump-labels - + changelog.d/fix-heap-census-large-arrays-19048 - + changelog.d/idle-gc-and-deadlock-detection - + changelog.d/lazy-field-annotations - + changelog.d/link-deterministic-order - + changelog.d/refactor-known-names - + changelog.d/show-byte-code - + changelog.d/unit-index - + changelog.d/warn-defaulted-callstack - compiler/GHC.hs - + compiler/GHC/Builtin.hs - + compiler/GHC/Builtin/KnownKeys.hs - + compiler/GHC/Builtin/KnownOccs.hs - + compiler/GHC/Builtin/Modules.hs - − compiler/GHC/Builtin/Names.hs - − compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Casts.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - + compiler/GHC/Builtin/TH.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - − compiler/GHC/Builtin/Utils.hs - + compiler/GHC/Builtin/WiredIn/Ids.hs - compiler/GHC/Builtin/Types/Prim.hs → compiler/GHC/Builtin/WiredIn/Prim.hs - compiler/GHC/Builtin/Types/Literals.hs → compiler/GHC/Builtin/WiredIn/TypeLits.hs - compiler/GHC/Builtin/Types.hs → compiler/GHC/Builtin/WiredIn/Types.hs - compiler/GHC/Builtin/Types.hs-boot → compiler/GHC/Builtin/WiredIn/Types.hs-boot - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Serialize.hs - + compiler/GHC/ByteCode/Show.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/CmmToAsm/Format.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Data/Unboxed.hs - compiler/GHC/Data/Word64Map/Internal.hs - compiler/GHC/Data/Word64Map/Lazy.hs - compiler/GHC/Data/Word64Map/Strict.hs - compiler/GHC/Data/Word64Map/Strict/Internal.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Config/Tidy.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/KnotVars.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Main/Hsc.hs - compiler/GHC/Driver/Main/Interactive.hs - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Decls/Overlap.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Stats.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Foreign/Utils.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Ppr.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Env.hs - − compiler/GHC/Iface/Env.hs-boot - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Iface/Warnings.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Header.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Lit.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Context.hs - compiler/GHC/Runtime/Debugger.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Stg/BcPrep.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/DataCon.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Foreign.hs - compiler/GHC/StgToCmm/Lit.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Functor.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Generics.hs - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Default.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/FunDeps.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Plugin.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/FunDeps.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/LclEnv.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Arity.hs - compiler/GHC/Types/DefaultEnv.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/ForeignCall.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/InlinePragma.hs - compiler/GHC/Types/Literal.hs - compiler/GHC/Types/Name.hs - compiler/GHC/Types/Name/Cache.hs - compiler/GHC/Types/Name/Ppr.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Types/TyThing.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/Unique/DFM.hs - compiler/GHC/Types/Unique/FM.hs - + compiler/GHC/Types/UnresolvedImport.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Unit.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/External.hs - + compiler/GHC/Unit/External/Database.hs - + compiler/GHC/Unit/External/Index.hs - + compiler/GHC/Unit/External/ModuleOrigin.hs - + compiler/GHC/Unit/External/Providers.hs - + compiler/GHC/Unit/External/Query.hs - + compiler/GHC/Unit/External/Substitution.hs - + compiler/GHC/Unit/External/Validate.hs - + compiler/GHC/Unit/External/Visibility.hs - + compiler/GHC/Unit/External/Wired.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs - compiler/GHC/Unit/Home/Graph.hs - compiler/GHC/Unit/Info.hs - compiler/GHC/Unit/Module/Deps.hs - compiler/GHC/Unit/Module/ModSummary.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/State.hs-boot - compiler/GHC/Unit/Types.hs - compiler/GHC/Utils/Binary.hs - − compiler/GHC/Utils/Binary/Typeable.hs - compiler/Language/Haskell/Syntax/BooleanFormula.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/ghc.cabal.in - docs/index.html.in - docs/users_guide/debugging.rst - docs/users_guide/exts/qualified_strings.rst - docs/users_guide/exts/strict.rst - docs/users_guide/ghc_config.py.in - docs/users_guide/runtime_control.rst - docs/users_guide/separate_compilation.rst - docs/users_guide/using-warnings.rst - docs/users_guide/using.rst - ghc/GHC/Driver/Session/Mode.hs - ghc/GHCi/UI.hs - ghc/GHCi/UI/Monad.hs - ghc/Main.hs - − hadrian/hie-bios - hadrian/hie-bios.bat - hadrian/src/Hadrian/Builder/Ar.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Nofib.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Rules/SourceDist.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hie.yaml - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/base/src/Control/Applicative.hs - libraries/base/src/Control/Concurrent.hs - libraries/base/src/Control/Concurrent/Chan.hs - libraries/base/src/Control/Concurrent/QSem.hs - libraries/base/src/Control/Concurrent/QSemN.hs - libraries/base/src/Data/Array/Byte.hs - libraries/base/src/Data/Bifoldable.hs - libraries/base/src/Data/Bifoldable1.hs - libraries/base/src/Data/Bifunctor.hs - libraries/base/src/Data/Bitraversable.hs - libraries/base/src/Data/Bool.hs - libraries/base/src/Data/Complex.hs - libraries/base/src/Data/Data.hs - libraries/base/src/Data/Enum.hs - libraries/base/src/Data/Fixed.hs - libraries/base/src/Data/Foldable1.hs - libraries/base/src/Data/Functor/Classes.hs - libraries/base/src/Data/Functor/Compose.hs - libraries/base/src/Data/Functor/Contravariant.hs - libraries/base/src/Data/Functor/Product.hs - libraries/base/src/Data/Functor/Sum.hs - libraries/base/src/Data/List.hs - libraries/base/src/Data/List/NonEmpty.hs - libraries/base/src/Data/List/NubOrdSet.hs - libraries/base/src/Data/Semigroup.hs - libraries/base/src/Data/Version.hs - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/ByteOrder.hs - + libraries/base/src/GHC/Essentials.hs - libraries/base/src/GHC/Exts.hs - libraries/base/src/GHC/Fingerprint.hs - libraries/base/src/GHC/RTS/Flags.hs - libraries/base/src/GHC/ResponseFile.hs - libraries/base/src/GHC/Stack.hs - libraries/base/src/GHC/Stats.hs - libraries/base/src/GHC/Weak/Finalize.hs - libraries/base/src/Numeric.hs - libraries/base/src/Prelude.hs - libraries/base/src/System/CPUTime/Posix/ClockGetTime.hsc - libraries/base/src/System/CPUTime/Posix/RUsage.hsc - libraries/base/src/System/CPUTime/Posix/Times.hsc - libraries/base/src/System/CPUTime/Unsupported.hs - libraries/base/src/System/Console/GetOpt.hs - libraries/base/src/System/Exit.hs - libraries/base/src/System/IO.hs - libraries/base/src/System/IO/OS.hs - libraries/base/src/System/IO/Unsafe.hs - libraries/base/src/System/Info.hs - libraries/base/src/System/Timeout.hs - libraries/base/src/Text/Printf.hs - libraries/base/src/Text/Read.hs - libraries/base/src/Text/Show/Functions.hs - libraries/base/tests/all.T - libraries/base/tests/listThreads1.hs - libraries/base/tests/listThreads1.stdout - libraries/base/tests/perf/ElemFusionUnknownList_O1.stderr - libraries/base/tests/perf/ElemFusionUnknownList_O2.stderr - libraries/binary - libraries/ghc-experimental/src/Data/Sum/Experimental.hs - libraries/ghc-experimental/src/Data/Tuple/Experimental.hs - libraries/ghc-experimental/src/GHC/Profiling/Eras.hs - libraries/ghc-experimental/src/Prelude/Experimental.hs - libraries/ghc-internal/codepages/MakeTable.hs - libraries/ghc-internal/ghc-internal.cabal.in - libraries/ghc-internal/include/RtsIfaceSymbols.h - libraries/ghc-internal/src/GHC/Internal/AllocationLimitHandler.hs - libraries/ghc-internal/src/GHC/Internal/Arr.hs - libraries/ghc-internal/src/GHC/Internal/ArrayArray.hs - libraries/ghc-internal/src/GHC/Internal/Base.hs - libraries/ghc-internal/src/GHC/Internal/Bignum/Backend.hs - libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/GMP.hs - libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Native.hs - libraries/ghc-internal/src/GHC/Internal/Bignum/BigNat.hs - libraries/ghc-internal/src/GHC/Internal/Bignum/BigNat.hs-boot - libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs - libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs-boot - libraries/ghc-internal/src/GHC/Internal/Bignum/Natural.hs - libraries/ghc-internal/src/GHC/Internal/Bignum/Natural.hs-boot - libraries/ghc-internal/src/GHC/Internal/Bignum/Primitives.hs - libraries/ghc-internal/src/GHC/Internal/Bignum/WordArray.hs - libraries/ghc-internal/src/GHC/Internal/Bits.hs - libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs - libraries/ghc-internal/src/GHC/Internal/CString.hs - libraries/ghc-internal/src/GHC/Internal/Char.hs - libraries/ghc-internal/src/GHC/Internal/Classes.hs - libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs - libraries/ghc-internal/src/GHC/Internal/Clock.hsc - libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs - libraries/ghc-internal/src/GHC/Internal/Conc/Bound.hs - libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs - libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs - libraries/ghc-internal/src/GHC/Internal/Conc/POSIX/Const.hsc - libraries/ghc-internal/src/GHC/Internal/Conc/Signal.hs - libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs - libraries/ghc-internal/src/GHC/Internal/ConsoleHandler.hsc - libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs - libraries/ghc-internal/src/GHC/Internal/Control/Category.hs - libraries/ghc-internal/src/GHC/Internal/Control/Concurrent/MVar.hs - libraries/ghc-internal/src/GHC/Internal/Control/Exception.hs - libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad/IO/Class.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Imp.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy/Imp.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad/Zip.hs - libraries/ghc-internal/src/GHC/Internal/Data/Bits.hs - libraries/ghc-internal/src/GHC/Internal/Data/Coerce.hs - libraries/ghc-internal/src/GHC/Internal/Data/Data.hs - libraries/ghc-internal/src/GHC/Internal/Data/Dynamic.hs - libraries/ghc-internal/src/GHC/Internal/Data/Either.hs - libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs - libraries/ghc-internal/src/GHC/Internal/Data/Function.hs - libraries/ghc-internal/src/GHC/Internal/Data/Functor.hs - libraries/ghc-internal/src/GHC/Internal/Data/Functor/Const.hs - libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs - libraries/ghc-internal/src/GHC/Internal/Data/Functor/Utils.hs - libraries/ghc-internal/src/GHC/Internal/Data/IORef.hs - libraries/ghc-internal/src/GHC/Internal/Data/List.hs - libraries/ghc-internal/src/GHC/Internal/Data/List/NonEmpty.hs - libraries/ghc-internal/src/GHC/Internal/Data/Maybe.hs - libraries/ghc-internal/src/GHC/Internal/Data/Monoid.hs - libraries/ghc-internal/src/GHC/Internal/Data/NonEmpty.hs - libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs - libraries/ghc-internal/src/GHC/Internal/Data/Ord.hs - libraries/ghc-internal/src/GHC/Internal/Data/Proxy.hs - libraries/ghc-internal/src/GHC/Internal/Data/STRef.hs - libraries/ghc-internal/src/GHC/Internal/Data/Semigroup/Internal.hs - libraries/ghc-internal/src/GHC/Internal/Data/String.hs - libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs - libraries/ghc-internal/src/GHC/Internal/Data/Tuple.hs - libraries/ghc-internal/src/GHC/Internal/Data/Type/Bool.hs - libraries/ghc-internal/src/GHC/Internal/Data/Type/Coercion.hs - libraries/ghc-internal/src/GHC/Internal/Data/Type/Equality.hs - libraries/ghc-internal/src/GHC/Internal/Data/Type/Ord.hs - libraries/ghc-internal/src/GHC/Internal/Data/Typeable.hs - libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs - libraries/ghc-internal/src/GHC/Internal/Data/Unique.hs - libraries/ghc-internal/src/GHC/Internal/Data/Version.hs - libraries/ghc-internal/src/GHC/Internal/Data/Void.hs - libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs - libraries/ghc-internal/src/GHC/Internal/Desugar.hs - libraries/ghc-internal/src/GHC/Internal/Encoding/UTF8.hs - libraries/ghc-internal/src/GHC/Internal/Enum.hs - libraries/ghc-internal/src/GHC/Internal/Enum.hs-boot - libraries/ghc-internal/src/GHC/Internal/Environment.hs - libraries/ghc-internal/src/GHC/Internal/Err.hs - libraries/ghc-internal/src/GHC/Internal/Event/Arr.hs - libraries/ghc-internal/src/GHC/Internal/Event/Array.hs - libraries/ghc-internal/src/GHC/Internal/Event/Control.hs - libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc - libraries/ghc-internal/src/GHC/Internal/Event/IntTable.hs - libraries/ghc-internal/src/GHC/Internal/Event/IntVar.hs - libraries/ghc-internal/src/GHC/Internal/Event/Internal.hs - libraries/ghc-internal/src/GHC/Internal/Event/Internal/Types.hs - libraries/ghc-internal/src/GHC/Internal/Event/KQueue.hsc - libraries/ghc-internal/src/GHC/Internal/Event/Manager.hs - libraries/ghc-internal/src/GHC/Internal/Event/PSQ.hs - libraries/ghc-internal/src/GHC/Internal/Event/Poll.hsc - libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs - libraries/ghc-internal/src/GHC/Internal/Event/TimeOut.hs - libraries/ghc-internal/src/GHC/Internal/Event/TimerManager.hs - libraries/ghc-internal/src/GHC/Internal/Event/Unique.hs - libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc - libraries/ghc-internal/src/GHC/Internal/Event/Windows/Clock.hs - libraries/ghc-internal/src/GHC/Internal/Event/Windows/ConsoleEvent.hsc - libraries/ghc-internal/src/GHC/Internal/Event/Windows/FFI.hsc - libraries/ghc-internal/src/GHC/Internal/Event/Windows/ManagedThreadPool.hs - libraries/ghc-internal/src/GHC/Internal/Event/Windows/Thread.hs - libraries/ghc-internal/src/GHC/Internal/Exception.hs - libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs - libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot - libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs - libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs-boot - libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs - libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs-boot - libraries/ghc-internal/src/GHC/Internal/ExecutionStack.hs - libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc - libraries/ghc-internal/src/GHC/Internal/Exts.hs - libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs - libraries/ghc-internal/src/GHC/Internal/Fingerprint/Type.hs - libraries/ghc-internal/src/GHC/Internal/Float.hs - libraries/ghc-internal/src/GHC/Internal/Float/ConversionUtils.hs - libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/C/ConstPtr.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/C/String.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/C/String/Encoding.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/C/Types.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/ForeignPtr/Imp.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Alloc.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Array.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Error.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Pool.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Utils.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/Ptr.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/Storable.hs - libraries/ghc-internal/src/GHC/Internal/ForeignPtr.hs - libraries/ghc-internal/src/GHC/Internal/ForeignSrcLang.hs - libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs - libraries/ghc-internal/src/GHC/Internal/GHCi.hs - libraries/ghc-internal/src/GHC/Internal/GHCi/Helpers.hs - libraries/ghc-internal/src/GHC/Internal/Generics.hs - libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs - libraries/ghc-internal/src/GHC/Internal/Heap/Constants.hsc - libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc - libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc - libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc - libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs - libraries/ghc-internal/src/GHC/Internal/IO.hs - libraries/ghc-internal/src/GHC/Internal/IO.hs-boot - libraries/ghc-internal/src/GHC/Internal/IO/Buffer.hs - libraries/ghc-internal/src/GHC/Internal/IO/BufferedIO.hs - libraries/ghc-internal/src/GHC/Internal/IO/Device.hs - libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs - libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage.hs - libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/API.hs - libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/Table.hs - libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Failure.hs - libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Iconv.hs - libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Latin1.hs - libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Types.hs - libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF16.hs - libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF32.hs - libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF8.hs - libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs - libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs-boot - libraries/ghc-internal/src/GHC/Internal/IO/FD.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Common.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Flock.hsc - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/NoOp.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Windows.hsc - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs-boot - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Windows.hs - libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs - libraries/ghc-internal/src/GHC/Internal/IO/SubSystem.hs - libraries/ghc-internal/src/GHC/Internal/IO/Unsafe.hs - libraries/ghc-internal/src/GHC/Internal/IO/Windows/Encoding.hs - libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc - libraries/ghc-internal/src/GHC/Internal/IOArray.hs - libraries/ghc-internal/src/GHC/Internal/IORef.hs - libraries/ghc-internal/src/GHC/Internal/InfoProv.hs - libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc - libraries/ghc-internal/src/GHC/Internal/Int.hs - libraries/ghc-internal/src/GHC/Internal/IsList.hs - libraries/ghc-internal/src/GHC/Internal/Ix.hs - libraries/ghc-internal/src/GHC/Internal/JS/Foreign/Callback.hs - libraries/ghc-internal/src/GHC/Internal/JS/Prim.hs - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - libraries/ghc-internal/src/GHC/Internal/Lexeme.hs - libraries/ghc-internal/src/GHC/Internal/List.hs - libraries/ghc-internal/src/GHC/Internal/MVar.hs - libraries/ghc-internal/src/GHC/Internal/Magic.hs - libraries/ghc-internal/src/GHC/Internal/Magic/Dict.hs - libraries/ghc-internal/src/GHC/Internal/Maybe.hs - libraries/ghc-internal/src/GHC/Internal/Num.hs - libraries/ghc-internal/src/GHC/Internal/Num.hs-boot - libraries/ghc-internal/src/GHC/Internal/Numeric.hs - libraries/ghc-internal/src/GHC/Internal/OverloadedLabels.hs - libraries/ghc-internal/src/GHC/Internal/Pack.hs - libraries/ghc-internal/src/GHC/Internal/Prim/Exception.hs - libraries/ghc-internal/src/GHC/Internal/Prim/Ext.hs - libraries/ghc-internal/src/GHC/Internal/Prim/Panic.hs - libraries/ghc-internal/src/GHC/Internal/Prim/PtrEq.hs - libraries/ghc-internal/src/GHC/Internal/Profiling.hs - libraries/ghc-internal/src/GHC/Internal/Ptr.hs - libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc - libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc - libraries/ghc-internal/src/GHC/Internal/Read.hs - libraries/ghc-internal/src/GHC/Internal/Real.hs - libraries/ghc-internal/src/GHC/Internal/Real.hs-boot - libraries/ghc-internal/src/GHC/Internal/Records.hs - libraries/ghc-internal/src/GHC/Internal/ST.hs - libraries/ghc-internal/src/GHC/Internal/STM.hs - libraries/ghc-internal/src/GHC/Internal/STRef.hs - libraries/ghc-internal/src/GHC/Internal/Show.hs - libraries/ghc-internal/src/GHC/Internal/Stable.hs - libraries/ghc-internal/src/GHC/Internal/StableName.hs - libraries/ghc-internal/src/GHC/Internal/Stack.hs - libraries/ghc-internal/src/GHC/Internal/Stack.hs-boot - libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs - libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc - libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs - libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc - libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc - libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs - libraries/ghc-internal/src/GHC/Internal/Stack/Types.hs - libraries/ghc-internal/src/GHC/Internal/StaticPtr.hs - libraries/ghc-internal/src/GHC/Internal/StaticPtr/Internal.hs - libraries/ghc-internal/src/GHC/Internal/Stats.hsc - libraries/ghc-internal/src/GHC/Internal/Storable.hs - libraries/ghc-internal/src/GHC/Internal/System/Environment.hs - libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc - libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc - libraries/ghc-internal/src/GHC/Internal/System/IO/Error.hs - libraries/ghc-internal/src/GHC/Internal/System/Mem.hs - libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs - libraries/ghc-internal/src/GHC/Internal/System/Posix/Types.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs - libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs - libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs - libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadP.hs - libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadPrec.hs - libraries/ghc-internal/src/GHC/Internal/Text/Read/Lex.hs - libraries/ghc-internal/src/GHC/Internal/TopHandler.hs - libraries/ghc-internal/src/GHC/Internal/Tuple.hs - libraries/ghc-internal/src/GHC/Internal/Type/Reflection.hs - libraries/ghc-internal/src/GHC/Internal/Type/Reflection/Unsafe.hs - libraries/ghc-internal/src/GHC/Internal/TypeError.hs - libraries/ghc-internal/src/GHC/Internal/TypeLits.hs - libraries/ghc-internal/src/GHC/Internal/TypeLits/Internal.hs - libraries/ghc-internal/src/GHC/Internal/TypeNats.hs - libraries/ghc-internal/src/GHC/Internal/TypeNats/Internal.hs - libraries/ghc-internal/src/GHC/Internal/Types.hs - libraries/ghc-internal/src/GHC/Internal/Unicode.hs - libraries/ghc-internal/src/GHC/Internal/Unicode/Bits.hs - libraries/ghc-internal/src/GHC/Internal/Unicode/Char/DerivedCoreProperties.hs - libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/GeneralCategory.hs - libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleLowerCaseMapping.hs - libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleTitleCaseMapping.hs - libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleUpperCaseMapping.hs - libraries/ghc-internal/src/GHC/Internal/Unicode/Version.hs - libraries/ghc-internal/src/GHC/Internal/Unsafe/Coerce.hs - libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Conc.hs - libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Conc/Internal.hs - libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.hs - libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs - libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs - libraries/ghc-internal/src/GHC/Internal/Weak.hs - libraries/ghc-internal/src/GHC/Internal/Weak/Finalize.hs - libraries/ghc-internal/src/GHC/Internal/Windows.hs - libraries/ghc-internal/src/GHC/Internal/Word.hs - libraries/ghc-internal/tools/ucd2haskell/exe/UCD2Haskell/ModuleGenerators.hs - libraries/ghc-prim/Dummy.hs - libraries/ghc-prim/ghc-prim.cabal - libraries/template-haskell/Language/Haskell/TH/Lib.hs - linters/lint-codes/LintCodes/Static.hs - rts/Apply.cmm - rts/IOManager.c - rts/IOManager.h - rts/LdvProfile.c - rts/Linker.c - rts/ZeroSlop.c → rts/MarkSlop.c - rts/PrimOps.cmm - rts/Printer.c - rts/ProfHeap.c - rts/RtsFlags.c - rts/RtsSignals.h - rts/RtsStartup.c - rts/RtsSymbols.c - rts/Schedule.c - rts/Schedule.h - rts/ThreadPaused.c - rts/Timer.c - rts/include/Cmm.h - rts/include/rts/RtsToHsIface.h - rts/include/rts/storage/ClosureMacros.h - rts/js/thread.js - rts/posix/Poll.c - rts/posix/Poll.h - rts/posix/Select.c - rts/posix/Signals.c - − rts/posix/Signals.h - rts/rts.cabal - rts/sm/NonMovingMark.c - rts/sm/Sanity.c - rts/sm/Storage.c - rts/win32/AwaitEvent.c - rts/win32/ConsoleHandler.c - rts/win32/ConsoleHandler.h - testsuite/.gitignore - testsuite/Makefile - testsuite/driver/perf_notes.py - testsuite/driver/runtests.py - testsuite/driver/term_color.py - testsuite/driver/testlib.py - testsuite/driver/testutil.py - testsuite/tests/ado/T13242a.stderr - testsuite/tests/annotations/should_fail/annfail10.stderr - testsuite/tests/backpack/cabal/bkpcabal07/Makefile - testsuite/tests/backpack/should_compile/T20396.stderr - testsuite/tests/backpack/should_fail/bkpfail17.stderr - testsuite/tests/bytecode/TLinkable/all.T - testsuite/tests/cabal/T12485/Makefile - + testsuite/tests/cabal/T27013a/Makefile - + testsuite/tests/cabal/T27013a/Setup.hs - + testsuite/tests/cabal/T27013a/all.T - + testsuite/tests/cabal/T27013a/composition.cabal - + testsuite/tests/cabal/T27013a/src/Data/Composition.hs - + testsuite/tests/cabal/T27013d/Composition.hs - + testsuite/tests/cabal/T27013d/Makefile - + testsuite/tests/cabal/T27013d/T27013d.stdout - + testsuite/tests/cabal/T27013d/all.T - testsuite/tests/callarity/unittest/CallArity1.hs - testsuite/tests/cmm/should_compile/Makefile - + testsuite/tests/cmm/should_compile/T27368-ppr-debug.cmm - + testsuite/tests/cmm/should_compile/T27368-ppr-debug.stdout - testsuite/tests/cmm/should_compile/all.T - + testsuite/tests/concurrent/should_run/T16761.hs - + testsuite/tests/concurrent/should_run/T16761.stdout - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/corelint/LintEtaExpand.hs - testsuite/tests/corelint/T21115b.stderr - testsuite/tests/corelint/T27374.hs - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/deSugar/should_compile/T13208.stdout - testsuite/tests/deSugar/should_compile/T16615.stderr - testsuite/tests/deSugar/should_compile/T2431.stderr - + testsuite/tests/deSugar/should_run/LazyFieldAnnotationsSemantics.hs - + testsuite/tests/deSugar/should_run/LazyFieldAnnotationsSemantics.stdout - testsuite/tests/deSugar/should_run/all.T - testsuite/tests/default/DefaultImportFail01.stderr - testsuite/tests/default/DefaultImportFail02.stderr - testsuite/tests/default/DefaultImportFail03.stderr - testsuite/tests/default/DefaultImportFail04.stderr - testsuite/tests/default/DefaultImportFail05.stderr - testsuite/tests/default/DefaultImportFail07.stderr - testsuite/tests/default/T25775.stderr - testsuite/tests/deriving/should_compile/T14682.stderr - testsuite/tests/deriving/should_compile/T20496.stderr - testsuite/tests/diagnostic-codes/codes.stdout - testsuite/tests/dmdanal/should_compile/T23398.stderr - + testsuite/tests/dmdanal/should_run/M2.hs - + testsuite/tests/dmdanal/should_run/T27626.hs - + testsuite/tests/dmdanal/should_run/T27626.stdout - testsuite/tests/dmdanal/should_run/all.T - + testsuite/tests/driver/T26423/Hello.hs - + testsuite/tests/driver/T26423/Makefile - + testsuite/tests/driver/T26423/T26423.hs - + testsuite/tests/driver/T26423/T26423.stderr - + testsuite/tests/driver/T26423/T26423.stdout - + testsuite/tests/driver/T26423/all.T - + testsuite/tests/driver/T26423/test/Test.hs - + testsuite/tests/driver/T26423/test/test.pkg - + testsuite/tests/driver/T27013b/Makefile - + testsuite/tests/driver/T27013b/T27013b.stdout - + testsuite/tests/driver/T27013b/X.hs - + testsuite/tests/driver/T27013b/all.T - + testsuite/tests/driver/T27013c/Makefile - + testsuite/tests/driver/T27013c/T27013c.stdout - + testsuite/tests/driver/T27013c/X.hs - + testsuite/tests/driver/T27013c/all.T - + testsuite/tests/driver/T27013e/T27013e.hs - + testsuite/tests/driver/T27013e/T27013e.stderr - + testsuite/tests/driver/T27013e/all.T - + testsuite/tests/driver/T27013f/T27013f.hs - + testsuite/tests/driver/T27013f/T27013f.stderr - + testsuite/tests/driver/T27013f/all.T - + testsuite/tests/driver/T27013g/T27013g.hs - + testsuite/tests/driver/T27013g/all.T - + testsuite/tests/driver/T27013h/GHC/Essentials.hs - + testsuite/tests/driver/T27013h/T27013h.stderr - + testsuite/tests/driver/T27013h/all.T - + testsuite/tests/driver/T27013h/unitT27013h - + testsuite/tests/driver/T27013i/T27013i.hs - + testsuite/tests/driver/T27013i/T27013i.stderr - + testsuite/tests/driver/T27013i/all.T - + testsuite/tests/driver/T27461/Main1.hs - + testsuite/tests/driver/T27461/Main2.hs - + testsuite/tests/driver/T27461/Makefile - + testsuite/tests/driver/T27461/T27461a.stderr - + testsuite/tests/driver/T27461/T27461b.script - + testsuite/tests/driver/T27461/T27461b.stderr - + testsuite/tests/driver/T27461/T27461b.stdout - + testsuite/tests/driver/T27461/all.T - + testsuite/tests/driver/T27461/src/Bar.hs - testsuite/tests/driver/T3007/A/Internal.hs - testsuite/tests/driver/T3007/Makefile - testsuite/tests/driver/T4437.hs - + testsuite/tests/driver/TUnitInfo/Foo.hs - + testsuite/tests/driver/TUnitInfo/Makefile - + testsuite/tests/driver/TUnitInfo/all.T - + testsuite/tests/driver/TUnitInfo/genMhu.sh - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space-mhu.stdout - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space-single.stdout - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.hs - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.stdout - testsuite/tests/driver/all.T - testsuite/tests/driver/make-prim/Makefile - testsuite/tests/driver/mostly-static/Makefile - testsuite/tests/driver/multipleHomeUnits/Makefile - testsuite/tests/driver/multipleHomeUnits/all.T - + testsuite/tests/driver/multipleHomeUnits/essentials-home/GHC/Essentials.hs - + testsuite/tests/driver/multipleHomeUnits/essentials-order-base/B.hs - + testsuite/tests/driver/multipleHomeUnits/essentials-order-user/U.hs - + testsuite/tests/driver/multipleHomeUnits/essentials-user/M.hs - testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr - + testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_essentials.stdout - + testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_essentials_order.stderr - + testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_essentials_recomp.stdout - + testsuite/tests/driver/multipleHomeUnits/unitEssentialsHome - + testsuite/tests/driver/multipleHomeUnits/unitEssentialsHomeHidden - + testsuite/tests/driver/multipleHomeUnits/unitEssentialsOrderBase - + testsuite/tests/driver/multipleHomeUnits/unitEssentialsOrderUser - + testsuite/tests/driver/multipleHomeUnits/unitEssentialsUser - + testsuite/tests/driver/multipleHomeUnits/unitEssentialsUserHidden - testsuite/tests/driver/recomp24656/Makefile - testsuite/tests/driver/recomp24656/recomp24656.stdout - testsuite/tests/ffi/should_fail/all.T - + testsuite/tests/ffi/should_fail/ccfail006.hs - + testsuite/tests/ffi/should_fail/ccfail006.stderr - + testsuite/tests/ffi/should_fail/ccfail007.hs - + testsuite/tests/ffi/should_fail/ccfail007.stderr - + testsuite/tests/ffi/should_fail/ccfail008.hs - + testsuite/tests/ffi/should_fail/ccfail008.stderr - + testsuite/tests/ffi/should_fail/ccfail009.hs - + testsuite/tests/ffi/should_fail/ccfail009.stderr - + testsuite/tests/ghc-api/EssentialsCoverage.hs - testsuite/tests/ghc-api/T25121_status.stdout - testsuite/tests/ghc-api/T8628.hs - testsuite/tests/ghc-api/all.T - testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs - testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs - testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.hs - testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs - testsuite/tests/ghc-e/should_fail/T18441fail7.stderr - testsuite/tests/ghc-e/should_run/ghc-e005.stderr - testsuite/tests/ghci.debugger/scripts/break006.stderr - testsuite/tests/ghci.debugger/scripts/print019.stderr - testsuite/tests/ghci/T13786/all.T - testsuite/tests/ghci/T16793/T16793.stdout - testsuite/tests/ghci/T18060/T18060.stdout - + testsuite/tests/ghci/T27532/Makefile - + testsuite/tests/ghci/T27532/T27532.stdout - + testsuite/tests/ghci/T27532/T27532j4.stdout - + testsuite/tests/ghci/T27532/a.script - + testsuite/tests/ghci/T27532/all.T - + testsuite/tests/ghci/T27532/b.script - + testsuite/tests/ghci/T27532/genT27532Modules - testsuite/tests/ghci/linking/all.T - testsuite/tests/ghci/linking/dyn/all.T - testsuite/tests/ghci/scripts/ListTuplePunsPpr.stdout - testsuite/tests/ghci/scripts/T4175.stdout - testsuite/tests/ghci/scripts/T8469.stdout - testsuite/tests/ghci/scripts/T8535.stdout - testsuite/tests/ghci/scripts/T9881.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/ghci/scripts/ghci020.stdout - testsuite/tests/ghci/scripts/ghci064.stdout - testsuite/tests/ghci/should_run/T10145.stdout - testsuite/tests/ghci/should_run/T18594.stdout - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/hiefile/should_compile/T24493.stderr - testsuite/tests/hiefile/should_run/T23120.stdout - + testsuite/tests/hiefile/should_run/T25709.hs - + testsuite/tests/hiefile/should_run/T25709.stdout - testsuite/tests/hiefile/should_run/all.T - testsuite/tests/iface/IfaceSharingIfaceType.hs - testsuite/tests/iface/IfaceSharingName.hs - testsuite/tests/indexed-types/should_fail/T12522a.stderr - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 - testsuite/tests/interface-stability/template-haskell-exports.stdout - testsuite/tests/javascript/Makefile - testsuite/tests/javascript/T24495.hs - testsuite/tests/module/mod185.stderr - testsuite/tests/numeric/should_compile/T14170.stdout - testsuite/tests/numeric/should_compile/T14465.stdout - testsuite/tests/numeric/should_compile/T23907.stderr - testsuite/tests/numeric/should_compile/T7116.stdout - testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr - testsuite/tests/package/T20010/all.T - testsuite/tests/package/all.T - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T14189.stderr - testsuite/tests/parser/should_compile/T15279.stderr - testsuite/tests/parser/should_compile/T20718.stderr - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr - testsuite/tests/parser/should_fail/T16270h.hs - testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr - testsuite/tests/partial-sigs/should_fail/NamedWildcardsNotInMonotype.stderr - + testsuite/tests/patsyn/should_compile/T27440a.hs - + testsuite/tests/patsyn/should_compile/T27440b.hs - + testsuite/tests/patsyn/should_compile/T27440c.hs - testsuite/tests/patsyn/should_compile/all.T - testsuite/tests/patsyn/should_fail/T26465.stderr - + testsuite/tests/patsyn/should_fail/T27440d.hs - + testsuite/tests/patsyn/should_fail/T27440d.stderr - testsuite/tests/patsyn/should_fail/all.T - + testsuite/tests/perf/compiler/FamAppCachePerf.hs - + testsuite/tests/perf/compiler/SimplCastPerf.hs - + testsuite/tests/perf/compiler/T27336.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/perf/should_run/ByteCodeAsm.hs - testsuite/tests/plugins/all.T - testsuite/tests/plugins/defaulting-plugin/DefaultInterference.hs - testsuite/tests/plugins/defaulting-plugin/DefaultInvalid.hs - testsuite/tests/plugins/defaulting-plugin/DefaultMultiParam.hs - testsuite/tests/plugins/plugins09.stdout - testsuite/tests/plugins/plugins10.stdout - testsuite/tests/plugins/plugins11.stdout - testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs - testsuite/tests/plugins/static-plugins.stdout - testsuite/tests/printer/Test20297.stdout - testsuite/tests/printer/Test24533.stdout - testsuite/tests/process/T3994.hs - testsuite/tests/process/process009.hs - testsuite/tests/process/process009.stdout - testsuite/tests/profiling/should_run/Makefile - testsuite/tests/profiling/should_run/callstack001.stdout - testsuite/tests/profiling/should_run/callstack002.stderr - testsuite/tests/profiling/should_run/callstack002.stdout - testsuite/tests/rename/should_compile/T3103/Foreign/Ptr.hs - testsuite/tests/rename/should_compile/T3103/GHC/Base.lhs - testsuite/tests/rename/should_compile/T3103/GHC/Word.hs - testsuite/tests/rename/should_compile/T3103/test.T - testsuite/tests/rep-poly/RepPolyRecordPattern.hs - testsuite/tests/rep-poly/RepPolyRecordPattern.stderr - testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr - testsuite/tests/rep-poly/T20113.stderr - − testsuite/tests/rep-poly/T20363.stderr - − testsuite/tests/rep-poly/T20363_show_co.hs - − testsuite/tests/rep-poly/T20363_show_co.stderr - − testsuite/tests/rep-poly/T20363b.stderr - + testsuite/tests/rep-poly/T20363c.hs - + testsuite/tests/rep-poly/T27639.hs - testsuite/tests/rep-poly/all.T - testsuite/tests/roles/should_compile/Roles1.stderr - testsuite/tests/roles/should_compile/Roles13.stderr - testsuite/tests/roles/should_compile/Roles14.stderr - testsuite/tests/roles/should_compile/Roles2.stderr - testsuite/tests/roles/should_compile/Roles3.stderr - testsuite/tests/roles/should_compile/Roles4.stderr - testsuite/tests/roles/should_compile/T8958.stderr - + testsuite/tests/rts/T19048.hs - + testsuite/tests/rts/T19048.stdout - + testsuite/tests/rts/T26408.hs - + testsuite/tests/rts/T26408.stderr - + testsuite/tests/rts/T27585.hs - + testsuite/tests/rts/T27585.stdout - testsuite/tests/rts/all.T - testsuite/tests/rts/linker/all.T - + testsuite/tests/saks/should_compile/T18725a.hs - testsuite/tests/saks/should_compile/all.T - + testsuite/tests/saks/should_fail/T18725b.hs - + testsuite/tests/saks/should_fail/T18725b.stderr - testsuite/tests/saks/should_fail/all.T - + testsuite/tests/show-bytecode/Example.hs - + testsuite/tests/show-bytecode/Makefile - + testsuite/tests/show-bytecode/all.T - + testsuite/tests/show-bytecode/normalize - + testsuite/tests/show-bytecode/show-bytecode-breakpoints.stdout - + testsuite/tests/show-bytecode/show-bytecode-breakpoints.stdout-javascript-unknown-ghcjs - + testsuite/tests/show-bytecode/show-bytecode-hpc.stdout - + testsuite/tests/show-bytecode/show-bytecode-vanilla.stdout - + testsuite/tests/show-bytecode/show-bytecode-vanilla.stdout-javascript-unknown-ghcjs - testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr - testsuite/tests/simplCore/should_compile/T13543.stderr - testsuite/tests/simplCore/should_compile/T16038/T16038.stdout - testsuite/tests/simplCore/should_compile/T24229a.stderr - testsuite/tests/simplCore/should_compile/T24229b.stderr - + testsuite/tests/simplCore/should_compile/T27589.hs - + testsuite/tests/simplCore/should_compile/T27589.stderr - + testsuite/tests/simplCore/should_compile/T27590.hs - + testsuite/tests/simplCore/should_compile/T27590.stderr - testsuite/tests/simplCore/should_compile/T3717.stderr - testsuite/tests/simplCore/should_compile/T3772.stdout - testsuite/tests/simplCore/should_compile/T4081.stderr - testsuite/tests/simplCore/should_compile/T4908.stderr - testsuite/tests/simplCore/should_compile/T4930.stderr - testsuite/tests/simplCore/should_compile/T7360.stderr - testsuite/tests/simplCore/should_compile/T8274.stdout - testsuite/tests/simplCore/should_compile/T9400.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/simplCore/should_compile/noinline01.stderr - testsuite/tests/simplCore/should_compile/par01.stderr - testsuite/tests/simplCore/should_compile/rule2.stderr - testsuite/tests/simplCore/should_compile/str-rules.hs - testsuite/tests/splice-imports/SI35.hs - testsuite/tests/tcplugins/ArgsPlugin.hs - testsuite/tests/tcplugins/EmitWantedPlugin.hs - testsuite/tests/tcplugins/RewritePlugin.hs - testsuite/tests/tcplugins/T26395_Plugin.hs - testsuite/tests/tcplugins/TcPlugin_RewritePerf.hs - testsuite/tests/tcplugins/TcPlugin_RewritePerf.stderr - testsuite/tests/tcplugins/TyFamPlugin.hs - + testsuite/tests/th/AssocDefaultNotAssoc.hs - + testsuite/tests/th/AssocDefaultNotAssoc.stderr - testsuite/tests/th/T14741.hs - + testsuite/tests/th/T20902.hs - testsuite/tests/th/T21547.stderr - testsuite/tests/th/T26568.stderr - + testsuite/tests/th/T27013th.hs - + testsuite/tests/th/TH_InvalidTopDecl.hs - + testsuite/tests/th/TH_InvalidTopDecl.stderr - testsuite/tests/th/TH_Roles2.stderr - + testsuite/tests/th/TH_cvt_DefaultDataInstDecl.hs - + testsuite/tests/th/TH_cvt_DefaultDataInstDecl.stderr - + testsuite/tests/th/TH_cvt_GadtNoCons.hs - + testsuite/tests/th/TH_cvt_GadtNoCons.stderr - + testsuite/tests/th/TH_cvt_IllegalDeclaration.hs - + testsuite/tests/th/TH_cvt_IllegalDeclaration.stderr - + testsuite/tests/th/TH_cvt_IllegalSumAlt.hs - + testsuite/tests/th/TH_cvt_IllegalSumAlt.stderr - + testsuite/tests/th/TH_cvt_InvalidCCallImpent.hs - + testsuite/tests/th/TH_cvt_InvalidCCallImpent.stderr - + testsuite/tests/th/TH_cvt_InvalidTyFamInstLHS.hs - + testsuite/tests/th/TH_cvt_InvalidTyFamInstLHS.stderr - + testsuite/tests/th/TH_cvt_InvalidTypeInstanceHeader.hs - + testsuite/tests/th/TH_cvt_InvalidTypeInstanceHeader.stderr - + testsuite/tests/th/TH_cvt_RecGadtNoCons.hs - + testsuite/tests/th/TH_cvt_RecGadtNoCons.stderr - + testsuite/tests/th/TH_cvt_SumAltArityExceeded.hs - + testsuite/tests/th/TH_cvt_SumAltArityExceeded.stderr - + testsuite/tests/th/TH_pragmaSpecOld.hs - + testsuite/tests/th/TH_pragmaSpecOld.stderr - testsuite/tests/th/all.T - + testsuite/tests/typecheck/should_compile/LazyFieldAnnotations.hs - testsuite/tests/typecheck/should_compile/T13032.stderr - testsuite/tests/typecheck/should_compile/T14273.stderr - testsuite/tests/typecheck/should_compile/T18406b.stderr - testsuite/tests/typecheck/should_compile/T18529.stderr - + testsuite/tests/typecheck/should_compile/T27557.hs - + testsuite/tests/typecheck/should_compile/WarnDefaultedCallStack.hs - + testsuite/tests/typecheck/should_compile/WarnDefaultedCallStack.stderr - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/holes.stderr - testsuite/tests/typecheck/should_compile/holes2.stderr - testsuite/tests/typecheck/should_compile/holes3.stderr - testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr - testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr - testsuite/tests/typecheck/should_fail/LazyFieldsDisabled.stderr - + testsuite/tests/typecheck/should_fail/LazyFieldsDisabledStrictData.hs - + testsuite/tests/typecheck/should_fail/LazyFieldsDisabledStrictData.stderr - testsuite/tests/typecheck/should_fail/T12921.stderr - testsuite/tests/typecheck/should_fail/T14884.stderr - testsuite/tests/typecheck/should_fail/T15883b.stderr - testsuite/tests/typecheck/should_fail/T15883c.stderr - testsuite/tests/typecheck/should_fail/T15883d.stderr - testsuite/tests/typecheck/should_fail/T21130.stderr - testsuite/tests/typecheck/should_fail/T3323.stderr - testsuite/tests/typecheck/should_fail/T5095.stderr - testsuite/tests/typecheck/should_fail/T5300.stderr - testsuite/tests/typecheck/should_fail/T7279.stderr - testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr - testsuite/tests/typecheck/should_fail/TyAppPat_PatternBindingExistential.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail072.stderr - testsuite/tests/typecheck/should_fail/tcfail097.stderr - testsuite/tests/typecheck/should_fail/tcfail133.stderr - testsuite/tests/typecheck/should_run/T22510.stdout - testsuite/tests/unboxedsums/UbxSumLevPoly.hs - testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs - + testsuite/tests/vdq-rta/should_compile/T27583a.hs - + testsuite/tests/vdq-rta/should_compile/T27583b.hs - + testsuite/tests/vdq-rta/should_compile/T27583c.hs - + testsuite/tests/vdq-rta/should_compile/T27583d.hs - + testsuite/tests/vdq-rta/should_compile/T27583e.hs - + testsuite/tests/vdq-rta/should_compile/T27583g.hs - testsuite/tests/vdq-rta/should_compile/all.T - + testsuite/tests/vdq-rta/should_fail/T27440e.hs - + testsuite/tests/vdq-rta/should_fail/T27440e.stderr - + testsuite/tests/vdq-rta/should_fail/T27583f.hs - + testsuite/tests/vdq-rta/should_fail/T27583f.stderr - + testsuite/tests/vdq-rta/should_fail/T27586a.hs - + testsuite/tests/vdq-rta/should_fail/T27586a.stderr - + testsuite/tests/vdq-rta/should_fail/T27586b.hs - + testsuite/tests/vdq-rta/should_fail/T27586b.stderr - + testsuite/tests/vdq-rta/should_fail/T27586c.hs - + testsuite/tests/vdq-rta/should_fail/T27586c.stderr - testsuite/tests/vdq-rta/should_fail/all.T - testsuite/tests/warnings/should_compile/DerivingTypeable.stderr - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Transform.hs - utils/check-exact/Utils.hs - utils/check-ppr/Main.hs - utils/genprimopcode/Main.hs - utils/haddock/haddock-api/src/Haddock.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs - utils/haddock/haddock-api/src/Haddock/Interface.hs - utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/566c4b06db895771f9eb35897ce202… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/566c4b06db895771f9eb35897ce202… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/mangoiv/ci-stages] fixup! ci: build and test stage
by Magnus (＠MangoIV) 24 Aug '26

24 Aug '26

Magnus pushed to branch wip/mangoiv/ci-stages at Glasgow Haskell Compiler / GHC Commits: 63fadbe1 by mangoiv at 2026-08-24T14:38:01+02:00 fixup! ci: build and test stage - - - - - 2 changed files: - .gitlab/ci.sh - hadrian/doc/cross-compile.md Changes: ===================================== .gitlab/ci.sh ===================================== @@ -697,6 +697,7 @@ function test_hadrian() { return # If we have set CROSS_EMULATOR, then can't test using normal testsuite. elif [ -n "${CROSS_EMULATOR:-}" ] && [[ "${CROSS_TARGET:-}" != *"wasm"* ]]; then + info "Cross compiling with CROSS_EMULATOR='$CROSS_EMULATOR' and CROSS_TARGET='$CROSS_TARGET'" local instdir="$TOP/_build/install" local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" install_bindist $dist_dir/ghc-*/ "$instdir" @@ -720,6 +721,7 @@ function test_hadrian() { # > main = putStrLn "hello world" run diff -w expected actual elif [[ -n "${REINSTALL_GHC:-}" ]]; then + info "Running with reinstall GHC $REINSTALL_GHC" run_hadrian \ test \ --test-root-dirs=testsuite/tests/stage1 \ @@ -754,6 +756,8 @@ function test_hadrian() { if [ $test_compiler_backend != "\"$BIGNUM_BACKEND\"" ]; then fail "Test compiler has a different BIGNUM_BACKEND ($test_compiler_backend) than requested ($BIGNUM_BACKEND)" fi + else + info "CROSS_TARGET=$CROSS_TARGET" fi # If we are doing a release job, check the compiler can build a profiled executable ===================================== hadrian/doc/cross-compile.md ===================================== @@ -1,3 +1,5 @@ +**This is severely outdated. And is here merely for historical interest** + ## Build a cross-compiling GHC In this example, our host machine is "Ubuntu 16.04.2 LTS, Linux ubuntu 4.4.0-79-generic 86_64". View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/63fadbe196e52e0a34989a51fb9b19c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/63fadbe196e52e0a34989a51fb9b19c… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/dcoutts/capability-yield] 8 commits: Eliminate a use of releaseCapability_ with always_wakeup
by Duncan Coutts (＠dcoutts) 24 Aug '26

24 Aug '26

Duncan Coutts pushed to branch wip/dcoutts/capability-yield at Glasgow Haskell Compiler / GHC Commits: be623efb by Duncan Coutts at 2026-08-20T00:20:01+01:00 Eliminate a use of releaseCapability_ with always_wakeup This one was purely artificial, just due to the unnecessarily strong pre-condition. We can just weaken the precondition. The capability inbox is non-empty so releaseCapability_ will certainly wake up a task for the capability anyway. We are trying to eliminate the always_wakeup parameter entirely since it is a bit of a design wart. - - - - - 5a0f5849 by Duncan Coutts at 2026-08-20T00:21:23+01:00 Eliminate another use of releaseCapability_ with always_wakeup Previusly in schedulePushWork, it checked if there are sparks for the capability and called releaseAndWakeupCapability if there were and releaseCapability if there were none. This is unnecessary: releaseCapability already ensures that a task will be worken if there are sparks available for the capability. This also lets us remove the now unused releaseAndWakeupCapability, eliminating another use of always_wakeup==true. - - - - - 29ed4da7 by Duncan Coutts at 2026-08-24T12:21:45+01:00 Make prodCapability reliable, fix race condition Also eliminate the last use of releaseCapability_ using the always_wakeup param. Add a Note that describes the problem and solution. Now that prodCapability also does an interruptCapability (if the capability is active) then we don't need to use interruptCapability as well at call sites of prodCapability. - - - - - 9a4e2330 by Duncan Coutts at 2026-08-24T12:24:23+01:00 Eliminate the now-unused always_wakeup param from releaseCapability_ releaseCapability_ had an extra bool param: always_wakeup. This was rather a design wart. We have now eliminated all uses of it so we can remove the param entirely. This will also reduce churn at call site when we add a new (rarely used) parameter in the subsequent commit. - - - - - 65241766 by Duncan Coutts at 2026-08-24T12:41:33+01:00 Add releaseCapability_ worker with a wakeup_worker modifier Split releaseCapability_ into a worker and wrapper. The worker gains the extra wakeup_worker parameter. Document within releaseCapability__ the basic approach of looking for a series of conditions in priority order and acting on them. Then add a modifier, wakeup_worker and explain it in similar terms. What it does is skip two of the conditions in the priority list, with the effect that we prioritise waking up a worker task over a returning task or bound task. This feature is not yet used in this commit, but it will be used as part of a scheme to allow in-RTS I/O managers in the threaded RTS. This scheme will make use of being able to start a background worker thread, and that will use this feature to start it promptly. Also correct the yieldCapability docs to cover all the conditions, and in priority order for consistency. - - - - - 3428302b by Duncan Coutts at 2026-08-24T12:45:07+01:00 Move enqueueWorker next to where it is used. It's not general purpose at all. It's very specifically crafted to work with it's only caller: yieldCapability. It does very suprising things like releaseCapability_, release locks and terminate threads. This logic would be much clearer if done within yieldCapability. - - - - - efe433ca by Duncan Coutts at 2026-08-24T12:47:14+01:00 Move code out of enqueueWorker and into releaseCapability_ Instead of directly releasing locks and terminating tasks, have it return whether the enqueue was successful or not. In the latter case, releaseCapability_ itself will release locks and terminate the task. This makes the logic of releaseCapability_ a lot clearer. Fiddling with tasks is what releaseCapability_ does, so it's better not to try and encapsulate this within a helper function. - - - - - e0e3f390 by Duncan Coutts at 2026-08-24T12:47:19+01:00 Clarify the logic and control flow in yieldCapability yieldCapability is unfortunately a bit complicated. This change restructures things slightly but should keep the behaviour the same. Previously after calling releaseCapability_ we had a bunch of alternatives, where in each branch we would use RELEASE_LOCK(cap->lock) and do various things before/after the lock is released. This was a bit hard to follow, or to extend (which we need to do). So now we have unconditional acquire and release of the cap->lock, so it's clear where that happens, with releaseCapability_ in between. Then in between these steps we have the various other pre/post actions. Some before releaseCapability_, some after while holing the lock, and some after having released the lock. We explain this structure in a longer comment, and refer back to the structure from the code. - - - - - 6 changed files: - rts/Capability.c - rts/Capability.h - rts/Messages.c - rts/RtsAPI.c - rts/Schedule.c - rts/sm/GC.c Changes: ===================================== rts/Capability.c ===================================== @@ -560,7 +560,7 @@ giveCapabilityToTask (Capability *cap USED_IF_DEBUG, Task *task) #endif /* ---------------------------------------------------------------------------- - * releaseCapability_ + * releaseCapability and releaseCapability_ * * This serves two purposes: * @@ -570,32 +570,37 @@ giveCapabilityToTask (Capability *cap USED_IF_DEBUG, Task *task) * * 2. There is no current task (cap->task == NULL), and thus the Capability * is idle, and we want to wake up an idle Task to animate the Capability. - * In this case set always_wakeup. See also prodCapability. + * See also prodCapability. * - * Setting the always_wakeup parameter (almost) ensures that the capability is - * not left idle: even if there is no known work to do, the capability will be - * given to a worker task. There are two exceptions to this: - * 1. if there is a pending sync then the capability is left idle, but in - * anticipation of whichever task initiated the sync picking it up shortly. - * 2. if the scheduler is shutting down and there are no threads on the run - * queue and there are no spare workers then the capability is left idle. - * It is not entirely clear if this corner case is intentional. - * - * The caller must hold cap->lock and will still hold it after the call returns. + * Difference: + * - releaseCapability the caller /must not/ hold cap->lock. + * - releaseCapability_ the caller /must/ hold cap->lock. * * N.B. May need to take all_tasks_mutex, if it needs to start a new task. * * ------------------------------------------------------------------------- */ #if defined(THREADED_RTS) -void -releaseCapability_ (Capability* cap, - bool always_wakeup) +static void releaseCapability__ (Capability* cap, bool wakeup_worker); + +void releaseCapability (Capability* cap) +{ + ACQUIRE_LOCK(&cap->lock); + releaseCapability__(cap, false /*wakeup_worker*/); + RELEASE_LOCK(&cap->lock); +} + +void releaseCapability_ (Capability* cap) +{ + releaseCapability__(cap, false /*wakeup_worker*/); +} + +static void releaseCapability__ (Capability* cap, + bool wakeup_worker) { { Task *task = cap->running_task; - ASSERT(task || always_wakeup); // To cover purpose 2 above, we allow the cap->running_task to be // NULL, to handle cases where a thread (that is not itself a Task) // needs to wake up an idle task for the capability. @@ -609,6 +614,33 @@ releaseCapability_ (Capability* cap, // Remove the current Task owning the Capability (if any, see purpose 2). RELAXED_STORE(&cap->running_task, NULL); + // We now look for a task to give the capability to, or otherwise we leave + // the capability free. + // + // We take one of these guarded actions, in priority order: + // + // 1. If there's a pending synchronisation of all capabilities (e.g. GC), + // then give the capability to the task performing the sync. + // 2. If there's a task returning (e.g. from safe FFI) on this capability, + // then give the capability to the first such task. + // 3. If the next runnable thread on this capability is a bound thread, + // then give the capability to the corresponding bound task. + // 4. If there are no spare worker tasks for this capability, + // then start one and give the capability to the new task. + // 5. If there is some work to do on this capability (e.g. runnable thread), + // then give the capability to a worker task. + // 6. Otherwise leave the capability free/idle. + // + // There is one modifier to this priority list: + // + // * Setting wakeup_worker skips cases 2 & 3. This prioritises waking a + // worker over returning tasks or bound tasks. + + + // Guarded action 1: + // If there's a pending synchronisation of all capabilities (e.g. GC), + // then give the capability to the task performing the sync. + // // If there is a pending sync, the task that requested the sync will // subsequently use acquireAllCapabilities to place itself on the (front of // the) returning_task list (of all capabilities). We will then be in one @@ -656,17 +688,22 @@ releaseCapability_ (Capability* cap, return; } - // Check to see whether a worker thread can be given - // the go-ahead to return the result of an external call.. - if (cap->n_returning_tasks != 0) { + // Skip guarded actions 2 & 3 if wakeup_worker. See the list of actions and + // modifiers above. + + // Guarded action 2: + // If there's a task returning (e.g. from safe FFI) on this capability, + // then give the capability to the first such task. + if (!wakeup_worker && cap->n_returning_tasks != 0) { giveCapabilityToTask(cap,cap->returning_tasks_hd); // The Task pops itself from the queue (see waitForCapability()) return; } - // If the next thread on the run queue is a bound thread, - // give this Capability to the appropriate Task. - if (!emptyRunQueue(cap) && peekRunQueue(cap)->bound) { + // Guarded action 3: + // If the next runnable thread on this capability is a bound thread, + // then give the capability to the bound thread's corresponding task. + if (!wakeup_worker && !emptyRunQueue(cap) && peekRunQueue(cap)->bound) { // Make sure we're not about to try to wake ourselves up // ASSERT(task != cap->run_queue_hd->bound); // assertion is false: in schedule() we force a yield after @@ -677,11 +714,13 @@ releaseCapability_ (Capability* cap, return; } + // Guarded action 4: + // If there are no spare worker tasks for this capability, + // then start one and give the capability to the new task. if (!cap->spare_workers) { - // Create a worker thread if we don't have one. If the system - // is interrupted, we only create a worker task if there - // are threads that need to be completed. If the system is - // shutting down, we never create a new worker. + // If the system is interrupted, we only create a worker task if there + // are threads that need to be completed. If the system is shutting + // down, we never create a new worker. if (getSchedState() < SCHED_SHUTTING_DOWN || !emptyRunQueue(cap)) { debugTrace(DEBUG_sched, "starting new worker on capability %d", cap->no); @@ -690,10 +729,14 @@ releaseCapability_ (Capability* cap, } } - // If we have an unbound thread on the run queue, or if there's - // anything else to do, give the Capability to a worker thread. - if (always_wakeup || - !emptyRunQueue(cap) || !emptyInbox(cap) || + // Guarded action 5: + // If there is some work to do on this capability (e.g. runnable thread), + // then give the capability to a worker task. + // + // We also check the cap->interrupt flag to avoid a race condition. + // See Note [prodCapability reliability]. + // + if (!emptyRunQueue(cap) || !emptyInbox(cap) || cap->interrupt || (!cap->disabled && !emptySparkPoolCap(cap)) || globalWorkToDo()) { if (cap->spare_workers) { giveCapabilityToTask(cap, cap->spare_workers); @@ -702,59 +745,14 @@ releaseCapability_ (Capability* cap, } } + // Guarded action 6: + // Otherwise leave the capability free/idle. #if defined(PROFILING) cap->r.rCCCS = CCS_IDLE; #endif RELAXED_STORE(&last_free_capability[cap->node], cap); debugTrace(DEBUG_sched, "freeing capability %d", cap->no); } - -void -releaseCapability (Capability* cap) -{ - ACQUIRE_LOCK(&cap->lock); - releaseCapability_(cap, false); - RELEASE_LOCK(&cap->lock); -} - -void -releaseAndWakeupCapability (Capability* cap) -{ - ACQUIRE_LOCK(&cap->lock); - releaseCapability_(cap, true); - RELEASE_LOCK(&cap->lock); -} - -static void -enqueueWorker (Capability* cap) -{ - Task *task; - - task = cap->running_task; - - // If the Task is stopped, we shouldn't be yielding, we should - // be just exiting. - ASSERT(!task->stopped); - ASSERT(task->worker); - - if (cap->n_spare_workers < MAX_SPARE_WORKERS) - { - task->next = cap->spare_workers; - cap->spare_workers = task; - cap->n_spare_workers++; - } - else - { - debugTrace(DEBUG_sched, "%d spare workers already, exiting", - cap->n_spare_workers); - releaseCapability_(cap,false); - // hold the lock until after workerTaskStop; c.f. scheduleWorker() - workerTaskStop(task); - RELEASE_LOCK(&cap->lock); - shutdownThread(); - } -} - #endif /* @@ -1051,12 +1049,6 @@ static void waitForCapability_ (Task *task, * when either we know that the Capability should be given to another Task, or * there is nothing to do right now. One of the following is true: * - * - The current Task is a worker, and there's a bound thread at the head of - * the run queue (or vice versa) - * - * - The run queue is empty. We'll be woken up again when there's work to - * do. - * * - Another Task is trying to do parallel GC (pending_sync == SYNC_GC_PAR). * We should become a GC worker for a while. * @@ -1064,12 +1056,21 @@ static void waitForCapability_ (Task *task, * SYNC_GC_PAR), either to do a sequential GC, forkProcess, or * setNumCapabilities. We should give up the Capability temporarily. * + * - There is a Task returning from a safe FFI call. + * + * - The current Task is a worker, and there's a bound thread at the head of + * the run queue (or vice versa) + * + * - There is no work to do (empty run queue, inbox etc). We'll be woken up + * again when there's work to do. + * * When yieldCapability returns *pCap will have been updated to the new * capability held by the caller. * * ------------------------------------------------------------------------- */ #if defined(THREADED_RTS) +static bool tryEnqueueWorker (Capability* cap); /* See Note [GC livelock] in Schedule.c for why we have gcAllowed and return the bool */ @@ -1124,28 +1125,61 @@ yieldCapability // We must now release the capability and wait to be woken up again. task->wakeup = false; + // What happens next is a bit complicated. It has the following outline: + // + // 1. take the cap->lock + // 2. "various stuff part A", pre-releaseCapability_ holding cap->lock + // 3. release the capability + // 4. "various stuff part B", post-releaseCapability_ holding cap->lock + // 5. release the cap->lock + // 6. "various stuff part C", post release cap->lock + // + // Much of the "various stuff" is also conditional, which complicates + // matters further. To try and maintain clarity we use the following + // variables in the conditions for the in-between steps. + // + bool terminate_worker = false; + bool task_is_worker = isWorker(task); + bool task_is_bound = isBoundTask(task); + + // Step 1: take the cap->lock ACQUIRE_LOCK(&cap->lock); - // If this is a worker thread, put it on the spare_workers queue - if (isWorker(task)) { - enqueueWorker(cap); + // Step 2: "various stuff part A", pre-releaseCapability_ holding cap->lock + if (task_is_worker) { + // If this is a worker thread, try to put it on the spare_workers + // queue or if it is surplus then we will terminate it. + terminate_worker = !tryEnqueueWorker(cap); } - releaseCapability_(cap, false); + // Step 3: release the capability + releaseCapability_(cap); - if (isWorker(task) || isBoundTask(task)) { - RELEASE_LOCK(&cap->lock); - cap = waitForWorkerCapability(task); - } else { + // Step 4: "various stuff part B", post-releaseCapability_ holding cap->lock + if (terminate_worker) { + // hold the lock until after workerTaskStop; c.f. scheduleWorker() + workerTaskStop(task); + } else if (!task_is_worker && !task_is_bound) { // Not a worker Task, or a bound Task. The only way we can be woken up // again is to put ourselves on the returning_tasks queue, so that's - // what we do. We still hold cap->lock at this point - // The Task waiting for this Capability does not have it - // yet, so we can be sure to be woken up later. (see #10545) + // what we do. We still hold cap->lock at this point. The Task waiting + // for this Capability does not have it yet, so we can be sure to be + // woken up later. (see #10545) appendToReturningTaskQueue(cap,task); - RELEASE_LOCK(&cap->lock); + } + + // Step 5: release the cap->lock + RELEASE_LOCK(&cap->lock); + + // Step 6. "various stuff part C", post release cap->lock + if (terminate_worker) { + shutdownThread(); + } else if (task_is_worker || task_is_bound) { + cap = waitForWorkerCapability(task); + } else { cap = waitForReturnCapability(task); } + // End of step 6. debugTrace(DEBUG_sched, "resuming capability %d", cap->no); ASSERT(cap->running_task == task); @@ -1161,6 +1195,33 @@ yieldCapability return false; } +// Returns true if it could enqueue, and false if the worker is surplus to +// requirements and should be terminated. +static bool tryEnqueueWorker (Capability* cap) +{ + Task *task = cap->running_task; + + // If the Task is stopped, we shouldn't be yielding, we should + // be just exiting. + ASSERT(!task->stopped); + ASSERT(task->worker); + ASSERT_LOCK_HELD(&cap->lock); + + if (cap->n_spare_workers < MAX_SPARE_WORKERS) + { + task->next = cap->spare_workers; + cap->spare_workers = task; + cap->n_spare_workers++; + return true; + } + else + { + debugTrace(DEBUG_sched, "%d spare workers already, exiting", + cap->n_spare_workers); + return false; + } +} + #endif /* THREADED_RTS */ @@ -1391,8 +1452,40 @@ void releaseAllCapabilities(uint32_t n, Capability *keep_cap, Task *task) /* ---------------------------------------------------------------------------- * prodCapability * - * If a Capability is currently idle, wake up a Task on it. Used to - * get every Capability into the GC. + * If a Capability is currently idle, wake up a Task on it. If it is not idle, + * interrupt it. + * + * Used to get every Capability into the GC. Also used for ctl-C handling + * to get the capability to run the scheduler. + * + * Note [prodCapability reliability] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * There's a potential race condition with prodCapability: a task running a + * capability may be just about to yield when it is prodded and then let the + * capability go idle, thus missing the prod. To avoid this we must check if + * the capability has been prodded in a reliable fashion when the task is + * yielding the capability. This is much like the issue of the race between + * sending a capability a message and the capability going idle (where it's + * vital that we don't let a capability go idle if there's a pending message). + * The solution we use is much the same as the solution for messages: rely on + * a shared variable set and tested while holding the cap->lock. + * + * The scheme is as follows: + * 1. Set the cap->interrupt flag in prodCapability while holding the cap->lock + * 2. Test the cap->interrupt flag in releaseCapability_ while holding the + * cap->lock. If the flag is set then make sure to pass the capability to + * a worker task (which often would be the task that was just releasing it). + * 3. Make sure to reset the cap->interrupt flag at the start of the scheduler + * loop. (Historically it was only reset when running a Haskell thread.) + * We must do this before the scheduler yields again or we could loop + * indefinitely. + * + * This scheme ensures that we run the scheduler loop once more, which will + * react to the prod or reset the flag and yield again. In particular for + * getting tasks into GC they will do that in yieldCapability, and for ctl-c + * the scheduler will asks the I/O manager to poll for events which will pick + * up pending signals. * ------------------------------------------------------------------------- */ #if defined(THREADED_RTS) @@ -1401,9 +1494,22 @@ void prodCapability (Capability *cap) { ACQUIRE_LOCK(&cap->lock); - if (!cap->running_task) { - releaseCapability_(cap,true); + if (cap->running_task) { + /* Set the cap->interrupt so that the capability will not go idle + * before attending to the reason for the interrupt. + * See Note [prodCapability reliability]. + */ + interruptCapability(cap); + } else { + /* Set the cap->interrupt first so that releaseCapability_ will see + * that there is something to do on this capability and ensure the + * cap is given to a task. See Note [prodCapability reliability]. + */ + interruptCapability(cap); + releaseCapability_(cap); } + /* Notice that we use interruptCapability either way, but for different + * reasons */ RELEASE_LOCK(&cap->lock); } @@ -1523,7 +1629,7 @@ shutdownCapability (Capability *cap USED_IF_THREADS, if (!emptyRunQueue(cap) || cap->spare_workers) { debugTrace(DEBUG_sched, "runnable threads or workers still alive, yielding"); - releaseCapability_(cap,false); // this will wake up a worker + releaseCapability_(cap); // this will wake up a worker RELEASE_LOCK(&cap->lock); yieldThread(); continue; ===================================== rts/Capability.h ===================================== @@ -262,16 +262,13 @@ void moreCapabilities (uint32_t from, uint32_t to); // ASSUMES: cap->running_task is the current Task. // #if defined(THREADED_RTS) -void releaseCapability (Capability* cap); -void releaseAndWakeupCapability (Capability* cap); -void releaseCapability_ (Capability* cap, bool always_wakeup); +void releaseCapability (Capability* cap); +void releaseCapability_ (Capability* cap); // assumes cap->lock is held #else // releaseCapability() is empty in non-threaded RTS INLINE_HEADER void releaseCapability (Capability* cap STG_UNUSED) {}; -INLINE_HEADER void releaseAndWakeupCapability (Capability* cap STG_UNUSED) {}; -INLINE_HEADER void releaseCapability_ (Capability* cap STG_UNUSED, - bool always_wakeup STG_UNUSED) {}; +INLINE_HEADER void releaseCapability_ (Capability* cap STG_UNUSED) {}; #endif // declared in rts/include/rts/Threads.h: ===================================== rts/Messages.c ===================================== @@ -49,11 +49,7 @@ void sendMessage(Capability *from_cap, Capability *to_cap, Message *msg) recordClosureMutated(from_cap,(StgClosure*)msg); if (to_cap->running_task == NULL) { - /* Precond for releaseCapability_ is: running_task || always_wakeup. - * We have running_task == NULL, hence we must use always_wakeup. This - * is ok since the inbox is now non-empty, so we wake a task anyway. - */ - releaseCapability_(to_cap, true /*always_wakeup*/); + releaseCapability_(to_cap); } else { interruptCapability(to_cap); } ===================================== rts/RtsAPI.c ===================================== @@ -691,7 +691,7 @@ rts_unlock (Capability *cap) // random point in the future, which causes problems for // freeTaskManager(). ACQUIRE_LOCK(&cap->lock); - releaseCapability_(cap,false); + releaseCapability_(cap); // Finally, we can release the Task to the free list. exitMyTask(); ===================================== rts/Schedule.c ===================================== @@ -283,6 +283,10 @@ schedule (Capability *initialCapability, Task *task) barf("sched_state: %" FMT_Word, sched_state); } + // Reset the interrupt flag upon starting the scheduler loop. + // See Note [prodCapability reliability]. + RELAXED_STORE(&cap->interrupt, false); + scheduleFindWork(&cap); /* work pushing, currently relevant only for THREADED_RTS: @@ -430,9 +434,6 @@ run_thread: SetLastError(t->saved_winerror); #endif - // reset the interrupt flag before running Haskell code - RELAXED_STORE(&cap->interrupt, false); - cap->in_haskell = true; RELAXED_STORE(&cap->idle, false); @@ -837,13 +838,9 @@ schedulePushWork(Capability *cap USED_IF_THREADS, // release the capabilities for (i = 0; i < n_free_caps; i++) { task->cap = free_caps[i]; - if (sparkPoolSizeCap(cap) > 0) { - // If we have sparks to steal, wake up a worker on the - // capability, even if it has no threads to run. - releaseAndWakeupCapability(free_caps[i]); - } else { - releaseCapability(free_caps[i]); - } + // If there are sparks available, this will wake up a Task to run + // the Capability, even if it has no threads to run. + releaseCapability(free_caps[i]); } } task->cap = cap; // reset to point to our Capability. @@ -1905,7 +1902,7 @@ forkProcess(HsStablePtr *entry #endif for (i=0; i < n_capabilities; i++) { - releaseCapability_(getCapability(i),false); + releaseCapability_(getCapability(i)); RELEASE_LOCK(&getCapability(i)->lock); } @@ -2320,7 +2317,7 @@ suspendThread (StgRegTable *reg, bool interruptible) suspendTask(cap,task); cap->in_haskell = false; - releaseCapability_(cap,false); + releaseCapability_(cap); RELEASE_LOCK(&cap->lock); @@ -2513,7 +2510,7 @@ void scheduleWorker (Capability *cap, Task *task) // Capability has been shut down. // ACQUIRE_LOCK(&cap->lock); - releaseCapability_(cap,false); + releaseCapability_(cap); workerTaskStop(task); RELEASE_LOCK(&cap->lock); } ===================================== rts/sm/GC.c ===================================== @@ -1523,7 +1523,6 @@ waitForGcThreads (Capability *cap, bool idle_cap[]) if (i == me || idle_cap[i]) { continue; } if (SEQ_CST_LOAD(&gc_threads[i]->wakeup) != GC_THREAD_STANDING_BY) { prodCapability(getCapability(i)); - interruptCapability(getCapability(i)); } } // this 1ms timeout is not well justified. It's the shortest timeout we View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9cfe2ee2cb65cc5d63ce6dbc978929… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9cfe2ee2cb65cc5d63ce6dbc978929… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: rts linker: Fix pointer arithmetic issue in flushInstructionCacheRISCV64
by Marge Bot (＠marge-bot) 24 Aug '26

24 Aug '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6e4d44f0 by Andreas Klebinger at 2026-08-24T06:35:03-04:00 rts linker: Fix pointer arithmetic issue in flushInstructionCacheRISCV64 We accidentally operated over `uint64_t*` when we should use `uint8_t`. Fixes #27569 - - - - - f4a97277 by Alan Zimmerman at 2026-08-24T06:35:03-04:00 EPA: Uses Parsers.parseModule for exactprint tests Parsers.parseModule is the advertised way to parse for use for exact printing in the ghc-exactprint library. This commit updates the GHC exact print testing to use it. This requires moving the comment balancing that was occurring only in the test path into the advertising parser path, so it moves from Transforms.hs to Utils.hs. Also update the comment adding to honour trailing annotations - - - - - 6 changed files: - rts/linker/elf_reloc_riscv64.c - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Parsers.hs - utils/check-exact/Transform.hs - utils/check-exact/Utils.hs Changes: ===================================== rts/linker/elf_reloc_riscv64.c ===================================== @@ -679,7 +679,7 @@ void flushInstructionCacheRISCV64(ObjectCode *oc) { /* The main object code */ void *codeBegin = oc->image + oc->misalignment; - __builtin___clear_cache(codeBegin, (void*) ((uint64_t*) codeBegin + oc->fileSize)); + __builtin___clear_cache(codeBegin, (void*) ((uint8_t*) codeBegin + oc->fileSize)); /* Jump Islands */ __builtin___clear_cache((void *)oc->symbol_extras, ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -1465,7 +1465,7 @@ instance ExactPrint (HsModule GhcPs) where Just exps -> do let (op,cp,tcs) = am_exports $ anns an0 op' <- markEpToken op - exps' <- mapM markAnnotated exps + exps' <- mapM markAnnotated (filter notIEDoc exps) tcs' <- mapM markEpToken tcs cp' <- markEpToken cp return (Just exps', an0 { anns = (anns an0) { am_exports = (op',cp',tcs')}}) ===================================== utils/check-exact/Main.hs ===================================== @@ -183,7 +183,8 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/printer/Test17519.hs" Nothing -- "../../testsuite/tests/printer/InTreeAnnotations1.hs" Nothing -- "../../testsuite/tests/printer/Test19798.hs" Nothing - "../../testsuite/tests/printer/Test10309.hs" Nothing + -- "../../testsuite/tests/printer/Test10309.hs" Nothing + "../../testsuite/tests/printer/Haddock1.hs" Nothing -- "../../testsuite/tests/qualifieddo/should_compile/qdocompile001.hs" Nothing -- "../../testsuite/tests/typecheck/should_fail/StrictBinds.hs" Nothing @@ -304,7 +305,7 @@ writeBinFile fpath x = withBinaryFile fpath WriteMode (\h -> hSetEncoding h utf8 testOneFile :: [(String, Changer)] -> FilePath -> String -> Maybe Changer -> IO () testOneFile _ libdir fileName mchanger = do - (p,_toks) <- parseOneFile libdir fileName + p <- parseOneFile libdir fileName let origAst = ppAst p pped = exactPrint p @@ -333,7 +334,7 @@ testOneFile _ libdir fileName mchanger = do changedSource <- readFile newFile return (expectedSource == changedSource, expectedSource, changedSource) - (p',_) <- parseOneFile libdir newFile + p' <- parseOneFile libdir newFile let newAstStr :: String newAstStr = ppAst p' writeBinFile newAstFile newAstStr @@ -364,15 +365,12 @@ testOneFile _ libdir fileName mchanger = do ppAst :: Data a => a -> String ppAst ast = showSDocUnsafe $ showAstData BlankSrcSpanFile NoBlankEpAnnotations ast - -parseOneFile :: FilePath -> FilePath -> IO (ParsedSource, [Located Token]) +parseOneFile :: FilePath -> FilePath -> IO ParsedSource parseOneFile libdir fileName = do - res <- parseModuleEpAnnsWithCpp libdir defaultCppOptions fileName + res <- Parsers.parseModule libdir fileName case res of Left m -> error (internalDebugShowMessages m) - Right (injectedComments, _dflags, pmod) -> do - let !pmodWithComments = insertCppComments pmod injectedComments - return (pmodWithComments, []) + Right pmod -> return pmod -- --------------------------------------------------------------------- @@ -519,8 +517,7 @@ changeLocalDecls libdir (L l p) = do replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs) -> Transform (LMatch GhcPs (LHsExpr GhcPs)) replaceLocalBinds (L lm (Match an mln pats (GRHSs _ rhs (HsValBinds (van,w) (ValBinds _ bs))))) = do - let (oldDecls) = map unWrapValBind bs - -- let decls = s:d:oldDecls + let oldDecls = map unWrapValBind bs let oldDecls' = captureLineSpacing oldDecls let (VbSig o:oldBinds) = map wrapValBind oldDecls' o' = setEntryDP o (DifferentLine 2 0) ===================================== utils/check-exact/Parsers.hs ===================================== @@ -46,6 +46,7 @@ module Parsers ( ) where import Preprocess +import Utils import Data.Functor (void) @@ -270,7 +271,10 @@ postParseTransform -> Either a (GHC.ParsedSource) postParseTransform parseRes = fmap mkAnns parseRes where - mkAnns (_cs, _, m) = fixModuleComments m + mkAnns (cs, _, m) = fixModuleComments (insertCppComments (noIEDoc m) cs) + noIEDoc (GHC.L l m) = case GHC.hsmodExports m of + Nothing -> GHC.L l m + Just exps -> GHC.L l m { GHC.hsmodExports = Just $ filter notIEDoc exps } fixModuleComments :: GHC.ParsedSource -> GHC.ParsedSource fixModuleComments p = fixModuleHeaderComments $ fixModuleTrailingComments p ===================================== utils/check-exact/Transform.hs ===================================== @@ -93,7 +93,6 @@ import qualified Control.Monad.Fail as Fail import GHC hiding (parseModule, parsedSource) import GHC.Parser.PostProcess ( wrapValBind ) import GHC.Data.FastString -import GHC.Types.SrcLoc import Data.Data import Data.List (unsnoc) @@ -402,6 +401,14 @@ balanceCommentsList' (a:b:ls) = (a':r) (a',b') = balanceComments a b r = balanceCommentsList' (b':ls) +balanceCommentsListA :: [LocatedA a ] -> [LocatedA a] +balanceCommentsListA [] = [] +balanceCommentsListA [x] = [x] +balanceCommentsListA (a:b:ls) = (a':r) + where + (a',b') = balanceCommentsA a b + r = balanceCommentsListA (b':ls) + -- |The GHC parser puts all comments appearing between the end of one AST -- item and the beginning of the next as 'annPriorComments' for the second one. -- This function takes two adjacent AST items and moves any 'annPriorComments' @@ -507,15 +514,6 @@ pushTrailingComments w cs lb@(HsValBinds (an,wt) _) = (True, HsValBinds (an',wt) (HsValBinds _ vb') -> vb' _ -> ValBinds noExtField [] - -balanceCommentsListA :: [LocatedA a] -> [LocatedA a] -balanceCommentsListA [] = [] -balanceCommentsListA [x] = [x] -balanceCommentsListA (a:b:ls) = (a':r) - where - (a',b') = balanceCommentsA a b - r = balanceCommentsListA (b':ls) - -- |Prior to moving an AST element, make sure any trailing comments belonging to -- it are attached to it, and not the following element. Of necessity this is a -- heuristic process, to be tuned later. Possibly a variant should be provided @@ -591,59 +589,6 @@ priorCommentsDeltas r cs = go r (sortEpaComments cs) -- --------------------------------------------------------------------- --- | Split comments into ones occurring before the end of the reference --- span, and those after it. -splitComments :: RealSrcSpan -> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment]) -splitComments p cs = (before, middle, after) - where - cmpe (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmpe (L _ _) = True - - cmpb (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2pos p - cmpb (L _ _) = True - - (beforeEnd, after) = break cmpe ((priorComments cs) ++ (getFollowingComments cs)) - (before, middle) = break cmpb beforeEnd - - --- | Split comments into ones occurring before the end of the reference --- span, and those after it. -splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments -splitCommentsEnd p (EpaComments cs) = cs' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = case after of - [] -> EpaComments cs - _ -> epaCommentsBalanced before after -splitCommentsEnd p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = before - ts' = after <> ts - --- | Split comments into ones occurring before the start of the reference --- span, and those after it. -splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments -splitCommentsStart p (EpaComments cs) = cs' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = case after of - [] -> EpaComments cs - _ -> epaCommentsBalanced before after -splitCommentsStart p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = before - ts' = after <> ts - moveLeadingComments :: (Data t, Data u, NoAnn t, NoAnn u) => LocatedAn t a -> EpAnn u -> (LocatedAn t a, EpAnn u) moveLeadingComments (L la a) lb = (L la' a, lb') @@ -680,19 +625,6 @@ addCommentOrigDeltasAnn (EpAnn e a cs) = EpAnn e a (addCommentOrigDeltas cs) anchorFromLocatedA :: LocatedA a -> RealSrcSpan anchorFromLocatedA (L (EpAnn anc _ _) _) = epaLocationRealSrcSpan anc --- | Get the full span of interest for comments from a LocatedA. --- This extends up to the last TrailingAnn -fullSpanFromLocatedA :: LocatedA a -> RealSrcSpan -fullSpanFromLocatedA (L (EpAnn anc tas _) _) = rr - where - r = epaLocationRealSrcSpan anc - trailing_loc ta = case ta_location ta of - EpaSpan (RealSrcSpan s _) -> [s] - _ -> [] - rr = case reverse (concatMap trailing_loc tas) of - [] -> r - (s:_) -> combineRealSrcSpans r s - -- --------------------------------------------------------------------- balanceSameLineComments :: LMatch GhcPs (LHsExpr GhcPs) -> (LMatch GhcPs (LHsExpr GhcPs)) ===================================== utils/check-exact/Utils.hs ===================================== @@ -228,7 +228,7 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining (p2, remaining) = insertTopLevelCppComments p1 toplevel addCommentsListItem :: EpAnn [TrailingAnn] -> State [LEpaComment] (EpAnn [TrailingAnn]) - addCommentsListItem = addComments + addCommentsListItem = addCommentsA addCommentsList :: EpAnn AnnList -> State [LEpaComment] (EpAnn AnnList) addCommentsList = addComments @@ -249,6 +249,20 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining _ -> return $ EpAnn anc an ocs + addCommentsA :: EpAnn [TrailingAnn] -> State [LEpaComment] (EpAnn [TrailingAnn]) + addCommentsA ann@(EpAnn anc an ocs) = do + case anc of + EpaSpan (RealSrcSpan s _) -> do + unAllocated <- get + let + (rest, these) = GHC.Parser.Lexer.allocateComments (fullSpanFromEpAnnA ann) unAllocated + balanced = splitCommentsEnd s (EpaComments these) + cs' = sortEpAnnComments (ocs <> balanced) + put rest + return $ EpAnn anc an cs' + + _ -> return $ EpAnn anc an ocs + workInComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments workInComments ocs [] = ocs workInComments ocs new = cs' @@ -264,9 +278,14 @@ workInComments ocs new = cs' = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos $ epaLocationRealSrcSpan ac) ) new +sortEpAnnComments :: EpAnnComments -> EpAnnComments +sortEpAnnComments (EpaComments cs) = EpaComments (sortEpaComments cs) +sortEpAnnComments (EpaCommentsBalanced pc fc) + = EpaCommentsBalanced (sortEpaComments pc) (sortEpaComments fc) + insertTopLevelCppComments :: HsModule GhcPs -> [LEpaComment] -> (HsModule GhcPs, [LEpaComment]) insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports imports decls) cs - = (HsModule (XModulePs an4 lo mdeprec mbDoc) mmn mexports' imports' decls', cs3) + = (HsModule (XModulePs an4 lo mdeprec mbDoc) mmn mexports imports' decls', cs3) -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0,hc1,hc_cs)) -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0i,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0i,hc0,hc1,hc_cs)) where @@ -297,24 +316,7 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports cs' = workInComments (comments an1) stay _ -> (an1,cs0a) - (mexports', an3, cs1) = - case mexports of - Nothing -> (Nothing, an2, cs0b) - Just exports -> (Just exports', an3', cse) - where - (csh', cs0b') = case am_exports $ anns an2 of - (tokOP, _tokCP, _tokCommas) -> - case tokOP of - (EpTok (EpaSpan (RealSrcSpan s _))) -> (h, n) - where - (h,n) = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos s) ) - cs0b - - _ -> ([], cs0b) - hc1' = workInComments (comments an2) csh' - an3' = an2 { comments = hc1' } - (exports', cse) = allocPreceding exports cs0b' - (imports0, cs2) = allocPreceding imports cs1 + (imports0, cs2) = allocPreceding imports cs0b (imports', hc0i) = balanceFirstLocatedAComments imports0 (decls0, cs3) = allocPreceding decls cs2 @@ -323,9 +325,9 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports -- Either hc0i or hc0d should have comments. Combine them hc0 = hc0i ++ hc0d - (hc1,hc_cs) = splitOnWhere After (am_where $ anns an3) hc0 - hc2 = workInComments (comments an3) hc1 - an4 = an3 { anns = (anns an3) {am_cs = hc_cs}, comments = hc2 } + (hc1,hc_cs) = splitOnWhere After (am_where $ anns an2) hc0 + hc2 = workInComments (comments an2) hc1 + an4 = an2 { anns = (anns an2) {am_cs = hc_cs}, comments = hc2 } allocPreceding :: [LocatedA a] -> [LEpaComment] -> ([LocatedA a], [LEpaComment]) allocPreceding [] cs' = ([], cs') @@ -346,7 +348,6 @@ annListBracketsLocs (ListSquare o c) = (getEpTokenLoc o, getEpTokenLoc c) annListBracketsLocs (ListBanana o c) = (getEpUniTokenLoc o, getEpUniTokenLoc c) annListBracketsLocs ListNone = (noAnn, noAnn) - data SplitWhere = Before | After splitOnWhere :: SplitWhere -> EpToken "where" -> [LEpaComment] -> ([LEpaComment], [LEpaComment]) @@ -430,6 +431,79 @@ insertRemainingCppComments (L l p) cs = L l p' -- --------------------------------------------------------------------- +-- | Get the full span of interest for comments from a LocatedA. +-- This extends up to the last TrailingAnn +fullSpanFromLocatedA :: LocatedA a -> RealSrcSpan +fullSpanFromLocatedA (L ann _) = fullSpanFromEpAnnA ann + +-- | Get the full span of interest for comments from a LocatedA. +-- This extends up to the last TrailingAnn +fullSpanFromEpAnnA :: EpAnn [TrailingAnn] -> RealSrcSpan +fullSpanFromEpAnnA (EpAnn anc tas _) = rr + where + r = epaLocationRealSrcSpan anc + trailing_loc ta = case ta_location ta of + EpaSpan (RealSrcSpan s _) -> [s] + _ -> [] + rr = case reverse (concatMap trailing_loc tas) of + [] -> r + (s:_) -> combineRealSrcSpans r s + +-- | Split comments into ones occurring before the end of the reference +-- span, and those after it. +splitComments :: RealSrcSpan -> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment]) +splitComments p cs = (before, middle, after) + where + cmpe (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmpe (L _ _) = True + + cmpb (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2pos p + cmpb (L _ _) = True + + (beforeEnd, after) = break cmpe ((priorComments cs) ++ (getFollowingComments cs)) + (before, middle) = break cmpb beforeEnd + + +-- | Split comments into ones occurring before the end of the reference +-- span, and those after it. +splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments +splitCommentsEnd p (EpaComments cs) = cs' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = case after of + [] -> EpaComments cs + _ -> epaCommentsBalanced before after +splitCommentsEnd p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = before + ts' = after <> ts + +-- | Split comments into ones occurring before the start of the reference +-- span, and those after it. +splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments +splitCommentsStart p (EpaComments cs) = cs' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = case after of + [] -> EpaComments cs + _ -> epaCommentsBalanced before after +splitCommentsStart p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = before + ts' = after <> ts + +-- --------------------------------------------------------------------- + ghcCommentText :: LEpaComment -> String ghcCommentText (L _ (GHC.EpaComment (EpaDocComment s) _)) = exactPrintHsDocString s ghcCommentText (L _ (GHC.EpaComment (EpaDocOptions s) _)) = s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/16b7cd2276cabc9df326d4a6aa6895… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/16b7cd2276cabc9df326d4a6aa6895… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: rts linker: Fix pointer arithmetic issue in flushInstructionCacheRISCV64
by Marge Bot (＠marge-bot) 24 Aug '26

24 Aug '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 3d44d11a by Andreas Klebinger at 2026-08-24T06:14:30-04:00 rts linker: Fix pointer arithmetic issue in flushInstructionCacheRISCV64 We accidentally operated over `uint64_t*` when we should use `uint8_t`. Fixes #27569 - - - - - 16b7cd22 by Alan Zimmerman at 2026-08-24T06:14:31-04:00 EPA: Uses Parsers.parseModule for exactprint tests Parsers.parseModule is the advertised way to parse for use for exact printing in the ghc-exactprint library. This commit updates the GHC exact print testing to use it. This requires moving the comment balancing that was occurring only in the test path into the advertising parser path, so it moves from Transforms.hs to Utils.hs. Also update the comment adding to honour trailing annotations - - - - - 6 changed files: - rts/linker/elf_reloc_riscv64.c - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Parsers.hs - utils/check-exact/Transform.hs - utils/check-exact/Utils.hs Changes: ===================================== rts/linker/elf_reloc_riscv64.c ===================================== @@ -679,7 +679,7 @@ void flushInstructionCacheRISCV64(ObjectCode *oc) { /* The main object code */ void *codeBegin = oc->image + oc->misalignment; - __builtin___clear_cache(codeBegin, (void*) ((uint64_t*) codeBegin + oc->fileSize)); + __builtin___clear_cache(codeBegin, (void*) ((uint8_t*) codeBegin + oc->fileSize)); /* Jump Islands */ __builtin___clear_cache((void *)oc->symbol_extras, ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -1465,7 +1465,7 @@ instance ExactPrint (HsModule GhcPs) where Just exps -> do let (op,cp,tcs) = am_exports $ anns an0 op' <- markEpToken op - exps' <- mapM markAnnotated exps + exps' <- mapM markAnnotated (filter notIEDoc exps) tcs' <- mapM markEpToken tcs cp' <- markEpToken cp return (Just exps', an0 { anns = (anns an0) { am_exports = (op',cp',tcs')}}) ===================================== utils/check-exact/Main.hs ===================================== @@ -183,7 +183,8 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/printer/Test17519.hs" Nothing -- "../../testsuite/tests/printer/InTreeAnnotations1.hs" Nothing -- "../../testsuite/tests/printer/Test19798.hs" Nothing - "../../testsuite/tests/printer/Test10309.hs" Nothing + -- "../../testsuite/tests/printer/Test10309.hs" Nothing + "../../testsuite/tests/printer/Haddock1.hs" Nothing -- "../../testsuite/tests/qualifieddo/should_compile/qdocompile001.hs" Nothing -- "../../testsuite/tests/typecheck/should_fail/StrictBinds.hs" Nothing @@ -304,7 +305,7 @@ writeBinFile fpath x = withBinaryFile fpath WriteMode (\h -> hSetEncoding h utf8 testOneFile :: [(String, Changer)] -> FilePath -> String -> Maybe Changer -> IO () testOneFile _ libdir fileName mchanger = do - (p,_toks) <- parseOneFile libdir fileName + p <- parseOneFile libdir fileName let origAst = ppAst p pped = exactPrint p @@ -333,7 +334,7 @@ testOneFile _ libdir fileName mchanger = do changedSource <- readFile newFile return (expectedSource == changedSource, expectedSource, changedSource) - (p',_) <- parseOneFile libdir newFile + p' <- parseOneFile libdir newFile let newAstStr :: String newAstStr = ppAst p' writeBinFile newAstFile newAstStr @@ -364,15 +365,12 @@ testOneFile _ libdir fileName mchanger = do ppAst :: Data a => a -> String ppAst ast = showSDocUnsafe $ showAstData BlankSrcSpanFile NoBlankEpAnnotations ast - -parseOneFile :: FilePath -> FilePath -> IO (ParsedSource, [Located Token]) +parseOneFile :: FilePath -> FilePath -> IO ParsedSource parseOneFile libdir fileName = do - res <- parseModuleEpAnnsWithCpp libdir defaultCppOptions fileName + res <- Parsers.parseModule libdir fileName case res of Left m -> error (internalDebugShowMessages m) - Right (injectedComments, _dflags, pmod) -> do - let !pmodWithComments = insertCppComments pmod injectedComments - return (pmodWithComments, []) + Right pmod -> return pmod -- --------------------------------------------------------------------- @@ -519,8 +517,7 @@ changeLocalDecls libdir (L l p) = do replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs) -> Transform (LMatch GhcPs (LHsExpr GhcPs)) replaceLocalBinds (L lm (Match an mln pats (GRHSs _ rhs (HsValBinds (van,w) (ValBinds _ bs))))) = do - let (oldDecls) = map unWrapValBind bs - -- let decls = s:d:oldDecls + let oldDecls = map unWrapValBind bs let oldDecls' = captureLineSpacing oldDecls let (VbSig o:oldBinds) = map wrapValBind oldDecls' o' = setEntryDP o (DifferentLine 2 0) ===================================== utils/check-exact/Parsers.hs ===================================== @@ -46,6 +46,7 @@ module Parsers ( ) where import Preprocess +import Utils import Data.Functor (void) @@ -270,7 +271,10 @@ postParseTransform -> Either a (GHC.ParsedSource) postParseTransform parseRes = fmap mkAnns parseRes where - mkAnns (_cs, _, m) = fixModuleComments m + mkAnns (cs, _, m) = fixModuleComments (insertCppComments (noIEDoc m) cs) + noIEDoc (GHC.L l m) = case GHC.hsmodExports m of + Nothing -> GHC.L l m + Just exps -> GHC.L l m { GHC.hsmodExports = Just $ filter notIEDoc exps } fixModuleComments :: GHC.ParsedSource -> GHC.ParsedSource fixModuleComments p = fixModuleHeaderComments $ fixModuleTrailingComments p ===================================== utils/check-exact/Transform.hs ===================================== @@ -93,7 +93,6 @@ import qualified Control.Monad.Fail as Fail import GHC hiding (parseModule, parsedSource) import GHC.Parser.PostProcess ( wrapValBind ) import GHC.Data.FastString -import GHC.Types.SrcLoc import Data.Data import Data.List (unsnoc) @@ -402,6 +401,14 @@ balanceCommentsList' (a:b:ls) = (a':r) (a',b') = balanceComments a b r = balanceCommentsList' (b':ls) +balanceCommentsListA :: [LocatedA a ] -> [LocatedA a] +balanceCommentsListA [] = [] +balanceCommentsListA [x] = [x] +balanceCommentsListA (a:b:ls) = (a':r) + where + (a',b') = balanceCommentsA a b + r = balanceCommentsListA (b':ls) + -- |The GHC parser puts all comments appearing between the end of one AST -- item and the beginning of the next as 'annPriorComments' for the second one. -- This function takes two adjacent AST items and moves any 'annPriorComments' @@ -507,15 +514,6 @@ pushTrailingComments w cs lb@(HsValBinds (an,wt) _) = (True, HsValBinds (an',wt) (HsValBinds _ vb') -> vb' _ -> ValBinds noExtField [] - -balanceCommentsListA :: [LocatedA a] -> [LocatedA a] -balanceCommentsListA [] = [] -balanceCommentsListA [x] = [x] -balanceCommentsListA (a:b:ls) = (a':r) - where - (a',b') = balanceCommentsA a b - r = balanceCommentsListA (b':ls) - -- |Prior to moving an AST element, make sure any trailing comments belonging to -- it are attached to it, and not the following element. Of necessity this is a -- heuristic process, to be tuned later. Possibly a variant should be provided @@ -591,59 +589,6 @@ priorCommentsDeltas r cs = go r (sortEpaComments cs) -- --------------------------------------------------------------------- --- | Split comments into ones occurring before the end of the reference --- span, and those after it. -splitComments :: RealSrcSpan -> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment]) -splitComments p cs = (before, middle, after) - where - cmpe (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmpe (L _ _) = True - - cmpb (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2pos p - cmpb (L _ _) = True - - (beforeEnd, after) = break cmpe ((priorComments cs) ++ (getFollowingComments cs)) - (before, middle) = break cmpb beforeEnd - - --- | Split comments into ones occurring before the end of the reference --- span, and those after it. -splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments -splitCommentsEnd p (EpaComments cs) = cs' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = case after of - [] -> EpaComments cs - _ -> epaCommentsBalanced before after -splitCommentsEnd p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = before - ts' = after <> ts - --- | Split comments into ones occurring before the start of the reference --- span, and those after it. -splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments -splitCommentsStart p (EpaComments cs) = cs' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = case after of - [] -> EpaComments cs - _ -> epaCommentsBalanced before after -splitCommentsStart p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = before - ts' = after <> ts - moveLeadingComments :: (Data t, Data u, NoAnn t, NoAnn u) => LocatedAn t a -> EpAnn u -> (LocatedAn t a, EpAnn u) moveLeadingComments (L la a) lb = (L la' a, lb') @@ -680,19 +625,6 @@ addCommentOrigDeltasAnn (EpAnn e a cs) = EpAnn e a (addCommentOrigDeltas cs) anchorFromLocatedA :: LocatedA a -> RealSrcSpan anchorFromLocatedA (L (EpAnn anc _ _) _) = epaLocationRealSrcSpan anc --- | Get the full span of interest for comments from a LocatedA. --- This extends up to the last TrailingAnn -fullSpanFromLocatedA :: LocatedA a -> RealSrcSpan -fullSpanFromLocatedA (L (EpAnn anc tas _) _) = rr - where - r = epaLocationRealSrcSpan anc - trailing_loc ta = case ta_location ta of - EpaSpan (RealSrcSpan s _) -> [s] - _ -> [] - rr = case reverse (concatMap trailing_loc tas) of - [] -> r - (s:_) -> combineRealSrcSpans r s - -- --------------------------------------------------------------------- balanceSameLineComments :: LMatch GhcPs (LHsExpr GhcPs) -> (LMatch GhcPs (LHsExpr GhcPs)) ===================================== utils/check-exact/Utils.hs ===================================== @@ -228,7 +228,7 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining (p2, remaining) = insertTopLevelCppComments p1 toplevel addCommentsListItem :: EpAnn [TrailingAnn] -> State [LEpaComment] (EpAnn [TrailingAnn]) - addCommentsListItem = addComments + addCommentsListItem = addCommentsA addCommentsList :: EpAnn AnnList -> State [LEpaComment] (EpAnn AnnList) addCommentsList = addComments @@ -249,6 +249,20 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining _ -> return $ EpAnn anc an ocs + addCommentsA :: EpAnn [TrailingAnn] -> State [LEpaComment] (EpAnn [TrailingAnn]) + addCommentsA ann@(EpAnn anc an ocs) = do + case anc of + EpaSpan (RealSrcSpan s _) -> do + unAllocated <- get + let + (rest, these) = GHC.Parser.Lexer.allocateComments (fullSpanFromEpAnnA ann) unAllocated + balanced = splitCommentsEnd s (EpaComments these) + cs' = sortEpAnnComments (ocs <> balanced) + put rest + return $ EpAnn anc an cs' + + _ -> return $ EpAnn anc an ocs + workInComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments workInComments ocs [] = ocs workInComments ocs new = cs' @@ -264,9 +278,14 @@ workInComments ocs new = cs' = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos $ epaLocationRealSrcSpan ac) ) new +sortEpAnnComments :: EpAnnComments -> EpAnnComments +sortEpAnnComments (EpaComments cs) = EpaComments (sortEpaComments cs) +sortEpAnnComments (EpaCommentsBalanced pc fc) + = EpaCommentsBalanced (sortEpaComments pc) (sortEpaComments fc) + insertTopLevelCppComments :: HsModule GhcPs -> [LEpaComment] -> (HsModule GhcPs, [LEpaComment]) insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports imports decls) cs - = (HsModule (XModulePs an4 lo mdeprec mbDoc) mmn mexports' imports' decls', cs3) + = (HsModule (XModulePs an4 lo mdeprec mbDoc) mmn mexports imports' decls', cs3) -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0,hc1,hc_cs)) -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0i,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0i,hc0,hc1,hc_cs)) where @@ -297,24 +316,7 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports cs' = workInComments (comments an1) stay _ -> (an1,cs0a) - (mexports', an3, cs1) = - case mexports of - Nothing -> (Nothing, an2, cs0b) - Just exports -> (Just exports', an3', cse) - where - (csh', cs0b') = case am_exports $ anns an2 of - (tokOP, _tokCP, _tokCommas) -> - case tokOP of - (EpTok (EpaSpan (RealSrcSpan s _))) -> (h, n) - where - (h,n) = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos s) ) - cs0b - - _ -> ([], cs0b) - hc1' = workInComments (comments an2) csh' - an3' = an2 { comments = hc1' } - (exports', cse) = allocPreceding exports cs0b' - (imports0, cs2) = allocPreceding imports cs1 + (imports0, cs2) = allocPreceding imports cs0b (imports', hc0i) = balanceFirstLocatedAComments imports0 (decls0, cs3) = allocPreceding decls cs2 @@ -323,9 +325,9 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports -- Either hc0i or hc0d should have comments. Combine them hc0 = hc0i ++ hc0d - (hc1,hc_cs) = splitOnWhere After (am_where $ anns an3) hc0 - hc2 = workInComments (comments an3) hc1 - an4 = an3 { anns = (anns an3) {am_cs = hc_cs}, comments = hc2 } + (hc1,hc_cs) = splitOnWhere After (am_where $ anns an2) hc0 + hc2 = workInComments (comments an2) hc1 + an4 = an2 { anns = (anns an2) {am_cs = hc_cs}, comments = hc2 } allocPreceding :: [LocatedA a] -> [LEpaComment] -> ([LocatedA a], [LEpaComment]) allocPreceding [] cs' = ([], cs') @@ -346,7 +348,6 @@ annListBracketsLocs (ListSquare o c) = (getEpTokenLoc o, getEpTokenLoc c) annListBracketsLocs (ListBanana o c) = (getEpUniTokenLoc o, getEpUniTokenLoc c) annListBracketsLocs ListNone = (noAnn, noAnn) - data SplitWhere = Before | After splitOnWhere :: SplitWhere -> EpToken "where" -> [LEpaComment] -> ([LEpaComment], [LEpaComment]) @@ -430,6 +431,79 @@ insertRemainingCppComments (L l p) cs = L l p' -- --------------------------------------------------------------------- +-- | Get the full span of interest for comments from a LocatedA. +-- This extends up to the last TrailingAnn +fullSpanFromLocatedA :: LocatedA a -> RealSrcSpan +fullSpanFromLocatedA (L ann _) = fullSpanFromEpAnnA ann + +-- | Get the full span of interest for comments from a LocatedA. +-- This extends up to the last TrailingAnn +fullSpanFromEpAnnA :: EpAnn [TrailingAnn] -> RealSrcSpan +fullSpanFromEpAnnA (EpAnn anc tas _) = rr + where + r = epaLocationRealSrcSpan anc + trailing_loc ta = case ta_location ta of + EpaSpan (RealSrcSpan s _) -> [s] + _ -> [] + rr = case reverse (concatMap trailing_loc tas) of + [] -> r + (s:_) -> combineRealSrcSpans r s + +-- | Split comments into ones occurring before the end of the reference +-- span, and those after it. +splitComments :: RealSrcSpan -> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment]) +splitComments p cs = (before, middle, after) + where + cmpe (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmpe (L _ _) = True + + cmpb (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2pos p + cmpb (L _ _) = True + + (beforeEnd, after) = break cmpe ((priorComments cs) ++ (getFollowingComments cs)) + (before, middle) = break cmpb beforeEnd + + +-- | Split comments into ones occurring before the end of the reference +-- span, and those after it. +splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments +splitCommentsEnd p (EpaComments cs) = cs' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = case after of + [] -> EpaComments cs + _ -> epaCommentsBalanced before after +splitCommentsEnd p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = before + ts' = after <> ts + +-- | Split comments into ones occurring before the start of the reference +-- span, and those after it. +splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments +splitCommentsStart p (EpaComments cs) = cs' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = case after of + [] -> EpaComments cs + _ -> epaCommentsBalanced before after +splitCommentsStart p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = before + ts' = after <> ts + +-- --------------------------------------------------------------------- + ghcCommentText :: LEpaComment -> String ghcCommentText (L _ (GHC.EpaComment (EpaDocComment s) _)) = exactPrintHsDocString s ghcCommentText (L _ (GHC.EpaComment (EpaDocOptions s) _)) = s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e4eb741cd5a14d45f6751ad442de1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e4eb741cd5a14d45f6751ad442de1… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/sjakobi/T27628-rebox-warning] 14 commits: SpecConstr: Don't warn about reboxing nullary constructors
by Simon Jakobi (＠sjakobi) 24 Aug '26

24 Aug '26

Simon Jakobi pushed to branch wip/sjakobi/T27628-rebox-warning at Glasgow Haskell Compiler / GHC Commits: 903a0046 by Simon Jakobi at 2026-08-22T14:12:01+02:00 SpecConstr: Don't warn about reboxing nullary constructors "Reboxing" a nullary constructor just references its shared static closure: it costs no allocation and even preserves pointer identity. Such patterns are common (Nil, [], Nothing, ...) and accounted for a fair share of the -Wspec-constr-reboxing warnings when compiling containers, e.g. from functions matching an empty-set argument. See Note [Reboxing warning]. Assisted-by: Claude Fable 5 - - - - - 523a633a by Simon Jakobi at 2026-08-22T14:17:27+02:00 SpecConstr: Attribute reboxing warnings to the enclosing binder -Wspec-constr-reboxing frequently fires on local functions — join points and local workers — whose names are meaningless to the user and which often have no source location at all, e.g. $j_sahl (Present) Defined at <no location info> Track the enclosing top-level binder in ScEnv (sc_top_fn) and name it in the warning, pointing at its definition site: that is where any remedy would be applied. See Note [Reboxing warning]. Assisted-by: Claude Fable 5 - - - - - 16f32940 by Simon Jakobi at 2026-08-22T14:25:01+02:00 SpecConstr: Emit one reboxing warning per function Emit -Wspec-constr-reboxing as one diagnostic per specialised function, merging the reboxed constructors of all its call patterns, instead of a single module-wide list. Compiling containers produced several near-identical entries per function (one per call pattern), e.g. four times `$wgo (Collision)`. The shorter per-function message points at the users guide for the possible remedies instead of spelling them out each time. Also: document the nullary-constructor exemption and the attribution of local functions in the users guide. Assisted-by: Claude Fable 5 - - - - - b01adcd0 by Simon Jakobi at 2026-08-22T14:28:11+02:00 SpecConstr: Merge reboxing warnings that would render identically Distinct local functions frequently share an occurrence name and enclosing binder (e.g. two workers both called merge0 inside IntMap.unionWithKey, from different unfoldings of the same source function), producing warnings that differ only in their Name's unique and so print as exact duplicates. Key the per-function aggregation on (occurrence name, parent) instead of the Name. Assisted-by: Claude Fable 5 - - - - - 96b4e968 by Simon Jakobi at 2026-08-22T15:08:14+02:00 SetLevels: Preserve source spans on floated poly_ bindings When the float-out pass lifts a local function past type-variable bindings, newPolyBndrs made the new poly_ binder with mkSysLocal, dropping the original binder's source span. Diagnostics naming such bindings — e.g. -Wspec-constr-reboxing (#27628) — could then only report "defined at <no location info>". Keep the original span on the poly_ binder instead. Worker/wrapper derives worker names with mkDerivedInternalName, so $wpoly_ bindings inherit the span for free. The new test T27628g checks that a reboxing warning about a floated local function points at its definition site. Assisted-by: Claude Fable 5 - - - - - c2318213 by Simon Jakobi at 2026-08-22T15:24:25+02:00 SpecConstr: Point reboxing warnings at the local function's definition A reboxing warning about a local function showed the enclosing top-level binder's location, so distinct same-named locals rendered identically and were merged into one warning. Applying a remedy to one of them then left the warning seemingly unchanged, with no hint that progress had been made. Show the local function's own definition site instead, falling back to the parent's only when the local has none (e.g. simplifier-made join points). Merging now only affects warnings that point at the same site, which a single source-level remedy addresses together; see Note [Reboxing warning]. Assisted-by: Claude Fable 5 - - - - - 35025093 by Simon Jakobi at 2026-08-23T04:14:09+02:00 SpecConstr: Explain reboxing warnings that have no source location A stage-2 GHC build showed 387 of 499 reboxing warnings pointing at "<no location info>": local loops (e.g. foldr's go, Data.Map's fromList stack machinery) that reach the consuming module in interface unfoldings, which record no spans for local binders. Rendering an unhelpful span reads like a bug and gives the user nothing to act on. Instead say "inlined from another module; no source location", and show constructors imported from other modules qualified with their defining module — with the function anonymous, they are what identifies the package to report the reboxing to. Also quote the function, parent, and constructor names, matching the usual diagnostic style. See the new bullet in Note [Reboxing warning]. Context: #27628. Assisted-by: Claude Fable 5 - - - - - 92115070 by Simon Jakobi at 2026-08-23T04:22:42+02:00 SpecConstr: Merge indistinguishable reboxing warnings uniformly Reboxing warnings that would render identically were merged only when a parent attribution was present. Parentless warnings were compared by Name instead. For located top-level functions the two rules agree, since distinct functions differ in name or location, but span-less loops from imported unfoldings all render as e.g. SpecConstr specialised 'go1' (inlined from another module; ...) and were still printed once per copy: a stage-2 GHC build had 67 such go1 lines, 10 of them in a single module. The reader cannot tell the copies apart, and none of them can be located, so repetition carries no information. Drop the special case and merge on render identity throughout, combining the constructor lists of merged warnings. New test T27628i checks that two span-less same-named loops produce a single warning listing both reboxed constructors. Context: #27628. Assisted-by: Claude Fable 5 - - - - - 47e5dc94 by Simon Jakobi at 2026-08-23T13:34:21+02:00 SpecConstr: Show the specialised function's type in reboxing warnings A reboxing warning about a span-less loop inlined from another module identifies it only by a meaningless name like go1. The type is usually short and is the best available clue to what the function does, so print it after the name. The type also joins the render-identity merge key, so same-named span-less loops of different types no longer collapse into one warning. See Note [Reboxing warning]. T27628i gains a third source function whose loop matches the first one's rendering, keeping the merge of indistinguishable warnings exercised. Context: #27628. Assisted-by: Claude Fable 5 - - - - - 8d2e130b by Simon Jakobi at 2026-08-23T13:39:46+02:00 SpecConstr: Name the calling functions in span-less reboxing warnings A reboxing warning about a function inlined from another module can point at no located code at all. The call sites that drove the specialisation can: they sit in top-level binders of the module being compiled, and following the inlining from one of them identifies the reboxed loop. Record the enclosing top-level binder of each call (sc_top_fn) in Call, thread it through CallPat, and render it as "called from". See Note [Reboxing warning]. Context: #27628. Assisted-by: Claude Fable 5 - - - - - c817c224 by Simon Jakobi at 2026-08-23T23:06:52+02:00 Render the reboxing warning as a labelled fact block The prose rendering packed definition site, callers, and constructors into one parenthesised run-on that grew hard to scan, especially with several callers or constructors. Instead show one labelled fact per line (source, called from, reboxed constructors), values aligned, with the wrapped-up prose reduced to a closing sentence whose grammar tracks the constructor count. The printed forall is suppressed (pprSigmaType) and callers are now always shown, including the enclosing binder of a local function: as a separate labelled fact it no longer reads as a duplicate of the source line. Since the constructor list is now part of what the reader sees per warning, it joins the render-identical merge key. Same-function warnings still merge unconditionally, in a separate pass keyed on the function's Name. Part of #27628. Assisted-by: Claude Fable 5 - - - - - bbc2f3f9 by Simon Jakobi at 2026-08-23T23:14:48+02:00 Classify the specialised function's recursivity in reboxing warnings A "recursivity:" fact says whether the function SpecConstr specialised is self-recursive, mutually recursive (naming the other functions of its Rec group), or non-recursive (e.g. a join point), as bound in the post-optimisation program. Where the warning fires on code the reader never wrote in that shape — floated-out loops, span-less inlined copies — this narrows down what to look for at the source. The classification falls out of the specialisation entry points: specRec knows the Rec group (a singleton is genuinely self-recursive, since the occurrence analyser demotes non-recursive singletons to NonRec), and specNonRec handles nested non-recursive bindings. See Note [Reboxing warning]. Part of #27628. Assisted-by: Claude Fable 5 - - - - - f0337cb7 by Simon Jakobi at 2026-08-24T01:51:48+02:00 Show the call patterns in reboxing warnings A reboxing warning used to list the reboxed constructors of all the function's specialisations as one flat set, which erased the structure that makes such a list intelligible: constructors from alternative patterns of one argument, and constructors nested inside others, read as an unrelated jumble. Now each call pattern is shown as the constructor skeletons of its arguments, e.g. call patterns: go (A _) (I# _) (reboxing ‘A’) go (B _) (I# _) (reboxing ‘B’) which also pictures what SpecConstr did: it copied the function for calls of exactly that shape. See Note [Reboxing warning]. Also fix the per-function aggregation, which keyed on the function's Name alone: two top-level bindings can bind distinct locals sharing a unique (copies of one inlined unfolding template), and their warnings were fused, dropping one warning's type and doubling the callers. The key now includes the enclosing top-level binder. T27628l pins the fixed behaviour with the Max/Min pair that exposed this. Part of #27628. Assisted-by: Claude Fable 5 - - - - - 147702b0 by Simon Jakobi at 2026-08-24T02:54:10+02:00 Render the reboxing tag as a comment, not parens Parenthesized as (reboxing 'A'), the tag read as one more argument of the call pattern. A comment can't be part of a call, and GHC already annotates output this way (:info's "-- Defined in"): call patterns: go (A _) (I# _) -- reboxes 'A' go (B _) (I# _) -- reboxes 'B' Part of #27628. Assisted-by: Claude Fable 5 - - - - - 23 changed files: - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/SpecConstr.hs - docs/users_guide/using-warnings.rst - testsuite/tests/simplCore/should_compile/T27628.stderr - testsuite/tests/simplCore/should_compile/T27628b.stderr - + testsuite/tests/simplCore/should_compile/T27628e.hs - + testsuite/tests/simplCore/should_compile/T27628f.hs - + testsuite/tests/simplCore/should_compile/T27628f.stderr - + testsuite/tests/simplCore/should_compile/T27628g.hs - + testsuite/tests/simplCore/should_compile/T27628g.stderr - + testsuite/tests/simplCore/should_compile/T27628h.hs - + testsuite/tests/simplCore/should_compile/T27628h.stderr - + testsuite/tests/simplCore/should_compile/T27628h_M.hs - + testsuite/tests/simplCore/should_compile/T27628i.hs - + testsuite/tests/simplCore/should_compile/T27628i.stderr - + testsuite/tests/simplCore/should_compile/T27628i_M.hs - + testsuite/tests/simplCore/should_compile/T27628j.hs - + testsuite/tests/simplCore/should_compile/T27628j.stderr - + testsuite/tests/simplCore/should_compile/T27628k.hs - + testsuite/tests/simplCore/should_compile/T27628k.stderr - + testsuite/tests/simplCore/should_compile/T27628l.hs - + testsuite/tests/simplCore/should_compile/T27628l.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -108,8 +108,8 @@ import GHC.Types.Var.Env import GHC.Types.Literal ( litIsTrivial ) import GHC.Types.Demand ( DmdSig, prependArgsDmdSig ) import GHC.Types.Cpr ( CprSig, prependArgsCprSig ) -import GHC.Types.Name ( getOccName ) -import GHC.Types.Name.Occurrence ( occNameFS ) +import GHC.Types.Name ( getOccName, getSrcSpan, mkSystemNameAt ) +import GHC.Types.Name.Occurrence ( occNameFS, mkVarOccFS ) import GHC.Types.Unique ( hasKey ) import GHC.Types.Tickish ( tickishIsCode ) import GHC.Types.Unique.Supply @@ -1872,7 +1872,10 @@ newPolyBndrs dest_lvl mk_poly_bndr bndr uniq = transferPolyIdInfo bndr abs_vars $ -- Note [transferPolyIdInfo] in GHC.Types.Id transfer_join_info bndr $ - mkSysLocal str uniq (idMult bndr) poly_ty + -- Keep bndr's srcspan so that diagnostics can + -- still point at the original definition + mkLocalId (mkSystemNameAt uniq (mkVarOccFS str) (getSrcSpan bndr)) + (idMult bndr) poly_ty where str = fsLit "poly_" `appendFS` occNameFS (getOccName bndr) poly_ty = mkLamTypes abs_vars (substTyUnchecked subst (idType bndr)) ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -36,6 +36,9 @@ import GHC.Core.Coercion hiding( substCo ) import GHC.Core.Rules import GHC.Core.Predicate ( scopedSort, typeDeterminesValue ) import GHC.Core.Type hiding ( substTy ) +import GHC.Core.TyCo.Compare ( eqType ) +import GHC.Core.TyCo.Ppr ( pprSigmaType ) +import GHC.Core.TyCo.Tidy ( tidyTopType ) import GHC.Core.TyCon (TyCon, tyConName ) import GHC.Core.Multiplicity import GHC.Core.Ppr ( pprParendExpr ) @@ -45,12 +48,13 @@ import GHC.Unit.Module.ModGuts import GHC.Types.InlinePragma import GHC.Types.Error (DiagnosticReason(..)) -import GHC.Types.Literal ( litIsLifted ) +import GHC.Types.Literal ( Literal, litIsLifted ) import GHC.Types.Id import GHC.Types.Id.Info ( IdDetails(..) ) import GHC.Types.Var.Env import GHC.Types.Var.Set import GHC.Types.Name +import GHC.Types.SrcLoc ( isGoodSrcSpan ) import GHC.Types.Tickish import GHC.Types.Basic import GHC.Types.Demand @@ -75,7 +79,7 @@ import GHC.Exts( SpecConstrAnnotation(..) ) import GHC.Serialized ( deserializeWithData ) import Control.Monad -import Data.List ( sortBy, partition, dropWhileEnd, mapAccumL, nub, unzip4 ) +import Data.List ( sortBy, partition, dropWhileEnd, mapAccumL, nub, nubBy, unzip4 ) import Data.List.NonEmpty ( NonEmpty (..) ) import Data.Maybe( mapMaybe ) import Data.Ord( comparing ) @@ -790,8 +794,8 @@ specConstrProgram guts is_rebox _ = False ; when (not (null forced_ws)) $ diagnostic WarningWithoutFlag (forced_msg forced_ws) - ; when (not (null rebox_ws)) $ diagnostic (WarningWithFlag Opt_WarnSpecConstrReboxing) - (rebox_msg (nub rebox_ws)) + ; mapM_ (diagnostic (WarningWithFlag Opt_WarnSpecConstrReboxing) . rebox_msg) + (aggregateRebox rebox_ws) ; return (guts { mg_binds = binds' }) } @@ -802,15 +806,137 @@ specConstrProgram guts nest 2 (vcat (map ppr warnings)) $$ (text "If this is expected you might want to increase -fmax-forced-spec-args to force specialization anyway.") + -- One warning per specialised function (all its patterns listed), + -- then warnings that would render identically merged too; see + -- Note [Reboxing warning] + aggregateRebox :: SpecConstrWarnings -> SpecConstrWarnings + aggregateRebox = mergeBy same_render . mergeBy same_fn + where + mergeBy eq ws + = [ SpecReboxed fn ty parent recur (nubBy same_pat (concat patss)) (nub (concat callerss)) + | w@(SpecReboxed fn ty parent recur _ _) <- nubBy eq ws + , let (patss, callerss) = unzip [ (pats, callers) + | w'@(SpecReboxed _ _ _ _ pats callers) <- ws + , eq w w' ] ] + + -- Also compare the parents: the fn Name alone is ambiguous + -- between top-level bindings; see Note [Reboxing warning] + same_fn (SpecReboxed fn1 _ p1 _ _ _) (SpecReboxed fn2 _ p2 _ _ _) + = fn1 == fn2 && p1 == p2 + same_fn _ _ = False + + -- Merge warnings that would render identically: same occurrence + -- name, type, parent, displayed location, recursivity, and + -- patterns. The reader could not tell them apart, so printing + -- both is noise; see Note [Reboxing warning]. Callers are + -- aggregated, not compared. + same_render (SpecReboxed fn1 ty1 p1 r1 pats1 _) (SpecReboxed fn2 ty2 p2 r2 pats2 _) + = getOccName fn1 == getOccName fn2 && p1 == p2 + && nameSrcSpan (rebox_loc_name fn1 p1) == nameSrcSpan (rebox_loc_name fn2 p2) + && ty1 `eqType` ty2 + && r1 `same_recur` r2 + && equalLength pats1 pats2 + && and (zipWith same_pat (sortBy cmpReboxedPat pats1) + (sortBy cmpReboxedPat pats2)) + same_render _ _ = False + + same_pat p1 p2 = cmpReboxedPat p1 p2 == EQ + + -- Recursivity as displayed: siblings compare by occurrence name, + -- so span-less copies of one mutual group still merge + same_recur ReboxSelfRec ReboxSelfRec = True + same_recur (ReboxNonRec j1) (ReboxNonRec j2) = j1 == j2 + same_recur (ReboxMutualRec s1) (ReboxMutualRec s2) + = map getOccName (sortBy stableNameCmp s1) + == map getOccName (sortBy stableNameCmp s2) + same_recur _ _ = False + + -- The definition site shown in a reboxing warning: the fn's own when + -- known, otherwise the parent's (e.g. for simplifier-made join points) + rebox_loc_name :: Name -> Maybe Name -> Name + rebox_loc_name fn (Just parent) + | not (isGoodSrcSpan (nameSrcSpan fn)) = parent + rebox_loc_name fn _ = fn + -- See Note [Reboxing warning] - rebox_msg :: SpecConstrWarnings -> SDoc - rebox_msg warnings = text "SpecConstr specialised the following function(s) on a constructor argument that is also used boxed:" $$ - nest 2 (vcat (map ppr warnings)) $$ - text "The specialised code allocates a fresh constructor at each such use (\"reboxing\")," $$ - text "which can increase allocation and defeat pointer-equality-based sharing." $$ - text "Possible remedies: exclude the type with an {-# ANN type T NoSpecConstr #-} pragma," $$ - text "hide the constructor from SpecConstr by wrapping the call-site argument in GHC.Exts.lazy," $$ - text "or use -fno-spec-constr." + rebox_msg :: SpecConstrWarning -> SDoc + rebox_msg w@(SpecFailForcedArgCount {}) = pprPanic "rebox_msg" (ppr w) + rebox_msg (SpecReboxed fn ty mb_parent recur pats callers) + = vcat [ hang (text "SpecConstr specialised") 2 + (quotes (ppr fn <+> dcolon <+> pp_ty)) + , nest 2 $ vcat $ catMaybes + [ Just (fact "source:" pp_source) + , Just (fact "recursivity:" pp_recur) + , fact "called from:" <$> pp_callers + , Just (fact pats_label pp_pats) ] + , pp_trailer + , text "See -Wspec-constr-reboxing in the users guide for possible remedies." ] + where + -- Aligned label column; $$ overlaps, so a multi-line value keeps + -- its lines aligned under the first + fact l v = text l $$ nest 23 v + + -- Truncate only pathologically large types + pp_ty = sdocWithContext $ \ctx -> + case splitAt 10000 (showSDocOneLine ctx pp_tidy) of + (_, []) -> pp_tidy + (prefix, _) -> text prefix <> text "..." + where pp_tidy = pprSigmaType (tidyTopType ty) + -- pprSigmaType: suppress the printed forall + + -- A name with no source span reached this module in an interface + -- unfolding: iface files record no spans for local binders + pp_source = case (mb_parent, isGoodSrcSpan (nameSrcSpan loc_name)) of + (Nothing, True) -> pp_loc + (Just p, True) -> quotes (ppr p) <+> text "at" <+> pp_loc + (Just p, False) -> quotes (ppr p) <> comma <+> pp_no_loc + (Nothing, False) -> pp_no_loc + where + loc_name = rebox_loc_name fn mb_parent + pp_loc = ppr (nameSrcLoc loc_name) + pp_no_loc = text "inlined from another module (no source location)" + + pp_recur = case recur of + ReboxSelfRec -> text "self-recursive" + ReboxNonRec True -> text "non-recursive (a join point)" + ReboxNonRec False -> text "non-recursive" + ReboxMutualRec sibs + -> text "mutually recursive with" + <+> pprWithCommas (quotes . ppr) named <> pp_rest + where + (named, rest) = splitAt 3 (sortBy stableNameCmp sibs) + pp_rest = case length rest of + 0 -> empty + 1 -> text " and 1 other" + n -> text " and" <+> int n <+> text "others" + + pp_callers = case sortBy stableNameCmp callers of + [] -> Nothing + cs -> Just (pprWithCommas (quotes . ppr) cs) + + pats_label = case pats of + [_] -> "call pattern:" + _ -> "call patterns:" + + pp_pats = vcat (map pp_pat (sortBy cmpReboxedPat pats)) + + pp_pat (ReboxedPat shapes cons) + = hang (hang (ppr fn) 2 (fsep (map pprPatShape shapes))) 2 + (text "-- reboxes" <+> + pprWithCommas pp_con (sortBy stableNameCmp cons)) + + -- Qualify imported constructors: they identify the package to + -- follow up with when the function itself has no location + pp_con con + | Just m <- nameModule_maybe con, m /= mg_module guts + = quotes (ppr m <> dot <> ppr con) + | otherwise = quotes (ppr con) + + all_cons = nub [ con | ReboxedPat _ cons <- pats, con <- cons ] + + pp_trailer = fsep $ map text $ words $ case all_cons of + [_] -> "This constructor argument is also used boxed, so the specialisation may increase allocation and defeat pointer-equality-based sharing." + _ -> "These constructor arguments are also used boxed, so the specialisations may increase allocation and defeat pointer-equality-based sharing." scTopBinds :: ScEnv -> [InBind] -> UniqSM (ScUsage, [OutBind], [SpecConstrWarning]) scTopBinds _env [] = return (nullUsage, [], []) scTopBinds env (b:bs) = do { (usg, b', bs', warnings) <- scBind TopLevel env b $ @@ -975,7 +1101,12 @@ data ScEnv = SCE { sc_opts :: !SpecConstrOpts, -- Domain is OutIds (*after* applying the substitution) -- Used even for top-level bindings (but not imported ones) - sc_annotations :: UniqFM Name SpecConstrAnnotation + sc_annotations :: UniqFM Name SpecConstrAnnotation, + + sc_top_fn :: Maybe Name + -- The top-level binder whose RHS we are inside, + -- used to attribute warnings about local functions + -- See Note [Reboxing warning] } --------------------- @@ -1025,7 +1156,8 @@ initScEnv guts sc_subst = init_subst, sc_how_bound = emptyVarEnv, sc_vals = emptyVarEnv, - sc_annotations = anns }) } + sc_annotations = anns, + sc_top_fn = Nothing }) } where init_subst = mkEmptySubst $ mkInScopeSetBndrs (mg_binds guts) -- Acccount for top-level bindings that are not in dependency order; @@ -1046,6 +1178,11 @@ instance Outputable HowBound where scForce :: ScEnv -> Bool -> ScEnv scForce env b = env { sc_force = b } +-- Keeps the outermost binder; see Note [Reboxing warning] +setTopFn :: ScEnv -> OutId -> ScEnv +setTopFn env@(SCE { sc_top_fn = Nothing }) bndr = env { sc_top_fn = Just (idName bndr) } +setTopFn env _ = env + lookupHowBound :: ScEnv -> OutId -> Maybe HowBound lookupHowBound env id = lookupVarEnv (sc_how_bound env) id @@ -1286,9 +1423,11 @@ data ScUsage } -- The domain is OutIds type CallEnv = IdEnv [Call] -- Domain is OutIds -data Call = Call OutId [CoreArg] ValueEnv +data Call = Call OutId [CoreArg] ValueEnv (Maybe Name) -- The arguments of the call, together with the -- env giving the constructor bindings at the call site + -- and the enclosing top-level binder of the call site + -- (sc_top_fn, for reboxing warnings) -- We keep the function mainly for debug output -- -- The call is not necessarily saturated; we just put @@ -1300,7 +1439,7 @@ instance Outputable ScUsage where , text "occs =" <+> ppr occs ]) instance Outputable Call where - ppr (Call fn args _) = ppr fn <+> fsep (map pprParendExpr args) + ppr (Call fn args _ _) = ppr fn <+> fsep (map pprParendExpr args) nullUsage :: ScUsage nullUsage = SCU { scu_calls = emptyVarEnv, scu_occs = emptyVarEnv } @@ -1443,6 +1582,73 @@ that decision bites, without changing which specialisations are made: SpecReboxed warnings, which specConstrProgram emits under -Wspec-constr-reboxing (off by default). +* One warning per function, listing each call pattern the function was + specialised for — the constructor skeletons of the call's arguments, + e.g. `go (_ : _) (BMap _) -- reboxes ‘BMap’` — alongside that + pattern's reboxed constructors. The shapes show where in the + argument each reboxed constructor sits, and picture what SpecConstr + did: it made a copy of + the function for calls of exactly that shape. The warning also shows + the function's type: names like `go1` say nothing, and for span-less + functions (last bullet below) the type is the main identifying clue. + + "Per function" means per (parent, function) *pair*: the function's + Name alone is ambiguous, because distinct top-level bindings can bind + distinct locals that share a unique. That happens when several + bindings inline one stable unfolding (e.g. a class's default-method + template): each copy keeps the template's uniques, and the simplifier + only freshens a binder on an in-scope clash, which cannot arise + between sibling top-level RHSs. + + Warnings that would render identically — same name, type, parent, + definition site, recursivity, and patterns — are merged too: the + reader could not tell them apart, so printing both is noise. For + located functions the merged warnings are simplifier-made copies of one + binding, addressed by a single source-level remedy; span-less loops + inlined from other modules can in principle merge across different + origins, but sharing name and type they are almost certainly copies of + one function. + +* The warning classifies how the specialised function recurses + ("recursivity"), taken from the binding SpecConstr saw: a Rec group of + one is self-recursive (the occurrence analyser demotes non-recursive + singletons to NonRec), a larger group is mutually recursive and the + siblings are named, and a nested NonRec binding — typically a join + point, see Note [Specialising local let bindings] — is non-recursive. + This reflects the post-optimisation program, whose shape can differ + from the source's. + +* Nullary constructors are exempt: "reboxing" a nullary constructor just + references its shared static closure, so it costs no allocation and even + preserves pointer identity. Such patterns are common (Nil, [], Nothing, + ...) and warning about them would be pure noise. + +* Warnings about local functions (join points, local workers) name the + enclosing top-level binder too: locals often have meaningless names, + and any remedy is applied at the enclosing function anyway. + sc_top_fn tracks that binder, set when entering a top-level RHS (or a + specialised copy of one) and kept unchanged below that. The location + shown is the local's own definition site, so same-named locals can be + told apart; only when that is missing (e.g. for simplifier-made join + points) does the warning fall back to the parent's location. + +* The warning lists the top-level binders containing the specialised + calls ("called from"); each Call records the sc_top_fn of its call + site for this purpose. Self-calls of a top-level loop are dropped as + uninformative (in callToPat); a *local* loop's self-calls record its + parent, indistinguishable from the parent's entry call, so the parent + appears among the callers. + +* A function with no source span and no parent reached this module in an + interface unfolding: iface files record no spans for local binders, and + such loops typically float to top level in the consuming module. The + warning says "inlined from another module" instead of showing an + unhelpful span. Imported constructors are shown qualified — with the + function anonymous, they are what identifies the package to report the + reboxing to. For such a warning the call sites ("called from") are the + only located code to point at: following the inlining from one of them + identifies the reboxed loop. + Why BoxPassAlong does not warn: if the callee is specialised at that argument position, its RULE rewrites the constructor-shaped call in the specialised body and no box is ever rebuilt. That is exactly the good case that @@ -1534,7 +1740,7 @@ scBind top_lvl env (NonRec bndr rhs) do_body -- -- I tried always specialising non-recursive top-level bindings too, -- but found some regressions (see !8135). So I backed off. - = do { (rhs_usage, rhs', ws_rhs) <- scExpr env rhs + = do { (rhs_usage, rhs', ws_rhs) <- scExpr (setTopFn env bndr) rhs -- At top level, we've already put all binders into scope; see initScEnv -- Hence no need to call `extendBndr`. But we still want to @@ -1554,7 +1760,8 @@ scBind top_lvl env (Rec prs) do_body -- why it only applies at top level. But that's the way it has been -- for a while. See #21456. do { (body_usg, body', warnings_body) <- do_body rhs_env2 - ; (rhs_usgs, rhss', rhs_ws) <- mapAndUnzip3M (scExpr env) rhss + ; (rhs_usgs, rhss', rhs_ws) <- mapAndUnzip3M (\(b,r) -> scExpr (setTopFn env b) r) + (bndrs' `zip` rhss) ; let all_usg = (combineUsages rhs_usgs `combineUsage` body_usg) `delCallsFor` bndrs' bind' = Rec (bndrs' `zip` rhss') @@ -1799,7 +2006,7 @@ markPassAlongArg _env _other usg = usg mkVarUsage :: ScEnv -> Id -> [CoreExpr] -> ScUsage mkVarUsage env fn args = case lookupHowBound env fn of - Just RecFun -> SCU { scu_calls = unitVarEnv fn [Call fn args (sc_vals env)] + Just RecFun -> SCU { scu_calls = unitVarEnv fn [Call fn args (sc_vals env) (sc_top_fn env)] , scu_occs = emptyVarEnv } Just RecArg -> SCU { scu_calls = emptyVarEnv , scu_occs = unitVarEnv fn arg_occ } @@ -1812,7 +2019,7 @@ mkVarUsage env fn args scRecRhs :: ScEnv -> (OutId, InExpr) -> UniqSM (RhsInfo, SpecConstrWarnings) scRecRhs env (bndr,rhs) = do { let (arg_bndrs,body) = collectBinders rhs - (body_env, arg_bndrs') = extendBndrsWith RecArg env arg_bndrs + (body_env, arg_bndrs') = extendBndrsWith RecArg (setTopFn env bndr) arg_bndrs ; (body_usg, body', body_ws) <- scExpr body_env body ; let (rhs_usg, arg_occs) = lookupOccs body_usg arg_bndrs' ; return (RI { ri_rhs_usg = rhs_usg @@ -1891,7 +2098,9 @@ specNonRec :: ScEnv -- plus details of specialisations specNonRec env body_calls rhs_info - = specialise env body_calls rhs_info (initSpecInfo rhs_info) + = specialise env recur body_calls rhs_info (initSpecInfo rhs_info) + where + recur = ReboxNonRec (isJoinId (ri_fn rhs_info)) ---------------------- specRec :: ScEnv @@ -1911,6 +2120,13 @@ specRec env body_calls rhs_infos where opts = sc_opts env + -- A Rec group of one is genuinely self-recursive: the occurrence + -- analyser demotes non-recursive singletons to NonRec + recur ri = case rhs_infos of + [_] -> ReboxSelfRec + _ -> ReboxMutualRec [ idName (ri_fn ri') | ri' <- rhs_infos + , ri_fn ri' /= ri_fn ri ] + -- Loop, specialising, until you get no new specialisations go, go_again :: Int -- Which iteration of the "until no new specialisations" -- loop we are on; first iteration is 1 @@ -1925,7 +2141,8 @@ specRec env body_calls rhs_infos -- , text "iteration" <+> int n_iter -- , text "spec_infos" <+> ppr (map (map os_pat . si_specs) spec_infos) -- ]) $ - do { specs_w_usg <- zipWithM (specialise env seed_calls) rhs_infos spec_infos + do { specs_w_usg <- zipWithM (\ri si -> specialise env (recur ri) seed_calls ri si) + rhs_infos spec_infos ; let (extra_usg_s, all_spec_infos, extra_ws ) = unzip3 specs_w_usg extra_usg = combineUsages extra_usg_s @@ -1963,6 +2180,7 @@ specRec env body_calls rhs_infos ---------------------- specialise :: ScEnv + -> ReboxRecursivity -- How the function recurses, for warnings -> CallEnv -- Info on newly-discovered calls to this function -> RhsInfo -> SpecInfo -- Original RHS plus patterns dealt with @@ -1977,8 +2195,8 @@ specialise -- So when we make a specialised copy of the RHS, we're starting -- from an RHS whose nested functions have been optimised already. -specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs - , ri_lam_body = body, ri_arg_occs = arg_occs }) +specialise env recur bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs + , ri_lam_body = body, ri_arg_occs = arg_occs }) spec_info@(SI { si_specs = specs, si_n_specs = spec_count , si_mb_unspec = mb_unspec }) | isDeadEndId fn -- Note [Do not specialise diverging functions] @@ -2001,7 +2219,9 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs ; let n_pats = length new_pats -- Warn about committed specialisations that will rebox; -- see Note [Reboxing warning] - rebox_ws = [ SpecReboxed (idName fn) (cp_rebox p) + rebox_ws = [ SpecReboxed (idName fn) (idType fn) (sc_top_fn env) + recur [ReboxedPat (patShapes p) (cp_rebox p)] + (cp_callers p) | p <- new_pats, not (null (cp_rebox p)) ] -- ; when (not (null new_pats) || isJust mb_unspec) $ -- pprTraceM "specialise" (vcat [ ppr fn <+> text "with" <+> int n_pats <+> text "good patterns" @@ -2013,7 +2233,9 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs -- , text "arg_occs" <+> ppr arg_occs -- , text "new_pats" <+> ppr new_pats]) - ; let spec_env = decreaseSpecCount env n_pats + ; let spec_env = setTopFn (decreaseSpecCount env n_pats) fn + -- setTopFn: attribute warnings from re-analysing the + -- specialised copies of a top-level fn's body to fn ; (spec_usgs, new_specs, new_wss) <- mapAndUnzip3M (spec_one spec_env fn arg_bndrs body) (new_pats `zip` [spec_count..]) -- See Note [Specialise original body] @@ -2565,30 +2787,127 @@ data CallPat = CP { cp_qvars :: [Var] -- Quantified variables , cp_args :: [CoreExpr] -- Arguments , cp_strict_args :: [Var] -- Arguments we want to pass unlifted even if they are boxed -- See Note [SpecConstr and strict fields] - , cp_rebox :: [Name] } -- Constructors matched by this pattern whose box + , cp_rebox :: [Name] -- Constructors matched by this pattern whose box -- is also used; see Note [Reboxing warning] + , cp_callers :: [Name] } -- Enclosing top-level binders of the calls this + -- pattern came from; see Note [Reboxing warning] -- See Note [SpecConstr call patterns] instance Outputable CallPat where - ppr (CP { cp_qvars = qvars, cp_args = args, cp_strict_args = strict, cp_rebox = rebox }) + ppr (CP { cp_qvars = qvars, cp_args = args, cp_strict_args = strict, cp_rebox = rebox + , cp_callers = callers }) = text "CP" <> braces (sep [ text "cp_qvars =" <+> ppr qvars <> comma , text "cp_args =" <+> ppr args , text "cp_strict_args = " <> ppr strict - , text "cp_rebox = " <> ppr rebox ]) + , text "cp_rebox = " <> ppr rebox + , text "cp_callers = " <> ppr callers ]) + +-- | One call pattern as displayed by the reboxing warning: the shapes of +-- the pattern's arguments, and the reboxed constructors among them. +-- See Note [Reboxing warning] +data ReboxedPat = ReboxedPat [PatShape] [Name] + +-- | The constructor skeleton of one call-pattern argument, as displayed +-- by the reboxing warning +data PatShape = ShapeWild + | ShapeLit Literal + | ShapeCon DataCon [PatShape] + +-- | The displayed shapes of a pattern's value arguments +patShapes :: CallPat -> [PatShape] +patShapes (CP { cp_args = args }) = mapMaybe arg_shape args + where + arg_shape (Type {}) = Nothing + arg_shape (Coercion {}) = Nothing + arg_shape (Cast e _) = arg_shape e + arg_shape (Tick _ e) = arg_shape e + arg_shape (Lit l) = Just (ShapeLit l) + arg_shape e + | (Var f, f_args) <- collectArgs e + , Just dc <- isDataConWorkId_maybe f + = Just (ShapeCon dc (mapMaybe arg_shape f_args)) + | otherwise + = Just ShapeWild + +-- | Stable comparison, used both to merge identically-rendering warnings +-- and to order a warning's patterns deterministically +cmpReboxedPat :: ReboxedPat -> ReboxedPat -> Ordering +cmpReboxedPat (ReboxedPat ss1 cs1) (ReboxedPat ss2 cs2) + = cmpListBy cmpShape ss1 ss2 + `mappend` cmpListBy stableNameCmp (sortBy stableNameCmp cs1) + (sortBy stableNameCmp cs2) + +cmpShape :: PatShape -> PatShape -> Ordering +cmpShape ShapeWild ShapeWild = EQ +cmpShape ShapeWild _ = LT +cmpShape _ ShapeWild = GT +cmpShape (ShapeLit l1) (ShapeLit l2) = compare l1 l2 +cmpShape (ShapeLit _) _ = LT +cmpShape _ (ShapeLit _) = GT +cmpShape (ShapeCon c1 a1) (ShapeCon c2 a2) + = stableNameCmp (dataConName c1) (dataConName c2) + `mappend` cmpListBy cmpShape a1 a2 + +cmpListBy :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering +cmpListBy _ [] [] = EQ +cmpListBy _ [] _ = LT +cmpListBy _ _ [] = GT +cmpListBy cmp (x1:xs1) (x2:xs2) = cmp x1 x2 `mappend` cmpListBy cmp xs1 xs2 + +-- Constructors are shown by bare occurrence name: shapes illustrate, +-- while the warning's "reboxes" list identifies (with qualification) +pprPatShape :: PatShape -> SDoc +pprPatShape = go (10 :: Int) -- Depth cap against pathological patterns + where + go _ ShapeWild = underscore + go _ (ShapeLit l) = ppr l + go _ (ShapeCon dc []) = ppr (getOccName dc) + go 0 (ShapeCon {}) = text "..." + go d (ShapeCon dc args) + | isTupleDataCon dc + = parens (pprWithCommas (go d') args) + | isUnboxedTupleDataCon dc + = text "(#" <+> pprWithCommas (go d') args <+> text "#)" + | dataConIsInfix dc, [a1, a2] <- args + = parens (go d' a1 <+> pprInfixOcc (getOccName dc) <+> go d' a2) + | otherwise + = parens (pprPrefixOcc (getOccName dc) <+> sep (map (go d') args)) + where d' = d - 1 + +-- | How the function that SpecConstr specialised recurses, as bound in +-- the post-optimisation program. See Note [Reboxing warning] +data ReboxRecursivity + = ReboxSelfRec + | ReboxMutualRec [Name] -- The sibling binders of its Rec group + | ReboxNonRec Bool -- True <=> a join point data SpecConstrWarning = SpecFailForcedArgCount { spec_failed_fun_name :: Name } | SpecReboxed { spec_rebox_fun_name :: Name -- The specialised function - , spec_rebox_cons :: [Name] } -- The reboxed constructor(s) + , spec_rebox_fun_ty :: Type -- Its type: often the only clue + -- to a span-less function's identity + , spec_rebox_parent :: Maybe Name -- Its enclosing top-level + -- binder, if fn is local + , spec_rebox_recur :: ReboxRecursivity + , spec_rebox_pats :: [ReboxedPat] -- The patterns that rebox + , spec_rebox_callers :: [Name] } -- Top-level binders containing + -- the specialised calls -- See Note [Reboxing warning] - deriving Eq type SpecConstrWarnings = [SpecConstrWarning] instance Outputable SpecConstrWarning where ppr (SpecFailForcedArgCount name) = ppr name <+> pprDefinedAt name - ppr (SpecReboxed fn dcs) = ppr fn <+> parens (pprWithCommas ppr dcs) <+> pprDefinedAt fn + ppr (SpecReboxed fn _ty mb_parent _recur pats _callers) + = ppr fn <+> parens (pprWithCommas ppr dcs) <+> pp_defn + where + dcs = [ dc | ReboxedPat _ cons <- pats, dc <- cons ] + -- A local fn often has no useful location; point at its + -- enclosing top-level binder instead + pp_defn = case mb_parent of + Just parent -> text "in" <+> ppr parent <> comma <+> pprDefinedAt parent + Nothing -> pprDefinedAt fn combineSpecWarning :: SpecConstrWarnings -> SpecConstrWarnings -> SpecConstrWarnings combineSpecWarning = (++) @@ -2735,7 +3054,7 @@ callToPat :: ScEnv -> [ArgOcc] -> Call -> UniqSM (Maybe CallPat) -- Type variables come first, since they may scope -- over the following term variables -- The [CoreExpr] are the argument patterns for the rule -callToPat env bndr_occs call@(Call fn args con_env) +callToPat env bndr_occs call@(Call fn args con_env mb_caller) = do { let in_scope = substInScopeSet (sc_subst env) ; arg_quads <- zipWith3M (argToPat env in_scope con_env) args bndr_occs (map (const NotMarkedStrict) args) @@ -2784,7 +3103,11 @@ callToPat env bndr_occs call@(Call fn args con_env) if interesting && null bad_covars then do { let cp_res = CP { cp_qvars = qvars', cp_args = pats , cp_strict_args = concat cbv_ids - , cp_rebox = concat rebox_cons } + , cp_rebox = concat rebox_cons + -- Self-recursive calls are no clue + -- to the function's identity + , cp_callers = [ c | Just c <- [mb_caller] + , c /= idName fn ] } -- ; pprTraceM "callToPatOut" $ -- vcat [ text "fn:" <+> ppr fn -- , text "args:" <+> ppr args @@ -2888,8 +3211,10 @@ argToPat1 env in_scope val_env arg arg_occ _arg_str ; let args' = [ p | (_, p, _, _) <- prs ] :: [CoreArg] cbvs = concat [ cbv | (_, _, cbv, _) <- prs ] rebox_nested = concat [ rbs | (_, _, _, rbs) <- prs ] - -- rebox_here: see Note [Reboxing warning] - rebox_here = [ dataConName dc | box_use == BoxOther ] + -- rebox_here: see Note [Reboxing warning]; nullary + -- constructors rebox for free, so don't warn about them + rebox_here = [ dataConName dc + | box_use == BoxOther, dataConRepArity dc > 0 ] ; assertPpr (length con_str == length (filter isRuntimeArg rest_args)) ( ppr con_str $$ ppr rest_args $$ ppr (length con_str) $$ ppr (length rest_args) ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -534,6 +534,35 @@ of ``-W(no-)*``. the call-pattern analysis by wrapping the argument in ``GHC.Exts.lazy`` at the call site, or :ghc-flag:`-fno-spec-constr`. + The warning shows the specialised function's type, which is often the + clearest clue to its identity when its name carries no meaning, + followed by a block of labelled facts: ``source:`` — the function's + definition site (for a local function, also the enclosing top-level + binding); ``recursivity:`` — whether the function is self-recursive, + mutually recursive (naming the other functions of its recursive + group), or non-recursive (for example a join point), as bound in the + optimised program, whose shape can differ from the source's; + ``called from:`` — the top-level bindings containing the specialised + calls; ``call patterns:`` — the calls the function was specialised + for, shown as the constructor skeletons of their arguments, each + alongside the constructors that the specialisation reboxes (for + example ``go (_ : _) (Bin _ _ _) -- reboxes ‘Bin’``). One warning is emitted per + specialised function, and warnings that would read identically are + merged into one. Specialisations on nullary constructors are not + reported, since "reboxing" a nullary constructor simply references + its shared static closure. + + A ``source:`` reading ``inlined from another module (no source + location)`` concerns a function that reached the module being compiled + through another module's unfolding; interface files record no source + locations for local functions. Such reboxing cannot be addressed in + the module being compiled — consider reporting it against the package + defining the inlined code. Constructors imported from other modules + are shown qualified with their defining module as a hint to where that + is. For such a warning the ``called from:`` sites are the only located + code — following the inlining from one of them identifies the reboxed + code. + The analysis behind this warning is approximate: it can both miss genuine reboxing and report reboxing that later optimisations eliminate or that only occurs on cold code paths. ===================================== testsuite/tests/simplCore/should_compile/T27628.stderr ===================================== @@ -1,9 +1,14 @@ T27628.hs: warning: [-Wspec-constr-reboxing] - SpecConstr specialised the following function(s) on a constructor argument that is also used boxed: - $wgo (LC) Defined at T27628.hs:17:1 - The specialised code allocates a fresh constructor at each such use ("reboxing"), - which can increase allocation and defeat pointer-equality-based sharing. - Possible remedies: exclude the type with an {-# ANN type T NoSpecConstr #-} pragma, - hide the constructor from SpecConstr by wrapping the call-site argument in GHC.Exts.lazy, - or use -fno-spec-constr. + SpecConstr specialised + ‘$wgo :: LC + -> GHC.Internal.Prim.Int# + -> GHC.Internal.Prim.Int# + -> GHC.Internal.Prim.Int#’ + source: T27628.hs:17:1 + recursivity: self-recursive + called from: ‘f’ + call pattern: $wgo (LC _ _) -- reboxes ‘LC’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. ===================================== testsuite/tests/simplCore/should_compile/T27628b.stderr ===================================== @@ -1,9 +1,10 @@ T27628b.hs: warning: [-Wspec-constr-reboxing] - SpecConstr specialised the following function(s) on a constructor argument that is also used boxed: - merge (Bin) Defined at T27628b.hs:10:1 - The specialised code allocates a fresh constructor at each such use ("reboxing"), - which can increase allocation and defeat pointer-equality-based sharing. - Possible remedies: exclude the type with an {-# ANN type T NoSpecConstr #-} pragma, - hide the constructor from SpecConstr by wrapping the call-site argument in GHC.Exts.lazy, - or use -fno-spec-constr. + SpecConstr specialised ‘merge :: T -> T -> T’ + source: T27628b.hs:10:1 + recursivity: self-recursive + called from: ‘f’ + call pattern: merge (Bin _ _ _) -- reboxes ‘Bin’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. ===================================== testsuite/tests/simplCore/should_compile/T27628e.hs ===================================== @@ -0,0 +1,17 @@ +-- Like T27628b, but the specialisation pattern is the *nullary* +-- constructor Tip (the call passes Tip; the box is also returned). +-- Reboxing a nullary constructor is free (it is a shared static +-- closure), so no warning should be emitted. +module T27628e where + +data T = Tip | Bin Int T T + +merge :: T -> T -> T +merge Tip t2 = t2 +merge t1@(Bin k l r) t2 = + case t2 of + Tip -> t1 + Bin _ l2 r2 -> Bin k (merge l l2) (merge r r2) + +g :: T -> T +g t = merge t Tip ===================================== testsuite/tests/simplCore/should_compile/T27628f.hs ===================================== @@ -0,0 +1,16 @@ +-- Like T27628b, but the specialised function is a *local* worker. +-- The warning should attribute it to the enclosing top-level binder f. +-- (merge captures n so that it is not floated to the top level.) +module T27628f where + +data T = Tip | Bin Int T T + +f :: Int -> T -> T +f n t0 = merge (Bin n Tip Tip) t0 + where + merge :: T -> T -> T + merge Tip _ = Tip + merge t1@(Bin k l r) t2 = + case t2 of + Tip -> t1 + Bin _ l2 r2 -> Bin (k + n) (merge l l2) (merge r r2) ===================================== testsuite/tests/simplCore/should_compile/T27628f.stderr ===================================== @@ -0,0 +1,10 @@ +T27628f.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘merge :: T -> T -> T’ + source: ‘f’ at T27628f.hs:12:5 + recursivity: self-recursive + called from: ‘f’ + call pattern: merge (Bin _ _ _) -- reboxes ‘Bin’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + ===================================== testsuite/tests/simplCore/should_compile/T27628g.hs ===================================== @@ -0,0 +1,15 @@ +module T27628g where + +data T a = Tip | Bin a (T a) (T a) + +-- merge has no free value variables, so the float-out pass lifts it to +-- top level as poly_merge, abstracted over 'a'. The reboxing warning +-- should still point at merge's definition site. +f :: a -> T a -> T a +f x t = merge (Bin x Tip Tip) t + where + merge Tip t2 = t2 + merge t1@(Bin k l r) t2 = + case t2 of + Tip -> t1 + Bin _ l2 r2 -> Bin k (merge l l2) (merge r r2) ===================================== testsuite/tests/simplCore/should_compile/T27628g.stderr ===================================== @@ -0,0 +1,10 @@ +T27628g.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘poly_merge :: T a -> T a -> T a’ + source: T27628g.hs:11:5 + recursivity: self-recursive + called from: ‘f’ + call pattern: poly_merge (Bin _ _ _) -- reboxes ‘Bin’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + ===================================== testsuite/tests/simplCore/should_compile/T27628h.hs ===================================== @@ -0,0 +1,8 @@ +-- Specialising the span-less copy of T27628h_M.merge must warn with the +-- "inlined from another module" wording and a module-qualified constructor. +module T27628h where + +import T27628h_M + +g :: Int -> T Int -> T Int +g x t = f x (f x t) ===================================== testsuite/tests/simplCore/should_compile/T27628h.stderr ===================================== @@ -0,0 +1,20 @@ +./T27628h_M.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘poly_merge :: T a -> T a -> T a’ + source: T27628h_M.hs:11:5 + recursivity: self-recursive + called from: ‘f’ + call pattern: poly_merge (Bin _ _ _) -- reboxes ‘Bin’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + +T27628h.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘merge :: T Int -> T Int -> T Int’ + source: inlined from another module (no source location) + recursivity: self-recursive + called from: ‘g’ + call pattern: merge (Bin _ _ _) -- reboxes ‘T27628h_M.Bin’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + ===================================== testsuite/tests/simplCore/should_compile/T27628h_M.hs ===================================== @@ -0,0 +1,16 @@ +-- The INLINE unfolding of f carries the local loop 'merge' into importing +-- modules, where it is specialised without a source span: iface unfoldings +-- record no spans for local binders. +module T27628h_M where + +data T a = Tip | Bin a (T a) (T a) + +f :: a -> T a -> T a +f x t = merge (Bin x Tip Tip) t + where + merge Tip t2 = t2 + merge t1@(Bin k l r) t2 = + case t2 of + Tip -> t1 + Bin _ l2 r2 -> Bin k (merge l l2) (merge r r2) +{-# INLINE f #-} ===================================== testsuite/tests/simplCore/should_compile/T27628i.hs ===================================== @@ -0,0 +1,15 @@ +-- The span-less copies of f1's and f3's 'merge' render identically, so +-- one warning covers both; f2's 'merge' differs in type and gets its +-- own warning. +module T27628i where + +import T27628i_M + +g1 :: Int -> T Int -> T Int +g1 x t = f1 x (f1 x t) + +g2 :: Int -> S Int -> S Int +g2 x t = f2 x (f2 x t) + +g3 :: Int -> T Int -> T Int +g3 x t = f3 x (f3 x t) ===================================== testsuite/tests/simplCore/should_compile/T27628i.stderr ===================================== @@ -0,0 +1,51 @@ +./T27628i_M.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘poly_merge :: T a -> T a -> T a’ + source: T27628i_M.hs:36:5 + recursivity: self-recursive + called from: ‘f3’ + call pattern: poly_merge (Bin _ _ _) -- reboxes ‘Bin’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + +./T27628i_M.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘poly_merge :: S a -> S a -> S a’ + source: T27628i_M.hs:24:5 + recursivity: self-recursive + called from: ‘f2’ + call pattern: poly_merge (Node _ _ _) -- reboxes ‘Node’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + +./T27628i_M.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘poly_merge :: T a -> T a -> T a’ + source: T27628i_M.hs:14:5 + recursivity: self-recursive + called from: ‘f1’ + call pattern: poly_merge (Bin _ _ _) -- reboxes ‘Bin’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + +T27628i.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘merge :: T Int -> T Int -> T Int’ + source: inlined from another module (no source location) + recursivity: self-recursive + called from: ‘g1’, ‘g3’ + call pattern: merge (Bin _ _ _) -- reboxes ‘T27628i_M.Bin’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + +T27628i.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘merge :: S Int -> S Int -> S Int’ + source: inlined from another module (no source location) + recursivity: self-recursive + called from: ‘g2’ + call pattern: merge (Node _ _ _) + -- reboxes ‘T27628i_M.Node’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + ===================================== testsuite/tests/simplCore/should_compile/T27628i_M.hs ===================================== @@ -0,0 +1,41 @@ +-- Three INLINE functions with local loops named 'merge': f1 and f3 over +-- T, f2 over S. In an importing module all three loops arrive span-less +-- (iface unfoldings record no spans for local binders). f1's and f3's +-- copies render identically (same name and type) and must merge into +-- one warning; f2's differs in type and must stay separate. +module T27628i_M where + +data T a = Tip | Bin a (T a) (T a) +data S a = Leaf | Node a (S a) (S a) + +f1 :: a -> T a -> T a +f1 x t = merge (Bin x Tip Tip) t + where + merge Tip t2 = t2 + merge t1@(Bin k l r) t2 = + case t2 of + Tip -> t1 + Bin _ l2 r2 -> Bin k (merge l l2) (merge r r2) +{-# INLINE f1 #-} + +f2 :: a -> S a -> S a +f2 x t = merge (Node x Leaf Leaf) t + where + merge Leaf t2 = t2 + merge t1@(Node k l r) t2 = + case t2 of + Leaf -> t1 + Node _ l2 r2 -> Node k (merge l l2) (merge r r2) +{-# INLINE f2 #-} + +-- Like f1 but recursing with the children swapped, so the two loops +-- stay distinct functions while their warnings render the same +f3 :: a -> T a -> T a +f3 x t = merge (Bin x Tip Tip) t + where + merge Tip t2 = t2 + merge t1@(Bin k l r) t2 = + case t2 of + Tip -> t1 + Bin _ l2 r2 -> Bin k (merge r r2) (merge l l2) +{-# INLINE f3 #-} ===================================== testsuite/tests/simplCore/should_compile/T27628j.hs ===================================== @@ -0,0 +1,24 @@ +-- A mutually recursive pair in the style of T27628b. g calls both +-- functions with a constructor argument: the non-loop-breaker inlines +-- into g, but the loop breaker's call survives to SpecConstr, whose +-- warning classifies it as mutually recursive and names the sibling. +module T27628j where + +data T = Tip | Bin Int T T + +mergeA :: T -> T -> T +mergeA Tip t2 = t2 +mergeA t1@(Bin k l r) t2 = + case t2 of + Tip -> t1 + Bin _ l2 r2 -> Bin k (mergeB l l2) (mergeB r r2) + +mergeB :: T -> T -> T +mergeB Tip t2 = t2 +mergeB t1@(Bin k l r) t2 = + case t2 of + Tip -> t1 + Bin _ l2 r2 -> Bin k (mergeA r r2) (mergeA l l2) + +g :: Int -> T -> T +g x t = mergeA (Bin x Tip Tip) (mergeB (Bin x Tip Tip) t) ===================================== testsuite/tests/simplCore/should_compile/T27628j.stderr ===================================== @@ -0,0 +1,10 @@ +T27628j.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘mergeB :: T -> T -> T’ + source: T27628j.hs:17:1 + recursivity: mutually recursive with ‘mergeA’ + called from: ‘g’ + call pattern: mergeB (Bin _ _ _) -- reboxes ‘Bin’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + ===================================== testsuite/tests/simplCore/should_compile/T27628k.hs ===================================== @@ -0,0 +1,20 @@ +-- 'go' is specialised for two different call patterns, A and B, and +-- both rebox (t is scrutinised but also passed whole to 'sink'). +-- Expect one warning for 'go' listing both call patterns. +module T27628k where + +data T = A Int | B Int | C + +-- The guard makes the use of 't' lazy, so boxity analysis keeps the +-- box: $wsink wants it. +sink :: T -> Int -> Int +sink t k + | k < 0 = k + | otherwise = case t of A n -> n; B n -> n; C -> 0 +{-# NOINLINE sink #-} + +go :: T -> Int -> Int +go t k = case t of + A n -> if k == 0 then sink t k else go (B n) (k - 1) + B n -> if k == 0 then sink t k else go (A n) (k - 1) + C -> 0 ===================================== testsuite/tests/simplCore/should_compile/T27628k.stderr ===================================== @@ -0,0 +1,11 @@ +T27628k.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘go :: T -> Int -> Int’ + source: T27628k.hs:17:1 + recursivity: self-recursive + call patterns: go (A _) (I# _) -- reboxes ‘A’ + go (B _) (I# _) -- reboxes ‘B’ + These constructor arguments are also used boxed, so the + specialisations may increase allocation and defeat + pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + ===================================== testsuite/tests/simplCore/should_compile/T27628l.hs ===================================== @@ -0,0 +1,38 @@ +-- Max and Min (mimicking GHC.Internal.Data.Functor.Utils) both inline +-- base's foldl' and stimes templates, so each instance's methods bind +-- local loops with the SAME uniques as the other's. The warnings must +-- stay separate per instance (keyed on (parent, function)), not be +-- fused into one with doubled callers; see Note [Reboxing warning]. +module T27628l where + +import Data.List (foldl') + +newtype Max a = Max (Maybe a) + +instance Ord a => Semigroup (Max a) where + {-# INLINE (<>) #-} + m <> Max Nothing = m + Max Nothing <> n = n + (Max m@(Just x)) <> (Max n@(Just y)) + | x >= y = Max m + | otherwise = Max n + +instance Ord a => Monoid (Max a) where + mempty = Max Nothing + mconcat = foldl' (<>) mempty + {-# INLINE mconcat #-} + +newtype Min a = Min (Maybe a) + +instance Ord a => Semigroup (Min a) where + {-# INLINE (<>) #-} + m <> Min Nothing = m + Min Nothing <> n = n + (Min m@(Just x)) <> (Min n@(Just y)) + | x <= y = Min m + | otherwise = Min n + +instance Ord a => Monoid (Min a) where + mempty = Min Nothing + mconcat = foldl' (<>) mempty + {-# INLINE mconcat #-} ===================================== testsuite/tests/simplCore/should_compile/T27628l.stderr ===================================== @@ -0,0 +1,66 @@ +T27628l.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘go1 :: [Max a] -> Max a -> Max a’ + source: ‘$cmconcat’ at T27628l.hs:22:5 + recursivity: self-recursive + called from: ‘$cmconcat’ + call pattern: go1 _ (Just _) + -- reboxes ‘GHC.Internal.Maybe.Just’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + +T27628l.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘exit :: Max a -> b -> Max a’ + source: ‘$cstimes’ at T27628l.hs:12:10 + recursivity: non-recursive (a join point) + called from: ‘$cstimes’ + call pattern: exit (Just _) _ + -- reboxes ‘GHC.Internal.Maybe.Just’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + +T27628l.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘g :: Max a -> b -> Max a -> Max a’ + source: ‘$cstimes’ at T27628l.hs:12:10 + recursivity: self-recursive + called from: ‘$cstimes’ + call pattern: g (Just _) _ _ + -- reboxes ‘GHC.Internal.Maybe.Just’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + +T27628l.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘go1 :: [Min a] -> Min a -> Min a’ + source: ‘$cmconcat’ at T27628l.hs:37:5 + recursivity: self-recursive + called from: ‘$cmconcat’ + call pattern: go1 _ (Just _) + -- reboxes ‘GHC.Internal.Maybe.Just’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + +T27628l.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘exit :: Min a -> b -> Min a’ + source: ‘$cstimes’ at T27628l.hs:27:10 + recursivity: non-recursive (a join point) + called from: ‘$cstimes’ + call pattern: exit (Just _) _ + -- reboxes ‘GHC.Internal.Maybe.Just’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + +T27628l.hs: warning: [-Wspec-constr-reboxing] + SpecConstr specialised ‘g :: Min a -> b -> Min a -> Min a’ + source: ‘$cstimes’ at T27628l.hs:27:10 + recursivity: self-recursive + called from: ‘$cstimes’ + call pattern: g (Just _) _ _ + -- reboxes ‘GHC.Internal.Maybe.Just’ + This constructor argument is also used boxed, so the specialisation + may increase allocation and defeat pointer-equality-based sharing. + See -Wspec-constr-reboxing in the users guide for possible remedies. + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -617,3 +617,11 @@ test('T27628', normal, compile, ['-O2 -Wspec-constr-reboxing']) test('T27628b', normal, compile, ['-O2 -Wspec-constr-reboxing']) test('T27628c', normal, compile, ['-O2 -Wspec-constr-reboxing']) test('T27628d', normal, compile, ['-O2 -Wspec-constr-reboxing']) +test('T27628e', normal, compile, ['-O2 -Wspec-constr-reboxing']) +test('T27628f', normal, compile, ['-O2 -Wspec-constr-reboxing']) +test('T27628g', normal, compile, ['-O2 -Wspec-constr-reboxing -dsuppress-uniques']) +test('T27628h', [extra_files(['T27628h_M.hs'])], multimod_compile, ['T27628h', '-v0 -O2 -Wspec-constr-reboxing -dsuppress-uniques']) +test('T27628i', [extra_files(['T27628i_M.hs'])], multimod_compile, ['T27628i', '-v0 -O2 -Wspec-constr-reboxing -dsuppress-uniques']) +test('T27628j', normal, compile, ['-O2 -Wspec-constr-reboxing']) +test('T27628k', normal, compile, ['-O2 -Wspec-constr-reboxing']) +test('T27628l', normal, compile, ['-O2 -Wspec-constr-reboxing -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0e9f8bc7f5d8acf390e0145030dbbe… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0e9f8bc7f5d8acf390e0145030dbbe… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: rts linker: Fix pointer arithmetic issue in flushInstructionCacheRISCV64
by Marge Bot (＠marge-bot) 24 Aug '26

24 Aug '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 84b9fd2f by Andreas Klebinger at 2026-08-24T02:45:47-04:00 rts linker: Fix pointer arithmetic issue in flushInstructionCacheRISCV64 We accidentally operated over `uint64_t*` when we should use `uint8_t`. Fixes #27569 - - - - - 7e4eb741 by Alan Zimmerman at 2026-08-24T02:45:47-04:00 EPA: Uses Parsers.parseModule for exactprint tests Parsers.parseModule is the advertised way to parse for use for exact printing in the ghc-exactprint library. This commit updates the GHC exact print testing to use it. This requires moving the comment balancing that was occurring only in the test path into the advertising parser path, so it moves from Transforms.hs to Utils.hs. Also update the comment adding to honour trailing annotations - - - - - 6 changed files: - rts/linker/elf_reloc_riscv64.c - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Parsers.hs - utils/check-exact/Transform.hs - utils/check-exact/Utils.hs Changes: ===================================== rts/linker/elf_reloc_riscv64.c ===================================== @@ -679,7 +679,7 @@ void flushInstructionCacheRISCV64(ObjectCode *oc) { /* The main object code */ void *codeBegin = oc->image + oc->misalignment; - __builtin___clear_cache(codeBegin, (void*) ((uint64_t*) codeBegin + oc->fileSize)); + __builtin___clear_cache(codeBegin, (void*) ((uint8_t*) codeBegin + oc->fileSize)); /* Jump Islands */ __builtin___clear_cache((void *)oc->symbol_extras, ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -1465,7 +1465,7 @@ instance ExactPrint (HsModule GhcPs) where Just exps -> do let (op,cp,tcs) = am_exports $ anns an0 op' <- markEpToken op - exps' <- mapM markAnnotated exps + exps' <- mapM markAnnotated (filter notIEDoc exps) tcs' <- mapM markEpToken tcs cp' <- markEpToken cp return (Just exps', an0 { anns = (anns an0) { am_exports = (op',cp',tcs')}}) ===================================== utils/check-exact/Main.hs ===================================== @@ -183,7 +183,8 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/printer/Test17519.hs" Nothing -- "../../testsuite/tests/printer/InTreeAnnotations1.hs" Nothing -- "../../testsuite/tests/printer/Test19798.hs" Nothing - "../../testsuite/tests/printer/Test10309.hs" Nothing + -- "../../testsuite/tests/printer/Test10309.hs" Nothing + "../../testsuite/tests/printer/Haddock1.hs" Nothing -- "../../testsuite/tests/qualifieddo/should_compile/qdocompile001.hs" Nothing -- "../../testsuite/tests/typecheck/should_fail/StrictBinds.hs" Nothing @@ -304,7 +305,7 @@ writeBinFile fpath x = withBinaryFile fpath WriteMode (\h -> hSetEncoding h utf8 testOneFile :: [(String, Changer)] -> FilePath -> String -> Maybe Changer -> IO () testOneFile _ libdir fileName mchanger = do - (p,_toks) <- parseOneFile libdir fileName + p <- parseOneFile libdir fileName let origAst = ppAst p pped = exactPrint p @@ -333,7 +334,7 @@ testOneFile _ libdir fileName mchanger = do changedSource <- readFile newFile return (expectedSource == changedSource, expectedSource, changedSource) - (p',_) <- parseOneFile libdir newFile + p' <- parseOneFile libdir newFile let newAstStr :: String newAstStr = ppAst p' writeBinFile newAstFile newAstStr @@ -364,15 +365,12 @@ testOneFile _ libdir fileName mchanger = do ppAst :: Data a => a -> String ppAst ast = showSDocUnsafe $ showAstData BlankSrcSpanFile NoBlankEpAnnotations ast - -parseOneFile :: FilePath -> FilePath -> IO (ParsedSource, [Located Token]) +parseOneFile :: FilePath -> FilePath -> IO ParsedSource parseOneFile libdir fileName = do - res <- parseModuleEpAnnsWithCpp libdir defaultCppOptions fileName + res <- Parsers.parseModule libdir fileName case res of Left m -> error (internalDebugShowMessages m) - Right (injectedComments, _dflags, pmod) -> do - let !pmodWithComments = insertCppComments pmod injectedComments - return (pmodWithComments, []) + Right pmod -> return pmod -- --------------------------------------------------------------------- @@ -519,8 +517,7 @@ changeLocalDecls libdir (L l p) = do replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs) -> Transform (LMatch GhcPs (LHsExpr GhcPs)) replaceLocalBinds (L lm (Match an mln pats (GRHSs _ rhs (HsValBinds (van,w) (ValBinds _ bs))))) = do - let (oldDecls) = map unWrapValBind bs - -- let decls = s:d:oldDecls + let oldDecls = map unWrapValBind bs let oldDecls' = captureLineSpacing oldDecls let (VbSig o:oldBinds) = map wrapValBind oldDecls' o' = setEntryDP o (DifferentLine 2 0) ===================================== utils/check-exact/Parsers.hs ===================================== @@ -46,6 +46,7 @@ module Parsers ( ) where import Preprocess +import Utils import Data.Functor (void) @@ -270,7 +271,10 @@ postParseTransform -> Either a (GHC.ParsedSource) postParseTransform parseRes = fmap mkAnns parseRes where - mkAnns (_cs, _, m) = fixModuleComments m + mkAnns (cs, _, m) = fixModuleComments (insertCppComments (noIEDoc m) cs) + noIEDoc (GHC.L l m) = case GHC.hsmodExports m of + Nothing -> GHC.L l m + Just exps -> GHC.L l m { GHC.hsmodExports = Just $ filter notIEDoc exps } fixModuleComments :: GHC.ParsedSource -> GHC.ParsedSource fixModuleComments p = fixModuleHeaderComments $ fixModuleTrailingComments p ===================================== utils/check-exact/Transform.hs ===================================== @@ -93,7 +93,6 @@ import qualified Control.Monad.Fail as Fail import GHC hiding (parseModule, parsedSource) import GHC.Parser.PostProcess ( wrapValBind ) import GHC.Data.FastString -import GHC.Types.SrcLoc import Data.Data import Data.List (unsnoc) @@ -402,6 +401,14 @@ balanceCommentsList' (a:b:ls) = (a':r) (a',b') = balanceComments a b r = balanceCommentsList' (b':ls) +balanceCommentsListA :: [LocatedA a ] -> [LocatedA a] +balanceCommentsListA [] = [] +balanceCommentsListA [x] = [x] +balanceCommentsListA (a:b:ls) = (a':r) + where + (a',b') = balanceCommentsA a b + r = balanceCommentsListA (b':ls) + -- |The GHC parser puts all comments appearing between the end of one AST -- item and the beginning of the next as 'annPriorComments' for the second one. -- This function takes two adjacent AST items and moves any 'annPriorComments' @@ -507,15 +514,6 @@ pushTrailingComments w cs lb@(HsValBinds (an,wt) _) = (True, HsValBinds (an',wt) (HsValBinds _ vb') -> vb' _ -> ValBinds noExtField [] - -balanceCommentsListA :: [LocatedA a] -> [LocatedA a] -balanceCommentsListA [] = [] -balanceCommentsListA [x] = [x] -balanceCommentsListA (a:b:ls) = (a':r) - where - (a',b') = balanceCommentsA a b - r = balanceCommentsListA (b':ls) - -- |Prior to moving an AST element, make sure any trailing comments belonging to -- it are attached to it, and not the following element. Of necessity this is a -- heuristic process, to be tuned later. Possibly a variant should be provided @@ -591,59 +589,6 @@ priorCommentsDeltas r cs = go r (sortEpaComments cs) -- --------------------------------------------------------------------- --- | Split comments into ones occurring before the end of the reference --- span, and those after it. -splitComments :: RealSrcSpan -> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment]) -splitComments p cs = (before, middle, after) - where - cmpe (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmpe (L _ _) = True - - cmpb (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2pos p - cmpb (L _ _) = True - - (beforeEnd, after) = break cmpe ((priorComments cs) ++ (getFollowingComments cs)) - (before, middle) = break cmpb beforeEnd - - --- | Split comments into ones occurring before the end of the reference --- span, and those after it. -splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments -splitCommentsEnd p (EpaComments cs) = cs' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = case after of - [] -> EpaComments cs - _ -> epaCommentsBalanced before after -splitCommentsEnd p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = before - ts' = after <> ts - --- | Split comments into ones occurring before the start of the reference --- span, and those after it. -splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments -splitCommentsStart p (EpaComments cs) = cs' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = case after of - [] -> EpaComments cs - _ -> epaCommentsBalanced before after -splitCommentsStart p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = before - ts' = after <> ts - moveLeadingComments :: (Data t, Data u, NoAnn t, NoAnn u) => LocatedAn t a -> EpAnn u -> (LocatedAn t a, EpAnn u) moveLeadingComments (L la a) lb = (L la' a, lb') @@ -680,19 +625,6 @@ addCommentOrigDeltasAnn (EpAnn e a cs) = EpAnn e a (addCommentOrigDeltas cs) anchorFromLocatedA :: LocatedA a -> RealSrcSpan anchorFromLocatedA (L (EpAnn anc _ _) _) = epaLocationRealSrcSpan anc --- | Get the full span of interest for comments from a LocatedA. --- This extends up to the last TrailingAnn -fullSpanFromLocatedA :: LocatedA a -> RealSrcSpan -fullSpanFromLocatedA (L (EpAnn anc tas _) _) = rr - where - r = epaLocationRealSrcSpan anc - trailing_loc ta = case ta_location ta of - EpaSpan (RealSrcSpan s _) -> [s] - _ -> [] - rr = case reverse (concatMap trailing_loc tas) of - [] -> r - (s:_) -> combineRealSrcSpans r s - -- --------------------------------------------------------------------- balanceSameLineComments :: LMatch GhcPs (LHsExpr GhcPs) -> (LMatch GhcPs (LHsExpr GhcPs)) ===================================== utils/check-exact/Utils.hs ===================================== @@ -228,7 +228,7 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining (p2, remaining) = insertTopLevelCppComments p1 toplevel addCommentsListItem :: EpAnn [TrailingAnn] -> State [LEpaComment] (EpAnn [TrailingAnn]) - addCommentsListItem = addComments + addCommentsListItem = addCommentsA addCommentsList :: EpAnn AnnList -> State [LEpaComment] (EpAnn AnnList) addCommentsList = addComments @@ -249,6 +249,20 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining _ -> return $ EpAnn anc an ocs + addCommentsA :: EpAnn [TrailingAnn] -> State [LEpaComment] (EpAnn [TrailingAnn]) + addCommentsA ann@(EpAnn anc an ocs) = do + case anc of + EpaSpan (RealSrcSpan s _) -> do + unAllocated <- get + let + (rest, these) = GHC.Parser.Lexer.allocateComments (fullSpanFromEpAnnA ann) unAllocated + balanced = splitCommentsEnd s (EpaComments these) + cs' = sortEpAnnComments (ocs <> balanced) + put rest + return $ EpAnn anc an cs' + + _ -> return $ EpAnn anc an ocs + workInComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments workInComments ocs [] = ocs workInComments ocs new = cs' @@ -264,9 +278,14 @@ workInComments ocs new = cs' = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos $ epaLocationRealSrcSpan ac) ) new +sortEpAnnComments :: EpAnnComments -> EpAnnComments +sortEpAnnComments (EpaComments cs) = EpaComments (sortEpaComments cs) +sortEpAnnComments (EpaCommentsBalanced pc fc) + = EpaCommentsBalanced (sortEpaComments pc) (sortEpaComments fc) + insertTopLevelCppComments :: HsModule GhcPs -> [LEpaComment] -> (HsModule GhcPs, [LEpaComment]) insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports imports decls) cs - = (HsModule (XModulePs an4 lo mdeprec mbDoc) mmn mexports' imports' decls', cs3) + = (HsModule (XModulePs an4 lo mdeprec mbDoc) mmn mexports imports' decls', cs3) -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0,hc1,hc_cs)) -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0i,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0i,hc0,hc1,hc_cs)) where @@ -297,24 +316,7 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports cs' = workInComments (comments an1) stay _ -> (an1,cs0a) - (mexports', an3, cs1) = - case mexports of - Nothing -> (Nothing, an2, cs0b) - Just exports -> (Just exports', an3', cse) - where - (csh', cs0b') = case am_exports $ anns an2 of - (tokOP, _tokCP, _tokCommas) -> - case tokOP of - (EpTok (EpaSpan (RealSrcSpan s _))) -> (h, n) - where - (h,n) = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos s) ) - cs0b - - _ -> ([], cs0b) - hc1' = workInComments (comments an2) csh' - an3' = an2 { comments = hc1' } - (exports', cse) = allocPreceding exports cs0b' - (imports0, cs2) = allocPreceding imports cs1 + (imports0, cs2) = allocPreceding imports cs0b (imports', hc0i) = balanceFirstLocatedAComments imports0 (decls0, cs3) = allocPreceding decls cs2 @@ -323,9 +325,9 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports -- Either hc0i or hc0d should have comments. Combine them hc0 = hc0i ++ hc0d - (hc1,hc_cs) = splitOnWhere After (am_where $ anns an3) hc0 - hc2 = workInComments (comments an3) hc1 - an4 = an3 { anns = (anns an3) {am_cs = hc_cs}, comments = hc2 } + (hc1,hc_cs) = splitOnWhere After (am_where $ anns an2) hc0 + hc2 = workInComments (comments an2) hc1 + an4 = an2 { anns = (anns an2) {am_cs = hc_cs}, comments = hc2 } allocPreceding :: [LocatedA a] -> [LEpaComment] -> ([LocatedA a], [LEpaComment]) allocPreceding [] cs' = ([], cs') @@ -346,7 +348,6 @@ annListBracketsLocs (ListSquare o c) = (getEpTokenLoc o, getEpTokenLoc c) annListBracketsLocs (ListBanana o c) = (getEpUniTokenLoc o, getEpUniTokenLoc c) annListBracketsLocs ListNone = (noAnn, noAnn) - data SplitWhere = Before | After splitOnWhere :: SplitWhere -> EpToken "where" -> [LEpaComment] -> ([LEpaComment], [LEpaComment]) @@ -430,6 +431,79 @@ insertRemainingCppComments (L l p) cs = L l p' -- --------------------------------------------------------------------- +-- | Get the full span of interest for comments from a LocatedA. +-- This extends up to the last TrailingAnn +fullSpanFromLocatedA :: LocatedA a -> RealSrcSpan +fullSpanFromLocatedA (L ann _) = fullSpanFromEpAnnA ann + +-- | Get the full span of interest for comments from a LocatedA. +-- This extends up to the last TrailingAnn +fullSpanFromEpAnnA :: EpAnn [TrailingAnn] -> RealSrcSpan +fullSpanFromEpAnnA (EpAnn anc tas _) = rr + where + r = epaLocationRealSrcSpan anc + trailing_loc ta = case ta_location ta of + EpaSpan (RealSrcSpan s _) -> [s] + _ -> [] + rr = case reverse (concatMap trailing_loc tas) of + [] -> r + (s:_) -> combineRealSrcSpans r s + +-- | Split comments into ones occurring before the end of the reference +-- span, and those after it. +splitComments :: RealSrcSpan -> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment]) +splitComments p cs = (before, middle, after) + where + cmpe (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmpe (L _ _) = True + + cmpb (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2pos p + cmpb (L _ _) = True + + (beforeEnd, after) = break cmpe ((priorComments cs) ++ (getFollowingComments cs)) + (before, middle) = break cmpb beforeEnd + + +-- | Split comments into ones occurring before the end of the reference +-- span, and those after it. +splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments +splitCommentsEnd p (EpaComments cs) = cs' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = case after of + [] -> EpaComments cs + _ -> epaCommentsBalanced before after +splitCommentsEnd p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = before + ts' = after <> ts + +-- | Split comments into ones occurring before the start of the reference +-- span, and those after it. +splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments +splitCommentsStart p (EpaComments cs) = cs' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = case after of + [] -> EpaComments cs + _ -> epaCommentsBalanced before after +splitCommentsStart p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = before + ts' = after <> ts + +-- --------------------------------------------------------------------- + ghcCommentText :: LEpaComment -> String ghcCommentText (L _ (GHC.EpaComment (EpaDocComment s) _)) = exactPrintHsDocString s ghcCommentText (L _ (GHC.EpaComment (EpaDocOptions s) _)) = s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c816680d958ebed747a4ef9e7353e5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c816680d958ebed747a4ef9e7353e5… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: rts linker: Fix pointer arithmetic issue in flushInstructionCacheRISCV64
by Marge Bot (＠marge-bot) 24 Aug '26

24 Aug '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: eb28622d by Andreas Klebinger at 2026-08-24T00:38:04-04:00 rts linker: Fix pointer arithmetic issue in flushInstructionCacheRISCV64 We accidentally operated over `uint64_t*` when we should use `uint8_t`. Fixes #27569 - - - - - c816680d by Alan Zimmerman at 2026-08-24T00:38:04-04:00 EPA: Uses Parsers.parseModule for exactprint tests Parsers.parseModule is the advertised way to parse for use for exact printing in the ghc-exactprint library. This commit updates the GHC exact print testing to use it. This requires moving the comment balancing that was occurring only in the test path into the advertising parser path, so it moves from Transforms.hs to Utils.hs. Also update the comment adding to honour trailing annotations - - - - - 6 changed files: - rts/linker/elf_reloc_riscv64.c - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Parsers.hs - utils/check-exact/Transform.hs - utils/check-exact/Utils.hs Changes: ===================================== rts/linker/elf_reloc_riscv64.c ===================================== @@ -679,7 +679,7 @@ void flushInstructionCacheRISCV64(ObjectCode *oc) { /* The main object code */ void *codeBegin = oc->image + oc->misalignment; - __builtin___clear_cache(codeBegin, (void*) ((uint64_t*) codeBegin + oc->fileSize)); + __builtin___clear_cache(codeBegin, (void*) ((uint8_t*) codeBegin + oc->fileSize)); /* Jump Islands */ __builtin___clear_cache((void *)oc->symbol_extras, ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -1465,7 +1465,7 @@ instance ExactPrint (HsModule GhcPs) where Just exps -> do let (op,cp,tcs) = am_exports $ anns an0 op' <- markEpToken op - exps' <- mapM markAnnotated exps + exps' <- mapM markAnnotated (filter notIEDoc exps) tcs' <- mapM markEpToken tcs cp' <- markEpToken cp return (Just exps', an0 { anns = (anns an0) { am_exports = (op',cp',tcs')}}) ===================================== utils/check-exact/Main.hs ===================================== @@ -183,7 +183,8 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/printer/Test17519.hs" Nothing -- "../../testsuite/tests/printer/InTreeAnnotations1.hs" Nothing -- "../../testsuite/tests/printer/Test19798.hs" Nothing - "../../testsuite/tests/printer/Test10309.hs" Nothing + -- "../../testsuite/tests/printer/Test10309.hs" Nothing + "../../testsuite/tests/printer/Haddock1.hs" Nothing -- "../../testsuite/tests/qualifieddo/should_compile/qdocompile001.hs" Nothing -- "../../testsuite/tests/typecheck/should_fail/StrictBinds.hs" Nothing @@ -304,7 +305,7 @@ writeBinFile fpath x = withBinaryFile fpath WriteMode (\h -> hSetEncoding h utf8 testOneFile :: [(String, Changer)] -> FilePath -> String -> Maybe Changer -> IO () testOneFile _ libdir fileName mchanger = do - (p,_toks) <- parseOneFile libdir fileName + p <- parseOneFile libdir fileName let origAst = ppAst p pped = exactPrint p @@ -333,7 +334,7 @@ testOneFile _ libdir fileName mchanger = do changedSource <- readFile newFile return (expectedSource == changedSource, expectedSource, changedSource) - (p',_) <- parseOneFile libdir newFile + p' <- parseOneFile libdir newFile let newAstStr :: String newAstStr = ppAst p' writeBinFile newAstFile newAstStr @@ -364,15 +365,12 @@ testOneFile _ libdir fileName mchanger = do ppAst :: Data a => a -> String ppAst ast = showSDocUnsafe $ showAstData BlankSrcSpanFile NoBlankEpAnnotations ast - -parseOneFile :: FilePath -> FilePath -> IO (ParsedSource, [Located Token]) +parseOneFile :: FilePath -> FilePath -> IO ParsedSource parseOneFile libdir fileName = do - res <- parseModuleEpAnnsWithCpp libdir defaultCppOptions fileName + res <- Parsers.parseModule libdir fileName case res of Left m -> error (internalDebugShowMessages m) - Right (injectedComments, _dflags, pmod) -> do - let !pmodWithComments = insertCppComments pmod injectedComments - return (pmodWithComments, []) + Right pmod -> return pmod -- --------------------------------------------------------------------- @@ -519,8 +517,7 @@ changeLocalDecls libdir (L l p) = do replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs) -> Transform (LMatch GhcPs (LHsExpr GhcPs)) replaceLocalBinds (L lm (Match an mln pats (GRHSs _ rhs (HsValBinds (van,w) (ValBinds _ bs))))) = do - let (oldDecls) = map unWrapValBind bs - -- let decls = s:d:oldDecls + let oldDecls = map unWrapValBind bs let oldDecls' = captureLineSpacing oldDecls let (VbSig o:oldBinds) = map wrapValBind oldDecls' o' = setEntryDP o (DifferentLine 2 0) ===================================== utils/check-exact/Parsers.hs ===================================== @@ -46,6 +46,7 @@ module Parsers ( ) where import Preprocess +import Utils import Data.Functor (void) @@ -270,7 +271,10 @@ postParseTransform -> Either a (GHC.ParsedSource) postParseTransform parseRes = fmap mkAnns parseRes where - mkAnns (_cs, _, m) = fixModuleComments m + mkAnns (cs, _, m) = fixModuleComments (insertCppComments (noIEDoc m) cs) + noIEDoc (GHC.L l m) = case GHC.hsmodExports m of + Nothing -> GHC.L l m + Just exps -> GHC.L l m { GHC.hsmodExports = Just $ filter notIEDoc exps } fixModuleComments :: GHC.ParsedSource -> GHC.ParsedSource fixModuleComments p = fixModuleHeaderComments $ fixModuleTrailingComments p ===================================== utils/check-exact/Transform.hs ===================================== @@ -93,7 +93,6 @@ import qualified Control.Monad.Fail as Fail import GHC hiding (parseModule, parsedSource) import GHC.Parser.PostProcess ( wrapValBind ) import GHC.Data.FastString -import GHC.Types.SrcLoc import Data.Data import Data.List (unsnoc) @@ -402,6 +401,14 @@ balanceCommentsList' (a:b:ls) = (a':r) (a',b') = balanceComments a b r = balanceCommentsList' (b':ls) +balanceCommentsListA :: [LocatedA a ] -> [LocatedA a] +balanceCommentsListA [] = [] +balanceCommentsListA [x] = [x] +balanceCommentsListA (a:b:ls) = (a':r) + where + (a',b') = balanceCommentsA a b + r = balanceCommentsListA (b':ls) + -- |The GHC parser puts all comments appearing between the end of one AST -- item and the beginning of the next as 'annPriorComments' for the second one. -- This function takes two adjacent AST items and moves any 'annPriorComments' @@ -507,15 +514,6 @@ pushTrailingComments w cs lb@(HsValBinds (an,wt) _) = (True, HsValBinds (an',wt) (HsValBinds _ vb') -> vb' _ -> ValBinds noExtField [] - -balanceCommentsListA :: [LocatedA a] -> [LocatedA a] -balanceCommentsListA [] = [] -balanceCommentsListA [x] = [x] -balanceCommentsListA (a:b:ls) = (a':r) - where - (a',b') = balanceCommentsA a b - r = balanceCommentsListA (b':ls) - -- |Prior to moving an AST element, make sure any trailing comments belonging to -- it are attached to it, and not the following element. Of necessity this is a -- heuristic process, to be tuned later. Possibly a variant should be provided @@ -591,59 +589,6 @@ priorCommentsDeltas r cs = go r (sortEpaComments cs) -- --------------------------------------------------------------------- --- | Split comments into ones occurring before the end of the reference --- span, and those after it. -splitComments :: RealSrcSpan -> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment]) -splitComments p cs = (before, middle, after) - where - cmpe (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmpe (L _ _) = True - - cmpb (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2pos p - cmpb (L _ _) = True - - (beforeEnd, after) = break cmpe ((priorComments cs) ++ (getFollowingComments cs)) - (before, middle) = break cmpb beforeEnd - - --- | Split comments into ones occurring before the end of the reference --- span, and those after it. -splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments -splitCommentsEnd p (EpaComments cs) = cs' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = case after of - [] -> EpaComments cs - _ -> epaCommentsBalanced before after -splitCommentsEnd p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = before - ts' = after <> ts - --- | Split comments into ones occurring before the start of the reference --- span, and those after it. -splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments -splitCommentsStart p (EpaComments cs) = cs' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = case after of - [] -> EpaComments cs - _ -> epaCommentsBalanced before after -splitCommentsStart p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = before - ts' = after <> ts - moveLeadingComments :: (Data t, Data u, NoAnn t, NoAnn u) => LocatedAn t a -> EpAnn u -> (LocatedAn t a, EpAnn u) moveLeadingComments (L la a) lb = (L la' a, lb') @@ -680,19 +625,6 @@ addCommentOrigDeltasAnn (EpAnn e a cs) = EpAnn e a (addCommentOrigDeltas cs) anchorFromLocatedA :: LocatedA a -> RealSrcSpan anchorFromLocatedA (L (EpAnn anc _ _) _) = epaLocationRealSrcSpan anc --- | Get the full span of interest for comments from a LocatedA. --- This extends up to the last TrailingAnn -fullSpanFromLocatedA :: LocatedA a -> RealSrcSpan -fullSpanFromLocatedA (L (EpAnn anc tas _) _) = rr - where - r = epaLocationRealSrcSpan anc - trailing_loc ta = case ta_location ta of - EpaSpan (RealSrcSpan s _) -> [s] - _ -> [] - rr = case reverse (concatMap trailing_loc tas) of - [] -> r - (s:_) -> combineRealSrcSpans r s - -- --------------------------------------------------------------------- balanceSameLineComments :: LMatch GhcPs (LHsExpr GhcPs) -> (LMatch GhcPs (LHsExpr GhcPs)) ===================================== utils/check-exact/Utils.hs ===================================== @@ -228,7 +228,7 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining (p2, remaining) = insertTopLevelCppComments p1 toplevel addCommentsListItem :: EpAnn [TrailingAnn] -> State [LEpaComment] (EpAnn [TrailingAnn]) - addCommentsListItem = addComments + addCommentsListItem = addCommentsA addCommentsList :: EpAnn AnnList -> State [LEpaComment] (EpAnn AnnList) addCommentsList = addComments @@ -249,6 +249,20 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining _ -> return $ EpAnn anc an ocs + addCommentsA :: EpAnn [TrailingAnn] -> State [LEpaComment] (EpAnn [TrailingAnn]) + addCommentsA ann@(EpAnn anc an ocs) = do + case anc of + EpaSpan (RealSrcSpan s _) -> do + unAllocated <- get + let + (rest, these) = GHC.Parser.Lexer.allocateComments (fullSpanFromEpAnnA ann) unAllocated + balanced = splitCommentsEnd s (EpaComments these) + cs' = sortEpAnnComments (ocs <> balanced) + put rest + return $ EpAnn anc an cs' + + _ -> return $ EpAnn anc an ocs + workInComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments workInComments ocs [] = ocs workInComments ocs new = cs' @@ -264,9 +278,14 @@ workInComments ocs new = cs' = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos $ epaLocationRealSrcSpan ac) ) new +sortEpAnnComments :: EpAnnComments -> EpAnnComments +sortEpAnnComments (EpaComments cs) = EpaComments (sortEpaComments cs) +sortEpAnnComments (EpaCommentsBalanced pc fc) + = EpaCommentsBalanced (sortEpaComments pc) (sortEpaComments fc) + insertTopLevelCppComments :: HsModule GhcPs -> [LEpaComment] -> (HsModule GhcPs, [LEpaComment]) insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports imports decls) cs - = (HsModule (XModulePs an4 lo mdeprec mbDoc) mmn mexports' imports' decls', cs3) + = (HsModule (XModulePs an4 lo mdeprec mbDoc) mmn mexports imports' decls', cs3) -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0,hc1,hc_cs)) -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0i,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0i,hc0,hc1,hc_cs)) where @@ -297,24 +316,7 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports cs' = workInComments (comments an1) stay _ -> (an1,cs0a) - (mexports', an3, cs1) = - case mexports of - Nothing -> (Nothing, an2, cs0b) - Just exports -> (Just exports', an3', cse) - where - (csh', cs0b') = case am_exports $ anns an2 of - (tokOP, _tokCP, _tokCommas) -> - case tokOP of - (EpTok (EpaSpan (RealSrcSpan s _))) -> (h, n) - where - (h,n) = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos s) ) - cs0b - - _ -> ([], cs0b) - hc1' = workInComments (comments an2) csh' - an3' = an2 { comments = hc1' } - (exports', cse) = allocPreceding exports cs0b' - (imports0, cs2) = allocPreceding imports cs1 + (imports0, cs2) = allocPreceding imports cs0b (imports', hc0i) = balanceFirstLocatedAComments imports0 (decls0, cs3) = allocPreceding decls cs2 @@ -323,9 +325,9 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports -- Either hc0i or hc0d should have comments. Combine them hc0 = hc0i ++ hc0d - (hc1,hc_cs) = splitOnWhere After (am_where $ anns an3) hc0 - hc2 = workInComments (comments an3) hc1 - an4 = an3 { anns = (anns an3) {am_cs = hc_cs}, comments = hc2 } + (hc1,hc_cs) = splitOnWhere After (am_where $ anns an2) hc0 + hc2 = workInComments (comments an2) hc1 + an4 = an2 { anns = (anns an2) {am_cs = hc_cs}, comments = hc2 } allocPreceding :: [LocatedA a] -> [LEpaComment] -> ([LocatedA a], [LEpaComment]) allocPreceding [] cs' = ([], cs') @@ -346,7 +348,6 @@ annListBracketsLocs (ListSquare o c) = (getEpTokenLoc o, getEpTokenLoc c) annListBracketsLocs (ListBanana o c) = (getEpUniTokenLoc o, getEpUniTokenLoc c) annListBracketsLocs ListNone = (noAnn, noAnn) - data SplitWhere = Before | After splitOnWhere :: SplitWhere -> EpToken "where" -> [LEpaComment] -> ([LEpaComment], [LEpaComment]) @@ -430,6 +431,79 @@ insertRemainingCppComments (L l p) cs = L l p' -- --------------------------------------------------------------------- +-- | Get the full span of interest for comments from a LocatedA. +-- This extends up to the last TrailingAnn +fullSpanFromLocatedA :: LocatedA a -> RealSrcSpan +fullSpanFromLocatedA (L ann _) = fullSpanFromEpAnnA ann + +-- | Get the full span of interest for comments from a LocatedA. +-- This extends up to the last TrailingAnn +fullSpanFromEpAnnA :: EpAnn [TrailingAnn] -> RealSrcSpan +fullSpanFromEpAnnA (EpAnn anc tas _) = rr + where + r = epaLocationRealSrcSpan anc + trailing_loc ta = case ta_location ta of + EpaSpan (RealSrcSpan s _) -> [s] + _ -> [] + rr = case reverse (concatMap trailing_loc tas) of + [] -> r + (s:_) -> combineRealSrcSpans r s + +-- | Split comments into ones occurring before the end of the reference +-- span, and those after it. +splitComments :: RealSrcSpan -> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment]) +splitComments p cs = (before, middle, after) + where + cmpe (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmpe (L _ _) = True + + cmpb (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2pos p + cmpb (L _ _) = True + + (beforeEnd, after) = break cmpe ((priorComments cs) ++ (getFollowingComments cs)) + (before, middle) = break cmpb beforeEnd + + +-- | Split comments into ones occurring before the end of the reference +-- span, and those after it. +splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments +splitCommentsEnd p (EpaComments cs) = cs' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = case after of + [] -> EpaComments cs + _ -> epaCommentsBalanced before after +splitCommentsEnd p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = before + ts' = after <> ts + +-- | Split comments into ones occurring before the start of the reference +-- span, and those after it. +splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments +splitCommentsStart p (EpaComments cs) = cs' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = case after of + [] -> EpaComments cs + _ -> epaCommentsBalanced before after +splitCommentsStart p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = before + ts' = after <> ts + +-- --------------------------------------------------------------------- + ghcCommentText :: LEpaComment -> String ghcCommentText (L _ (GHC.EpaComment (EpaDocComment s) _)) = exactPrintHsDocString s ghcCommentText (L _ (GHC.EpaComment (EpaDocOptions s) _)) = s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5af7613fd719b1541ee93ac41f5a71… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5af7613fd719b1541ee93ac41f5a71… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: rts linker: Fix pointer arithmetic issue in flushInstructionCacheRISCV64
by Marge Bot (＠marge-bot) 24 Aug '26

24 Aug '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 79765ad4 by Andreas Klebinger at 2026-08-23T20:29:30-04:00 rts linker: Fix pointer arithmetic issue in flushInstructionCacheRISCV64 We accidentally operated over `uint64_t*` when we should use `uint8_t`. Fixes #27569 - - - - - 5af7613f by Alan Zimmerman at 2026-08-23T20:29:30-04:00 EPA: Uses Parsers.parseModule for exactprint tests Parsers.parseModule is the advertised way to parse for use for exact printing in the ghc-exactprint library. This commit updates the GHC exact print testing to use it. This requires moving the comment balancing that was occurring only in the test path into the advertising parser path, so it moves from Transforms.hs to Utils.hs. Also update the comment adding to honour trailing annotations - - - - - 6 changed files: - rts/linker/elf_reloc_riscv64.c - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Parsers.hs - utils/check-exact/Transform.hs - utils/check-exact/Utils.hs Changes: ===================================== rts/linker/elf_reloc_riscv64.c ===================================== @@ -679,7 +679,7 @@ void flushInstructionCacheRISCV64(ObjectCode *oc) { /* The main object code */ void *codeBegin = oc->image + oc->misalignment; - __builtin___clear_cache(codeBegin, (void*) ((uint64_t*) codeBegin + oc->fileSize)); + __builtin___clear_cache(codeBegin, (void*) ((uint8_t*) codeBegin + oc->fileSize)); /* Jump Islands */ __builtin___clear_cache((void *)oc->symbol_extras, ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -1465,7 +1465,7 @@ instance ExactPrint (HsModule GhcPs) where Just exps -> do let (op,cp,tcs) = am_exports $ anns an0 op' <- markEpToken op - exps' <- mapM markAnnotated exps + exps' <- mapM markAnnotated (filter notIEDoc exps) tcs' <- mapM markEpToken tcs cp' <- markEpToken cp return (Just exps', an0 { anns = (anns an0) { am_exports = (op',cp',tcs')}}) ===================================== utils/check-exact/Main.hs ===================================== @@ -183,7 +183,8 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/printer/Test17519.hs" Nothing -- "../../testsuite/tests/printer/InTreeAnnotations1.hs" Nothing -- "../../testsuite/tests/printer/Test19798.hs" Nothing - "../../testsuite/tests/printer/Test10309.hs" Nothing + -- "../../testsuite/tests/printer/Test10309.hs" Nothing + "../../testsuite/tests/printer/Haddock1.hs" Nothing -- "../../testsuite/tests/qualifieddo/should_compile/qdocompile001.hs" Nothing -- "../../testsuite/tests/typecheck/should_fail/StrictBinds.hs" Nothing @@ -304,7 +305,7 @@ writeBinFile fpath x = withBinaryFile fpath WriteMode (\h -> hSetEncoding h utf8 testOneFile :: [(String, Changer)] -> FilePath -> String -> Maybe Changer -> IO () testOneFile _ libdir fileName mchanger = do - (p,_toks) <- parseOneFile libdir fileName + p <- parseOneFile libdir fileName let origAst = ppAst p pped = exactPrint p @@ -333,7 +334,7 @@ testOneFile _ libdir fileName mchanger = do changedSource <- readFile newFile return (expectedSource == changedSource, expectedSource, changedSource) - (p',_) <- parseOneFile libdir newFile + p' <- parseOneFile libdir newFile let newAstStr :: String newAstStr = ppAst p' writeBinFile newAstFile newAstStr @@ -364,15 +365,12 @@ testOneFile _ libdir fileName mchanger = do ppAst :: Data a => a -> String ppAst ast = showSDocUnsafe $ showAstData BlankSrcSpanFile NoBlankEpAnnotations ast - -parseOneFile :: FilePath -> FilePath -> IO (ParsedSource, [Located Token]) +parseOneFile :: FilePath -> FilePath -> IO ParsedSource parseOneFile libdir fileName = do - res <- parseModuleEpAnnsWithCpp libdir defaultCppOptions fileName + res <- Parsers.parseModule libdir fileName case res of Left m -> error (internalDebugShowMessages m) - Right (injectedComments, _dflags, pmod) -> do - let !pmodWithComments = insertCppComments pmod injectedComments - return (pmodWithComments, []) + Right pmod -> return pmod -- --------------------------------------------------------------------- @@ -519,8 +517,7 @@ changeLocalDecls libdir (L l p) = do replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs) -> Transform (LMatch GhcPs (LHsExpr GhcPs)) replaceLocalBinds (L lm (Match an mln pats (GRHSs _ rhs (HsValBinds (van,w) (ValBinds _ bs))))) = do - let (oldDecls) = map unWrapValBind bs - -- let decls = s:d:oldDecls + let oldDecls = map unWrapValBind bs let oldDecls' = captureLineSpacing oldDecls let (VbSig o:oldBinds) = map wrapValBind oldDecls' o' = setEntryDP o (DifferentLine 2 0) ===================================== utils/check-exact/Parsers.hs ===================================== @@ -46,6 +46,7 @@ module Parsers ( ) where import Preprocess +import Utils import Data.Functor (void) @@ -270,7 +271,10 @@ postParseTransform -> Either a (GHC.ParsedSource) postParseTransform parseRes = fmap mkAnns parseRes where - mkAnns (_cs, _, m) = fixModuleComments m + mkAnns (cs, _, m) = fixModuleComments (insertCppComments (noIEDoc m) cs) + noIEDoc (GHC.L l m) = case GHC.hsmodExports m of + Nothing -> GHC.L l m + Just exps -> GHC.L l m { GHC.hsmodExports = Just $ filter notIEDoc exps } fixModuleComments :: GHC.ParsedSource -> GHC.ParsedSource fixModuleComments p = fixModuleHeaderComments $ fixModuleTrailingComments p ===================================== utils/check-exact/Transform.hs ===================================== @@ -93,7 +93,6 @@ import qualified Control.Monad.Fail as Fail import GHC hiding (parseModule, parsedSource) import GHC.Parser.PostProcess ( wrapValBind ) import GHC.Data.FastString -import GHC.Types.SrcLoc import Data.Data import Data.List (unsnoc) @@ -402,6 +401,14 @@ balanceCommentsList' (a:b:ls) = (a':r) (a',b') = balanceComments a b r = balanceCommentsList' (b':ls) +balanceCommentsListA :: [LocatedA a ] -> [LocatedA a] +balanceCommentsListA [] = [] +balanceCommentsListA [x] = [x] +balanceCommentsListA (a:b:ls) = (a':r) + where + (a',b') = balanceCommentsA a b + r = balanceCommentsListA (b':ls) + -- |The GHC parser puts all comments appearing between the end of one AST -- item and the beginning of the next as 'annPriorComments' for the second one. -- This function takes two adjacent AST items and moves any 'annPriorComments' @@ -507,15 +514,6 @@ pushTrailingComments w cs lb@(HsValBinds (an,wt) _) = (True, HsValBinds (an',wt) (HsValBinds _ vb') -> vb' _ -> ValBinds noExtField [] - -balanceCommentsListA :: [LocatedA a] -> [LocatedA a] -balanceCommentsListA [] = [] -balanceCommentsListA [x] = [x] -balanceCommentsListA (a:b:ls) = (a':r) - where - (a',b') = balanceCommentsA a b - r = balanceCommentsListA (b':ls) - -- |Prior to moving an AST element, make sure any trailing comments belonging to -- it are attached to it, and not the following element. Of necessity this is a -- heuristic process, to be tuned later. Possibly a variant should be provided @@ -591,59 +589,6 @@ priorCommentsDeltas r cs = go r (sortEpaComments cs) -- --------------------------------------------------------------------- --- | Split comments into ones occurring before the end of the reference --- span, and those after it. -splitComments :: RealSrcSpan -> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment]) -splitComments p cs = (before, middle, after) - where - cmpe (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmpe (L _ _) = True - - cmpb (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2pos p - cmpb (L _ _) = True - - (beforeEnd, after) = break cmpe ((priorComments cs) ++ (getFollowingComments cs)) - (before, middle) = break cmpb beforeEnd - - --- | Split comments into ones occurring before the end of the reference --- span, and those after it. -splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments -splitCommentsEnd p (EpaComments cs) = cs' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = case after of - [] -> EpaComments cs - _ -> epaCommentsBalanced before after -splitCommentsEnd p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = before - ts' = after <> ts - --- | Split comments into ones occurring before the start of the reference --- span, and those after it. -splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments -splitCommentsStart p (EpaComments cs) = cs' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = case after of - [] -> EpaComments cs - _ -> epaCommentsBalanced before after -splitCommentsStart p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = before - ts' = after <> ts - moveLeadingComments :: (Data t, Data u, NoAnn t, NoAnn u) => LocatedAn t a -> EpAnn u -> (LocatedAn t a, EpAnn u) moveLeadingComments (L la a) lb = (L la' a, lb') @@ -680,19 +625,6 @@ addCommentOrigDeltasAnn (EpAnn e a cs) = EpAnn e a (addCommentOrigDeltas cs) anchorFromLocatedA :: LocatedA a -> RealSrcSpan anchorFromLocatedA (L (EpAnn anc _ _) _) = epaLocationRealSrcSpan anc --- | Get the full span of interest for comments from a LocatedA. --- This extends up to the last TrailingAnn -fullSpanFromLocatedA :: LocatedA a -> RealSrcSpan -fullSpanFromLocatedA (L (EpAnn anc tas _) _) = rr - where - r = epaLocationRealSrcSpan anc - trailing_loc ta = case ta_location ta of - EpaSpan (RealSrcSpan s _) -> [s] - _ -> [] - rr = case reverse (concatMap trailing_loc tas) of - [] -> r - (s:_) -> combineRealSrcSpans r s - -- --------------------------------------------------------------------- balanceSameLineComments :: LMatch GhcPs (LHsExpr GhcPs) -> (LMatch GhcPs (LHsExpr GhcPs)) ===================================== utils/check-exact/Utils.hs ===================================== @@ -228,7 +228,7 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining (p2, remaining) = insertTopLevelCppComments p1 toplevel addCommentsListItem :: EpAnn [TrailingAnn] -> State [LEpaComment] (EpAnn [TrailingAnn]) - addCommentsListItem = addComments + addCommentsListItem = addCommentsA addCommentsList :: EpAnn AnnList -> State [LEpaComment] (EpAnn AnnList) addCommentsList = addComments @@ -249,6 +249,20 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining _ -> return $ EpAnn anc an ocs + addCommentsA :: EpAnn [TrailingAnn] -> State [LEpaComment] (EpAnn [TrailingAnn]) + addCommentsA ann@(EpAnn anc an ocs) = do + case anc of + EpaSpan (RealSrcSpan s _) -> do + unAllocated <- get + let + (rest, these) = GHC.Parser.Lexer.allocateComments (fullSpanFromEpAnnA ann) unAllocated + balanced = splitCommentsEnd s (EpaComments these) + cs' = sortEpAnnComments (ocs <> balanced) + put rest + return $ EpAnn anc an cs' + + _ -> return $ EpAnn anc an ocs + workInComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments workInComments ocs [] = ocs workInComments ocs new = cs' @@ -264,9 +278,14 @@ workInComments ocs new = cs' = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos $ epaLocationRealSrcSpan ac) ) new +sortEpAnnComments :: EpAnnComments -> EpAnnComments +sortEpAnnComments (EpaComments cs) = EpaComments (sortEpaComments cs) +sortEpAnnComments (EpaCommentsBalanced pc fc) + = EpaCommentsBalanced (sortEpaComments pc) (sortEpaComments fc) + insertTopLevelCppComments :: HsModule GhcPs -> [LEpaComment] -> (HsModule GhcPs, [LEpaComment]) insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports imports decls) cs - = (HsModule (XModulePs an4 lo mdeprec mbDoc) mmn mexports' imports' decls', cs3) + = (HsModule (XModulePs an4 lo mdeprec mbDoc) mmn mexports imports' decls', cs3) -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0,hc1,hc_cs)) -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0i,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0i,hc0,hc1,hc_cs)) where @@ -297,24 +316,7 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports cs' = workInComments (comments an1) stay _ -> (an1,cs0a) - (mexports', an3, cs1) = - case mexports of - Nothing -> (Nothing, an2, cs0b) - Just exports -> (Just exports', an3', cse) - where - (csh', cs0b') = case am_exports $ anns an2 of - (tokOP, _tokCP, _tokCommas) -> - case tokOP of - (EpTok (EpaSpan (RealSrcSpan s _))) -> (h, n) - where - (h,n) = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos s) ) - cs0b - - _ -> ([], cs0b) - hc1' = workInComments (comments an2) csh' - an3' = an2 { comments = hc1' } - (exports', cse) = allocPreceding exports cs0b' - (imports0, cs2) = allocPreceding imports cs1 + (imports0, cs2) = allocPreceding imports cs0b (imports', hc0i) = balanceFirstLocatedAComments imports0 (decls0, cs3) = allocPreceding decls cs2 @@ -323,9 +325,9 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports -- Either hc0i or hc0d should have comments. Combine them hc0 = hc0i ++ hc0d - (hc1,hc_cs) = splitOnWhere After (am_where $ anns an3) hc0 - hc2 = workInComments (comments an3) hc1 - an4 = an3 { anns = (anns an3) {am_cs = hc_cs}, comments = hc2 } + (hc1,hc_cs) = splitOnWhere After (am_where $ anns an2) hc0 + hc2 = workInComments (comments an2) hc1 + an4 = an2 { anns = (anns an2) {am_cs = hc_cs}, comments = hc2 } allocPreceding :: [LocatedA a] -> [LEpaComment] -> ([LocatedA a], [LEpaComment]) allocPreceding [] cs' = ([], cs') @@ -346,7 +348,6 @@ annListBracketsLocs (ListSquare o c) = (getEpTokenLoc o, getEpTokenLoc c) annListBracketsLocs (ListBanana o c) = (getEpUniTokenLoc o, getEpUniTokenLoc c) annListBracketsLocs ListNone = (noAnn, noAnn) - data SplitWhere = Before | After splitOnWhere :: SplitWhere -> EpToken "where" -> [LEpaComment] -> ([LEpaComment], [LEpaComment]) @@ -430,6 +431,79 @@ insertRemainingCppComments (L l p) cs = L l p' -- --------------------------------------------------------------------- +-- | Get the full span of interest for comments from a LocatedA. +-- This extends up to the last TrailingAnn +fullSpanFromLocatedA :: LocatedA a -> RealSrcSpan +fullSpanFromLocatedA (L ann _) = fullSpanFromEpAnnA ann + +-- | Get the full span of interest for comments from a LocatedA. +-- This extends up to the last TrailingAnn +fullSpanFromEpAnnA :: EpAnn [TrailingAnn] -> RealSrcSpan +fullSpanFromEpAnnA (EpAnn anc tas _) = rr + where + r = epaLocationRealSrcSpan anc + trailing_loc ta = case ta_location ta of + EpaSpan (RealSrcSpan s _) -> [s] + _ -> [] + rr = case reverse (concatMap trailing_loc tas) of + [] -> r + (s:_) -> combineRealSrcSpans r s + +-- | Split comments into ones occurring before the end of the reference +-- span, and those after it. +splitComments :: RealSrcSpan -> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment]) +splitComments p cs = (before, middle, after) + where + cmpe (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmpe (L _ _) = True + + cmpb (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2pos p + cmpb (L _ _) = True + + (beforeEnd, after) = break cmpe ((priorComments cs) ++ (getFollowingComments cs)) + (before, middle) = break cmpb beforeEnd + + +-- | Split comments into ones occurring before the end of the reference +-- span, and those after it. +splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments +splitCommentsEnd p (EpaComments cs) = cs' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = case after of + [] -> EpaComments cs + _ -> epaCommentsBalanced before after +splitCommentsEnd p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = before + ts' = after <> ts + +-- | Split comments into ones occurring before the start of the reference +-- span, and those after it. +splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments +splitCommentsStart p (EpaComments cs) = cs' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = case after of + [] -> EpaComments cs + _ -> epaCommentsBalanced before after +splitCommentsStart p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = before + ts' = after <> ts + +-- --------------------------------------------------------------------- + ghcCommentText :: LEpaComment -> String ghcCommentText (L _ (GHC.EpaComment (EpaDocComment s) _)) = exactPrintHsDocString s ghcCommentText (L _ (GHC.EpaComment (EpaDocOptions s) _)) = s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e54da4bb5ca046002f3cd727baa93c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e54da4bb5ca046002f3cd727baa93c… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0